]> code.delx.au - gnu-emacs/blobdiff - lisp/files.el
backup-buffer minor reworking of internals
[gnu-emacs] / lisp / files.el
index 40a4289741935b16c4151339c631d4acc22bd7d6..6939f2b8fc10b437f3116ab16bd114b8c39126cd 100644 (file)
@@ -55,7 +55,7 @@ FROM with TO when it appears in a directory name.  This replacement is
 done when setting up the default directory of a newly visited file.
 
 FROM is matched against directory names anchored at the first
-character, so it should start with a \"\\\\`\", or, if directory
+character, so it should start with a \"\\\\\\=`\", or, if directory
 names cannot have embedded newlines, with a \"^\".
 
 FROM and TO should be equivalent names, which refer to the
@@ -573,6 +573,12 @@ using \\[read-only-mode]."
 
 Maximum length of the history list is determined by the value
 of `history-length', which see.")
+
+(defvar save-silently nil
+  "If non-nil, avoid messages when saving files.
+Error-related messages will still be printed, but all other
+messages will not.")
+
 \f
 (put 'ange-ftp-completion-hook-function 'safe-magic t)
 (defun ange-ftp-completion-hook-function (op &rest args)
@@ -648,10 +654,14 @@ the value of `default-directory'."
                  'file-directory-p))
 
 \f
-(defun pwd ()
-  "Show the current default directory."
-  (interactive nil)
-  (message "Directory %s" default-directory))
+(defun pwd (&optional insert)
+  "Show the current default directory.
+With prefix argument INSERT, insert the current default directory
+at point instead."
+  (interactive "P")
+  (if insert
+      (insert default-directory)
+    (message "Directory %s" default-directory)))
 
 (defvar cd-path nil
   "Value of the CDPATH environment variable, as a list.
@@ -1082,14 +1092,14 @@ Tip: You can use this expansion of remote identifier components
 
 (defcustom remote-file-name-inhibit-cache 10
   "Whether to use the remote file-name cache for read access.
-When `nil', never expire cached values (caution)
-When `t', never use the cache (safe, but may be slow)
+When nil, never expire cached values (caution)
+When t, never use the cache (safe, but may be slow)
 A number means use cached values for that amount of seconds since caching.
 
 The attributes of remote files are cached for better performance.
 If they are changed outside of Emacs's control, the cached values
 become invalid, and must be reread.  If you are sure that nothing
-other than Emacs changes the files, you can set this variable to `nil'.
+other than Emacs changes the files, you can set this variable to nil.
 
 If a remote file is checked regularly, it might be a good idea to
 let-bind this variable to a value less than the interval between
@@ -1192,7 +1202,7 @@ containing it, until no links are left at any level.
            (setq dirfile (directory-file-name dir))
            ;; If these are equal, we have the (or a) root directory.
            (or (string= dir dirfile)
-               (and (memq system-type '(windows-nt ms-dos cygwin))
+               (and (memq system-type '(windows-nt ms-dos cygwin nacl))
                     (eq (compare-strings dir 0 nil dirfile 0 nil t) t))
                ;; If this is the same dir we last got the truename for,
                ;; save time--don't recalculate.
@@ -1628,10 +1638,10 @@ killed."
             (confirm-nonexistent-file-or-buffer) file-name)
           t)))
   (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
-    (error "Aborted"))
+    (user-error "Aborted"))
   (and (buffer-modified-p) buffer-file-name
        (not (yes-or-no-p "Kill and replace the buffer without saving it? "))
-       (error "Aborted"))
+       (user-error "Aborted"))
   (let ((obuf (current-buffer))
        (ofile buffer-file-name)
        (onum buffer-file-number)
@@ -1844,7 +1854,7 @@ OP-TYPE specifies the file operation being performed (for message to user)."
             (not (y-or-n-p (format "File %s is large (%s), really %s? "
                                    (file-name-nondirectory filename)
                                    (file-size-human-readable size) op-type))))
-    (error "Aborted")))
+    (user-error "Aborted")))
 
 (defun warn-maybe-out-of-memory (size)
   "Warn if an attempt to open file of SIZE bytes may run out of memory."
@@ -1865,6 +1875,13 @@ If that fails, try to open it with `find-file-literally'
             out-of-memory-warning-percentage
             (file-size-human-readable (* total-free-memory 1024)))))))))
 
