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

[Stephen Compall]

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