Mercurial > hg > xemacs-beta

comparison lisp/packages/backup-dir.el @ 213:78f53ef88e17 r20-4b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b5
author cvs
date Mon, 13 Aug 2007 10:06:47 +0200
parents e45d5e7c476e
children
comparison
equal deleted inserted replaced
212:d8688acf4c5b 213:78f53ef88e17
1 ;;; BACKUP-DIR.EL: Emacs functions to allow backup files to live in 1 ;;; BACKUP-DIR.EL: Emacs functions to allow backup files to live in
2 ;;; some other directory(s). Version 2.0 2 ;;; some other directory(s). Version 2.1
3 ;;; 3 ;;;
4 ;;; Copyright (C) 1992-97 Greg Klanderman 4 ;;; Copyright (C) 1992-97 Greg Klanderman
5 ;;; 5 ;;;
6 ;;; This program is free software; you can redistribute it and/or modify 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 7 ;;; it under the terms of the GNU General Public License as published by
20 ;;; Send bug reports, etc. to greg@alphatech.com or gregk@ai.mit.edu. 20 ;;; Send bug reports, etc. to greg@alphatech.com or gregk@ai.mit.edu.
21 ;;; 21 ;;;
22 ;;; 22 ;;;
23 ;;; Modification History 23 ;;; Modification History
24 ;;; ==================== 24 ;;; ====================
25 ;;;
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>
25 ;;; 33 ;;;
26 ;;; 12/28/1996 Version 2.0 34 ;;; 12/28/1996 Version 2.0
27 ;;; Updated for XEmacs 19.15b4, much of code reorganized & cleaned up 35 ;;; Updated for XEmacs 19.15b4, much of code reorganized & cleaned up
28 ;;; 36 ;;;
29 ;;; 12/27/1996 Version 1.6 37 ;;; 12/27/1996 Version 1.6
82 ;;; These lines from my .emacs load this file and set the values I like: 90 ;;; These lines from my .emacs load this file and set the values I like:
83 ;;; 91 ;;;
84 ;;; (require 'backup-dir) 92 ;;; (require 'backup-dir)
85 ;;; (setq bkup-backup-directory-info 93 ;;; (setq bkup-backup-directory-info
86 ;;; '(("/home/greg/.*" "/~/.backups/" ok-create full-path) 94 ;;; '(("/home/greg/.*" "/~/.backups/" ok-create full-path)
87 ;;; (t ".backups/" full-path search-upward))) 95 ;;; ("^/[^/:]+:" ".backups/") ; handle EFS files specially: we don't
96 ;;; ("^/[^/:]+:" "./") ; want to search-upward... its very slow
97 ;;; (t ".backups/" full-path search-upward)))
88 ;;; 98 ;;;
89 ;;; 99 ;;;
90 ;;; The package also provides a new function, `find-file-latest-backup' to find 100 ;;; The package also provides a new function, `find-file-latest-backup' to find
91 ;;; the latest backup file for the current buffer's file. 101 ;;; the latest backup file for the current buffer's file.
92 ;;; 102 ;;;
131 usual behavior results. 141 usual behavior results.
132 142
133 Once you save this variable with `M-x customize-variable', 143 Once you save this variable with `M-x customize-variable',
134 `backup-dir' will be loaded for you each time you start XEmacs." 144 `backup-dir' will be loaded for you each time you start XEmacs."
135 :type '(repeat 145 :type '(repeat
136 (list (regexp :tag "File regexp") 146 (list (regexp :tag "File regexp")
137 (string :tag "Backup Dir") 147 (string :tag "Backup Dir")
138 (set :inline t 148 (set :inline t
139 (const ok-create) 149 (const ok-create)
140 (const full-path) 150 (const full-path)
141 (const search-upward)))) 151 (const search-upward))))
142 :require 'backup-dir 152 :require 'backup-dir
143 :group 'backup) 153 :group 'backup)
154
144 155
145 ;;; New functions 156 ;;; New functions
146 ;;; 157 ;;;
147 (defun bkup-search-upward-for-backup-dir (base bd-name) 158 (defun bkup-search-upward-for-backup-dir (base bd-name)
148 "search upward for a directory named BD-NAME, starting in the 159 "Search upward for a directory named BD-NAME, starting in the
149 directory BASE and continuing with its parent directories until 160 directory BASE and continuing with its parent directories until
150 one is found or the root is reached." 161 one is found or the root is reached."
151 (let ((prev nil) (curr base) (gotit nil) (tryit nil)) 162 (let ((prev nil) (curr base) (gotit nil) (tryit nil))
152 (while (and (not gotit) 163 (while (and (not gotit)
153 (not (equal prev curr)) 164 (not (equal prev curr))
172 (aset ns i ?!)) 183 (aset ns i ?!))
173 (setq i (1- i))) 184 (setq i (1- i)))
174 ns)) 185 ns))
175 186
176 (defun bkup-try-making-directory (dir) 187 (defun bkup-try-making-directory (dir)
177 "try making directory DIR, return non-nil if successful" 188 "Try making directory DIR, return non-nil if successful"
178 (condition-case () 189 (condition-case ()
179 (progn (make-directory dir t) 190 (progn (make-directory dir t)
180 t) 191 t)
181 (t 192 (t
182 nil))) 193 nil)))
366 (non-num-bk-name (bkup-make-backup-file-name fn dir-n-base)) ;add 377 (non-num-bk-name (bkup-make-backup-file-name fn dir-n-base)) ;add
367 (bk-dir (car dir-n-base)) ;add 378 (bk-dir (car dir-n-base)) ;add
368 (bk-base (cdr dir-n-base)) ;add 379 (bk-base (cdr dir-n-base)) ;add
369 (base-versions (concat bk-base ".~")) ;mod 380 (base-versions (concat bk-base ".~")) ;mod
370 ;; used by backup-extract-version: 381 ;; used by backup-extract-version:
371 (bv-length (length base-versions)) 382 (bv-length (length base-versions)) ;; older GNU Emacsen and XEmacs
383 (backup-extract-version-start (length base-versions)) ;; new GNU Emacs (20.2)
372 possibilities 384 possibilities
373 (versions nil) 385 (versions nil)
374 (high-water-mark 0) 386 (high-water-mark 0)
375 (deserve-versions-p nil) 387 (deserve-versions-p nil)
376 (number-to-delete 0)) 388 (number-to-delete 0))