(find-backup-file-name): Run a file name handler.

(backup-buffer): Do nothing if backup-info is nil.

1 files changed, 99 insertions, 93 deletions

diff --git a/lisp/files.el b/lisp/files.el
index 21c2bf6c2fe..e36072dca51 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1364,63 +1364,64 @@ the modes of the new file to agree with the old modes."
               targets (cdr backup-info))
 ;;;     (if (file-directory-p buffer-file-name)
 ;;;         (error "Cannot save buffer in directory %s" buffer-file-name))
-        (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))))))
-              ;; Actually write the back up file.
-              (condition-case ()
-                  (if (or file-precious-flag
-;                         (file-symlink-p buffer-file-name)
-                          backup-by-copying
-                          (and backup-by-copying-when-linked
-                               (> (file-nlinks real-file-name) 1))
-                          (and backup-by-copying-when-mismatch
-                               (let ((attr (file-attributes real-file-name)))
-                                 (or (nth 9 attr)
-                                     (not (file-ownership-preserved-p real-file-name))))))
-                      (condition-case ()
-                          (copy-file real-file-name backupname t t)
-                        (file-error
-                         ;; If copying fails because file BACKUPNAME
-                         ;; is not writable, delete that file and try again.
-                         (if (and (file-exists-p backupname)
-                                  (not (file-writable-p backupname)))
-                             (delete-file backupname))
-                         (copy-file real-file-name backupname t t)))
-                    ;; rename-file should delete old backup.
-                    (rename-file real-file-name backupname t)
-                    (setq setmodes (file-modes backupname)))
-                (file-error
-                 ;; If trouble writing the backup, write it in ~.
-                 (setq backupname (expand-file-name "~/%backup%~"))
-                 (message "Cannot write backup file; backing up in ~/%%backup%%~")
-                 (sleep-for 1)
-                 (condition-case ()
-                     (copy-file real-file-name backupname t t)
-                   (file-error
-                    ;; If copying fails because file BACKUPNAME
-                    ;; is not writable, delete that file and try again.
-                    (if (and (file-exists-p backupname)
-                             (not (file-writable-p backupname)))
-                        (delete-file backupname))
-                    (copy-file real-file-name backupname t t)))))
-              (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)))))
+        (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))))))
+                  ;; Actually write the back up file.
+                  (condition-case ()
+                      (if (or file-precious-flag
+    ;                     (file-symlink-p buffer-file-name)
+                              backup-by-copying
+                              (and backup-by-copying-when-linked
+                                   (> (file-nlinks real-file-name) 1))
+                              (and backup-by-copying-when-mismatch
+                                   (let ((attr (file-attributes real-file-name)))
+                                     (or (nth 9 attr)
+                                         (not (file-ownership-preserved-p real-file-name))))))
+                          (condition-case ()
+                              (copy-file real-file-name backupname t t)
+                            (file-error
+                             ;; If copying fails because file BACKUPNAME
+                             ;; is not writable, delete that file and try again.
+                             (if (and (file-exists-p backupname)
+                                      (not (file-writable-p backupname)))
+                                 (delete-file backupname))
+                             (copy-file real-file-name backupname t t)))
+                        ;; rename-file should delete old backup.
+                        (rename-file real-file-name backupname t)
+                        (setq setmodes (file-modes backupname)))
+                    (file-error
+                     ;; If trouble writing the backup, write it in ~.
+                     (setq backupname (expand-file-name "~/%backup%~"))
+                     (message "Cannot write backup file; backing up in ~/%%backup%%~")
+                     (sleep-for 1)
+                     (condition-case ()
+                         (copy-file real-file-name backupname t t)
+                       (file-error
+                        ;; If copying fails because file BACKUPNAME
+                        ;; is not writable, delete that file and try again.
+                        (if (and (file-exists-p backupname)
+                                 (not (file-writable-p backupname)))
+                            (delete-file backupname))
+                        (copy-file real-file-name backupname t t)))))
+                  (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))))))
 
 (defun file-name-sans-versions (name &optional keep-backup-version)
   "Return FILENAME sans backup versions or strings.
@@ -1506,43 +1507,48 @@ the index in the name where the version number begins."
 (defun find-backup-file-name (fn)
   "Find a file name for a backup file, and suggestions for deletions.
 Value is a list whose car is the name for the backup file
- and whose cdr is a list of old versions to consider deleting now."
-  (if (eq version-control 'never)
-      (list (make-backup-file-name fn))
-    (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
-           (bv-length (length base-versions))
-           possibilities
-           (versions nil)
-           (high-water-mark 0)
-           (deserve-versions-p nil)
-           (number-to-delete 0))
-      (condition-case ()
-          (setq possibilities (file-name-all-completions
-                               base-versions
-                               (file-name-directory fn))
-                versions (sort (mapcar
-                                (function backup-extract-version)
-                                possibilities)
-                               '<)
-                high-water-mark (apply 'max 0 versions)
-                deserve-versions-p (or version-control
-                                       (> high-water-mark 0))
-                number-to-delete (- (length versions)
-                                    kept-old-versions kept-new-versions -1))
-        (file-error
-         (setq possibilities nil)))
-      (if (not deserve-versions-p)
+ and whose cdr is a list of old versions to consider deleting now.
+If the value is nil, don't make a backup."
+  (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
+    ;; Run a handler for this function so that ange-ftp can refuse to do it.
+    (if handler
+        (funcall handler 'find-backup-file-name fn)
+      (if (eq version-control 'never)
           (list (make-backup-file-name fn))
-        (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
-              (if (and (> number-to-delete 0)
-                       ;; Delete nothing if there is overflow
-                       ;; in the number of versions to keep.
-                       (>= (+ kept-new-versions kept-old-versions -1) 0))
-                  (mapcar (function (lambda (n)
-                                      (concat fn ".~" (int-to-string n) "~")))
-                          (let ((v (nthcdr kept-old-versions versions)))
-                            (rplacd (nthcdr (1- number-to-delete) v) ())
-                            v))))))))
+        (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
+               (bv-length (length base-versions))
+               possibilities
+               (versions nil)
+               (high-water-mark 0)
+               (deserve-versions-p nil)
+               (number-to-delete 0))
+          (condition-case ()
+              (setq possibilities (file-name-all-completions
+                                   base-versions
+                                   (file-name-directory fn))
+                    versions (sort (mapcar
+                                    (function backup-extract-version)
+                                    possibilities)
+                                   '<)
+                    high-water-mark (apply 'max 0 versions)
+                    deserve-versions-p (or version-control
+                                           (> high-water-mark 0))
+                    number-to-delete (- (length versions)
+                                        kept-old-versions kept-new-versions -1))
+            (file-error
+             (setq possibilities nil)))
+          (if (not deserve-versions-p)
+              (list (make-backup-file-name fn))
+            (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
+                  (if (and (> number-to-delete 0)
+                           ;; Delete nothing if there is overflow
+                           ;; in the number of versions to keep.
+                           (>= (+ kept-new-versions kept-old-versions -1) 0))
+                      (mapcar (function (lambda (n)
+                                          (concat fn ".~" (int-to-string n) "~")))
+                              (let ((v (nthcdr kept-old-versions versions)))
+                                (rplacd (nthcdr (1- number-to-delete) v) ())
+                                v))))))))))
 
 (defun file-nlinks (filename)
   "Return number of names file FILENAME has."