X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/3c0abb26d3ed871f12cee7acb277bd8daf46b726..4cc8ea4a65f6d78ea95662ac67c4afe8e44a8d30:/lisp/files.el diff --git a/lisp/files.el b/lisp/files.el index ca6e7ec9f7..570a31b808 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1,7 +1,7 @@ ;;; files.el --- file input and output commands for Emacs ;; Copyright (C) 1985, 86, 87, 92, 93, -;; 94, 95, 96, 97, 98, 1999 Free Software Foundation, Inc. +;; 94, 95, 96, 97, 98, 99, 2000 Free Software Foundation, Inc. ;; Maintainer: FSF @@ -133,16 +133,30 @@ 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 -1))) + (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 -1))))))) + +(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.") (defcustom buffer-offer-save nil - "*Non-nil in a buffer means offer to save the buffer on exit -even if the buffer is not visiting a file. + "*Non-nil in a buffer means always offer to save buffer on exit. +Do so even if the buffer is not visiting a file. Automatically local in all buffers." :type 'boolean :group '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." @@ -274,16 +305,24 @@ Loading an abbrev file sets this to t." :group 'abbrev) (defcustom find-file-run-dired t - "*Non-nil says run dired if `find-file' is given the name of a directory." + "*Non-nil means allow `find-file' to visit directories. +To visit the directory, `find-file' runs `find-directory-functions'." :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. -`buffer-file-name' is already set up. +Variable `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. @@ -298,7 +337,8 @@ functions are called.") 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 this list is cleared if you change the visited file name. +So any buffer-local binding of `write-file-hooks' is +discarded if you change the visited file name with \\[set-visited-file-name]. Don't make this variable buffer-local; instead, use `local-write-file-hooks'. See also `write-contents-hooks'.") @@ -403,11 +443,11 @@ 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 @@ -420,8 +460,9 @@ have fast storage with limited space, such as a RAM disk.") (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 () @@ -434,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)) @@ -493,7 +536,9 @@ colon-separated list of directories when resolving a relative directory name." (defun load-file (file) "Load the Lisp file named FILE." (interactive "fLoad file: ") - (load (expand-file-name file) nil nil t)) + (let ((completion-ignored-extensions + (delete ".elc" completion-ignored-extensions))) + (load (expand-file-name file) nil nil t))) (defun load-library (library) "Load the library named LIBRARY. @@ -501,10 +546,12 @@ This is an interface to the function `load'." (interactive "sLoad library: ") (load library)) -(defun file-local-copy (file &optional buffer) +(defun file-local-copy (file) "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) @@ -561,7 +608,7 @@ Do not specify them in other calls." (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))) @@ -711,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) @@ -812,8 +859,10 @@ otherwise a string <2> or <3> or ... is appended to get an unused name." Choose the buffer's name using `generate-new-buffer-name'." (get-buffer-create (generate-new-buffer-name name))) -(defvar automount-dir-prefix "^/tmp_mnt/" - "Regexp to match the automounter prefix in a directory name.") +(defcustom automount-dir-prefix "^/tmp_mnt/" + "Regexp to match the automounter prefix in a directory name." + :group 'files + :type 'regexp) (defvar abbreviated-home-dir nil "The user's homedir abbreviated according to `directory-abbrev-alist'.") @@ -914,6 +963,7 @@ If there is no such live buffer, return nil." For example, if you specify `*.c', that would visit all the files whose names match the pattern." :group 'files + :version "20.4" :type 'boolean) (defun find-file-noselect (filename &optional nowarn rawfile wildcards) @@ -931,11 +981,13 @@ that are visiting the various files." (abbreviate-file-name (expand-file-name filename))) (if (file-directory-p 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)) + (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 (and wildcards find-file-wildcards (not (string-match "\\`/:" filename)) @@ -946,8 +998,7 @@ that are visiting the various files." (find-file-wildcards nil)) (if (null files) (find-file-noselect filename) - (car (mapcar #'(lambda (fn) (find-file-noselect fn)) - files)))) + (car (mapcar #'find-file-noselect files)))) (let* ((buf (get-file-buffer filename)) (truename (abbreviate-file-name (file-truename filename))) (number (nthcdr 10 (file-attributes truename))) @@ -1147,7 +1198,7 @@ Don't call it from programs! Use `insert-file-contents-literally' instead. 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. @@ -1192,7 +1243,12 @@ unless NOMODES is non-nil." "File exists, but cannot be read") ((not buffer-read-only) (if (and warn - (file-newer-than-file-p (make-auto-save-file-name) + ;; 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)) buffer-file-name)) (format "%s has auto save data; consider M-x recover-file" (file-name-nondirectory buffer-file-name)) @@ -1259,129 +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) - ("\\.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)) - "\ -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 @@ -1393,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). @@ -1445,9 +1513,6 @@ 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 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. This checks for a -*- mode tag in the buffer's text, @@ -1529,7 +1594,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) @@ -1548,10 +1613,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)))) @@ -1570,9 +1634,9 @@ 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 "#![ \t]?\\([^ \t\n]*\ +/bin/env[ \t]\\)?\\([^ \t\n]+\\)") + (match-string 2) ""))) elt) ;; Map interpreter name to a mode. @@ -1583,10 +1647,10 @@ and we don't even do that unless it would come from the file name." (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) @@ -1609,7 +1673,7 @@ and we don't even do that unless it would come from the file name." (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, @@ -1774,9 +1838,9 @@ is specified, returning t if it is specified." (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")))) @@ -2034,10 +2098,10 @@ no longer accessible under its old name." backup-by-copying (and backup-by-copying-when-linked (> (file-nlinks real-file-name) 1)) - (and (or backup-by-copying-when-mismatch + (and (or backup-by-copying-when-mismatch (integerp backup-by-copying-when-privileged-mismatch)) (let ((attr (file-attributes real-file-name))) - (and (or backup-by-copying-when-mismatch + (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))) @@ -2084,7 +2148,7 @@ no longer accessible under its old name." (file-error nil)))))) (defun file-name-sans-versions (name &optional keep-backup-version) - "Return FILENAME sans backup versions or strings. + "Return file NAME 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, @@ -2111,7 +2175,7 @@ we do not remove backup version numbers, only true file version numbers." (length name)))))))) (defun file-ownership-preserved-p (file) - "Returns t if deleting FILE and rewriting it would preserve the owner." + "Return 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) @@ -2150,19 +2214,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). @@ -2176,7 +2338,7 @@ You may need to redefine `file-name-sans-versions' as well." ;; 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, return the backup number. + "Given the name of a numeric backup file, FN, 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) @@ -2187,47 +2349,49 @@ the index in the name where the version number begins." ;; 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, and suggestions for deletions. + "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)))))))))) @@ -2237,7 +2401,7 @@ If the value is nil, don't make a backup." (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 @@ -2334,8 +2498,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. @@ -2477,7 +2644,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))) @@ -2507,16 +2676,19 @@ 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)) -(defun save-some-buffers (&optional arg exiting) +(defun save-some-buffers (&optional arg pred) "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 EXITING means ask about certain non-file buffers - as well as about file buffers." +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." (interactive "P") (save-window-excursion (let* ((queried nil) @@ -2528,10 +2700,12 @@ Optional second argument EXITING means ask about certain non-file buffers (not (buffer-base-buffer buffer)) (or (buffer-file-name buffer) - (and exiting + (and pred (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) @@ -2623,15 +2797,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)) @@ -2732,7 +2909,7 @@ sake of backward compatibility. IGNORE-AUTO is optional, defaulting 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 @@ -2871,6 +3048,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"))) @@ -3020,17 +3200,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.) @@ -3135,7 +3327,7 @@ by `sh' are supported." (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) @@ -3143,7 +3335,7 @@ by `sh' are supported." (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) @@ -3323,8 +3515,26 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'." (if (/= result 0) ;; We get here if ls failed. ;; Access the file to get a suitable error. - (access-file file "Reading directory"))))))) - + (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)))))))))) + (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. @@ -3360,7 +3570,7 @@ With prefix arg, silently save all file-visiting buffers, then kill." (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 @@ -3377,7 +3587,7 @@ With prefix arg, silently save all file-visiting buffers, then kill." (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.