Mercurial > emacs
changeset 32129:3cd2e815deaa
(basic-save-buffer): Call vc-before-save before saving.
| author | André Spiegel <spiegel@gnu.org> |
|---|---|
| date | Wed, 04 Oct 2000 09:55:21 +0000 |
| parents | f5ee1a4a371c |
| children | 281c3dca4833 |
| files | lisp/files.el |
| diffstat | 1 files changed, 332 insertions(+), 651 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/files.el Wed Oct 04 09:51:15 2000 +0000 +++ b/lisp/files.el Wed Oct 04 09:55:21 2000 +0000 @@ -1,7 +1,7 @@ ;;; files.el --- file input and output commands for Emacs ;; Copyright (C) 1985, 86, 87, 92, 93, -;; 94, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc. +;; 94, 95, 96, 97, 98, 1998 Free Software Foundation, Inc. ;; Maintainer: FSF @@ -84,9 +84,8 @@ The file's owner and group are unchanged. The choice of renaming or copying is controlled by the variables -`backup-by-copying', `backup-by-copying-when-linked', -`backup-by-copying-when-mismatch' and -`backup-by-copying-when-privileged-mismatch'. See also `backup-inhibited'." +`backup-by-copying', `backup-by-copying-when-linked' and +`backup-by-copying-when-mismatch'. See also `backup-inhibited'." :type 'boolean :group 'backup) @@ -121,42 +120,16 @@ :type 'boolean :group 'backup) -(defcustom backup-by-copying-when-privileged-mismatch 200 - "*Non-nil means create backups by copying to preserve a privileged owner. -Renaming may still be used (subject to control of other variables) -when it would not result in changing the owner of the file or if the owner -has a user id greater than the value of this variable. This is useful -when low-numbered uid's are used for special system users (such as root) -that must maintain ownership of certain files. -This variable is relevant only if `backup-by-copying' and -`backup-by-copying-when-mismatch' are nil." - :type '(choice (const nil) integer) - :group 'backup) - -(defun normal-backup-enable-predicate (name) - "Default `backup-enable-predicate' function. -Checks for files in `temporary-file-directory' or -`small-temporary-file-directory'." - (not (or (let ((comp (compare-strings temporary-file-directory 0 nil - name 0 nil))) - ;; Directory is under temporary-file-directory. - (and (not (eq comp t)) - (< comp (- (length temporary-file-directory))))) - (if small-temporary-file-directory - (let ((comp (compare-strings small-temporary-file-directory - 0 nil - name 0 nil))) - ;; Directory is under small-temporary-file-directory. - (and (not (eq comp t)) - (< comp (- (length small-temporary-file-directory))))))))) - -(defvar backup-enable-predicate 'normal-backup-enable-predicate +(defvar backup-enable-predicate + '(lambda (name) + (or (< (length name) 5) + (not (string-equal "/tmp/" (substring name 0 5))))) "Predicate that looks at a file name and decides whether to make backups. Called with an absolute file name as argument, it returns t to enable backup.") (defcustom buffer-offer-save nil - "*Non-nil in a buffer means always offer to save buffer on exit. -Do so even if the buffer is not visiting a file. + "*Non-nil in a buffer means offer to save the buffer on exit +even if the buffer is not visiting a file. Automatically local in all buffers." :type 'boolean :group 'backup) @@ -281,23 +254,6 @@ :type 'boolean :group 'auto-save) -(defcustom auto-save-file-name-transforms - '(("\\`/[^/]*:\\(.+/\\)*\\(.*\\)" "/tmp/\\2")) - "*Transforms to apply to buffer file name before making auto-save file name. -Each transform is a list (REGEXP REPLACEMENT): -REGEXP is a regular expression to match against the file name. -If it matches, `replace-match' is used to replace the -matching part with REPLACEMENT. -All the transforms in the list are tried, in the order they are listed. -When one transform applies, its result is final; -no further transforms are tried. - -The default value is set up to put the auto-save file into `/tmp' -for editing a remote file." - :group 'auto-save - :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement"))) - :version "21.1") - (defcustom save-abbrevs nil "*Non-nil means save word abbrevs too when files are saved. Loading an abbrev file sets this to t." @@ -305,24 +261,16 @@ :group 'abbrev) (defcustom find-file-run-dired t - "*Non-nil means allow `find-file' to visit directories. -To visit the directory, `find-file' runs `find-directory-functions'." + "*Non-nil says run dired if `find-file' is given the name of a directory." :type 'boolean :group 'find-file) -(defcustom find-directory-functions '(cvs-dired-noselect dired-noselect) - "*List of functions to try in sequence to visit a directory. -Each function is called with the directory name as the sole argument -and should return either a buffer or nil." - :type '(hook :options (cvs-dired-noselect dired-noselect)) - :group 'find-file) - ;;;It is not useful to make this a local variable. ;;;(put 'find-file-not-found-hooks 'permanent-local t) (defvar find-file-not-found-hooks nil "List of functions to be called for `find-file' on nonexistent file. These functions are called as soon as the error is detected. -Variable `buffer-file-name' is already set up. +`buffer-file-name' is already set up. The functions are called in the order given until one of them returns non-nil.") ;;;It is not useful to make this a local variable. @@ -337,8 +285,7 @@ If one of them returns non-nil, the file is considered already written and the rest are not called. These hooks are considered to pertain to the visited file. -So any buffer-local binding of `write-file-hooks' is -discarded if you change the visited file name with \\[set-visited-file-name]. +So this list is cleared if you change the visited file name. Don't make this variable buffer-local; instead, use `local-write-file-hooks'. See also `write-contents-hooks'.") @@ -433,21 +380,14 @@ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) "The directory for writing temporary files.") -(defvar small-temporary-file-directory - (if (eq system-type 'ms-dos) (getenv "TMPDIR")) - "The directory for writing small temporary files. -If non-nil, this directory is used instead of `temporary-file-directory' -by programs that create small temporary files. This is for systems that -have fast storage with limited space, such as a RAM disk.") - ;; The system null device. (Should reference NULL_DEVICE from C.) (defvar null-device "/dev/null" "The system null device.") +;; This hook function provides support for ange-ftp host name +;; completion. It runs the usual ange-ftp hook, but only for +;; completion operations. Having this here avoids the need +;; to load ange-ftp when it's not really in use. (defun ange-ftp-completion-hook-function (op &rest args) - "Provides support for ange-ftp host name completion. -Runs the usual ange-ftp hook, but only for completion operations." - ;; Having this here avoids the need to load ange-ftp when it's not - ;; really in use. (if (memq op '(file-name-completion file-name-all-completions)) (apply 'ange-ftp-hook-function op args) (let ((inhibit-file-name-handlers @@ -460,9 +400,8 @@ (defun convert-standard-filename (filename) "Convert a standard file's name to something suitable for the current OS. This function's standard definition is trivial; it just returns the argument. -However, on some systems, the function is redefined with a definition -that really does change some file names to canonicalize certain -patterns and to guarantee valid names." +However, on some systems, the function is redefined +with a definition that really does change some file names." filename) (defun pwd () @@ -475,9 +414,7 @@ Not actually set up until the first time you you use it.") (defun parse-colon-path (cd-path) - "Explode a colon-separated search path into a list of directory names. -\(For values of `colon' equal to `path-separator'.)" - ;; We could use split-string here. + "Explode a colon-separated search path into a list of directory names." (and cd-path (let (cd-prefix cd-list (cd-start 0) cd-colon) (setq cd-path (concat cd-path path-separator)) @@ -536,9 +473,7 @@ (defun load-file (file) "Load the Lisp file named FILE." (interactive "fLoad file: ") - (let ((completion-ignored-extensions - (delete ".elc" completion-ignored-extensions))) - (load (expand-file-name file) nil nil t))) + (load (expand-file-name file) nil nil t)) (defun load-library (library) "Load the library named LIBRARY. @@ -546,12 +481,10 @@ (interactive "sLoad library: ") (load library)) -(defun file-local-copy (file) +(defun file-local-copy (file &optional buffer) "Copy the file FILE into a temporary file on this machine. Returns the name of the local copy, or nil, if FILE is directly accessible." - ;; This formerly had an optional BUFFER argument that wasn't used by - ;; anything. (let ((handler (find-file-name-handler file 'file-local-copy))) (if handler (funcall handler 'file-local-copy file) @@ -608,7 +541,7 @@ (if handler (setq filename (funcall handler 'file-truename filename)) ;; If filename contains a wildcard, newname will be the old name. - (if (string-match "[[*?]" filename) + (if (string-match "[*?]" filename) (setq newname filename) ;; If filename doesn't exist, newname will be nil. (setq newname (w32-long-file-name filename))) @@ -718,8 +651,7 @@ Switch to a buffer visiting file FILENAME, creating one if none already exists. Interactively, or if WILDCARDS is non-nil in a call from Lisp, -expand wildcards (if any) and visit multiple files. Wildcard expansion -can be suppressed by setting `find-file-wildcards'." +expand wildcards (if any) and visit multiple files." (interactive "FFind file: \np") (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) @@ -758,7 +690,7 @@ (defun find-file-read-only (filename &optional wildcards) "Edit file FILENAME but don't allow changes. -Like `find-file' but marks buffer as read-only. +Like \\[find-file] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." (interactive "fFind file read-only: \np") (find-file filename wildcards) @@ -859,13 +791,11 @@ Choose the buffer's name using `generate-new-buffer-name'." (get-buffer-create (generate-new-buffer-name name))) -(defcustom automount-dir-prefix "^/tmp_mnt/" - "Regexp to match the automounter prefix in a directory name." - :group 'files - :type 'regexp) +(defvar automount-dir-prefix "^/tmp_mnt/" + "Regexp to match the automounter prefix in a directory name.") (defvar abbreviated-home-dir nil - "The user's homedir abbreviated according to `directory-abbrev-alist'.") + "The user's homedir abbreviated according to `directory-abbrev-list'.") (defun abbreviate-file-name (filename) "Return a version of FILENAME shortened using `directory-abbrev-alist'. @@ -966,15 +896,6 @@ :version "20.4" :type 'boolean) -(defcustom find-file-suppress-same-file-warnings nil - "*Non-nil means suppress warning messages for symlinked files. -When nil, Emacs prints a warning when visiting a file that is already -visited, but with a different name. Setting this option to t -suppresses this warning." - :group 'files - :version "21.1" - :type 'boolean) - (defun find-file-noselect (filename &optional nowarn rawfile wildcards) "Read file FILENAME into a buffer and return the buffer. If a buffer exists visiting FILENAME, return that one, but @@ -990,24 +911,21 @@ (abbreviate-file-name (expand-file-name filename))) (if (file-directory-p filename) - (or (and find-file-run-dired - (run-hook-with-args-until-success - 'find-directory-functions - (if find-file-visit-truename - (abbreviate-file-name (file-truename filename)) - filename))) - (error "%s is a directory" filename)) + (if find-file-run-dired + (dired-noselect (if find-file-visit-truename + (abbreviate-file-name (file-truename filename)) + filename)) + (error "%s is a directory" filename)) (if (and wildcards find-file-wildcards (not (string-match "\\`/:" filename)) (string-match "[[*?]" filename)) - (let ((files (condition-case nil - (file-expand-wildcards filename t) - (error (list filename)))) + (let ((files (file-expand-wildcards filename t)) (find-file-wildcards nil)) (if (null files) - (find-file-noselect filename) - (car (mapcar #'find-file-noselect files)))) + (error "No files match `%s'" filename)) + (mapcar #'(lambda (fn) (find-file-noselect fn)) + files)) (let* ((buf (get-file-buffer filename)) (truename (abbreviate-file-name (file-truename filename))) (number (nthcdr 10 (file-attributes truename))) @@ -1017,7 +935,6 @@ (if other (progn (or nowarn - find-file-suppress-same-file-warnings (string-equal filename (buffer-file-name other)) (message "%s and %s are the same file" filename (buffer-file-name other))) @@ -1208,7 +1125,7 @@ This is a permanent local.") (put 'find-file-literally 'permanent-local t) -(defun find-file-literally (filename) +(defun find-file-literally (filename) "Visit file FILENAME with no conversion of any kind. Format conversion and character code conversion are both disabled, and multibyte characters are disabled in the resulting buffer. @@ -1250,15 +1167,10 @@ (msg (cond ((and error (file-attributes buffer-file-name)) (setq buffer-read-only t) - "File exists, but cannot be read") + "File exists, but cannot be read.") ((not buffer-read-only) (if (and warn - ;; No need to warn if buffer is auto-saved - ;; under the name of the visited file. - (not (and buffer-file-name - auto-save-visited-file-name)) - (file-newer-than-file-p (or buffer-auto-save-file-name - (make-auto-save-file-name)) + (file-newer-than-file-p (make-auto-save-file-name) buffer-file-name)) (format "%s has auto save data; consider M-x recover-file" (file-name-nondirectory buffer-file-name)) @@ -1282,14 +1194,8 @@ (or not-serious (sit-for 1 nil t))))) (if (and auto-save-default (not noauto)) (auto-save-mode t))) - ;; Make people do a little extra work (C-x C-q) - ;; before altering a backup file. - (if (backup-file-name-p buffer-file-name) - (setq buffer-read-only t)) (if nomodes nil - (and view-read-only view-mode - (view-mode-disable)) (normal-mode t) (if (and buffer-read-only view-read-only (not (eq (get major-mode 'mode-class) 'special))) @@ -1325,138 +1231,128 @@ (prin1-to-string err))))) (defvar auto-mode-alist - (mapc - (lambda (elt) - (cons (purecopy (car elt)) (cdr elt))) - '(("\\.te?xt\\'" . text-mode) - ("\\.c\\'" . c-mode) - ("\\.h\\'" . c-mode) - ("\\.tex\\'" . tex-mode) - ("\\.ltx\\'" . latex-mode) - ("\\.el\\'" . emacs-lisp-mode) - ("\\.scm\\'" . scheme-mode) - ("\\.l\\'" . lisp-mode) - ("\\.lisp\\'" . lisp-mode) - ("\\.f\\'" . fortran-mode) - ("\\.F\\'" . fortran-mode) - ("\\.for\\'" . fortran-mode) - ("\\.p\\'" . pascal-mode) - ("\\.pas\\'" . pascal-mode) - ("\\.ad[abs]\\'" . ada-mode) - ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode) - ("\\.s?html?\\'" . html-mode) - ("\\.cc\\'" . c++-mode) - ("\\.hh\\'" . c++-mode) - ("\\.hpp\\'" . c++-mode) - ("\\.C\\'" . c++-mode) - ("\\.H\\'" . c++-mode) - ("\\.cpp\\'" . c++-mode) - ("\\.cxx\\'" . c++-mode) - ("\\.hxx\\'" . c++-mode) - ("\\.c\\+\\+\\'" . c++-mode) - ("\\.h\\+\\+\\'" . c++-mode) - ("\\.m\\'" . objc-mode) - ("\\.java\\'" . java-mode) - ("\\.mk\\'" . makefile-mode) - ("\\(M\\|m\\|GNUm\\)akefile\\(\\.in\\)?\\'" . makefile-mode) - ("\\.am\\'" . makefile-mode) ;For Automake. + '(("\\.te?xt\\'" . text-mode) + ("\\.c\\'" . c-mode) + ("\\.h\\'" . c-mode) + ("\\.tex\\'" . tex-mode) + ("\\.ltx\\'" . latex-mode) + ("\\.el\\'" . emacs-lisp-mode) + ("\\.scm\\'" . scheme-mode) + ("\\.l\\'" . lisp-mode) + ("\\.lisp\\'" . lisp-mode) + ("\\.f\\'" . fortran-mode) + ("\\.F\\'" . fortran-mode) + ("\\.for\\'" . fortran-mode) + ("\\.p\\'" . pascal-mode) + ("\\.pas\\'" . pascal-mode) + ("\\.ad[abs]\\'" . ada-mode) + ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode) + ("\\.s?html?\\'" . html-mode) + ("\\.cc\\'" . c++-mode) + ("\\.hh\\'" . c++-mode) + ("\\.hpp\\'" . c++-mode) + ("\\.C\\'" . c++-mode) + ("\\.H\\'" . c++-mode) + ("\\.cpp\\'" . c++-mode) + ("\\.cxx\\'" . c++-mode) + ("\\.hxx\\'" . c++-mode) + ("\\.c\\+\\+\\'" . c++-mode) + ("\\.h\\+\\+\\'" . c++-mode) + ("\\.m\\'" . objc-mode) + ("\\.java\\'" . java-mode) + ("\\.mk\\'" . makefile-mode) + ("\\(M\\|m\\|GNUm\\)akefile\\(\\.in\\)?\\'" . makefile-mode) + ("\\.am\\'" . makefile-mode) ;For Automake. ;;; Less common extensions come here ;;; so more common ones above are found faster. - ("\\.texinfo\\'" . texinfo-mode) - ("\\.te?xi\\'" . texinfo-mode) - ("\\.s\\'" . asm-mode) - ("\\.S\\'" . asm-mode) - ("\\.asm\\'" . asm-mode) - ("ChangeLog\\'" . change-log-mode) - ("change\\.log\\'" . change-log-mode) - ("changelo\\'" . change-log-mode) - ("ChangeLog\\.[0-9]+\\'" . change-log-mode) - ;; for MSDOS and MS-Windows (which are case-insensitive) - ("changelog\\'" . change-log-mode) - ("changelog\\.[0-9]+\\'" . change-log-mode) - ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) - ("\\.scm\\.[0-9]*\\'" . scheme-mode) - ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) - ("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode) - ("\\(/\\|\\`\\)\\.\\(bash_logout\\|shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) - ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) - ("\\.m?spec$" . sh-mode) - ("\\.mm\\'" . nroff-mode) - ("\\.me\\'" . nroff-mode) - ("\\.ms\\'" . nroff-mode) - ("\\.man\\'" . nroff-mode) - ("\\.\\(u?lpc\\|pike\\|pmod\\)\\'" . pike-mode) + ("\\.texinfo\\'" . texinfo-mode) + ("\\.te?xi\\'" . texinfo-mode) + ("\\.s\\'" . asm-mode) + ("\\.S\\'" . asm-mode) + ("\\.asm\\'" . asm-mode) + ("ChangeLog\\'" . change-log-mode) + ("change\\.log\\'" . change-log-mode) + ("changelo\\'" . change-log-mode) + ("ChangeLog\\.[0-9]+\\'" . change-log-mode) + ;; for MSDOS and MS-Windows (which are case-insensitive) + ("changelog\\'" . change-log-mode) + ("changelog\\.[0-9]+\\'" . change-log-mode) + ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) + ("\\.scm\\.[0-9]*\\'" . scheme-mode) + ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) + ("\\(/\\|\\`\\)\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode) + ("\\(/\\|\\`\\)\\.\\(bash_logout\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) + ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) + ("\\.m?spec$" . sh-mode) + ("\\.mm\\'" . nroff-mode) + ("\\.me\\'" . nroff-mode) + ("\\.ms\\'" . nroff-mode) + ("\\.man\\'" . nroff-mode) + ("\\.\\(u?lpc\\|pike\\|pmod\\)\\'" . pike-mode) ;;; The following should come after the ChangeLog pattern ;;; for the sake of ChangeLog.1, etc. ;;; and after the .scm.[0-9] pattern too. - ("\\.[12345678]\\'" . nroff-mode) - ("\\.TeX\\'" . tex-mode) - ("\\.sty\\'" . latex-mode) - ("\\.cls\\'" . latex-mode) ;LaTeX 2e class - ("\\.clo\\'" . latex-mode) ;LaTeX 2e class option - ("\\.bbl\\'" . latex-mode) - ("\\.bib\\'" . bibtex-mode) - ("\\.sql\\'" . sql-mode) - ("\\.m4\\'" . m4-mode) - ("\\.mc\\'" . m4-mode) - ("\\.mf\\'" . metafont-mode) - ("\\.mp\\'" . metapost-mode) - ("\\.vhdl?\\'" . vhdl-mode) - ("\\.article\\'" . text-mode) - ("\\.letter\\'" . text-mode) - ("\\.tcl\\'" . tcl-mode) - ("\\.exp\\'" . tcl-mode) - ("\\.itcl\\'" . tcl-mode) - ("\\.itk\\'" . tcl-mode) - ("\\.icn\\'" . icon-mode) - ("\\.sim\\'" . simula-mode) - ("\\.mss\\'" . scribe-mode) - ("\\.f90\\'" . f90-mode) - ("\\.pro\\'" . idlwave-mode) - ("\\.lsp\\'" . lisp-mode) - ("\\.awk\\'" . awk-mode) - ("\\.prolog\\'" . prolog-mode) - ("\\.tar\\'" . tar-mode) - ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode) - ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode) - ;; Mailer puts message to be edited in - ;; /tmp/Re.... or Message - ("\\`/tmp/Re" . text-mode) - ("/Message[0-9]*\\'" . text-mode) - ("/drafts/[0-9]+\\'" . mh-letter-mode) - ("\\.zone\\'" . zone-mode) - ;; some news reader is reported to use this - ("\\`/tmp/fol/" . text-mode) - ("\\.y\\'" . c-mode) - ("\\.lex\\'" . c-mode) - ("\\.oak\\'" . scheme-mode) - ("\\.sgml?\\'" . sgml-mode) - ("\\.xml\\'" . sgml-mode) - ("\\.dtd\\'" . sgml-mode) - ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) - ("\\.idl\\'" . idl-mode) - ;; .emacs following a directory delimiter - ;; in Unix, MSDOG or VMS syntax. - ("[]>:/\\]\\..*emacs\\'" . emacs-lisp-mode) - ("\\`\\..*emacs\\'" . emacs-lisp-mode) - ;; _emacs following a directory delimiter - ;; in MsDos syntax - ("[:/]_emacs\\'" . emacs-lisp-mode) - ("/crontab\\.X*[0-9]+\\'" . shell-script-mode) - ("\\.ml\\'" . lisp-mode) - ("\\.asn$" . snmp-mode) - ("\\.mib$" . snmp-mode) - ("\\.smi$" . snmp-mode) - ("\\.as2$" . snmpv2-mode) - ("\\.mi2$" . snmpv2-mode) - ("\\.sm2$" . snmpv2-mode) - ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) - ("\\.[eE]?[pP][sS]$" . ps-mode) - ("configure\\.in\\'" . autoconf-mode) - ("BROWSE\\'" . ebrowse-tree-mode) - ("\\.ebrowse\\'" . ebrowse-tree-mode) - ("#\\*mail\\*" . mail-mode))) - "Alist of filename patterns vs corresponding major mode functions. + ("\\.[12345678]\\'" . nroff-mode) + ("\\.TeX\\'" . tex-mode) + ("\\.sty\\'" . latex-mode) + ("\\.cls\\'" . latex-mode) ;LaTeX 2e class + ("\\.clo\\'" . latex-mode) ;LaTeX 2e class option + ("\\.bbl\\'" . latex-mode) + ("\\.bib\\'" . bibtex-mode) + ("\\.sql\\'" . sql-mode) + ("\\.m4\\'" . m4-mode) + ("\\.mc\\'" . m4-mode) + ("\\.mf\\'" . metafont-mode) + ("\\.mp\\'" . metapost-mode) + ("\\.vhdl?\\'" . vhdl-mode) + ("\\.article\\'" . text-mode) + ("\\.letter\\'" . text-mode) + ("\\.tcl\\'" . tcl-mode) + ("\\.exp\\'" . tcl-mode) + ("\\.itcl\\'" . tcl-mode) + ("\\.itk\\'" . tcl-mode) + ("\\.icn\\'" . icon-mode) + ("\\.sim\\'" . simula-mode) + ("\\.mss\\'" . scribe-mode) + ("\\.f90\\'" . f90-mode) + ("\\.lsp\\'" . lisp-mode) + ("\\.awk\\'" . awk-mode) + ("\\.prolog\\'" . prolog-mode) + ("\\.tar\\'" . tar-mode) + ("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\)\\'" . archive-mode) + ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\)\\'" . archive-mode) + ;; Mailer puts message to be edited in + ;; /tmp/Re.... or Message + ("\\`/tmp/Re" . text-mode) + ("/Message[0-9]*\\'" . text-mode) + ("/drafts/[0-9]+\\'" . mh-letter-mode) + ("\\.zone\\'" . zone-mode) + ;; some news reader is reported to use this + ("\\`/tmp/fol/" . text-mode) + ("\\.y\\'" . c-mode) + ("\\.lex\\'" . c-mode) + ("\\.oak\\'" . scheme-mode) + ("\\.sgml?\\'" . sgml-mode) + ("\\.xml\\'" . sgml-mode) + ("\\.dtd\\'" . sgml-mode) + ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) + ("\\.idl\\'" . idl-mode) + ;; .emacs following a directory delimiter + ;; in Unix, MSDOG or VMS syntax. + ("[]>:/\\]\\..*emacs\\'" . emacs-lisp-mode) + ("\\`\\..*emacs\\'" . emacs-lisp-mode) + ;; _emacs following a directory delimiter + ;; in MsDos syntax + ("[:/]_emacs\\'" . emacs-lisp-mode) + ("\\.ml\\'" . lisp-mode) + ("\\.asn$" . snmp-mode) + ("\\.mib$" . snmp-mode) + ("\\.smi$" . snmp-mode) + ("\\.as2$" . snmpv2-mode) + ("\\.mi2$" . snmpv2-mode) + ("\\.sm2$" . snmpv2-mode)) + "\ +Alist of filename patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). \(NON-NIL stands for anything that is not nil; the value does not matter.) Visiting a file whose name matches REGEXP specifies FUNCTION as the @@ -1468,47 +1364,41 @@ (defvar interpreter-mode-alist - (mapc - (lambda (l) - (cons (purecopy (car l)) (cdr l))) - '(("perl" . perl-mode) - ("perl5" . perl-mode) - ("miniperl" . perl-mode) - ("wish" . tcl-mode) - ("wishx" . tcl-mode) - ("tcl" . tcl-mode) - ("tclsh" . tcl-mode) - ("awk" . awk-mode) - ("mawk" . awk-mode) - ("nawk" . awk-mode) - ("gawk" . awk-mode) - ("scm" . scheme-mode) - ("ash" . sh-mode) - ("bash" . sh-mode) - ("bash2" . sh-mode) - ("csh" . sh-mode) - ("dtksh" . sh-mode) - ("es" . sh-mode) - ("itcsh" . sh-mode) - ("jsh" . sh-mode) - ("ksh" . sh-mode) - ("oash" . sh-mode) - ("pdksh" . sh-mode) - ("rc" . sh-mode) - ("rpm" . sh-mode) - ("sh" . sh-mode) - ("sh5" . sh-mode) - ("tcsh" . sh-mode) - ("wksh" . sh-mode) - ("wsh" . sh-mode) - ("zsh" . sh-mode) - ("tail" . text-mode) - ("more" . text-mode) - ("less" . text-mode) - ("pg" . text-mode) - ("make" . makefile-mode) ; Debian uses this - ("guile" . scheme-mode) - ("clisp" . lisp-mode))) + '(("perl" . perl-mode) + ("perl5" . perl-mode) + ("miniperl" . perl-mode) + ("wish" . tcl-mode) + ("wishx" . tcl-mode) + ("tcl" . tcl-mode) + ("tclsh" . tcl-mode) + ("awk" . awk-mode) + ("mawk" . awk-mode) + ("nawk" . awk-mode) + ("gawk" . awk-mode) + ("scm" . scheme-mode) + ("ash" . sh-mode) + ("bash" . sh-mode) + ("bash2" . sh-mode) + ("csh" . sh-mode) + ("dtksh" . sh-mode) + ("es" . sh-mode) + ("itcsh" . sh-mode) + ("jsh" . sh-mode) + ("ksh" . sh-mode) + ("oash" . sh-mode) + ("pdksh" . sh-mode) + ("rc" . sh-mode) + ("rpm" . sh-mode) + ("sh" . sh-mode) + ("sh5" . sh-mode) + ("tcsh" . sh-mode) + ("wksh" . sh-mode) + ("wsh" . sh-mode) + ("zsh" . sh-mode) + ("tail" . text-mode) + ("more" . text-mode) + ("less" . text-mode) + ("pg" . text-mode)) "Alist mapping interpreter names to major modes. This alist applies to files whose first line starts with `#!'. Each element looks like (INTERPRETER . MODE). @@ -1524,16 +1414,8 @@ When checking `inhibit-first-line-modes-regexps', we first discard from the end of the file name anything that matches one of these regexps.") -(defvar auto-mode-interpreter-regexp - "#![ \t]?\\([^ \t\n]*\ -/bin/env[ \t]\\)?\\([^ \t\n]+\\)" - "Regular expression matching interpreters, for file mode determination. -This regular expression is matched against the first line of a file -to determine the file's mode in `set-auto-mode' when Emacs can't deduce -a mode from the file's name. If it matches, the file is assumed to -be interpreted by the interpreter matched by the second group of the -regular expression. The mode is then determined as the mode associated -with that interpreter in `interpreter-mode-alist'.") +(defvar user-init-file nil + "File name, including directory, of user's initialization file.") (defun set-auto-mode (&optional just-from-file-name) "Select major mode appropriate for current buffer. @@ -1616,7 +1498,7 @@ ;; outside the save-excursion. (when modes (unless just-from-file-name - (mapc 'funcall (nreverse modes))) + (mapcar 'funcall (nreverse modes))) (setq done t)) ;; If we didn't find a mode from a -*- line, try using the file name. (if (and (not done) buffer-file-name) @@ -1635,9 +1517,10 @@ (if (string-match (car (car alist)) name) (if (and (consp (cdr (car alist))) (nth 2 (car alist))) - (setq mode (car (cdr (car alist))) - name (substring name 0 (match-beginning 0)) - keep-going t) + (progn + (setq mode (car (cdr (car alist))) + name (substring name 0 (match-beginning 0)) + keep-going t)) (setq mode (cdr (car alist)) keep-going nil))) (setq alist (cdr alist)))) @@ -1656,8 +1539,9 @@ (let ((interpreter (save-excursion (goto-char (point-min)) - (if (looking-at auto-mode-interpreter-regexp) - (match-string 2) + (if (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)") + (buffer-substring (match-beginning 2) + (match-end 2)) ""))) elt) ;; Map interpreter name to a mode. @@ -1668,10 +1552,10 @@ (funcall (cdr elt)))))))))))) (defun hack-local-variables-prop-line () - "Set local variables specified in the -*- line. -Ignore any specification for `mode:' and `coding:'; -`set-auto-mode' should already have handled `mode:', -`set-auto-coding' should already have handled `coding:'." + ;; Set local variables specified in the -*- line. + ;; Ignore any specification for `mode:' and `coding:'; + ;; set-auto-mode should already have handled `mode:', + ;; set-auto-coding should already have handled `coding:'. (save-excursion (goto-char (point-min)) (let ((result nil) @@ -1694,7 +1578,7 @@ (error "-*- not terminated before end of line"))) (while (< (point) end) (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") - (error "Malformed -*- line")) + (error "malformed -*- line")) (goto-char (match-end 0)) ;; There used to be a downcase here, ;; but the manual didn't say so, @@ -1859,9 +1743,9 @@ (defun hack-one-local-variable-quotep (exp) (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) +;; "Set" one variable in a local variables spec. +;; A few variable names are treated specially. (defun hack-one-local-variable (var val) - "\"Set\" one variable in a local variables spec. -A few variable names are treated specially." (cond ((eq var 'mode) (funcall (intern (concat (downcase (symbol-name val)) "-mode")))) @@ -2115,19 +1999,14 @@ ;; Actually write the back up file. (condition-case () (if (or file-precious-flag - ; (file-symlink-p buffer-file-name) + ; (file-symlink-p buffer-file-name) backup-by-copying (and backup-by-copying-when-linked (> (file-nlinks real-file-name) 1)) - (and (or backup-by-copying-when-mismatch - (integerp backup-by-copying-when-privileged-mismatch)) + (and backup-by-copying-when-mismatch (let ((attr (file-attributes real-file-name))) - (and (or backup-by-copying-when-mismatch - (and (integerp (nth 2 attr)) - (integerp backup-by-copying-when-privileged-mismatch) - (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch))) - (or (nth 9 attr) - (not (file-ownership-preserved-p real-file-name))))))) + (or (nth 9 attr) + (not (file-ownership-preserved-p real-file-name)))))) (condition-case () (copy-file real-file-name backupname t t) (file-error @@ -2169,7 +2048,7 @@ (file-error nil)))))) (defun file-name-sans-versions (name &optional keep-backup-version) - "Return file NAME sans backup versions or strings. + "Return FILENAME sans backup versions or strings. This is a separate procedure so your site-init or startup file can redefine it. If the optional argument KEEP-BACKUP-VERSION is non-nil, @@ -2196,7 +2075,7 @@ (length name)))))))) (defun file-ownership-preserved-p (file) - "Return t if deleting FILE and rewriting it would preserve the owner." + "Returns t if deleting FILE and rewriting it would preserve the owner." (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) (if handler (funcall handler 'file-ownership-preserved-p file) @@ -2235,117 +2114,19 @@ (if period ""))))) -(defcustom make-backup-file-name-function nil - "A function to use instead of the default `make-backup-file-name'. -A value of nil gives the default `make-backup-file-name' behaviour. - -This could be buffer-local to do something special for for specific -files. If you define it, you may need to change `backup-file-name-p' -and `file-name-sans-versions' too. - -See also `backup-directory-alist'." - :group 'backup - :type '(choice (const :tag "Default" nil) - (function :tag "Your function"))) - -(defcustom backup-directory-alist nil - "Alist of filename patterns and backup directory names. -Each element looks like (REGEXP . DIRECTORY). Backups of files with -names matching REGEXP will be made in DIRECTORY. DIRECTORY may be -relative or absolute. If it is absolute, so that all matching files -are backed up into the same directory, the file names in this -directory will be the full name of the file backed up with all -directory separators changed to `!' to prevent clashes. This will not -work correctly if your filesystem truncates the resulting name. - -For the common case of all backups going into one directory, the alist -should contain a single element pairing \".\" with the appropriate -directory name. - -If this variable is nil, or it fails to match a filename, the backup -is made in the original file's directory. - -On MS-DOS filesystems without long names this variable is always -ignored." - :group 'backup - :type '(repeat (cons (regexp :tag "Regexp macthing filename") - (directory :tag "Backup directory name")))) - (defun make-backup-file-name (file) "Create the non-numeric backup file name for FILE. -Normally this will just be the file's name with `~' appended. -Customization hooks are provided as follows. - -If the variable `make-backup-file-name-function' is non-nil, its value -should be a function which will be called with FILE as its argument; -the resulting name is used. - -Otherwise a match for FILE is sought in `backup-directory-alist'; see -the documentation of that variable. If the directory for the backup -doesn't exist, it is created." - (if make-backup-file-name-function - (funcall make-backup-file-name-function file) - (if (and (eq system-type 'ms-dos) - (not (msdos-long-file-names))) - (let ((fn (file-name-nondirectory file))) - (concat (file-name-directory file) - (or (and (string-match "\\`[^.]+\\'" fn) - (concat (match-string 0 fn) ".~")) - (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn) - (concat (match-string 0 fn) "~"))))) - (concat (make-backup-file-name-1 file) "~")))) - -(defun make-backup-file-name-1 (file) - "Subroutine of `make-backup-file-name' and `find-backup-file-name'." - (let ((alist backup-directory-alist) - elt backup-directory dir-sep-string) - (while alist - (setq elt (pop alist)) - (if (string-match (car elt) file) - (setq backup-directory (cdr elt) - alist nil))) - (if (null backup-directory) - file - (unless (file-exists-p backup-directory) - (condition-case nil - (make-directory backup-directory 'parents) - (file-error file))) - (if (file-name-absolute-p backup-directory) - (progn - (when (memq system-type '(windows-nt ms-dos)) - ;; Normalize DOSish file names: convert all slashes to - ;; directory-sep-char, downcase the drive letter, if any, - ;; and replace the leading "x:" with "/drive_x". - (or (file-name-absolute-p file) - (setq file (expand-file-name file))) ; make defaults explicit - ;; Replace any invalid file-name characters (for the - ;; case of backing up remote files). - (setq file (convert-standard-filename file)) - (setq dir-sep-string (char-to-string directory-sep-char)) - (or (eq directory-sep-char ?/) - (subst-char-in-string ?/ ?\\ file)) - (or (eq directory-sep-char ?\\) - (subst-char-in-string ?\\ ?/ file)) - (if (eq (aref file 1) ?:) - (setq file (concat dir-sep-string - "drive_" - (char-to-string (downcase (aref file 0))) - (if (eq (aref file 2) directory-sep-char) - "" - dir-sep-string) - (substring file 2))))) - ;; Make the name unique by substituting directory - ;; separators. It may not really be worth bothering about - ;; doubling `!'s in the original name... - (expand-file-name - (subst-char-in-string - directory-sep-char ?! - (replace-regexp-in-string "!" "!!" file)) - backup-directory)) - (expand-file-name (file-name-nondirectory file) - (file-name-as-directory - (expand-file-name backup-directory - (file-name-directory file)))))))) +This is a separate function so you can redefine it for customization." + (if (and (eq system-type 'ms-dos) + (not (msdos-long-file-names))) + (let ((fn (file-name-nondirectory file))) + (concat (file-name-directory file) + (or + (and (string-match "\\`[^.]+\\'" fn) + (concat (match-string 0 fn) ".~")) + (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn) + (concat (match-string 0 fn) "~"))))) + (concat file "~"))) (defun backup-file-name-p (file) "Return non-nil if FILE is a backup file name (numeric or not). @@ -2359,7 +2140,7 @@ ;; The usage of backup-extract-version-start is not very clean, ;; but I can't see a good alternative, so as of now I am leaving it alone. (defun backup-extract-version (fn) - "Given the name of a numeric backup file, FN, return the backup number. + "Given the name of a numeric backup file, return the backup number. Uses the free variable `backup-extract-version-start', whose value should be the index in the name where the version number begins." (if (and (string-match "[0-9]+~$" fn backup-extract-version-start) @@ -2370,49 +2151,47 @@ ;; I believe there is no need to alter this behavior for VMS; ;; since backup files are not made on VMS, it should not get called. (defun find-backup-file-name (fn) - "Find a file name for a backup file FN, and suggestions for deletions. + "Find a file name for a backup file, and suggestions for deletions. Value is a list whose car is the name for the backup file -and whose cdr is a list of old versions to consider deleting now. -If the value is nil, don't make a backup. -Uses `backup-directory-alist' in the same way as does -`make-backup-file-name'." + and whose cdr is a list of old versions to consider deleting now. +If the value is nil, don't make a backup." (let ((handler (find-file-name-handler fn 'find-backup-file-name))) ;; Run a handler for this function so that ange-ftp can refuse to do it. (if handler (funcall handler 'find-backup-file-name fn) (if (eq version-control 'never) (list (make-backup-file-name fn)) - (let* ((basic-name (make-backup-file-name-1 fn)) - (base-versions (concat (file-name-nondirectory basic-name) - ".~")) + (let* ((base-versions (concat (file-name-nondirectory fn) ".~")) (backup-extract-version-start (length base-versions)) + possibilities + (versions nil) (high-water-mark 0) - (number-to-delete 0) - possibilities deserve-versions-p versions) + (deserve-versions-p nil) + (number-to-delete 0)) (condition-case () (setq possibilities (file-name-all-completions base-versions - (file-name-directory basic-name)) - versions (sort (mapcar #'backup-extract-version - possibilities) - #'<) + (file-name-directory fn)) + versions (sort (mapcar + (function backup-extract-version) + possibilities) + '<) high-water-mark (apply 'max 0 versions) deserve-versions-p (or version-control (> high-water-mark 0)) number-to-delete (- (length versions) - kept-old-versions - kept-new-versions - -1)) - (file-error (setq possibilities nil))) + kept-old-versions kept-new-versions -1)) + (file-error + (setq possibilities nil))) (if (not deserve-versions-p) - (list (concat basic-name "~")) - (cons (format "%s.~%d~" basic-name (1+ high-water-mark)) + (list (make-backup-file-name fn)) + (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~") (if (and (> number-to-delete 0) ;; Delete nothing if there is overflow ;; in the number of versions to keep. (>= (+ kept-new-versions kept-old-versions -1) 0)) - (mapcar (lambda (n) - (format "%s.~%d~" basic-name n)) + (mapcar (function (lambda (n) + (concat fn ".~" (int-to-string n) "~"))) (let ((v (nthcdr kept-old-versions versions))) (rplacd (nthcdr (1- number-to-delete) v) ()) v)))))))))) @@ -2422,7 +2201,7 @@ (car (cdr (file-attributes filename)))) (defun file-relative-name (filename &optional directory) - "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). + "Convert FILENAME to be relative to DIRECTORY (default: default-directory). This function returns a relative file name which is equivalent to FILENAME when used with that default directory as the default. If this is impossible (which can happen on MSDOS and Windows @@ -2519,11 +2298,8 @@ (defvar auto-save-hook nil "Normal hook run just before auto-saving.") -(defcustom after-save-hook nil - "Normal hook that is run after a buffer is saved to its file." - :options '(executable-make-buffer-file-executable-if-script-p) - :type 'hook - :group 'files) +(defvar after-save-hook nil + "Normal hook that is run after a buffer is saved to its file.") (defvar save-buffer-coding-system nil "If non-nil, use this coding system for saving the buffer. @@ -2594,6 +2370,8 @@ (save-excursion (goto-char (point-max)) (insert ?\n)))) + ;; Support VC version backups. + (vc-before-save) (or (run-hook-with-args-until-success 'write-contents-hooks) (run-hook-with-args-until-success 'local-write-file-hooks) (run-hook-with-args-until-success 'write-file-hooks) @@ -2665,9 +2443,7 @@ (if (and (eq system-type 'ms-dos) (not (msdos-long-file-names))) "%s#%d.tm#" ; MSDOS limits files to 8+3 - (if (memq system-type '(vax-vms axp-vms)) - "%s$tmp$%d" - "%s#tmp#%d")) + "%s#tmp#%d") dir i)) (setq nogood (file-exists-p tempname)) (setq i (1+ i))) @@ -2697,19 +2473,16 @@ (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes (file-modes buffer-file-name)) - (set-file-modes buffer-file-name (logior setmodes 128)))) + (set-file-modes buffer-file-name 511))) (write-region (point-min) (point-max) buffer-file-name nil t buffer-file-truename))) setmodes)) -(defun save-some-buffers (&optional arg pred) +(defun save-some-buffers (&optional arg exiting) "Save some modified file-visiting buffers. Asks user about each one. Optional argument (the prefix) non-nil means save all with no questions. -Optional second argument PRED determines which buffers are considered: -If PRED is nil, all the file-visiting buffers are considered. -If PRED is t, then certain non-file buffers will also be considered. -If PRED is a zero-argument function, it indicates for each buffer whether -to consider it or not when called with that buffer current." +Optional second argument EXITING means ask about certain non-file buffers + as well as about file buffers." (interactive "P") (save-window-excursion (let* ((queried nil) @@ -2721,12 +2494,10 @@ (not (buffer-base-buffer buffer)) (or (buffer-file-name buffer) - (and pred + (and exiting (progn (set-buffer buffer) (and buffer-offer-save (> (buffer-size) 0))))) - (or (not (functionp pred)) - (with-current-buffer buffer (funcall pred))) (if arg t (setq queried t) @@ -2818,18 +2589,15 @@ (defun file-newest-backup (filename) "Return most recent backup file for FILENAME or nil if no backups exist." - ;; `make-backup-file-name' will get us the right directory for - ;; ordinary or numeric backups. It might create a directory for - ;; backups as a side-effect, according to `backup-directory-alist'. - (let* ((filename (file-name-sans-versions - (make-backup-file-name filename))) + (let* ((filename (expand-file-name filename)) (file (file-name-nondirectory filename)) (dir (file-name-directory filename)) (comp (file-name-all-completions file dir)) (newest nil) tem) (while comp - (setq tem (pop comp)) + (setq tem (car comp) + comp (cdr comp)) (cond ((and (backup-file-name-p tem) (string= (file-name-sans-versions tem) file)) (setq tem (concat dir tem)) @@ -2930,7 +2698,7 @@ to nil. Optional second argument NOCONFIRM means don't ask for confirmation at -all. (The local variable `revert-without-query', if non-nil, prevents +all. (The local variable `revert-without-query', if non-nil, prevents confirmation.) Optional third argument PRESERVE-MODES non-nil means don't alter @@ -3041,15 +2809,12 @@ (not (file-exists-p file-name))) (error "Auto-save file %s not current" file-name)) ((save-window-excursion - (with-output-to-temp-buffer "*Directory*" - (buffer-disable-undo standard-output) - (save-excursion - (let ((switches dired-listing-switches)) - (if (file-symlink-p file) - (setq switches (concat switches "L"))) - (set-buffer standard-output) - (insert-directory file switches) - (insert-directory file-name switches)))) + (if (not (memq system-type '(vax-vms windows-nt))) + (with-output-to-temp-buffer "*Directory*" + (buffer-disable-undo standard-output) + (call-process "ls" nil standard-output nil + (if (file-symlink-p file) "-lL" "-l") + file file-name))) (yes-or-no-p (format "Recover auto save file %s? " file-name))) (switch-to-buffer (find-file-noselect file t)) (let ((buffer-read-only nil) @@ -3072,9 +2837,6 @@ (interactive) (if (null auto-save-list-file-prefix) (error "You set `auto-save-list-file-prefix' to disable making session files")) - (let ((dir (file-name-directory auto-save-list-file-prefix))) - (unless (file-directory-p dir) - (make-directory dir t))) (let ((ls-lisp-support-shell-wildcards t)) (dired (concat auto-save-list-file-prefix "*") (concat dired-listing-switches "t"))) @@ -3224,29 +2986,17 @@ before calling this function. You can redefine this for customization. See also `auto-save-file-name-p'." (if buffer-file-name - (let ((list auto-save-file-name-transforms) - (filename buffer-file-name) - result) - ;; Apply user-specified translations - ;; to the file name. - (while (and list (not result)) - (if (string-match (car (car list)) filename) - (setq result (replace-match (cadr (car list)) t nil - filename))) - (setq list (cdr list))) - (if result (setq filename result)) - - (if (and (eq system-type 'ms-dos) - (not (msdos-long-file-names))) - (let ((fn (file-name-nondirectory buffer-file-name))) - (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn) - (concat (file-name-directory buffer-file-name) - "#" (match-string 1 fn) - "." (match-string 3 fn) "#")) - (concat (file-name-directory filename) - "#" - (file-name-nondirectory filename) - "#"))) + (if (and (eq system-type 'ms-dos) + (not (msdos-long-file-names))) + (let ((fn (file-name-nondirectory buffer-file-name))) + (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn) + (concat (file-name-directory buffer-file-name) + "#" (match-string 1 fn) + "." (match-string 3 fn) "#")) + (concat (file-name-directory buffer-file-name) + "#" + (file-name-nondirectory buffer-file-name) + "#")) ;; Deal with buffers that don't have any associated files. (Mail ;; mode tends to create a good number of these.) @@ -3351,7 +3101,7 @@ (defcustom list-directory-brief-switches (if (eq system-type 'vax-vms) "" "-CF") - "*Switches for `list-directory' to pass to `ls' for brief listing." + "*Switches for list-directory to pass to `ls' for brief listing," :type 'string :group 'dired) @@ -3359,7 +3109,7 @@ (if (eq system-type 'vax-vms) "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)" "-l") - "*Switches for `list-directory' to pass to `ls' for verbose listing." + "*Switches for list-directory to pass to `ls' for verbose listing," :type 'string :group 'dired) @@ -3435,52 +3185,6 @@ (let ((wildcard (not (file-directory-p dirname)))) (insert-directory dirname switches wildcard (not wildcard))))))) -(defun shell-quote-wildcard-pattern (pattern) - "Quote characters special to the shell in PATTERN, leave wildcards alone. - -PATTERN is assumed to represent a file-name wildcard suitable for the -underlying filesystem. For Unix and GNU/Linux, the characters from the -set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all -the parts of the pattern which don't include wildcard characters are -quoted with double quotes. -Existing quote characters in PATTERN are left alone, so you can pass -PATTERN that already quotes some of the special characters." - (save-match-data - (cond - ((memq system-type '(ms-dos windows-nt)) - ;; DOS/Windows don't allow `"' in file names. So if the - ;; argument has quotes, we can safely assume it is already - ;; quoted by the caller. - (if (or (string-match "[\"]" pattern) - ;; We quote [&()#$'] in case their shell is a port of a - ;; Unixy shell. We quote [,=+] because stock DOS and - ;; Windows shells require that in some cases, such as - ;; passing arguments to batch files that use positional - ;; arguments like %1. - (not (string-match "[ \t;&()#$',=+]" pattern))) - pattern - (let ((result "\"") - (beg 0) - end) - (while (string-match "[*?]+" pattern beg) - (setq end (match-beginning 0) - result (concat result (substring pattern beg end) - "\"" - (substring pattern end (match-end 0)) - "\"") - beg (match-end 0))) - (concat result (substring pattern beg) "\"")))) - (t - (let ((beg 0)) - (while (string-match "[ \t\n;<>&|()#$]" pattern beg) - (setq pattern - (concat (substring pattern 0 (match-beginning 0)) - "\\" - (substring pattern (match-beginning 0))) - beg (1+ (match-end 0))))) - pattern)))) - - (defvar insert-directory-program "ls" "Absolute or relative name of the `ls' program used by `insert-directory'.") @@ -3516,7 +3220,7 @@ ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory))) - (if handler + (if handler (funcall handler 'insert-directory file switches wildcard full-directory-p) (if (eq system-type 'vax-vms) @@ -3529,86 +3233,63 @@ (coding-system-for-write coding-system-for-read) (result (if wildcard - ;; Run ls in the directory of the file pattern we asked for + ;; Run ls in the directory of the file pattern we asked for. (let ((default-directory (if (file-name-absolute-p file) (file-name-directory file) (file-name-directory (expand-file-name file)))) - (pattern (file-name-nondirectory file))) - (call-process - shell-file-name nil t nil - "-c" (concat (if (memq system-type '(ms-dos windows-nt)) - "" - "\\") ; Disregard Unix shell aliases! - insert-directory-program - " -d " - (if (stringp switches) - switches - (mapconcat 'identity switches " ")) - " -- " - ;; Quote some characters that have - ;; special meanings in shells; but - ;; don't quote the wildcards--we - ;; want them to be special. We - ;; also currently don't quote the - ;; quoting characters in case - ;; people want to use them - ;; explicitly to quote wildcard - ;; characters. - (shell-quote-wildcard-pattern pattern)))) + (pattern (file-name-nondirectory file)) + (beg 0)) + ;; Quote some characters that have special meanings in shells; + ;; but don't quote the wildcards--we want them to be special. + ;; We also currently don't quote the quoting characters + ;; in case people want to use them explicitly to quote + ;; wildcard characters. + (while (string-match "[ \t\n;<>&|()#$]" pattern beg) + (setq pattern + (concat (substring pattern 0 (match-beginning 0)) + "\\" + (substring pattern (match-beginning 0))) + beg (1+ (match-end 0)))) + (call-process shell-file-name nil t nil + "-c" (concat "\\";; Disregard shell aliases! + insert-directory-program + " -d " + (if (stringp switches) + switches + (mapconcat 'identity switches " ")) + " -- " + pattern))) ;; SunOS 4.1.3, SVr4 and others need the "." to list the ;; directory if FILE is a symbolic link. (apply 'call-process - insert-directory-program nil t nil - (append - (if (listp switches) switches - (unless (equal switches "") - ;; Split the switches at any spaces so we can - ;; pass separate options as separate args. - (split-string switches))) - ;; Avoid lossage if FILE starts with `-'. - '("--") - (progn - (if (string-match "\\`~" file) - (setq file (expand-file-name file))) - (list - (if full-directory-p - (concat (file-name-as-directory file) ".") - file)))))))) + insert-directory-program nil t nil + (let (list) + (if (listp switches) + (setq list switches) + (if (not (equal switches "")) + (progn + ;; Split the switches at any spaces + ;; so we can pass separate options as separate args. + (while (string-match " " switches) + (setq list (cons (substring switches 0 (match-beginning 0)) + list) + switches (substring switches (match-end 0)))) + (setq list (nreverse (cons switches list)))))) + (append list + ;; Avoid lossage if FILE starts with `-'. + '("--") + (progn + (if (string-match "\\`~" file) + (setq file (expand-file-name file))) + (list + (if full-directory-p + (concat (file-name-as-directory file) ".") + file))))))))) (if (/= result 0) - ;; We get here if `insert-directory-program' failed. - ;; On non-Posix systems, we cannot open a directory, so - ;; don't even try, because that will always result in - ;; the ubiquitous "Access denied". Instead, show them - ;; the `ls' command line and let them guess what went - ;; wrong. - (if (and (file-directory-p file) - (memq system-type '(ms-dos windows-nt))) - (error - "Reading directory: \"%s %s -- %s\" exited with status %s" - insert-directory-program - (if (listp switches) (concat switches) switches) - file result) - ;; Unix. Access the file to get a suitable error. - (access-file file "Reading directory")) - ;; Replace "total" with "used", to avoid confusion. - ;; Add in the amount of free space. - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^total" nil t) - (replace-match "used") - (end-of-line) - (let (available) - (with-temp-buffer - (call-process "df" nil t nil ".") - (goto-char (point-min)) - (forward-line 1) - (skip-chars-forward "^ \t") - (forward-word 3) - (let ((end (point))) - (forward-word -1) - (setq available (buffer-substring (point) end)))) - (insert " available " available)))))))))) + ;; We get here if ls failed. + ;; Access the file to get a suitable error. + (access-file file "Reading directory"))))))) (defvar kill-emacs-query-functions nil "Functions to call with no arguments to query about killing Emacs. @@ -3645,7 +3326,7 @@ (run-hook-with-args-until-failure 'kill-emacs-query-functions) (kill-emacs))) -;; We use /: as a prefix to "quote" a file name +;; We use /: as a prefix to "quote" a file name ;; so that magic file name handlers will not apply to it. (setq file-name-handler-alist @@ -3662,7 +3343,7 @@ (default-directory (if (eq operation 'insert-directory) (directory-file-name - (expand-file-name + (expand-file-name (unhandled-file-name-directory default-directory))) default-directory)) ;; Get a list of the indices of the args which are file names.