aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndré Spiegel2000-10-04 09:55:21 +0000
committerAndré Spiegel2000-10-04 09:55:21 +0000
commitfa5867f6aa5f4a87168a8beff305662c834511a5 (patch)
treedf4a89333e364e8a35f1ba29c81b0174eb23d417
parentb3d6528a4c29f91232a46dc05bd231d0229a38a6 (diff)
downloademacs-fa5867f6aa5f4a87168a8beff305662c834511a5.tar.gz
emacs-fa5867f6aa5f4a87168a8beff305662c834511a5.zip
(basic-save-buffer): Call vc-before-save before saving.
-rw-r--r--lisp/files.el983
1 files changed, 332 insertions, 651 deletions
diff --git a/lisp/files.el b/lisp/files.el
index 805a1810252..990838a26fe 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1,7 +1,7 @@
1;;; files.el --- file input and output commands for Emacs 1;;; files.el --- file input and output commands for Emacs
2 2
3;; Copyright (C) 1985, 86, 87, 92, 93, 3;; Copyright (C) 1985, 86, 87, 92, 93,
4;; 94, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc. 4;; 94, 95, 96, 97, 98, 1998 Free Software Foundation, Inc.
5 5
6;; Maintainer: FSF 6;; Maintainer: FSF
7 7
@@ -84,9 +84,8 @@ names that the old file had will now refer to the new (edited) file.
84The file's owner and group are unchanged. 84The file's owner and group are unchanged.
85 85
86The choice of renaming or copying is controlled by the variables 86The choice of renaming or copying is controlled by the variables
87`backup-by-copying', `backup-by-copying-when-linked', 87`backup-by-copying', `backup-by-copying-when-linked' and
88`backup-by-copying-when-mismatch' and 88`backup-by-copying-when-mismatch'. See also `backup-inhibited'."
89`backup-by-copying-when-privileged-mismatch'. See also `backup-inhibited'."
90 :type 'boolean 89 :type 'boolean
91 :group 'backup) 90 :group 'backup)
92 91
@@ -121,42 +120,16 @@ This variable is relevant only if `backup-by-copying' is nil."
121 :type 'boolean 120 :type 'boolean
122 :group 'backup) 121 :group 'backup)
123 122
124(defcustom backup-by-copying-when-privileged-mismatch 200 123(defvar backup-enable-predicate
125 "*Non-nil means create backups by copying to preserve a privileged owner. 124 '(lambda (name)
126Renaming may still be used (subject to control of other variables) 125 (or (< (length name) 5)
127when it would not result in changing the owner of the file or if the owner 126 (not (string-equal "/tmp/" (substring name 0 5)))))
128has a user id greater than the value of this variable. This is useful
129when low-numbered uid's are used for special system users (such as root)
130that must maintain ownership of certain files.
131This variable is relevant only if `backup-by-copying' and
132`backup-by-copying-when-mismatch' are nil."
133 :type '(choice (const nil) integer)
134 :group 'backup)
135
136(defun normal-backup-enable-predicate (name)
137 "Default `backup-enable-predicate' function.
138Checks for files in `temporary-file-directory' or
139`small-temporary-file-directory'."
140 (not (or (let ((comp (compare-strings temporary-file-directory 0 nil
141 name 0 nil)))
142 ;; Directory is under temporary-file-directory.
143 (and (not (eq comp t))
144 (< comp (- (length temporary-file-directory)))))
145 (if small-temporary-file-directory
146 (let ((comp (compare-strings small-temporary-file-directory
147 0 nil
148 name 0 nil)))
149 ;; Directory is under small-temporary-file-directory.
150 (and (not (eq comp t))
151 (< comp (- (length small-temporary-file-directory)))))))))
152
153(defvar backup-enable-predicate 'normal-backup-enable-predicate
154 "Predicate that looks at a file name and decides whether to make backups. 127 "Predicate that looks at a file name and decides whether to make backups.
155Called with an absolute file name as argument, it returns t to enable backup.") 128Called with an absolute file name as argument, it returns t to enable backup.")
156 129
157(defcustom buffer-offer-save nil 130(defcustom buffer-offer-save nil
158 "*Non-nil in a buffer means always offer to save buffer on exit. 131 "*Non-nil in a buffer means offer to save the buffer on exit
159Do so even if the buffer is not visiting a file. 132even if the buffer is not visiting a file.
160Automatically local in all buffers." 133Automatically local in all buffers."
161 :type 'boolean 134 :type 'boolean
162 :group 'backup) 135 :group 'backup)
@@ -281,23 +254,6 @@ Normally auto-save files are written under other names."
281 :type 'boolean 254 :type 'boolean
282 :group 'auto-save) 255 :group 'auto-save)
283 256
284(defcustom auto-save-file-name-transforms
285 '(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)" "/tmp/\\2"))
286 "*Transforms to apply to buffer file name before making auto-save file name.
287Each transform is a list (REGEXP REPLACEMENT):
288REGEXP is a regular expression to match against the file name.
289If it matches, `replace-match' is used to replace the
290matching part with REPLACEMENT.
291All the transforms in the list are tried, in the order they are listed.
292When one transform applies, its result is final;
293no further transforms are tried.
294
295The default value is set up to put the auto-save file into `/tmp'
296for editing a remote file."
297 :group 'auto-save
298 :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement")))
299 :version "21.1")
300
301(defcustom save-abbrevs nil 257(defcustom save-abbrevs nil
302 "*Non-nil means save word abbrevs too when files are saved. 258 "*Non-nil means save word abbrevs too when files are saved.
303Loading an abbrev file sets this to t." 259Loading an abbrev file sets this to t."
@@ -305,24 +261,16 @@ Loading an abbrev file sets this to t."
305 :group 'abbrev) 261 :group 'abbrev)
306 262
307(defcustom find-file-run-dired t 263(defcustom find-file-run-dired t
308 "*Non-nil means allow `find-file' to visit directories. 264 "*Non-nil says run dired if `find-file' is given the name of a directory."
309To visit the directory, `find-file' runs `find-directory-functions'."
310 :type 'boolean 265 :type 'boolean
311 :group 'find-file) 266 :group 'find-file)
312 267
313(defcustom find-directory-functions '(cvs-dired-noselect dired-noselect)
314 "*List of functions to try in sequence to visit a directory.
315Each function is called with the directory name as the sole argument
316and should return either a buffer or nil."
317 :type '(hook :options (cvs-dired-noselect dired-noselect))
318 :group 'find-file)
319
320;;;It is not useful to make this a local variable. 268;;;It is not useful to make this a local variable.
321;;;(put 'find-file-not-found-hooks 'permanent-local t) 269;;;(put 'find-file-not-found-hooks 'permanent-local t)
322(defvar find-file-not-found-hooks nil 270(defvar find-file-not-found-hooks nil
323 "List of functions to be called for `find-file' on nonexistent file. 271 "List of functions to be called for `find-file' on nonexistent file.
324These functions are called as soon as the error is detected. 272These functions are called as soon as the error is detected.
325Variable `buffer-file-name' is already set up. 273`buffer-file-name' is already set up.
326The functions are called in the order given until one of them returns non-nil.") 274The functions are called in the order given until one of them returns non-nil.")
327 275
328;;;It is not useful to make this a local variable. 276;;;It is not useful to make this a local variable.
@@ -337,8 +285,7 @@ functions are called.")
337If one of them returns non-nil, the file is considered already written 285If one of them returns non-nil, the file is considered already written
338and the rest are not called. 286and the rest are not called.
339These hooks are considered to pertain to the visited file. 287These hooks are considered to pertain to the visited file.
340So any buffer-local binding of `write-file-hooks' is 288So this list is cleared if you change the visited file name.
341discarded if you change the visited file name with \\[set-visited-file-name].
342 289
343Don't make this variable buffer-local; instead, use `local-write-file-hooks'. 290Don't make this variable buffer-local; instead, use `local-write-file-hooks'.
344See also `write-contents-hooks'.") 291See also `write-contents-hooks'.")
@@ -433,21 +380,14 @@ and ignores this variable."
433 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) 380 (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
434 "The directory for writing temporary files.") 381 "The directory for writing temporary files.")
435 382
436(defvar small-temporary-file-directory
437 (if (eq system-type 'ms-dos) (getenv "TMPDIR"))
438 "The directory for writing small temporary files.
439If non-nil, this directory is used instead of `temporary-file-directory'
440by programs that create small temporary files. This is for systems that
441have fast storage with limited space, such as a RAM disk.")
442
443;; The system null device. (Should reference NULL_DEVICE from C.) 383;; The system null device. (Should reference NULL_DEVICE from C.)
444(defvar null-device "/dev/null" "The system null device.") 384(defvar null-device "/dev/null" "The system null device.")
445 385
386;; This hook function provides support for ange-ftp host name
387;; completion. It runs the usual ange-ftp hook, but only for
388;; completion operations. Having this here avoids the need
389;; to load ange-ftp when it's not really in use.
446(defun ange-ftp-completion-hook-function (op &rest args) 390(defun ange-ftp-completion-hook-function (op &rest args)
447 "Provides support for ange-ftp host name completion.
448Runs the usual ange-ftp hook, but only for completion operations."
449 ;; Having this here avoids the need to load ange-ftp when it's not
450 ;; really in use.
451 (if (memq op '(file-name-completion file-name-all-completions)) 391 (if (memq op '(file-name-completion file-name-all-completions))
452 (apply 'ange-ftp-hook-function op args) 392 (apply 'ange-ftp-hook-function op args)
453 (let ((inhibit-file-name-handlers 393 (let ((inhibit-file-name-handlers
@@ -460,9 +400,8 @@ Runs the usual ange-ftp hook, but only for completion operations."
460(defun convert-standard-filename (filename) 400(defun convert-standard-filename (filename)
461 "Convert a standard file's name to something suitable for the current OS. 401 "Convert a standard file's name to something suitable for the current OS.
462This function's standard definition is trivial; it just returns the argument. 402This function's standard definition is trivial; it just returns the argument.
463However, on some systems, the function is redefined with a definition 403However, on some systems, the function is redefined
464that really does change some file names to canonicalize certain 404with a definition that really does change some file names."
465patterns and to guarantee valid names."
466 filename) 405 filename)
467 406
468(defun pwd () 407(defun pwd ()
@@ -475,9 +414,7 @@ patterns and to guarantee valid names."
475Not actually set up until the first time you you use it.") 414Not actually set up until the first time you you use it.")
476 415
477(defun parse-colon-path (cd-path) 416(defun parse-colon-path (cd-path)
478 "Explode a colon-separated search path into a list of directory names. 417 "Explode a colon-separated search path into a list of directory names."
479\(For values of `colon' equal to `path-separator'.)"
480 ;; We could use split-string here.
481 (and cd-path 418 (and cd-path
482 (let (cd-prefix cd-list (cd-start 0) cd-colon) 419 (let (cd-prefix cd-list (cd-start 0) cd-colon)
483 (setq cd-path (concat cd-path path-separator)) 420 (setq cd-path (concat cd-path path-separator))
@@ -536,9 +473,7 @@ colon-separated list of directories when resolving a relative directory name."
536(defun load-file (file) 473(defun load-file (file)
537 "Load the Lisp file named FILE." 474 "Load the Lisp file named FILE."
538 (interactive "fLoad file: ") 475 (interactive "fLoad file: ")
539 (let ((completion-ignored-extensions 476 (load (expand-file-name file) nil nil t))
540 (delete ".elc" completion-ignored-extensions)))
541 (load (expand-file-name file) nil nil t)))
542 477
543(defun load-library (library) 478(defun load-library (library)
544 "Load the library named LIBRARY. 479 "Load the library named LIBRARY.
@@ -546,12 +481,10 @@ This is an interface to the function `load'."
546 (interactive "sLoad library: ") 481 (interactive "sLoad library: ")
547 (load library)) 482 (load library))
548 483
549(defun file-local-copy (file) 484(defun file-local-copy (file &optional buffer)
550 "Copy the file FILE into a temporary file on this machine. 485 "Copy the file FILE into a temporary file on this machine.
551Returns the name of the local copy, or nil, if FILE is directly 486Returns the name of the local copy, or nil, if FILE is directly
552accessible." 487accessible."
553 ;; This formerly had an optional BUFFER argument that wasn't used by
554 ;; anything.
555 (let ((handler (find-file-name-handler file 'file-local-copy))) 488 (let ((handler (find-file-name-handler file 'file-local-copy)))
556 (if handler 489 (if handler
557 (funcall handler 'file-local-copy file) 490 (funcall handler 'file-local-copy file)
@@ -608,7 +541,7 @@ Do not specify them in other calls."
608 (if handler 541 (if handler
609 (setq filename (funcall handler 'file-truename filename)) 542 (setq filename (funcall handler 'file-truename filename))
610 ;; If filename contains a wildcard, newname will be the old name. 543 ;; If filename contains a wildcard, newname will be the old name.
611 (if (string-match "[[*?]" filename) 544 (if (string-match "[*?]" filename)
612 (setq newname filename) 545 (setq newname filename)
613 ;; If filename doesn't exist, newname will be nil. 546 ;; If filename doesn't exist, newname will be nil.
614 (setq newname (w32-long-file-name filename))) 547 (setq newname (w32-long-file-name filename)))
@@ -718,8 +651,7 @@ do not put this buffer at the front of the list of recently selected ones."
718Switch to a buffer visiting file FILENAME, 651Switch to a buffer visiting file FILENAME,
719creating one if none already exists. 652creating one if none already exists.
720Interactively, or if WILDCARDS is non-nil in a call from Lisp, 653Interactively, or if WILDCARDS is non-nil in a call from Lisp,
721expand wildcards (if any) and visit multiple files. Wildcard expansion 654expand wildcards (if any) and visit multiple files."
722can be suppressed by setting `find-file-wildcards'."
723 (interactive "FFind file: \np") 655 (interactive "FFind file: \np")
724 (let ((value (find-file-noselect filename nil nil wildcards))) 656 (let ((value (find-file-noselect filename nil nil wildcards)))
725 (if (listp value) 657 (if (listp value)
@@ -758,7 +690,7 @@ expand wildcards (if any) and visit multiple files."
758 690
759(defun find-file-read-only (filename &optional wildcards) 691(defun find-file-read-only (filename &optional wildcards)
760 "Edit file FILENAME but don't allow changes. 692 "Edit file FILENAME but don't allow changes.
761Like `find-file' but marks buffer as read-only. 693Like \\[find-file] but marks buffer as read-only.
762Use \\[toggle-read-only] to permit editing." 694Use \\[toggle-read-only] to permit editing."
763 (interactive "fFind file read-only: \np") 695 (interactive "fFind file read-only: \np")
764 (find-file filename wildcards) 696 (find-file filename wildcards)
@@ -859,13 +791,11 @@ otherwise a string <2> or <3> or ... is appended to get an unused name."
859Choose the buffer's name using `generate-new-buffer-name'." 791Choose the buffer's name using `generate-new-buffer-name'."
860 (get-buffer-create (generate-new-buffer-name name))) 792 (get-buffer-create (generate-new-buffer-name name)))
861 793
862(defcustom automount-dir-prefix "^/tmp_mnt/" 794(defvar automount-dir-prefix "^/tmp_mnt/"
863 "Regexp to match the automounter prefix in a directory name." 795 "Regexp to match the automounter prefix in a directory name.")
864 :group 'files
865 :type 'regexp)
866 796
867(defvar abbreviated-home-dir nil 797(defvar abbreviated-home-dir nil
868 "The user's homedir abbreviated according to `directory-abbrev-alist'.") 798 "The user's homedir abbreviated according to `directory-abbrev-list'.")
869 799
870(defun abbreviate-file-name (filename) 800(defun abbreviate-file-name (filename)
871 "Return a version of FILENAME shortened using `directory-abbrev-alist'. 801 "Return a version of FILENAME shortened using `directory-abbrev-alist'.
@@ -966,15 +896,6 @@ whose names match the pattern."
966 :version "20.4" 896 :version "20.4"
967 :type 'boolean) 897 :type 'boolean)
968 898
969(defcustom find-file-suppress-same-file-warnings nil
970 "*Non-nil means suppress warning messages for symlinked files.
971When nil, Emacs prints a warning when visiting a file that is already
972visited, but with a different name. Setting this option to t
973suppresses this warning."
974 :group 'files
975 :version "21.1"
976 :type 'boolean)
977
978(defun find-file-noselect (filename &optional nowarn rawfile wildcards) 899(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
979 "Read file FILENAME into a buffer and return the buffer. 900 "Read file FILENAME into a buffer and return the buffer.
980If a buffer exists visiting FILENAME, return that one, but 901If a buffer exists visiting FILENAME, return that one, but
@@ -990,24 +911,21 @@ that are visiting the various files."
990 (abbreviate-file-name 911 (abbreviate-file-name
991 (expand-file-name filename))) 912 (expand-file-name filename)))
992 (if (file-directory-p filename) 913 (if (file-directory-p filename)
993 (or (and find-file-run-dired 914 (if find-file-run-dired
994 (run-hook-with-args-until-success 915 (dired-noselect (if find-file-visit-truename
995 'find-directory-functions 916 (abbreviate-file-name (file-truename filename))
996 (if find-file-visit-truename 917 filename))
997 (abbreviate-file-name (file-truename filename)) 918 (error "%s is a directory" filename))
998 filename)))
999 (error "%s is a directory" filename))
1000 (if (and wildcards 919 (if (and wildcards
1001 find-file-wildcards 920 find-file-wildcards
1002 (not (string-match "\\`/:" filename)) 921 (not (string-match "\\`/:" filename))
1003 (string-match "[[*?]" filename)) 922 (string-match "[[*?]" filename))
1004 (let ((files (condition-case nil 923 (let ((files (file-expand-wildcards filename t))
1005 (file-expand-wildcards filename t)
1006 (error (list filename))))
1007 (find-file-wildcards nil)) 924 (find-file-wildcards nil))
1008 (if (null files) 925 (if (null files)
1009 (find-file-noselect filename) 926 (error "No files match `%s'" filename))
1010 (car (mapcar #'find-file-noselect files)))) 927 (mapcar #'(lambda (fn) (find-file-noselect fn))
928 files))
1011 (let* ((buf (get-file-buffer filename)) 929 (let* ((buf (get-file-buffer filename))
1012 (truename (abbreviate-file-name (file-truename filename))) 930 (truename (abbreviate-file-name (file-truename filename)))
1013 (number (nthcdr 10 (file-attributes truename))) 931 (number (nthcdr 10 (file-attributes truename)))
@@ -1017,7 +935,6 @@ that are visiting the various files."
1017 (if other 935 (if other
1018 (progn 936 (progn
1019 (or nowarn 937 (or nowarn
1020 find-file-suppress-same-file-warnings
1021 (string-equal filename (buffer-file-name other)) 938 (string-equal filename (buffer-file-name other))
1022 (message "%s and %s are the same file" 939 (message "%s and %s are the same file"
1023 filename (buffer-file-name other))) 940 filename (buffer-file-name other)))
@@ -1208,7 +1125,7 @@ Don't call it from programs! Use `insert-file-contents-literally' instead.
1208This is a permanent local.") 1125This is a permanent local.")
1209(put 'find-file-literally 'permanent-local t) 1126(put 'find-file-literally 'permanent-local t)
1210 1127
1211(defun find-file-literally (filename) 1128(defun find-file-literally (filename)
1212 "Visit file FILENAME with no conversion of any kind. 1129 "Visit file FILENAME with no conversion of any kind.
1213Format conversion and character code conversion are both disabled, 1130Format conversion and character code conversion are both disabled,
1214and multibyte characters are disabled in the resulting buffer. 1131and multibyte characters are disabled in the resulting buffer.
@@ -1250,15 +1167,10 @@ unless NOMODES is non-nil."
1250 (msg 1167 (msg
1251 (cond ((and error (file-attributes buffer-file-name)) 1168 (cond ((and error (file-attributes buffer-file-name))
1252 (setq buffer-read-only t) 1169 (setq buffer-read-only t)
1253 "File exists, but cannot be read") 1170 "File exists, but cannot be read.")
1254 ((not buffer-read-only) 1171 ((not buffer-read-only)
1255 (if (and warn 1172 (if (and warn
1256 ;; No need to warn if buffer is auto-saved 1173 (file-newer-than-file-p (make-auto-save-file-name)
1257 ;; under the name of the visited file.
1258 (not (and buffer-file-name
1259 auto-save-visited-file-name))
1260 (file-newer-than-file-p (or buffer-auto-save-file-name
1261 (make-auto-save-file-name))
1262 buffer-file-name)) 1174 buffer-file-name))
1263 (format "%s has auto save data; consider M-x recover-file" 1175 (format "%s has auto save data; consider M-x recover-file"
1264 (file-name-nondirectory buffer-file-name)) 1176 (file-name-nondirectory buffer-file-name))
@@ -1282,14 +1194,8 @@ unless NOMODES is non-nil."
1282 (or not-serious (sit-for 1 nil t))))) 1194 (or not-serious (sit-for 1 nil t)))))
1283 (if (and auto-save-default (not noauto)) 1195 (if (and auto-save-default (not noauto))
1284 (auto-save-mode t))) 1196 (auto-save-mode t)))
1285 ;; Make people do a little extra work (C-x C-q)
1286 ;; before altering a backup file.
1287 (if (backup-file-name-p buffer-file-name)
1288 (setq buffer-read-only t))
1289 (if nomodes 1197 (if nomodes
1290 nil 1198 nil
1291 (and view-read-only view-mode
1292 (view-mode-disable))
1293 (normal-mode t) 1199 (normal-mode t)
1294 (if (and buffer-read-only view-read-only 1200 (if (and buffer-read-only view-read-only
1295 (not (eq (get major-mode 'mode-class) 'special))) 1201 (not (eq (get major-mode 'mode-class) 'special)))
@@ -1325,138 +1231,128 @@ in that case, this function acts as if `enable-local-variables' were t."
1325 (prin1-to-string err))))) 1231 (prin1-to-string err)))))
1326 1232
1327(defvar auto-mode-alist 1233(defvar auto-mode-alist
1328 (mapc 1234 '(("\\.te?xt\\'" . text-mode)
1329 (lambda (elt) 1235 ("\\.c\\'" . c-mode)
1330 (cons (purecopy (car elt)) (cdr elt))) 1236 ("\\.h\\'" . c-mode)
1331 '(("\\.te?xt\\'" . text-mode) 1237 ("\\.tex\\'" . tex-mode)
1332 ("\\.c\\'" . c-mode) 1238 ("\\.ltx\\'" . latex-mode)
1333 ("\\.h\\'" . c-mode) 1239 ("\\.el\\'" . emacs-lisp-mode)
1334 ("\\.tex\\'" . tex-mode) 1240 ("\\.scm\\'" . scheme-mode)
1335 ("\\.ltx\\'" . latex-mode) 1241 ("\\.l\\'" . lisp-mode)
1336 ("\\.el\\'" . emacs-lisp-mode) 1242 ("\\.lisp\\'" . lisp-mode)
1337 ("\\.scm\\'" . scheme-mode) 1243 ("\\.f\\'" . fortran-mode)
1338 ("\\.l\\'" . lisp-mode) 1244 ("\\.F\\'" . fortran-mode)
1339 ("\\.lisp\\'" . lisp-mode) 1245 ("\\.for\\'" . fortran-mode)
1340 ("\\.f\\'" . fortran-mode) 1246 ("\\.p\\'" . pascal-mode)
1341 ("\\.F\\'" . fortran-mode) 1247 ("\\.pas\\'" . pascal-mode)
1342 ("\\.for\\'" . fortran-mode) 1248 ("\\.ad[abs]\\'" . ada-mode)
1343 ("\\.p\\'" . pascal-mode) 1249 ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode)
1344 ("\\.pas\\'" . pascal-mode) 1250 ("\\.s?html?\\'" . html-mode)
1345 ("\\.ad[abs]\\'" . ada-mode) 1251 ("\\.cc\\'" . c++-mode)
1346 ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode) 1252 ("\\.hh\\'" . c++-mode)
1347 ("\\.s?html?\\'" . html-mode) 1253 ("\\.hpp\\'" . c++-mode)
1348 ("\\.cc\\'" . c++-mode) 1254 ("\\.C\\'" . c++-mode)
1349 ("\\.hh\\'" . c++-mode) 1255 ("\\.H\\'" . c++-mode)
1350 ("\\.hpp\\'" . c++-mode) 1256 ("\\.cpp\\'" . c++-mode)
1351 ("\\.C\\'" . c++-mode) 1257 ("\\.cxx\\'" . c++-mode)
1352 ("\\.H\\'" . c++-mode) 1258 ("\\.hxx\\'" . c++-mode)
1353 ("\\.cpp\\'" . c++-mode) 1259 ("\\.c\\+\\+\\'" . c++-mode)
1354 ("\\.cxx\\'" . c++-mode) 1260 ("\\.h\\+\\+\\'" . c++-mode)
1355 ("\\.hxx\\'" . c++-mode) 1261 ("\\.m\\'" . objc-mode)
1356 ("\\.c\\+\\+\\'" . c++-mode) 1262 ("\\.java\\'" . java-mode)
1357 ("\\.h\\+\\+\\'" . c++-mode) 1263 ("\\.mk\\'" . makefile-mode)
1358 ("\\.m\\'" . objc-mode) 1264 ("\\(M\\|m\\|GNUm\\)akefile\\(\\.in\\)?\\'" . makefile-mode)
1359 ("\\.java\\'" . java-mode) 1265 ("\\.am\\'" . makefile-mode) ;For Automake.
1360 ("\\.mk\\'" . makefile-mode)
1361 ("\\(M\\|m\\|GNUm\\)akefile\\(\\.in\\)?\\'" . makefile-mode)
1362 ("\\.am\\'" . makefile-mode) ;For Automake.
1363;;; Less common extensions come here 1266;;; Less common extensions come here
1364;;; so more common ones above are found faster. 1267;;; so more common ones above are found faster.
1365 ("\\.texinfo\\'" . texinfo-mode) 1268 ("\\.texinfo\\'" . texinfo-mode)
1366 ("\\.te?xi\\'" . texinfo-mode) 1269 ("\\.te?xi\\'" . texinfo-mode)
1367 ("\\.s\\'" . asm-mode) 1270 ("\\.s\\'" . asm-mode)
1368 ("\\.S\\'" . asm-mode) 1271 ("\\.S\\'" . asm-mode)
1369 ("\\.asm\\'" . asm-mode) 1272 ("\\.asm\\'" . asm-mode)
1370 ("ChangeLog\\'" . change-log-mode) 1273 ("ChangeLog\\'" . change-log-mode)
1371 ("change\\.log\\'" . change-log-mode) 1274 ("change\\.log\\'" . change-log-mode)
1372 ("changelo\\'" . change-log-mode) 1275 ("changelo\\'" . change-log-mode)
1373 ("ChangeLog\\.[0-9]+\\'" . change-log-mode) 1276 ("ChangeLog\\.[0-9]+\\'" . change-log-mode)
1374 ;; for MSDOS and MS-Windows (which are case-insensitive) 1277 ;; for MSDOS and MS-Windows (which are case-insensitive)
1375 ("changelog\\'" . change-log-mode) 1278 ("changelog\\'" . change-log-mode)
1376 ("changelog\\.[0-9]+\\'" . change-log-mode) 1279 ("changelog\\.[0-9]+\\'" . change-log-mode)
1377 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) 1280 ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
1378 ("\\.scm\\.[0-9]*\\'" . scheme-mode) 1281 ("\\.scm\\.[0-9]*\\'" . scheme-mode)
1379 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) 1282 ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
1380 ("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode) 1283 ("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
1381 ("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) 1284 ("\\(/\\|\\`\\)\\.\\(bash_logout\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
1382 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) 1285 ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
1383 ("\\.m?spec$" . sh-mode) 1286 ("\\.m?spec$" . sh-mode)
1384 ("\\.mm\\'" . nroff-mode) 1287 ("\\.mm\\'" . nroff-mode)
1385 ("\\.me\\'" . nroff-mode) 1288 ("\\.me\\'" . nroff-mode)
1386 ("\\.ms\\'" . nroff-mode) 1289 ("\\.ms\\'" . nroff-mode)
1387 ("\\.man\\'" . nroff-mode) 1290 ("\\.man\\'" . nroff-mode)
1388 ("\\.\\(u?lpc\\|pike\\|pmod\\)\\'" . pike-mode) 1291 ("\\.\\(u?lpc\\|pike\\|pmod\\)\\'" . pike-mode)
1389;;; The following should come after the ChangeLog pattern 1292;;; The following should come after the ChangeLog pattern
1390;;; for the sake of ChangeLog.1, etc. 1293;;; for the sake of ChangeLog.1, etc.
1391;;; and after the .scm.[0-9] pattern too. 1294;;; and after the .scm.[0-9] pattern too.
1392 ("\\.[12345678]\\'" . nroff-mode) 1295 ("\\.[12345678]\\'" . nroff-mode)
1393 ("\\.TeX\\'" . tex-mode) 1296 ("\\.TeX\\'" . tex-mode)
1394 ("\\.sty\\'" . latex-mode) 1297 ("\\.sty\\'" . latex-mode)
1395 ("\\.cls\\'" . latex-mode) ;LaTeX 2e class 1298 ("\\.cls\\'" . latex-mode) ;LaTeX 2e class
1396 ("\\.clo\\'" . latex-mode) ;LaTeX 2e class option 1299 ("\\.clo\\'" . latex-mode) ;LaTeX 2e class option
1397 ("\\.bbl\\'" . latex-mode) 1300 ("\\.bbl\\'" . latex-mode)
1398 ("\\.bib\\'" . bibtex-mode) 1301 ("\\.bib\\'" . bibtex-mode)
1399 ("\\.sql\\'" . sql-mode) 1302 ("\\.sql\\'" . sql-mode)
1400 ("\\.m4\\'" . m4-mode) 1303 ("\\.m4\\'" . m4-mode)
1401 ("\\.mc\\'" . m4-mode) 1304 ("\\.mc\\'" . m4-mode)
1402 ("\\.mf\\'" . metafont-mode) 1305 ("\\.mf\\'" . metafont-mode)
1403 ("\\.mp\\'" . metapost-mode) 1306 ("\\.mp\\'" . metapost-mode)
1404 ("\\.vhdl?\\'" . vhdl-mode) 1307 ("\\.vhdl?\\'" . vhdl-mode)
1405 ("\\.article\\'" . text-mode) 1308 ("\\.article\\'" . text-mode)
1406 ("\\.letter\\'" . text-mode) 1309 ("\\.letter\\'" . text-mode)
1407 ("\\.tcl\\'" . tcl-mode) 1310 ("\\.tcl\\'" . tcl-mode)
1408 ("\\.exp\\'" . tcl-mode) 1311 ("\\.exp\\'" . tcl-mode)
1409 ("\\.itcl\\'" . tcl-mode) 1312 ("\\.itcl\\'" . tcl-mode)
1410 ("\\.itk\\'" . tcl-mode) 1313 ("\\.itk\\'" . tcl-mode)
1411 ("\\.icn\\'" . icon-mode) 1314 ("\\.icn\\'" . icon-mode)
1412 ("\\.sim\\'" . simula-mode) 1315 ("\\.sim\\'" . simula-mode)
1413 ("\\.mss\\'" . scribe-mode) 1316 ("\\.mss\\'" . scribe-mode)
1414 ("\\.f90\\'" . f90-mode) 1317 ("\\.f90\\'" . f90-mode)
1415 ("\\.pro\\'" . idlwave-mode) 1318 ("\\.lsp\\'" . lisp-mode)
1416 ("\\.lsp\\'" . lisp-mode) 1319 ("\\.awk\\'" . awk-mode)
1417 ("\\.awk\\'" . awk-mode) 1320 ("\\.prolog\\'" . prolog-mode)
1418 ("\\.prolog\\'" . prolog-mode) 1321 ("\\.tar\\'" . tar-mode)
1419 ("\\.tar\\'" . tar-mode) 1322 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode)
1420 ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode) 1323 ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode)
1421 ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode) 1324 ;; Mailer puts message to be edited in
1422 ;; Mailer puts message to be edited in 1325 ;; /tmp/Re.... or Message
1423 ;; /tmp/Re.... or Message 1326 ("\\`/tmp/Re" . text-mode)
1424 ("\\`/tmp/Re" . text-mode) 1327 ("/Message[0-9]*\\'" . text-mode)
1425 ("/Message[0-9]*\\'" . text-mode) 1328 ("/drafts/[0-9]+\\'" . mh-letter-mode)
1426 ("/drafts/[0-9]+\\'" . mh-letter-mode) 1329 ("\\.zone\\'" . zone-mode)
1427 ("\\.zone\\'" . zone-mode) 1330 ;; some news reader is reported to use this
1428 ;; some news reader is reported to use this 1331 ("\\`/tmp/fol/" . text-mode)
1429 ("\\`/tmp/fol/" . text-mode) 1332 ("\\.y\\'" . c-mode)
1430 ("\\.y\\'" . c-mode) 1333 ("\\.lex\\'" . c-mode)
1431 ("\\.lex\\'" . c-mode) 1334 ("\\.oak\\'" . scheme-mode)
1432 ("\\.oak\\'" . scheme-mode) 1335 ("\\.sgml?\\'" . sgml-mode)
1433 ("\\.sgml?\\'" . sgml-mode) 1336 ("\\.xml\\'" . sgml-mode)
1434 ("\\.xml\\'" . sgml-mode) 1337 ("\\.dtd\\'" . sgml-mode)
1435 ("\\.dtd\\'" . sgml-mode) 1338 ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
1436 ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) 1339 ("\\.idl\\'" . idl-mode)
1437 ("\\.idl\\'" . idl-mode) 1340 ;; .emacs following a directory delimiter
1438 ;; .emacs following a directory delimiter 1341 ;; in Unix, MSDOG or VMS syntax.
1439 ;; in Unix, MSDOG or VMS syntax. 1342 ("[]>:/\\]\\..*emacs\\'" . emacs-lisp-mode)
1440 ("[]>:/\\]\\..*emacs\\'" . emacs-lisp-mode) 1343 ("\\`\\..*emacs\\'" . emacs-lisp-mode)
1441 ("\\`\\..*emacs\\'" . emacs-lisp-mode) 1344 ;; _emacs following a directory delimiter
1442 ;; _emacs following a directory delimiter 1345 ;; in MsDos syntax
1443 ;; in MsDos syntax 1346 ("[:/]_emacs\\'" . emacs-lisp-mode)
1444 ("[:/]_emacs\\'" . emacs-lisp-mode) 1347 ("\\.ml\\'" . lisp-mode)
1445 ("/crontab\\.X*[0-9]+\\'" . shell-script-mode) 1348 ("\\.asn$" . snmp-mode)
1446 ("\\.ml\\'" . lisp-mode) 1349 ("\\.mib$" . snmp-mode)
1447 ("\\.asn$" . snmp-mode) 1350 ("\\.smi$" . snmp-mode)
1448 ("\\.mib$" . snmp-mode) 1351 ("\\.as2$" . snmpv2-mode)
1449 ("\\.smi$" . snmp-mode) 1352 ("\\.mi2$" . snmpv2-mode)
1450 ("\\.as2$" . snmpv2-mode) 1353 ("\\.sm2$" . snmpv2-mode))
1451 ("\\.mi2$" . snmpv2-mode) 1354 "\
1452 ("\\.sm2$" . snmpv2-mode) 1355Alist of filename patterns vs corresponding major mode functions.
1453 ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
1454 ("\\.[eE]?[pP][sS]$" . ps-mode)
1455 ("configure\\.in\\'" . autoconf-mode)
1456 ("BROWSE\\'" . ebrowse-tree-mode)
1457 ("\\.ebrowse\\'" . ebrowse-tree-mode)
1458 ("#\\*mail\\*" . mail-mode)))
1459 "Alist of filename patterns vs corresponding major mode functions.
1460Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). 1356Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
1461\(NON-NIL stands for anything that is not nil; the value does not matter.) 1357\(NON-NIL stands for anything that is not nil; the value does not matter.)
1462Visiting a file whose name matches REGEXP specifies FUNCTION as the 1358Visiting a file whose name matches REGEXP specifies FUNCTION as the
@@ -1468,47 +1364,41 @@ REGEXP and search the list again for another match.")
1468 1364
1469 1365
1470(defvar interpreter-mode-alist 1366(defvar interpreter-mode-alist
1471 (mapc 1367 '(("perl" . perl-mode)
1472 (lambda (l) 1368 ("perl5" . perl-mode)
1473 (cons (purecopy (car l)) (cdr l))) 1369 ("miniperl" . perl-mode)
1474 '(("perl" . perl-mode) 1370 ("wish" . tcl-mode)
1475 ("perl5" . perl-mode) 1371 ("wishx" . tcl-mode)
1476 ("miniperl" . perl-mode) 1372 ("tcl" . tcl-mode)
1477 ("wish" . tcl-mode) 1373 ("tclsh" . tcl-mode)
1478 ("wishx" . tcl-mode) 1374 ("awk" . awk-mode)
1479 ("tcl" . tcl-mode) 1375 ("mawk" . awk-mode)
1480 ("tclsh" . tcl-mode) 1376 ("nawk" . awk-mode)
1481 ("awk" . awk-mode) 1377 ("gawk" . awk-mode)
1482 ("mawk" . awk-mode) 1378 ("scm" . scheme-mode)
1483 ("nawk" . awk-mode) 1379 ("ash" . sh-mode)
1484 ("gawk" . awk-mode) 1380 ("bash" . sh-mode)
1485 ("scm" . scheme-mode) 1381 ("bash2" . sh-mode)
1486 ("ash" . sh-mode) 1382 ("csh" . sh-mode)
1487 ("bash" . sh-mode) 1383 ("dtksh" . sh-mode)
1488 ("bash2" . sh-mode) 1384 ("es" . sh-mode)
1489 ("csh" . sh-mode) 1385 ("itcsh" . sh-mode)
1490 ("dtksh" . sh-mode) 1386 ("jsh" . sh-mode)
1491 ("es" . sh-mode) 1387 ("ksh" . sh-mode)
1492 ("itcsh" . sh-mode) 1388 ("oash" . sh-mode)
1493 ("jsh" . sh-mode) 1389 ("pdksh" . sh-mode)
1494 ("ksh" . sh-mode) 1390 ("rc" . sh-mode)
1495 ("oash" . sh-mode) 1391 ("rpm" . sh-mode)
1496 ("pdksh" . sh-mode) 1392 ("sh" . sh-mode)
1497 ("rc" . sh-mode) 1393 ("sh5" . sh-mode)
1498 ("rpm" . sh-mode) 1394 ("tcsh" . sh-mode)
1499 ("sh" . sh-mode) 1395 ("wksh" . sh-mode)
1500 ("sh5" . sh-mode) 1396 ("wsh" . sh-mode)
1501 ("tcsh" . sh-mode) 1397 ("zsh" . sh-mode)
1502 ("wksh" . sh-mode) 1398 ("tail" . text-mode)
1503 ("wsh" . sh-mode) 1399 ("more" . text-mode)
1504 ("zsh" . sh-mode) 1400 ("less" . text-mode)
1505 ("tail" . text-mode) 1401 ("pg" . text-mode))
1506 ("more" . text-mode)
1507 ("less" . text-mode)
1508 ("pg" . text-mode)
1509 ("make" . makefile-mode) ; Debian uses this
1510 ("guile" . scheme-mode)
1511 ("clisp" . lisp-mode)))
1512 "Alist mapping interpreter names to major modes. 1402 "Alist mapping interpreter names to major modes.
1513This alist applies to files whose first line starts with `#!'. 1403This alist applies to files whose first line starts with `#!'.
1514Each element looks like (INTERPRETER . MODE). 1404Each element looks like (INTERPRETER . MODE).
@@ -1524,16 +1414,8 @@ If it matches, mode MODE is selected.")
1524When checking `inhibit-first-line-modes-regexps', we first discard 1414When checking `inhibit-first-line-modes-regexps', we first discard
1525from the end of the file name anything that matches one of these regexps.") 1415from the end of the file name anything that matches one of these regexps.")
1526 1416
1527(defvar auto-mode-interpreter-regexp 1417(defvar user-init-file nil
1528 "#![ \t]?\\([^ \t\n]*\ 1418 "File name, including directory, of user's initialization file.")
1529/bin/env[ \t]\\)?\\([^ \t\n]+\\)"
1530 "Regular expression matching interpreters, for file mode determination.
1531This regular expression is matched against the first line of a file
1532to determine the file's mode in `set-auto-mode' when Emacs can't deduce
1533a mode from the file's name. If it matches, the file is assumed to
1534be interpreted by the interpreter matched by the second group of the
1535regular expression. The mode is then determined as the mode associated
1536with that interpreter in `interpreter-mode-alist'.")
1537 1419
1538(defun set-auto-mode (&optional just-from-file-name) 1420(defun set-auto-mode (&optional just-from-file-name)
1539 "Select major mode appropriate for current buffer. 1421 "Select major mode appropriate for current buffer.
@@ -1616,7 +1498,7 @@ and we don't even do that unless it would come from the file name."
1616 ;; outside the save-excursion. 1498 ;; outside the save-excursion.
1617 (when modes 1499 (when modes
1618 (unless just-from-file-name 1500 (unless just-from-file-name
1619 (mapc 'funcall (nreverse modes))) 1501 (mapcar 'funcall (nreverse modes)))
1620 (setq done t)) 1502 (setq done t))
1621 ;; If we didn't find a mode from a -*- line, try using the file name. 1503 ;; If we didn't find a mode from a -*- line, try using the file name.
1622 (if (and (not done) buffer-file-name) 1504 (if (and (not done) buffer-file-name)
@@ -1635,9 +1517,10 @@ and we don't even do that unless it would come from the file name."
1635 (if (string-match (car (car alist)) name) 1517 (if (string-match (car (car alist)) name)
1636 (if (and (consp (cdr (car alist))) 1518 (if (and (consp (cdr (car alist)))
1637 (nth 2 (car alist))) 1519 (nth 2 (car alist)))
1638 (setq mode (car (cdr (car alist))) 1520 (progn
1639 name (substring name 0 (match-beginning 0)) 1521 (setq mode (car (cdr (car alist)))
1640 keep-going t) 1522 name (substring name 0 (match-beginning 0))
1523 keep-going t))
1641 (setq mode (cdr (car alist)) 1524 (setq mode (cdr (car alist))
1642 keep-going nil))) 1525 keep-going nil)))
1643 (setq alist (cdr alist)))) 1526 (setq alist (cdr alist))))
@@ -1656,8 +1539,9 @@ and we don't even do that unless it would come from the file name."
1656 (let ((interpreter 1539 (let ((interpreter
1657 (save-excursion 1540 (save-excursion
1658 (goto-char (point-min)) 1541 (goto-char (point-min))
1659 (if (looking-at auto-mode-interpreter-regexp) 1542 (if (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
1660 (match-string 2) 1543 (buffer-substring (match-beginning 2)
1544 (match-end 2))
1661 ""))) 1545 "")))
1662 elt) 1546 elt)
1663 ;; Map interpreter name to a mode. 1547 ;; Map interpreter name to a mode.
@@ -1668,10 +1552,10 @@ and we don't even do that unless it would come from the file name."
1668 (funcall (cdr elt)))))))))))) 1552 (funcall (cdr elt))))))))))))
1669 1553
1670(defun hack-local-variables-prop-line () 1554(defun hack-local-variables-prop-line ()
1671 "Set local variables specified in the -*- line. 1555 ;; Set local variables specified in the -*- line.
1672Ignore any specification for `mode:' and `coding:'; 1556 ;; Ignore any specification for `mode:' and `coding:';
1673`set-auto-mode' should already have handled `mode:', 1557 ;; set-auto-mode should already have handled `mode:',
1674`set-auto-coding' should already have handled `coding:'." 1558 ;; set-auto-coding should already have handled `coding:'.
1675 (save-excursion 1559 (save-excursion
1676 (goto-char (point-min)) 1560 (goto-char (point-min))
1677 (let ((result nil) 1561 (let ((result nil)
@@ -1694,7 +1578,7 @@ Ignore any specification for `mode:' and `coding:';
1694 (error "-*- not terminated before end of line"))) 1578 (error "-*- not terminated before end of line")))
1695 (while (< (point) end) 1579 (while (< (point) end)
1696 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") 1580 (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
1697 (error "Malformed -*- line")) 1581 (error "malformed -*- line"))
1698 (goto-char (match-end 0)) 1582 (goto-char (match-end 0))
1699 ;; There used to be a downcase here, 1583 ;; There used to be a downcase here,
1700 ;; but the manual didn't say so, 1584 ;; but the manual didn't say so,
@@ -1859,9 +1743,9 @@ is specified, returning t if it is specified."
1859(defun hack-one-local-variable-quotep (exp) 1743(defun hack-one-local-variable-quotep (exp)
1860 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) 1744 (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
1861 1745
1746;; "Set" one variable in a local variables spec.
1747;; A few variable names are treated specially.
1862(defun hack-one-local-variable (var val) 1748(defun hack-one-local-variable (var val)
1863 "\"Set\" one variable in a local variables spec.
1864A few variable names are treated specially."
1865 (cond ((eq var 'mode) 1749 (cond ((eq var 'mode)
1866 (funcall (intern (concat (downcase (symbol-name val)) 1750 (funcall (intern (concat (downcase (symbol-name val))
1867 "-mode")))) 1751 "-mode"))))
@@ -2115,19 +1999,14 @@ no longer accessible under its old name."
2115 ;; Actually write the back up file. 1999 ;; Actually write the back up file.
2116 (condition-case () 2000 (condition-case ()
2117 (if (or file-precious-flag 2001 (if (or file-precious-flag
2118 ; (file-symlink-p buffer-file-name) 2002 ; (file-symlink-p buffer-file-name)
2119 backup-by-copying 2003 backup-by-copying
2120 (and backup-by-copying-when-linked 2004 (and backup-by-copying-when-linked
2121 (> (file-nlinks real-file-name) 1)) 2005 (> (file-nlinks real-file-name) 1))
2122 (and (or backup-by-copying-when-mismatch 2006 (and backup-by-copying-when-mismatch
2123 (integerp backup-by-copying-when-privileged-mismatch))
2124 (let ((attr (file-attributes real-file-name))) 2007 (let ((attr (file-attributes real-file-name)))
2125 (and (or backup-by-copying-when-mismatch 2008 (or (nth 9 attr)
2126 (and (integerp (nth 2 attr)) 2009 (not (file-ownership-preserved-p real-file-name))))))
2127 (integerp backup-by-copying-when-privileged-mismatch)
2128 (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
2129 (or (nth 9 attr)
2130 (not (file-ownership-preserved-p real-file-name)))))))
2131 (condition-case () 2010 (condition-case ()
2132 (copy-file real-file-name backupname t t) 2011 (copy-file real-file-name backupname t t)
2133 (file-error 2012 (file-error
@@ -2169,7 +2048,7 @@ no longer accessible under its old name."
2169 (file-error nil)))))) 2048 (file-error nil))))))
2170 2049
2171(defun file-name-sans-versions (name &optional keep-backup-version) 2050(defun file-name-sans-versions (name &optional keep-backup-version)
2172 "Return file NAME sans backup versions or strings. 2051 "Return FILENAME sans backup versions or strings.
2173This is a separate procedure so your site-init or startup file can 2052This is a separate procedure so your site-init or startup file can
2174redefine it. 2053redefine it.
2175If the optional argument KEEP-BACKUP-VERSION is non-nil, 2054If the optional argument KEEP-BACKUP-VERSION is non-nil,
@@ -2196,7 +2075,7 @@ we do not remove backup version numbers, only true file version numbers."
2196 (length name)))))))) 2075 (length name))))))))
2197 2076
2198(defun file-ownership-preserved-p (file) 2077(defun file-ownership-preserved-p (file)
2199 "Return t if deleting FILE and rewriting it would preserve the owner." 2078 "Returns t if deleting FILE and rewriting it would preserve the owner."
2200 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) 2079 (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
2201 (if handler 2080 (if handler
2202 (funcall handler 'file-ownership-preserved-p file) 2081 (funcall handler 'file-ownership-preserved-p file)
@@ -2235,117 +2114,19 @@ the value is \"\"."
2235 (if period 2114 (if period
2236 ""))))) 2115 "")))))
2237 2116
2238(defcustom make-backup-file-name-function nil
2239 "A function to use instead of the default `make-backup-file-name'.
2240A value of nil gives the default `make-backup-file-name' behaviour.
2241
2242This could be buffer-local to do something special for for specific
2243files. If you define it, you may need to change `backup-file-name-p'
2244and `file-name-sans-versions' too.
2245
2246See also `backup-directory-alist'."
2247 :group 'backup
2248 :type '(choice (const :tag "Default" nil)
2249 (function :tag "Your function")))
2250
2251(defcustom backup-directory-alist nil
2252 "Alist of filename patterns and backup directory names.
2253Each element looks like (REGEXP . DIRECTORY). Backups of files with
2254names matching REGEXP will be made in DIRECTORY. DIRECTORY may be
2255relative or absolute. If it is absolute, so that all matching files
2256are backed up into the same directory, the file names in this
2257directory will be the full name of the file backed up with all
2258directory separators changed to `!' to prevent clashes. This will not
2259work correctly if your filesystem truncates the resulting name.
2260
2261For the common case of all backups going into one directory, the alist
2262should contain a single element pairing \".\" with the appropriate
2263directory name.
2264
2265If this variable is nil, or it fails to match a filename, the backup
2266is made in the original file's directory.
2267
2268On MS-DOS filesystems without long names this variable is always
2269ignored."
2270 :group 'backup
2271 :type '(repeat (cons (regexp :tag "Regexp macthing filename")
2272 (directory :tag "Backup directory name"))))
2273
2274(defun make-backup-file-name (file) 2117(defun make-backup-file-name (file)
2275 "Create the non-numeric backup file name for FILE. 2118 "Create the non-numeric backup file name for FILE.
2276Normally this will just be the file's name with `~' appended. 2119This is a separate function so you can redefine it for customization."
2277Customization hooks are provided as follows. 2120 (if (and (eq system-type 'ms-dos)
2278 2121 (not (msdos-long-file-names)))
2279If the variable `make-backup-file-name-function' is non-nil, its value 2122 (let ((fn (file-name-nondirectory file)))
2280should be a function which will be called with FILE as its argument; 2123 (concat (file-name-directory file)
2281the resulting name is used. 2124 (or
2282 2125 (and (string-match "\\`[^.]+\\'" fn)
2283Otherwise a match for FILE is sought in `backup-directory-alist'; see 2126 (concat (match-string 0 fn) ".~"))
2284the documentation of that variable. If the directory for the backup 2127 (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
2285doesn't exist, it is created." 2128 (concat (match-string 0 fn) "~")))))
2286 (if make-backup-file-name-function 2129 (concat file "~")))
2287 (funcall make-backup-file-name-function file)
2288 (if (and (eq system-type 'ms-dos)
2289 (not (msdos-long-file-names)))
2290 (let ((fn (file-name-nondirectory file)))
2291 (concat (file-name-directory file)
2292 (or (and (string-match "\\`[^.]+\\'" fn)
2293 (concat (match-string 0 fn) ".~"))
2294 (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
2295 (concat (match-string 0 fn) "~")))))
2296 (concat (make-backup-file-name-1 file) "~"))))
2297
2298(defun make-backup-file-name-1 (file)
2299 "Subroutine of `make-backup-file-name' and `find-backup-file-name'."
2300 (let ((alist backup-directory-alist)
2301 elt backup-directory dir-sep-string)
2302 (while alist
2303 (setq elt (pop alist))
2304 (if (string-match (car elt) file)
2305 (setq backup-directory (cdr elt)
2306 alist nil)))
2307 (if (null backup-directory)
2308 file
2309 (unless (file-exists-p backup-directory)
2310 (condition-case nil
2311 (make-directory backup-directory 'parents)
2312 (file-error file)))
2313 (if (file-name-absolute-p backup-directory)
2314 (progn
2315 (when (memq system-type '(windows-nt ms-dos))
2316 ;; Normalize DOSish file names: convert all slashes to
2317 ;; directory-sep-char, downcase the drive letter, if any,
2318 ;; and replace the leading "x:" with "/drive_x".
2319 (or (file-name-absolute-p file)
2320 (setq file (expand-file-name file))) ; make defaults explicit
2321 ;; Replace any invalid file-name characters (for the
2322 ;; case of backing up remote files).
2323 (setq file (convert-standard-filename file))
2324 (setq dir-sep-string (char-to-string directory-sep-char))
2325 (or (eq directory-sep-char ?/)
2326 (subst-char-in-string ?/ ?\\ file))
2327 (or (eq directory-sep-char ?\\)
2328 (subst-char-in-string ?\\ ?/ file))
2329 (if (eq (aref file 1) ?:)
2330 (setq file (concat dir-sep-string
2331 "drive_"
2332 (char-to-string (downcase (aref file 0)))
2333 (if (eq (aref file 2) directory-sep-char)
2334 ""
2335 dir-sep-string)
2336 (substring file 2)))))
2337 ;; Make the name unique by substituting directory
2338 ;; separators. It may not really be worth bothering about
2339 ;; doubling `!'s in the original name...
2340 (expand-file-name
2341 (subst-char-in-string
2342 directory-sep-char ?!
2343 (replace-regexp-in-string "!" "!!" file))
2344 backup-directory))
2345 (expand-file-name (file-name-nondirectory file)
2346 (file-name-as-directory
2347 (expand-file-name backup-directory
2348 (file-name-directory file))))))))
2349 2130
2350(defun backup-file-name-p (file) 2131(defun backup-file-name-p (file)
2351 "Return non-nil if FILE is a backup file name (numeric or not). 2132 "Return non-nil if FILE is a backup file name (numeric or not).
@@ -2359,7 +2140,7 @@ You may need to redefine `file-name-sans-versions' as well."
2359;; The usage of backup-extract-version-start is not very clean, 2140;; The usage of backup-extract-version-start is not very clean,
2360;; but I can't see a good alternative, so as of now I am leaving it alone. 2141;; but I can't see a good alternative, so as of now I am leaving it alone.
2361(defun backup-extract-version (fn) 2142(defun backup-extract-version (fn)
2362 "Given the name of a numeric backup file, FN, return the backup number. 2143 "Given the name of a numeric backup file, return the backup number.
2363Uses the free variable `backup-extract-version-start', whose value should be 2144Uses the free variable `backup-extract-version-start', whose value should be
2364the index in the name where the version number begins." 2145the index in the name where the version number begins."
2365 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start) 2146 (if (and (string-match "[0-9]+~$" fn backup-extract-version-start)
@@ -2370,49 +2151,47 @@ the index in the name where the version number begins."
2370;; I believe there is no need to alter this behavior for VMS; 2151;; I believe there is no need to alter this behavior for VMS;
2371;; since backup files are not made on VMS, it should not get called. 2152;; since backup files are not made on VMS, it should not get called.
2372(defun find-backup-file-name (fn) 2153(defun find-backup-file-name (fn)
2373 "Find a file name for a backup file FN, and suggestions for deletions. 2154 "Find a file name for a backup file, and suggestions for deletions.
2374Value is a list whose car is the name for the backup file 2155Value is a list whose car is the name for the backup file
2375and whose cdr is a list of old versions to consider deleting now. 2156 and whose cdr is a list of old versions to consider deleting now.
2376If the value is nil, don't make a backup. 2157If the value is nil, don't make a backup."
2377Uses `backup-directory-alist' in the same way as does
2378`make-backup-file-name'."
2379 (let ((handler (find-file-name-handler fn 'find-backup-file-name))) 2158 (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
2380 ;; Run a handler for this function so that ange-ftp can refuse to do it. 2159 ;; Run a handler for this function so that ange-ftp can refuse to do it.
2381 (if handler 2160 (if handler
2382 (funcall handler 'find-backup-file-name fn) 2161 (funcall handler 'find-backup-file-name fn)
2383 (if (eq version-control 'never) 2162 (if (eq version-control 'never)
2384 (list (make-backup-file-name fn)) 2163 (list (make-backup-file-name fn))
2385 (let* ((basic-name (make-backup-file-name-1 fn)) 2164 (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
2386 (base-versions (concat (file-name-nondirectory basic-name)
2387 ".~"))
2388 (backup-extract-version-start (length base-versions)) 2165 (backup-extract-version-start (length base-versions))
2166 possibilities
2167 (versions nil)
2389 (high-water-mark 0) 2168 (high-water-mark 0)
2390 (number-to-delete 0) 2169 (deserve-versions-p nil)
2391 possibilities deserve-versions-p versions) 2170 (number-to-delete 0))
2392 (condition-case () 2171 (condition-case ()
2393 (setq possibilities (file-name-all-completions 2172 (setq possibilities (file-name-all-completions
2394 base-versions 2173 base-versions
2395 (file-name-directory basic-name)) 2174 (file-name-directory fn))
2396 versions (sort (mapcar #'backup-extract-version 2175 versions (sort (mapcar
2397 possibilities) 2176 (function backup-extract-version)
2398 #'<) 2177 possibilities)
2178 '<)
2399 high-water-mark (apply 'max 0 versions) 2179 high-water-mark (apply 'max 0 versions)
2400 deserve-versions-p (or version-control 2180 deserve-versions-p (or version-control
2401 (> high-water-mark 0)) 2181 (> high-water-mark 0))
2402 number-to-delete (- (length versions) 2182 number-to-delete (- (length versions)
2403 kept-old-versions 2183 kept-old-versions kept-new-versions -1))
2404 kept-new-versions 2184 (file-error
2405 -1)) 2185 (setq possibilities nil)))
2406 (file-error (setq possibilities nil)))
2407 (if (not deserve-versions-p) 2186 (if (not deserve-versions-p)
2408 (list (concat basic-name "~")) 2187 (list (make-backup-file-name fn))
2409 (cons (format "%s.~%d~" basic-name (1+ high-water-mark)) 2188 (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
2410 (if (and (> number-to-delete 0) 2189 (if (and (> number-to-delete 0)
2411 ;; Delete nothing if there is overflow 2190 ;; Delete nothing if there is overflow
2412 ;; in the number of versions to keep. 2191 ;; in the number of versions to keep.
2413 (>= (+ kept-new-versions kept-old-versions -1) 0)) 2192 (>= (+ kept-new-versions kept-old-versions -1) 0))
2414 (mapcar (lambda (n) 2193 (mapcar (function (lambda (n)
2415 (format "%s.~%d~" basic-name n)) 2194 (concat fn ".~" (int-to-string n) "~")))
2416 (let ((v (nthcdr kept-old-versions versions))) 2195 (let ((v (nthcdr kept-old-versions versions)))
2417 (rplacd (nthcdr (1- number-to-delete) v) ()) 2196 (rplacd (nthcdr (1- number-to-delete) v) ())
2418 v)))))))))) 2197 v))))))))))
@@ -2422,7 +2201,7 @@ Uses `backup-directory-alist' in the same way as does
2422 (car (cdr (file-attributes filename)))) 2201 (car (cdr (file-attributes filename))))
2423 2202
2424(defun file-relative-name (filename &optional directory) 2203(defun file-relative-name (filename &optional directory)
2425 "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). 2204 "Convert FILENAME to be relative to DIRECTORY (default: default-directory).
2426This function returns a relative file name which is equivalent to FILENAME 2205This function returns a relative file name which is equivalent to FILENAME
2427when used with that default directory as the default. 2206when used with that default directory as the default.
2428If this is impossible (which can happen on MSDOS and Windows 2207If this is impossible (which can happen on MSDOS and Windows
@@ -2519,11 +2298,8 @@ the last real save, but optional arg FORCE non-nil means delete anyway."
2519(defvar auto-save-hook nil 2298(defvar auto-save-hook nil
2520 "Normal hook run just before auto-saving.") 2299 "Normal hook run just before auto-saving.")
2521 2300
2522(defcustom after-save-hook nil 2301(defvar after-save-hook nil
2523 "Normal hook that is run after a buffer is saved to its file." 2302 "Normal hook that is run after a buffer is saved to its file.")
2524 :options '(executable-make-buffer-file-executable-if-script-p)
2525 :type 'hook
2526 :group 'files)
2527 2303
2528(defvar save-buffer-coding-system nil 2304(defvar save-buffer-coding-system nil
2529 "If non-nil, use this coding system for saving the buffer. 2305 "If non-nil, use this coding system for saving the buffer.
@@ -2594,6 +2370,8 @@ After saving the buffer, this function runs `after-save-hook'."
2594 (save-excursion 2370 (save-excursion
2595 (goto-char (point-max)) 2371 (goto-char (point-max))
2596 (insert ?\n)))) 2372 (insert ?\n))))
2373 ;; Support VC version backups.
2374 (vc-before-save)
2597 (or (run-hook-with-args-until-success 'write-contents-hooks) 2375 (or (run-hook-with-args-until-success 'write-contents-hooks)
2598 (run-hook-with-args-until-success 'local-write-file-hooks) 2376 (run-hook-with-args-until-success 'local-write-file-hooks)
2599 (run-hook-with-args-until-success 'write-file-hooks) 2377 (run-hook-with-args-until-success 'write-file-hooks)
@@ -2665,9 +2443,7 @@ After saving the buffer, this function runs `after-save-hook'."
2665 (if (and (eq system-type 'ms-dos) 2443 (if (and (eq system-type 'ms-dos)
2666 (not (msdos-long-file-names))) 2444 (not (msdos-long-file-names)))
2667 "%s#%d.tm#" ; MSDOS limits files to 8+3 2445 "%s#%d.tm#" ; MSDOS limits files to 8+3
2668 (if (memq system-type '(vax-vms axp-vms)) 2446 "%s#tmp#%d")
2669 "%s$tmp$%d"
2670 "%s#tmp#%d"))
2671 dir i)) 2447 dir i))
2672 (setq nogood (file-exists-p tempname)) 2448 (setq nogood (file-exists-p tempname))
2673 (setq i (1+ i))) 2449 (setq i (1+ i)))
@@ -2697,19 +2473,16 @@ After saving the buffer, this function runs `after-save-hook'."
2697 (cond ((and tempsetmodes (not setmodes)) 2473 (cond ((and tempsetmodes (not setmodes))
2698 ;; Change the mode back, after writing. 2474 ;; Change the mode back, after writing.
2699 (setq setmodes (file-modes buffer-file-name)) 2475 (setq setmodes (file-modes buffer-file-name))
2700 (set-file-modes buffer-file-name (logior setmodes 128)))) 2476 (set-file-modes buffer-file-name 511)))
2701 (write-region (point-min) (point-max) 2477 (write-region (point-min) (point-max)
2702 buffer-file-name nil t buffer-file-truename))) 2478 buffer-file-name nil t buffer-file-truename)))
2703 setmodes)) 2479 setmodes))
2704 2480
2705(defun save-some-buffers (&optional arg pred) 2481(defun save-some-buffers (&optional arg exiting)
2706 "Save some modified file-visiting buffers. Asks user about each one. 2482 "Save some modified file-visiting buffers. Asks user about each one.
2707Optional argument (the prefix) non-nil means save all with no questions. 2483Optional argument (the prefix) non-nil means save all with no questions.
2708Optional second argument PRED determines which buffers are considered: 2484Optional second argument EXITING means ask about certain non-file buffers
2709If PRED is nil, all the file-visiting buffers are considered. 2485 as well as about file buffers."
2710If PRED is t, then certain non-file buffers will also be considered.
2711If PRED is a zero-argument function, it indicates for each buffer whether
2712to consider it or not when called with that buffer current."
2713 (interactive "P") 2486 (interactive "P")
2714 (save-window-excursion 2487 (save-window-excursion
2715 (let* ((queried nil) 2488 (let* ((queried nil)
@@ -2721,12 +2494,10 @@ to consider it or not when called with that buffer current."
2721 (not (buffer-base-buffer buffer)) 2494 (not (buffer-base-buffer buffer))
2722 (or 2495 (or
2723 (buffer-file-name buffer) 2496 (buffer-file-name buffer)
2724 (and pred 2497 (and exiting
2725 (progn 2498 (progn
2726 (set-buffer buffer) 2499 (set-buffer buffer)
2727 (and buffer-offer-save (> (buffer-size) 0))))) 2500 (and buffer-offer-save (> (buffer-size) 0)))))
2728 (or (not (functionp pred))
2729 (with-current-buffer buffer (funcall pred)))
2730 (if arg 2501 (if arg
2731 t 2502 t
2732 (setq queried t) 2503 (setq queried t)
@@ -2818,18 +2589,15 @@ saying what text to write."
2818 2589
2819(defun file-newest-backup (filename) 2590(defun file-newest-backup (filename)
2820 "Return most recent backup file for FILENAME or nil if no backups exist." 2591 "Return most recent backup file for FILENAME or nil if no backups exist."
2821 ;; `make-backup-file-name' will get us the right directory for 2592 (let* ((filename (expand-file-name filename))
2822 ;; ordinary or numeric backups. It might create a directory for
2823 ;; backups as a side-effect, according to `backup-directory-alist'.
2824 (let* ((filename (file-name-sans-versions
2825 (make-backup-file-name filename)))
2826 (file (file-name-nondirectory filename)) 2593 (file (file-name-nondirectory filename))
2827 (dir (file-name-directory filename)) 2594 (dir (file-name-directory filename))
2828 (comp (file-name-all-completions file dir)) 2595 (comp (file-name-all-completions file dir))
2829 (newest nil) 2596 (newest nil)
2830 tem) 2597 tem)
2831 (while comp 2598 (while comp
2832 (setq tem (pop comp)) 2599 (setq tem (car comp)
2600 comp (cdr comp))
2833 (cond ((and (backup-file-name-p tem) 2601 (cond ((and (backup-file-name-p tem)
2834 (string= (file-name-sans-versions tem) file)) 2602 (string= (file-name-sans-versions tem) file))
2835 (setq tem (concat dir tem)) 2603 (setq tem (concat dir tem))
@@ -2930,7 +2698,7 @@ sake of backward compatibility. IGNORE-AUTO is optional, defaulting
2930to nil. 2698to nil.
2931 2699
2932Optional second argument NOCONFIRM means don't ask for confirmation at 2700Optional second argument NOCONFIRM means don't ask for confirmation at
2933all. (The local variable `revert-without-query', if non-nil, prevents 2701all. (The local variable `revert-without-query', if non-nil, prevents
2934confirmation.) 2702confirmation.)
2935 2703
2936Optional third argument PRESERVE-MODES non-nil means don't alter 2704Optional third argument PRESERVE-MODES non-nil means don't alter
@@ -3041,15 +2809,12 @@ non-nil, it is called instead of rereading visited file contents."
3041 (not (file-exists-p file-name))) 2809 (not (file-exists-p file-name)))
3042 (error "Auto-save file %s not current" file-name)) 2810 (error "Auto-save file %s not current" file-name))
3043 ((save-window-excursion 2811 ((save-window-excursion
3044 (with-output-to-temp-buffer "*Directory*" 2812 (if (not (memq system-type '(vax-vms windows-nt)))
3045 (buffer-disable-undo standard-output) 2813 (with-output-to-temp-buffer "*Directory*"
3046 (save-excursion 2814 (buffer-disable-undo standard-output)
3047 (let ((switches dired-listing-switches)) 2815 (call-process "ls" nil standard-output nil
3048 (if (file-symlink-p file) 2816 (if (file-symlink-p file) "-lL" "-l")
3049 (setq switches (concat switches "L"))) 2817 file file-name)))
3050 (set-buffer standard-output)
3051 (insert-directory file switches)
3052 (insert-directory file-name switches))))
3053 (yes-or-no-p (format "Recover auto save file %s? " file-name))) 2818 (yes-or-no-p (format "Recover auto save file %s? " file-name)))
3054 (switch-to-buffer (find-file-noselect file t)) 2819 (switch-to-buffer (find-file-noselect file t))
3055 (let ((buffer-read-only nil) 2820 (let ((buffer-read-only nil)
@@ -3072,9 +2837,6 @@ Then you'll be asked about a number of files to recover."
3072 (interactive) 2837 (interactive)
3073 (if (null auto-save-list-file-prefix) 2838 (if (null auto-save-list-file-prefix)
3074 (error "You set `auto-save-list-file-prefix' to disable making session files")) 2839 (error "You set `auto-save-list-file-prefix' to disable making session files"))
3075 (let ((dir (file-name-directory auto-save-list-file-prefix)))
3076 (unless (file-directory-p dir)
3077 (make-directory dir t)))
3078 (let ((ls-lisp-support-shell-wildcards t)) 2840 (let ((ls-lisp-support-shell-wildcards t))
3079 (dired (concat auto-save-list-file-prefix "*") 2841 (dired (concat auto-save-list-file-prefix "*")
3080 (concat dired-listing-switches "t"))) 2842 (concat dired-listing-switches "t")))
@@ -3224,29 +2986,17 @@ Does not consider `auto-save-visited-file-name' as that variable is checked
3224before calling this function. You can redefine this for customization. 2986before calling this function. You can redefine this for customization.
3225See also `auto-save-file-name-p'." 2987See also `auto-save-file-name-p'."
3226 (if buffer-file-name 2988 (if buffer-file-name
3227 (let ((list auto-save-file-name-transforms) 2989 (if (and (eq system-type 'ms-dos)
3228 (filename buffer-file-name) 2990 (not (msdos-long-file-names)))
3229 result) 2991 (let ((fn (file-name-nondirectory buffer-file-name)))
3230 ;; Apply user-specified translations 2992 (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
3231 ;; to the file name. 2993 (concat (file-name-directory buffer-file-name)
3232 (while (and list (not result)) 2994 "#" (match-string 1 fn)
3233 (if (string-match (car (car list)) filename) 2995 "." (match-string 3 fn) "#"))
3234 (setq result (replace-match (cadr (car list)) t nil 2996 (concat (file-name-directory buffer-file-name)
3235 filename))) 2997 "#"
3236 (setq list (cdr list))) 2998 (file-name-nondirectory buffer-file-name)
3237 (if result (setq filename result)) 2999 "#"))
3238
3239 (if (and (eq system-type 'ms-dos)
3240 (not (msdos-long-file-names)))
3241 (let ((fn (file-name-nondirectory buffer-file-name)))
3242 (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
3243 (concat (file-name-directory buffer-file-name)
3244 "#" (match-string 1 fn)
3245 "." (match-string 3 fn) "#"))
3246 (concat (file-name-directory filename)
3247 "#"
3248 (file-name-nondirectory filename)
3249 "#")))
3250 3000
3251 ;; Deal with buffers that don't have any associated files. (Mail 3001 ;; Deal with buffers that don't have any associated files. (Mail
3252 ;; mode tends to create a good number of these.) 3002 ;; mode tends to create a good number of these.)
@@ -3351,7 +3101,7 @@ by `sh' are supported."
3351 3101
3352(defcustom list-directory-brief-switches 3102(defcustom list-directory-brief-switches
3353 (if (eq system-type 'vax-vms) "" "-CF") 3103 (if (eq system-type 'vax-vms) "" "-CF")
3354 "*Switches for `list-directory' to pass to `ls' for brief listing." 3104 "*Switches for list-directory to pass to `ls' for brief listing,"
3355 :type 'string 3105 :type 'string
3356 :group 'dired) 3106 :group 'dired)
3357 3107
@@ -3359,7 +3109,7 @@ by `sh' are supported."
3359 (if (eq system-type 'vax-vms) 3109 (if (eq system-type 'vax-vms)
3360 "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)" 3110 "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)"
3361 "-l") 3111 "-l")
3362 "*Switches for `list-directory' to pass to `ls' for verbose listing." 3112 "*Switches for list-directory to pass to `ls' for verbose listing,"
3363 :type 'string 3113 :type 'string
3364 :group 'dired) 3114 :group 'dired)
3365 3115
@@ -3435,52 +3185,6 @@ and `list-directory-verbose-switches'."
3435 (let ((wildcard (not (file-directory-p dirname)))) 3185 (let ((wildcard (not (file-directory-p dirname))))
3436 (insert-directory dirname switches wildcard (not wildcard))))))) 3186 (insert-directory dirname switches wildcard (not wildcard)))))))
3437 3187
3438(defun shell-quote-wildcard-pattern (pattern)
3439 "Quote characters special to the shell in PATTERN, leave wildcards alone.
3440
3441PATTERN is assumed to represent a file-name wildcard suitable for the
3442underlying filesystem. For Unix and GNU/Linux, the characters from the
3443set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all
3444the parts of the pattern which don't include wildcard characters are
3445quoted with double quotes.
3446Existing quote characters in PATTERN are left alone, so you can pass
3447PATTERN that already quotes some of the special characters."
3448 (save-match-data
3449 (cond
3450 ((memq system-type '(ms-dos windows-nt))
3451 ;; DOS/Windows don't allow `"' in file names. So if the
3452 ;; argument has quotes, we can safely assume it is already
3453 ;; quoted by the caller.
3454 (if (or (string-match "[\"]" pattern)
3455 ;; We quote [&()#$'] in case their shell is a port of a
3456 ;; Unixy shell. We quote [,=+] because stock DOS and
3457 ;; Windows shells require that in some cases, such as
3458 ;; passing arguments to batch files that use positional
3459 ;; arguments like %1.
3460 (not (string-match "[ \t;&()#$',=+]" pattern)))
3461 pattern
3462 (let ((result "\"")
3463 (beg 0)
3464 end)
3465 (while (string-match "[*?]+" pattern beg)
3466 (setq end (match-beginning 0)
3467 result (concat result (substring pattern beg end)
3468 "\""
3469 (substring pattern end (match-end 0))
3470 "\"")
3471 beg (match-end 0)))
3472 (concat result (substring pattern beg) "\""))))
3473 (t
3474 (let ((beg 0))
3475 (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
3476 (setq pattern
3477 (concat (substring pattern 0 (match-beginning 0))
3478 "\\"
3479 (substring pattern (match-beginning 0)))
3480 beg (1+ (match-end 0)))))
3481 pattern))))
3482
3483
3484(defvar insert-directory-program "ls" 3188(defvar insert-directory-program "ls"
3485 "Absolute or relative name of the `ls' program used by `insert-directory'.") 3189 "Absolute or relative name of the `ls' program used by `insert-directory'.")
3486 3190
@@ -3516,7 +3220,7 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'."
3516 ;; We need the directory in order to find the right handler. 3220 ;; We need the directory in order to find the right handler.
3517 (let ((handler (find-file-name-handler (expand-file-name file) 3221 (let ((handler (find-file-name-handler (expand-file-name file)
3518 'insert-directory))) 3222 'insert-directory)))
3519 (if handler 3223 (if handler
3520 (funcall handler 'insert-directory file switches 3224 (funcall handler 'insert-directory file switches
3521 wildcard full-directory-p) 3225 wildcard full-directory-p)
3522 (if (eq system-type 'vax-vms) 3226 (if (eq system-type 'vax-vms)
@@ -3529,86 +3233,63 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'."
3529 (coding-system-for-write coding-system-for-read) 3233 (coding-system-for-write coding-system-for-read)
3530 (result 3234 (result
3531 (if wildcard 3235 (if wildcard
3532 ;; Run ls in the directory of the file pattern we asked for 3236 ;; Run ls in the directory of the file pattern we asked for.
3533 (let ((default-directory 3237 (let ((default-directory
3534 (if (file-name-absolute-p file) 3238 (if (file-name-absolute-p file)
3535 (file-name-directory file) 3239 (file-name-directory file)
3536 (file-name-directory (expand-file-name file)))) 3240 (file-name-directory (expand-file-name file))))
3537 (pattern (file-name-nondirectory file))) 3241 (pattern (file-name-nondirectory file))
3538 (call-process 3242 (beg 0))
3539 shell-file-name nil t nil 3243 ;; Quote some characters that have special meanings in shells;
3540 "-c" (concat (if (memq system-type '(ms-dos windows-nt)) 3244 ;; but don't quote the wildcards--we want them to be special.
3541 "" 3245 ;; We also currently don't quote the quoting characters
3542 "\\") ; Disregard Unix shell aliases! 3246 ;; in case people want to use them explicitly to quote
3543 insert-directory-program 3247 ;; wildcard characters.
3544 " -d " 3248 (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
3545 (if (stringp switches) 3249 (setq pattern
3546 switches 3250 (concat (substring pattern 0 (match-beginning 0))
3547 (mapconcat 'identity switches " ")) 3251 "\\"
3548 " -- " 3252 (substring pattern (match-beginning 0)))
3549 ;; Quote some characters that have 3253 beg (1+ (match-end 0))))
3550 ;; special meanings in shells; but 3254 (call-process shell-file-name nil t nil
3551 ;; don't quote the wildcards--we 3255 "-c" (concat "\\";; Disregard shell aliases!
3552 ;; want them to be special. We 3256 insert-directory-program
3553 ;; also currently don't quote the 3257 " -d "
3554 ;; quoting characters in case 3258 (if (stringp switches)
3555 ;; people want to use them 3259 switches
3556 ;; explicitly to quote wildcard 3260 (mapconcat 'identity switches " "))
3557 ;; characters. 3261 " -- "
3558 (shell-quote-wildcard-pattern pattern)))) 3262 pattern)))
3559 ;; SunOS 4.1.3, SVr4 and others need the "." to list the 3263 ;; SunOS 4.1.3, SVr4 and others need the "." to list the
3560 ;; directory if FILE is a symbolic link. 3264 ;; directory if FILE is a symbolic link.
3561 (apply 'call-process 3265 (apply 'call-process
3562 insert-directory-program nil t nil 3266 insert-directory-program nil t nil
3563 (append 3267 (let (list)
3564 (if (listp switches) switches 3268 (if (listp switches)
3565 (unless (equal switches "") 3269 (setq list switches)
3566 ;; Split the switches at any spaces so we can 3270 (if (not (equal switches ""))
3567 ;; pass separate options as separate args. 3271 (progn
3568 (split-string switches))) 3272 ;; Split the switches at any spaces
3569 ;; Avoid lossage if FILE starts with `-'. 3273 ;; so we can pass separate options as separate args.
3570 '("--") 3274 (while (string-match " " switches)
3571 (progn 3275 (setq list (cons (substring switches 0 (match-beginning 0))
3572 (if (string-match "\\`~" file) 3276 list)
3573 (setq file (expand-file-name file))) 3277 switches (substring switches (match-end 0))))
3574 (list 3278 (setq list (nreverse (cons switches list))))))
3575 (if full-directory-p 3279 (append list
3576 (concat (file-name-as-directory file) ".") 3280 ;; Avoid lossage if FILE starts with `-'.
3577 file)))))))) 3281 '("--")
3282 (progn
3283 (if (string-match "\\`~" file)
3284 (setq file (expand-file-name file)))
3285 (list
3286 (if full-directory-p
3287 (concat (file-name-as-directory file) ".")
3288 file)))))))))
3578 (if (/= result 0) 3289 (if (/= result 0)
3579 ;; We get here if `insert-directory-program' failed. 3290 ;; We get here if ls failed.
3580 ;; On non-Posix systems, we cannot open a directory, so 3291 ;; Access the file to get a suitable error.
3581 ;; don't even try, because that will always result in 3292 (access-file file "Reading directory")))))))
3582 ;; the ubiquitous "Access denied". Instead, show them
3583 ;; the `ls' command line and let them guess what went
3584 ;; wrong.
3585 (if (and (file-directory-p file)
3586 (memq system-type '(ms-dos windows-nt)))
3587 (error
3588 "Reading directory: \"%s %s -- %s\" exited with status %s"
3589 insert-directory-program
3590 (if (listp switches) (concat switches) switches)
3591 file result)
3592 ;; Unix. Access the file to get a suitable error.
3593 (access-file file "Reading directory"))
3594 ;; Replace "total" with "used", to avoid confusion.
3595 ;; Add in the amount of free space.
3596 (save-excursion
3597 (goto-char (point-min))
3598 (when (re-search-forward "^total" nil t)
3599 (replace-match "used")
3600 (end-of-line)
3601 (let (available)
3602 (with-temp-buffer
3603 (call-process "df" nil t nil ".")
3604 (goto-char (point-min))
3605 (forward-line 1)
3606 (skip-chars-forward "^ \t")
3607 (forward-word 3)
3608 (let ((end (point)))
3609 (forward-word -1)
3610 (setq available (buffer-substring (point) end))))
3611 (insert " available " available))))))))))
3612 3293
3613(defvar kill-emacs-query-functions nil 3294(defvar kill-emacs-query-functions nil
3614 "Functions to call with no arguments to query about killing Emacs. 3295 "Functions to call with no arguments to query about killing Emacs.
@@ -3645,7 +3326,7 @@ With prefix arg, silently save all file-visiting buffers, then kill."
3645 (run-hook-with-args-until-failure 'kill-emacs-query-functions) 3326 (run-hook-with-args-until-failure 'kill-emacs-query-functions)
3646 (kill-emacs))) 3327 (kill-emacs)))
3647 3328
3648;; We use /: as a prefix to "quote" a file name 3329;; We use /: as a prefix to "quote" a file name
3649;; so that magic file name handlers will not apply to it. 3330;; so that magic file name handlers will not apply to it.
3650 3331
3651(setq file-name-handler-alist 3332(setq file-name-handler-alist
@@ -3662,7 +3343,7 @@ With prefix arg, silently save all file-visiting buffers, then kill."
3662 (default-directory 3343 (default-directory
3663 (if (eq operation 'insert-directory) 3344 (if (eq operation 'insert-directory)
3664 (directory-file-name 3345 (directory-file-name
3665 (expand-file-name 3346 (expand-file-name
3666 (unhandled-file-name-directory default-directory))) 3347 (unhandled-file-name-directory default-directory)))
3667 default-directory)) 3348 default-directory))
3668 ;; Get a list of the indices of the args which are file names. 3349 ;; Get a list of the indices of the args which are file names.