diff lisp/packages/auto-save.el @ 100:4be1180a9e89 r20-1b2

Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 131b0175ea99
children cca96a509cfe
line wrap: on
line diff
--- a/lisp/packages/auto-save.el	Mon Aug 13 09:13:58 2007 +0200
+++ b/lisp/packages/auto-save.el	Mon Aug 13 09:15:11 2007 +0200
@@ -1,96 +1,101 @@
-;;; auto-save.el --- safer auto saving with support for ange-ftp and /tmp
-
-(defconst auto-save-version "cvs ate me")
-
-;;;; Copyright (C) 1992, 1993, 1994 by Sebastian Kremer <sk@thp.uni-koeln.de>
-;;;; Modified by jwz
+;; -*- Emacs-Lisp -*-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; File:          auto-save.el
+;; Version:       $Revision: 1.2 $
+;; RCS:           
+;; Description:   Safer autosaving with support for efs and /tmp.
+;;                This version of auto-save is designed to work with efs,
+;;                instead of ange-ftp.
+;; Author:        Sebastian Kremer <sk@thp.uni-koeln.de>,
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+(defconst auto-save-version (substring "$Revision: 1.2 $" 11 -2)
+  "Version number of auto-save.")
 
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
+;;; Copyright (C) 1992 by Sebastian Kremer <sk@thp.uni-koeln.de>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 1, or (at your option)
+;;; any later version.
 
-;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the 
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
 
-;;; Synched up with: Not in FSF.
-
-;;;; LISPDIR ENTRY for the Elisp Archive ===============================
-;;;;    LCD Archive Entry:
-;;;;    auto-save|Sebastian Kremer|sk@thp.uni-koeln.de
-;;;;    |safer auto saving with support for ange-ftp and /tmp
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 ;;;; OVERVIEW ==========================================================
 
-;;;; Combines autosaving for ange-ftp (to a local or remote directory)
-;;;; with the ability to do autosaves to a fixed directory on a local
-;;;; disk, in case NFS is slow.  The auto-save file used for
-;;;;     /usr/foo/bar/baz.txt
-;;;; will be
-;;;;     AUTOSAVE/#\!usr\!foo\!bar\!baz.txt#
-;;;; assuming AUTOSAVE is the non-nil value of the variable
-;;;; `auto-save-directory'.
+;;; Combines autosaving for efs (to a local or remote directory)
+;;; with the ability to do autosaves to a fixed directory on a local
+;;; disk, in case NFS is slow.  The auto-save file used for
+;;;     /usr/foo/bar/baz.txt
+;;; will be
+;;;     AUTOSAVE/#\!usr\!foo\!bar\!baz.txt#
+;;; assuming AUTOSAVE is the non-nil value of the variable
+;;; `auto-save-directory'.
 
-;;;; Takes care that autosave files for non-file-buffers (e.g. *mail*)
-;;;; from two simultaneous Emacses don't collide.
+;;; Takes care that autosave files for non-file-buffers (e.g. *mail*)
+;;; from two simultaneous Emacses don't collide.
 
-;;;; Autosaves even if the current directory is not writable.
+;;; Autosaves even if the current directory is not writable.
 
-;;;; Can limit autosave names to 14 characters using a hash function,
-;;;; see `auto-save-hash-p'.
+;;; Can limit autosave names to 14 characters using a hash function,
+;;; see `auto-save-hash-p'.
 
-;;;; See `auto-save-directory' and `make-auto-save-file-name' and
-;;;; references therein for complete documentation.
+;;; See `auto-save-directory' and `make-auto-save-file-name' and
+;;; references therein for complete documentation.
 
-;;;; Meta-x recover-all-files will effectively do recover-file on all
-;;;; files whose autosave file is newer (one of the benefits of having
-;;;; all autosave files in the same place).
+;;; Meta-x recover-all-files will effectively do recover-file on all
+;;; files whose autosave file is newer (one of the benefits of having
+;;; all autosave files in the same place).
 
 ;;;; INSTALLATION ======================================================
 
