[PATCH]saveplace.el: only check part of save-place-alist

[Stephen Compall <s11@member.fsf.org>]

I apologize if this is a duplicate.

* Bug

If your save-place-alist is long, running
save-place-forget-unreadable-files can take a while.  This slows down
exit.

* Patch

Just check the last `save-place-check-limit' of the list, if the
optional argument is given.  The exit hook uses the argument.

2004-08-28  Stephen Compall  <s11@member.fsf.org>

	* saveplace.el (save-place-check-limit): New defcustom.
	(save-place-nfilter): New function.
	(save-place-forget-unreadable-files): Use said nfilter.  If
	optional limit argument given, only check that many, from the
	end, and move them to the front of the list.
	(save-place-alist-to-file): Use s-p-f-u-f optional limit arg.

*** lisp/saveplace.el	8 Jun 2004 00:36:04 -0000	1.28
--- lisp/saveplace.el	29 Aug 2004 00:48:29 -0000
***************
*** 107,112 ****
--- 107,123 ----
  `save-place-file'."
    :type 'boolean :group 'save-place)
  
+ (defcustom save-place-check-limit 20
+   "Maximum entries to check for readability; nil means no limit.
+ 
+ `save-place-alist-to-file' uses this to limit the checking of
+ function `save-place-forget-unreadable-files' to this many elements
+ at the end of `save-place-alist'.  The most common case of this is at
+ Emacs exit, in function `save-place-kill-emacs-hook'."
+   :type '(choice (integer :tag "Tail entries")
+ 		 (const :tag "No Limit" nil))
+   :group 'save-place)
+ 
  (defcustom save-place-save-skipped t
    "If non-nil, remember files matching `save-place-skip-check-regexp'.
  
***************
*** 172,203 ****
  		    (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)))
--- 183,237 ----
  		    (cons (cons buffer-file-name position)
  			  save-place-alist)))))))
  
! (defun save-place-nfilter (nfpred nflst)
!   "Destructively remove elements from NFLST for whom NFPRED answers nil.
! 
! You must save the return value, because the first pair may have
! been \"removed\" from the list."
!   (if nflst
!       (let ((nfprev nflst))
! 	(while (cdr nfprev)
! 	  (if (funcall nfpred (cadr nfprev))
! 	      (setq nfprev (cdr nfprev))
! 	    (setcdr nfprev (cddr nfprev))))
! 	(if (funcall nfpred (car nflst))
! 	    nflst
! 	  (cdr nflst)))
!     nflst))
! 
! (defun save-place-forget-unreadable-files (&optional limit)
    "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'.
! 
! If LIMIT is given, and is a positive integer, only check the
! last LIMIT elements, and move them to the front of the list."
    (interactive)
!   ;; it's just too much of a pain without grabbing the length first.
!   ;; But in case it's not needed, we short-circuit here with LIMIT so
!   ;; (< limit llen) fails.
!   (let ((llen (if (and (integerp limit) (< 0 limit))
! 		  (length save-place-alist)
! 		limit))
! 	(remember-p-proc		;element filter predicate
! 	 #'(lambda (fent)
! 	     (if (string-match save-place-skip-check-regexp (car fent))
! 		 save-place-save-skipped
! 	       (file-readable-p (car fent))))))
!     (if (and (integerp limit) (< limit llen))
! 	;; check LIMIT elts, and move remaining to front of list
! 	(let* ((new-tail (nthcdr (- llen limit 1) save-place-alist))
! 	       (new-head
! 		(save-place-nfilter remember-p-proc (cdr new-tail)))
! 	       (inhibit-quit t))
! 	  ;; without inhibit-quit, if these ops are in this order, you
! 	  ;; might lose all of new-head.  If in the reverse order,
! 	  ;; s-p-a might end up circular, and that can't be good.
! 	  (setcdr new-tail nil)
! 	  (setq save-place-alist (nconc new-head save-place-alist)))
!       (setq save-place-alist		;filter entire list
! 	    (save-place-nfilter remember-p-proc save-place-alist)))))
  
  (defun save-place-alist-to-file ()
    (let ((file (expand-file-name save-place-file)))
***************
*** 206,212 ****
        (set-buffer (get-buffer-create " *Saved Places*"))
        (delete-region (point-min) (point-max))
        (when save-place-forget-unreadable-files
! 	(save-place-forget-unreadable-files))
        (let ((print-length nil)
              (print-level nil))
          (print save-place-alist (current-buffer)))
--- 240,246 ----
        (set-buffer (get-buffer-create " *Saved Places*"))
        (delete-region (point-min) (point-max))
        (when save-place-forget-unreadable-files
! 	(save-place-forget-unreadable-files save-place-check-limit))
        (let ((print-length nil)
              (print-level nil))
          (print save-place-alist (current-buffer)))

--
Stephen Compall or s11 or sirian

Q:	What is printed on the bottom of beer bottles in Minnesota?
A:	Open other end.

eavesdropping Perl-RSA Sundevil top secret Leitrim monarchist Baranyi
Vickie Weaver SAFE TWA halcon BRLO threat number key jihad