(save-place-forget-unreadable-files)

[bpt/emacs.git] / lisp / saveplace.el

diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index d8706de..3e40f11 100644 (file)
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -94,6 +94,40 @@ value of `version-control'."
                 (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,12 +172,41 @@ To save places automatically in all files, put this in your `.emacs' file:
                    (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