diff options
| author | André Spiegel | 2000-10-04 09:55:21 +0000 |
|---|---|---|
| committer | André Spiegel | 2000-10-04 09:55:21 +0000 |
| commit | fa5867f6aa5f4a87168a8beff305662c834511a5 (patch) | |
| tree | df4a89333e364e8a35f1ba29c81b0174eb23d417 | |
| parent | b3d6528a4c29f91232a46dc05bd231d0229a38a6 (diff) | |
| download | emacs-fa5867f6aa5f4a87168a8beff305662c834511a5.tar.gz emacs-fa5867f6aa5f4a87168a8beff305662c834511a5.zip | |
(basic-save-buffer): Call vc-before-save before saving.
| -rw-r--r-- | lisp/files.el | 983 |
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. | |||
| 84 | The file's owner and group are unchanged. | 84 | The file's owner and group are unchanged. |
| 85 | 85 | ||
| 86 | The choice of renaming or copying is controlled by the variables | 86 | The 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) |
| 126 | Renaming may still be used (subject to control of other variables) | 125 | (or (< (length name) 5) |
| 127 | when it would not result in changing the owner of the file or if the owner | 126 | (not (string-equal "/tmp/" (substring name 0 5))))) |
| 128 | has a user id greater than the value of this variable. This is useful | ||
| 129 | when low-numbered uid's are used for special system users (such as root) | ||
| 130 | that must maintain ownership of certain files. | ||
| 131 | This 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. | ||
| 138 | Checks 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. |
| 155 | Called with an absolute file name as argument, it returns t to enable backup.") | 128 | Called 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 |
| 159 | Do so even if the buffer is not visiting a file. | 132 | even if the buffer is not visiting a file. |
| 160 | Automatically local in all buffers." | 133 | Automatically 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. | ||
| 287 | Each transform is a list (REGEXP REPLACEMENT): | ||
| 288 | REGEXP is a regular expression to match against the file name. | ||
| 289 | If it matches, `replace-match' is used to replace the | ||
| 290 | matching part with REPLACEMENT. | ||
| 291 | All the transforms in the list are tried, in the order they are listed. | ||
| 292 | When one transform applies, its result is final; | ||
| 293 | no further transforms are tried. | ||
| 294 | |||
| 295 | The default value is set up to put the auto-save file into `/tmp' | ||
| 296 | for 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. |
| 303 | Loading an abbrev file sets this to t." | 259 | Loading 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." |
| 309 | To 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. | ||
| 315 | Each function is called with the directory name as the sole argument | ||
| 316 | and 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. |
| 324 | These functions are called as soon as the error is detected. | 272 | These functions are called as soon as the error is detected. |
| 325 | Variable `buffer-file-name' is already set up. | 273 | `buffer-file-name' is already set up. |
| 326 | The functions are called in the order given until one of them returns non-nil.") | 274 | The 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.") | |||
| 337 | If one of them returns non-nil, the file is considered already written | 285 | If one of them returns non-nil, the file is considered already written |
| 338 | and the rest are not called. | 286 | and the rest are not called. |
| 339 | These hooks are considered to pertain to the visited file. | 287 | These hooks are considered to pertain to the visited file. |
| 340 | So any buffer-local binding of `write-file-hooks' is | 288 | So this list is cleared if you change the visited file name. |
| 341 | discarded if you change the visited file name with \\[set-visited-file-name]. | ||
| 342 | 289 | ||
| 343 | Don't make this variable buffer-local; instead, use `local-write-file-hooks'. | 290 | Don't make this variable buffer-local; instead, use `local-write-file-hooks'. |
| 344 | See also `write-contents-hooks'.") | 291 | See 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. | ||
| 439 | If non-nil, this directory is used instead of `temporary-file-directory' | ||
| 440 | by programs that create small temporary files. This is for systems that | ||
| 441 | have 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. | ||
| 448 | Runs 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. |
| 462 | This function's standard definition is trivial; it just returns the argument. | 402 | This function's standard definition is trivial; it just returns the argument. |
| 463 | However, on some systems, the function is redefined with a definition | 403 | However, on some systems, the function is redefined |
| 464 | that really does change some file names to canonicalize certain | 404 | with a definition that really does change some file names." |
| 465 | patterns 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." | |||
| 475 | Not actually set up until the first time you you use it.") | 414 | Not 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. |
| 551 | Returns the name of the local copy, or nil, if FILE is directly | 486 | Returns the name of the local copy, or nil, if FILE is directly |
| 552 | accessible." | 487 | accessible." |
| 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." | |||
| 718 | Switch to a buffer visiting file FILENAME, | 651 | Switch to a buffer visiting file FILENAME, |
| 719 | creating one if none already exists. | 652 | creating one if none already exists. |
| 720 | Interactively, or if WILDCARDS is non-nil in a call from Lisp, | 653 | Interactively, or if WILDCARDS is non-nil in a call from Lisp, |
| 721 | expand wildcards (if any) and visit multiple files. Wildcard expansion | 654 | expand wildcards (if any) and visit multiple files." |
| 722 | can 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. |
| 761 | Like `find-file' but marks buffer as read-only. | 693 | Like \\[find-file] but marks buffer as read-only. |
| 762 | Use \\[toggle-read-only] to permit editing." | 694 | Use \\[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." | |||
| 859 | Choose the buffer's name using `generate-new-buffer-name'." | 791 | Choose 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. | ||
| 971 | When nil, Emacs prints a warning when visiting a file that is already | ||
| 972 | visited, but with a different name. Setting this option to t | ||
| 973 | suppresses 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. |
| 980 | If a buffer exists visiting FILENAME, return that one, but | 901 | If 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. | |||
| 1208 | This is a permanent local.") | 1125 | This 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. |
| 1213 | Format conversion and character code conversion are both disabled, | 1130 | Format conversion and character code conversion are both disabled, |
| 1214 | and multibyte characters are disabled in the resulting buffer. | 1131 | and 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) | 1355 | Alist 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. | ||
| 1460 | Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). | 1356 | Each 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.) |
| 1462 | Visiting a file whose name matches REGEXP specifies FUNCTION as the | 1358 | Visiting 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. |
| 1513 | This alist applies to files whose first line starts with `#!'. | 1403 | This alist applies to files whose first line starts with `#!'. |
| 1514 | Each element looks like (INTERPRETER . MODE). | 1404 | Each element looks like (INTERPRETER . MODE). |
| @@ -1524,16 +1414,8 @@ If it matches, mode MODE is selected.") | |||
| 1524 | When checking `inhibit-first-line-modes-regexps', we first discard | 1414 | When checking `inhibit-first-line-modes-regexps', we first discard |
| 1525 | from the end of the file name anything that matches one of these regexps.") | 1415 | from 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. | ||
| 1531 | This regular expression is matched against the first line of a file | ||
| 1532 | to determine the file's mode in `set-auto-mode' when Emacs can't deduce | ||
| 1533 | a mode from the file's name. If it matches, the file is assumed to | ||
| 1534 | be interpreted by the interpreter matched by the second group of the | ||
| 1535 | regular expression. The mode is then determined as the mode associated | ||
| 1536 | with 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. |
| 1672 | Ignore 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. | ||
| 1864 | A 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. |
| 2173 | This is a separate procedure so your site-init or startup file can | 2052 | This is a separate procedure so your site-init or startup file can |
| 2174 | redefine it. | 2053 | redefine it. |
| 2175 | If the optional argument KEEP-BACKUP-VERSION is non-nil, | 2054 | If 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'. | ||
| 2240 | A value of nil gives the default `make-backup-file-name' behaviour. | ||
| 2241 | |||
| 2242 | This could be buffer-local to do something special for for specific | ||
| 2243 | files. If you define it, you may need to change `backup-file-name-p' | ||
| 2244 | and `file-name-sans-versions' too. | ||
| 2245 | |||
| 2246 | See 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. | ||
| 2253 | Each element looks like (REGEXP . DIRECTORY). Backups of files with | ||
| 2254 | names matching REGEXP will be made in DIRECTORY. DIRECTORY may be | ||
| 2255 | relative or absolute. If it is absolute, so that all matching files | ||
| 2256 | are backed up into the same directory, the file names in this | ||
| 2257 | directory will be the full name of the file backed up with all | ||
| 2258 | directory separators changed to `!' to prevent clashes. This will not | ||
| 2259 | work correctly if your filesystem truncates the resulting name. | ||
| 2260 | |||
| 2261 | For the common case of all backups going into one directory, the alist | ||
| 2262 | should contain a single element pairing \".\" with the appropriate | ||
| 2263 | directory name. | ||
| 2264 | |||
| 2265 | If this variable is nil, or it fails to match a filename, the backup | ||
| 2266 | is made in the original file's directory. | ||
| 2267 | |||
| 2268 | On MS-DOS filesystems without long names this variable is always | ||
| 2269 | ignored." | ||
| 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. |
| 2276 | Normally this will just be the file's name with `~' appended. | 2119 | This is a separate function so you can redefine it for customization." |
| 2277 | Customization hooks are provided as follows. | 2120 | (if (and (eq system-type 'ms-dos) |
| 2278 | 2121 | (not (msdos-long-file-names))) | |
| 2279 | If the variable `make-backup-file-name-function' is non-nil, its value | 2122 | (let ((fn (file-name-nondirectory file))) |
| 2280 | should be a function which will be called with FILE as its argument; | 2123 | (concat (file-name-directory file) |
| 2281 | the resulting name is used. | 2124 | (or |
| 2282 | 2125 | (and (string-match "\\`[^.]+\\'" fn) | |
| 2283 | Otherwise a match for FILE is sought in `backup-directory-alist'; see | 2126 | (concat (match-string 0 fn) ".~")) |
| 2284 | the documentation of that variable. If the directory for the backup | 2127 | (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn) |
| 2285 | doesn'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. |
| 2363 | Uses the free variable `backup-extract-version-start', whose value should be | 2144 | Uses the free variable `backup-extract-version-start', whose value should be |
| 2364 | the index in the name where the version number begins." | 2145 | the 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. |
| 2374 | Value is a list whose car is the name for the backup file | 2155 | Value is a list whose car is the name for the backup file |
| 2375 | and 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. |
| 2376 | If the value is nil, don't make a backup. | 2157 | If the value is nil, don't make a backup." |
| 2377 | Uses `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). |
| 2426 | This function returns a relative file name which is equivalent to FILENAME | 2205 | This function returns a relative file name which is equivalent to FILENAME |
| 2427 | when used with that default directory as the default. | 2206 | when used with that default directory as the default. |
| 2428 | If this is impossible (which can happen on MSDOS and Windows | 2207 | If 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. |
| 2707 | Optional argument (the prefix) non-nil means save all with no questions. | 2483 | Optional argument (the prefix) non-nil means save all with no questions. |
| 2708 | Optional second argument PRED determines which buffers are considered: | 2484 | Optional second argument EXITING means ask about certain non-file buffers |
| 2709 | If PRED is nil, all the file-visiting buffers are considered. | 2485 | as well as about file buffers." |
| 2710 | If PRED is t, then certain non-file buffers will also be considered. | ||
| 2711 | If PRED is a zero-argument function, it indicates for each buffer whether | ||
| 2712 | to 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 | |||
| 2930 | to nil. | 2698 | to nil. |
| 2931 | 2699 | ||
| 2932 | Optional second argument NOCONFIRM means don't ask for confirmation at | 2700 | Optional second argument NOCONFIRM means don't ask for confirmation at |
| 2933 | all. (The local variable `revert-without-query', if non-nil, prevents | 2701 | all. (The local variable `revert-without-query', if non-nil, prevents |
| 2934 | confirmation.) | 2702 | confirmation.) |
| 2935 | 2703 | ||
| 2936 | Optional third argument PRESERVE-MODES non-nil means don't alter | 2704 | Optional 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 | |||
| 3224 | before calling this function. You can redefine this for customization. | 2986 | before calling this function. You can redefine this for customization. |
| 3225 | See also `auto-save-file-name-p'." | 2987 | See 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 | |||
| 3441 | PATTERN is assumed to represent a file-name wildcard suitable for the | ||
| 3442 | underlying filesystem. For Unix and GNU/Linux, the characters from the | ||
| 3443 | set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all | ||
| 3444 | the parts of the pattern which don't include wildcard characters are | ||
| 3445 | quoted with double quotes. | ||
| 3446 | Existing quote characters in PATTERN are left alone, so you can pass | ||
| 3447 | PATTERN 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. |