-;;;; Put this file into your load-path and the following in your ~/.emacs:
+;;; Put this file into your load-path and the following in your ~/.emacs:
 
-;;;; If you want to autosave in the fixed directory /tmp/USER-autosave/
-;;;; (setq auto-save-directory
-;;;;       (concat "/tmp/" (user-login-name) "-autosave/"))
+;;; If you want to autosave in the fixed directory /tmp/USER-autosave/
+;;; (setq auto-save-directory
+;;;       (concat "/tmp/" (user-login-name) "-autosave/"))
 
-;;;; If you don't want to save in /tmp (e.g., because it is swap
-;;;; mounted) but rather in ~/autosave/
-;;;;   (setq auto-save-directory (expand-file-name "~/autosave/"))
+;;; If you don't want to save in /tmp (e.g., because it is swap
+;;; mounted) but rather in ~/autosave/
+;;;   (setq auto-save-directory (expand-file-name "~/autosave/"))
 
-;;;; If you want to save each file in its own directory (the default)
-;;;;   (setq auto-save-directory nil)
-;;;; You still can take advantage of autosaving ange-ftp remote files
-;;;; in a fixed local directory, `auto-save-directory-fallback' will
-;;;; be used.
+;;; If you want to save each file in its own directory (the default)
+;;;   (setq auto-save-directory nil)
+;;; You still can take advantage of autosaving efs remote files
+;;; in a fixed local directory, `auto-save-directory-fallback' will
+;;; be used.
 
-;;;; If you want to use 14 character hashed autosave filenames
-;;;;   (setq auto-save-hash-p t)
+;;; If you want to use 14 character hashed autosave filenames
+;;;   (setq auto-save-hash-p t)
 
