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