Sync to HEAD

1 files changed, 64 insertions, 0 deletions

diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index 3211a055335..3e40f118a41 100644
--- 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
@@ -238,4 +301,5 @@ To save places automatically in all files, put this in your `.emacs' file:
 
 (provide 'saveplace) ; why not...
 
+;;; arch-tag: 3c2ef47b-0a22-4558-b116-118c9ef454a0
 ;;; saveplace.el ends here