diff options
Diffstat (limited to 'lisp/files.el')
| -rw-r--r-- | lisp/files.el | 1302 |
1 files changed, 821 insertions, 481 deletions
diff --git a/lisp/files.el b/lisp/files.el index 0a00b8b828a..862982b71df 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -191,20 +191,18 @@ if the file has changed on disk and you have not edited the buffer." :type '(repeat regexp) :group 'find-file) -(defvar buffer-file-number nil +(defvar-local buffer-file-number nil "The device number and file number of the file visited in the current buffer. The value is a list of the form (FILENUM DEVNUM). This pair of numbers uniquely identifies the file. If the buffer is visiting a new file, the value is nil.") -(make-variable-buffer-local 'buffer-file-number) (put 'buffer-file-number 'permanent-local t) (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt))) "Non-nil means that `buffer-file-number' uniquely identifies files.") -(defvar buffer-file-read-only nil +(defvar-local buffer-file-read-only nil "Non-nil if visited file was read-only when visited.") -(make-variable-buffer-local 'buffer-file-read-only) (defcustom small-temporary-file-directory (if (eq system-type 'ms-dos) (getenv "TMPDIR")) @@ -393,6 +391,10 @@ constructed by taking the directory part of the replaced file-name, concatenated with the buffer file name with all directory separators changed to `!' to prevent clashes. This will not work correctly if your filesystem truncates the resulting name. +If UNIQUIFY is one of the members of `secure-hash-algorithms', +Emacs constructs the nondirectory part of the auto-save file name +by applying that `secure-hash' to the buffer file name. This +avoids any risk of excessively long file names. All the transforms in the list are tried, in the order they are listed. When one transform applies, its result is final; @@ -405,11 +407,31 @@ editing a remote file. On MS-DOS filesystems without long names this variable is always ignored." :group 'auto-save - :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement") + :type '(repeat (list (regexp :tag "Regexp") (string :tag "Replacement") (boolean :tag "Uniquify"))) :initialize 'custom-initialize-delay :version "21.1") +(defcustom lock-file-name-transforms nil + "Transforms to apply to buffer file name before making a lock file name. +This has the same syntax as +`auto-save-file-name-transforms' (which see), but instead of +applying to auto-save file names, it's applied to lock file names. + +By default, a lock file is put into the same directory as the +file it's locking, and it has the same name, but with \".#\" prepended." + :group 'files + :type '(repeat (list (regexp :tag "Regexp") + (string :tag "Replacement") + (boolean :tag "Uniquify"))) + :version "28.1") + +(defcustom remote-file-name-inhibit-locks nil + "Whether to use file locks for remote files." + :group 'files + :version "28.1" + :type 'boolean) + (defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.") (defcustom auto-save-visited-interval 5 @@ -430,7 +452,13 @@ idle for `auto-save-visited-interval' seconds." Unlike `auto-save-mode', this mode will auto-save buffer contents to the visited files directly and will also run all save-related -hooks. See Info node `Saving' for details of the save process." +hooks. See Info node `Saving' for details of the save process. + +You can also set the buffer-local value of the variable +`auto-save-visited-mode' to nil. A buffer where the buffer-local +value of this variable is nil is ignored for the purpose of +`auto-save-visited-mode', even if `auto-save-visited-mode' is +enabled." :group 'auto-save :global t (when auto-save--timer (cancel-timer auto-save--timer)) @@ -441,6 +469,7 @@ hooks. See Info node `Saving' for details of the save process." #'save-some-buffers :no-prompt (lambda () (and buffer-file-name + auto-save-visited-mode (not (and buffer-auto-save-file-name auto-save-visited-file-name)))))))) @@ -522,15 +551,14 @@ updates before the buffer is saved, use `before-save-hook'.") (put 'write-file-functions 'permanent-local t) ;; I found some files still using the obsolete form in 2018. -(defvar local-write-file-hooks nil) -(make-variable-buffer-local 'local-write-file-hooks) +(defvar-local local-write-file-hooks nil) (put 'local-write-file-hooks 'permanent-local t) (make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1") ;; I found some files still using the obsolete form in 2018. (define-obsolete-variable-alias 'write-contents-hooks 'write-contents-functions "22.1") -(defvar write-contents-functions nil +(defvar-local write-contents-functions nil "List of functions to be called before writing out a buffer to a file. Used only by `save-buffer'. If one of them returns non-nil, the @@ -549,7 +577,6 @@ For hooks that _do_ pertain to the particular visited file, use `write-file-functions' relate to how a buffer is saved to file. To perform various checks or updates before the buffer is saved, use `before-save-hook'.") -(make-variable-buffer-local 'write-contents-functions) (defcustom enable-local-variables t "Control use of local variables in files you visit. @@ -574,7 +601,9 @@ a -*- line. The command \\[normal-mode], when used interactively, always obeys file local variable specifications and the -*- line, -and ignores this variable." +and ignores this variable. + +Also see the `permanently-enabled-local-variables' variable." :risky t :type '(choice (const :tag "Query Unsafe" t) (const :tag "Safe Only" :safe) @@ -590,7 +619,7 @@ settings being applied, but still respect file-local ones.") ;; This is an odd variable IMO. ;; You might wonder why it is needed, when we could just do: -;; (set (make-local-variable 'enable-local-variables) nil) +;; (setq-local enable-local-variables nil) ;; These two are not precisely the same. ;; Setting this variable does not cause -*- mode settings to be ;; ignored, whereas setting enable-local-variables does. @@ -745,10 +774,16 @@ resulting list of directory names. For an empty path element (i.e., a leading or trailing separator, or two adjacent separators), return nil (meaning `default-directory') as the associated list element." (when (stringp search-path) - (mapcar (lambda (f) - (if (equal "" f) nil - (substitute-in-file-name (file-name-as-directory f)))) - (split-string search-path path-separator)))) + (let ((spath (substitute-env-vars search-path))) + (mapcar (lambda (f) + (if (equal "" f) nil + (let ((dir (expand-file-name (file-name-as-directory f)))) + ;; Previous implementation used `substitute-in-file-name' + ;; which collapse multiple "/" in front. Do the same for + ;; backward compatibility. + (if (string-match "\\`/+" dir) + (substring dir (1- (match-end 0))) dir)))) + (split-string spath path-separator))))) (defun cd-absolute (dir) "Change current directory to given absolute file name DIR." @@ -814,7 +849,9 @@ The path separator is colon in GNU and GNU-like systems." (expand-file-name dir)) (locate-file dir cd-path nil (lambda (f) (and (file-directory-p f) 'dir-ok))) - (error "No such directory found via CDPATH environment variable")))) + (if (getenv "CDPATH") + (error "No such directory found via CDPATH environment variable: %s" dir) + (error "No such directory: %s" dir))))) (defun directory-files-recursively (dir regexp &optional include-directories predicate @@ -875,6 +912,16 @@ recursion." (push (concat dir "/" file) files))))) (nconc result (nreverse files)))) +(defun directory-empty-p (dir) + "Return t if DIR names an existing directory containing no other files. +Return nil if DIR does not name a directory, or if there was +trouble determining whether DIR is a directory or empty. + +Symbolic links to directories count as directories. +See `file-symlink-p' to distinguish symlinks." + (and (file-directory-p dir) + (null (directory-files dir nil directory-files-no-dot-files-regexp t 1)))) + (defvar module-file-suffix) (defun load-file (file) @@ -887,6 +934,8 @@ recursion." (read-file-name "Load file: " nil nil 'lambda)))) (load (expand-file-name file) nil nil t)) +(defvar comp-eln-to-el-h) + (defun locate-file (filename path &optional suffixes predicate) "Search for FILENAME through PATH. If found, return the absolute file name of FILENAME; otherwise @@ -913,7 +962,10 @@ one or more of those symbols." (logior (if (memq 'executable predicate) 1 0) (if (memq 'writable predicate) 2 0) (if (memq 'readable predicate) 4 0)))) - (locate-file-internal filename path suffixes predicate)) + (let ((file (locate-file-internal filename path suffixes predicate))) + (if (and file (string-match "\\.eln\\'" file)) + (gethash (file-name-nondirectory file) comp-eln-to-el-h) + file))) (defun locate-file-completion-table (dirs suffixes string pred action) "Do completion for file names passed to `locate-file'." @@ -972,14 +1024,6 @@ one or more of those symbols." (completion-table-with-context string-dir names string-file pred action))))) -(defun locate-file-completion (string path-and-suffixes action) - "Do completion for file names passed to `locate-file'. -PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." - (declare (obsolete locate-file-completion-table "23.1")) - (locate-file-completion-table (car path-and-suffixes) - (cdr path-and-suffixes) - string nil action)) - (defvar locate-dominating-stop-dir-regexp (purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'") "Regexp of directory names that stop the search in `locate-dominating-file'. @@ -987,7 +1031,7 @@ Any directory whose name matches this regexp will be treated like a kind of root directory by `locate-dominating-file', which will stop its search when it bumps into it. The default regexp prevents fruitless and time-consuming attempts to find -special files in directories in which filenames are interpreted as hostnames, +special files in directories in which file names are interpreted as host names, or mount points potentially requiring authentication as a different user.") (defun locate-dominating-file (file name) @@ -1094,6 +1138,8 @@ REMOTE is non-nil, search on the remote host indicated by (let ((default-directory (file-name-quote default-directory 'top))) (locate-file command exec-path exec-suffixes 1)))) +(declare-function read-library-name "find-func" nil) + (defun load-library (library) "Load the Emacs Lisp library named LIBRARY. LIBRARY should be a string. @@ -1103,12 +1149,7 @@ well as `load-file-rep-suffixes'). See Info node `(emacs)Lisp Libraries' for more details. See `load-file' for a different interface to `load'." - (interactive - (let (completion-ignored-extensions) - (list (completing-read "Load library: " - (apply-partially 'locate-file-completion-table - load-path - (get-load-suffixes)))))) + (interactive (list (read-library-name))) (load library)) (defun file-remote-p (file &optional identification connected) @@ -1390,7 +1431,7 @@ it means chase no more than that many links and then stop." newname)) ;; A handy function to display file sizes in human-readable form. -;; See http://en.wikipedia.org/wiki/Kibibyte for the reference. +;; See https://en.wikipedia.org/wiki/Kibibyte for the reference. (defun file-size-human-readable (file-size &optional flavor space unit) "Produce a string showing FILE-SIZE in human-readable form. @@ -1561,8 +1602,8 @@ use with M-x." (and (not (memq 'eight-bit-control charsets)) (not (memq 'eight-bit-graphic charsets))))) (setq from-coding (read-coding-system - (format "Recode filename %s from (default %s): " - filename default-coding) + (format-prompt "Recode filename %s from" + filename default-coding) default-coding)) (setq from-coding (read-coding-system (format "Recode filename %s from: " filename)))) @@ -1574,8 +1615,8 @@ use with M-x." (format "Recode filename %s from %s to: " filename from-coding))) (setq to-coding (read-coding-system - (format "Recode filename %s from %s to (default %s): " - filename from-coding default-coding) + (format-prompt "Recode filename %s from %s to" + default-coding filename from-coding) default-coding))) (list filename from-coding to-coding))) @@ -1631,20 +1672,21 @@ called additional times). This macro actually adds an auxiliary function that calls FUN, rather than FUN itself, to `minibuffer-setup-hook'." - (declare (indent 1) (debug t)) + (declare (indent 1) (debug ([&or (":append" form) [&or symbolp form]] body))) (let ((hook (make-symbol "setup-hook")) (funsym (make-symbol "fun")) (append nil)) (when (eq (car-safe fun) :append) (setq append '(t) fun (cadr fun))) `(let ((,funsym ,fun) - ,hook) - (setq ,hook - (lambda () - ;; Clear out this hook so it does not interfere - ;; with any recursive minibuffer usage. - (remove-hook 'minibuffer-setup-hook ,hook) - (funcall ,funsym))) + ;; Use a symbol to make sure `add-hook' doesn't waste time + ;; in `equal'ity testing (bug#46326). + (,hook (make-symbol "minibuffer-setup"))) + (fset ,hook (lambda () + ;; Clear out this hook so it does not interfere + ;; with any recursive minibuffer usage. + (remove-hook 'minibuffer-setup-hook ,hook) + (funcall ,funsym))) (unwind-protect (progn (add-hook 'minibuffer-setup-hook ,hook ,@append) @@ -1838,6 +1880,10 @@ expand wildcards (if any) and replace the file with multiple files." The buffer being killed is current while the hook is running. See `kill-buffer'. +This hook is not run for internal or temporary buffers created by +`get-buffer-create' or `generate-new-buffer' with argument +INHIBIT-BUFFER-HOOKS non-nil. + Note: Be careful with let-binding this hook considering it is frequently used for cleanup.") @@ -1917,6 +1963,8 @@ killed." (setq buffer-file-truename otrue) (setq dired-directory odir) (lock-buffer) + (if (get-buffer oname) + (kill-buffer oname)) (rename-buffer oname))) (unless (eq (current-buffer) obuf) (with-current-buffer obuf @@ -1937,7 +1985,7 @@ this function prepends a \"|\" to the final result if necessary." (let ((lastname (file-name-nondirectory filename))) (if (string= lastname "") (setq lastname filename)) - (generate-new-buffer (if (string-match-p "\\` " lastname) + (generate-new-buffer (if (string-prefix-p " " lastname) (concat "|" lastname) lastname)))) @@ -2105,29 +2153,75 @@ think it does, because \"free\" is pretty hard to define in practice." :version "25.1" :type '(choice integer (const :tag "Never issue warning" nil))) +(defcustom query-about-changed-file t + "If non-nil, query the user when re-visiting a file that has changed. +This happens if the file is already visited in a buffer, the +file was changed externally, and the user re-visits the file. + +If nil, don't prompt the user, but instead provide instructions for +reverting, after switching to the buffer with its contents before +the external changes." + :group 'files + :group 'find-file + :version "28.1" + :type 'boolean) + (declare-function x-popup-dialog "menu.c" (position contents &optional header)) +(defun files--ask-user-about-large-file-help-text (op-type size) + "Format the text that explains the options to open large files in Emacs. +OP-TYPE contains the kind of file operation that will be +performed. SIZE is the size of the large file." + (format + "The file that you want to %s is large (%s), which exceeds the + threshold above which Emacs asks for confirmation (%s). + + Large files may be slow to edit or navigate so Emacs asks you + before you try to %s such files. + + You can press: + 'y' to %s the file. + 'n' to abort, and not %s the file. + 'l' (the letter ell) to %s the file literally, which means that + Emacs will %s the file without doing any format or character code + conversion and in Fundamental mode, without loading any potentially + expensive features. + + You can customize the option `large-file-warning-threshold' to be the + file size, in bytes, from which Emacs will ask for confirmation. Set + it to nil to never request confirmation." + op-type + size + (funcall byte-count-to-string-function large-file-warning-threshold) + op-type + op-type + op-type + op-type + op-type)) + (defun files--ask-user-about-large-file (size op-type filename offer-raw) + "Query the user about what to do with large files. +Files are \"large\" if file SIZE is larger than `large-file-warning-threshold'. + +OP-TYPE specifies the file operation being performed on FILENAME. + +If OFFER-RAW is true, give user the additional option to open the +file literally." (let ((prompt (format "File %s is large (%s), really %s?" (file-name-nondirectory filename) (funcall byte-count-to-string-function size) op-type))) (if (not offer-raw) (if (y-or-n-p prompt) nil 'abort) - (let* ((use-dialog (and (display-popup-menus-p) - last-input-event - (listp last-nonmenu-event) - use-dialog-box)) - (choice - (if use-dialog - (x-popup-dialog t `(,prompt - ("Yes" . ?y) - ("No" . ?n) - ("Open literally" . ?l))) - (read-char-from-minibuffer - (concat prompt " (y)es or (n)o or (l)iterally ") - '(?y ?Y ?n ?N ?l ?L))))) - (cond ((memq choice '(?y ?Y)) nil) - ((memq choice '(?l ?L)) 'raw) + (let ((choice + (car + (read-multiple-choice + prompt '((?y "yes") + (?n "no") + (?l "literally")) + (files--ask-user-about-large-file-help-text + op-type (funcall byte-count-to-string-function size)))))) + (cond ((eq choice ?y) nil) + ((eq choice ?l) 'raw) (t 'abort)))))) (defun abort-if-file-too-large (size op-type filename &optional offer-raw) @@ -2227,7 +2321,8 @@ the various files." ;; Check to see if the file looks uncommonly large. (when (not (or buf nowarn)) (when (eq (abort-if-file-too-large - (file-attribute-size attributes) "open" filename t) + (file-attribute-size attributes) "open" filename + (not rawfile)) 'raw) (setf rawfile t)) (warn-maybe-out-of-memory (file-attribute-size attributes))) @@ -2253,6 +2348,14 @@ the various files." (message "Reverting file %s..." filename) (revert-buffer t t) (message "Reverting file %s...done" filename))) + ((not query-about-changed-file) + (message + (substitute-command-keys + "File %s changed on disk. \\[revert-buffer] to load new contents%s") + (file-name-nondirectory filename) + (if (buffer-modified-p buf) + " and discard your edits" + ""))) ((yes-or-no-p (if (string= (file-name-nondirectory filename) (buffer-name buf)) @@ -2296,53 +2399,52 @@ the various files." ;; hexl-mode or image-mode. (memq major-mode '(hexl-mode image-mode))) (if (buffer-modified-p) - (if (y-or-n-p - (format - (if rawfile - "The file %s is already visited normally, + (if (let ((help-form + (format-message + (if rawfile "\ +The file %s is already visited normally, and you have edited the buffer. Now you have asked to visit it literally, meaning no coding system handling, format conversion, or local variables. -Emacs can visit a file in only one way at a time. - -Do you want to save the file, and visit it literally instead? " - "The file %s is already visited literally, +Emacs can visit a file in only one way at a time." + "\ +The file %s is already visited literally, meaning no coding system handling, format conversion, or local variables. You have edited the buffer. Now you have asked to visit the file normally, -but Emacs can visit a file in only one way at a time. - -Do you want to save the file, and visit it normally instead? ") - (file-name-nondirectory filename))) +but Emacs can visit a file in only one way at a time.") + (file-name-nondirectory filename)))) + (y-or-n-p + (if rawfile "\ +Do you want to save the file, and visit it literally instead? " "\ +Do you want to save the file, and visit it normally instead? "))) (progn (save-buffer) (find-file-noselect-1 buf filename nowarn rawfile truename number)) (if (y-or-n-p - (format - (if rawfile - "\ -Do you want to discard your changes, and visit the file literally now? " - "\ -Do you want to discard your changes, and visit the file normally now? "))) + (if rawfile "\ +Do you want to discard your changes, and visit the file literally now? " "\ +Do you want to discard your changes, and visit the file normally now? ")) (find-file-noselect-1 buf filename nowarn rawfile truename number) (error (if rawfile "File already visited non-literally" "File already visited literally")))) - (if (y-or-n-p - (format - (if rawfile - "The file %s is already visited normally. + (if (let ((help-form + (format-message + (if rawfile "\ +The file %s is already visited normally. You have asked to visit it literally, meaning no coding system decoding, format conversion, or local variables. -But Emacs can visit a file in only one way at a time. - -Do you want to revisit the file literally now? " - "The file %s is already visited literally, +But Emacs can visit a file in only one way at a time." + "\ +The file %s is already visited literally, meaning no coding system decoding, format conversion, or local variables. You have asked to visit it normally, -but Emacs can visit a file in only one way at a time. - -Do you want to revisit the file normally now? ") - (file-name-nondirectory filename))) +but Emacs can visit a file in only one way at a time.") + (file-name-nondirectory filename)))) + (y-or-n-p + (if rawfile "\ +Do you want to revisit the file literally now? " "\ +Do you want to revisit the file normally now? "))) (find-file-noselect-1 buf filename nowarn rawfile truename number) (error (if rawfile "File already visited non-literally" @@ -2369,7 +2471,8 @@ Do you want to revisit the file normally now? ") (set-buffer-multibyte t)) (if rawfile (condition-case () - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t) + (enable-local-variables nil)) (insert-file-contents-literally filename t)) (file-error (when (and (file-exists-p filename) @@ -2406,11 +2509,9 @@ Do you want to revisit the file normally now? ") ;; this is a permanent local, the major mode won't eliminate it. (and backup-enable-predicate (not (funcall backup-enable-predicate buffer-file-name)) - (progn - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t))) + (setq-local backup-inhibited t)) (if rawfile - (progn + (let ((enable-local-variables nil)) (set-buffer-multibyte nil) (setq buffer-file-coding-system 'no-conversion) (set-buffer-major-mode buf) @@ -2518,23 +2619,20 @@ unless NOMODES is non-nil." (let* (not-serious (msg (cond - ((not warn) nil) - ((and error (file-attributes buffer-file-name)) + ((and error (file-exists-p buffer-file-name)) (setq buffer-read-only t) - (if (and (file-symlink-p buffer-file-name) - (not (file-exists-p - (file-chase-links buffer-file-name)))) - "Symbolic link that points to nonexistent file" - "File exists, but cannot be read")) + "File exists, but cannot be read") + ((and error (file-symlink-p buffer-file-name)) + "Symbolic link that points to nonexistent file") ((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)) - buffer-file-name)) + (if (and + ;; 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-this-file" (file-name-nondirectory buffer-file-name)) (setq not-serious t) @@ -2542,14 +2640,13 @@ unless NOMODES is non-nil." ((not error) (setq not-serious t) "Note: file is write protected") - ((file-attributes (directory-file-name default-directory)) + ((file-accessible-directory-p default-directory) "File not found and directory write-protected") - ((file-exists-p (file-name-directory buffer-file-name)) - (setq buffer-read-only nil)) (t (setq buffer-read-only nil) - "Use M-x make-directory RET RET to create the directory and its parents")))) - (when msg + (unless (file-directory-p default-directory) + "Use M-x make-directory RET RET to create the directory and its parents"))))) + (when (and warn msg) (message "%s" msg) (or not-serious (sit-for 1 t)))) (when (and auto-save-default (not noauto)) @@ -2660,6 +2757,14 @@ since only a single case-insensitive search through the alist is made." ("\\.ltx\\'" . latex-mode) ("\\.dtx\\'" . doctex-mode) ("\\.org\\'" . org-mode) + ;; .dir-locals.el is not really Elisp. Could use the + ;; `dir-locals-file' constant if it weren't defined below. + ("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode) + ("eww-bookmarks\\'" . lisp-data-mode) + ("tramp\\'" . lisp-data-mode) + ("/archive-contents\\'" . lisp-data-mode) + ("places\\'" . lisp-data-mode) + ("\\.emacs-places\\'" . lisp-data-mode) ("\\.el\\'" . emacs-lisp-mode) ("Project\\.ede\\'" . emacs-lisp-mode) ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode) @@ -2670,8 +2775,6 @@ since only a single case-insensitive search through the alist is made." ("\\.p\\'" . pascal-mode) ("\\.pas\\'" . pascal-mode) ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode) - ("\\.ad[abs]\\'" . ada-mode) - ("\\.ad[bs]\\.dg\\'" . ada-mode) ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) ("Imakefile\\'" . makefile-imake-mode) ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk @@ -2709,6 +2812,7 @@ since only a single case-insensitive search through the alist is made." ("\\.scm\\.[0-9]*\\'" . scheme-mode) ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) ("\\.bash\\'" . sh-mode) + ("/PKGBUILD\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) @@ -2749,8 +2853,8 @@ since only a single case-insensitive search through the alist is made." ;; The list of archive file extensions should be in sync with ;; `auto-coding-alist' with `no-conversion' coding system. ("\\.\\(\ -arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|\ -ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mode) +arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|squashfs\\|\ +ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . archive-mode) ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions. ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages. ;; Mailer puts message to be edited in @@ -2896,7 +3000,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mo ("\\.xmp\\'" . image-mode) ("\\.xwd\\'" . image-mode) ("\\.yuv\\'" . image-mode))) - "Alist of filename patterns vs corresponding major mode functions. + "Alist of file name 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 @@ -3058,7 +3162,7 @@ If FUNCTION is nil, then it is not called. (That is a way of saying "\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?" "[Hh][Tt][Mm][Ll]")) . mhtml-mode) - ("<!DOCTYPE[ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode) + ("<![Dd][Oo][Cc][Tt][Yy][Pp][Ee][ \t\r\n]+[Hh][Tt][Mm][Ll]" . mhtml-mode) ;; These two must come after html, because they are more general: ("<\\?xml " . xml-mode) (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") @@ -3089,7 +3193,7 @@ To find the right major mode, this function checks for a -*- mode tag checks for a `mode:' entry in the Local Variables section of the file, checks if it uses an interpreter listed in `interpreter-mode-alist', matches the buffer beginning against `magic-mode-alist', -compares the filename against the entries in `auto-mode-alist', +compares the file name against the entries in `auto-mode-alist', then matches the buffer beginning against `magic-fallback-mode-alist'. If `enable-local-variables' is nil, or if the file name matches @@ -3143,13 +3247,8 @@ we don't actually set it to the same mode the buffer already has." (or (set-auto-mode-0 mode keep-mode-if-same) ;; continuing would call minor modes again, toggling them off (throw 'nop nil)))))) - ;; hack-local-variables checks local-enable-local-variables etc, but - ;; we might as well be explicit here for the sake of clarity. (and (not done) - enable-local-variables - local-enable-local-variables - try-locals - (setq mode (hack-local-variables t)) + (setq mode (hack-local-variables t (not try-locals))) (not (memq mode modes)) ; already tried and failed (if (not (functionp mode)) (message "Ignoring unknown mode `%s'" mode) @@ -3422,23 +3521,21 @@ asking you for confirmation." (put 'c-set-style 'safe-local-eval-function t) -(defvar file-local-variables-alist nil +(defvar-local file-local-variables-alist nil "Alist of file-local variable settings in the current buffer. Each element in this list has the form (VAR . VALUE), where VAR is a file-local variable (a symbol) and VALUE is the value specified. The actual value in the buffer may differ from VALUE, if it is changed by the major or minor modes, or by the user.") -(make-variable-buffer-local 'file-local-variables-alist) (put 'file-local-variables-alist 'permanent-local t) -(defvar dir-local-variables-alist nil +(defvar-local dir-local-variables-alist nil "Alist of directory-local variable settings in the current buffer. Each element in this list has the form (VAR . VALUE), where VAR is a directory-local variable (a symbol) and VALUE is the value specified in .dir-locals.el. The actual value in the buffer may differ from VALUE, if it is changed by the major or minor modes, or by the user.") -(make-variable-buffer-local 'dir-local-variables-alist) (defvar before-hack-local-variables-hook nil "Normal hook run before setting file-local variables. @@ -3450,6 +3547,10 @@ function is allowed to change the contents of this alist. This hook is called only if there is at least one file-local variable to set.") +(defvar permanently-enabled-local-variables '(lexical-binding) + "A list of local variables that are always enabled. +This overrides any `enable-local-variables' setting.") + (defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars dir-name) "Get confirmation before setting up local variable values. ALL-VARS is the list of all variables to be set up. @@ -3501,7 +3602,7 @@ n -- to ignore the local variables list.") (let ((print-escape-newlines t)) (prin1 (cdr elt) buf)) (insert "\n")) - (set (make-local-variable 'cursor-type) nil) + (setq-local cursor-type nil) (set-buffer-modified-p nil) (goto-char (point-min))) @@ -3517,7 +3618,7 @@ n -- to ignore the local variables list.") ", or C-v/M-v to scroll"))) char) (if offer-save (push ?! exit-chars)) - (setq char (read-char-from-minibuffer prompt exit-chars)) + (setq char (read-char-choice prompt exit-chars)) (when (and offer-save (= char ?!) unsafe-vars) (customize-push-and-save 'safe-local-variable-values unsafe-vars)) (prog1 (memq char '(?! ?\s ?y)) @@ -3663,25 +3764,26 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil." ;; TODO? Warn once per file rather than once per session? (defvar hack-local-variables--warned-lexical nil) -(defun hack-local-variables (&optional handle-mode) +(defun hack-local-variables (&optional handle-mode inhibit-locals) "Parse and put into effect this buffer's local variables spec. For buffers visiting files, also puts into effect directory-local variables. -Uses `hack-local-variables-apply' to apply the variables. -If HANDLE-MODE is nil, we apply all the specified local -variables. If HANDLE-MODE is neither nil nor t, we do the same, -except that any settings of `mode' are ignored. +Uses `hack-local-variables-apply' to apply the variables. -If HANDLE-MODE is t, all we do is check whether a \"mode:\" -is specified, and return the corresponding mode symbol, or nil. -In this case, we try to ignore minor-modes, and return only a -major-mode. +See `hack-local-variables--find-variables' for the meaning of +HANDLE-MODE. -If `enable-local-variables' or `local-enable-local-variables' is nil, -this function does nothing. If `inhibit-local-variables-regexps' +If `enable-local-variables' or `local-enable-local-variables' is +nil, or INHIBIT-LOCALS is non-nil, this function disregards all +normal local variables. If `inhibit-local-variables-regexps' applies to the file in question, the file is not scanned for -local variables, but directory-local variables may still be applied." +local variables, but directory-local variables may still be +applied. + +Variables present in `permanently-enabled-local-variables' will +still be evaluated, even if local variables are otherwise +inhibited." ;; We don't let inhibit-local-variables-p influence the value of ;; enable-local-variables, because then it would affect dir-local ;; variables. We don't want to search eg tar files for file local @@ -3689,9 +3791,18 @@ local variables, but directory-local variables may still be applied." ;; to them. The real meaning of inhibit-local-variables-p is "do ;; not scan this file for local variables". (let ((enable-local-variables - (and local-enable-local-variables enable-local-variables)) - result) - (unless (eq handle-mode t) + (and (not inhibit-locals) + local-enable-local-variables enable-local-variables))) + (if (eq handle-mode t) + ;; We're looking just for the major mode setting. + (and enable-local-variables + (not (inhibit-local-variables-p)) + ;; If HANDLE-MODE is t, and the prop line specifies a + ;; mode, then we're done, and have no need to scan further. + (or (hack-local-variables-prop-line t) + ;; Look for the mode elsewhere in the buffer. + (hack-local-variables--find-variables t))) + ;; Normal handling of local variables. (setq file-local-variables-alist nil) (when (and (file-remote-p default-directory) (fboundp 'hack-connection-local-variables) @@ -3702,133 +3813,138 @@ local variables, but directory-local variables may still be applied." (connection-local-criteria-for-default-directory)))) (with-demoted-errors "Directory-local variables error: %s" ;; Note this is a no-op if enable-local-variables is nil. - (hack-dir-local-variables))) - ;; This entire function is basically a no-op if enable-local-variables - ;; is nil. All it does is set file-local-variables-alist to nil. - (when enable-local-variables - ;; This part used to ignore enable-local-variables when handle-mode - ;; was t. That was inappropriate, eg consider the - ;; (artificial) example of: - ;; (setq local-enable-local-variables nil) - ;; Open a file foo.txt that contains "mode: sh". - ;; It correctly opens in text-mode. - ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode. - (unless (or (inhibit-local-variables-p) - ;; If HANDLE-MODE is t, and the prop line specifies a - ;; mode, then we're done, and have no need to scan further. - (and (setq result (hack-local-variables-prop-line - handle-mode)) - (eq handle-mode t))) - ;; Look for "Local variables:" line in last page. - (save-excursion - (goto-char (point-max)) - (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) - 'move) - (when (let ((case-fold-search t)) - (search-forward "Local Variables:" nil t)) - (skip-chars-forward " \t") - ;; suffix is what comes after "local variables:" in its line. - ;; prefix is what comes before "local variables:" in its line. - (let ((suffix - (concat - (regexp-quote (buffer-substring (point) - (line-end-position))) - "$")) - (prefix - (concat "^" (regexp-quote - (buffer-substring (line-beginning-position) - (match-beginning 0)))))) - - (forward-line 1) - (let ((startpos (point)) - endpos - (thisbuf (current-buffer))) - (save-excursion - (unless (let ((case-fold-search t)) - (re-search-forward - (concat prefix "[ \t]*End:[ \t]*" suffix) - nil t)) - ;; This used to be an error, but really all it means is - ;; that this may simply not be a local-variables section, - ;; so just ignore it. - (message "Local variables list is not properly terminated")) - (beginning-of-line) - (setq endpos (point))) - - (with-temp-buffer - (insert-buffer-substring thisbuf startpos endpos) - (goto-char (point-min)) - (subst-char-in-region (point) (point-max) ?\^m ?\n) - (while (not (eobp)) - ;; Discard the prefix. - (if (looking-at prefix) - (delete-region (point) (match-end 0)) - (error "Local variables entry is missing the prefix")) - (end-of-line) - ;; Discard the suffix. - (if (looking-back suffix (line-beginning-position)) - (delete-region (match-beginning 0) (point)) - (error "Local variables entry is missing the suffix")) - (forward-line 1)) - (goto-char (point-min)) - - (while (not (or (eobp) - (and (eq handle-mode t) result))) - ;; Find the variable name; - (unless (looking-at hack-local-variable-regexp) - (error "Malformed local variable line: %S" - (buffer-substring-no-properties - (point) (line-end-position)))) - (goto-char (match-end 1)) - (let* ((str (match-string 1)) - (var (intern str)) - val val2) - (and (equal (downcase (symbol-name var)) "mode") - (setq var 'mode)) - ;; Read the variable value. - (skip-chars-forward "^:") - (forward-char 1) - ;; As a defensive measure, we do not allow - ;; circular data in the file-local data. - (let ((read-circle nil)) - (setq val (read (current-buffer)))) - (if (eq handle-mode t) - (and (eq var 'mode) - ;; Specifying minor-modes via mode: is - ;; deprecated, but try to reject them anyway. - (not (string-match - "-minor\\'" - (setq val2 (downcase (symbol-name val))))) - (setq result (intern (concat val2 "-mode")))) - (cond ((eq var 'coding)) - ((eq var 'lexical-binding) - (unless hack-local-variables--warned-lexical - (setq hack-local-variables--warned-lexical t) - (display-warning - 'files - (format-message - "%s: `lexical-binding' at end of file unreliable" - (file-name-nondirectory - ;; We are called from - ;; 'with-temp-buffer', so we need - ;; to use 'thisbuf's name in the - ;; warning message. - (or (buffer-file-name thisbuf) "")))))) - ((and (eq var 'mode) handle-mode)) - (t - (ignore-errors - (push (cons (if (eq var 'eval) - 'eval - (indirect-variable var)) - val) - result)))))) - (forward-line 1)))))))) - ;; Now we've read all the local variables. - ;; If HANDLE-MODE is t, return whether the mode was specified. - (if (eq handle-mode t) result - ;; Otherwise, set the variables. - (hack-local-variables-filter result nil) - (hack-local-variables-apply))))) + (hack-dir-local-variables)) + (let ((result (append (hack-local-variables--find-variables) + (hack-local-variables-prop-line)))) + (if (and enable-local-variables + (not (inhibit-local-variables-p))) + (progn + ;; Set the variables. + (hack-local-variables-filter result nil) + (hack-local-variables-apply)) + ;; Handle `lexical-binding' and other special local + ;; variables. + (dolist (variable permanently-enabled-local-variables) + (when-let ((elem (assq variable result))) + (push elem file-local-variables-alist))) + (hack-local-variables-apply)))))) + +(defun hack-local-variables--find-variables (&optional handle-mode) + "Return all local variables in the ucrrent buffer. +If HANDLE-MODE is nil, we gather all the specified local +variables. If HANDLE-MODE is neither nil nor t, we do the same, +except that any settings of `mode' are ignored. + +If HANDLE-MODE is t, all we do is check whether a \"mode:\" +is specified, and return the corresponding mode symbol, or nil. +In this case, we try to ignore minor-modes, and return only a +major-mode." + (let ((result nil)) + ;; Look for "Local variables:" line in last page. + (save-excursion + (goto-char (point-max)) + (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) + 'move) + (when (let ((case-fold-search t)) + (search-forward "Local Variables:" nil t)) + (skip-chars-forward " \t") + ;; suffix is what comes after "local variables:" in its line. + ;; prefix is what comes before "local variables:" in its line. + (let ((suffix + (concat + (regexp-quote (buffer-substring (point) + (line-end-position))) + "$")) + (prefix + (concat "^" (regexp-quote + (buffer-substring (line-beginning-position) + (match-beginning 0)))))) + + (forward-line 1) + (let ((startpos (point)) + endpos + (thisbuf (current-buffer))) + (save-excursion + (unless (let ((case-fold-search t)) + (re-search-forward + (concat prefix "[ \t]*End:[ \t]*" suffix) + nil t)) + ;; This used to be an error, but really all it means is + ;; that this may simply not be a local-variables section, + ;; so just ignore it. + (message "Local variables list is not properly terminated")) + (beginning-of-line) + (setq endpos (point))) + + (with-temp-buffer + (insert-buffer-substring thisbuf startpos endpos) + (goto-char (point-min)) + (subst-char-in-region (point) (point-max) ?\^m ?\n) + (while (not (eobp)) + ;; Discard the prefix. + (if (looking-at prefix) + (delete-region (point) (match-end 0)) + (error "Local variables entry is missing the prefix")) + (end-of-line) + ;; Discard the suffix. + (if (looking-back suffix (line-beginning-position)) + (delete-region (match-beginning 0) (point)) + (error "Local variables entry is missing the suffix")) + (forward-line 1)) + (goto-char (point-min)) + + (while (not (or (eobp) + (and (eq handle-mode t) result))) + ;; Find the variable name; + (unless (looking-at hack-local-variable-regexp) + (error "Malformed local variable line: %S" + (buffer-substring-no-properties + (point) (line-end-position)))) + (goto-char (match-end 1)) + (let* ((str (match-string 1)) + (var (intern str)) + val val2) + (and (equal (downcase (symbol-name var)) "mode") + (setq var 'mode)) + ;; Read the variable value. + (skip-chars-forward "^:") + (forward-char 1) + ;; As a defensive measure, we do not allow + ;; circular data in the file-local data. + (let ((read-circle nil)) + (setq val (read (current-buffer)))) + (if (eq handle-mode t) + (and (eq var 'mode) + ;; Specifying minor-modes via mode: is + ;; deprecated, but try to reject them anyway. + (not (string-match + "-minor\\'" + (setq val2 (downcase (symbol-name val))))) + (setq result (intern (concat val2 "-mode")))) + (cond ((eq var 'coding)) + ((eq var 'lexical-binding) + (unless hack-local-variables--warned-lexical + (setq hack-local-variables--warned-lexical t) + (display-warning + 'files + (format-message + "%s: `lexical-binding' at end of file unreliable" + (file-name-nondirectory + ;; We are called from + ;; 'with-temp-buffer', so we need + ;; to use 'thisbuf's name in the + ;; warning message. + (or (buffer-file-name thisbuf) "")))))) + ((and (eq var 'mode) handle-mode)) + (t + (ignore-errors + (push (cons (if (eq var 'eval) + 'eval + (indirect-variable var)) + val) + result)))))) + (forward-line 1))))))) + result)) (defun hack-local-variables-apply () "Apply the elements of `file-local-variables-alist'. @@ -3966,7 +4082,7 @@ already the major mode." ('eval (pcase val (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook))) - (save-excursion (eval val))) + (save-excursion (eval val t))) (_ (hack-one-local-variable--obsolete var) ;; Make sure the string has no text properties. @@ -4041,13 +4157,13 @@ Return the new variables list." (subdirs (assq 'subdirs alist))) (if (or (not subdirs) (progn - (setq alist (delq subdirs alist)) + (setq alist (remq subdirs alist)) (cdr-safe subdirs)) ;; TODO someone might want to extend this to allow ;; integer values for subdir, where N means ;; variables apply to this directory and N levels ;; below it (0 == nil). - (equal root default-directory)) + (equal root (expand-file-name default-directory))) (setq variables (dir-locals-collect-mode-variables alist variables)))))))) (error @@ -4286,15 +4402,36 @@ Return the new class name, which is a symbol named DIR." (let ((read-circle nil)) (read (current-buffer))) (end-of-file nil)))) + (unless (listp newvars) + (message "Invalid data in %s: %s" file newvars) + (setq newvars nil)) (setq variables ;; Try and avoid loading `map' since that also loads cl-lib ;; which then might hamper bytecomp warnings (bug#30635). (if (not (and newvars variables)) (or newvars variables) (require 'map) - (map-merge-with 'list (lambda (a b) (map-merge 'list a b)) - variables - newvars)))))) + ;; We want to make the variable setting from + ;; newvars (the second .dir-locals file) take + ;; presedence over the old variables, but we also + ;; want to preserve all `eval' elements as is from + ;; both lists. + (map-merge-with + 'list + (lambda (a b) + (let ((ag + (seq-group-by + (lambda (e) (eq (car e) 'eval)) a)) + (bg + (seq-group-by + (lambda (e) (eq (car e) 'eval)) b))) + (append (map-merge 'list + (assoc-default nil ag) + (assoc-default nil bg)) + (assoc-default t ag) + (assoc-default t bg)))) + variables + newvars)))))) (setq success latest)) (setq variables (dir-locals--sort-variables variables)) (dir-locals-set-class-variables class-name variables) @@ -4455,9 +4592,7 @@ the old visited file has been renamed to the new name FILENAME." (and buffer-file-name backup-enable-predicate (not (funcall backup-enable-predicate buffer-file-name)) - (progn - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t))) + (setq-local backup-inhibited t)) (let ((oauto buffer-auto-save-file-name)) (cond ((null filename) (setq buffer-auto-save-file-name nil)) @@ -4674,6 +4809,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." ;; Create temp files with strict access rights. It's easy to ;; loosen them later, whereas it's impossible to close the ;; time-window of loose permissions otherwise. + (let (nofollow-flag) (with-file-modes ?\700 (when (condition-case nil ;; Try to overwrite old backup first. @@ -4684,6 +4820,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." (when (file-exists-p to-name) (delete-file to-name)) (copy-file from-name to-name nil t t) + (setq nofollow-flag 'nofollow) nil) (file-already-exists t)) ;; The file was somehow created by someone else between @@ -4696,7 +4833,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." (with-demoted-errors (set-file-extended-attributes to-name extended-attributes))) (and modes - (set-file-modes to-name (logand modes #o1777))))) + (set-file-modes to-name (logand modes #o1777) nofollow-flag))))) (defvar file-name-version-regexp "\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)" @@ -4798,6 +4935,27 @@ extension, the value is \"\"." (if period ""))))) +(defun file-name-with-extension (filename extension) + "Set the EXTENSION of a FILENAME. +The extension (in a file name) is the part that begins with the last \".\". + +Trims a leading dot from the EXTENSION so that either \"foo\" or +\".foo\" can be given. + +Errors if the FILENAME or EXTENSION are empty, or if the given +FILENAME has the format of a directory. + +See also `file-name-sans-extension'." + (let ((extn (string-trim-left extension "[.]"))) + (cond ((string-empty-p filename) + (error "Empty filename: %s" filename)) + ((string-empty-p extn) + (error "Malformed extension: %s" extension)) + ((directory-name-p filename) + (error "Filename is a directory: %s" filename)) + (t + (concat (file-name-sans-extension filename) "." extn))))) + (defun file-name-base (&optional filename) "Return the base name of the FILENAME: no directory, no extension." (declare (advertised-calling-convention (filename) "27.1")) @@ -4824,7 +4982,7 @@ See also `backup-directory-alist'." (function :tag "Function"))) (defcustom backup-directory-alist nil - "Alist of filename patterns and backup directory names. + "Alist of file name 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 @@ -4837,7 +4995,7 @@ 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 +If this variable is nil, or it fails to match a file name, the backup is made in the original file's directory. On MS-DOS filesystems without long names this variable is always @@ -5194,7 +5352,7 @@ Used only by `save-buffer'." :type 'hook :group 'files) -(defvar save-buffer-coding-system nil +(defvar-local save-buffer-coding-system nil "If non-nil, use this coding system for saving the buffer. More precisely, use this coding system in place of the value of `buffer-file-coding-system', when saving the buffer. @@ -5202,7 +5360,6 @@ Calling `write-region' for any purpose other than saving the buffer will still use `buffer-file-coding-system'; this variable has no effect in such cases.") -(make-variable-buffer-local 'save-buffer-coding-system) (put 'save-buffer-coding-system 'permanent-local t) (defun basic-save-buffer (&optional called-interactively) @@ -5471,9 +5628,8 @@ Before and after saving the buffer, this function runs "ACTION-ALIST argument used in call to `map-y-or-n-p'.") (put 'save-some-buffers-action-alist 'risky-local-variable t) -(defvar buffer-save-without-query nil +(defvar-local buffer-save-without-query nil "Non-nil means `save-some-buffers' should save this buffer without asking.") -(make-variable-buffer-local 'buffer-save-without-query) (defcustom save-some-buffers-default-predicate nil "Default predicate for `save-some-buffers'. @@ -5555,10 +5711,28 @@ change the additional actions you can take on files." t (setq queried t) (if (buffer-file-name buffer) - (format "Save file %s? " - (buffer-file-name buffer)) - (format "Save buffer %s? " - (buffer-name buffer)))))) + (if (or + (equal (buffer-name buffer) + (file-name-nondirectory + (buffer-file-name buffer))) + (string-match + (concat "\\<" + (regexp-quote + (file-name-nondirectory + (buffer-file-name buffer))) + "<[^>]*>\\'") + (buffer-name buffer))) + ;; The buffer name is similar to the + ;; file name. + (format "Save file %s? " + (buffer-file-name buffer)) + ;; The buffer and file names are + ;; dissimilar; display both. + (format "Save file %s (buffer %s)? " + (buffer-file-name buffer) + (buffer-name buffer))) + ;; No file name + (format "Save buffer %s? " (buffer-name buffer)))))) (lambda (buffer) (with-current-buffer buffer (save-buffer))) @@ -5644,25 +5818,28 @@ like `write-region' does." (defun file-newest-backup (filename) "Return most recent backup file for FILENAME or nil if no backups exist." + (car (file-backup-file-names filename))) + +(defun file-backup-file-names (filename) + "Return a list of backup files for FILENAME. +The list will be sorted by modification time so that the most +recent files are first." ;; `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 (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)) - (cond ((and (backup-file-name-p tem) - (string= (file-name-sans-versions tem) file)) - (setq tem (concat dir tem)) - (if (or (null newest) - (file-newer-than-file-p tem newest)) - (setq newest tem))))) - newest)) + (dir (file-name-directory filename))) + (sort + (seq-filter + (lambda (candidate) + (and (backup-file-name-p candidate) + (string= (file-name-sans-versions candidate) filename))) + (mapcar + (lambda (file) + (concat dir file)) + (file-name-all-completions (file-name-nondirectory filename) dir))) + #'file-newer-than-file-p))) (defun rename-uniquely () "Rename current buffer to a similar name not already taken. @@ -5755,7 +5932,10 @@ If called interactively, then PARENTS is non-nil." (defconst directory-files-no-dot-files-regexp "[^.]\\|\\.\\.\\." - "Regexp matching any file name except \".\" and \"..\".") + "Regexp matching any file name except \".\" and \"..\". +More precisely, it matches parts of any nonempty string except those two. +It is useful as the regexp argument to `directory-files' and +`directory-files-and-attributes'.") (defun files--force (no-such fn &rest args) "Use NO-SUCH to affect behavior of function FN applied to list ARGS. @@ -5804,10 +5984,7 @@ RECURSIVE if DIRECTORY is nonempty." ;; case, where the operation fails in delete-directory-internal. ;; As `move-file-to-trash' trashes directories (empty or ;; otherwise) as a unit, we do not need to recurse here. - (if (and (not recursive) - ;; Check if directory is empty apart from "." and "..". - (directory-files - directory 'full directory-files-no-dot-files-regexp)) + (if (not (or recursive (directory-empty-p directory))) (error "Directory is not empty, not moving to trash") (move-file-to-trash directory))) ;; Otherwise, call ourselves recursively if needed. @@ -5880,9 +6057,9 @@ last-modified time as the old ones. (This works on only some systems.) A prefix arg makes KEEP-TIME non-nil. -Noninteractively, the last argument PARENTS says whether to -create parent directories if they don't exist. Interactively, -this happens by default. +Noninteractively, the PARENTS argument says whether to create +parent directories if they don't exist. Interactively, this +happens by default. If NEWNAME is a directory name, copy DIRECTORY as a subdirectory there. However, if called from Lisp with a non-nil optional @@ -5902,7 +6079,8 @@ into NEWNAME instead." ;; If default-directory is a remote directory, make sure we find its ;; copy-directory handler. (let ((handler (or (find-file-name-handler directory 'copy-directory) - (find-file-name-handler newname 'copy-directory)))) + (find-file-name-handler newname 'copy-directory))) + (follow parents)) (if handler (funcall handler 'copy-directory directory newname keep-time parents copy-contents) @@ -5922,7 +6100,8 @@ into NEWNAME instead." (or parents (not (file-directory-p newname))) (setq newname (concat newname (file-name-nondirectory directory)))) - (make-directory (directory-file-name newname) parents))) + (make-directory (directory-file-name newname) parents)) + (t (setq follow t))) ;; Copy recursively. (dolist (file @@ -5942,9 +6121,10 @@ into NEWNAME instead." ;; Set directory attributes. (let ((modes (file-modes directory)) (times (and keep-time (file-attribute-modification-time - (file-attributes directory))))) - (if modes (set-file-modes newname modes)) - (if times (set-file-times newname times)))))) + (file-attributes directory)))) + (follow-flag (unless follow 'nofollow))) + (if modes (set-file-modes newname modes follow-flag)) + (if times (set-file-times newname times follow-flag)))))) ;; At time of writing, only info uses this. @@ -6060,6 +6240,9 @@ This undoes all changes since the file was visited or saved. With a prefix argument, offer to revert from latest auto-save file, if that is more recent than the visited file. +Reverting a buffer will try to preserve markers in the buffer; +see the Info node `(elisp)Reverting' for details. + This command also implements an interface for special buffers that contain text that doesn't come from a file, but reflects some other data instead (e.g. Dired buffers, `buffer-list' @@ -6129,8 +6312,11 @@ Non-file buffers need a custom function." (dolist (regexp revert-without-query) (when (string-match regexp file-name) (throw 'found t))))) - (yes-or-no-p (format "Revert buffer from file %s? " - file-name))) + (yes-or-no-p + (format (if (buffer-modified-p) + "Discard edits and reread from %s? " + "Revert buffer from file %s? ") + file-name))) (run-hooks 'before-revert-hook) ;; If file was backed up but has changed since, ;; we should make another backup. @@ -6156,7 +6342,7 @@ Non-file buffers need a custom function." ;; Run after-revert-hook as it was before we reverted. (setq-default revert-buffer-internal-hook global-hook) (if local-hook - (set (make-local-variable 'revert-buffer-internal-hook) + (setq-local revert-buffer-internal-hook local-hook) (kill-local-variable 'revert-buffer-internal-hook)) (run-hooks 'revert-buffer-internal-hook)) @@ -6179,11 +6365,6 @@ an auto-save file." "Cannot revert unreadable file %s") file-name)) (t - ;; Bind buffer-file-name to nil - ;; so that we don't try to lock the file. - (let ((buffer-file-name nil)) - (or auto-save-p - (unlock-buffer))) (widen) (let ((coding-system-for-read ;; Auto-saved file should be read by Emacs's @@ -6216,6 +6397,82 @@ an auto-save file." (insert-file-contents file-name (not auto-save-p) nil nil t)))))) +(defvar revert-buffer-with-fine-grain-max-seconds 2.0 + "Maximum time that `revert-buffer-with-fine-grain' should use. +The command tries to preserve markers, properties and overlays. +If the operation takes more than this time, a single +delete+insert is performed. Actually, this value is passed as +the MAX-SECS argument to the function `replace-buffer-contents', +so it is not ensured that the whole execution won't take longer. +See `replace-buffer-contents' for more details.") + +(defun revert-buffer-insert-file-contents-delicately (file-name _auto-save-p) + "Optional function for `revert-buffer-insert-file-contents-function'. +The function `revert-buffer-with-fine-grain' uses this function by binding +`revert-buffer-insert-file-contents-function' to it. + +As with `revert-buffer-insert-file-contents--default-function', FILE-NAME is +the name of the file and AUTO-SAVE-P is non-nil if this is an auto-save file. +Since calling `replace-buffer-contents' can take a long time, depending of +the number of changes made to the buffer, it uses the value of the variable +`revert-buffer-with-fine-grain-max-seconds' as a maximum time to try delicately +reverting the buffer. If it fails, it does a delete+insert. For more details, +see `replace-buffer-contents'." + (cond + ((not (file-exists-p file-name)) + (error (if buffer-file-number + "File %s no longer exists" + "Cannot revert nonexistent file %s") + file-name)) + ((not (file-readable-p file-name)) + (error (if buffer-file-number + "File %s no longer readable" + "Cannot revert unreadable file %s") + file-name)) + (t + (let* ((buf (current-buffer)) ; current-buffer is the buffer to revert. + (success + (save-excursion + (save-restriction + (widen) + (with-temp-buffer + (insert-file-contents file-name) + (let ((temp-buf (current-buffer))) + (set-buffer buf) + (let ((buffer-file-name nil)) + (replace-buffer-contents + temp-buf + revert-buffer-with-fine-grain-max-seconds)))))))) + ;; See comments in revert-buffer-with-fine-grain for an explanation. + (defun revert-buffer-with-fine-grain-success-p () + success)) + (set-buffer-modified-p nil)))) + +(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm) + "Revert buffer preserving markers, overlays, etc. +This command is an alternative to `revert-buffer' because it tries to be as +non-destructive as possible, preserving markers, properties and overlays. +Binds `revert-buffer-insert-file-contents-function' to the function +`revert-buffer-insert-file-contents-delicately'. + +With a prefix argument, offer to revert from latest auto-save file. For more +details on the arguments, see `revert-buffer'." + ;; See revert-buffer for an explanation of this. + (interactive (list (not current-prefix-arg))) + ;; Simply bind revert-buffer-insert-file-contents-function to the specialized + ;; function, and call revert-buffer. + (let ((revert-buffer-insert-file-contents-function + #'revert-buffer-insert-file-contents-delicately)) + (revert-buffer ignore-auto noconfirm t) + ;; This closure is defined in revert-buffer-insert-file-contents-function. + ;; It is needed because revert-buffer--default always returns t after + ;; reverting, and it might be needed to report the success/failure of + ;; reverting delicately. + (when (fboundp 'revert-buffer-with-fine-grain-success-p) + (prog1 + (revert-buffer-with-fine-grain-success-p) + (fmakunbound 'revert-buffer-with-fine-grain-success-p))))) + (defun recover-this-file () "Recover the visited file--get contents from its last auto-save file." (interactive) @@ -6445,64 +6702,18 @@ Also rename any existing auto save file, if it was made in this session." (defun make-auto-save-file-name () "Return file name to use for auto-saves of current buffer. Does not consider `auto-save-visited-file-name' as that variable is checked -before calling this function. You can redefine this for customization. +before calling this function. See also `auto-save-file-name-p'." (if buffer-file-name - (let ((handler (find-file-name-handler buffer-file-name - 'make-auto-save-file-name))) + (let ((handler (find-file-name-handler + buffer-file-name 'make-auto-save-file-name))) (if handler (funcall handler 'make-auto-save-file-name) - (let ((list auto-save-file-name-transforms) - (filename buffer-file-name) - result uniq) - ;; 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) - uniq (car (cddr (car list))))) - (setq list (cdr list))) - (if result - (if uniq - (setq filename (concat - (file-name-directory result) - (subst-char-in-string - ?/ ?! - (replace-regexp-in-string "!" "!!" - filename)))) - (setq filename result))) - (setq result - (if (and (eq system-type 'ms-dos) - (not (msdos-long-file-names))) - ;; We truncate the file name to DOS 8+3 limits - ;; before doing anything else, because the regexp - ;; passed to string-match below cannot handle - ;; extensions longer than 3 characters, multiple - ;; dots, and other atrocities. - (let ((fn (dos-8+3-filename - (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) - "#"))) - ;; Make sure auto-save file names don't contain characters - ;; invalid for the underlying filesystem. - (if (and (memq system-type '(ms-dos windows-nt cygwin)) - ;; Don't modify remote filenames - (not (file-remote-p result))) - (convert-standard-filename result) - result)))) - + (files--transform-file-name + buffer-file-name auto-save-file-name-transforms + "#" "#"))) ;; Deal with buffers that don't have any associated files. (Mail ;; mode tends to create a good number of these.) - (let ((buffer-name (buffer-name)) (limit 0) file-name) @@ -6550,14 +6761,83 @@ See also `auto-save-file-name-p'." (file-error nil)) file-name))) +(defun files--transform-file-name (filename transforms prefix suffix) + "Transform FILENAME according to TRANSFORMS. +See `auto-save-file-name-transforms' for the format of +TRANSFORMS. PREFIX is prepended to the non-directory portion of +the resulting file name, and SUFFIX is appended." + (save-match-data + (let (result uniq) + ;; Apply user-specified translations to the file name. + (while (and transforms (not result)) + (if (string-match (car (car transforms)) filename) + (setq result (replace-match (cadr (car transforms)) t nil + filename) + uniq (car (cddr (car transforms))))) + (setq transforms (cdr transforms))) + (when result + (setq filename + (cond + ((memq uniq (secure-hash-algorithms)) + (concat + (file-name-directory result) + (secure-hash uniq filename))) + (uniq + (concat + (file-name-directory result) + (subst-char-in-string + ?/ ?! + (replace-regexp-in-string + "!" "!!" filename)))) + (t result)))) + (setq result + (if (and (eq system-type 'ms-dos) + (not (msdos-long-file-names))) + ;; We truncate the file name to DOS 8+3 limits before + ;; doing anything else, because the regexp passed to + ;; string-match below cannot handle extensions longer + ;; than 3 characters, multiple dots, and other + ;; atrocities. + (let ((fn (dos-8+3-filename + (file-name-nondirectory buffer-file-name)))) + (string-match + "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" + fn) + (concat (file-name-directory buffer-file-name) + prefix (match-string 1 fn) + "." (match-string 3 fn) suffix)) + (concat (file-name-directory filename) + prefix + (file-name-nondirectory filename) + suffix))) + ;; Make sure auto-save file names don't contain characters + ;; invalid for the underlying filesystem. + (expand-file-name + (if (and (memq system-type '(ms-dos windows-nt cygwin)) + ;; Don't modify remote filenames + (not (file-remote-p result))) + (convert-standard-filename result) + result))))) + +(defun make-lock-file-name (filename) + "Make a lock file name for FILENAME. +By default, this just prepends \".#\" to the non-directory part +of FILENAME, but the transforms in `lock-file-name-transforms' +are done first." + (let ((handler (find-file-name-handler filename 'make-lock-file-name))) + (if handler + (funcall handler 'make-lock-file-name filename) + (files--transform-file-name filename lock-file-name-transforms ".#" "")))) + (defun auto-save-file-name-p (filename) "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. -FILENAME should lack slashes. You can redefine this for customization." +FILENAME should lack slashes. +See also `make-auto-save-file-name'." (string-match "\\`#.*#\\'" filename)) (defun wildcard-to-regexp (wildcard) "Given a shell file name pattern WILDCARD, return an equivalent regexp. -The generated regexp will match a filename only if the filename +The generated regexp will match a file name only if the file name matches that wildcard according to shell rules. Only wildcards known by `sh' are supported." (let* ((i (string-match "[[.*+\\^$?]" wildcard)) @@ -6775,9 +7055,7 @@ We assume the output has the format of `df'. The value of this variable must be just a command name or file name; if you want to specify options, use `directory-free-space-args'. -A value of nil disables this feature. - -This variable is obsolete; Emacs no longer uses it." +A value of nil disables this feature." :type '(choice (string :tag "Program") (const :tag "None" nil)) :group 'dired) (make-obsolete-variable 'directory-free-space-program @@ -6823,6 +7101,9 @@ If DIR's free space cannot be obtained, this function returns nil." s "+" "\\(" HH:MM "\\|" yyyy "\\)")) (western-comma (concat month s "+" dd "," s "+" yyyy)) + ;; This represents the date in strftime(3) format "%e-%b-%Y" + ;; (aka "%v"), as it is the default for many ls incarnations. + (DD-MMM-YYYY (concat dd "-" month "-" yyyy s HH:MM)) ;; Japanese MS-Windows ls-lisp has one-digit months, and ;; omits the Kanji characters after month and day-of-month. ;; On Mac OS X 10.3, the date format in East Asian locales is @@ -6850,7 +7131,8 @@ If DIR's free space cannot be obtained, this function returns nil." ;; This is not supported yet. (purecopy (concat "\\([0-9][BkKMGTPEZY]? " iso "\\|.*[0-9][BkKMGTPEZY]? " - "\\(" western "\\|" western-comma "\\|" east-asian "\\)" + "\\(" western "\\|" western-comma + "\\|" DD-MMM-YYYY "\\|" east-asian "\\)" "\\) +"))) "Regular expression to match up to the file name in a directory listing. The default value is designed to recognize dates and times @@ -7031,6 +7313,8 @@ normally equivalent short `-D' option is just passed on to ((stringp switches) (concat switches " -d")) ((member "-d" switches) switches) (t (append switches '("-d")))))) + (if (string-match "\\`~" file) + (setq file (expand-file-name file))) (apply 'call-process insert-directory-program nil t nil (append @@ -7041,14 +7325,7 @@ normally equivalent short `-D' option is just passed on to (split-string-and-unquote 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 - file)))))))) + (list file)))))) ;; If we got "//DIRED//" in the output, it means we got a real ;; directory listing, even if `ls' returned nonzero. @@ -7233,9 +7510,9 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (save-some-buffers arg t) (let ((confirm confirm-kill-emacs)) (and - (or (not (memq t (mapcar (function - (lambda (buf) (and (buffer-file-name buf) - (buffer-modified-p buf)))) + (or (not (memq t (mapcar (lambda (buf) + (and (buffer-file-name buf) + (buffer-modified-p buf))) (buffer-list)))) (progn (setq confirm nil) (yes-or-no-p "Modified buffers exist; exit anyway? "))) @@ -7250,10 +7527,15 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (setq active t)) (setq processes (cdr processes))) (or (not active) - (with-displayed-buffer-window + (with-current-buffer-window (get-buffer-create "*Process List*") - '(display-buffer--maybe-at-bottom - (dedicated . t)) + `(display-buffer--maybe-at-bottom + (dedicated . t) + (window-height . fit-window-to-buffer) + (preserve-size . (nil . t)) + (body-function + . ,#'(lambda (_window) + (list-processes t)))) #'(lambda (window _value) (with-selected-window window (unwind-protect @@ -7261,8 +7543,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (setq confirm nil) (yes-or-no-p "Active processes exist; kill them and exit anyway? ")) (when (window-live-p window) - (quit-restore-window window 'kill))))) - (list-processes t))))) + (quit-restore-window window 'kill))))))))) ;; Query the user for other things, perhaps. (run-hook-with-args-until-failure 'kill-emacs-query-functions) (or (null confirm) @@ -7276,7 +7557,7 @@ If the current frame has no client, kill Emacs itself using With prefix ARG, silently save all file-visiting buffers, then kill. -If emacsclient was started with a list of filenames to edit, then +If emacsclient was started with a list of file names to edit, then only these files will be asked to be saved." (interactive "P") (if (frame-parameter nil 'client) @@ -7297,12 +7578,11 @@ only these files will be asked to be saved." ;; operations, which return a file name. See Bug#29579. (defun file-name-non-special (operation &rest arguments) - (let (;; In general, we don't want any file name handler. For some - ;; few cases, operations with two file name arguments which - ;; might be bound to different file name handlers, we still - ;; need this. - (saved-file-name-handler-alist file-name-handler-alist) - file-name-handler-alist + (let ((inhibit-file-name-handlers + (cons 'file-name-non-special + (and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers))) + (inhibit-file-name-operation operation) ;; Some operations respect file name handlers in ;; `default-directory'. Because core function like ;; `call-process' don't care about file name handlers in @@ -7384,69 +7664,73 @@ only these files will be asked to be saved." (when (car pair) (setcar pair (file-name-unquote (car pair) t)))) (setq file-arg-indices (cdr file-arg-indices)))) - (pcase method - ('identity (car arguments)) - ('add (file-name-quote (apply operation arguments) t)) - ('buffer-file-name - (let ((buffer-file-name (file-name-unquote buffer-file-name t))) - (apply operation arguments))) - ('insert-file-contents - (let ((visit (nth 1 arguments))) - (unwind-protect - (apply operation arguments) - (when (and visit buffer-file-name) - (setq buffer-file-name (file-name-quote buffer-file-name t)))))) - ('unquote-then-quote - ;; We can't use `cl-letf' with `(buffer-local-value)' here - ;; because it wouldn't work during bootstrapping. - (let ((buffer (current-buffer))) - ;; `unquote-then-quote' is used only for the - ;; `verify-visited-file-modtime' action, which takes a buffer - ;; as only optional argument. - (with-current-buffer (or (car arguments) buffer) - (let ((buffer-file-name (file-name-unquote buffer-file-name t))) - ;; Make sure to hide the temporary buffer change from the - ;; underlying operation. - (with-current-buffer buffer - (apply operation arguments)))))) - ('local-copy - (let* ((file-name-handler-alist saved-file-name-handler-alist) - (source (car arguments)) - (target (car (cdr arguments))) - (prefix (expand-file-name - "file-name-non-special" temporary-file-directory)) - tmpfile) - (cond - ;; If source is remote, we must create a local copy. - ((file-remote-p source) - (setq tmpfile (make-temp-name prefix)) - (apply operation source tmpfile (cddr arguments)) - (setq source tmpfile)) - ;; If source is quoted, and the unquoted source looks - ;; remote, we must create a local copy. - ((file-name-quoted-p source t) - (setq source (file-name-unquote source t)) - (when (file-remote-p source) + ;; In general, we don't want any file name handler, see Bug#47625, + ;; Bug#48349. For some few cases, operations with two file name + ;; arguments which might be bound to different file name handlers, + ;; we still need this. + (let ((tramp-mode (and tramp-mode (eq method 'local-copy)))) + (pcase method + ('identity (car arguments)) + ('add (file-name-quote (apply operation arguments) t)) + ('buffer-file-name + (let ((buffer-file-name (file-name-unquote buffer-file-name t))) + (apply operation arguments))) + ('insert-file-contents + (let ((visit (nth 1 arguments))) + (unwind-protect + (apply operation arguments) + (when (and visit buffer-file-name) + (setq buffer-file-name (file-name-quote buffer-file-name t)))))) + ('unquote-then-quote + ;; We can't use `cl-letf' with `(buffer-local-value)' here + ;; because it wouldn't work during bootstrapping. + (let ((buffer (current-buffer))) + ;; `unquote-then-quote' is used only for the + ;; `verify-visited-file-modtime' action, which takes a + ;; buffer as only optional argument. + (with-current-buffer (or (car arguments) buffer) + (let ((buffer-file-name (file-name-unquote buffer-file-name t))) + ;; Make sure to hide the temporary buffer change from + ;; the underlying operation. + (with-current-buffer buffer + (apply operation arguments)))))) + ('local-copy + (let ((source (car arguments)) + (target (car (cdr arguments))) + (prefix (expand-file-name + "file-name-non-special" temporary-file-directory)) + tmpfile) + (cond + ;; If source is remote, we must create a local copy. + ((file-remote-p source) (setq tmpfile (make-temp-name prefix)) - (let (file-name-handler-alist) - (apply operation source tmpfile (cddr arguments))) - (setq source tmpfile)))) - ;; If target is quoted, and the unquoted target looks remote, - ;; we must disable the file name handler. - (when (file-name-quoted-p target t) - (setq target (file-name-unquote target t)) - (when (file-remote-p target) - (setq file-name-handler-alist nil))) - ;; Do it. - (setcar arguments source) - (setcar (cdr arguments) target) - (apply operation arguments) - ;; Cleanup. - (when (and tmpfile (file-exists-p tmpfile)) - (if (file-directory-p tmpfile) - (delete-directory tmpfile 'recursive) (delete-file tmpfile))))) - (_ - (apply operation arguments))))) + (apply operation source tmpfile (cddr arguments)) + (setq source tmpfile)) + ;; If source is quoted, and the unquoted source looks + ;; remote, we must create a local copy. + ((file-name-quoted-p source t) + (setq source (file-name-unquote source t)) + (when (file-remote-p source) + (setq tmpfile (make-temp-name prefix)) + (let (file-name-handler-alist) + (apply operation source tmpfile (cddr arguments))) + (setq source tmpfile)))) + ;; If target is quoted, and the unquoted target looks + ;; remote, we must disable the file name handler. + (when (file-name-quoted-p target t) + (setq target (file-name-unquote target t)) + (when (file-remote-p target) + (setq file-name-handler-alist nil))) + ;; Do it. + (setcar arguments source) + (setcar (cdr arguments) target) + (apply operation arguments) + ;; Cleanup. + (when (and tmpfile (file-exists-p tmpfile)) + (if (file-directory-p tmpfile) + (delete-directory tmpfile 'recursive) (delete-file tmpfile))))) + (_ + (apply operation arguments)))))) (defsubst file-name-quoted-p (name &optional top) "Whether NAME is quoted with prefix \"/:\". @@ -7502,6 +7786,9 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)." ;; Rights relative to the previous file modes. ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111)) ((= char ?u) (let ((uright (logand #o4700 from))) + ;; FIXME: These divisions/shifts seem to be right + ;; for the `7' part of the #o4700 mask, but not + ;; for the `4' part. Same below for `g' and `o'. (+ uright (/ uright #o10) (/ uright #o100)))) ((= char ?g) (let ((gright (logand #o2070 from))) (+ gright (/ gright #o10) (* gright #o10)))) @@ -7536,6 +7823,44 @@ as in \"og+rX-w\"." op char-right))) num-rights)) +(defun file-modes-number-to-symbolic (mode &optional filetype) + "Return a string describing a file's MODE. +For instance, if MODE is #o700, then it produces `-rwx------'. +FILETYPE if provided should be a character denoting the type of file, +such as `?d' for a directory, or `?l' for a symbolic link and will override +the leading `-' char." + (string + (or filetype + (pcase (lsh mode -12) + ;; POSIX specifies that the file type is included in st_mode + ;; and provides names for the file types but values only for + ;; the permissions (e.g., S_IWOTH=2). + + ;; (#o017 ??) ;; #define S_IFMT 00170000 + (#o014 ?s) ;; #define S_IFSOCK 0140000 + (#o012 ?l) ;; #define S_IFLNK 0120000 + ;; (8 ??) ;; #define S_IFREG 0100000 + (#o006 ?b) ;; #define S_IFBLK 0060000 + (#o004 ?d) ;; #define S_IFDIR 0040000 + (#o002 ?c) ;; #define S_IFCHR 0020000 + (#o001 ?p) ;; #define S_IFIFO 0010000 + (_ ?-))) + (if (zerop (logand 256 mode)) ?- ?r) + (if (zerop (logand 128 mode)) ?- ?w) + (if (zerop (logand 64 mode)) + (if (zerop (logand 2048 mode)) ?- ?S) + (if (zerop (logand 2048 mode)) ?x ?s)) + (if (zerop (logand 32 mode)) ?- ?r) + (if (zerop (logand 16 mode)) ?- ?w) + (if (zerop (logand 8 mode)) + (if (zerop (logand 1024 mode)) ?- ?S) + (if (zerop (logand 1024 mode)) ?x ?s)) + (if (zerop (logand 4 mode)) ?- ?r) + (if (zerop (logand 2 mode)) ?- ?w) + (if (zerop (logand 512 mode)) + (if (zerop (logand 1 mode)) ?- ?x) + (if (zerop (logand 1 mode)) ?T ?t)))) + (defun file-modes-symbolic-to-number (modes &optional from) "Convert symbolic file modes to numeric file modes. MODES is the string to convert, it should match @@ -7643,7 +7968,7 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (let (delete-by-moving-to-trash) (rename-file fn new-fn)))) ;; Otherwise, use the freedesktop.org method, as specified at - ;; http://freedesktop.org/wiki/Specifications/trash-spec + ;; https://freedesktop.org/wiki/Specifications/trash-spec (t (let* ((xdg-data-dir (directory-file-name @@ -7706,9 +8031,24 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, ;; Make a .trashinfo file. Use O_EXCL, as per trash-spec 1.0. (let* ((files-base (file-name-nondirectory fn)) - (info-fn (expand-file-name + (is-directory (file-directory-p fn)) + (overwrite nil) + info-fn) + ;; We're checking further down whether the info file + ;; exists, but the file name may exist in the trash + ;; directory even if there is no info file for it. + (when (file-exists-p + (expand-file-name files-base trash-files-dir)) + (setq overwrite t + files-base (file-name-nondirectory + (make-temp-file + (expand-file-name + files-base trash-files-dir) + is-directory)))) + (setq info-fn (expand-file-name (concat files-base ".trashinfo") - trash-info-dir))) + trash-info-dir)) + ;; Re-check the existence (sort of). (condition-case nil (write-region nil nil info-fn nil 'quiet info-fn 'excl) (file-already-exists @@ -7724,7 +8064,7 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, ;; Finally, try to move the file to the trashcan. (let ((delete-by-moving-to-trash nil) (new-fn (expand-file-name files-base trash-files-dir))) - (rename-file fn new-fn))))))))) + (rename-file fn new-fn overwrite))))))))) (defsubst file-attribute-type (attributes) "The type field in ATTRIBUTES returned by `file-attributes'. |