|
12
|
1 ;;; BACKUP-DIR.EL: Emacs functions to allow backup files to live in
|
|
|
2 ;;; some other directory(s). Version 2.0
|
|
|
3 ;;;
|
|
|
4 ;;; Copyright (C) 1992-97 Greg Klanderman
|
|
|
5 ;;;
|
|
|
6 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
7 ;;; it under the terms of the GNU General Public License as published by
|
|
|
8 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
9 ;;; any later version.
|
|
|
10 ;;;
|
|
|
11 ;;; This program is distributed in the hope that it will be useful,
|
|
|
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
14 ;;; GNU General Public License for more details.
|
|
|
15 ;;;
|
|
|
16 ;;; A copy of the GNU General Public License can be obtained from
|
|
|
17 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
|
|
|
18 ;;; 02139, USA.
|
|
|
19 ;;;
|
|
|
20 ;;; Send bug reports, etc. to greg@alphatech.com or gregk@ai.mit.edu.
|
|
|
21 ;;;
|
|
|
22 ;;;
|
|
|
23 ;;; Modification History
|
|
|
24 ;;; ====================
|
|
|
25 ;;;
|
|
|
26 ;;; 12/28/1996 Version 2.0
|
|
|
27 ;;; Updated for XEmacs 19.15b4, much of code reorganized & cleaned up
|
|
|
28 ;;;
|
|
|
29 ;;; 12/27/1996 Version 1.6
|
|
|
30 ;;; explicit loading of dired replaced to use dired-load-hook
|
|
|
31 ;;; (suggested by Thomas Feuster, feuster@tp4.physik.uni-giessen.de)
|
|
|
32 ;;;
|
|
|
33 ;;; 12/2/1996 Version 1.5
|
|
|
34 ;;; Took out obsolete byte compiler options
|
|
|
35 ;;;
|
|
|
36 ;;; 9/24/1996 Version 1.4
|
|
|
37 ;;; Fix some bugs, change to alist OPTIONS list (ok-create, full-path..) from
|
|
|
38 ;;; separate fields for each option variable. Added search-upward option.
|
|
|
39 ;;; Added new function `find-file-latest-backup' to find a file's latest backup.
|
|
|
40 ;;;
|
|
|
41 ;;; 1/26/1996 Version 1.3
|
|
|
42 ;;; Name change to backup-dir.el
|
|
|
43 ;;;
|
|
|
44 ;;; 3/22/1995 Version 1.2
|
|
|
45 ;;; Added new definitions for functions `file-newest-backup', `latest-backup-file',
|
|
|
46 ;;; and `diff-latest-backup-file' so various other emacs functions will find the
|
|
|
47 ;;; right backup files.
|
|
|
48 ;;;
|
|
|
49 ;;; 4/23/1993 Version 1.1
|
|
|
50 ;;; Reworked to allow different behavior for different files based on the
|
|
|
51 ;;; alist `bkup-backup-directory-info'.
|
|
|
52 ;;;
|
|
|
53 ;;; Fall 1992 Version 1.0
|
|
|
54 ;;; Name change and added ability to make directories absolute. Added the
|
|
|
55 ;;; full path stuff to make backup name unique for absolute directories.
|
|
|
56 ;;;
|
|
|
57 ;;; Spring 1992 Version 0.0
|
|
|
58 ;;; Original
|
|
|
59 ;;;
|
|
|
60 ;;;
|
|
|
61 ;;; Description:
|
|
|
62 ;;; ============
|
|
|
63 ;;;
|
|
|
64 ;;; Allows backup files to be optionally stored in some directories, based on
|
|
|
65 ;;; the value of the alist, `bkup-backup-directory-info'. This variable is a
|
|
|
66 ;;; list of lists of the form (FILE-REGEXP BACKUP-DIR OPTIONS ...). If the
|
|
|
67 ;;; filename to be backed up matches FILE-REGEXP, or FILE-REGEXP is t, then
|
|
|
68 ;;; BACKUP-DIR is used as the path for its backups. Directories may begin with
|
|
|
69 ;;; "/" to specify an absolute pathname. If BACKUP-DIR does not exist and
|
|
|
70 ;;; OPTIONS contains the symbol `ok-create', then it is created if possible.
|
|
|
71 ;;; Otherwise the usual behavior (backup in the same directory as the file)
|
|
|
72 ;;; results. If OPTIONS contains the symbol `full-path', then the full path of
|
|
|
73 ;;; the file being backed up is prepended to the backup file name, with each "/"
|
|
|
74 ;;; replaced by a "!". This is intended for cases where an absolute backup path
|
|
|
75 ;;; is used. If OPTIONS contains the symbol `search-upward' and the backup
|
|
|
76 ;;; directory BACKUP-DIR is a relative path, then a directory with that name is
|
|
|
77 ;;; searched for starting at the current directory and proceeding upward (..,
|
|
|
78 ;;; ../.., etc) until one is found of that name or the root is reached, and if
|
|
|
79 ;;; one is found it is used as the backup directory. Finally, if no FILE-REGEXP
|
|
|
80 ;;; matches the file name being backed up, then the usual behavior results.
|
|
|
81 ;;;
|
|
|
82 ;;; These lines from my .emacs load this file and set the values I like:
|
|
|
83 ;;;
|
|
|
84 ;;; (require 'backup-dir)
|
|
|
85 ;;; (setq bkup-backup-directory-info
|
|
|
86 ;;; '(("/home/greg/.*" "/~/.backups/" ok-create full-path)
|
|
|
87 ;;; (t ".backups/" full-path search-upward)))
|
|
|
88 ;;;
|
|
|
89 ;;;
|
|
|
90 ;;; The package also provides a new function, `find-file-latest-backup' to find
|
|
|
91 ;;; the latest backup file for the current buffer's file.
|
|
|
92 ;;;
|
|
|
93 ;;;
|
|
|
94 ;;; This file is based on `files.el' from XEmacs 19.15b4.
|
|
|
95 ;;; It has not been extensively tested on GNU Emacs past 18.58.
|
|
|
96 ;;; It does not work under ms-dos.
|
|
|
97
|
|
|
98
|
|
|
99 (byte-compiler-options
|
|
|
100 (optimize t)
|
|
|
101 (warnings (- free-vars)) ; Don't warn about free variables
|
|
|
102 )
|
|
|
103
|
|
|
104
|
|
|
105 ;;; New variables affecting backup file behavior
|
|
|
106 ;;; This is the only user-customizable variable for this package.
|
|
|
107 ;;;
|
|
207
|
108 (defcustom bkup-backup-directory-info nil
|
|
|
109 "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
|
|
12
|
110 If the filename to be backed up matches FILE-REGEXP, or FILE-REGEXP is t,
|
|
207
|
111 then BACKUP-DIR is used as the path for its backups.
|
|
|
112
|
|
|
113 Directories may begin with \"/\" to specify an absolute pathname.
|
|
|
114
|
|
|
115 If BACKUP-DIR does not exist and OPTIONS contains the symbol `ok-create',
|
|
|
116 then it is created if possible. Otherwise the usual behavior (backup in the
|
|
|
117 same directory as the file) results.
|
|
|
118
|
|
|
119 If OPTIONS contains the symbol `full-path', then the full path of the file
|
|
12
|
120 being backed up is prepended to the backup file name, with each \"/\"
|
|
207
|
121 replaced by a \"!\". This is intended for cases where an absolute backup
|
|
|
122 path is used.
|
|
|
123
|
|
|
124 If OPTIONS contains the symbol `search-upward' and the backup directory
|
|
|
125 BACKUP-DIR is a relative path, then a directory with that name is searched
|
|
|
126 for starting at the current directory and proceeding upward (.., ../.., etc)
|
|
|
127 until one is found of that name, or the root is reached, and if one is found
|
|
|
128 it is used as the backup directory.
|
|
|
129
|
|
|
130 Finally, if no FILE-REGEXP matches the file name being backed up, then the
|
|
|
131 usual behavior results.
|
|
12
|
132
|
|
207
|
133 Once you save this variable with `M-x customize-variable',
|
|
|
134 `backup-dir' will be loaded for you each time you start XEmacs."
|
|
|
135 :type '(repeat
|
|
|
136 (list (regexp :tag "File regexp")
|
|
|
137 (string :tag "Backup Dir")
|
|
|
138 (set :inline t
|
|
|
139 (const ok-create)
|
|
|
140 (const full-path)
|
|
|
141 (const search-upward))))
|
|
|
142 :require 'backup-dir
|
|
|
143 :group 'backup)
|
|
12
|
144
|
|
|
145 ;;; New functions
|
|
|
146 ;;;
|
|
|
147 (defun bkup-search-upward-for-backup-dir (base bd-name)
|
|
|
148 "search upward for a directory named BD-NAME, starting in the
|
|
|
149 directory BASE and continuing with its parent directories until
|
|
|
150 one is found or the root is reached."
|
|
|
151 (let ((prev nil) (curr base) (gotit nil) (tryit nil))
|
|
|
152 (while (and (not gotit)
|
|
|
153 (not (equal prev curr))
|
|
|
154 (not (equal curr "//")))
|
|
|
155 (setq prev curr)
|
|
|
156 (setq curr (expand-file-name (concat curr "../")))
|
|
|
157 (setq tryit (expand-file-name bd-name curr))
|
|
|
158 (if (and (file-directory-p tryit) (file-exists-p tryit))
|
|
|
159 (setq gotit tryit)))
|
|
|
160 (if (and gotit
|
|
|
161 (eq (aref gotit (1- (length gotit))) ?/))
|
|
|
162 (setq gotit (substring gotit 0 (1- (length gotit)))))
|
|
|
163 gotit))
|
|
|
164
|
|
|
165 (defun bkup-replace-slashes-with-exclamations (s)
|
|
|
166 "Replaces slashes in the string S with exclamations.
|
|
|
167 A new string is produced and returned."
|
|
|
168 (let ((ns (copy-sequence s))
|
|
|
169 (i (1- (length s))))
|
|
|
170 (while (>= i 0)
|
|
|
171 (if (= (aref ns i) ?/)
|
|
|
172 (aset ns i ?!))
|
|
|
173 (setq i (1- i)))
|
|
|
174 ns))
|
|
|
175
|
|
|
176 (defun bkup-try-making-directory (dir)
|
|
|
177 "try making directory DIR, return non-nil if successful"
|
|
|
178 (condition-case ()
|
|
|
179 (progn (make-directory dir t)
|
|
|
180 t)
|
|
|
181 (t
|
|
|
182 nil)))
|
|
|
183
|
|
|
184 (defun bkup-backup-basename (file full-path)
|
|
|
185 "Gives the base part of the backup name for FILE, according to FULL-PATH."
|
|
|
186 (if full-path
|
|
|
187 (bkup-replace-slashes-with-exclamations file)
|
|
|
188 (file-name-nondirectory file)))
|
|
|
189
|
|
|
190 (defun bkup-backup-directory-and-basename (file)
|
|
|
191 "Return the cons of the backup directory name
|
|
|
192 and backup file name base for FILE."
|
|
|
193 (let ((file (expand-file-name file)))
|
|
|
194 (let ((dir (file-name-directory file))
|
|
|
195 (alist bkup-backup-directory-info)
|
|
|
196 (bk-dir nil)
|
|
|
197 (bk-base nil))
|
|
|
198 (if (listp alist)
|
|
|
199 (while (and (not bk-dir) alist)
|
|
|
200 (if (or (eq (car (car alist)) t)
|
|
|
201 (eq (string-match (car (car alist)) file) 0))
|
|
|
202 (let* ((bd (car (cdr (car alist))))
|
|
|
203 (bd-rel-p (and (> (length bd) 0)
|
|
|
204 (not (eq (aref bd 0) ?/))))
|
|
|
205 (bd-expn (expand-file-name bd dir))
|
|
|
206 (bd-noslash (if (eq (aref bd-expn (1- (length bd-expn))) ?/)
|
|
|
207 (substring bd-expn 0 (1- (length bd-expn)))
|
|
|
208 bd-expn))
|
|
|
209 (options (cdr (cdr (car alist))))
|
|
|
210 (ok-create (and (memq 'ok-create options) t))
|
|
|
211 (full-path (and (memq 'full-path options) t))
|
|
|
212 (search-upward (and (memq 'search-upward options) t)))
|
|
|
213 (if bd-expn
|
|
|
214 (cond ((or (file-directory-p bd-expn)
|
|
|
215 (and ok-create
|
|
|
216 (not (file-exists-p bd-expn))
|
|
|
217 (bkup-try-making-directory bd-noslash)))
|
|
|
218 (setq bk-dir (concat bd-noslash "/")
|
|
|
219 bk-base (bkup-backup-basename file full-path)))
|
|
|
220 ((and bd-rel-p search-upward)
|
|
|
221 (let ((bd-up (bkup-search-upward-for-backup-dir dir bd)))
|
|
|
222 (if bd-up
|
|
|
223 (setq bk-dir (concat bd-up "/")
|
|
|
224 bk-base (bkup-backup-basename file full-path)))))))))
|
|
|
225 (setq alist (cdr alist))))
|
|
|
226 (if (and bk-dir bk-base)
|
|
|
227 (cons bk-dir bk-base)
|
|
|
228 (cons dir (bkup-backup-basename file nil))))))
|
|
|
229
|
|
|
230
|
|
|
231 ;;; This next one is based on the following from `files.el'
|
|
|
232 ;;; but accepts a second optional argument
|
|
|
233
|
|
|
234 ;;(defun make-backup-file-name (file)
|
|
|
235 ;; "Create the non-numeric backup file name for FILE.
|
|
|
236 ;;This is a separate function so you can redefine it for customization."
|
|
|
237 ;; (if (and (eq system-type 'ms-dos)
|
|
|
238 ;; (not (msdos-long-file-names)))
|
|
|
239 ;; (let ((fn (file-name-nondirectory file)))
|
|
|
240 ;; (concat (file-name-directory file)
|
|
|
241 ;; (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
|
|
|
242 ;; (substring fn 0 (match-end 1)))
|
|
|
243 ;; ".bak"))
|
|
|
244 ;; (concat file "~")))
|
|
|
245
|
|
|
246 (defun bkup-make-backup-file-name (file &optional dir-n-base)
|
|
|
247 "Create the non-numeric backup file name for FILE.
|
|
|
248 Optionally accept a list containing the backup directory and
|
|
|
249 backup basename. NB: we don't really handle ms-dos."
|
|
|
250 (if (and (eq system-type 'ms-dos)
|
|
|
251 (not (and (fboundp 'msdos-long-file-names) (msdos-long-file-names))))
|
|
|
252 (let ((fn (file-name-nondirectory file)))
|
|
|
253 (concat (file-name-directory file)
|
|
|
254 (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
|
|
|
255 (substring fn 0 (match-end 1)))
|
|
|
256 ".bak"))
|
|
|
257 (let ((d-n-b (or dir-n-base
|
|
|
258 (bkup-backup-directory-and-basename file))))
|
|
|
259 (concat (car d-n-b) (cdr d-n-b) "~"))))
|
|
|
260
|
|
|
261 (defun bkup-existing-backup-files (fn)
|
|
|
262 "Return list of existing backup files for file"
|
|
|
263 (let* ((efn (expand-file-name fn))
|
|
|
264 (dir-n-base (bkup-backup-directory-and-basename efn))
|
|
|
265 (non-num-bk-name (bkup-make-backup-file-name efn dir-n-base))
|
|
|
266 (non-num-bk (file-exists-p non-num-bk-name))
|
|
|
267 (backup-dir (car dir-n-base))
|
|
|
268 (base-versions (concat (cdr dir-n-base) ".~"))
|
|
|
269 (possibilities (file-name-all-completions base-versions backup-dir))
|
|
|
270 (poss (mapcar #'(lambda (name) (concat backup-dir name)) possibilities)))
|
|
|
271 (mapcar #'expand-file-name
|
|
|
272 (if non-num-bk (cons non-num-bk-name poss) poss))))
|
|
|
273
|
|
|
274 (defun find-file-latest-backup (file)
|
|
|
275 "Find the latest backup file for FILE"
|
|
|
276 (interactive (list (read-file-name (format "Find latest backup of file (default %s): "
|
|
|
277 (file-name-nondirectory (buffer-file-name)))
|
|
|
278 nil (buffer-file-name) t)))
|
|
|
279 (let ((backup (file-newest-backup file)))
|
|
|
280 (if backup
|
|
|
281 (find-file backup)
|
|
|
282 (message "no backups found for `%s'" file))))
|
|
|
283
|
|
|
284
|
|
|
285 ;;; Functions changed from `files.el' and elsewhere -- originals precede new versions
|
|
|
286
|
|
|
287 ;;(defun make-backup-file-name (file)
|
|
|
288 ;; "Create the non-numeric backup file name for FILE.
|
|
|
289 ;;This is a separate function so you can redefine it for customization."
|
|
|
290 ;; (if (and (eq system-type 'ms-dos)
|
|
|
291 ;; (not (msdos-long-file-names)))
|
|
|
292 ;; (let ((fn (file-name-nondirectory file)))
|
|
|
293 ;; (concat (file-name-directory file)
|
|
|
294 ;; (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
|
|
|
295 ;; (substring fn 0 (match-end 1)))
|
|
|
296 ;; ".bak"))
|
|
|
297 ;; (concat file "~")))
|
|
|
298
|
|
|
299 (defun make-backup-file-name (file)
|
|
|
300 "Create the non-numeric backup file name for FILE.
|
|
|
301 This is a separate function so you can redefine it for customization.
|
|
|
302 *** Changed by \"backup-dir.el\""
|
|
|
303 (bkup-make-backup-file-name file))
|
|
|
304
|
|
|
305
|
|
|
306 ;;(defun find-backup-file-name (fn)
|
|
|
307 ;; "Find a file name for a backup file, and suggestions for deletions.
|
|
|
308 ;;Value is a list whose car is the name for the backup file
|
|
|
309 ;; and whose cdr is a list of old versions to consider deleting now.
|
|
|
310 ;;If the value is nil, don't make a backup."
|
|
|
311 ;; (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
|
|
|
312 ;; ;; Run a handler for this function so that ange-ftp can refuse to do it.
|
|
|
313 ;; (if handler
|
|
|
314 ;; (funcall handler 'find-backup-file-name fn)
|
|
|
315 ;; (if (eq version-control 'never)
|
|
|
316 ;; (list (make-backup-file-name fn))
|
|
|
317 ;; (let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
|
|
|
318 ;; ;; used by backup-extract-version:
|
|
|
319 ;; (bv-length (length base-versions))
|
|
|
320 ;; possibilities
|
|
|
321 ;; (versions nil)
|
|
|
322 ;; (high-water-mark 0)
|
|
|
323 ;; (deserve-versions-p nil)
|
|
|
324 ;; (number-to-delete 0))
|
|
|
325 ;; (condition-case ()
|
|
|
326 ;; (setq possibilities (file-name-all-completions
|
|
|
327 ;; base-versions
|
|
|
328 ;; (file-name-directory fn))
|
|
|
329 ;; versions (sort (mapcar
|
|
|
330 ;; #'backup-extract-version
|
|
|
331 ;; possibilities)
|
|
|
332 ;; '<)
|
|
|
333 ;; high-water-mark (apply #'max 0 versions)
|
|
|
334 ;; deserve-versions-p (or version-control
|
|
|
335 ;; (> high-water-mark 0))
|
|
|
336 ;; number-to-delete (- (length versions)
|
|
|
337 ;; kept-old-versions kept-new-versions -1))
|
|
|
338 ;; (file-error
|
|
|
339 ;; (setq possibilities nil)))
|
|
|
340 ;; (if (not deserve-versions-p)
|
|
|
341 ;; (list (make-backup-file-name fn))
|
|
|
342 ;; (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
|
|
|
343 ;; (if (and (> number-to-delete 0)
|
|
|
344 ;; ;; Delete nothing if there is overflow
|
|
|
345 ;; ;; in the number of versions to keep.
|
|
|
346 ;; (>= (+ kept-new-versions kept-old-versions -1) 0))
|
|
|
347 ;; (mapcar #'(lambda (n)
|
|
|
348 ;; (concat fn ".~" (int-to-string n) "~"))
|
|
|
349 ;; (let ((v (nthcdr kept-old-versions versions)))
|
|
|
350 ;; (rplacd (nthcdr (1- number-to-delete) v) ())
|
|
|
351 ;; v))))))))))
|
|
|
352
|
|
|
353 (defun find-backup-file-name (fn)
|
|
|
354 "Find a file name for a backup file, and suggestions for deletions.
|
|
|
355 Value is a list whose car is the name for the backup file
|
|
|
356 and whose cdr is a list of old versions to consider deleting now.
|
|
|
357 If the value is nil, don't make a backup.
|
|
|
358 *** Changed by \"backup-dir.el\""
|
|
|
359 (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
|
|
|
360 ;; Run a handler for this function so that ange-ftp can refuse to do it.
|
|
|
361 (if handler
|
|
|
362 (funcall handler 'find-backup-file-name fn)
|
|
|
363 (if (eq version-control 'never)
|
|
|
364 (list (make-backup-file-name fn))
|
|
|
365 (let* ((dir-n-base (bkup-backup-directory-and-basename fn)) ;add
|
|
|
366 (non-num-bk-name (bkup-make-backup-file-name fn dir-n-base)) ;add
|
|
|
367 (bk-dir (car dir-n-base)) ;add
|
|
|
368 (bk-base (cdr dir-n-base)) ;add
|
|
|
369 (base-versions (concat bk-base ".~")) ;mod
|
|
|
370 ;; used by backup-extract-version:
|
|
|
371 (bv-length (length base-versions))
|
|
|
372 possibilities
|
|
|
373 (versions nil)
|
|
|
374 (high-water-mark 0)
|
|
|
375 (deserve-versions-p nil)
|
|
|
376 (number-to-delete 0))
|
|
|
377 (condition-case ()
|
|
|
378 (setq possibilities (file-name-all-completions
|
|
|
379 base-versions
|
|
|
380 bk-dir) ;mod
|
|
|
381 versions (sort (mapcar
|
|
|
382 #'backup-extract-version
|
|
|
383 possibilities)
|
|
|
384 '<)
|
|
|
385 high-water-mark (apply #'max 0 versions)
|
|
|
386 deserve-versions-p (or version-control
|
|
|
387 (> high-water-mark 0))
|
|
|
388 number-to-delete (- (length versions)
|
|
|
389 kept-old-versions kept-new-versions -1))
|
|
|
390 (file-error
|
|
|
391 (setq possibilities nil)))
|
|
|
392 (if (not deserve-versions-p)
|
|
|
393 (list (bkup-make-backup-file-name fn dir-n-base)) ;mod
|
|
|
394 (cons (concat bk-dir base-versions (int-to-string (1+ high-water-mark)) "~") ;mod
|
|
|
395 (if (and (> number-to-delete 0)
|
|
|
396 ;; Delete nothing if there is overflow
|
|
|
397 ;; in the number of versions to keep.
|
|
|
398 (>= (+ kept-new-versions kept-old-versions -1) 0))
|
|
|
399 (mapcar #'(lambda (n)
|
|
|
400 (concat bk-dir base-versions (int-to-string n) "~")) ;mod
|
|
|
401 (let ((v (nthcdr kept-old-versions versions)))
|
|
|
402 (rplacd (nthcdr (1- number-to-delete) v) ())
|
|
|
403 v))))))))))
|
|
|
404
|
|
|
405
|
|
|
406 ;;(defun file-newest-backup (filename)
|
|
|
407 ;; "Return most recent backup file for FILENAME or nil if no backups exist."
|
|
|
408 ;; (let* ((filename (expand-file-name filename))
|
|
|
409 ;; (file (file-name-nondirectory filename))
|
|
|
410 ;; (dir (file-name-directory filename))
|
|
|
411 ;; (comp (file-name-all-completions file dir))
|
|
|
412 ;; newest tem)
|
|
|
413 ;; (while comp
|
|
|
414 ;; (setq tem (car comp)
|
|
|
415 ;; comp (cdr comp))
|
|
|
416 ;; (cond ((and (backup-file-name-p tem)
|
|
|
417 ;; (string= (file-name-sans-versions tem) file))
|
|
|
418 ;; (setq tem (concat dir tem))
|
|
|
419 ;; (if (or (null newest)
|
|
|
420 ;; (file-newer-than-file-p tem newest))
|
|
|
421 ;; (setq newest tem)))))
|
|
|
422 ;; newest))
|
|
|
423
|
|
|
424 (defun file-newest-backup (filename)
|
|
|
425 "Return most recent backup file for FILENAME or nil if no backups exist.
|
|
|
426 *** Changed by \"backup-dir.el\""
|
|
|
427 (let ((comp (bkup-existing-backup-files filename))
|
|
|
428 (newest nil)
|
|
|
429 (file nil))
|
|
|
430 (while comp
|
|
|
431 (setq file (car comp)
|
|
|
432 comp (cdr comp))
|
|
|
433 (if (and (backup-file-name-p file)
|
|
|
434 (or (null newest) (file-newer-than-file-p file newest)))
|
|
|
435 (setq newest file)))
|
|
|
436 newest))
|
|
|
437
|
|
|
438
|
|
|
439 ;;; patch `latest-backup-file' from "dired"
|
|
|
440 ;;;
|
|
|
441 ;;; we use `dired-load-hook' to avoid loading dired now. This speeds things up
|
|
|
442 ;;; considerably according to Thomas Feuster, feuster@tp4.physik.uni-giessen.de
|
|
|
443 ;;;
|
|
|
444 ;;; one really wonders why there are 3 functions to do the same thing...
|
|
|
445 ;;;
|
|
|
446 (defun bkup-patch-latest-backup-file ()
|
|
|
447 (fset 'latest-backup-file (symbol-function 'file-newest-backup))
|
|
|
448 (remove-hook 'dired-load-hook 'bkup-patch-latest-backup-file))
|
|
|
449
|
|
|
450 (if (featurep 'dired)
|
|
|
451 ;; if loaded, patch it now
|
|
|
452 (fset 'latest-backup-file (symbol-function 'file-newest-backup))
|
|
|
453 ;; otherwise do it later
|
|
|
454 (add-hook 'dired-load-hook 'bkup-patch-latest-backup-file))
|
|
|
455
|
|
|
456
|
|
|
457 ;;; patch `diff-latest-backup-file' from "diff"
|
|
|
458 ;;;
|
|
|
459 (require 'diff)
|
|
|
460 (fset 'diff-latest-backup-file (symbol-function 'file-newest-backup))
|
|
|
461
|
|
|
462
|
|
|
463 ;;; finally, add to list of features
|
|
|
464 ;;;
|
|
|
465 (provide 'backup-dir)
|
|
|
466
|
|
|
467 ;;; backup-dir.el ends here
|
