diff options
| author | Paul Eggert | 2015-05-29 23:17:28 -0700 |
|---|---|---|
| committer | Paul Eggert | 2015-05-29 23:18:40 -0700 |
| commit | b65be6c5defd517cdfcb9aeee91904def06f5782 (patch) | |
| tree | 67e7228fa7160cbd269a1f74e0a4746920efb95b | |
| parent | ab27722721afca4647a7eec0933ac9209e0eac30 (diff) | |
| download | emacs-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.el | 137 |
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 | |||
| 4077 | the buffer, should change the extended attributes of the new file | 4077 | the buffer, should change the extended attributes of the new file |
| 4078 | to agree with the old attributes. | 4078 | to agree with the old attributes. |
| 4079 | BACKUPNAME is the backup file name, which is the old file renamed." | 4079 | BACKUPNAME 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 |