-;;;; Finally, put this line after the others in your ~/.emacs:
-;;;;   (require 'auto-save)
+;;; Finally, put this line after the others in your ~/.emacs:
+;;;   (require 'auto-save)
 
 
 ;;;; ACKNOWLEDGEMENT ===================================================
 
-;;;; This code is loosely derived from autosave-in-tmp.el by Jamie
-;;;; Zawinski <jwz@lucid.com> (the version I had was last modified 22
-;;;; dec 90 jwz) and code submitted to ange-ftp-lovers on Sun, 5 Apr
-;;;; 92 23:20:47 EDT by drw@BOURBAKI.MIT.EDU (Dale R. Worley).
-;;;; auto-save.el tries to cover the functionality of those two
-;;;; packages.
+;;; This code is loosely derived from autosave-in-tmp.el by Jamie
+;;; Zawinski <jwz@lucid.com> (the version I had was last modified 22
+;;; dec 90 jwz) and code submitted to ange-ftp-lovers on Sun, 5 Apr
+;;; 92 23:20:47 EDT by drw@BOURBAKI.MIT.EDU (Dale R. Worley).
+;;; auto-save.el tries to cover the functionality of those two
+;;; packages.
 
-;;;; Valuable comments and help from Dale Worley, Andy Norman, Jamie
-;;;; Zawinski and Sandy Rutherford are gratefully acknowledged.
+;;; Valuable comments and help from Dale Worley, Andy Norman, Jamie
+;;; Zawinski and Sandy Rutherford are gratefully acknowledged.
+
+;;;; PROVISION ========================================================
+
+(provide 'auto-save)
 
 ;;;; CUSTOMIZATION =====================================================
 
@@ -119,8 +124,8 @@
 and thus vanishes after a reboot, or if your system is particularly
 thorough when cleaning up /tmp, clearing even non-empty subdirectories.
 
-It should never be an ange-ftp remote filename because that would
-defeat `ange-ftp-auto-save-remotely'.
+It should never be an efs remote filename because that would
+defeat `efs-auto-save-remotely'.
 
 Unless you set `auto-save-hash-p', you shouldn't set this to a
 directory in a filesystem that does not support long filenames, since
@@ -134,8 +139,8 @@
 
 as auto save file.
 
-See also variables `auto-save-directory-fallback', `auto-save-hash-p',
-`ange-ftp-auto-save' and `ange-ftp-auto-save-remotely'.")
+See also variables `auto-save-directory-fallback',
+`efs-auto-save' and `efs-auto-save-remotely'.")
 
 (defvar auto-save-hash-p nil
   "If non-nil, hashed autosave names of length 14 are used.
@@ -145,26 +150,15 @@
 Hashing defeats `recover-all-files', you have to recover files
 individually by doing `recover-file'.")
 
-;;; This defvar is in ange-ftp.el now, but for older versions it
-;;; doesn't hurt to give it here as well so that loading auto-save.el
-;;; does not abort.
-(defvar ange-ftp-auto-save 0
-  "If 1, allows ange-ftp files to be auto-saved.
-If 0, suppresses auto-saving of ange-ftp files.
-Don't use any other value.")
+;;; This defvar is in efs.el now, but doesn't hurt to give it here as
+;;; well so that loading first auto-save.el does not abort.
+(or (boundp 'efs-auto-save) (defvar efs-auto-save 0))
+(or (boundp 'efs-auto-save-remotely) (defvar efs-auto-save-remotely nil))
 
-(defvar ange-ftp-auto-save-remotely nil
-  "*If non-nil, causes the auto-save file for an ange-ftp file to be written in
-the remote directory containing the file, rather than in a local directory.
-
-For remote files, this being true overrides a non-nil
-`auto-save-directory'.  Local files are unaffected.
-
-If you want to use this feature, you probably only want to set this
-true in a few buffers, rather than globally.  You might want to give
-each buffer its own value using `make-variable-buffer-local'.
-
-See also variable `ange-ftp-auto-save'.")
+(defvar auto-save-offer-delete nil
+  "*If non-nil, `recover-all-files' offers to delete autosave files
+that are out of date or were dismissed for recovering.
+Special value 'always deletes those files silently.")
 
 ;;;; end of customization
 
@@ -174,7 +168,7 @@
 (defvar auto-save-directory-fallback (expand-file-name "~/autosave/")
   ;; not user-variable-p, see above
   "Directory used for local autosaving of remote files if
-both `auto-save-directory' and `ange-ftp-auto-save-remotely' are nil.
+both `auto-save-directory' and `efs-auto-save-remotely' are nil.
 Also used if a working directory to be used for autosaving is not writable.
 This *must* always be the name of directory that exists or can be
 created by you, never nil.")
@@ -198,10 +192,6 @@
 	(if (fboundp 'make-directory)	; V19 or tree dired
 	    (make-directory dir)
 	  (call-process "mkdir" nil nil nil dir))
-	;; This is 1300, aka "d-wx-----T"
-	;; The sticky bit means that you can only delete your own files,
-	;; even if you have write permission in the directory (which is
-	;; moot, since the directory is only writable by owner.)
 	(set-file-modes dir (* 7 8 8))))))
 
 (mapcar (function auto-save-check-directory)
@@ -224,11 +214,15 @@
 autosave files can then be recovered at once with function
 `recover-all-files'.
 
-Takes care to make autosave files for files accessed through ange-ftp
-be local files if variable `ange-ftp-auto-save-remotely' is nil.
+Takes care to make autosave files for files accessed through efs
+be local files if variable `efs-auto-save-remotely' is nil.
 
 Takes care of slashes in buffer names to prevent autosave errors.
 
+Takes care that autosave files for buffers not visiting any file (such
+as `*mail*') from two simultaneous Emacses don't collide by prepending
+the Emacs pid.
+
 Uses 14 character autosave names if `auto-save-hash-p' is true.
 
 Autosaves even if the current directory is not writable, using
@@ -242,9 +236,12 @@
   ;; would fail for each new file).
 
   (condition-case error-data
-      (let* ((file-name (or (and (boundp 'buffer-file-truename) ; From jwz,
-				 buffer-file-truename) ; for Emacs 19?
-			    buffer-file-name))
+      (let* ((file-name (or (and (boundp 'buffer-file-truename)
+				 buffer-file-truename
+				 ;; Make sure that the file name is expanded.
+				 (expand-file-name buffer-file-name))
+			    (and buffer-file-name
+				 (expand-file-name buffer-file-name))))
 	     ;; So autosavename looks like #%...#, roughly as with the
 	     ;; old make-auto-save-file-name function.  The
 	     ;; make-temp-name inserts the pid of this Emacs: this
@@ -253,42 +250,32 @@
 	     ;; the next Emacs session (the one after the crash) the
 	     ;; pid will be different, but file-less buffers like
 	     ;; *mail* must be recovered manually anyway.
-
-	     ;; jwz: putting the emacs PID in the auto-save file name is bad
-	     ;; news, because that defeats auto-save-recovery of *mail*
-	     ;; buffers -- the (sensible) code in sendmail.el calls
-	     ;; (make-auto-save-file-name) to determine whether there is
-	     ;; unsent, auto-saved mail to recover. If that mail came from a
-	     ;; previous emacs process (far and away the most likely case)
-	     ;; then this can never succeed as the pid differs.
-;;	     (name-prefix (if file-name nil (make-temp-name "#%")))
-	     (name-prefix (if file-name nil "#%"))
-
+	     (name-prefix (if file-name nil (make-temp-name "#%")))
 	     (save-name (or file-name
 			    ;; Prevent autosave errors.  Buffername
 			    ;; (to become non-dir part of filename) will
 			    ;; be unslashified twice.  Don't care.
 			    (auto-save-unslashify-name (buffer-name))))
 	     (remote-p (and (stringp file-name)
-			    (fboundp 'ange-ftp-ftp-path)
-			    (ange-ftp-ftp-path file-name))))
+			    (fboundp 'efs-ftp-path)
+			    (efs-ftp-path file-name))))
 	;; Return the appropriate auto save file name:
 	(expand-file-name;; a buffername needs this, a filename not
 	 (if remote-p
-	     (if ange-ftp-auto-save-remotely
+	     (if efs-auto-save-remotely
 		 (auto-save-name-in-same-directory save-name)
 	       ;; We have to use the `fixed-directory' now since the
 	       ;; `same-directory' would be remote.
 	       ;; It will use the fallback if needed.
 	       (auto-save-name-in-fixed-directory save-name))
 	   ;; Else it is a local file (or a buffer without a file, hence
-	   ;; the name-prefix).
+	       ;; the name-prefix).
 	   ;; Hashed files always go into the special hash dir, never
 	   ;; in the same directory, to make recognizing reliable.
 	   (if (or auto-save-directory auto-save-hash-p)
 	       (auto-save-name-in-fixed-directory save-name name-prefix)
 	     (auto-save-name-in-same-directory save-name name-prefix)))))
-
+    
     ;; If any error occurs in the above code, return what the old
     ;; version of this function would have done.  It is not ok to
     ;; return nil, e.g., when after-find-file tests
@@ -396,15 +383,16 @@
 
 (defun auto-save-cyclic-hash-14 (s)
   ;;   "Hash string S into a string of length 14.
+  ;; A 7-bytes cyclic code for burst correction is calculated on a
+  ;; byte-by-byte basis. The polynomial used is D^7 + D^6 + D^3 +1.
   ;; The resulting string consists of hexadecimal digits [0-9a-f].
   ;; In particular, it contains no slash, so it can be used as autosave name."
-  (let ((crc (make-string 8 0))
+  (let ((crc (make-string 7 0))
 	result)
     (mapcar
      (function
       (lambda (new)
-	(setq new (+ new (aref crc 7)))
-	(aset crc 7 (aref crc 6))
+	(setq new (+ new (aref crc 6)))
 	(aset crc 6 (+ (aref crc 5) new))
 	(aset crc 5 (aref crc 4))
 	(aset crc 4 (aref crc 3))
@@ -420,22 +408,55 @@
 			 (aref crc 3)
 			 (aref crc 4)
 			 (aref crc 5)
-			 (aref crc 6)
-			 (aref crc 7)))
+			 (aref crc 6)))
     result))
 
+;; This leaves two characters that could be used to wrap it in `#' or
+;; make two filenames from it: one for autosaving, and another for a
+;; file containing the name of the autosaved filed, to make hashing
+;; reversible.
+(defun auto-save-cyclic-hash-12 (s)
+  "Outputs the 12-characters ascii hex representation of a 6-bytes
+cyclic code for burst correction calculated on STRING on a
+byte-by-byte basis. The used polynomial is D^6 + D^5 + D^4 + D^3 +1."
+  (let ((crc (make-string 6 0)))
+    (mapcar
+     (function
+      (lambda (new)
+        (setq new (+ new (aref crc 5)))
+        (aset crc 5 (+ (aref crc 4) new))
+        (aset crc 4 (+ (aref crc 3) new))
+        (aset crc 3 (+ (aref crc 2) new))
+        (aset crc 2 (aref crc 1))
+        (aset crc 1 (aref crc 0))
+        (aset crc 0 new)))
+     s)
+    (format "%02x%02x%02x%02x%02x%02x"
+            (aref crc 0)
+            (aref crc 1)
+            (aref crc 2)
+            (aref crc 3)
+            (aref crc 4)
+            (aref crc 5))))
+
 
 
 ;;; Recovering files
 
-;; jwz: changed this to also offer to recover auto-saved buffers which
-;; had no associated file name (such as sendmail buffers.)
-(defun recover-all-files ()
+(defun recover-all-files (&optional silent)
   "Do recover-file for all autosave files which are current.
 Only works if you have a non-nil `auto-save-directory'.
+
+Optional prefix argument SILENT means to be silent about non-current
+autosave files.  This is useful if invoked automatically at Emacs
+startup.
+
+If `auto-save-offer-delete' is t, this function will offer to delete
+old or rejected autosave files.
+
 Hashed files (see `auto-save-hash-p') are not understood, use
 `recover-file' to recover them individually."
-  (interactive)
+  (interactive "P")
   (let ((savefiles (directory-files auto-save-directory t "^#"))
 	afile				; the auto save file
 	file				; its original file
@@ -455,10 +476,10 @@
 	    (t
 	     (setq total (1+ total))
 	     (with-output-to-temp-buffer "*Directory*"
-	       (apply 'call-process "ls" nil standard-output nil
-		      "-l" afile (if file (list file))))
+	       (call-process "ls" nil standard-output nil
+			     "-l" afile (if file (list file))))
 	     (if (yes-or-no-p (format "Recover %s from auto save file? "
-				      (or file "non-file buffer")))
+				      file))
 		 (let* ((obuf (current-buffer))
 			(buf (set-buffer
 			      (if file
@@ -476,10 +497,17 @@
 Auto-save off in buffer \"%s\" till you do M-x auto-save-mode."
 			    (buffer-name))
 		   (set-buffer obuf)
-		   (sit-for 1))))))
+		   (sit-for 1))
+	       ;; If not used for recovering, offer to delete
+	       ;; autosave file
+	       (and auto-save-offer-delete
+		    (or (eq 'always auto-save-offer-delete)
+			(yes-or-no-p
+			 (format "Delete autosave file for `%s'? " file)))
+		    (delete-file afile))))))
     (if (zerop total)
-	(message "Nothing to recover.")
+	(or silent (message "Nothing to recover."))
       (message "%d/%d file%s recovered." count total (if (= count 1) "" "s"))))
   (if (get-buffer "*Directory*") (kill-buffer "*Directory*")))
 
-(provide 'auto-save)
+;;; end of auto-save.el