;;; files.el --- file input and output commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
-;; 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
+(defvar font-lock-keywords)
+
+
(defgroup backup nil
"Backups of edited data files."
:group 'files)
:type 'boolean
:group 'find-file)
-(defcustom revert-without-query
- nil
+(defcustom revert-without-query nil
"*Specify which files should be reverted without query.
The value is a list of regular expressions.
If the file name matches one of these regular expressions,
(put 'buffer-file-number 'permanent-local t)
(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
- "Non-nil means that buffer-file-number uniquely identifies files.")
+ "Non-nil means that `buffer-file-number' uniquely identifies files.")
(defvar buffer-file-read-only nil
"Non-nil if visited file was read-only when visited.")
:type '(choice (const :tag "When visiting" visit)
(const :tag "When saving" t)
(const :tag "When visiting or saving" visit-save)
- (const :tag "Never" nil)
- (other :tag "Ask" ask))
+ (const :tag "Don't add newlines" nil)
+ (other :tag "Ask each time" ask))
:group 'editing-basics)
(defcustom mode-require-final-newline t
- "*Whether to add a newline at the end of the file, in certain major modes.
+ "*Whether to add a newline at end of file, in certain major modes.
Those modes set `require-final-newline' to this value when you enable them.
-They do so because they are used for files that are supposed
+They do so because they are often used for files that are supposed
to end in newlines, and the question is how to arrange that.
A value of t means do this only when the file is about to be saved.
A value of `visit' means do this right after the file is visited.
A value of `visit-save' means do it at both of those times.
-Any other non-nil value means ask user whether to add a newline, when saving."
+Any other non-nil value means ask user whether to add a newline, when saving.
+
+nil means do not add newlines. That is a risky choice in this variable
+since this value is used for modes for files that ought to have final newlines.
+So if you set this to nil, you must explicitly check and add
+a final newline, whenever you save a file that really needs one."
:type '(choice (const :tag "When visiting" visit)
(const :tag "When saving" t)
(const :tag "When visiting or saving" visit-save)
- (other :tag "Ask" ask))
+ (const :tag "Don't add newlines" nil)
+ (other :tag "Ask each time" ask))
:group 'editing-basics
:version "22.1")
These functions are called as soon as the error is detected.
Variable `buffer-file-name' is already set up.
The functions are called in the order given until one of them returns non-nil.")
-(defvaralias 'find-file-not-found-hooks 'find-file-not-found-functions)
-(make-obsolete-variable
- 'find-file-not-found-hooks 'find-file-not-found-functions "22.1")
+(define-obsolete-variable-alias 'find-file-not-found-hooks
+ 'find-file-not-found-functions "22.1")
;;;It is not useful to make this a local variable.
;;;(put 'find-file-hooks 'permanent-local t)
:type 'hook
:options '(auto-insert)
:version "22.1")
-(defvaralias 'find-file-hooks 'find-file-hook)
-(make-obsolete-variable 'find-file-hooks 'find-file-hook "22.1")
+(define-obsolete-variable-alias 'find-file-hooks 'find-file-hook "22.1")
(defvar write-file-functions nil
"List of functions to be called before writing out a buffer to a file.
to how to save a buffer to file, for instance, choosing a suitable
coding system and setting mode bits. (See Info
node `(elisp)Saving Buffers'.) To perform various checks or
-updates before the buffer is saved, use `before-save-hook' .")
+updates before the buffer is saved, use `before-save-hook'.")
(put 'write-file-functions 'permanent-local t)
-(defvaralias 'write-file-hooks 'write-file-functions)
-(make-obsolete-variable 'write-file-hooks 'write-file-functions "22.1")
+(define-obsolete-variable-alias 'write-file-hooks 'write-file-functions "22.1")
(defvar local-write-file-hooks nil)
(make-variable-buffer-local 'local-write-file-hooks)
To perform various checks or updates before the buffer is saved,
use `before-save-hook'.")
(make-variable-buffer-local 'write-contents-functions)
-(defvaralias 'write-contents-hooks 'write-contents-functions)
-(make-obsolete-variable 'write-contents-hooks 'write-contents-functions "22.1")
+(define-obsolete-variable-alias 'write-contents-hooks
+ 'write-contents-functions "22.1")
(defcustom enable-local-variables t
"*Control use of local variables in files you visit.
This means to guarantee valid names and perhaps to canonicalize
certain patterns.
+FILENAME should be an absolute file name since the conversion rules
+sometimes vary depending on the position in the file name. E.g. c:/foo
+is a valid DOS file name, but c:/bar/c:/foo is not.
+
This function's standard definition is trivial; it just returns
the argument. However, on Windows and DOS, replace invalid
characters. On DOS, make sure to obey the 8.3 limitations. On
Value is not expanded---you must call `expand-file-name' yourself.
Default name to DEFAULT-DIRNAME if user exits with the same
non-empty string that was inserted by this function.
- (If DEFAULT-DIRNAME is omitted, the current buffer's directory is used,
- except that if INITIAL is specified, that combined with DIR is used.)
+ (If DEFAULT-DIRNAME is omitted, DIR combined with INITIAL is used,
+ or just DIR if INITIAL is nil.)
If the user exits with an empty minibuffer, this function returns
an empty string. (This can only happen if the user erased the
pre-inserted contents or if `insert-default-directory' is nil.)
the value of `default-directory'."
(unless dir
(setq dir default-directory))
- (unless default-dirname
- (setq default-dirname
- (if initial (concat dir initial) default-directory)))
- (read-file-name prompt dir default-dirname mustmatch initial
+ (read-file-name prompt dir (or default-dirname
+ (if initial (expand-file-name initial dir)
+ dir))
+ mustmatch initial
'file-directory-p))
\f
(defun locate-file (filename path &optional suffixes predicate)
"Search for FILENAME through PATH.
+If found, return the absolute file name of FILENAME, with its suffixes;
+otherwise return nil.
+PATH should be a list of directories to look in, like the lists in
+`exec-path' or `load-path'.
If SUFFIXES is non-nil, it should be a list of suffixes to append to
file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\").
+Use '(\"/\") to disable PATH search, but still try the suffixes in SUFFIXES.
If non-nil, PREDICATE is used instead of `file-readable-p'.
PREDICATE can also be an integer to pass to the `access' system call,
in which case file-name handlers are ignored. This usage is deprecated.
(defun locate-file-completion (string path-and-suffixes action)
"Do completion for file names passed to `locate-file'.
-PATH-AND-SUFFIXES is a pair of lists (DIRECTORIES . SUFFIXES)."
+PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
(if (file-name-absolute-p string)
(read-file-name-internal string nil action)
(let ((names nil)
((null action) (try-completion string names))
(t (test-completion string names))))))
+(defun executable-find (command)
+ "Search for COMMAND in `exec-path' and return the absolute file name.
+Return nil if COMMAND is not found anywhere in `exec-path'."
+ ;; Use 1 rather than file-executable-p to better match the behavior of
+ ;; call-process.
+ (locate-file command exec-path exec-suffixes 1))
+
(defun load-library (library)
"Load the library named LIBRARY.
This is an interface to the function `load'."
"Change the encoding of FILE's name from CODING to NEW-CODING.
The value is a new name of FILE.
Signals a `file-already-exists' error if a file of the new name
-already exists unless optional third argument OK-IF-ALREADY-EXISTS
-is non-nil. A number as third arg means request confirmation if
+already exists unless optional fourth argument OK-IF-ALREADY-EXISTS
+is non-nil. A number as fourth arg means request confirmation if
the new name already exists. This is what happens in interactive
use with M-x."
(interactive
(defvar find-file-default nil
"Used within `find-file-read-args'.")
+(defmacro minibuffer-with-setup-hook (fun &rest body)
+ "Add FUN to `minibuffer-setup-hook' while executing BODY.
+BODY should use the minibuffer at most once.
+Recursive uses of the minibuffer will not be affected."
+ (declare (indent 1) (debug t))
+ (let ((hook (make-symbol "setup-hook")))
+ `(let (,hook)
+ (setq ,hook
+ (lambda ()
+ ;; Clear out this hook so it does not interfere
+ ;; with any recursive minibuffer usage.
+ (remove-hook 'minibuffer-setup-hook ,hook)
+ (,fun)))
+ (unwind-protect
+ (progn
+ (add-hook 'minibuffer-setup-hook ,hook)
+ ,@body)
+ (remove-hook 'minibuffer-setup-hook ,hook)))))
+
(defun find-file-read-args (prompt mustmatch)
(list (let ((find-file-default
(and buffer-file-name
- (abbreviate-file-name buffer-file-name)))
- (munge-default-fun
- (lambda ()
- (setq minibuffer-default find-file-default)
- ;; Clear out this hook so it does not interfere
- ;; with any recursive minibuffer usage.
- (pop minibuffer-setup-hook)))
- (minibuffer-setup-hook
- minibuffer-setup-hook))
- (add-hook 'minibuffer-setup-hook munge-default-fun)
- (read-file-name prompt nil default-directory mustmatch))
+ (abbreviate-file-name buffer-file-name))))
+ (minibuffer-with-setup-hook
+ (lambda () (setq minibuffer-default find-file-default))
+ (read-file-name prompt nil default-directory mustmatch)))
t))
(defun find-file (filename &optional wildcards)
If a buffer exists visiting FILENAME, return that one, but
verify that the file has not changed since visited or saved.
The buffer is not selected, just returned to the caller.
-Optional first arg NOWARN non-nil means suppress any warning messages.
-Optional second arg RAWFILE non-nil means the file is read literally.
-Optional third arg WILDCARDS non-nil means do wildcard processing
+Optional second arg NOWARN non-nil means suppress any warning messages.
+Optional third arg RAWFILE non-nil means the file is read literally.
+Optional fourth arg WILDCARDS non-nil means do wildcard processing
and visit all the matching files. When wildcards are actually
used and expanded, return a list of buffers that are visiting
the various files."
buf)
;; Create a new buffer.
(setq buf (create-file-buffer filename))
- (set-buffer-major-mode buf)
;; find-file-noselect-1 may use a different buffer.
(find-file-noselect-1 buf filename nowarn
rawfile truename number))))))
(progn
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'no-conversion)
+ (set-buffer-major-mode buf)
(make-local-variable 'find-file-literally)
(setq find-file-literally t))
(after-find-file error (not nowarn)))
or from Lisp without specifying the optional argument FIND-FILE;
in that case, this function acts as if `enable-local-variables' were t."
(interactive)
- (or find-file (funcall (or default-major-mode 'fundamental-mode)))
- (report-errors "File mode specification error: %s"
- (set-auto-mode))
- (report-errors "File local-variables error: %s"
- (let ((enable-local-variables (or (not find-file) enable-local-variables)))
+ (funcall (or default-major-mode 'fundamental-mode))
+ (let ((enable-local-variables (or (not find-file) enable-local-variables)))
+ (report-errors "File mode specification error: %s"
+ (set-auto-mode))
+ (report-errors "File local-variables error: %s"
(hack-local-variables)))
+ ;; Turn font lock off and on, to make sure it takes account of
+ ;; whatever file local variables are relevant to it.
+ (when (and font-lock-mode (eq (car font-lock-keywords) t))
+ (setq font-lock-keywords (cadr font-lock-keywords))
+ (font-lock-mode 1))
+
(if (fboundp 'ucs-set-table-for-input) ; don't lose when building
(ucs-set-table-for-input)))
(mapc
(lambda (elt)
(cons (purecopy (car elt)) (cdr elt)))
- '(;; do this first, so that .html.pl is Polish html, not Perl
+ `(;; do this first, so that .html.pl is Polish html, not Perl
("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode)
("\\.te?xt\\'" . text-mode)
("\\.[tT]e[xX]\\'" . tex-mode)
("\\.ad[abs]\\'" . ada-mode)
("\\.ad[bs].dg\\'" . ada-mode)
("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
- ("\\.mk\\'" . makefile-mode)
- ("\\([Mm]\\|GNUm\\)akep*file\\'" . makefile-mode)
- ("\\.am\\'" . makefile-mode) ;For Automake.
+ ,@(if (memq system-type '(berkeley-unix next-mach darwin))
+ '(("\\.mk\\'" . makefile-bsdmake-mode)
+ ("GNUmakefile\\'" . makefile-gmake-mode)
+ ("[Mm]akefile\\'" . makefile-bsdmake-mode))
+ '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
+ ("[Mm]akefile\\'" . makefile-gmake-mode)))
+ ("Makeppfile\\'" . makefile-makepp-mode)
+ ("\\.am\\'" . makefile-automake-mode)
;; Less common extensions come here
;; so more common ones above are found faster.
("\\.texinfo\\'" . texinfo-mode)
("\\.pro\\'" . idlwave-mode)
("\\.prolog\\'" . prolog-mode)
("\\.tar\\'" . tar-mode)
- ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|ear\\|jar\\|war\\)\\'" . archive-mode)
- ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|EAR\\|JAR\\|WAR\\)\\'" . archive-mode)
+ ;; The list of archive file extensions should be in sync with
+ ;; `auto-coding-alist' with `no-conversion' coding system.
+ ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|[jew]ar\\|xpi\\)\\'" . archive-mode)
+ ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . archive-mode)
("\\.sx[dmicw]\\'" . archive-mode) ; OpenOffice.org
;; Mailer puts message to be edited in
;; /tmp/Re.... or Message
("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config
("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode)
- ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
- ("\\`/etc/\\(?:acpid?/.+\\|aliases\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\)\\'" . conf-mode)
+ ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
+ ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
;; either user's dot-files or under /etc or some such
("/\\.?\\(?:gnokiirc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
;; alas not all ~/.*rc files are like this
("more" . text-mode)
("less" . text-mode)
("pg" . text-mode)
- ("make" . makefile-mode) ; Debian uses this
+ ("make" . makefile-gmake-mode) ; Debian uses this
("guile" . scheme-mode)
("clisp" . lisp-mode)))
"Alist mapping interpreter names to major modes.
This is used for files whose first lines match `auto-mode-interpreter-regexp'.
Each element looks like (INTERPRETER . MODE).
-The car of each element is compared with
-the name of the interpreter specified in the first line.
-If it matches, mode MODE is selected.
+If INTERPRETER matches the name of the interpreter specified in the first line
+of a script, mode MODE is enabled.
See also `auto-mode-alist'.")
(defvar auto-mode-interpreter-regexp
"#![ \t]?\\([^ \t\n]*\
/bin/env[ \t]\\)?\\([^ \t\n]+\\)"
- "Regular expression matching interpreters, for file mode determination.
+ "Regexp matching interpreters, for file mode determination.
This regular expression is matched against the first line of a file
-to determine the file's mode in `set-auto-mode' when Emacs can't deduce
-a mode from the file's name. If it matches, the file is assumed to
-be interpreted by the interpreter matched by the second group of the
-regular expression. The mode is then determined as the mode associated
-with that interpreter in `interpreter-mode-alist'.")
+to determine the file's mode in `set-auto-mode'. If it matches, the file
+is assumed to be interpreted by the interpreter matched by the second group
+of the regular expression. The mode is then determined as the mode
+associated with that interpreter in `interpreter-mode-alist'.")
(defvar magic-mode-alist
`(;; The < comes before the groups (but the first) to reduce backtracking.
("%![^V]" . ps-mode)
("# xmcd " . conf-unix-mode))
"Alist of buffer beginnings vs. corresponding major mode functions.
-Each element looks like (REGEXP . FUNCTION). FUNCTION will be
-called, unless it is nil (to allow `auto-mode-alist' to override).")
+Each element looks like (REGEXP . FUNCTION). After visiting a file,
+if REGEXP matches the text at the beginning of the buffer,
+`normal-mode' will call FUNCTION rather than allowing `auto-mode-alist'
+to decide the buffer's major mode.
+
+If FUNCTION is nil, then it is not called. (That is a way of saying
+\"allow `auto-mode-alist' to decide for these files.\")")
(defun set-auto-mode (&optional keep-mode-if-same)
"Select major mode appropriate for current buffer.
(setq temp (cdr temp)))
(not temp))
- (search-forward "-*-" (save-excursion
- ;; If the file begins with "#!"
- ;; (exec interpreter magic), look
- ;; for mode frobs in the first two
- ;; lines. You cannot necessarily
- ;; put them in the first line of
- ;; such a file without screwing up
- ;; the interpreter invocation.
- (end-of-line (and (looking-at "^#!") 2))
- (point)) t)
+ (search-forward "-*-" (line-end-position
+ ;; If the file begins with "#!"
+ ;; (exec interpreter magic), look
+ ;; for mode frobs in the first two
+ ;; lines. You cannot necessarily
+ ;; put them in the first line of
+ ;; such a file without screwing up
+ ;; the interpreter invocation.
+ (and (looking-at "^#!") 2)) t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
- (search-forward "-*-"
- (save-excursion (end-of-line) (point))
- t))
+ (search-forward "-*-" (line-end-position) t))
(progn
(forward-char -3)
(skip-chars-backward " \t")
(goto-char beg)
end))))
+(defun hack-local-variables-confirm (string flag-to-check)
+ (or (eq flag-to-check t)
+ (and flag-to-check
+ (save-window-excursion
+ (condition-case nil
+ (switch-to-buffer (current-buffer))
+ (error
+ ;; If we fail to switch in the selected window,
+ ;; it is probably a minibuffer or dedicated window.
+ ;; So try another window.
+ (let ((pop-up-frames nil))
+ ;; Refrain from popping up frames since it can't
+ ;; be undone by save-window-excursion.
+ (pop-to-buffer (current-buffer)))))
+ (save-excursion
+ (beginning-of-line)
+ (set-window-start (selected-window) (point)))
+ (y-or-n-p (format string
+ (if buffer-file-name
+ (file-name-nondirectory buffer-file-name)
+ (concat "buffer " (buffer-name)))))))))
+
(defun hack-local-variables-prop-line (&optional mode-only)
"Set local variables specified in the -*- line.
Ignore any specification for `mode:' and `coding:';
(if mode-only mode-specified
(if (and result
(or mode-only
- (eq enable-local-variables t)
- (and enable-local-variables
- (save-window-excursion
- (condition-case nil
- (switch-to-buffer (current-buffer))
- (error
- ;; If we fail to switch in the selected window,
- ;; it is probably a minibuffer.
- ;; So try another window.
- (condition-case nil
- (switch-to-buffer-other-window (current-buffer))
- (error
- (switch-to-buffer-other-frame (current-buffer))))))
- (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
- (file-name-nondirectory buffer-file-name)))))))
+ (hack-local-variables-confirm
+ "Set local variables as specified in -*- line of %s? "
+ enable-local-variables)))
(let ((enable-local-eval enable-local-eval))
(while result
(hack-one-local-variable (car (car result)) (cdr (car result)))
(search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
(when (let ((case-fold-search t))
(and (search-forward "Local Variables:" nil t)
- (or (eq enable-local-variables t)
- mode-only
- (and enable-local-variables
- (save-window-excursion
- (switch-to-buffer (current-buffer))
- (save-excursion
- (beginning-of-line)
- (set-window-start (selected-window) (point)))
- (y-or-n-p (format "Set local variables as specified at end of %s? "
- (if buffer-file-name
- (file-name-nondirectory
- buffer-file-name)
- (concat "buffer "
- (buffer-name))))))))))
+ (or mode-only
+ (hack-local-variables-confirm
+ "Set local variables as specified at end of %s? "
+ enable-local-variables))))
(skip-chars-forward " \t")
(let ((enable-local-eval enable-local-eval)
;; suffix is what comes after "local variables:" in its line.
dangerous."
(let ((safep (get sym 'safe-local-variable)))
(or (get sym 'risky-local-variable)
- (and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
+ (and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-commands?$\\|-predicates?$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
(symbol-name sym))
(not safep))
;; If the safe-local-variable property isn't t or nil,
(hack-one-local-variable-eval-safep val))
;; Permit eval if not root and user says ok.
(and (not (zerop (user-uid)))
- (or (eq enable-local-eval t)
- (and enable-local-eval
- (save-window-excursion
- (switch-to-buffer (current-buffer))
- (save-excursion
- (beginning-of-line)
- (set-window-start (selected-window) (point)))
- (setq enable-local-eval
- (y-or-n-p (format "Process `eval' or hook local variables in %s? "
- (if buffer-file-name
- (concat "file " (file-name-nondirectory buffer-file-name))
- (concat "buffer " (buffer-name)))))))))))
+ (hack-local-variables-confirm
+ "Process `eval' or hook local variables in %s? "
+ enable-local-eval)))
(if (eq var 'eval)
(save-excursion (eval val))
(make-local-variable var)
(setq truename (file-truename filename))
(if find-file-visit-truename
(setq filename truename))))
+ (if filename
+ (let ((new-name (file-name-nondirectory filename)))
+ (if (string= new-name "")
+ (error "Empty file name"))))
(let ((buffer (and filename (find-buffer-visiting filename))))
(and buffer (not (eq buffer (current-buffer)))
(not no-query)
(setq buffer-file-name filename)
(if filename ; make buffer name reflect filename.
(let ((new-name (file-name-nondirectory buffer-file-name)))
- (if (string= new-name "")
- (error "Empty file name"))
(if (eq system-type 'vax-vms)
(setq new-name (downcase new-name)))
(setq default-directory (file-name-directory buffer-file-name))
backup-by-copying
;; Don't rename a suid or sgid file.
(and modes (< 0 (logand modes #o6000)))
+ (not (file-writable-p (file-name-directory real-file-name)))
(and backup-by-copying-when-linked
(> (file-nlinks real-file-name) 1))
(and (or backup-by-copying-when-mismatch
(file-error nil))))))
(defun backup-buffer-copy (from-name to-name modes)
- (condition-case ()
- (copy-file from-name to-name t t)
- (file-error
- ;; If copying fails because file TO-NAME
- ;; is not writable, delete that file and try again.
- (if (and (file-exists-p to-name)
- (not (file-writable-p to-name)))
- (delete-file to-name))
- (copy-file from-name to-name t t)))
+ (let ((umask (default-file-modes)))
+ (unwind-protect
+ (progn
+ ;; Create temp files with strict access rights. It's easy to
+ ;; loosen them later, whereas it's impossible to close the
+ ;; time-window of loose permissions otherwise.
+ (set-default-file-modes ?\700)
+ (while (condition-case ()
+ (progn
+ (condition-case nil
+ (delete-file to-name)
+ (file-error nil))
+ (copy-file from-name to-name t t 'excl)
+ nil)
+ (file-already-exists t))
+ ;; The file was somehow created by someone else between
+ ;; `delete-file' and `copy-file', so let's try again.
+ nil))
+ ;; Reset the umask.
+ (set-default-file-modes umask)))
(and modes
(set-file-modes to-name (logand modes #o1777))))
(defcustom make-backup-file-name-function nil
"A function to use instead of the default `make-backup-file-name'.
-A value of nil gives the default `make-backup-file-name' behaviour.
+A value of nil gives the default `make-backup-file-name' behavior.
This could be buffer-local to do something special for specific
files. If you define it, you may need to change `backup-file-name-p'
the index in the name where the version number begins."
(if (and (string-match "[0-9]+~$" fn backup-extract-version-start)
(= (match-beginning 0) backup-extract-version-start))
- (string-to-int (substring fn backup-extract-version-start -1))
+ (string-to-number (substring fn backup-extract-version-start -1))
0))
;; I believe there is no need to alter this behavior for VMS;
ancestor))))))
\f
(defun save-buffer (&optional args)
- "Save current buffer in visited file if modified. Versions described below.
+ "Save current buffer in visited file if modified. Variations are described below.
By default, makes the previous version into a backup file
if previously requested or if this is the first save.
-With 1 \\[universal-argument], marks this version
+Prefixed with one \\[universal-argument], marks this version
to become a backup when the next save is done.
-With 2 \\[universal-argument]'s,
+Prefixed with two \\[universal-argument]'s,
unconditionally makes the previous version into a backup file.
-With 3 \\[universal-argument]'s, marks this version
+Prefixed with three \\[universal-argument]'s, marks this version
to become a backup when the next save is done,
and unconditionally makes the previous version into a backup file.
-With argument of 0, never make the previous version into a backup file.
+With a numeric argument of 0, never make the previous version
+into a backup file.
If a file's name is FOO, the names of its numbered backup versions are
FOO.~i~ for various integers i. A non-numbered backup file is called FOO~.
"Save the current buffer in its visited file, if it has been modified.
The hooks `write-contents-functions' and `write-file-functions' get a chance
to do the job of saving; if they do not, then the buffer is saved in
-the visited file file in the usual way.
+the visited file in the usual way.
Before and after saving the buffer, this function runs
`before-save-hook' and `after-save-hook', respectively."
(interactive)
;; This requires write access to the containing dir,
;; which is why we don't try it if we don't have that access.
(let ((realname buffer-file-name)
- tempname nogood i succeed
+ tempname succeed
+ (umask (default-file-modes))
(old-modtime (visited-file-modtime)))
- (setq i 0)
- (setq nogood t)
- ;; Find the temporary name to write under.
- (while nogood
- (setq tempname (format
- (if (and (eq system-type 'ms-dos)
- (not (msdos-long-file-names)))
- "%s#%d.tm#" ; MSDOS limits files to 8+3
- (if (memq system-type '(vax-vms axp-vms))
- "%s$tmp$%d"
- "%s#tmp#%d"))
- dir i))
- (setq nogood (file-exists-p tempname))
- (setq i (1+ i)))
+ ;; Create temp files with strict access rights. It's easy to
+ ;; loosen them later, whereas it's impossible to close the
+ ;; time-window of loose permissions otherwise.
(unwind-protect
- (progn (clear-visited-file-modtime)
- (write-region (point-min) (point-max)
- tempname nil realname
- buffer-file-truename)
- (setq succeed t))
- ;; If writing the temp file fails,
- ;; delete the temp file.
- (or succeed
- (progn
- (condition-case nil
- (delete-file tempname)
- (file-error nil))
- (set-visited-file-modtime old-modtime))))
- ;; Since we have created an entirely new file
- ;; and renamed it, make sure it gets the
- ;; right permission bits set.
+ (progn
+ (clear-visited-file-modtime)
+ (set-default-file-modes ?\700)
+ ;; Try various temporary names.
+ ;; This code follows the example of make-temp-file,
+ ;; but it calls write-region in the appropriate way
+ ;; for saving the buffer.
+ (while (condition-case ()
+ (progn
+ (setq tempname
+ (make-temp-name
+ (expand-file-name "tmp" dir)))
+ (write-region (point-min) (point-max)
+ tempname nil realname
+ buffer-file-truename 'excl)
+ nil)
+ (file-already-exists t))
+ ;; The file was somehow created by someone else between
+ ;; `make-temp-name' and `write-region', let's try again.
+ nil)
+ (setq succeed t))
+ ;; Reset the umask.
+ (set-default-file-modes umask)
+ ;; If we failed, restore the buffer's modtime.
+ (unless succeed
+ (set-visited-file-modtime old-modtime)))
+ ;; Since we have created an entirely new file,
+ ;; make sure it gets the right permission bits set.
(setq setmodes (or setmodes (cons (file-modes buffer-file-name)
buffer-file-name)))
;; We succeeded in writing the temp file,
(recursive-edit)
;; Return nil to ask about BUF again.
nil)
- "display the current buffer")
+ "view this file")
(?d diff-buffer-with-file
- "show difference to last saved version"))
+ "view changes in file"))
"ACTION-ALIST argument used in call to `map-y-or-n-p'.")
(put 'save-some-buffers-action-alist 'risky-local-variable t)
"Save some modified file-visiting buffers. Asks user about each one.
You can answer `y' to save, `n' not to save, `C-r' to look at the
buffer in question with `view-buffer' before deciding or `d' to
-view the differences using `diff-buffer-to-file'.
+view the differences using `diff-buffer-with-file'.
Optional argument (the prefix) non-nil means save all with no questions.
Optional second argument PRED determines which buffers are considered:
(defvar buffer-stale-function nil
"Function to check whether a non-file buffer needs reverting.
This should be a function with one optional argument NOCONFIRM.
-Auto Revert Mode sets NOCONFIRM to t. The function should return
+Auto Revert Mode passes t for NOCONFIRM. The function should return
non-nil if the buffer should be reverted. A return value of
`fast' means that the need for reverting was not checked, but
that reverting the buffer is fast. The buffer is current when
(interactive (list (not current-prefix-arg)))
(if revert-buffer-function
(funcall revert-buffer-function ignore-auto noconfirm)
- (let* ((auto-save-p (and (not ignore-auto)
- (recent-auto-save-p)
- buffer-auto-save-file-name
- (file-readable-p buffer-auto-save-file-name)
- (y-or-n-p
- "Buffer has been auto-saved recently. Revert from auto-save file? ")))
- (file-name (if auto-save-p
- buffer-auto-save-file-name
- buffer-file-name)))
- (cond ((null file-name)
- (error "Buffer does not seem to be associated with any file"))
- ((or noconfirm
- (and (not (buffer-modified-p))
- (let ((tail revert-without-query)
- (found nil))
- (while tail
- (if (string-match (car tail) file-name)
- (setq found t))
- (setq tail (cdr tail)))
- found))
- (yes-or-no-p (format "Revert buffer from file %s? "
- file-name)))
- (run-hooks 'before-revert-hook)
- ;; If file was backed up but has changed since,
- ;; we shd make another backup.
- (and (not auto-save-p)
- (not (verify-visited-file-modtime (current-buffer)))
- (setq buffer-backed-up nil))
- ;; Get rid of all undo records for this buffer.
- (or (eq buffer-undo-list t)
- (setq buffer-undo-list nil))
- ;; Effectively copy the after-revert-hook status,
- ;; since after-find-file will clobber it.
- (let ((global-hook (default-value 'after-revert-hook))
- (local-hook-p (local-variable-p 'after-revert-hook))
- (local-hook (and (local-variable-p 'after-revert-hook)
- after-revert-hook)))
- (let (buffer-read-only
- ;; Don't make undo records for the reversion.
- (buffer-undo-list t))
- (if revert-buffer-insert-file-contents-function
- (funcall revert-buffer-insert-file-contents-function
- file-name auto-save-p)
- (if (not (file-exists-p file-name))
- (error (if buffer-file-number
- "File %s no longer exists!"
- "Cannot revert nonexistent file %s")
- file-name))
- ;; Bind buffer-file-name to nil
- ;; so that we don't try to lock the file.
- (let ((buffer-file-name nil))
- (or auto-save-p
- (unlock-buffer)))
- (widen)
- (let ((coding-system-for-read
- ;; Auto-saved file shoule be read by Emacs'
- ;; internal coding.
- (if auto-save-p 'auto-save-coding
- (or coding-system-for-read
- buffer-file-coding-system-explicit))))
- ;; This force after-insert-file-set-coding
- ;; (called from insert-file-contents) to set
- ;; buffer-file-coding-system to a proper value.
- (kill-local-variable 'buffer-file-coding-system)
-
- ;; Note that this preserves point in an intelligent way.
- (if preserve-modes
- (let ((buffer-file-format buffer-file-format))
- (insert-file-contents file-name (not auto-save-p)
- nil nil t))
- (insert-file-contents file-name (not auto-save-p)
- nil nil t)))))
- ;; Recompute the truename in case changes in symlinks
- ;; have changed the truename.
- (setq buffer-file-truename
- (abbreviate-file-name (file-truename buffer-file-name)))
- (after-find-file nil nil t t preserve-modes)
- ;; Run after-revert-hook as it was before we reverted.
- (setq-default revert-buffer-internal-hook global-hook)
- (if local-hook-p
- (set (make-local-variable 'revert-buffer-internal-hook)
- local-hook)
- (kill-local-variable 'revert-buffer-internal-hook))
- (run-hooks 'revert-buffer-internal-hook))
- t)))))
+ (with-current-buffer (or (buffer-base-buffer (current-buffer))
+ (current-buffer))
+ (let* ((auto-save-p (and (not ignore-auto)
+ (recent-auto-save-p)
+ buffer-auto-save-file-name
+ (file-readable-p buffer-auto-save-file-name)
+ (y-or-n-p
+ "Buffer has been auto-saved recently. Revert from auto-save file? ")))
+ (file-name (if auto-save-p
+ buffer-auto-save-file-name
+ buffer-file-name)))
+ (cond ((null file-name)
+ (error "Buffer does not seem to be associated with any file"))
+ ((or noconfirm
+ (and (not (buffer-modified-p))
+ (let ((tail revert-without-query)
+ (found nil))
+ (while tail
+ (if (string-match (car tail) file-name)
+ (setq found t))
+ (setq tail (cdr tail)))
+ found))
+ (yes-or-no-p (format "Revert buffer from file %s? "
+ file-name)))
+ (run-hooks 'before-revert-hook)
+ ;; If file was backed up but has changed since,
+ ;; we shd make another backup.
+ (and (not auto-save-p)
+ (not (verify-visited-file-modtime (current-buffer)))
+ (setq buffer-backed-up nil))
+ ;; Get rid of all undo records for this buffer.
+ (or (eq buffer-undo-list t)
+ (setq buffer-undo-list nil))
+ ;; Effectively copy the after-revert-hook status,
+ ;; since after-find-file will clobber it.
+ (let ((global-hook (default-value 'after-revert-hook))
+ (local-hook-p (local-variable-p 'after-revert-hook))
+ (local-hook (and (local-variable-p 'after-revert-hook)
+ after-revert-hook)))
+ (let (buffer-read-only
+ ;; Don't make undo records for the reversion.
+ (buffer-undo-list t))
+ (if revert-buffer-insert-file-contents-function
+ (funcall revert-buffer-insert-file-contents-function
+ file-name auto-save-p)
+ (if (not (file-exists-p file-name))
+ (error (if buffer-file-number
+ "File %s no longer exists!"
+ "Cannot revert nonexistent file %s")
+ file-name))
+ ;; Bind buffer-file-name to nil
+ ;; so that we don't try to lock the file.
+ (let ((buffer-file-name nil))
+ (or auto-save-p
+ (unlock-buffer)))
+ (widen)
+ (let ((coding-system-for-read
+ ;; Auto-saved file shoule be read by Emacs'
+ ;; internal coding.
+ (if auto-save-p 'auto-save-coding
+ (or coding-system-for-read
+ buffer-file-coding-system-explicit))))
+ ;; This force after-insert-file-set-coding
+ ;; (called from insert-file-contents) to set
+ ;; buffer-file-coding-system to a proper value.
+ (kill-local-variable 'buffer-file-coding-system)
+
+ ;; Note that this preserves point in an intelligent way.
+ (if preserve-modes
+ (let ((buffer-file-format buffer-file-format))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t))
+ (insert-file-contents file-name (not auto-save-p)
+ nil nil t)))))
+ ;; Recompute the truename in case changes in symlinks
+ ;; have changed the truename.
+ (setq buffer-file-truename
+ (abbreviate-file-name (file-truename buffer-file-name)))
+ (after-find-file nil nil t t preserve-modes)
+ ;; Run after-revert-hook as it was before we reverted.
+ (setq-default revert-buffer-internal-hook global-hook)
+ (if local-hook-p
+ (set (make-local-variable 'revert-buffer-internal-hook)
+ local-hook)
+ (kill-local-variable 'revert-buffer-internal-hook))
+ (run-hooks 'revert-buffer-internal-hook))
+ t))))))
(defun recover-this-file ()
"Recover the visited file--get contents from its last auto-save file."
(while list
(let* ((buffer (car list))
(name (buffer-name buffer)))
- (and (not (string-equal name ""))
- (/= (aref name 0) ? )
+ (and name ; Can be nil for an indirect buffer
+ ; if we killed the base buffer.
+ (not (string-equal name ""))
+ (/= (aref name 0) ?\s)
(yes-or-no-p
(format "Buffer %s %s. Kill? "
name
before calling this function. You can redefine this for customization.
See also `auto-save-file-name-p'."
(if buffer-file-name
- (let ((list auto-save-file-name-transforms)
- (filename buffer-file-name)
- result uniq)
- ;; Apply user-specified translations
- ;; to the file name.
- (while (and list (not result))
- (if (string-match (car (car list)) filename)
- (setq result (replace-match (cadr (car list)) t nil
- filename)
- uniq (car (cddr (car list)))))
- (setq list (cdr list)))
- (if result
- (if uniq
- (setq filename (concat
- (file-name-directory result)
- (subst-char-in-string
- ?/ ?!
- (replace-regexp-in-string "!" "!!"
- filename))))
- (setq filename result)))
- (setq result
- (if (and (eq system-type 'ms-dos)
- (not (msdos-long-file-names)))
- ;; We truncate the file name to DOS 8+3 limits
- ;; before doing anything else, because the regexp
- ;; passed to string-match below cannot handle
- ;; extensions longer than 3 characters, multiple
- ;; dots, and other atrocities.
- (let ((fn (dos-8+3-filename
- (file-name-nondirectory buffer-file-name))))
- (string-match
- "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
- fn)
- (concat (file-name-directory buffer-file-name)
- "#" (match-string 1 fn)
- "." (match-string 3 fn) "#"))
- (concat (file-name-directory filename)
- "#"
- (file-name-nondirectory filename)
- "#")))
- ;; Make sure auto-save file names don't contain characters
- ;; invalid for the underlying filesystem.
- (if (and (memq system-type '(ms-dos windows-nt))
- ;; Don't modify remote (ange-ftp) filenames
- (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
- (convert-standard-filename result)
- result))
+ (let ((handler (find-file-name-handler buffer-file-name
+ 'make-auto-save-file-name)))
+ (if handler
+ (funcall handler 'make-auto-save-file-name)
+ (let ((list auto-save-file-name-transforms)
+ (filename buffer-file-name)
+ result uniq)
+ ;; Apply user-specified translations
+ ;; to the file name.
+ (while (and list (not result))
+ (if (string-match (car (car list)) filename)
+ (setq result (replace-match (cadr (car list)) t nil
+ filename)
+ uniq (car (cddr (car list)))))
+ (setq list (cdr list)))
+ (if result
+ (if uniq
+ (setq filename (concat
+ (file-name-directory result)
+ (subst-char-in-string
+ ?/ ?!
+ (replace-regexp-in-string "!" "!!"
+ filename))))
+ (setq filename result)))
+ (setq result
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ ;; We truncate the file name to DOS 8+3 limits
+ ;; before doing anything else, because the regexp
+ ;; passed to string-match below cannot handle
+ ;; extensions longer than 3 characters, multiple
+ ;; dots, and other atrocities.
+ (let ((fn (dos-8+3-filename
+ (file-name-nondirectory buffer-file-name))))
+ (string-match
+ "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
+ fn)
+ (concat (file-name-directory buffer-file-name)
+ "#" (match-string 1 fn)
+ "." (match-string 3 fn) "#"))
+ (concat (file-name-directory filename)
+ "#"
+ (file-name-nondirectory filename)
+ "#")))
+ ;; Make sure auto-save file names don't contain characters
+ ;; invalid for the underlying filesystem.
+ (if (and (memq system-type '(ms-dos windows-nt))
+ ;; Don't modify remote (ange-ftp) filenames
+ (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result)))
+ (convert-standard-filename result)
+ result))))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
:group 'dired)
(defun get-free-disk-space (dir)
- "Return the mount of free space on directory DIR's file system.
+ "Return the amount of free space on directory DIR's file system.
The result is a string that gives the number of free 1KB blocks,
-or nil if the system call or the program which retrieve the infornmation
+or nil if the system call or the program which retrieve the information
fail.
This function calls `file-system-info' if it is available, or invokes the
(if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out)
(let* ((version (match-string 1 version-out))
(split (split-string version "[.]"))
- (numbers (mapcar 'string-to-int split))
+ (numbers (mapcar 'string-to-number split))
(min '(5 2 1))
comparison)
(while (and (not comparison) (or numbers min))
(end (insert-directory-adj-pos
(+ beg (read (current-buffer)))
error-lines)))
- (if (memq (char-after end) '(?\n ?\ ))
+ (if (memq (char-after end) '(?\n ?\s))
;; End is followed by \n or by " -> ".
(put-text-property start end 'dired-filename t)
;; It seems that we can't trust ls's output as to
((eq method 'add)
(concat "/:" (apply operation arguments)))
((eq method 'quote)
- (prog1 (apply operation arguments)
+ (unwind-protect
+ (apply operation arguments)
(setq buffer-file-name (concat "/:" buffer-file-name))))
((eq method 'unquote-then-quote)
(let (res)
(define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
-;;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f
+;; arch-tag: bc68d3ea-19ca-468b-aac6-3a4a7766101f
;;; files.el ends here
HCoop / bpt / emacs.git / blobdiff