diff options
Diffstat (limited to 'lisp/files.el')
| -rw-r--r-- | lisp/files.el | 560 |
1 files changed, 335 insertions, 225 deletions
diff --git a/lisp/files.el b/lisp/files.el index 292c05b58e4..b5da0ea5c52 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -68,6 +68,31 @@ a regexp matching the name it is linked to." :group 'abbrev :group 'find-file) +(defun directory-abbrev-make-regexp (directory) + "Create a regexp to match DIRECTORY for `directory-abbrev-alist'." + (let ((regexp + ;; We include a slash at the end, to avoid spurious + ;; matches such as `/usr/foobar' when the home dir is + ;; `/usr/foo'. + (concat "\\`" (regexp-quote directory) "\\(/\\|\\'\\)"))) + ;; The value of regexp could be multibyte or unibyte. In the + ;; latter case, we need to decode it. + (if (multibyte-string-p regexp) + regexp + (decode-coding-string regexp + (if (eq system-type 'windows-nt) + 'utf-8 + locale-coding-system))))) + +(defun directory-abbrev-apply (filename) + "Apply the abbreviations in `directory-abbrev-alist' to FILENAME. +Note that when calling this, you should set `case-fold-search' as +appropriate for the filesystem used for FILENAME." + (dolist (dir-abbrev directory-abbrev-alist filename) + (when (string-match (car dir-abbrev) filename) + (setq filename (concat (cdr dir-abbrev) + (substring filename (match-end 0))))))) + (defcustom make-backup-files t "Non-nil means make a backup of a file the first time it is saved. This can be done by renaming the file or by copying. @@ -962,10 +987,7 @@ 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)))) - (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))) + (locate-file-internal filename path suffixes predicate)) (defun locate-file-completion-table (dirs suffixes string pred action) "Do completion for file names passed to `locate-file'." @@ -1468,8 +1490,13 @@ in all cases, since that is the standard symbol for byte." (if (string= prefix "") "" "i") (or unit "B")) (concat prefix unit)))) - (format (if (and (>= (mod file-size 1.0) 0.05) + ;; Mimic what GNU "ls -lh" does: + ;; If the formatted size will have just one digit before the decimal... + (format (if (and (< file-size 10) + ;; ...and its fractional part is not too small... + (>= (mod file-size 1.0) 0.05) (< (mod file-size 1.0) 0.95)) + ;; ...then emit one digit after the decimal. "%.1f%s%s" "%.0f%s%s") file-size @@ -1990,12 +2017,14 @@ otherwise a string <2> or <3> or ... is appended to get an unused name. Emacs treats buffers whose names begin with a space as internal buffers. To avoid confusion when visiting a file whose name begins with a space, 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-prefix-p " " lastname) - (concat "|" lastname) - lastname)))) + (let* ((lastname (file-name-nondirectory filename)) + (lastname (if (string= lastname "") + filename lastname)) + (buf (generate-new-buffer (if (string-prefix-p " " lastname) + (concat "|" lastname) + lastname)))) + (uniquify--create-file-buffer-advice buf filename) + buf)) (defcustom automount-dir-prefix (purecopy "^/tmp_mnt/") "Regexp to match the automounter prefix in a directory name." @@ -2020,73 +2049,54 @@ if you want to permanently change your home directory after having started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." ;; Get rid of the prefixes added by the automounter. (save-match-data ;FIXME: Why? - (if (and automount-dir-prefix - (string-match automount-dir-prefix filename) - (file-exists-p (file-name-directory - (substring filename (1- (match-end 0)))))) - (setq filename (substring filename (1- (match-end 0))))) - ;; Avoid treating /home/foo as /home/Foo during `~' substitution. - (let ((case-fold-search (file-name-case-insensitive-p filename))) - ;; If any elt of directory-abbrev-alist matches this name, - ;; abbreviate accordingly. - (dolist (dir-abbrev directory-abbrev-alist) - (if (string-match (car dir-abbrev) filename) - (setq filename - (concat (cdr dir-abbrev) - (substring filename (match-end 0)))))) - ;; Compute and save the abbreviated homedir name. - ;; We defer computing this until the first time it's needed, to - ;; give time for directory-abbrev-alist to be set properly. - ;; We include a slash at the end, to avoid spurious matches - ;; such as `/usr/foobar' when the home dir is `/usr/foo'. - (unless abbreviated-home-dir - (put 'abbreviated-home-dir 'home (expand-file-name "~")) - (setq abbreviated-home-dir - (let* ((abbreviated-home-dir "\\`\\'.") ;Impossible regexp. - (regexp - (concat "\\`" - (regexp-quote - (abbreviate-file-name - (get 'abbreviated-home-dir 'home))) - "\\(/\\|\\'\\)"))) - ;; Depending on whether default-directory does or - ;; doesn't include non-ASCII characters, the value - ;; of abbreviated-home-dir could be multibyte or - ;; unibyte. In the latter case, we need to decode - ;; it. Note that this function is called for the - ;; first time (from startup.el) when - ;; locale-coding-system is already set up. - (if (multibyte-string-p regexp) - regexp - (decode-coding-string regexp - (if (eq system-type 'windows-nt) - 'utf-8 - locale-coding-system)))))) - - ;; If FILENAME starts with the abbreviated homedir, - ;; and ~ hasn't changed since abbreviated-home-dir was set, - ;; make it start with `~' instead. - ;; If ~ has changed, we ignore abbreviated-home-dir rather than - ;; invalidating it, on the assumption that a change in HOME - ;; is likely temporary (eg for testing). - ;; FIXME Is it even worth caching abbreviated-home-dir? - ;; Ref: https://debbugs.gnu.org/19657#20 - (let (mb1) - (if (and (string-match abbreviated-home-dir filename) - (setq mb1 (match-beginning 1)) - ;; If the home dir is just /, don't change it. - (not (and (= (match-end 0) 1) - (= (aref filename 0) ?/))) - ;; MS-DOS root directories can come with a drive letter; - ;; Novell Netware allows drive letters beyond `Z:'. - (not (and (memq system-type '(ms-dos windows-nt cygwin)) - (string-match "\\`[a-zA-`]:/\\'" filename))) - (equal (get 'abbreviated-home-dir 'home) - (expand-file-name "~"))) - (setq filename - (concat "~" - (substring filename mb1)))) - filename)))) + (if-let ((handler (find-file-name-handler filename 'abbreviate-file-name))) + (funcall handler 'abbreviate-file-name filename) + (if (and automount-dir-prefix + (string-match automount-dir-prefix filename) + (file-exists-p (file-name-directory + (substring filename (1- (match-end 0)))))) + (setq filename (substring filename (1- (match-end 0))))) + ;; Avoid treating /home/foo as /home/Foo during `~' substitution. + (let ((case-fold-search (file-name-case-insensitive-p filename))) + ;; If any elt of directory-abbrev-alist matches this name, + ;; abbreviate accordingly. + (setq filename (directory-abbrev-apply filename)) + + ;; Compute and save the abbreviated homedir name. + ;; We defer computing this until the first time it's needed, to + ;; give time for directory-abbrev-alist to be set properly. + (unless abbreviated-home-dir + (put 'abbreviated-home-dir 'home (expand-file-name "~")) + (setq abbreviated-home-dir + (directory-abbrev-make-regexp + (let ((abbreviated-home-dir "\\`\\'.")) ;Impossible regexp. + (abbreviate-file-name + (get 'abbreviated-home-dir 'home)))))) + + ;; If FILENAME starts with the abbreviated homedir, + ;; and ~ hasn't changed since abbreviated-home-dir was set, + ;; make it start with `~' instead. + ;; If ~ has changed, we ignore abbreviated-home-dir rather than + ;; invalidating it, on the assumption that a change in HOME + ;; is likely temporary (eg for testing). + ;; FIXME Is it even worth caching abbreviated-home-dir? + ;; Ref: https://debbugs.gnu.org/19657#20 + (let (mb1) + (if (and (string-match abbreviated-home-dir filename) + (setq mb1 (match-beginning 1)) + ;; If the home dir is just /, don't change it. + (not (and (= (match-end 0) 1) + (= (aref filename 0) ?/))) + ;; MS-DOS root directories can come with a drive letter; + ;; Novell Netware allows drive letters beyond `Z:'. + (not (and (memq system-type '(ms-dos windows-nt cygwin)) + (string-match "\\`[a-zA-`]:/\\'" filename))) + (equal (get 'abbreviated-home-dir 'home) + (expand-file-name "~"))) + (setq filename + (concat "~" + (substring filename mb1)))) + filename))))) (defun find-buffer-visiting (filename &optional predicate) "Return the buffer visiting file FILENAME (a string). @@ -2750,8 +2760,7 @@ since only a single case-insensitive search through the alist is made." (defvar auto-mode-alist ;; Note: The entries for the modes defined in cc-mode.el (c-mode, ;; c++-mode, java-mode and more) are added through autoload - ;; directives in that file. That way is discouraged since it - ;; spreads out the definition of the initial value. + ;; directives in that file. (mapcar (lambda (elt) (cons (purecopy (car elt)) (cdr elt))) @@ -2766,6 +2775,7 @@ since only a single case-insensitive search through the alist is made." ("\\.gif\\'" . image-mode) ("\\.png\\'" . image-mode) ("\\.jpe?g\\'" . image-mode) + ("\\.webp\\'" . image-mode) ("\\.te?xt\\'" . text-mode) ("\\.[tT]e[xX]\\'" . tex-mode) ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. @@ -2891,6 +2901,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.[ds]?va?h?\\'" . verilog-mode) ("\\.by\\'" . bovine-grammar-mode) ("\\.wy\\'" . wisent-grammar-mode) + ("\\.erts\\'" . erts-mode) ;; .emacs or .gnus or .viper following a directory delimiter in ;; Unix or MS-DOS syntax. ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) @@ -2920,7 +2931,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS ("\\.[eE]?[pP][sS]\\'" . ps-mode) - ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX\\|XLSX?\\|PPTX?\\|pdf\\|djvu\\|dvi\\|od[fgpst]\\|docx\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe) + ("\\.\\(?:PDF\\|EPUB\\|CBZ\\|FB2\\|O?XPS\\|DVI\\|OD[FGPST]\\|DOCX\\|XLSX?\\|PPTX?\\|pdf\\|epub\\|cbz\\|fb2\\|o?xps\\|djvu\\|dvi\\|od[fgpst]\\|docx\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe) ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) ("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode) ("BROWSE\\'" . ebrowse-tree-mode) @@ -2983,6 +2994,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.dng\\'" . image-mode) ("\\.dpx\\'" . image-mode) ("\\.fax\\'" . image-mode) + ("\\.heic\\'" . image-mode) ("\\.hrz\\'" . image-mode) ("\\.icb\\'" . image-mode) ("\\.icc\\'" . image-mode) @@ -3046,8 +3058,7 @@ and `magic-mode-alist', which determines modes based on file contents.") (defvar interpreter-mode-alist ;; Note: The entries for the modes defined in cc-mode.el (awk-mode ;; and pike-mode) are added through autoload directives in that - ;; file. That way is discouraged since it spreads out the - ;; definition of the initial value. + ;; file. (mapcar (lambda (l) (cons (purecopy (car l)) (cdr l))) @@ -3239,6 +3250,7 @@ extra checks should be done." (let ((case-fold-search t)) (assoc-default name alist 'string-match)))))) (if (and mode + (not (functionp mode)) (consp mode) (cadr mode)) (setq mode (car mode) @@ -3631,7 +3643,7 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil." (cond (unsafe-vars (insert "The local variables list in " name - "\ncontains values that may not be safe (*)" + "\nor .dir-locals.el contains values that may not be safe (*)" (if risky-vars ", and variables that are risky (**)." "."))) @@ -3730,8 +3742,8 @@ return as the symbol specifying the mode." (while (not (or (and (eq handle-mode t) result) (>= (point) end))) (unless (looking-at hack-local-variable-regexp) - (message "Malformed mode-line: %S" - (buffer-substring-no-properties (point) end)) + (message "Malformed mode-line: %S in buffer %S" + (buffer-substring-no-properties (point) end) (buffer-name)) (throw 'malformed-line nil)) (goto-char (match-end 0)) ;; There used to be a downcase here, @@ -3958,22 +3970,21 @@ major-mode." ;; Discard the prefix. (if (looking-at prefix) (delete-region (point) (match-end 0)) - (error "Local variables entry is missing the prefix")) + (user-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")) + (user-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))) + (while (not (eobp)) ;; 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)))) + (user-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)) @@ -3994,7 +4005,8 @@ major-mode." (not (string-match "-minor\\'" (setq val2 (downcase (symbol-name val))))) - (setq result (intern (concat val2 "-mode")))) + ;; Allow several mode: elements. + (push (intern (concat val2 "-mode")) result)) (cond ((eq var 'coding)) ((eq var 'lexical-binding) (unless hack-local-variables--warned-lexical @@ -4018,7 +4030,10 @@ major-mode." val) result)))))) (forward-line 1))))))) - result)) + (if (eq handle-mode t) + ;; Return the final mode: setting that's defined. + (car (seq-filter #'fboundp result)) + result))) (defun hack-local-variables-apply () "Apply the elements of `file-local-variables-alist'. @@ -4052,7 +4067,8 @@ It is safe if any of these conditions are met: (and (functionp safep) ;; If the function signals an error, that means it ;; can't assure us that the value is safe. - (with-demoted-errors (funcall safep val)))))) + (with-demoted-errors "Local variable error: %S" + (funcall safep val)))))) (defun risky-local-variable-p (sym &optional _ignored) "Non-nil if SYM could be dangerous as a file-local variable. @@ -4077,11 +4093,8 @@ It is dangerous if either of these conditions are met: (defun hack-one-local-variable-quotep (exp) (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) -(defun hack-one-local-variable-constantp (exp) - (or (and (not (symbolp exp)) (not (consp exp))) - (memq exp '(t nil)) - (keywordp exp) - (hack-one-local-variable-quotep exp))) +(define-obsolete-function-alias 'hack-one-local-variable-constantp + #'macroexp-const-p "29.1") (defun hack-one-local-variable-eval-safep (exp) "Return non-nil if it is safe to eval EXP when it is found in a file." @@ -4119,7 +4132,7 @@ It is dangerous if either of these conditions are met: (cond ((eq prop t) (let ((ok t)) (dolist (arg (cdr exp)) - (unless (hack-one-local-variable-constantp arg) + (unless (macroexp-const-p arg) (setq ok nil))) ok)) ((functionp prop) @@ -4741,7 +4754,6 @@ using \\<minibuffer-local-map>\\[next-history-element]. If optional second arg CONFIRM is non-nil, this function asks for confirmation before overwriting an existing file. Interactively, confirmation is required unless you supply a prefix argument." -;; (interactive "FWrite file: ") (interactive (list (if buffer-file-name (read-file-name "Write file: " @@ -4752,33 +4764,44 @@ Interactively, confirmation is required unless you supply a prefix argument." default-directory) nil nil)) (not current-prefix-arg))) - (or (null filename) (string-equal filename "") - (progn - ;; If arg is a directory name, - ;; use the default file name, but in that directory. - (if (directory-name-p filename) - (setq filename (concat filename - (file-name-nondirectory - (or buffer-file-name (buffer-name)))))) - (and confirm - (file-exists-p filename) - ;; NS does its own confirm dialog. - (not (and (eq (framep-on-display) 'ns) - (listp last-nonmenu-event) - use-dialog-box)) - (or (y-or-n-p (format-message - "File `%s' exists; overwrite? " filename)) - (user-error "Canceled"))) - (set-visited-file-name filename (not confirm)))) - (set-buffer-modified-p t) - ;; Make buffer writable if file is writable. - (and buffer-file-name - (file-writable-p buffer-file-name) - (setq buffer-read-only nil)) - (save-buffer) - ;; It's likely that the VC status at the new location is different from - ;; the one at the old location. - (vc-refresh-state)) + (let ((old-modes + (and buffer-file-name + ;; File may have gone away; ignore errors in that case. + (ignore-errors (file-modes buffer-file-name))))) + (or (null filename) (string-equal filename "") + (progn + ;; If arg is a directory name, + ;; use the default file name, but in that directory. + (if (directory-name-p filename) + (setq filename (concat filename + (file-name-nondirectory + (or buffer-file-name (buffer-name)))))) + (and confirm + (file-exists-p filename) + ;; NS does its own confirm dialog. + (not (and (eq (framep-on-display) 'ns) + (listp last-nonmenu-event) + use-dialog-box)) + (or (y-or-n-p (format-message + "File `%s' exists; overwrite? " filename)) + (user-error "Canceled"))) + (set-visited-file-name filename (not confirm)))) + (set-buffer-modified-p t) + ;; Make buffer writable if file is writable. + (and buffer-file-name + (file-writable-p buffer-file-name) + (setq buffer-read-only nil)) + (save-buffer) + ;; If the old file was executable, then make the new file + ;; executable, too. + (when (and old-modes + (not (zerop (logand #o111 old-modes)))) + (set-file-modes buffer-file-name + (logior (logand #o111 old-modes) + (file-modes buffer-file-name)))) + ;; It's likely that the VC status at the new location is different from + ;; the one at the old location. + (vc-refresh-state))) (defun file-extended-attributes (filename) "Return an alist of extended attributes of file FILENAME. @@ -4921,7 +4944,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." nil))) ;; If set-file-extended-attributes fails, fall back on set-file-modes. (unless (and extended-attributes - (with-demoted-errors + (with-demoted-errors "Error setting attributes: %S" (set-file-extended-attributes to-name extended-attributes))) (and modes (set-file-modes to-name (logand modes #o1777) nofollow-flag))))) @@ -5053,6 +5076,33 @@ See also `file-name-sans-extension'." (file-name-sans-extension (file-name-nondirectory (or filename (buffer-file-name))))) +(defun file-name-split (filename) + "Return a list of all the components of FILENAME. +On most systems, this will be true: + + (equal (string-join (file-name-split filename) \"/\") filename)" + (let ((components nil)) + ;; If this is a directory file name, then we have a null file name + ;; at the end. + (when (directory-name-p filename) + (push "" components) + (setq filename (directory-file-name filename))) + ;; Loop, chopping off components. + (while (length> filename 0) + (push (file-name-nondirectory filename) components) + (let ((dir (file-name-directory filename))) + (setq filename (and dir (directory-file-name dir))) + ;; If there's nothing left to peel off, we're at the root and + ;; we can stop. + (when (and dir (equal dir filename)) + (push (if (equal dir "") "" + ;; On Windows, the first component might be "c:" or + ;; the like. + (substring dir 0 -1)) + components) + (setq filename nil)))) + components)) + (defcustom make-backup-file-name-function #'make-backup-file-name--default-function "A function that `make-backup-file-name' uses to create backup file names. @@ -5519,7 +5569,8 @@ Before and after saving the buffer, this function runs (goto-char (point-max)) (insert ?\n)))) ;; Don't let errors prevent saving the buffer. - (with-demoted-errors (run-hooks 'before-save-hook)) + (with-demoted-errors "Before-save hook error: %S" + (run-hooks 'before-save-hook)) ;; Give `write-contents-functions' a chance to ;; short-circuit the whole process. (unless (run-hook-with-args-until-success 'write-contents-functions) @@ -5567,7 +5618,7 @@ Before and after saving the buffer, this function runs (condition-case () (progn (unless - (with-demoted-errors + (with-demoted-errors "Error setting file modes: %S" (set-file-modes buffer-file-name (car setmodes))) (set-file-extended-attributes buffer-file-name (nth 1 setmodes)))) @@ -5682,7 +5733,7 @@ Before and after saving the buffer, this function runs ;; If set-file-extended-attributes fails, fall back on ;; set-file-modes. (unless - (with-demoted-errors + (with-demoted-errors "Error setting attributes: %s" (set-file-extended-attributes buffer-file-name (nth 1 setmodes))) (set-file-modes buffer-file-name @@ -5777,15 +5828,50 @@ of the directory that was default during command invocation." (lambda () (file-in-directory-p default-directory root)))) (put 'save-some-buffers-root 'save-some-buffers-function t) +(defun files--buffers-needing-to-be-saved (pred) + "Return a list of buffers to save according to PRED. +See `save-some-buffers' for PRED values." + (let ((buffers + (mapcar (lambda (buffer) + (if + ;; Note that killing some buffers may kill others via + ;; hooks (e.g. Rmail and its viewing buffer). + (and (buffer-live-p buffer) + (buffer-modified-p buffer) + (not (buffer-base-buffer buffer)) + (or + (buffer-file-name buffer) + (with-current-buffer buffer + (or (eq buffer-offer-save 'always) + (and pred buffer-offer-save + (> (buffer-size) 0))))) + (or (not (functionp pred)) + (with-current-buffer buffer + (funcall pred)))) + buffer)) + (buffer-list)))) + (delq nil buffers))) + +(defvar save-some-buffers-functions nil + "Functions to be run by `save-some-buffers' after saving the buffers. +The functions can be called in two \"modes\", depending on the +first argument. If the first argument is `query', then the +function should return non-nil if there is something to be +saved (but it should not actually save anything). + +If the first argument is something else, then the function should +save according to the value of the second argument, which is the +ARG argument from `save-some-buffers'.") + (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' +You can answer \\`y' or \\`SPC' to save, \\`n' or \\`DEL' not to save, \\`C-r' to look at the buffer in question with `view-buffer' before -deciding, `d' to view the differences using -`diff-buffer-with-file', `!' to save the buffer and all remaining -buffers without any further querying, `.' to save only the -current buffer and skip the remaining ones and `q' or RET to exit -the function without saving any more buffers. `C-h' displays a +deciding, \\`d' to view the differences using +`diff-buffer-with-file', \\`!' to save the buffer and all remaining +buffers without any further querying, \\`.' to save only the +current buffer and skip the remaining ones and \\`q' or \\`RET' to exit +the function without saving any more buffers. \\`C-h' displays a help message describing these options. This command first saves any buffers where `buffer-save-without-query' is @@ -5801,7 +5887,10 @@ should return non-nil if that buffer should be considered. PRED defaults to the value of `save-some-buffers-default-predicate'. See `save-some-buffers-action-alist' if you want to -change the additional actions you can take on files." +change the additional actions you can take on files. + +The functions in `save-some-buffers-functions' will be called +after saving the buffers." (interactive "P") (unless pred (setq pred @@ -5817,7 +5906,7 @@ change the additional actions you can take on files." (lambda (buffer) (setq switched-buffer buffer))) queried autosaved-buffers - files-done abbrevs-done) + files-done inhibit-message) (unwind-protect (save-window-excursion (dolist (buffer (buffer-list)) @@ -5833,64 +5922,42 @@ change the additional actions you can take on files." (setq files-done (map-y-or-n-p (lambda (buffer) - ;; Note that killing some buffers may kill others via - ;; hooks (e.g. Rmail and its viewing buffer). - (and (buffer-live-p buffer) - (buffer-modified-p buffer) - (not (buffer-base-buffer buffer)) - (or - (buffer-file-name buffer) - (with-current-buffer buffer - (or (eq buffer-offer-save 'always) - (and pred buffer-offer-save - (> (buffer-size) 0))))) - (or (not (functionp pred)) - (with-current-buffer buffer (funcall pred))) - (if arg - t - (setq queried t) - (if (buffer-file-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)))))) + (if arg + t + (setq queried t) + (if (buffer-file-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))) - (buffer-list) + (files--buffers-needing-to-be-saved pred) '("buffer" "buffers" "save") save-some-buffers-action-alist)) - ;; Maybe to save abbrevs, and record whether - ;; we either saved them or asked to. - (and save-abbrevs abbrevs-changed - (progn - (if (or arg - (eq save-abbrevs 'silently) - (y-or-n-p (format "Save abbrevs in %s? " - abbrev-file-name))) - (write-abbrev-file nil)) - ;; Don't keep bothering user if he says no. - (setq abbrevs-changed nil) - (setq abbrevs-done t))) - (or queried (> files-done 0) abbrevs-done + ;; Allow other things to be saved at this time, like abbrevs. + (dolist (func save-some-buffers-functions) + (setq inhibit-message (or (funcall func nil arg) inhibit-message))) + (or queried (> files-done 0) inhibit-message (cond ((null autosaved-buffers) (when (called-interactively-p 'any) @@ -6186,6 +6253,29 @@ Return nil if DIR is not an existing directory." (unless mismatch (file-equal-p root dir))))))) +(defvar file-has-changed-p--hash-table (make-hash-table :test #'equal) + "Internal variable used by `file-has-changed-p'.") + +(defun file-has-changed-p (file &optional tag) + "Return non-nil if FILE has changed. +The size and modification time of FILE are compared to the size +and modification time of the same FILE during a previous +invocation of `file-has-changed-p'. Thus, the first invocation +of `file-has-changed-p' always returns non-nil when FILE exists. +The optional argument TAG, which must be a symbol, can be used to +limit the comparison to invocations with identical tags; it can be +the symbol of the calling function, for example." + (let* ((file (directory-file-name (expand-file-name file))) + (remote-file-name-inhibit-cache t) + (fileattr (file-attributes file 'integer)) + (attr (and fileattr + (cons (file-attribute-size fileattr) + (file-attribute-modification-time fileattr)))) + (sym (concat (symbol-name tag) "@" file)) + (cachedattr (gethash sym file-has-changed-p--hash-table))) + (when (not (equal attr cachedattr)) + (puthash sym attr file-has-changed-p--hash-table)))) + (defun copy-directory (directory newname &optional keep-time parents copy-contents) "Copy DIRECTORY to NEWNAME. Both args must be strings. This function always sets the file modes of the output files to match @@ -7138,16 +7228,16 @@ default directory. However, if FULL is non-nil, they are absolute." (let ((this-dir-contents ;; Filter out "." and ".." (delq nil - (mapcar #'(lambda (name) - (unless (string-match "\\`\\.\\.?\\'" - (file-name-nondirectory name)) - name)) + (mapcar (lambda (name) + (unless (string-match "\\`\\.\\.?\\'" + (file-name-nondirectory name)) + name)) (directory-files (or dir ".") full (wildcard-to-regexp nondir)))))) (setq contents (nconc (if (and dir (not full)) - (mapcar #'(lambda (name) (concat dir name)) + (mapcar (lambda (name) (concat dir name)) this-dir-contents) this-dir-contents) contents))))) @@ -7162,11 +7252,18 @@ DIRNAME is globbed by the shell if necessary. Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. Actions controlled by variables `list-directory-brief-switches' and `list-directory-verbose-switches'." - (interactive (let ((pfx current-prefix-arg)) - (list (read-directory-name (if pfx "List directory (verbose): " - "List directory (brief): ") - nil default-directory nil) - pfx))) + (interactive + (let ((pfx current-prefix-arg)) + (list (read-file-name + (if pfx "List directory (verbose): " + "List directory (brief): ") + nil default-directory t + nil + (lambda (file) + (or (file-directory-p file) + (insert-directory-wildcard-in-dir-p + (expand-file-name file))))) + pfx))) (let ((switches (if verbose list-directory-verbose-switches list-directory-brief-switches)) buffer) @@ -7619,21 +7716,7 @@ normally equivalent short `-D' option is just passed on to (if val coding-no-eol coding)) (if val (put-text-property pos (point) - 'dired-filename t))))))) - - (if full-directory-p - ;; Try to insert the amount of free space. - (save-excursion - (goto-char beg) - ;; First find the line to put it on. - (when (re-search-forward "^ *\\(total\\)" nil t) - ;; Replace "total" with "total used in directory" to - ;; avoid confusion. - (replace-match "total used in directory" nil nil nil 1) - (let ((available (get-free-disk-space file))) - (when available - (end-of-line) - (insert " available " available)))))))))) + 'dired-filename t))))))))))) (defun insert-directory-adj-pos (pos error-lines) "Convert `ls --dired' file name position value POS to a buffer position. @@ -7688,18 +7771,34 @@ prompt the user before killing them." :group 'convenience :version "26.1") -(defun save-buffers-kill-emacs (&optional arg) +(defun save-buffers-kill-emacs (&optional arg restart) "Offer to save each buffer, then kill this Emacs process. With prefix ARG, silently save all file-visiting buffers without asking. If there are active processes where `process-query-on-exit-flag' returns non-nil and `confirm-kill-processes' is non-nil, asks whether processes should be killed. + Runs the members of `kill-emacs-query-functions' in turn and stops -if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." +if any returns nil. If `confirm-kill-emacs' is non-nil, calls it. + +If RESTART, restart Emacs after killing the current Emacs process." (interactive "P") ;; Don't use save-some-buffers-default-predicate, because we want ;; to ask about all the buffers before killing Emacs. - (save-some-buffers arg t) + (when (or (files--buffers-needing-to-be-saved t) + (catch 'need-save + (dolist (func save-some-buffers-functions) + (when (funcall func 'query) + (throw 'need-save t))))) + (if (use-dialog-box-p) + (pcase (x-popup-dialog + t `("Unsaved Buffers" + ("Close Without Saving" . no-save) + ("Save All" . save-all) + ("Cancel" . cancel))) + ('cancel (user-error "Exit cancelled")) + ('save-all (save-some-buffers t))) + (save-some-buffers arg t))) (let ((confirm confirm-kill-emacs)) (and (or (not (memq t (mapcar (lambda (buf) @@ -7740,7 +7839,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (run-hook-with-args-until-failure 'kill-emacs-query-functions) (or (null confirm) (funcall confirm "Really exit Emacs? ")) - (kill-emacs)))) + (kill-emacs nil restart)))) (defun save-buffers-kill-terminal (&optional arg) "Offer to save each buffer, then kill the current connection. @@ -7755,6 +7854,16 @@ only these files will be asked to be saved." (if (frame-parameter nil 'client) (server-save-buffers-kill-terminal arg) (save-buffers-kill-emacs arg))) + +(defun restart-emacs () + "Kill the current Emacs process and start a new one. +This goes through the same shutdown procedure as +`save-buffers-kill-emacs', but instead of killing Emacs and +exiting, it re-executes Emacs (using the same command line +arguments as the running Emacs)." + (interactive) + (save-buffers-kill-emacs nil t)) + ;; We use /: as a prefix to "quote" a file name ;; so that magic file name handlers will not apply to it. @@ -7794,10 +7903,11 @@ only these files will be asked to be saved." ;; Get a list of the indices of the args that are file names. (file-arg-indices (cdr (or (assq operation - '(;; The first seven are special because they + '(;; The first eight are special because they ;; return a file name. We want to include ;; the /: in the return value. So just ;; avoid stripping it in the first place. + (abbreviate-file-name) (directory-file-name) (expand-file-name) (file-name-as-directory) |