diff options
Diffstat (limited to 'lisp/files.el')
| -rw-r--r-- | lisp/files.el | 1180 |
1 files changed, 753 insertions, 427 deletions
diff --git a/lisp/files.el b/lisp/files.el index dada69c1457..77977f14116 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -391,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; @@ -461,6 +465,31 @@ If `silently', don't ask the user before saving." :type '(choice (const t) (const nil) (const silently)) :group 'abbrev) +(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) + +(define-minor-mode lock-file-mode + "Toggle file locking in the current buffer (Lock File mode)." + :version "28.1" + (setq-local create-lockfiles (and lock-file-mode t))) + (defcustom find-file-run-dired t "Non-nil means allow `find-file' to visit directories. To visit the directory, `find-file' runs `find-directory-functions'." @@ -577,7 +606,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) @@ -751,7 +782,7 @@ nil (meaning `default-directory') as the associated list element." (let ((spath (substitute-env-vars search-path))) (mapcar (lambda (f) (if (equal "" f) nil - (let ((dir (expand-file-name (file-name-as-directory f)))) + (let ((dir (file-name-as-directory f))) ;; Previous implementation used `substitute-in-file-name' ;; which collapse multiple "/" in front. Do the same for ;; backward compatibility. @@ -823,7 +854,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 @@ -906,6 +939,8 @@ See `file-symlink-p' to distinguish symlinks." (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 @@ -932,7 +967,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'." @@ -998,7 +1036,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) @@ -1639,20 +1677,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) @@ -1663,6 +1702,10 @@ rather than FUN itself, to `minibuffer-setup-hook'." (list (read-file-name prompt nil default-directory mustmatch) t)) +(defun file-name-history--add (file) + "Add FILE to `file-name-history'." + (add-to-history 'file-name-history (abbreviate-file-name file))) + (defun find-file (filename &optional wildcards) "Edit file FILENAME. Switch to a buffer visiting file FILENAME, @@ -2119,29 +2162,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-choice - (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) @@ -2241,7 +2330,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))) @@ -2267,6 +2357,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)) @@ -2382,7 +2480,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) @@ -2421,7 +2520,7 @@ Do you want to revisit the file normally now? "))) (not (funcall backup-enable-predicate buffer-file-name)) (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) @@ -2529,23 +2628,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) @@ -2553,14 +2649,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)) @@ -2726,6 +2821,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) @@ -2913,7 +3009,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.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 @@ -3099,14 +3195,73 @@ If FUNCTION is nil, then it is not called.") "Upper limit on `magic-mode-alist' regexp matches. Also applies to `magic-fallback-mode-alist'.") +(defun set-auto-mode--apply-alist (alist keep-mode-if-same dir-local) + "Helper function for `set-auto-mode'. +This function takes an alist of the same form as +`auto-mode-alist'. It then tries to find the appropriate match +in the alist for the current buffer; setting the mode if +possible. +Return non-nil if the mode was set, nil otherwise. +DIR-LOCAL non-nil means this call is via directory-locals, and +extra checks should be done." + (if buffer-file-name + (let (mode + (name buffer-file-name) + (remote-id (file-remote-p buffer-file-name)) + (case-insensitive-p (file-name-case-insensitive-p + buffer-file-name))) + ;; Remove backup-suffixes from file name. + (setq name (file-name-sans-versions name)) + ;; Remove remote file name identification. + (when (and (stringp remote-id) + (string-match (regexp-quote remote-id) name)) + (setq name (substring name (match-end 0)))) + (while name + ;; Find first matching alist entry. + (setq mode + (if case-insensitive-p + ;; Filesystem is case-insensitive. + (let ((case-fold-search t)) + (assoc-default name alist 'string-match)) + ;; Filesystem is case-sensitive. + (or + ;; First match case-sensitively. + (let ((case-fold-search nil)) + (assoc-default name alist 'string-match)) + ;; Fallback to case-insensitive match. + (and auto-mode-case-fold + (let ((case-fold-search t)) + (assoc-default name alist 'string-match)))))) + (if (and mode + (consp mode) + (cadr mode)) + (setq mode (car mode) + name (substring name 0 (match-beginning 0))) + (setq name nil))) + (when (and dir-local mode + (not (set-auto-mode--dir-local-valid-p mode))) + (message "Ignoring invalid mode `%s'" mode) + (setq mode nil)) + (when mode + (set-auto-mode-0 mode keep-mode-if-same) + t)))) + +(defun set-auto-mode--dir-local-valid-p (mode) + "Say whether MODE can be used in a .dir-local.el `auto-mode-alist'." + (and (symbolp mode) + (string-suffix-p "-mode" (symbol-name mode)) + (commandp mode) + (not (provided-mode-derived-p mode 'special-mode)))) + (defun set-auto-mode (&optional keep-mode-if-same) "Select major mode appropriate for current buffer. 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 there an `auto-mode-alist' entry in `.dir-locals.el', 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 @@ -3160,13 +3315,16 @@ 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. + ;; Check for auto-mode-alist entry in dir-locals. + (unless done + (with-demoted-errors "Directory-local variables error: %s" + ;; Note this is a no-op if enable-local-variables is nil. + (let* ((mode-alist (cdr (hack-dir-local--get-variables + (lambda (key) (eq key 'auto-mode-alist)))))) + (setq done (set-auto-mode--apply-alist mode-alist + keep-mode-if-same t))))) (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) @@ -3216,45 +3374,8 @@ we don't actually set it to the same mode the buffer already has." (set-auto-mode-0 done keep-mode-if-same))) ;; Next compare the filename against the entries in auto-mode-alist. (unless done - (if buffer-file-name - (let ((name buffer-file-name) - (remote-id (file-remote-p buffer-file-name)) - (case-insensitive-p (file-name-case-insensitive-p - buffer-file-name))) - ;; Remove backup-suffixes from file name. - (setq name (file-name-sans-versions name)) - ;; Remove remote file name identification. - (when (and (stringp remote-id) - (string-match (regexp-quote remote-id) name)) - (setq name (substring name (match-end 0)))) - (while name - ;; Find first matching alist entry. - (setq mode - (if case-insensitive-p - ;; Filesystem is case-insensitive. - (let ((case-fold-search t)) - (assoc-default name auto-mode-alist - 'string-match)) - ;; Filesystem is case-sensitive. - (or - ;; First match case-sensitively. - (let ((case-fold-search nil)) - (assoc-default name auto-mode-alist - 'string-match)) - ;; Fallback to case-insensitive match. - (and auto-mode-case-fold - (let ((case-fold-search t)) - (assoc-default name auto-mode-alist - 'string-match)))))) - (if (and mode - (consp mode) - (cadr mode)) - (setq mode (car mode) - name (substring name 0 (match-beginning 0))) - (setq name nil)) - (when mode - (set-auto-mode-0 mode keep-mode-if-same) - (setq done t)))))) + (setq done (set-auto-mode--apply-alist auto-mode-alist + keep-mode-if-same nil))) ;; Next try matching the buffer beginning against magic-fallback-mode-alist. (unless done (if (setq done (save-excursion @@ -3348,13 +3469,27 @@ Major modes can use this to examine user-specified local variables in order to initialize other data structure based on them.") (defcustom safe-local-variable-values nil - "List variable-value pairs that are considered safe. + "List of variable-value pairs that are considered safe. Each element is a cons cell (VAR . VAL), where VAR is a variable -symbol and VAL is a value that is considered safe." +symbol and VAL is a value that is considered safe. + +Also see `ignored-local-variable-values'." :risky t :group 'find-file :type 'alist) +(defcustom ignored-local-variable-values nil + "List of variable-value pairs that should always be ignored. +Each element is a cons cell (VAR . VAL), where VAR is a variable +symbol and VAL is its value; if VAR is set to VAL by a file-local +variables section, that setting should be ignored. + +Also see `safe-local-variable-values'." + :risky t + :group 'find-file + :type 'alist + :version "28.1") + (defcustom safe-local-eval-forms ;; This should be here at least as long as Emacs supports write-file-hooks. '((add-hook 'write-file-hooks 'time-stamp) @@ -3465,6 +3600,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 file-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 +3640,9 @@ n -- to ignore the local variables list.") (if offer-save (insert " ! -- to apply the local variables list, and permanently mark these - values (*) as safe (in the future, they will be set automatically.)\n\n") + values (*) as safe (in the future, they will be set automatically.) +i -- to ignore the local variables list, and permanently mark these + values (*) as ignored\n\n") (insert "\n\n")) (dolist (elt all-vars) (cond ((member elt unsafe-vars) @@ -3525,16 +3666,24 @@ n -- to ignore the local variables list.") (pop-to-buffer buf '(display-buffer--maybe-at-bottom)) (let* ((exit-chars '(?y ?n ?\s)) (prompt (format "Please type %s%s: " - (if offer-save "y, n, or !" "y or n") + (if offer-save "y, n, ! or i" "y or n") (if (< (line-number-at-pos (point-max)) (window-body-height)) "" ", or C-v/M-v to scroll"))) char) - (if offer-save (push ?! exit-chars)) + (when offer-save + (push ?i exit-chars) + (push ?! 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)) + (when (and offer-save + (or (= char ?!) (= char ?i)) + unsafe-vars) + (customize-push-and-save + (if (= char ?!) + 'safe-local-variable-values + 'ignored-local-variable-values) + unsafe-vars)) (prog1 (memq char '(?! ?\s ?y)) (quit-window t))))))) @@ -3627,13 +3776,18 @@ If these settings come from directory-local variables, then DIR-NAME is the name of the associated directory. Otherwise it is nil." ;; Find those variables that we may want to save to ;; `safe-local-variable-values'. - (let (all-vars risky-vars unsafe-vars) + (let (all-vars risky-vars unsafe-vars ignored) (dolist (elt variables) (let ((var (car elt)) (val (cdr elt))) (cond ((memq var ignored-local-variables) ;; Ignore any variable in `ignored-local-variables'. nil) + ((seq-some (lambda (elem) + (and (eq (car elem) var) + (eq (cdr elem) val))) + ignored-local-variable-values) + nil) ;; Obey `enable-local-eval'. ((eq var 'eval) (when enable-local-eval @@ -3678,25 +3832,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 @@ -3704,9 +3859,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) @@ -3717,133 +3881,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'. @@ -3981,7 +4150,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. @@ -4027,10 +4196,13 @@ Returns the new list." ;; Need a new cons in case we setcdr later. (push (cons variable value) variables))))) -(defun dir-locals-collect-variables (class-variables root variables) +(defun dir-locals-collect-variables (class-variables root variables + &optional predicate) "Collect entries from CLASS-VARIABLES into VARIABLES. ROOT is the root directory of the project. -Return the new variables list." +Return the new variables list. +If PREDICATE is given, it is used to test a symbol key in the alist +to see whether it should be considered." (let* ((file-name (or (buffer-file-name) ;; Handle non-file buffers, too. (expand-file-name default-directory))) @@ -4049,9 +4221,11 @@ Return the new variables list." (>= (length sub-file-name) (length key)) (string-prefix-p key sub-file-name)) (setq variables (dir-locals-collect-variables - (cdr entry) root variables)))) - ((or (not key) - (derived-mode-p key)) + (cdr entry) root variables predicate)))) + ((if predicate + (funcall predicate key) + (or (not key) + (derived-mode-p key))) (let* ((alist (cdr entry)) (subdirs (assq 'subdirs alist))) (if (or (not subdirs) @@ -4301,6 +4475,9 @@ 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). @@ -4345,13 +4522,13 @@ Return the new class name, which is a symbol named DIR." (defvar hack-dir-local-variables--warned-coding nil) -(defun hack-dir-local-variables () +(defun hack-dir-local--get-variables (predicate) "Read per-directory local variables for the current buffer. -Store the directory-local variables in `dir-local-variables-alist' -and `file-local-variables-alist', without applying them. - -This does nothing if either `enable-local-variables' or -`enable-dir-local-variables' are nil." +Return a cons of the form (DIR . ALIST), where DIR is the +directory name (maybe nil) and ALIST is an alist of all variables +that might apply. These will be filtered according to the +buffer's directory, but not according to its mode. +PREDICATE is passed to `dir-locals-collect-variables'." (when (and enable-local-variables enable-dir-local-variables (or enable-remote-dir-locals @@ -4370,21 +4547,33 @@ This does nothing if either `enable-local-variables' or (setq dir-name (nth 0 dir-or-cache)) (setq class (nth 1 dir-or-cache)))) (when class - (let ((variables - (dir-locals-collect-variables - (dir-locals-get-class-variables class) dir-name nil))) - (when variables - (dolist (elt variables) - (if (eq (car elt) 'coding) - (unless hack-dir-local-variables--warned-coding - (setq hack-dir-local-variables--warned-coding t) - (display-warning 'files - "Coding cannot be specified by dir-locals")) - (unless (memq (car elt) '(eval mode)) - (setq dir-local-variables-alist - (assq-delete-all (car elt) dir-local-variables-alist))) - (push elt dir-local-variables-alist))) - (hack-local-variables-filter variables dir-name))))))) + (cons dir-name + (dir-locals-collect-variables + (dir-locals-get-class-variables class) + dir-name nil predicate)))))) + +(defun hack-dir-local-variables () + "Read per-directory local variables for the current buffer. +Store the directory-local variables in `dir-local-variables-alist' +and `file-local-variables-alist', without applying them. + +This does nothing if either `enable-local-variables' or +`enable-dir-local-variables' are nil." + (let* ((items (hack-dir-local--get-variables nil)) + (dir-name (car items)) + (variables (cdr items))) + (when variables + (dolist (elt variables) + (if (eq (car elt) 'coding) + (unless hack-dir-local-variables--warned-coding + (setq hack-dir-local-variables--warned-coding t) + (display-warning 'files + "Coding cannot be specified by dir-locals")) + (unless (memq (car elt) '(eval mode)) + (setq dir-local-variables-alist + (assq-delete-all (car elt) dir-local-variables-alist))) + (push elt dir-local-variables-alist))) + (hack-local-variables-filter variables dir-name)))) (defun hack-dir-local-variables-non-file-buffer () "Apply directory-local variables to a non-file buffer. @@ -4831,6 +5020,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")) @@ -4857,7 +5067,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 @@ -4870,7 +5080,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 @@ -4991,7 +5201,7 @@ The function `find-backup-file-name' also uses this." (expand-file-name (subst-char-in-string ?/ ?! - (replace-regexp-in-string "!" "!!" file)) + (string-replace "!" "!!" file)) backup-directory)) (expand-file-name (file-name-nondirectory file) (file-name-as-directory abs-backup-directory)))))) @@ -5517,9 +5727,23 @@ be saved." :group 'auto-save ;; FIXME nil should not be a valid option, let alone the default, ;; eg so that add-function can be used. - :type '(choice (const :tag "Default" nil) function) + :type '(choice (const :tag "Default" nil) + (function :tag "Only in subdirs of root" + save-some-buffers-root) + (function :tag "Custom function")) :version "26.1") +(defun save-some-buffers-root () + "A predicate to check whether the buffer is under the root directory. +Can be used as a value of `save-some-buffers-default-predicate' +to save buffers only under the project root or in subdirectories +of the directory that was default during command invocation." + (let ((root (or (and (featurep 'project) (project-current) + (fboundp 'project-root) + (project-root (project-current))) + default-directory))) + (lambda () (file-in-directory-p default-directory root)))) + (defun save-some-buffers (&optional arg pred) "Save some modified file-visiting buffers. Asks user about each one. You can answer `y' or SPC to save, `n' or DEL not to save, `C-r' @@ -5548,6 +5772,11 @@ change the additional actions you can take on files." (interactive "P") (unless pred (setq pred save-some-buffers-default-predicate)) + ;; Allow `pred' to be a function that returns a predicate + ;; with lexical bindings in its original environment (bug#46374). + (let ((pred-fun (and (functionp pred) (funcall pred)))) + (when (functionp pred-fun) + (setq pred pred-fun))) (let* ((switched-buffer nil) (save-some-buffers--switch-window-callback (lambda (buffer) @@ -6115,9 +6344,6 @@ 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' @@ -6143,7 +6369,12 @@ This function binds `revert-buffer-in-progress-p' non-nil while it operates. This function calls the function that `revert-buffer-function' specifies to do the work, with arguments IGNORE-AUTO and NOCONFIRM. The default function runs the hooks `before-revert-hook' and -`after-revert-hook'." +`after-revert-hook' + +Reverting a buffer will try to preserve markers in the buffer, +but it cannot always preserve all of them. For better results, +use `revert-buffer-with-fine-grain', which tries harder to +preserve markers and overlays, at the price of being slower." ;; I admit it's odd to reverse the sense of the prefix argument, but ;; there is a lot of code out there that assumes that the first ;; argument should be t to avoid consulting the auto-save file, and @@ -6187,8 +6418,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. @@ -6237,11 +6471,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 @@ -6323,7 +6552,8 @@ see `replace-buffer-contents'." ;; 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)))) + (set-buffer-modified-p nil) + (set-visited-file-modtime)))) (defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm) "Revert buffer preserving markers, overlays, etc. @@ -6350,6 +6580,38 @@ details on the arguments, see `revert-buffer'." (revert-buffer-with-fine-grain-success-p) (fmakunbound 'revert-buffer-with-fine-grain-success-p))))) +(defcustom revert-buffer-quick-short-answers nil + "How much confirmation to be done by the `revert-buffer-quick' command. +If non-nil, use `y-or-n-p' instead of `yes-or-no-p'." + :version "28.1" + :type 'boolean) + +(defun revert-buffer-quick (&optional auto-save) + "Like `revert-buffer', but asks for less confirmation. +If the current buffer is visiting a file, and the buffer is not +modified, no confirmation is required. + +This command heeds the `revert-buffer-quick-short-answers' user option. + +If AUTO-SAVE (the prefix argument), offer to revert from latest +auto-save file, if that is more recent than the visited file." + (interactive "P") + (cond + ;; If we've visiting a file, and we have no changes, don't ask for + ;; confirmation. + ((and buffer-file-name + (not (buffer-modified-p))) + (revert-buffer (not auto-save) t) + (message "Reverted buffer")) + ;; Heed `revert-buffer-quick-short-answers'. + (revert-buffer-quick-short-answers + (let ((use-short-answers t)) + (revert-buffer (not auto-save)))) + ;; Call `revert-buffer' normally. + (t + (revert-buffer (not auto-save))))) + + (defun recover-this-file () "Recover the visited file--get contents from its last auto-save file." (interactive) @@ -6405,7 +6667,8 @@ details on the arguments, see `revert-buffer'." (coding-system-for-read 'auto-save-coding)) (erase-buffer) (insert-file-contents file-name nil) - (set-buffer-file-coding-system coding-system)) + (set-buffer-file-coding-system coding-system) + (set-buffer-auto-saved)) (after-find-file nil nil t)) (t (user-error "Recover-file canceled"))))) @@ -6524,6 +6787,7 @@ This command is used in the special Dired buffer created by (message "No files can be recovered from this session now"))) (kill-buffer buffer)))) + (defun kill-buffer-ask (buffer) "Kill BUFFER if confirmed." (when (yes-or-no-p (format "Buffer %s %s. Kill? " @@ -6582,61 +6846,15 @@ Does not consider `auto-save-visited-file-name' as that variable is checked 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) @@ -6684,6 +6902,74 @@ 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 + ?/ ?! + (string-replace + "!" "!!" 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. @@ -6692,7 +6978,7 @@ See also `make-auto-save-file-name'." (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)) @@ -6745,7 +7031,7 @@ by `sh' are supported." (prog1 ; copy everything upto next `]'. (substring wildcard i - (setq j (string-match + (setq j (string-search "]" wildcard i))) (setq i (if j (1- j) (1- len))))))) ((eq ch ?.) "\\.") @@ -6871,7 +7157,7 @@ need to be passed verbatim to shell commands." ;; DOS/Windows don't allow `"' in file names. So if the ;; argument has quotes, we can safely assume it is already ;; quoted by the caller. - (if (or (string-match "[\"]" pattern) + (if (or (string-search "\"" pattern) ;; We quote [&()#$`'] in case their shell is a port of a ;; Unixy shell. We quote [,=+] because stock DOS and ;; Windows shells require that in some cases, such as @@ -7177,7 +7463,7 @@ normally equivalent short `-D' option is just passed on to (unless (equal switches "") ;; Split the switches at any spaces so we can ;; pass separate options as separate args. - (split-string-and-unquote switches))) + (split-string-shell-command switches))) ;; Avoid lossage if FILE starts with `-'. '("--") (list file)))))) @@ -7412,7 +7698,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) @@ -7433,12 +7719,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 @@ -7520,69 +7805,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 \"/:\". @@ -7638,6 +7927,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)))) @@ -7672,11 +7964,28 @@ as in \"og+rX-w\"." op char-right))) num-rights)) -(defun file-modes-number-to-symbolic (mode) +(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 - (if (zerop (logand 8192 mode)) - (if (zerop (logand 16384 mode)) ?- ?d) - ?c) ; completeness + (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)) @@ -7732,7 +8041,7 @@ based on existing mode bits, as in \"og+rX-w\"." (default (and (stringp modestr) (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr) - (replace-regexp-in-string + (string-replace "-" "" (format "u=%s,g=%s,o=%s" (match-string 1 modestr) @@ -7748,6 +8057,7 @@ based on existing mode bits, as in \"og+rX-w\"." (define-obsolete-variable-alias 'cache-long-line-scans 'cache-long-scans "24.4") + ;; Trashcan handling. (defcustom trash-directory nil "Directory for `move-file-to-trash' to move files and directories to. @@ -7863,9 +8173,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 - (concat files-base ".trashinfo") - trash-info-dir))) + (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 + (file-name-concat trash-files-dir files-base)) + (setq overwrite t + files-base (file-name-nondirectory + (make-temp-file + (file-name-concat + trash-files-dir files-base) + is-directory)))) + (setq info-fn (file-name-concat + trash-info-dir + (concat files-base ".trashinfo"))) + ;; Re-check the existence (sort of). (condition-case nil (write-region nil nil info-fn nil 'quiet info-fn 'excl) (file-already-exists @@ -7873,16 +8198,17 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, ;; like Emacs-style backup file names. E.g.: ;; https://bugs.kde.org/170956 (setq info-fn (make-temp-file - (expand-file-name files-base trash-info-dir) + (file-name-concat trash-info-dir files-base) nil ".trashinfo")) (setq files-base (substring (file-name-nondirectory info-fn) 0 (- (length ".trashinfo")))) (write-region nil nil info-fn nil 'quiet info-fn))) ;; 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))))))))) + (new-fn (file-name-concat trash-files-dir files-base))) + (rename-file fn new-fn overwrite))))))))) + (defsubst file-attribute-type (attributes) "The type field in ATTRIBUTES returned by `file-attributes'. The value is either t for directory, string (name linked to) for |