+(defun files--message (format &rest args)
+  "Like `message', except sometimes don't print to minibuffer.
+If the variable `save-silently' is non-nil, the message is not
+displayed on the minibuffer."
+  (apply #'message format args)
+  (when save-silently (message nil)))
+
 (defun find-file-noselect (filename &optional nowarn rawfile wildcards)
   "Read file FILENAME into a buffer and return the buffer.
 If a buffer exists visiting FILENAME, return that one, but
@@ -1910,8 +1927,8 @@ the various files."
              (or nowarn
                  find-file-suppress-same-file-warnings
                  (string-equal filename (buffer-file-name other))
-                 (message "%s and %s are the same file"
-                          filename (buffer-file-name other)))
+                 (files--message "%s and %s are the same file"
+                                  filename (buffer-file-name other)))
              ;; Optionally also find that buffer.
              (if (or find-file-existing-other-name find-file-visit-truename)
                  (setq buf other))))
@@ -2110,7 +2127,7 @@ Do you want to revisit the file normally now? ")
 (defun insert-file-contents-literally (filename &optional visit beg end replace)
   "Like `insert-file-contents', but only reads in the file literally.
 A buffer may be modified in several ways after reading into the buffer,
-to Emacs features such as format decoding, character code
+due to Emacs features such as format decoding, character code
 conversion, `find-file-hook', automatic uncompression, etc.
 
 This function ensures that none of these modifications will take place."
@@ -2506,7 +2523,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
      ;; this has lower priority to avoid matching changelog.sgml etc.
      ("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode)
      ;; either user's dot-files or under /etc or some such
-     ("/\\.?\\(?:gnokiirc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
+     ("/\\.?\\(?:gitconfig\\|gnokiirc\\|hgrc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
      ;; alas not all ~/.*rc files are like this
      ("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode)
      ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode)
@@ -3362,7 +3379,7 @@ local variables, but directory-local variables may still be applied."
                      (error "Local variables entry is missing the prefix"))
                    (end-of-line)
                    ;; Discard the suffix.
-                   (if (looking-back 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))
@@ -3883,7 +3900,7 @@ the old visited file has been renamed to the new name FILENAME."
           (not no-query)
           (not (y-or-n-p (format "A buffer is visiting %s; proceed? "
                                  filename)))
-          (error "Aborted")))
+          (user-error "Aborted")))
     (or (equal filename buffer-file-name)
        (progn
          (and filename (lock-buffer filename))
@@ -3931,17 +3948,19 @@ the old visited file has been renamed to the new name FILENAME."
           (make-local-variable 'backup-inhibited)
           (setq backup-inhibited t)))
     (let ((oauto buffer-auto-save-file-name))
-      ;; If auto-save was not already on, turn it on if appropriate.
-      (if (not buffer-auto-save-file-name)
-         (and buffer-file-name auto-save-default
-              (auto-save-mode t))
-       ;; If auto save is on, start using a new name.
-       ;; We deliberately don't rename or delete the old auto save
-       ;; for the old visited file name.  This is because perhaps
-       ;; the user wants to save the new state and then compare with the
-       ;; previous state from the auto save file.
-       (setq buffer-auto-save-file-name
-             (make-auto-save-file-name)))
+      (cond ((null filename)
+            (setq buffer-auto-save-file-name nil))
+           ((not buffer-auto-save-file-name)
+            ;; If auto-save was not already on, turn it on if appropriate.
+            (and buffer-file-name auto-save-default (auto-save-mode t)))
+           (t
+            ;; If auto save is on, start using a new name. We
+            ;; deliberately don't rename or delete the old auto save
+            ;; for the old visited file name.  This is because
+            ;; perhaps the user wants to save the new state and then
+            ;; compare with the previous state from the auto save
+            ;; file.
+            (setq buffer-auto-save-file-name (make-auto-save-file-name))))
       ;; Rename the old auto save file if any.
       (and oauto buffer-auto-save-file-name
           (file-exists-p oauto)
@@ -4007,7 +4026,7 @@ Interactively, confirmation is required unless you supply a prefix argument."
                       (listp last-nonmenu-event)
                       use-dialog-box))
             (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
-                (error "Canceled")))
+                (user-error "Canceled")))
        (set-visited-file-name filename (not confirm))))
   (set-buffer-modified-p t)
   ;; Make buffer writable if file is writable.
@@ -4058,80 +4077,75 @@ on the original file; this means that the caller, after saving
 the buffer, should change the extended attributes of the new file
 to agree with the old attributes.
 BACKUPNAME is the backup file name, which is the old file renamed."
-  (if (and make-backup-files (not backup-inhibited)
-          (not buffer-backed-up)
-          (file-exists-p buffer-file-name)
-          (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
-                '(?- ?l)))
-      (let ((real-file-name buffer-file-name)
-           backup-info backupname targets setmodes)
+  (when (and make-backup-files (not backup-inhibited) (not buffer-backed-up))
+    (let ((attributes (file-attributes buffer-file-name)))
+      (when (and attributes (memq (aref (elt attributes 8) 0) '(?- ?l)))
        ;; If specified name is a symbolic link, chase it to the target.
-       ;; Thus we make the backups in the directory where the real file is.
-       (setq real-file-name (file-chase-links real-file-name))
-       (setq backup-info (find-backup-file-name real-file-name)
-             backupname (car backup-info)
-             targets (cdr backup-info))
-       ;; (if (file-directory-p buffer-file-name)
-       ;;     (error "Cannot save buffer in directory %s" buffer-file-name))
-       (if backup-info
-           (condition-case ()
-               (let ((delete-old-versions
-                      ;; If have old versions to maybe delete,
-                      ;; ask the user to confirm now, before doing anything.
-                      ;; But don't actually delete til later.
-                      (and targets
-                           (or (eq delete-old-versions t) (eq delete-old-versions nil))
-                           (or delete-old-versions
-                               (y-or-n-p (format "Delete excess backup versions of %s? "
-                                                 real-file-name)))))
-                     (modes (file-modes buffer-file-name))
-                     (extended-attributes
-                      (file-extended-attributes buffer-file-name)))
-                 ;; Actually write the back up file.
-                 (condition-case ()
-                     (if (or file-precious-flag
-    ;                        (file-symlink-p buffer-file-name)
-                             backup-by-copying
-                             ;; Don't rename a suid or sgid file.
-                             (and modes (< 0 (logand modes #o6000)))
-                             (not (file-writable-p (file-name-directory real-file-name)))
-                             (and backup-by-copying-when-linked
-                                  (> (file-nlinks real-file-name) 1))
-                             (and (or backup-by-copying-when-mismatch
-                                      (integerp backup-by-copying-when-privileged-mismatch))
-                                  (let ((attr (file-attributes real-file-name)))
-                                    (and (or backup-by-copying-when-mismatch
-                                             (and (integerp (nth 2 attr))
-                                                  (integerp backup-by-copying-when-privileged-mismatch)
-                                                  (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
-                                         (not (file-ownership-preserved-p
-                                               real-file-name t))))))
-                         (backup-buffer-copy real-file-name
-                                             backupname modes
-                                             extended-attributes)
-                       ;; rename-file should delete old backup.
-                       (rename-file real-file-name backupname t)
-                       (setq setmodes (list modes extended-attributes
-                                            backupname)))
-                   (file-error
-                    ;; If trouble writing the backup, write it in
-                    ;; .emacs.d/%backup%.
-                    (setq backupname (locate-user-emacs-file "%backup%~"))
-                    (message "Cannot write backup file; backing up in %s"
-                             backupname)
-                    (sleep-for 1)
-                    (backup-buffer-copy real-file-name backupname
-                                        modes extended-attributes)))
-                 (setq buffer-backed-up t)
-                 ;; Now delete the old versions, if desired.
-                 (if delete-old-versions
-                     (while targets
-                       (condition-case ()
-                           (delete-file (car targets))
-                         (file-error nil))
-                       (setq targets (cdr targets))))
-                 setmodes)
-           (file-error nil))))))
+       ;; This makes backups in the directory where the real file is.
+       (let* ((real-file-name (file-chase-links buffer-file-name))
+              (backup-info (find-backup-file-name real-file-name)))
+         (when backup-info
+           (let* ((backupname (car backup-info))
+                  (targets (cdr backup-info))
+                  (old-versions
+                   ;; If have old versions to maybe delete,
+                   ;; ask the user to confirm now, before doing anything.
+                   ;; But don't actually delete til later.
+                   (and targets
+                        (booleanp delete-old-versions)
+                        (or delete-old-versions
+                            (y-or-n-p
+                             (format "Delete excess backup versions of %s? "
+                                     real-file-name)))
+                        targets))
+                  (modes (file-modes buffer-file-name))
+                  (extended-attributes
+                   (file-extended-attributes buffer-file-name))
+                  (copy-when-priv-mismatch
+                   backup-by-copying-when-privileged-mismatch)
+                  (make-copy
+                   (or file-precious-flag backup-by-copying
+                       ;; Don't rename a suid or sgid file.
+                       (and modes (< 0 (logand modes #o6000)))
+                       (not (file-writable-p
+                             (file-name-directory real-file-name)))
+                       (and backup-by-copying-when-linked
+                            (< 1 (file-nlinks real-file-name)))
+                       (and (or backup-by-copying-when-mismatch
+                                (and (integerp copy-when-priv-mismatch)
+                                     (let ((attr (file-attributes
+                                                  real-file-name
+                                                  'integer)))
+                                       (<= (nth 2 attr)
+                                           copy-when-priv-mismatch))))
+                            (not (file-ownership-preserved-p real-file-name
+                                                             t)))))
+                  setmodes)
+             (condition-case ()
+                 (progn
+                   ;; Actually make the backup file.
+                   (if make-copy
+                       (backup-buffer-copy real-file-name backupname
+                                           modes extended-attributes)
+                     ;; rename-file should delete old backup.
+                     (rename-file real-file-name backupname t)
+                     (setq setmodes (list modes extended-attributes
+                                          backupname)))
+                   (setq buffer-backed-up t)
+                   ;; Now delete the old versions, if desired.
+                   (dolist (old-version old-versions)
+                     (delete-file old-version)))
+               (file-error nil))
+             ;; If trouble writing the backup, write it in .emacs.d/%backup%.
+             (when (not buffer-backed-up)
+               (setq backupname (locate-user-emacs-file "%backup%~"))
+               (message "Cannot write backup file; backing up in %s"
+                        backupname)
+               (sleep-for 1)
+               (backup-buffer-copy real-file-name backupname
+                                   modes extended-attributes)
+               (setq buffer-backed-up t))
+             setmodes)))))))
 
 (defun backup-buffer-copy (from-name to-name modes extended-attributes)
   ;; Create temp files with strict access rights.  It's easy to
@@ -4639,9 +4653,12 @@ See the subroutine `basic-save-buffer' for more information."
     ;; then Rmail-mbox never displays it due to buffer swapping.  If
     ;; the test is ever re-introduced, be sure to handle saving of
     ;; Rmail files.
-    (if (and modp (buffer-file-name) (not noninteractive))
+    (if (and modp
+             (buffer-file-name)
+             (not noninteractive)
+             (not save-silently))
        (message "Saving file %s..." (buffer-file-name)))
-    (basic-save-buffer)
+    (basic-save-buffer (called-interactively-p 'any))
     (and modp (memq arg '(4 64)) (setq buffer-backed-up nil))))
 
 (defun delete-auto-save-file-if-necessary (&optional force)
@@ -4683,14 +4700,14 @@ in such cases.")
 (make-variable-buffer-local 'save-buffer-coding-system)
 (put 'save-buffer-coding-system 'permanent-local t)
 
-(defun basic-save-buffer ()
+(defun basic-save-buffer (&optional called-interactively)
   "Save the current buffer in its visited file, if it has been modified.
 The hooks `write-contents-functions' and `write-file-functions' get a chance
 to do the job of saving; if they do not, then the buffer is saved in
 the visited file in the usual way.
 Before and after saving the buffer, this function runs
 `before-save-hook' and `after-save-hook', respectively."
-  (interactive)
+  (interactive '(called-interactively))
   (save-current-buffer
     ;; In an indirect buffer, save its base buffer instead.
     (if (buffer-base-buffer)
@@ -4781,7 +4798,9 @@ Before and after saving the buffer, this function runs
          ;; Support VC `implicit' locking.
          (vc-after-save)
          (run-hooks 'after-save-hook))
-      (or noninteractive (message "(No changes need to be saved)")))))
+      (or noninteractive
+          (not called-interactively)
+          (files--message "(No changes need to be saved)")))))
 
 ;; This does the "real job" of writing a buffer into its visited file
 ;; and making a backup file.  This is what is normally done
@@ -4854,9 +4873,10 @@ Before and after saving the buffer, this function runs
                                ;; Pass in nil&nil rather than point-min&max
                                ;; cause we're saving the whole buffer.
                                ;; write-region-annotate-functions may use it.
-                              (write-region nil nil
-                                            tempname nil  realname
-                                            buffer-file-truename 'excl)
+                               (write-region nil nil
+                                             tempname nil  realname
+                                             buffer-file-truename 'excl)
+                               (when save-silently (message nil))
                               nil)
                           (file-already-exists t))
                    ;; The file was somehow created by someone else between
@@ -4901,8 +4921,9 @@ Before and after saving the buffer, this function runs
                 ;; Pass in nil&nil rather than point-min&max to indicate
                 ;; we're saving the buffer rather than just a region.
                 ;; write-region-annotate-functions may make us of it.
-               (write-region nil nil
-                             buffer-file-name nil t buffer-file-truename)
+                (write-region nil nil
+                              buffer-file-name nil t buffer-file-truename)
+                (when save-silently (message nil))
                (setq success t))
            ;; If we get an error writing the new file, and we made
            ;; the backup by renaming, undo the backing-up.
@@ -5022,13 +5043,14 @@ change the additional actions you can take on files."
       (or queried (> files-done 0) abbrevs-done
          (cond
           ((null autosaved-buffers)
-           (message "(No files need saving)"))
+            (when (called-interactively-p 'any)
+              (files--message "(No files need saving)")))
           ((= (length autosaved-buffers) 1)
-           (message "(Saved %s)" (car autosaved-buffers)))
+           (files--message "(Saved %s)" (car autosaved-buffers)))
           (t
-           (message "(Saved %d files: %s)"
-                    (length autosaved-buffers)
-                    (mapconcat 'identity autosaved-buffers ", "))))))))
+           (files--message "(Saved %d files: %s)"
+                            (length autosaved-buffers)
+                            (mapconcat 'identity autosaved-buffers ", "))))))))
 \f
 (defun clear-visited-file-modtime ()
   "Clear out records of last mod time of visited file.
@@ -5043,8 +5065,8 @@ It is not a good idea to use this function in Lisp programs, because it
 prints a message in the minibuffer.  Instead, use `set-buffer-modified-p'."
   (declare (interactive-only set-buffer-modified-p))
   (interactive "P")
-  (message (if arg "Modification-flag set"
-              "Modification-flag cleared"))
+  (files--message (if arg "Modification-flag set"
+                    "Modification-flag cleared"))
   (set-buffer-modified-p arg))
 
 (defun toggle-read-only (&optional arg interactive)
@@ -5078,7 +5100,8 @@ instead of any buffer contents; END is ignored.
 This does character code conversion and applies annotations
 like `write-region' does."
   (interactive "r\nFAppend to file: ")
-  (write-region start end filename t))
+  (prog1 (write-region start end filename t)
+    (when save-silently (message nil))))
 
 (defun file-newest-backup (filename)
   "Return most recent backup file for FILENAME or nil if no backups exist."
@@ -5664,13 +5687,14 @@ Then you'll be asked about a number of files to recover."
   (interactive)
   (if (null auto-save-list-file-prefix)
       (error "You set `auto-save-list-file-prefix' to disable making session files"))
-  (let ((dir (file-name-directory auto-save-list-file-prefix)))
+  (let ((dir (file-name-directory auto-save-list-file-prefix))
+        (nd (file-name-nondirectory auto-save-list-file-prefix)))
     (unless (file-directory-p dir)
       (make-directory dir t))
     (unless (directory-files dir nil
-                            (concat "\\`" (regexp-quote
-                                           (file-name-nondirectory
-                                            auto-save-list-file-prefix)))
+                             (if (string= "" nd)
+                                 directory-files-no-dot-files-regexp
+                               (concat "\\`" (regexp-quote nd)))
                             t)
       (error "No previous sessions to recover")))
   (let ((ls-lisp-support-shell-wildcards t))
@@ -6590,35 +6614,40 @@ 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."
   (interactive "P")
   (save-some-buffers arg t)
-  (and (or (not (memq t (mapcar (function
-                                 (lambda (buf) (and (buffer-file-name buf)
-                                                    (buffer-modified-p buf))))
-                               (buffer-list))))
-          (yes-or-no-p "Modified buffers exist; exit anyway? "))
-       (or (not (fboundp 'process-list))
-          ;; process-list is not defined on MSDOS.
-          (let ((processes (process-list))
-                active)
-            (while processes
-              (and (memq (process-status (car processes)) '(run stop open listen))
-                   (process-query-on-exit-flag (car processes))
-                   (setq active t))
-              (setq processes (cdr processes)))
-            (or (not active)
-                (with-current-buffer-window
-                 (get-buffer-create "*Process List*") nil
-                 #'(lambda (window _value)
-                     (with-selected-window window
-                       (unwind-protect
-                           (yes-or-no-p "Active processes exist; kill them and exit anyway? ")
-                         (when (window-live-p window)
-                           (quit-restore-window window 'kill)))))
-                 (list-processes t)))))
-       ;; Query the user for other things, perhaps.
-       (run-hook-with-args-until-failure 'kill-emacs-query-functions)
-       (or (null confirm-kill-emacs)
-          (funcall confirm-kill-emacs "Really exit Emacs? "))
-       (kill-emacs)))
+  (let ((confirm confirm-kill-emacs))
+    (and
+     (or (not (memq t (mapcar (function
+                               (lambda (buf) (and (buffer-file-name buf)
+                                                  (buffer-modified-p buf))))
+                              (buffer-list))))
+         (progn (setq confirm nil)
+                (yes-or-no-p "Modified buffers exist; exit anyway? ")))
+     (or (not (fboundp 'process-list))
+         ;; process-list is not defined on MSDOS.
+         (let ((processes (process-list))
+               active)
+           (while processes
+             (and (memq (process-status (car processes)) '(run stop open listen))
+                  (process-query-on-exit-flag (car processes))
+                  (setq active t))
+             (setq processes (cdr processes)))
+           (or (not active)
+               (with-current-buffer-window
+                (get-buffer-create "*Process List*") nil
+                #'(lambda (window _value)
+                    (with-selected-window window
+                      (unwind-protect
+                          (progn
+                            (setq confirm nil)
+                            (yes-or-no-p "Active processes exist; kill them and exit anyway? "))
+                        (when (window-live-p window)
+                          (quit-restore-window window 'kill)))))
+                (list-processes t)))))
+     ;; Query the user for other things, perhaps.
+     (run-hook-with-args-until-failure 'kill-emacs-query-functions)
+     (or (null confirm)
+         (funcall confirm "Really exit Emacs? "))
+     (kill-emacs))))
 
 (defun save-buffers-kill-terminal (&optional arg)
   "Offer to save each buffer, then kill the current connection.