[PATCH]saveplace.el: forget unreadable files (again)

[Stephen Compall]

* Bug

lisp/saveplace.el: save-place-alist contains entries for files that may
not be readable anymore.

You get rid of files, you don't want saveplace to save places in them
anymore.

* Fix

This is a patch to lisp/saveplace.el 1.25, Tue Mar 25 19:32:39 2003.

This filters save-place-alist when saving the alist to file against
`file-readable-p'.  However, first it checks the filename against
save-place-skip-check-regexp; if it matches, its fate depends on
save-place-save-skipped, and file-readable-p is *not* run against the
file.  This solves the problem of slow, removable, and network drives.
The default regexp in this patch is based on common removable mount
points in various GNU/Linux distributions and the ange-ftp-name-format
regexp.

Glenn Morris suggested using the readability checks in recentf instead
of this new implementation.  However, the recentf method -- checking
only a buffer's file name only when killing said buffer -- does not
work for the IMHO more common case of deleting a file, etc *after*
killing its buffer.

As the filter is now filtered, forgetting is now enabled by default.

Tested in GNU Emacs 21.3.

*** /cdrom/emacs-cvs/lisp/saveplace.el  Tue Mar 25 13:32:39 2003
--- /home/sirian/ide/emacs/saveplace.el Fri Dec 19 01:17:44 2003
***************
*** 94,99 ****
--- 94,133 ----
                 (const :tag "No Limit" nil))
    :group 'save-place)
  
+ (defcustom save-place-forget-unreadable-files t
+   "Non-nil means forget place in unreadable files.
+ 
+ The filenames in `save-place-alist' that do not match
+ `save-place-skip-check-regexp' are filtered through
+ `file-readable-p'. if nil, their alist entries are removed.
+ 
+ You may do this anytime by calling the complementary function,
+ `save-place-forget-unreadable-files'.  When this option is turned on,
+ this happens automatically before saving `save-place-alist' to
+ `save-place-file'."
+   :type 'boolean :group 'save-place)
+ 
+ (defcustom save-place-save-skipped t
+   "If non-nil, remember files matching `save-place-skip-check-regexp'.
+ 
+ When filtering `save-place-alist' for unreadable files, some will not
+ be checked, based on said regexp, and instead saved or forgotten based
+ on this flag."
+   :type 'boolean :group 'save-place)
+ 
+ (defcustom save-place-skip-check-regexp
+   ;; thanks to ange-ftp-name-format
+   "\\`/\\(?:cdrom\\|floppy\\|mnt\\|\\(?:[^@/:]*@\\)?[^@/:]*[^@/:.]:\\)"
+   "Regexp whose file names shall not be checked for readability.
+ 
+ When forgetting unreadable files, file names matching this regular
+ expression shall not be checked for readability, but instead be
+ subject to `save-place-save-skipped'.
+ 
+ Files for which such a check may be inconvenient include those on
+ removable and network volumes."
+   :type 'regexp :group 'save-place)
+ 
  (defun toggle-save-place (&optional parg)
    "Toggle whether to save your place in this file between sessions.
  If this mode is enabled, point is recorded when you kill the buffer
***************
*** 138,149 ****
--- 172,212 ----
                    (cons (cons buffer-file-name position)
                          save-place-alist)))))))
  
+ (defun save-place-forget-unreadable-files ()
+   "Remove unreadable files from `save-place-alist'.
+ For each entry in the alist, if `file-readable-p' returns nil for the
+ filename, remove the entry.  Save the new alist \(as the first pair
+ may have changed\) back to `save-place-alist'."
+   (interactive)
+   ;; the following was adapted from an in-place filtering function,
+   ;; `filter-mod', used in the original.
+   (unless (null save-place-alist)     ;says it better than `when'
+     ;; first, check all except first
+     (let ((fmprev save-place-alist) (fmcur (cdr save-place-alist)))
+       (while fmcur                    ;not null
+       ;; a value is only saved when it becomes FMPREV.
+       (if (if (string-match save-place-skip-check-regexp (caar fmcur))
+               save-place-save-skipped
+             (file-readable-p (caar fmcur)))
+           (setq fmprev fmcur)
+         (setcdr fmprev (cdr fmcur)))
+       (setq fmcur (cdr fmcur))))
+     ;; test first pair, keep it if OK, otherwise 2nd element, which
+     ;; may be '()
+     (unless (if (string-match save-place-skip-check-regexp
+                             (caar save-place-alist))
+               save-place-save-skipped
+             (file-readable-p (caar save-place-alist)))
+       (setq save-place-alist (cdr save-place-alist)))))
+ 
  (defun save-place-alist-to-file ()
    (let ((file (expand-file-name save-place-file)))
      (save-excursion
        (message "Saving places to %s..." file)
        (set-buffer (get-buffer-create " *Saved Places*"))
        (delete-region (point-min) (point-max))
+       (when save-place-forget-unreadable-files
+       (save-place-forget-unreadable-files))
        (print save-place-alist (current-buffer))
        (let ((version-control
               (cond


--
Stephen Compall or s11 or sirian

Politics and the fate of mankind are formed by men without ideals and without
greatness.  Those who have greatness within them do not go in for politics.
                -- Albert Camus

[Hello to all my friends and fans in domestic surveillance] ASPIC
ASDIC anarchy clones ASLET Freeh Audiotel secure dictionary Firefly
Ft. Knox AMEMB enforcers ammunition