aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul Eggert2015-05-29 23:17:28 -0700
committerPaul Eggert2015-05-29 23:18:40 -0700
commitb65be6c5defd517cdfcb9aeee91904def06f5782 (patch)
tree67e7228fa7160cbd269a1f74e0a4746920efb95b
parentab27722721afca4647a7eec0933ac9209e0eac30 (diff)
downloademacs-b65be6c5defd517cdfcb9aeee91904def06f5782.tar.gz
emacs-b65be6c5defd517cdfcb9aeee91904def06f5782.zip
backup-buffer minor reworking of internals
* lisp/files.el (backup-buffer): Rework to avoid a couple of unused locals inadvertently introduced in the previous change.
-rw-r--r--lisp/files.el137
1 files changed, 69 insertions, 68 deletions
diff --git a/lisp/files.el b/lisp/files.el
index 1340a500554..6939f2b8fc1 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4077,74 +4077,75 @@ on the original file; this means that the caller, after saving
4077the buffer, should change the extended attributes of the new file 4077the buffer, should change the extended attributes of the new file
4078to agree with the old attributes. 4078to agree with the old attributes.
4079BACKUPNAME is the backup file name, which is the old file renamed." 4079BACKUPNAME is the backup file name, which is the old file renamed."
4080 (let (attributes real-file-name backup-info) 4080 (when (and make-backup-files (not backup-inhibited) (not buffer-backed-up))
4081 (when (and make-backup-files (not backup-inhibited) (not buffer-backed-up) 4081 (let ((attributes (file-attributes buffer-file-name)))
4082 (setq attributes (file-attributes buffer-file-name)) 4082 (when (and attributes (memq (aref (elt attributes 8) 0) '(?- ?l)))
4083 (memq (aref (elt attributes 8) 0) '(?- ?l))) 4083 ;; If specified name is a symbolic link, chase it to the target.
4084 ;; If specified name is a symbolic link, chase it to the target. 4084 ;; This makes backups in the directory where the real file is.
4085 ;; This makes backups in the directory where the real file is. 4085 (let* ((real-file-name (file-chase-links buffer-file-name))
4086 (let* ((real-file-name (file-chase-links buffer-file-name)) 4086 (backup-info (find-backup-file-name real-file-name)))
4087 (backup-info (find-backup-file-name real-file-name))) 4087 (when backup-info
4088 (when backup-info 4088 (let* ((backupname (car backup-info))
4089 (let* ((backupname (car backup-info)) 4089 (targets (cdr backup-info))
4090 (targets (cdr backup-info)) 4090 (old-versions
4091 (old-versions 4091 ;; If have old versions to maybe delete,
4092 ;; If have old versions to maybe delete, 4092 ;; ask the user to confirm now, before doing anything.
4093 ;; ask the user to confirm now, before doing anything. 4093 ;; But don't actually delete til later.
4094 ;; But don't actually delete til later. 4094 (and targets
4095 (and targets 4095 (booleanp delete-old-versions)
4096 (booleanp delete-old-versions) 4096 (or delete-old-versions
4097 (or delete-old-versions 4097 (y-or-n-p
4098 (y-or-n-p 4098 (format "Delete excess backup versions of %s? "
4099 (format "Delete excess backup versions of %s? " 4099 real-file-name)))
4100 real-file-name))) 4100 targets))
4101 targets)) 4101 (modes (file-modes buffer-file-name))
4102 (modes (file-modes buffer-file-name)) 4102 (extended-attributes
4103 (extended-attributes 4103 (file-extended-attributes buffer-file-name))
4104 (file-extended-attributes buffer-file-name)) 4104 (copy-when-priv-mismatch
4105 (copy-when-priv-mismatch 4105 backup-by-copying-when-privileged-mismatch)
4106 backup-by-copying-when-privileged-mismatch) 4106 (make-copy
4107 (make-copy 4107 (or file-precious-flag backup-by-copying
4108 (or file-precious-flag backup-by-copying 4108 ;; Don't rename a suid or sgid file.
4109 ;; Don't rename a suid or sgid file. 4109 (and modes (< 0 (logand modes #o6000)))
4110 (and modes (< 0 (logand modes #o6000))) 4110 (not (file-writable-p
4111 (not (file-writable-p 4111 (file-name-directory real-file-name)))
4112 (file-name-directory real-file-name))) 4112 (and backup-by-copying-when-linked
4113 (and backup-by-copying-when-linked 4113 (< 1 (file-nlinks real-file-name)))
4114 (< 1 (file-nlinks real-file-name))) 4114 (and (or backup-by-copying-when-mismatch
4115 (and (or backup-by-copying-when-mismatch 4115 (and (integerp copy-when-priv-mismatch)
4116 (and (integerp copy-when-priv-mismatch) 4116 (let ((attr (file-attributes
4117 (let ((attr (file-attributes real-file-name 4117 real-file-name
4118 'integer))) 4118 'integer)))
4119 (<= (nth 2 attr) 4119 (<= (nth 2 attr)
4120 copy-when-priv-mismatch)))) 4120 copy-when-priv-mismatch))))
4121 (not (file-ownership-preserved-p real-file-name 4121 (not (file-ownership-preserved-p real-file-name
4122 t))))) 4122 t)))))
4123 setmodes) 4123 setmodes)
4124 (condition-case () 4124 (condition-case ()
4125 (progn 4125 (progn
4126 ;; Actually make the backup file. 4126 ;; Actually make the backup file.
4127 (if make-copy 4127 (if make-copy
4128 (backup-buffer-copy real-file-name backupname 4128 (backup-buffer-copy real-file-name backupname
4129 modes extended-attributes) 4129 modes extended-attributes)
4130 ;; rename-file should delete old backup. 4130 ;; rename-file should delete old backup.
4131 (rename-file real-file-name backupname t) 4131 (rename-file real-file-name backupname t)
4132 (setq setmodes (list modes extended-attributes 4132 (setq setmodes (list modes extended-attributes
4133 backupname))) 4133 backupname)))
4134 (setq buffer-backed-up t) 4134 (setq buffer-backed-up t)
4135 ;; Now delete the old versions, if desired. 4135 ;; Now delete the old versions, if desired.
4136 (dolist (old-version old-versions) 4136 (dolist (old-version old-versions)
4137 (delete-file old-version))) 4137 (delete-file old-version)))
4138 (file-error nil)) 4138 (file-error nil))
4139 ;; If trouble writing the backup, write it in .emacs.d/%backup%. 4139 ;; If trouble writing the backup, write it in .emacs.d/%backup%.
4140 (when (not buffer-backed-up) 4140 (when (not buffer-backed-up)
4141 (setq backupname (locate-user-emacs-file "%backup%~")) 4141 (setq backupname (locate-user-emacs-file "%backup%~"))
4142 (message "Cannot write backup file; backing up in %s" backupname) 4142 (message "Cannot write backup file; backing up in %s"
4143 (sleep-for 1) 4143 backupname)
4144 (backup-buffer-copy real-file-name backupname 4144 (sleep-for 1)
4145 modes extended-attributes) 4145 (backup-buffer-copy real-file-name backupname
4146 (setq buffer-backed-up t)) 4146 modes extended-attributes)
4147 setmodes)))))) 4147 (setq buffer-backed-up t))
4148 setmodes)))))))
4148 4149
4149(defun backup-buffer-copy (from-name to-name modes extended-attributes) 4150(defun backup-buffer-copy (from-name to-name modes extended-attributes)
4150 ;; Create temp files with strict access rights. It's easy to 4151 ;; Create temp files with strict access rights. It's easy to