X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/18f183760f2a3ae71c42d8fe95ad4d96d4c0dafb..c454aac1921dfc9e7afa4e139ac7ed95dd27faa1:/lisp/files.el diff --git a/lisp/files.el b/lisp/files.el index 9de7c0ba8e..17c54f69d5 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -133,10 +133,24 @@ This variable is relevant only if `backup-by-copying' and :type '(choice (const nil) integer) :group 'backup) -(defvar backup-enable-predicate - '(lambda (name) - (or (< (length name) 5) - (not (string-equal "/tmp/" (substring name 0 5))))) +(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 "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.") @@ -267,6 +281,23 @@ Normally auto-save files are written under other names." :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." @@ -429,8 +460,9 @@ Runs the usual ange-ftp hook, but only for completion operations." (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." +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." filename) (defun pwd () @@ -443,7 +475,9 @@ with a definition that really does change some file names." 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." + "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. (and cd-path (let (cd-prefix cd-list (cd-start 0) cd-colon) (setq cd-path (concat cd-path path-separator)) @@ -724,7 +758,7 @@ expand wildcards (if any) and visit multiple files." (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) @@ -1281,133 +1315,137 @@ in that case, this function acts as if `enable-local-variables' were t." (prin1-to-string err))))) (defvar auto-mode-alist - '(("\\.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. + (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. ;;; 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\\|[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\\|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) ;;; 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)) - "\ -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) + ("\\.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))) + "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 @@ -1419,43 +1457,47 @@ REGEXP and search the list again for another match.") (defvar interpreter-mode-alist - '(("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) - ("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)) + (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))) "Alist mapping interpreter names to major modes. This alist applies to files whose first line starts with `#!'. Each element looks like (INTERPRETER . MODE). @@ -1471,6 +1513,17 @@ If it matches, mode MODE is selected.") 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'.") + (defun set-auto-mode (&optional just-from-file-name) "Select major mode appropriate for current buffer. This checks for a -*- mode tag in the buffer's text, @@ -1552,7 +1605,7 @@ and we don't even do that unless it would come from the file name." ;; outside the save-excursion. (when modes (unless just-from-file-name - (mapcar 'funcall (nreverse modes))) + (mapc '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) @@ -1571,10 +1624,9 @@ and we don't even do that unless it would come from the file name." (if (string-match (car (car alist)) name) (if (and (consp (cdr (car alist))) (nth 2 (car alist))) - (progn - (setq mode (car (cdr (car alist))) - name (substring name 0 (match-beginning 0)) - keep-going t)) + (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)))) @@ -1593,9 +1645,8 @@ and we don't even do that unless it would come from the file name." (let ((interpreter (save-excursion (goto-char (point-min)) - (if (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)") - (buffer-substring (match-beginning 2) - (match-end 2)) + (if (looking-at auto-mode-interpreter-regexp) + (match-string 2) ""))) elt) ;; Map interpreter name to a mode. @@ -2173,19 +2224,117 @@ the value is \"\"." (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. -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 "~"))) +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)))))))) (defun backup-file-name-p (file) "Return non-nil if FILE is a backup file name (numeric or not). @@ -2212,45 +2361,47 @@ the index in the name where the version number begins." (defun find-backup-file-name (fn) "Find a file name for a backup file FN, 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." +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'." (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* ((base-versions (concat (file-name-nondirectory fn) ".~")) + (let* ((basic-name (make-backup-file-name-1 fn)) + (base-versions (concat (file-name-nondirectory basic-name) + ".~")) (backup-extract-version-start (length base-versions)) - possibilities - (versions nil) (high-water-mark 0) - (deserve-versions-p nil) - (number-to-delete 0)) + (number-to-delete 0) + possibilities deserve-versions-p versions) (condition-case () (setq possibilities (file-name-all-completions base-versions - (file-name-directory fn)) - versions (sort (mapcar - (function backup-extract-version) - possibilities) - '<) + (file-name-directory basic-name)) + versions (sort (mapcar #'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 (make-backup-file-name fn)) - (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~") + (list (concat basic-name "~")) + (cons (format "%s.~%d~" basic-name (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 (function (lambda (n) - (concat fn ".~" (int-to-string n) "~"))) + (mapcar (lambda (n) + (format "%s.~%d~" basic-name n)) (let ((v (nthcdr kept-old-versions versions))) (rplacd (nthcdr (1- number-to-delete) v) ()) v)))))))))) @@ -2357,8 +2508,11 @@ the last real save, but optional arg FORCE non-nil means delete anyway." (defvar auto-save-hook nil "Normal hook run just before auto-saving.") -(defvar after-save-hook nil - "Normal hook that is run after a buffer is saved to its file.") +(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 save-buffer-coding-system nil "If non-nil, use this coding system for saving the buffer. @@ -2500,7 +2654,9 @@ After saving the buffer, this function runs `after-save-hook'." (if (and (eq system-type 'ms-dos) (not (msdos-long-file-names))) "%s#%d.tm#" ; MSDOS limits files to 8+3 - "%s#tmp#%d") + (if (memq system-type '(vax-vms axp-vms)) + "%s$tmp$%d" + "%s#tmp#%d")) dir i)) (setq nogood (file-exists-p tempname)) (setq i (1+ i))) @@ -2530,7 +2686,7 @@ After saving the buffer, this function runs `after-save-hook'." (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes (file-modes buffer-file-name)) - (set-file-modes buffer-file-name 511))) + (set-file-modes buffer-file-name (logior setmodes 128)))) (write-region (point-min) (point-max) buffer-file-name nil t buffer-file-truename))) setmodes)) @@ -2651,15 +2807,18 @@ saying what text to write." (defun file-newest-backup (filename) "Return most recent backup file for FILENAME or nil if no backups exist." - (let* ((filename (expand-file-name filename)) + ;; `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))) (file (file-name-nondirectory filename)) (dir (file-name-directory filename)) (comp (file-name-all-completions file dir)) (newest nil) tem) (while comp - (setq tem (car comp) - comp (cdr comp)) + (setq tem (pop comp)) (cond ((and (backup-file-name-p tem) (string= (file-name-sans-versions tem) file)) (setq tem (concat dir tem)) @@ -2871,12 +3030,15 @@ non-nil, it is called instead of rereading visited file contents." (not (file-exists-p file-name))) (error "Auto-save file %s not current" file-name)) ((save-window-excursion - (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))) + (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)))) (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) @@ -2899,6 +3061,9 @@ Then you'll be asked about a number of files to recover." (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"))) @@ -3048,17 +3213,29 @@ Does not consider `auto-save-visited-file-name' as that variable is checked before calling this function. You can redefine this for customization. See also `auto-save-file-name-p'." (if buffer-file-name - (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) - "#")) + (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) + "#"))) ;; Deal with buffers that don't have any associated files. (Mail ;; mode tends to create a good number of these.) @@ -3247,6 +3424,52 @@ and `list-directory-verbose-switches'." (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'.") @@ -3282,7 +3505,7 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'." ;; 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) @@ -3295,63 +3518,68 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'." (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)) - (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))) + (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)))) ;; 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 - (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))))))))) + 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)))))))) (if (/= result 0) - ;; We get here if ls failed. - ;; Access the file to get a suitable error. - (access-file file "Reading directory") + ;; 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 @@ -3370,7 +3598,7 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'." (forward-word -1) (setq available (buffer-substring (point) end)))) (insert " available " available)))))))))) - + (defvar kill-emacs-query-functions nil "Functions to call with no arguments to query about killing Emacs. If any of these functions returns nil, killing Emacs is cancelled.