API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 16th, 2015
342
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 23.86 KB | None | 0 0
raw download clone embed print report
  1. ;;; backup-dir.el --- allow backup files to live in some other directory(s).
  2.  
  3. ;;; Author: Greg Klanderman <greg.klanderman@alum.mit.edu>
  4. ;;; Version: 2.9
  5. ;;; Date: January 8, 1999
  6. ;;; Created: Spring 1992
  7. ;;; Keywords: backup file
  8.  
  9. ;;; Copyright (C) 1992-98 Greg Klanderman
  10. ;;;
  11. ;;; This program is free software; you can redistribute it and/or modify
  12. ;;; it under the terms of the GNU General Public License as published by
  13. ;;; the Free Software Foundation; either version 2, or (at your option)
  14. ;;; any later version.
  15. ;;;
  16. ;;; This program is distributed in the hope that it will be useful,
  17. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;;; GNU General Public License for more details.
  20. ;;;
  21. ;;; A copy of the GNU General Public License can be obtained from the
  22. ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;;; Boston, MA 02111-1307, USA.
  24. ;;;
  25. ;;; Send bug reports, feedback, etc. to greg.klanderman@alum.mit.edu,
  26. ;;; greg@alphatech.com, or gregk@ai.mit.edu.
  27.  
  28. ;;; Commentary:
  29. ;;;
  30. ;;; Allows backup files to be optionally stored in some directories, based on
  31. ;;; the value of the alist, `bkup-backup-directory-info'. This variable is a
  32. ;;; list of lists of the form (FILE-REGEXP BACKUP-DIR OPTIONS ...). If the
  33. ;;; filename to be backed up matches FILE-REGEXP, or FILE-REGEXP is t, then
  34. ;;; BACKUP-DIR is used as the path for its backups. Directories may begin
  35. ;;; with "/" to specify an absolute pathname.
  36. ;;;
  37. ;;; If BACKUP-DIR does not exist and OPTIONS contains the symbol `ok-create',
  38. ;;; then it is created if possible. Otherwise the usual behavior (backup in
  39. ;;; the same directory as the file) results.
  40. ;;;
  41. ;;; If OPTIONS contains the symbol `full-path', then the full path of the file
  42. ;;; being backed up is prepended to the backup file name, with each "/"
  43. ;;; replaced by a "!". This is intended for cases where an absolute backup
  44. ;;; path is used. If OPTIONS contains `prepend-name' in addition to
  45. ;;; `full-path', then the file name is prepended rather than appended to the
  46. ;;; path component when forming the backup name.
  47. ;;;
  48. ;;; If OPTIONS contains the symbol `search-upward' and the backup directory
  49. ;;; BACKUP-DIR is a relative path, then a directory with that name is searched
  50. ;;; for starting at the current directory and proceeding upward (.., ../..,
  51. ;;; etc) until one is found of that name or the root is reached, and if one is
  52. ;;; found it is used as the backup directory.
  53. ;;;
  54. ;;; Finally, if no FILE-REGEXP matches the file name being backed up, then the
  55. ;;; usual behavior results.
  56. ;;;
  57. ;;; These lines from my .emacs load this file and set the values I like:
  58. ;;;
  59. ;;; (require 'backup-dir)
  60. ;;; (setq bkup-backup-directory-info
  61. ;;; '(("/home/greg/.*" "/~/.backups/" ok-create full-path prepend-name)
  62. ;;; ("^/[^/:]+:" ".backups/") ; handle EFS files specially: don't
  63. ;;; ("^/[^/:]+:" "./") ; search-upward... its very slow
  64. ;;; (t ".backups/"
  65. ;;; full-path prepend-name search-upward)))
  66. ;;;
  67. ;;;
  68. ;;; The package also provides a new function, `find-file-latest-backup' to
  69. ;;; find the latest backup file for the current buffer's file.
  70. ;;;
  71. ;;; This package is based on `files.el' from XEmacs 20.3 and overrides
  72. ;;; functions defined there. The overridden functions are clearly
  73. ;;; marked below and the originals precede the new definitions in
  74. ;;; commented form.
  75. ;;;
  76. ;;; The package is known to work in the latest XEmacs betas. It has
  77. ;;; not been extensively tested on GNU Emacs past 18.58, though I have
  78. ;;; reports of it working through 20.2. It does not work under ms-dos.
  79.  
  80. ;;; Change Log:
  81. ;;;
  82. ;;; January 8, 1999 Version 2.9
  83. ;;; * Fix bkup-search-upward-for-backup-dir,
  84. ;;; bkup-replace-slashes-with-exclamations, and
  85. ;;; bkup-backup-directory-and-basename for NT.
  86. ;;;
  87. ;;; November 13, 1998 Version 2.8
  88. ;;; * Reformat to fit within 80 columns.
  89. ;;; * Reformat ChangeLog section.
  90. ;;;
  91. ;;; June 10, 1998 Version 2.7
  92. ;;; * Add optional N argument to file-newest-backup and
  93. ;;; find-file-latest-backup.
  94. ;;;
  95. ;;; March 23, 1998 Version 2.6
  96. ;;; * Have to quote the eval-after-load form.
  97. ;;;
  98. ;;; February 22, 1998 Version 2.5
  99. ;;; * Fix infinite loop in bkup-search-upward-for-backup-dir due to a
  100. ;;; change in expand-file-name. Fix to not rely on expand-file-name.
  101. ;;;
  102. ;;; February 22, 1998 Version 2.4
  103. ;;; * Add a new option: prepend-name, suggested by Dave Bakhash.
  104. ;;;
  105. ;;; February 2, 1998 Version 2.3
  106. ;;; * Nuke byte-compiler-options.
  107. ;;; * Use eval-when-compile defvars to avoid compiler warnings.
  108. ;;; * Remove unused binding of non-num-bk-name from find-backup-file-name.
  109. ;;;
  110. ;;; October 27, 1997 Version 2.2
  111. ;;; * Update to adhere to lisp-mnt.el standards.
  112. ;;; * Don't require diff; instead use eval-after-load to patch
  113. ;;; diff-latest-backup-file (patch from Steve Baur).
  114. ;;;
  115. ;;; October 27, 1997 Version 2.1
  116. ;;; * Updated to support GNU Emacs 20.2. The function
  117. ;;; `backup-extract-version' now uses the free variable
  118. ;;; `backup-extract-version-start' rather than `bv-length'.
  119. ;;; Note, we continue to support older GNU Emacs and XEmacs
  120. ;;; by binding both names.
  121. ;;;
  122. ;;; October 22, 1997
  123. ;;; * Customization by Karl M. Hegbloom <karlheg@inetarena.com>
  124. ;;;
  125. ;;; December 28, 1996 Version 2.0
  126. ;;; * Updated for XEmacs 19.15b4, much of code reorganized & cleaned up
  127. ;;;
  128. ;;; December 27, 1996 Version 1.6
  129. ;;; * Explicit loading of dired replaced to use dired-load-hook
  130. ;;; (suggested by Thomas Feuster, feuster@tp4.physik.uni-giessen.de)
  131. ;;;
  132. ;;; December 2, 1996 Version 1.5
  133. ;;; * Took out obsolete byte compiler options
  134. ;;;
  135. ;;; September 24, 1996 Version 1.4
  136. ;;; * Various bugfixes.
  137. ;;; * Change to OPTIONS alist list (ok-create, full-path..) from
  138. ;;; separate fields for each option variable.
  139. ;;; * Added search-upward option.
  140. ;;; * Added new function `find-file-latest-backup' to find a file's
  141. ;;; latest backup.
  142. ;;;
  143. ;;; January 26, 1996 Version 1.3
  144. ;;; * Name change to backup-dir.el
  145. ;;;
  146. ;;; March 22, 1995 Version 1.2
  147. ;;; * Added new definitions for functions `file-newest-backup',
  148. ;;; `latest-backup-file', and `diff-latest-backup-file' so various other
  149. ;;; emacs functions will find the right backup files.
  150. ;;;
  151. ;;; April 23, 1993 Version 1.1
  152. ;;; * Reworked to allow different behavior for different files based on the
  153. ;;; alist `bkup-backup-directory-info'.
  154. ;;;
  155. ;;; Fall 1992 Version 1.0
  156. ;;; * Name change
  157. ;;; * Added ability to make directories absolute.
  158. ;;; * Added the full path stuff to make backup name unique for
  159. ;;; absolute directories.
  160. ;;;
  161. ;;; Spring 1992 Version 0.0
  162. ;;; * The original.
  163.  
  164.  
  165. ;;; Code:
  166.  
  167. (eval-when-compile
  168. ;; avoid compiler warnings: these are dynamically bound by
  169. ;; find-backup-file-name and used by backup extract-versions.
  170. (defvar backup-extract-version-start) ; GNU Emacs 20.2
  171. (defvar bv-length) ; XEmacs, older GNU Emacs
  172.  
  173. ;; this is defined for msdos only
  174. (unless (fboundp 'msdos-long-file-names)
  175. (defun msdos-long-file-names () nil)))
  176.  
  177.  
  178. ;;; New variables affecting backup file behavior
  179. ;;; This is the only user-customizable variable for this package.
  180. ;;;
  181. (defcustom bkup-backup-directory-info nil
  182. "*Alist of (FILE-REGEXP BACKUP-DIR OPTIONS ...))
  183. If the filename to be backed up matches FILE-REGEXP, or FILE-REGEXP is t,
  184. then BACKUP-DIR is used as the path for its backups.
  185.  
  186. Directories may begin with \"/\" to specify an absolute pathname.
  187.  
  188. If BACKUP-DIR does not exist and OPTIONS contains the symbol `ok-create',
  189. then it is created if possible. Otherwise the usual behavior (backup in the
  190. same directory as the file) results.
  191.  
  192. If OPTIONS contains the symbol `full-path', then the full path of the file
  193. being backed up is prepended to the backup file name, with each \"/\"
  194. replaced by a \"!\". This is intended for cases where an absolute backup
  195. path is used. If OPTIONS contains `prepend-name' in addition to `full-path',
  196. then the file name is prepended rather than appended to the path component
  197. when forming the backup name.
  198.  
  199. If OPTIONS contains the symbol `search-upward' and the backup directory
  200. BACKUP-DIR is a relative path, then a directory with that name is searched
  201. for starting at the current directory and proceeding upward (.., ../.., etc)
  202. until one is found of that name, or the root is reached, and if one is found
  203. it is used as the backup directory.
  204.  
  205. Finally, if no FILE-REGEXP matches the file name being backed up, then the
  206. usual behavior results.
  207.  
  208. Once you save this variable with `M-x customize-variable',
  209. `backup-dir' will be loaded for you each time you start XEmacs."
  210. :type '(repeat
  211. (list (regexp :tag "File regexp")
  212. (string :tag "Backup Dir")
  213. (set :inline t
  214. (const ok-create)
  215. (const full-path)
  216. (const prepend-name)
  217. (const search-upward))))
  218. :require 'backup-dir
  219. :group 'backup)
  220.  
  221.  
  222. ;;; New functions
  223. ;;;
  224. (defun bkup-search-upward-for-backup-dir (base bd-name)
  225. "Search upward for a directory named BD-NAME, starting in the
  226. directory BASE and continuing with its parent directories until
  227. one is found or the root is reached."
  228. (let ((prev nil) (curr base) (gotit nil) (tryit nil))
  229. (while (and (not gotit)
  230. (not (equal curr prev))
  231. (not (equal prev "/")))
  232. (setq tryit (expand-file-name bd-name curr))
  233. (if (and (file-directory-p tryit)
  234. (file-exists-p tryit))
  235. (setq gotit tryit)
  236. (setq prev curr
  237. curr (file-name-directory (directory-file-name curr)))))
  238. (if (and gotit
  239. (eq (aref gotit (1- (length gotit))) ?/))
  240. (setq gotit (substring gotit 0 (1- (length gotit)))))
  241. gotit))
  242.  
  243. (defun bkup-replace-slashes-with-exclamations (s)
  244. "Replaces slashes in the string S with exclamations.
  245. A new string is produced and returned."
  246. (let ((ns (copy-sequence s))
  247. (i (1- (length s)))
  248. (mswin (eq system-type 'windows-nt))
  249. (c nil))
  250. (while (>= i 0)
  251. (setq c (aref ns i))
  252. (if (or (= c ?/)
  253. (and mswin
  254. (or (= c ?:) (= c ?\\))))
  255. (aset ns i ?!))
  256. (setq i (1- i)))
  257. ns))
  258.  
  259. (defun bkup-try-making-directory (dir)
  260. "Try making directory DIR, return non-nil if successful"
  261. (condition-case ()
  262. (progn (make-directory dir t)
  263. t)
  264. (t
  265. nil)))
  266.  
  267. (defun bkup-backup-basename (file options)
  268. "Gives the base part of the backup name for FILE, according to OPTIONS."
  269. (if (memq 'full-path options)
  270. (if (memq 'prepend-name options)
  271. (concat (file-name-nondirectory file)
  272. "!!"
  273. (bkup-replace-slashes-with-exclamations
  274. (file-name-directory file)))
  275. (bkup-replace-slashes-with-exclamations file))
  276. (file-name-nondirectory file)))
  277.  
  278. (defun bkup-backup-directory-and-basename (file)
  279. "Return the cons of the backup directory name
  280. and backup file name base for FILE."
  281. (let ((file (expand-file-name file)))
  282. (let ((dir (file-name-directory file))
  283. (alist bkup-backup-directory-info)
  284. (bk-dir nil)
  285. (bk-base nil))
  286. (if (listp alist)
  287. (while (and (not bk-dir) alist)
  288. (if (or (eq (car (car alist)) t)
  289. (eq (string-match (car (car alist)) file) 0))
  290. (let* ((bd (car (cdr (car alist))))
  291. (bd-rel-p (not (file-name-absolute-p bd)))
  292. (bd-expn (expand-file-name bd dir))
  293. (bd-noslash (directory-file-name bd-expn))
  294. (options (cdr (cdr (car alist))))
  295. (ok-create (and (memq 'ok-create options) t))
  296. (search-upward (and (memq 'search-upward options) t)))
  297. (if bd-expn
  298. (cond ((or (file-directory-p bd-expn)
  299. (and ok-create
  300. (not (file-exists-p bd-expn))
  301. (bkup-try-making-directory bd-noslash)))
  302. (setq bk-dir (file-name-as-directory bd-noslash)
  303. bk-base (bkup-backup-basename file
  304. options)))
  305. ((and bd-rel-p search-upward)
  306. (let ((bd-up (bkup-search-upward-for-backup-dir
  307. dir bd)))
  308. (if bd-up
  309. (setq bk-dir (file-name-as-directory bd-up)
  310. bk-base (bkup-backup-basename
  311. file options)))))))))
  312. (setq alist (cdr alist))))
  313. (if (and bk-dir bk-base)
  314. (cons bk-dir bk-base)
  315. (cons dir (bkup-backup-basename file nil))))))
  316.  
  317.  
  318. ;;; This next one is based on the following from `files.el'
  319. ;;; but accepts a second optional argument
  320.  
  321. ;;(defun make-backup-file-name (file)
  322. ;; "Create the non-numeric backup file name for FILE.
  323. ;;This is a separate function so you can redefine it for customization."
  324. ;; (if (and (eq system-type 'ms-dos)
  325. ;; (not (msdos-long-file-names)))
  326. ;; (let ((fn (file-name-nondirectory file)))
  327. ;;(concat (file-name-directory file)
  328. ;;(if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
  329. ;; (substring fn 0 (match-end 1)))
  330. ;;".bak"))
  331. ;; (concat file "~")))
  332.  
  333. (defun bkup-make-backup-file-name (file &optional dir-n-base)
  334. "Create the non-numeric backup file name for FILE.
  335. Optionally accept a list containing the backup directory and
  336. backup basename. NB: we don't really handle ms-dos."
  337. (if (and (eq system-type 'ms-dos)
  338. (not (and (fboundp 'msdos-long-file-names)
  339. (msdos-long-file-names))))
  340. (let ((fn (file-name-nondirectory file)))
  341. (concat (file-name-directory file)
  342. (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
  343. (substring fn 0 (match-end 1)))
  344. ".bak"))
  345. (let ((d-n-b (or dir-n-base
  346. (bkup-backup-directory-and-basename file))))
  347. (concat (car d-n-b) (cdr d-n-b) "~"))))
  348.  
  349. (defun bkup-existing-backup-files (fn)
  350. "Return list of existing backup files for file"
  351. (let* ((efn (expand-file-name fn))
  352. (dir-n-base (bkup-backup-directory-and-basename efn))
  353. (non-num-bk-name (bkup-make-backup-file-name efn dir-n-base))
  354. (non-num-bk (file-exists-p non-num-bk-name))
  355. (backup-dir (car dir-n-base))
  356. (base-versions (concat (cdr dir-n-base) ".~"))
  357. (possibilities (file-name-all-completions base-versions backup-dir))
  358. (poss (mapcar #'(lambda (name) (concat backup-dir name))
  359. possibilities)))
  360. (mapcar #'expand-file-name
  361. (if non-num-bk (cons non-num-bk-name poss) poss))))
  362.  
  363. (defun find-file-latest-backup (file &optional n)
  364. "Find the latest backup file for FILE, or the Nth most recent
  365. if optional second argument N is specified. Interactively, N
  366. is specified with the prefix argument."
  367. (interactive
  368. (list
  369. (read-file-name
  370. (format "Find %slatest backup of file (default %s): "
  371. (let* ((arg (prefix-numeric-value
  372. current-prefix-arg))
  373. (mod (% arg 10)))
  374. (if (and (integerp arg) (> arg 1))
  375. (format "%d%s "
  376. arg
  377. (cond ((= 1 mod) "st")
  378. ((= 2 mod) "nd")
  379. ((= 3 mod) "rd")
  380. (t "th")))
  381. ""))
  382. (file-name-nondirectory (buffer-file-name)))
  383. nil (buffer-file-name) t)
  384. (prefix-numeric-value current-prefix-arg)))
  385. (let ((backup (file-newest-backup file n)))
  386. (if backup
  387. (find-file backup)
  388. (message "no %s found for `%s'"
  389. (if (> n 1) "such backup" "backups") file))))
  390.  
  391.  
  392. ;;; Functions changed from `files.el' and elsewhere -- originals
  393. ;;; precede new versions
  394.  
  395. ;;(defun make-backup-file-name (file)
  396. ;; "Create the non-numeric backup file name for FILE.
  397. ;;This is a separate function so you can redefine it for customization."
  398. ;; (if (and (eq system-type 'ms-dos)
  399. ;; (not (msdos-long-file-names)))
  400. ;; (let ((fn (file-name-nondirectory file)))
  401. ;;(concat (file-name-directory file)
  402. ;;(if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
  403. ;; (substring fn 0 (match-end 1)))
  404. ;;".bak"))
  405. ;; (concat file "~")))
  406.  
  407. (defun make-backup-file-name (file)
  408. "Create the non-numeric backup file name for FILE.
  409. This is a separate function so you can redefine it for customization.
  410. *** Changed by \"backup-dir.el\""
  411. (bkup-make-backup-file-name file))
  412.  
  413.  
  414. ;;(defun find-backup-file-name (fn)
  415. ;; "Find a file name for a backup file, and suggestions for deletions.
  416. ;;Value is a list whose car is the name for the backup file
  417. ;; and whose cdr is a list of old versions to consider deleting now.
  418. ;;If the value is nil, don't make a backup."
  419. ;; (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
  420. ;; ;; Run a handler for this function so that ange-ftp can refuse to do it.
  421. ;; (if handler
  422. ;;(funcall handler 'find-backup-file-name fn)
  423. ;; (if (eq version-control 'never)
  424. ;; (list (make-backup-file-name fn))
  425. ;;(let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
  426. ;; ;; used by backup-extract-version:
  427. ;; (bv-length (length base-versions))
  428. ;; possibilities
  429. ;; (versions nil)
  430. ;; (high-water-mark 0)
  431. ;; (deserve-versions-p nil)
  432. ;; (number-to-delete 0))
  433. ;; (condition-case ()
  434. ;; (setq possibilities (file-name-all-completions
  435. ;; base-versions
  436. ;; (file-name-directory fn))
  437. ;; versions (sort (mapcar
  438. ;; #'backup-extract-version
  439. ;; possibilities)
  440. ;; '<)
  441. ;; high-water-mark (apply #'max 0 versions)
  442. ;; deserve-versions-p (or version-control
  443. ;; (> high-water-mark 0))
  444. ;; number-to-delete (- (length versions)
  445. ;;kept-old-versions kept-new-versions -1))
  446. ;; (file-error
  447. ;; (setq possibilities nil)))
  448. ;; (if (not deserve-versions-p)
  449. ;; (list (make-backup-file-name fn))
  450. ;; (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
  451. ;; (if (and (> number-to-delete 0)
  452. ;; ;; Delete nothing if there is overflow
  453. ;; ;; in the number of versions to keep.
  454. ;; (>= (+ kept-new-versions kept-old-versions -1) 0))
  455. ;; (mapcar #'(lambda (n)
  456. ;; (concat fn ".~" (int-to-string n) "~"))
  457. ;; (let ((v (nthcdr kept-old-versions versions)))
  458. ;;(rplacd (nthcdr (1- number-to-delete) v) ())
  459. ;;v))))))))))
  460.  
  461. (defun find-backup-file-name (fn)
  462. "Find a file name for a backup file, and suggestions for deletions.
  463. Value is a list whose car is the name for the backup file
  464. and whose cdr is a list of old versions to consider deleting now.
  465. If the value is nil, don't make a backup.
  466. *** Changed by \"backup-dir.el\""
  467. (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
  468. ;; Run a handler for this function so that ange-ftp can refuse to do it.
  469. (if handler
  470. (funcall handler 'find-backup-file-name fn)
  471. (if (eq version-control 'never)
  472. (list (make-backup-file-name fn))
  473. (let* ((dir-n-base (bkup-backup-directory-and-basename fn)) ;add
  474. (bk-dir (car dir-n-base)) ;add
  475. (bk-base (cdr dir-n-base)) ;add
  476. (base-versions (concat bk-base ".~")) ;mod
  477. ;; used by backup-extract-version:
  478. (bv-length (length base-versions)) ;; older GNU and XEmacs
  479. (backup-extract-version-start
  480. (length base-versions)) ;; new GNU Emacs (20.2)
  481. possibilities
  482. (versions nil)
  483. (high-water-mark 0)
  484. (deserve-versions-p nil)
  485. (number-to-delete 0))
  486. (condition-case ()
  487. (setq possibilities (file-name-all-completions
  488. base-versions
  489. bk-dir) ;mod
  490. versions (sort (mapcar
  491. #'backup-extract-version
  492. possibilities)
  493. '<)
  494. high-water-mark (apply #'max 0 versions)
  495. deserve-versions-p (or version-control
  496. (> high-water-mark 0))
  497. number-to-delete (- (length versions)
  498. kept-old-versions
  499. kept-new-versions -1))
  500. (file-error
  501. (setq possibilities nil)))
  502. (if (not deserve-versions-p)
  503. (list (bkup-make-backup-file-name fn dir-n-base)) ;mod
  504. (cons (concat bk-dir base-versions
  505. (int-to-string (1+ high-water-mark)) "~") ;mod
  506. (if (and (> number-to-delete 0)
  507. ;; Delete nothing if there is overflow
  508. ;; in the number of versions to keep.
  509. (>= (+ kept-new-versions kept-old-versions -1) 0))
  510. (mapcar #'(lambda (n)
  511. (concat bk-dir base-versions
  512. (int-to-string n) "~")) ;mod
  513. (let ((v (nthcdr kept-old-versions versions)))
  514. (rplacd (nthcdr (1- number-to-delete) v) ())
  515. v))))))))))
  516.  
  517.  
  518. ;;(defun file-newest-backup (filename)
  519. ;; "Return most recent backup file for FILENAME or nil if no backups exist."
  520. ;; (let* ((filename (expand-file-name filename))
  521. ;; (file (file-name-nondirectory filename))
  522. ;; (dir (file-name-directory filename))
  523. ;; (comp (file-name-all-completions file dir))
  524. ;; newest tem)
  525. ;; (while comp
  526. ;; (setq tem (car comp)
  527. ;; comp (cdr comp))
  528. ;; (cond ((and (backup-file-name-p tem)
  529. ;; (string= (file-name-sans-versions tem) file))
  530. ;; (setq tem (concat dir tem))
  531. ;; (if (or (null newest)
  532. ;; (file-newer-than-file-p tem newest))
  533. ;; (setq newest tem)))))
  534. ;; newest))
  535.  
  536. (defun file-newest-backup (filename &optional n)
  537. "Return most recent backup file for FILENAME or nil if no backups exist.
  538. Optional second argument N specifies the Nth newest backup, rather than the
  539. most recent.
  540. *** Changed by \"backup-dir.el\""
  541. (nth (if (integerp n) (max 0 (1- n)) 0)
  542. (sort (bkup-existing-backup-files filename)
  543. 'file-newer-than-file-p)))
  544.  
  545.  
  546. ;;; patch `latest-backup-file' from "dired"
  547. ;;;
  548. ;;; we use `dired-load-hook' to avoid loading dired now. This speeds things
  549. ;;; up considerably according to Thomas Feuster,
  550. ;;; feuster@tp4.physik.uni-giessen.de
  551. ;;;
  552. ;;; one really wonders why there are 3 functions to do the same thing...
  553. ;;;
  554. (defun bkup-patch-latest-backup-file ()
  555. (fset 'latest-backup-file (symbol-function 'file-newest-backup))
  556. (remove-hook 'dired-load-hook 'bkup-patch-latest-backup-file))
  557.  
  558. (if (featurep 'dired)
  559. ;; if loaded, patch it now
  560. (fset 'latest-backup-file (symbol-function 'file-newest-backup))
  561. ;; otherwise do it later
  562. (add-hook 'dired-load-hook 'bkup-patch-latest-backup-file))
  563.  
  564.  
  565. ;;; patch `diff-latest-backup-file' from "diff"
  566. ;;;
  567. (eval-after-load "diff"
  568. '(fset 'diff-latest-backup-file
  569. (symbol-function 'file-newest-backup)))
  570.  
  571.  
  572. ;;; finally, add to list of features
  573. ;;;
  574. (provide 'backup-dir)
  575.  
  576. ;;; backup-dir.el ends here
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!