Mercurial > hg > xemacs-beta

comparison lisp/auto-save.el @ 464:5aa1854ad537 r21-2-47

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-47
author cvs
date Mon, 13 Aug 2007 11:45:51 +0200
parents 8de8e3f6228a
children 943eaba38521
comparison
equal deleted inserted replaced
463:a158004111cd 464:5aa1854ad537
1 ;;; auto-save.el -- Safer autosaving for EFS and tmp. 1 ;;; auto-save.el -- Safer autosaving for EFS and tmp.
2 2
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1992 by Sebastian Kremer <sk@thp.uni-koeln.de> 4 ;; Copyright (C) 1992 by Sebastian Kremer <sk@thp.uni-koeln.de>
5 ;; Copyright (C) 2001 Ben Wing.
5 6
6 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> 7 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
7 ;; Maintainer: XEmacs Development Team 8 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: extensions, dumped 9 ;; Keywords: extensions, dumped
9 ;; Version: 1.26 10 ;; Version: 1.26
32 ;; Combines autosaving for efs (to a local or remote directory) 33 ;; Combines autosaving for efs (to a local or remote directory)
33 ;; with the ability to do autosaves to a fixed directory on a local 34 ;; with the ability to do autosaves to a fixed directory on a local
34 ;; disk, in case NFS is slow. The auto-save file used for 35 ;; disk, in case NFS is slow. The auto-save file used for
35 ;; /usr/foo/bar/baz.txt 36 ;; /usr/foo/bar/baz.txt
36 ;; will be 37 ;; will be
37 ;; AUTOSAVE/#\!usr\!foo\!bar\!baz.txt# 38 ;; AUTOSAVE/#=2Fusr=2Ffoo=2Fbar=2Fbaz.txt#"
38 ;; assuming AUTOSAVE is the non-nil value of the variable 39 ;; assuming AUTOSAVE is the non-nil value of the variable
39 ;; `auto-save-directory'. 40 ;; `auto-save-directory'.
40
41 ;; Takes care that autosave files for non-file-buffers (e.g. *mail*)
42 ;; from two simultaneous Emacses don't collide.
43 41
44 ;; Autosaves even if the current directory is not writable. 42 ;; Autosaves even if the current directory is not writable.
45 43
46 ;; Can limit autosave names to 14 characters using a hash function, 44 ;; Can limit autosave names to 14 characters using a hash function,
47 ;; see `auto-save-hash-p'. 45 ;; see `auto-save-hash-p'.
58 ;; If you want to autosave in the fixed directory /tmp/USER-autosave/ 56 ;; If you want to autosave in the fixed directory /tmp/USER-autosave/
59 ;; (setq auto-save-directory 57 ;; (setq auto-save-directory
60 ;; (concat "/tmp/" (user-login-name) "-autosave/")) 58 ;; (concat "/tmp/" (user-login-name) "-autosave/"))
61 59
62 ;; If you don't want to save in /tmp (e.g., because it is swap 60 ;; If you don't want to save in /tmp (e.g., because it is swap
63 ;; mounted) but rather in ~/autosave/ 61 ;; mounted) but rather in ~/.autosave/
64 ;; (setq auto-save-directory (expand-file-name "~/.autosave/")) 62 ;; (setq auto-save-directory (expand-file-name "~/.autosave/"))
65 63
66 ;; If you want to save each file in its own directory (the default) 64 ;; If you want to save each file in its own directory (the default)
67 ;; (setq auto-save-directory nil) 65 ;; (setq auto-save-directory nil)
68 ;; You still can take advantage of autosaving efs remote files 66 ;; You still can take advantage of autosaving efs remote files
142 140
143 /home/sk/lib/emacs/lisp/auto-save.el 141 /home/sk/lib/emacs/lisp/auto-save.el
144 142
145 will have a longish filename like 143 will have a longish filename like
146 144
147 AUTO-SAVE-DIRECTORY/#\\!home\\!sk\\!lib\\!emacs\\!lisp\\!auto-save.el# 145 AUTO-SAVE-DIRECTORY/#=2Fhome=2Fsk=2Flib=2Femacs=2Flisp=2Fauto-save.el#
148 146
149 as auto save file. 147 as auto save file.
150 148
151 See also variables `auto-save-directory-fallback', 149 See also variables `auto-save-directory-fallback',
152 `efs-auto-save' and `efs-auto-save-remotely'." 150 `efs-auto-save' and `efs-auto-save-remotely'."
220 ; (auto-save-check-directory 'auto-save-hash-directory)) 218 ; (auto-save-check-directory 'auto-save-hash-directory))
221 219
222 220
223 ;;; Computing an autosave name for a file and vice versa 221 ;;; Computing an autosave name for a file and vice versa
224 222
225 ;; #### Now that this file is dumped, we should turn off the routine 223 (defun make-auto-save-file-name (&optional file-name)
226 ;; from files.el. But it would make it harder to remove it!
227
228 (defun make-auto-save-file-name (&optional file-name);; redefines files.el
229 ;; auto-save-file-name-p need not be redefined.
230
231 "Return file name to use for auto-saves of current buffer. 224 "Return file name to use for auto-saves of current buffer.
232 Does not consider `auto-save-visited-file-name'; that is checked 225 Does not consider `auto-save-visited-file-name'; that is checked
233 before calling this function. 226 before calling this function.
234 227
235 Offers to autosave all files in the same `auto-save-directory'. All 228 Offers to autosave all files in the same `auto-save-directory'. All
283 (name-prefix (if file-name nil "#%")) 276 (name-prefix (if file-name nil "#%"))
284 277
285 (save-name (or file-name 278 (save-name (or file-name
286 ;; Prevent autosave errors. Buffername 279 ;; Prevent autosave errors. Buffername
287 ;; (to become non-dir part of filename) will 280 ;; (to become non-dir part of filename) will
288 ;; be unslashified twice. Don't care. 281 ;; be escaped twice. Don't care.
289 (auto-save-unslashify-name (buffer-name)))) 282 (auto-save-escape-name (buffer-name))))
290 (remote-p (and (stringp file-name) 283 (remote-p (and (stringp file-name)
291 (fboundp 'efs-ftp-path) 284 (fboundp 'efs-ftp-path)
292 (efs-ftp-path file-name)))) 285 (efs-ftp-path file-name))))
293 ;; Return the appropriate auto save file name: 286 ;; Return the appropriate auto save file name:
294 (expand-file-name;; a buffername needs this, a filename not 287 (expand-file-name;; a buffername needs this, a filename not
314 ;; return nil, e.g., when after-find-file tests 307 ;; return nil, e.g., when after-find-file tests
315 ;; file-newer-than-file-p, nil would bomb. 308 ;; file-newer-than-file-p, nil would bomb.
316 309
317 (error (warn "Error caught in `make-auto-save-file-name':\n%s" 310 (error (warn "Error caught in `make-auto-save-file-name':\n%s"
318 (error-message-string error-data)) 311 (error-message-string error-data))
319 (if buffer-file-name 312 (let ((fname
320 (concat (file-name-directory buffer-file-name) 313 (if file-name
321 "#" 314 (concat (file-name-directory file-name)
322 (file-name-nondirectory buffer-file-name) 315 "#"
323 "#") 316 (file-name-nondirectory file-name)
324 (expand-file-name (concat "#%" (buffer-name) "#")))))) 317 "#")
318 (expand-file-name
319 (concat "#%" (auto-save-escape-name (buffer-name))
320 "#")))))
321 (if (or (file-writable-p fname)
322 (file-exists-p fname))
323 fname
324 (expand-file-name (concat "~/"
325 (file-name-nondirectory fname))))))))
326
327 (defun auto-save-file-name-p (filename)
328 "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
329 FILENAME should lack slashes.
330 You can redefine this for customization."
331 (string-match "\\`#.*#\\'" filename))
325 332
326 (defun auto-save-original-name (savename) 333 (defun auto-save-original-name (savename)
327 "Reverse of `make-auto-save-file-name'. 334 "Reverse of `make-auto-save-file-name'.
328 Returns nil if SAVENAME was not associated with a file (e.g., it came 335 Returns nil if SAVENAME was not associated with a file (e.g., it came
329 from an autosaved `*mail*' buffer) or does not appear to be an 336 from an autosaved `*mail*' buffer) or does not appear to be an
340 (expand-file-name auto-save-directory))) 347 (expand-file-name auto-save-directory)))
341 ; 2nd arg may be nil 348 ; 2nd arg may be nil
342 (equal savedir 349 (equal savedir
343 (expand-file-name auto-save-directory-fallback))) 350 (expand-file-name auto-save-directory-fallback)))
344 ;; it is of the `-fixed-directory' type 351 ;; it is of the `-fixed-directory' type
345 (auto-save-slashify-name (substring basename 1 -1))) 352 (auto-save-unescape-name (substring basename 1 -1)))
346 (t 353 (t
347 ;; else it is of `-same-directory' type 354 ;; else it is of `-same-directory' type
348 (concat savedir (substring basename 1 -1)))))) 355 (concat savedir (substring basename 1 -1))))))
349 356
350 (defun auto-save-name-in-fixed-directory (filename &optional prefix) 357 (defun auto-save-name-in-fixed-directory (filename &optional prefix)
351 ;; Unslashify and enclose the whole FILENAME in `#' to make an auto 358 ;; Escape and enclose the whole FILENAME in `#' to make an auto
352 ;; save file in the auto-save-directory, or if that is nil, in 359 ;; save file in the auto-save-directory, or if that is nil, in
353 ;; auto-save-directory-fallback (which must be the name of an 360 ;; auto-save-directory-fallback (which must be the name of an
354 ;; existing directory). If the results would be too long for 14 361 ;; existing directory). If the results would be too long for 14
355 ;; character filenames, and `auto-save-hash-p' is set, hash FILENAME 362 ;; character filenames, and `auto-save-hash-p' is set, hash FILENAME
356 ;; into a shorter name. 363 ;; into a shorter name.
357 ;; Optional PREFIX is string to use instead of "#" to prefix name. 364 ;; Optional PREFIX is string to use instead of "#" to prefix name.
358 (let ((base-name (concat (or prefix "#") 365 (let ((base-name (concat (or prefix "#")
359 (auto-save-unslashify-name filename) 366 (auto-save-escape-name filename)
360 "#"))) 367 "#")))
361 (if (and auto-save-hash-p 368 (if (and auto-save-hash-p
362 auto-save-hash-directory 369 auto-save-hash-directory
363 (> (length base-name) 14)) 370 (> (length base-name) 14))
364 (expand-file-name (auto-save-cyclic-hash-14 filename) 371 (expand-file-name (auto-save-cyclic-hash-14 filename)
384 (concat directory ; (concat nil) is "" 391 (concat directory ; (concat nil) is ""
385 (or prefix "#") 392 (or prefix "#")
386 (file-name-nondirectory filename) 393 (file-name-nondirectory filename)
387 "#"))) 394 "#")))
388 395
389 ;; #### The following two should probably use `replace-in-string'. 396 (defconst auto-save-reserved-chars
390 397 '(
391 (defun auto-save-unslashify-name (s) 398 ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\10 ?\11 ?\12 ?\13 ?\14 ?\15 ?\16
392 ;; "Quote any slashes in string S by replacing them with the two 399 ?\17 ?\20 ?\21 ?\22 ?\23 ?\24 ?\25 ?\26 ?\27 ?\30 ?\31 ?\32 ?\33
393 ;;characters `\\!'. 400 ?\34 ?\35 ?\36 ?\37 ?\40 ?? ?* ?: ?< ?> ?| ?/ ?\\ ?& ?^ ?% ?= ?\")
394 ;;Also, replace any backslash by double backslash, to make it one-to-one." 401 "List of characters disallowed (or potentially disallowed) in filenames.
395 (let ((limit 0)) 402 Includes everything that can get us into trouble under MS Windows or Unix.")
396 (while (string-match "[/\\]" s limit) 403
397 (setq s (concat (substring s 0 (match-beginning 0)) 404 ;; This code based on code in Bill Perry's url.el.
398 (if (string= (substring s 405
399 (match-beginning 0) 406 (defun auto-save-escape-name (str)
400 (match-end 0)) 407 "Escape any evil nasty characters in a potential filename.
401 "/") 408 Uses quoted-printable-style escaping -- e.g. the dreaded =3D.
402 "\\!" 409 Does not use URL escaping (with %) because filenames beginning with #% are
403 "\\\\") 410 a special signal for non-file buffers."
404 (substring s (match-end 0)))) 411 (mapconcat
405 (setq limit (1+ (match-end 0))))) 412 (function
406 s) 413 (lambda (char)
407 414 (if (memq char auto-save-reserved-chars)
408 (defun auto-save-slashify-name (s) 415 (if (< char 16)
409 ;;"Reverse of `auto-save-unslashify-name'." 416 (upcase (format "=0%x" char))
410 (let (pos) 417 (upcase (format "=%x" char)))
411 (while (setq pos (string-match "\\\\[\\!]" s pos)) 418 (char-to-string char))))
412 (setq s (concat (substring s 0 pos) 419 str ""))
413 (if (eq ?! (aref s (1+ pos))) "/" "\\") 420
414 (substring s (+ pos 2))) 421 (defun auto-save-unhex (x)
415 pos (1+ pos)))) 422 (if (> x ?9)
416 s) 423 (if (>= x ?a)
424 (+ 10 (- x ?a))
425 (+ 10 (- x ?A)))
426 (- x ?0)))
427
428 (defun auto-save-unescape-name (str)
429 "Undo any escaping of evil nasty characters in a file name.
430 See `auto-save-escape-name'."
431 (setq str (or str ""))
432 (let ((tmp "")
433 (case-fold-search t))
434 (while (string-match "=[0-9a-f][0-9a-f]" str)
435 (let* ((start (match-beginning 0))
436 (ch1 (auto-save-unhex (elt str (+ start 1))))
437 (code (+ (* 16 ch1)
438 (auto-save-unhex (elt str (+ start 2))))))
439 (setq tmp (concat tmp (substring str 0 start)
440 (char-to-string code))
441 str (substring str (match-end 0)))))
442 (setq tmp (concat tmp str))
443 tmp))
444
445 ;; The old versions are below.
446
447 ;(defun auto-save-escape-name (s)
448 ; ;; "Quote any slashes in string S by replacing them with the two
449 ; ;;characters `\\!'.
450 ; ;;Also, replace any backslash by double backslash, to make it one-to-one."
451 ; (let ((limit 0))
452 ; (while (string-match "[/\\]" s limit)
453 ; (setq s (concat (substring s 0 (match-beginning 0))
454 ; (if (string= (substring s
455 ; (match-beginning 0)
456 ; (match-end 0))
457 ; "/")
458 ; "\\!"
459 ; "\\\\")
460 ; (substring s (match-end 0))))
461 ; (setq limit (1+ (match-end 0)))))
462 ; s)
463
464 ;(defun auto-save-unescape-name (s)
465 ; ;;"Reverse of `auto-save-escape-name'."
466 ; (let (pos)
467 ; (while (setq pos (string-match "\\\\[\\!]" s pos))
468 ; (setq s (concat (substring s 0 pos)
469 ; (if (eq ?! (aref s (1+ pos))) "/" "\\")
470 ; (substring s (+ pos 2)))
471 ; pos (1+ pos))))
472 ; s)
417 473
418 474
419 ;;; Hashing for autosave names 475 ;;; Hashing for autosave names
420 476
421 ;;; Hashing function contributed by Andy Norman <ange@hplb.hpl.hp.com> 477 ;;; Hashing function contributed by Andy Norman <ange@hplb.hpl.hp.com>
452 ;; should be used in `auto-save-name-in-same-directory', if anywhere. 508 ;; should be used in `auto-save-name-in-same-directory', if anywhere.
453 ;; -hniksic 509 ;; -hniksic
454 510
455 ;; This leaves two characters that could be used to wrap it in `#' or 511 ;; This leaves two characters that could be used to wrap it in `#' or
456 ;; make two filenames from it: one for autosaving, and another for a 512 ;; make two filenames from it: one for autosaving, and another for a
457 ;; file containing the name of the autosaved filed, to make hashing 513 ;; file containing the name of the autosaved file, to make hashing
458 ;; reversible. 514 ;; reversible.
459 ;(defun auto-save-cyclic-hash-12 (s) 515 ;(defun auto-save-cyclic-hash-12 (s)
460 ; "Outputs the 12-characters ascii hex representation of a 6-bytes 516 ; "Outputs the 12-characters ascii hex representation of a 6-bytes
461 ;cyclic code for burst correction calculated on STRING on a 517 ;cyclic code for burst correction calculated on STRING on a
462 ;byte-by-byte basis. The used polynomial is D^6 + D^5 + D^4 + D^3 +1." 518 ;byte-by-byte basis. The used polynomial is D^6 + D^5 + D^4 + D^3 +1."
516 (cond ((and file (not (file-newer-than-file-p afile file))) 572 (cond ((and file (not (file-newer-than-file-p afile file)))
517 (warn "Autosave file \"%s\" is not current." afile)) 573 (warn "Autosave file \"%s\" is not current." afile))
518 (t 574 (t
519 (incf total) 575 (incf total)
520 (with-output-to-temp-buffer "*Directory*" 576 (with-output-to-temp-buffer "*Directory*"
521 (apply 'call-process "ls" nil standard-output nil 577 (buffer-disable-undo standard-output)
522 "-l" afile (if file (list file)))) 578 (save-excursion
579 (set-buffer "*Directory*")
580 (setq default-directory (file-name-directory afile))
581 (insert-directory afile "-l")
582 (when file
583 (setq default-directory (file-name-directory file))
584 (insert-directory file "-l"))))
523 (if (yes-or-no-p (format "Recover %s from auto save file? " 585 (if (yes-or-no-p (format "Recover %s from auto save file? "
524 (or file "non-file buffer"))) 586 (or file "non-file buffer")))
525 (let* ((obuf (current-buffer))) 587 (let* ((obuf (current-buffer)))
526 (set-buffer (if file 588 (set-buffer (if file
527 (find-file-noselect file t) 589 (find-file-noselect file t)