Mercurial > emacs
comparison lisp/files.el @ 74979:2711fe24b0e3
(backup-buffer): Show entire backup file name in message.
(make-backup-file-name-1): Precompute abs name
but don't lose the relative name.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Sat, 30 Dec 2006 06:28:57 +0000 |
| parents | 7f729944fa45 |
| children | bb4f2b144d6f |
comparison
equal
deleted
inserted
replaced
| 74978:750801c2d9b6 | 74979:2711fe24b0e3 |
|---|---|
| 3029 ;; If trouble writing the backup, write it in ~. | 3029 ;; If trouble writing the backup, write it in ~. |
| 3030 (setq backupname (expand-file-name | 3030 (setq backupname (expand-file-name |
| 3031 (convert-standard-filename | 3031 (convert-standard-filename |
| 3032 "~/%backup%~"))) | 3032 "~/%backup%~"))) |
| 3033 (message "Cannot write backup file; backing up in %s" | 3033 (message "Cannot write backup file; backing up in %s" |
| 3034 (file-name-nondirectory backupname)) | 3034 backupname) |
| 3035 (sleep-for 1) | 3035 (sleep-for 1) |
| 3036 (backup-buffer-copy real-file-name backupname modes))) | 3036 (backup-buffer-copy real-file-name backupname modes))) |
| 3037 (setq buffer-backed-up t) | 3037 (setq buffer-backed-up t) |
| 3038 ;; Now delete the old versions, if desired. | 3038 ;; Now delete the old versions, if desired. |
| 3039 (if delete-old-versions | 3039 (if delete-old-versions |
| 3225 (concat (make-backup-file-name-1 file) "~")))) | 3225 (concat (make-backup-file-name-1 file) "~")))) |
| 3226 | 3226 |
| 3227 (defun make-backup-file-name-1 (file) | 3227 (defun make-backup-file-name-1 (file) |
| 3228 "Subroutine of `make-backup-file-name' and `find-backup-file-name'." | 3228 "Subroutine of `make-backup-file-name' and `find-backup-file-name'." |
| 3229 (let ((alist backup-directory-alist) | 3229 (let ((alist backup-directory-alist) |
| 3230 elt backup-directory) | 3230 elt backup-directory abs-backup-directory) |
| 3231 (while alist | 3231 (while alist |
| 3232 (setq elt (pop alist)) | 3232 (setq elt (pop alist)) |
| 3233 (if (string-match (car elt) file) | 3233 (if (string-match (car elt) file) |
| 3234 (setq backup-directory (cdr elt) | 3234 (setq backup-directory (cdr elt) |
| 3235 alist nil))) | 3235 alist nil))) |
| 3236 ;; If backup-directory is relative, it should be relative to the | 3236 ;; If backup-directory is relative, it should be relative to the |
| 3237 ;; file's directory. By expanding explicitly here, we avoid | 3237 ;; file's directory. By expanding explicitly here, we avoid |
| 3238 ;; depending on default-directory. | 3238 ;; depending on default-directory. |
| 3239 (if backup-directory | 3239 (if backup-directory |
| 3240 (setq backup-directory (expand-file-name backup-directory | 3240 (setq abs-backup-directory |
| 3241 (file-name-directory file)))) | 3241 (expand-file-name backup-directory |
| 3242 (if (and backup-directory (not (file-exists-p backup-directory))) | 3242 (file-name-directory file)))) |
| 3243 (if (and abs-backup-directory (not (file-exists-p abs-backup-directory))) | |
| 3243 (condition-case nil | 3244 (condition-case nil |
| 3244 (make-directory backup-directory 'parents) | 3245 (make-directory abs-backup-directory 'parents) |
| 3245 (file-error (setq backup-directory nil)))) | 3246 (file-error (setq backup-directory nil |
| 3247 abs-backup-directory nil)))) | |
| 3246 (if (null backup-directory) | 3248 (if (null backup-directory) |
| 3247 file | 3249 file |
| 3248 (if (file-name-absolute-p backup-directory) | 3250 (if (file-name-absolute-p backup-directory) |
| 3249 (progn | 3251 (progn |
| 3250 (when (memq system-type '(windows-nt ms-dos cygwin)) | 3252 (when (memq system-type '(windows-nt ms-dos cygwin)) |
| 3271 (subst-char-in-string | 3273 (subst-char-in-string |
| 3272 ?/ ?! | 3274 ?/ ?! |
| 3273 (replace-regexp-in-string "!" "!!" file)) | 3275 (replace-regexp-in-string "!" "!!" file)) |
| 3274 backup-directory)) | 3276 backup-directory)) |
| 3275 (expand-file-name (file-name-nondirectory file) | 3277 (expand-file-name (file-name-nondirectory file) |
| 3276 (file-name-as-directory | 3278 (file-name-as-directory abs-backup-directory)))))) |
| 3277 (expand-file-name backup-directory | |
| 3278 (file-name-directory file)))))))) | |
| 3279 | 3279 |
| 3280 (defun backup-file-name-p (file) | 3280 (defun backup-file-name-p (file) |
| 3281 "Return non-nil if FILE is a backup file name (numeric or not). | 3281 "Return non-nil if FILE is a backup file name (numeric or not). |
| 3282 This is a separate function so you can redefine it for customization. | 3282 This is a separate function so you can redefine it for customization. |
| 3283 You may need to redefine `file-name-sans-versions' as well." | 3283 You may need to redefine `file-name-sans-versions' as well." |