# HG changeset patch # User Richard M. Stallman # Date 901880681 0 # Node ID 16dcade0dd4acfdc83f2353023af672cbd7b5f8b # Parent 77090a50041721481d42b54a2ed619be85a57ee6 Require timer. (clean-buffer-list-kill-regexps): Match `*vc' buffers. (midnight-find): Use dolist, not loop. (clean-buffer-list-delay): Use assoc-default. (assoc-default): New function. diff -r 77090a500417 -r 16dcade0dd4a lisp/midnight.el --- a/lisp/midnight.el Fri Jul 31 03:21:07 1998 +0000 +++ b/lisp/midnight.el Fri Jul 31 10:24:41 1998 +0000 @@ -36,7 +36,9 @@ ;; keeping `clean-buffer-list-kill-never-buffer-names' and ;; `clean-buffer-list-kill-never-regexps'. -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'timer)) (defgroup midnight nil "Run something every day at midnight." @@ -93,7 +95,7 @@ :type 'integer :group 'midnight) -(defcustom clean-buffer-list-kill-regexps nil +(defcustom clean-buffer-list-kill-regexps '("\\*vc\\.") "*List of regexps saying which buffers will be killed at midnight. If buffer name matches a regexp in the list and the buffer was not displayed in the last `clean-buffer-list-delay-special' seconds, it is killed by @@ -145,23 +147,35 @@ "A stopgap solution to the absence of `find' in ELisp." (if (fboundp 'find) (find el ls :test test :key (or key 'eql)) - (loop for rr in ls when (funcall test el (if key (funcall key rr) rr)) - return rr))) + (dolist (rr ls) + (when (funcall test el (if key (funcall key rr) rr)) + (return rr))))) + +(defun assoc-default (el alist test default) + "Find object EL in a pseudo-alist ALIST. +ALIST is a list of conses or objects. EL is compared (using TEST) with +CAR (or the object itself, if it is not a cons) of elements of ALIST. +When TEST returns non-nil, CDR (or DEFAULT, if the object is not a cons) +of the object is returned. +This is a non-consing analogue of + (cdr (assoc el (mapcar (lambda (el) (if (consp el) el (cons el default))) + alist) + :test test)) +The calling sequence is: (ASSOC-DEFAULT EL ALIST TEST DEFAULT)" + (dolist (rr alist) + (when (funcall test el (if (consp rr) (car rr) rr)) + (return (if (consp rr) (cdr rr) default))))) (defun clean-buffer-list-delay (bn) "Return the delay, in seconds, before this buffer name is auto-killed. Uses `clean-buffer-list-kill-buffer-names', `clean-buffer-list-kill-regexps' `clean-buffer-list-delay-general' and `clean-buffer-list-delay-special'. Autokilling is done by `clean-buffer-list'." - (flet ((ff (ls ts) - (let ((zz (midnight-find - bn ls ts (lambda (xx) (if (consp xx) (car xx) xx))))) - (cond ((consp zz) (cdr zz)) - ((null zz) nil) - (clean-buffer-list-delay-special))))) - (or (ff clean-buffer-list-kill-buffer-names 'string=) - (ff clean-buffer-list-kill-regexps 'string-match) - (* clean-buffer-list-delay-general 24 60 60)))) + (or (assoc-default bn clean-buffer-list-kill-buffer-names 'string= + clean-buffer-list-delay-special) + (assoc-default bn clean-buffer-list-kill-regexps 'string-match + clean-buffer-list-delay-special) + (* clean-buffer-list-delay-general 24 60 60))) (defun clean-buffer-list () "Kill old buffers. @@ -174,8 +188,7 @@ (dolist (buf (buffer-list)) (message "[%s] processing `%s'..." ts buf) (setq bts (buffer-display-time buf) bn (buffer-name buf)) - (unless (or ;; (string-match clean-buffer-list-kill-never bn) - (midnight-find bn clean-buffer-list-kill-never-regexps + (unless (or (midnight-find bn clean-buffer-list-kill-never-regexps 'string-match) (midnight-find bn clean-buffer-list-kill-never-buffer-names 'string-equal)