X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/08adf84e8b9381992f8a7cc22c421bf414049b4a..ca088b04376178d1305ff9d0866c20263f4a79bf:/lisp/files.el diff --git a/lisp/files.el b/lisp/files.el index 0a91cf2c24..d3764c47a8 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1,7 +1,7 @@ ;;; files.el --- file input and output commands for Emacs -;; Copyright (C) 1985,86,87,92,93,94,95,96,97,98,99,2000,01,02,03,2004 -;;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998, +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF @@ -273,14 +273,46 @@ Includes the new backup. Must be > 0" :group 'backup) (defcustom require-final-newline nil - "*Value of t says silently ensure a file ends in a newline when it is saved. -Non-nil but not t says ask user whether to add a newline when there isn't one. -nil means don't add newlines." - :type '(choice (const :tag "Off" nil) - (const :tag "Add" t) - (other :tag "Ask" ask)) + "*Whether to add a newline automatically at the end of the file. + +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. +nil means don't add newlines. + +Certain major modes set this locally to the value obtained +from `mode-require-final-newline'." + :type '(choice (const :tag "When visiting" visit) + (const :tag "When saving" t) + (const :tag "When visiting or saving" visit-save) + (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 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 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. + +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) + (const :tag "Don't add newlines" nil) + (other :tag "Ask each time" ask)) + :group 'editing-basics + :version "22.1") + (defcustom auto-save-default t "*Non-nil says by default do auto-saving of every file-visiting buffer." :type 'boolean @@ -351,7 +383,7 @@ 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 "21.4") + '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) @@ -362,9 +394,9 @@ functions are called." :group 'find-file :type 'hook :options '(auto-insert) - :version "21.4") + :version "22.1") (defvaralias 'find-file-hooks 'find-file-hook) -(make-obsolete-variable 'find-file-hooks 'find-file-hook "21.4") +(make-obsolete-variable '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. @@ -383,12 +415,12 @@ node `(elisp)Saving Buffers'.) To perform various checks or 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 "21.4") +(make-obsolete-variable 'write-file-hooks 'write-file-functions "22.1") (defvar local-write-file-hooks nil) (make-variable-buffer-local 'local-write-file-hooks) (put 'local-write-file-hooks 'permanent-local t) -(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "21.4") +(make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1") (defvar write-contents-functions nil "List of functions to be called before writing out a buffer to a file. @@ -408,7 +440,7 @@ 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 "21.4") +(make-obsolete-variable 'write-contents-hooks 'write-contents-functions "22.1") (defcustom enable-local-variables t "*Control use of local variables in files you visit. @@ -482,6 +514,10 @@ Runs the usual ange-ftp hook, but only for completion operations." 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 @@ -497,8 +533,8 @@ See Info node `(elisp)Standard File Names' for more details." 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.) @@ -509,10 +545,10 @@ DIR should be an absolute directory name. It defaults to 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)) @@ -597,8 +633,13 @@ The path separator is colon in GNU and GNU-like systems." (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. @@ -617,7 +658,7 @@ one or more of those symbols." (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) @@ -639,6 +680,13 @@ PATH-AND-SUFFIXES is a pair of lists (DIRECTORIES . SUFFIXES)." ((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'." @@ -902,20 +950,32 @@ documentation for additional customization information." (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) @@ -932,8 +992,7 @@ suppress wildcard expansion by setting `find-file-wildcards'. To visit a file without any kind of conversion and without automatically choosing a major mode, use \\[find-file-literally]." - (interactive - (find-file-read-args "Find file: " nil)) + (interactive (find-file-read-args "Find file: " nil)) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) (mapcar 'switch-to-buffer (nreverse value)) @@ -955,8 +1014,8 @@ expand wildcards (if any) and visit multiple files." (if (listp value) (progn (setq value (nreverse value)) - (switch-to-buffer-other-window (car value)) - (mapcar 'switch-to-buffer (cdr value))) + (cons (switch-to-buffer-other-window (car value)) + (mapcar 'switch-to-buffer (cdr value)))) (switch-to-buffer-other-window value)))) (defun find-file-other-frame (filename &optional wildcards) @@ -975,8 +1034,8 @@ expand wildcards (if any) and visit multiple files." (if (listp value) (progn (setq value (nreverse value)) - (switch-to-buffer-other-frame (car value)) - (mapcar 'switch-to-buffer (cdr value))) + (cons (switch-to-buffer-other-frame (car value)) + (mapcar 'switch-to-buffer (cdr value)))) (switch-to-buffer-other-frame value)))) (defun find-file-existing (filename &optional wildcards) @@ -991,35 +1050,53 @@ Like \\[find-file] but only allow files that exists." "Edit file FILENAME but don't allow changes. Like \\[find-file] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only: " t)) - (unless (file-exists-p filename) (error "%s does not exist" filename)) - (find-file filename wildcards) - (toggle-read-only 1) - (current-buffer)) + (interactive (find-file-read-args "Find file read-only: " nil)) + (unless (or (and wildcards find-file-wildcards + (not (string-match "\\`/:" filename)) + (string-match "[[*?]" filename)) + (file-exists-p filename)) + (error "%s does not exist" filename)) + (let ((value (find-file filename wildcards))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) (defun find-file-read-only-other-window (filename &optional wildcards) "Edit file FILENAME in another window but don't allow changes. Like \\[find-file-other-window] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only other window: " t)) - (unless (file-exists-p filename) (error "%s does not exist" filename)) - (find-file-other-window filename wildcards) - (toggle-read-only 1) - (current-buffer)) + (interactive (find-file-read-args "Find file read-only other window: " nil)) + (unless (or (and wildcards find-file-wildcards + (not (string-match "\\`/:" filename)) + (string-match "[[*?]" filename)) + (file-exists-p filename)) + (error "%s does not exist" filename)) + (let ((value (find-file-other-window filename wildcards))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) (defun find-file-read-only-other-frame (filename &optional wildcards) "Edit file FILENAME in another frame but don't allow changes. Like \\[find-file-other-frame] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only other frame: " t)) - (unless (file-exists-p filename) (error "%s does not exist" filename)) - (find-file-other-frame filename wildcards) - (toggle-read-only 1) - (current-buffer)) - -(defun find-alternate-file-other-window (filename) + (interactive (find-file-read-args "Find file read-only other frame: " nil)) + (unless (or (and wildcards find-file-wildcards + (not (string-match "\\`/:" filename)) + (string-match "[[*?]" filename)) + (file-exists-p filename)) + (error "%s does not exist" filename)) + (let ((value (find-file-other-frame filename wildcards))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) + +(defun find-alternate-file-other-window (filename &optional wildcards) "Find file FILENAME as a replacement for the file in the next window. -This command does not select that window." +This command does not select that window. + +Interactively, or if WILDCARDS is non-nil in a call from Lisp, +expand wildcards (if any) and replace the file with multiple files." (interactive (save-selected-window (other-window 1) @@ -1030,17 +1107,21 @@ This command does not select that window." (setq file-name (file-name-nondirectory file) file-dir (file-name-directory file))) (list (read-file-name - "Find alternate file: " file-dir nil nil file-name))))) + "Find alternate file: " file-dir nil nil file-name) + t)))) (if (one-window-p) - (find-file-other-window filename) + (find-file-other-window filename wildcards) (save-selected-window (other-window 1) - (find-alternate-file filename)))) + (find-alternate-file filename wildcards)))) -(defun find-alternate-file (filename) +(defun find-alternate-file (filename &optional wildcards) "Find file FILENAME, select its buffer, kill previous buffer. If the current buffer now contains an empty file that you just visited -\(presumably by mistake), use this command to visit the file you really want." +\(presumably by mistake), use this command to visit the file you really want. + +Interactively, or if WILDCARDS is non-nil in a call from Lisp, +expand wildcards (if any) and replace the file with multiple files." (interactive (let ((file buffer-file-name) (file-name nil) @@ -1049,7 +1130,8 @@ If the current buffer now contains an empty file that you just visited (setq file-name (file-name-nondirectory file) file-dir (file-name-directory file))) (list (read-file-name - "Find alternate file: " file-dir nil nil file-name)))) + "Find alternate file: " file-dir nil nil file-name) + t))) (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions) (error "Aborted")) (when (and (buffer-modified-p) (buffer-file-name)) @@ -1077,7 +1159,7 @@ If the current buffer now contains an empty file that you just visited (setq buffer-file-truename nil) ;; Likewise for dired buffers. (setq dired-directory nil) - (find-file filename)) + (find-file filename wildcards)) (when (eq obuf (current-buffer)) ;; This executes if find-file gets an error ;; and does not really find anything. @@ -1178,7 +1260,8 @@ name to this list as a string." "Return the buffer visiting file FILENAME (a string). This is like `get-file-buffer', except that it checks for any buffer visiting the same file, possibly under a different name. -If PREDICATE is non-nil, only a buffer satisfying it can be returned. +If PREDICATE is non-nil, only buffers satisfying it are eligible, +and others are ignored. If there is no such live buffer, return nil." (let ((predicate (or predicate #'identity)) (truename (abbreviate-file-name (file-truename filename)))) @@ -1235,7 +1318,7 @@ suppresses this warning." When nil, never request confirmation." :group 'files :group 'find-file - :version "21.4" + :version "22.1" :type '(choice integer (const :tag "Never request confirmation" nil))) (defun find-file-noselect (filename &optional nowarn rawfile wildcards) @@ -1247,8 +1330,8 @@ 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 and visit all the matching files. When wildcards are actually -used and expanded, the value is a list of buffers -that are visiting the various files." +used and expanded, return a list of buffers that are visiting +the various files." (setq filename (abbreviate-file-name (expand-file-name filename))) @@ -1604,6 +1687,15 @@ unless NOMODES is non-nil." (when (and view-read-only view-mode) (view-mode-disable)) (normal-mode t) + ;; If requested, add a newline at the end of the file. + (and (memq require-final-newline '(visit visit-save)) + (> (point-max) (point-min)) + (/= (char-after (1- (point-max))) ?\n) + (not (and (eq selective-display t) + (= (char-after (1- (point-max))) ?\r))) + (save-excursion + (goto-char (point-max)) + (insert "\n"))) (when (and buffer-read-only view-read-only (not (eq (get major-mode 'mode-class) 'special))) @@ -1640,10 +1732,10 @@ 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))) + (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))) (if (fboundp 'ucs-set-table-for-input) ; don't lose when building (ucs-set-table-for-input))) @@ -1656,7 +1748,7 @@ in that case, this function acts as if `enable-local-variables' were t." (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) @@ -1674,9 +1766,14 @@ in that case, this function acts as if `enable-local-variables' were t." ("\\.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. + ("GNUmakefile\\'" . makefile-gmake-mode) + ,@(if (memq system-type '(berkeley-unix next-mach darwin)) + '(("\\.mk\\'" . makefile-bsdmake-mode) + ("[Mm]akefile\\'" . makefile-bsdmake-mode)) + '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage + ("[Mm]akefile\\'" . makefile-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) @@ -1717,8 +1814,10 @@ in that case, this function acts as if `enable-local-variables' were t." ("\\.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 @@ -1757,6 +1856,7 @@ in that case, this function acts as if `enable-local-variables' were t." ("\\.ses\\'" . ses-mode) ("\\.\\(soa\\|zone\\)\\'" . dns-mode) ("\\.docbook\\'" . sgml-mode) + ("\\.com\\'" . dcl-mode) ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) ;; Windows candidates may be opened case sensitively on Unix ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) @@ -1766,8 +1866,8 @@ in that case, this function acts as if `enable-local-variables' were t." ("\\.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/\\(?:default/.*\\|aliases\\|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 @@ -1797,8 +1897,14 @@ mode function to use. FUNCTION will be called, unless it is nil. If the element has the form (REGEXP FUNCTION NON-NIL), then after calling FUNCTION (if it's not nil), we delete the suffix that matched -REGEXP and search the list again for another match.") +REGEXP and search the list again for another match. + +If the file name matches `inhibit-first-line-modes-regexps', +then `auto-mode-alist' is not processed. +See also `interpreter-mode-alist', which detects executable script modes +based on the interpreters they specify to run, +and `magic-mode-alist', which determines modes based on file contents.") (defvar interpreter-mode-alist ;; Note: The entries for the modes defined in cc-mode.el (awk-mode @@ -1839,15 +1945,17 @@ REGEXP and search the list again for another match.") ("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 alist applies to files whose first line starts with `#!'. +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 car of each element, a regular expression, is compared with the name of the interpreter specified in the first line. -If it matches, mode MODE is selected.") +If it matches, mode MODE is selected. + +See also `auto-mode-alist'.") (defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'") "List of regexps; if one matches a file name, don't look for `-*-'.") @@ -1860,13 +1968,12 @@ from the end of the file name anything that matches one of these regexps.") (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. @@ -1876,17 +1983,24 @@ with that interpreter in `interpreter-mode-alist'.") (concat "\\(?:<\\?xml\\s +[^>]*>\\)?\\s *<" comment-re "*" "\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\s *" comment-re "*\\)?" - "[Hh][Tt][Mm][Ll]")) . html-mode) + "[Hh][Tt][Mm][Ll]")) + . html-mode) ;; These two must come after html, because they are more general: ("<\\?xml " . xml-mode) (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") (comment-re (concat "\\(?:!--" incomment-re "*-->\\s *<\\)"))) - (concat "\\s *<" comment-re "*!DOCTYPE ")) . sgml-mode) + (concat "\\s *<" comment-re "*!DOCTYPE ")) + . sgml-mode) ("%![^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. @@ -2025,22 +2139,19 @@ Otherwise, return nil; point may be changed." (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") @@ -2048,6 +2159,28 @@ Otherwise, return nil; point may be changed." (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:'; @@ -2102,21 +2235,9 @@ is specified, returning t if it is specified." (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))) @@ -2143,94 +2264,77 @@ is specified, returning t if it is specified." (save-excursion (goto-char (point-max)) (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) - (if (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)))))))))) - (let (prefix prefixlen suffix beg - (enable-local-eval enable-local-eval)) - ;; The prefix is what comes before "local variables:" in its line. - ;; The suffix is what comes after "local variables:" in its line. - (skip-chars-forward " \t") - (or (eolp) - (setq suffix (buffer-substring (point) - (progn (end-of-line) (point))))) - (goto-char (match-beginning 0)) - (or (bolp) - (setq prefix - (buffer-substring (point) - (progn (beginning-of-line) (point))))) - - (if prefix (setq prefixlen (length prefix) - prefix (regexp-quote prefix))) - (if suffix (setq suffix (concat (regexp-quote suffix) "$"))) - (forward-line 1) - (let ((startpos (point)) - endpos - (thisbuf (current-buffer))) - (save-excursion - (if (not (re-search-forward - (concat (or prefix "") - "[ \t]*End:[ \t]*" - (or suffix "")) - nil t)) - (error "Local variables list is not properly terminated")) - (beginning-of-line) - (setq endpos (point))) - - (with-temp-buffer - (insert-buffer-substring thisbuf startpos endpos) - (goto-char (point-min)) - (subst-char-in-region (point) (point-max) - ?\^m ?\n) - (while (not (eobp)) - ;; Discard the prefix, if any. - (if prefix - (if (looking-at prefix) - (delete-region (point) (match-end 0)) - (error "Local variables entry is missing the prefix"))) - (end-of-line) - ;; Discard the suffix, if any. - (if suffix - (if (looking-back suffix) - (delete-region (match-beginning 0) (point)) - (error "Local variables entry is missing the suffix"))) - (forward-line 1)) - (goto-char (point-min)) - - (while (not (eobp)) - ;; Find the variable name; strip whitespace. - (skip-chars-forward " \t") - (setq beg (point)) - (skip-chars-forward "^:\n") - (if (eolp) (error "Missing colon in local variables entry")) - (skip-chars-backward " \t") - (let* ((str (buffer-substring beg (point))) - (var (read str)) - val) - ;; Read the variable value. - (skip-chars-forward "^:") - (forward-char 1) - (setq val (read (current-buffer))) - (if mode-only - (if (eq var 'mode) - (setq mode-specified t)) - ;; Set the variable. "Variables" mode and eval are funny. - (with-current-buffer thisbuf - (hack-one-local-variable var val)))) - (forward-line 1))))))) + (when (let ((case-fold-search t)) + (and (search-forward "Local Variables:" nil t) + (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. + (suffix + (concat + (regexp-quote (buffer-substring (point) (line-end-position))) + "$")) + ;; prefix is what comes before "local variables:" in its line. + (prefix + (concat "^" (regexp-quote + (buffer-substring (line-beginning-position) + (match-beginning 0))))) + beg) + + (forward-line 1) + (let ((startpos (point)) + endpos + (thisbuf (current-buffer))) + (save-excursion + (unless (let ((case-fold-search t)) + (re-search-forward + (concat prefix "[ \t]*End:[ \t]*" suffix) + nil t)) + (error "Local variables list is not properly terminated")) + (beginning-of-line) + (setq endpos (point))) + + (with-temp-buffer + (insert-buffer-substring thisbuf startpos endpos) + (goto-char (point-min)) + (subst-char-in-region (point) (point-max) ?\^m ?\n) + (while (not (eobp)) + ;; Discard the prefix. + (if (looking-at prefix) + (delete-region (point) (match-end 0)) + (error "Local variables entry is missing the prefix")) + (end-of-line) + ;; Discard the suffix. + (if (looking-back suffix) + (delete-region (match-beginning 0) (point)) + (error "Local variables entry is missing the suffix")) + (forward-line 1)) + (goto-char (point-min)) + + (while (not (eobp)) + ;; Find the variable name; strip whitespace. + (skip-chars-forward " \t") + (setq beg (point)) + (skip-chars-forward "^:\n") + (if (eolp) (error "Missing colon in local variables entry")) + (skip-chars-backward " \t") + (let* ((str (buffer-substring beg (point))) + (var (read str)) + val) + ;; Read the variable value. + (skip-chars-forward "^:") + (forward-char 1) + (setq val (read (current-buffer))) + (if mode-only + (if (eq var 'mode) + (setq mode-specified t)) + ;; Set the variable. "Variables" mode and eval are funny. + (with-current-buffer thisbuf + (hack-one-local-variable var val)))) + (forward-line 1))))))) (unless mode-only (run-hooks 'hack-local-variables-hook)) mode-specified)) @@ -2317,7 +2421,7 @@ Add expressions to this list if you want Emacs to evaluate them, when they appear in an `eval' local variable specification, without first asking you for confirmation." :group 'find-file - :version "21.4" + :version "22.1" :type '(repeat sexp)) (put 'c-set-style 'safe-local-eval-function t) @@ -2386,18 +2490,9 @@ is considered risky." (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) @@ -2625,6 +2720,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." 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 @@ -2661,15 +2757,26 @@ BACKUPNAME is the backup file name, which is the old file renamed." (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)))) @@ -2747,7 +2854,7 @@ the value is \"\"." (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' @@ -2783,13 +2890,18 @@ ignored." (defun normal-backup-enable-predicate (name) "Default `backup-enable-predicate' function. -Checks for files in `temporary-file-directory' or -`small-temporary-file-directory'." +Checks for files in `temporary-file-directory', +`small-temporary-file-directory', and /tmp." (not (or (let ((comp (compare-strings temporary-file-directory 0 nil name 0 nil))) ;; Directory is under temporary-file-directory. (and (not (eq comp t)) (< comp (- (length temporary-file-directory))))) + (let ((comp (compare-strings "/tmp" 0 nil + name 0 nil))) + ;; Directory is under /tmp. + (and (not (eq comp t)) + (< comp (- (length "/tmp"))))) (if small-temporary-file-directory (let ((comp (compare-strings small-temporary-file-directory 0 nil @@ -2886,7 +2998,7 @@ Uses the free variable `backup-extract-version-start', whose value should be 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; @@ -3036,18 +3148,19 @@ on a DOS/Windows machine, it returns FILENAME on expanded form." ancestor)))))) (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~. @@ -3171,6 +3284,7 @@ Before and after saving the buffer, this function runs (not (and (eq selective-display t) (= (char-after (1- (point-max))) ?\r))) (or (eq require-final-newline t) + (eq require-final-newline 'visit-save) (and require-final-newline (y-or-n-p (format "Buffer %s does not end in newline. Add one? " @@ -3212,10 +3326,12 @@ Before and after saving the buffer, this function runs ;; but inhibited if one of write-file-functions returns non-nil. ;; It returns a value (MODES . BACKUPNAME), like backup-buffer. (defun basic-save-buffer-1 () - (if save-buffer-coding-system - (let ((coding-system-for-write save-buffer-coding-system)) + (prog1 + (if save-buffer-coding-system + (let ((coding-system-for-write save-buffer-coding-system)) + (basic-save-buffer-2)) (basic-save-buffer-2)) - (basic-save-buffer-2))) + (setq buffer-file-coding-system-explicit last-coding-system-used))) ;; This returns a value (MODES . BACKUPNAME), like backup-buffer. (defun basic-save-buffer-2 () @@ -3243,39 +3359,41 @@ Before and after saving the buffer, this function runs ;; 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, @@ -3340,11 +3458,15 @@ This requires the external program `diff' to be in your `exec-path'." "ACTION-ALIST argument used in call to `map-y-or-n-p'.") (put 'save-some-buffers-action-alist 'risky-local-variable t) +(defvar buffer-save-without-query nil + "Non-nil means `save-some-buffers' should save this buffer without asking.") +(make-variable-buffer-local 'buffer-save-without-query) + (defun save-some-buffers (&optional arg pred) "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: @@ -3357,8 +3479,18 @@ See `save-some-buffers-action-alist' if you want to change the additional actions you can take on files." (interactive "P") (save-window-excursion - (let* ((queried nil) - (files-done + (let* (queried some-automatic + files-done abbrevs-done) + (dolist (buffer (buffer-list)) + ;; First save any buffers that we're supposed to save unconditionally. + ;; That way the following code won't ask about them. + (with-current-buffer buffer + (when (and buffer-save-without-query (buffer-modified-p)) + (setq some-automatic t) + (save-buffer)))) + ;; Ask about those buffers that merit it, + ;; and record the number thus saved. + (setq files-done (map-y-or-n-p (function (lambda (buffer) @@ -3387,19 +3519,22 @@ change the additional actions you can take on files." (buffer-list) '("buffer" "buffers" "save") save-some-buffers-action-alist)) - (abbrevs-done - (and save-abbrevs abbrevs-changed - (progn - (if (or arg - (eq save-abbrevs 'silently) - (y-or-n-p (format "Save abbrevs in %s? " - abbrev-file-name))) - (write-abbrev-file nil)) - ;; Don't keep bothering user if he says no. - (setq abbrevs-changed nil) - t)))) + ;; Maybe to save abbrevs, and record whether + ;; we either saved them or asked to. + (and save-abbrevs abbrevs-changed + (progn + (if (or arg + (eq save-abbrevs 'silently) + (y-or-n-p (format "Save abbrevs in %s? " + abbrev-file-name))) + (write-abbrev-file nil)) + ;; Don't keep bothering user if he says no. + (setq abbrevs-changed nil) + (setq abbrevs-done t))) (or queried (> files-done 0) abbrevs-done - (message "(No files need saving)"))))) + (message (if some-automatic + "(Some special files were saved without asking)" + "(No files need saving)")))))) (defun not-modified (&optional arg) "Mark current buffer as unmodified, not needing to be saved. @@ -3544,7 +3679,7 @@ The function you specify is responsible for updating (or preserving) point.") (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 @@ -3613,91 +3748,93 @@ non-nil, it is called instead of rereading visited file contents." (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 without - ;; any code conversion. - (if auto-save-p 'emacs-mule-unix - (or coding-system-for-read - buffer-file-coding-system)))) - ;; 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." @@ -4286,6 +4423,8 @@ program specified by `directory-free-space-program' if that is non-nil." (buffer-substring (point) end))))))))) +(defvar insert-directory-ls-version 'unknown) + ;; insert-directory ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and ;; FULL-DIRECTORY-P is nil. @@ -4395,6 +4534,56 @@ normally equivalent short `-D' option is just passed on to (concat (file-name-as-directory file) ".") file)))))))) + ;; If we got "//DIRED//" in the output, it means we got a real + ;; directory listing, even if `ls' returned nonzero. + ;; So ignore any errors. + (when (if (stringp switches) + (string-match "--dired\\>" switches) + (member "--dired" switches)) + (save-excursion + (forward-line -2) + (when (looking-at "//SUBDIRED//") + (forward-line -1)) + (if (looking-at "//DIRED//") + (setq result 0)))) + + (when (and (not (eq 0 result)) + (eq insert-directory-ls-version 'unknown)) + ;; The first time ls returns an error, + ;; find the version numbers of ls, + ;; and set insert-directory-ls-version + ;; to > if it is more than 5.2.1, < if it is less, nil if it + ;; is equal or if the info cannot be obtained. + ;; (That can mean it isn't GNU ls.) + (let ((version-out + (with-temp-buffer + (call-process "ls" nil t nil "--version") + (buffer-string)))) + (if (string-match "ls (.*utils) \\([0-9.]*\\)$" version-out) + (let* ((version (match-string 1 version-out)) + (split (split-string version "[.]")) + (numbers (mapcar 'string-to-number split)) + (min '(5 2 1)) + comparison) + (while (and (not comparison) (or numbers min)) + (cond ((null min) + (setq comparison '>)) + ((null numbers) + (setq comparison '<)) + ((> (car numbers) (car min)) + (setq comparison '>)) + ((< (car numbers) (car min)) + (setq comparison '<)) + (t + (setq numbers (cdr numbers) + min (cdr min))))) + (setq insert-directory-ls-version (or comparison '=))) + (setq insert-directory-ls-version nil)))) + + ;; For GNU ls versions 5.2.2 and up, ignore minor errors. + (when (and (eq 1 result) (eq insert-directory-ls-version '>)) + (setq result 0)) + ;; If `insert-directory-program' failed, signal an error. (unless (eq 0 result) ;; Delete the error message it may have output. @@ -4417,17 +4606,38 @@ normally equivalent short `-D' option is just passed on to (when (if (stringp switches) (string-match "--dired\\>" switches) (member "--dired" switches)) + ;; The following overshoots by one line for an empty + ;; directory listed with "--dired", but without "-a" + ;; switch, where the ls output contains a + ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line. + ;; We take care of that case later. (forward-line -2) (when (looking-at "//SUBDIRED//") (delete-region (point) (progn (forward-line 1) (point))) (forward-line -1)) (if (looking-at "//DIRED//") - (let ((end (line-end-position))) + (let ((end (line-end-position)) + (linebeg (point)) + error-lines) + ;; Find all the lines that are error messages, + ;; and record the bounds of each one. + (goto-char beg) + (while (< (point) linebeg) + (or (eql (following-char) ?\s) + (push (list (point) (line-end-position)) error-lines)) + (forward-line 1)) + (setq error-lines (nreverse error-lines)) + ;; Now read the numeric positions of file names. + (goto-char linebeg) (forward-word 1) (forward-char 3) (while (< (point) end) - (let ((start (+ beg (read (current-buffer)))) - (end (+ beg (read (current-buffer))))) + (let ((start (insert-directory-adj-pos + (+ beg (read (current-buffer))) + error-lines)) + (end (insert-directory-adj-pos + (+ beg (read (current-buffer))) + error-lines))) (if (memq (char-after end) '(?\n ?\ )) ;; End is followed by \n or by " -> ". (put-text-property start end 'dired-filename t) @@ -4437,11 +4647,13 @@ normally equivalent short `-D' option is just passed on to (end-of-line)))) (goto-char end) (beginning-of-line) - (delete-region (point) (progn (forward-line 2) (point)))) - (forward-line 1) - (if (looking-at "//DIRED-OPTIONS//") - (delete-region (point) (progn (forward-line 1) (point))) - (forward-line 1)))) + (delete-region (point) (progn (forward-line 1) (point)))) + ;; Take care of the case where the ls output contains a + ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line + ;; and we went one line too far back (see above). + (forward-line 1)) + (if (looking-at "//DIRED-OPTIONS//") + (delete-region (point) (progn (forward-line 1) (point))))) ;; Now decode what read if necessary. (let ((coding (or coding-system-for-read @@ -4489,6 +4701,18 @@ normally equivalent short `-D' option is just passed on to (end-of-line) (insert " available " available))))))))))) +(defun insert-directory-adj-pos (pos error-lines) + "Convert `ls --dired' file name position value POS to a buffer position. +File name position values returned in ls --dired output +count only stdout; they don't count the error messages sent to stderr. +So this function converts to them to real buffer positions. +ERROR-LINES is a list of buffer positions of error message lines, +of the form (START END)." + (while (and error-lines (< (caar error-lines) pos)) + (setq pos (+ pos (- (nth 1 (car error-lines)) (nth 0 (car error-lines))))) + (pop error-lines)) + pos) + (defun insert-directory-safely (file switches &optional wildcard full-directory-p) "Insert directory listing for FILE, formatted according to SWITCHES. @@ -4654,5 +4878,5 @@ With prefix arg, silently save all file-visiting buffers, then kill." (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