aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2015-04-27 19:07:51 -0400
committerStefan Monnier2015-04-27 19:07:51 -0400
commitc603274f264d550bbae6b0b5c906dfebb78c7eb3 (patch)
tree3e1aea23518398f21476031664cf5f987e8cbd57
parent66fec8bec4a7333b3d1c6d58b046a62b50bde3d2 (diff)
downloademacs-c603274f264d550bbae6b0b5c906dfebb78c7eb3.tar.gz
emacs-c603274f264d550bbae6b0b5c906dfebb78c7eb3.zip
* lisp/midnight.el: Make it a minor mode. Allow predicates.
* lisp/midnight.el: Use lexical-binding. (midnight-mode): Make it a proper minor mode. (midnight-buffer-display-time): Make arg non-optional. (midnight-find): Remove. (clean-buffer-list-kill-never-regexps) (clean-buffer-list-kill-regexps): Tweak type for new function choice. (clean-buffer-list-delay): Allow clean-buffer-list-kill-regexps to contain functions. (clean-buffer-list): Use cl-find. Allow clean-buffer-list-kill-never-regexps to contain functions.
-rw-r--r--etc/NEWS4
-rw-r--r--lisp/midnight.el95
2 files changed, 51 insertions, 48 deletions
diff --git a/etc/NEWS b/etc/NEWS
index b408b51756f..a505cf2f0e7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -237,6 +237,10 @@ Unicode standards.
237 237
238 238
239* Changes in Specialized Modes and Packages in Emacs 25.1 239* Changes in Specialized Modes and Packages in Emacs 25.1
240** Midnight-mode
241*** `midnight-mode' is a proper minor mode.
242*** clean-buffer-*-regexps can now specify buffers via predicate functions.
243
240** In xterms, killing text now also sets the CLIPBOARD/PRIMARY selection 244** In xterms, killing text now also sets the CLIPBOARD/PRIMARY selection
241in the surrounding GUI (using the OSC-52 escape sequence). This only works 245in the surrounding GUI (using the OSC-52 escape sequence). This only works
242if your xterm supports it and enables the `allowWindowOps' options (disabled 246if your xterm supports it and enables the `allowWindowOps' options (disabled
diff --git a/lisp/midnight.el b/lisp/midnight.el
index dbf0c0289d1..256ab9c06aa 100644
--- a/lisp/midnight.el
+++ b/lisp/midnight.el
@@ -1,4 +1,4 @@
1;;; midnight.el --- run something every midnight, e.g., kill old buffers 1;;; midnight.el --- run something every midnight, e.g., kill old buffers -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc. 3;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
4 4
@@ -36,7 +36,7 @@
36 36
37;;; Code: 37;;; Code:
38 38
39(eval-when-compile (require 'cl-lib)) 39(require 'cl-lib)
40 40
41(defgroup midnight nil 41(defgroup midnight nil
42 "Run something every day at midnight." 42 "Run something every day at midnight."
@@ -48,24 +48,19 @@
48Use `cancel-timer' to stop it and `midnight-delay-set' to change 48Use `cancel-timer' to stop it and `midnight-delay-set' to change
49the time when it is run.") 49the time when it is run.")
50 50
51(defcustom midnight-mode nil 51;;;###autoload
52 "Non-nil means run `midnight-hook' at midnight. 52(define-minor-mode midnight-mode
53Setting this variable outside customize has no effect; 53 "Non-nil means run `midnight-hook' at midnight."
54call `cancel-timer' or `timer-activate' on `midnight-timer' instead." 54 :global t
55 :type 'boolean 55 :initialize #'custom-initialize-default
56 :group 'midnight 56 (if midnight-mode (timer-activate midnight-timer)
57 :require 'midnight 57 (cancel-timer midnight-timer)))
58 :initialize 'custom-initialize-default
59 :set (lambda (symb val)
60 (set symb val) (require 'midnight)
61 (if val (timer-activate midnight-timer)
62 (cancel-timer midnight-timer))))
63 58
64;;; time conversion 59;;; time conversion
65 60
66(defun midnight-buffer-display-time (&optional buffer) 61(defun midnight-buffer-display-time (buffer)
67 "Return the time-stamp of BUFFER, or current buffer, as float." 62 "Return the time-stamp of BUFFER, or current buffer, as float."
68 (with-current-buffer (or buffer (current-buffer)) 63 (with-current-buffer buffer
69 (when buffer-display-time (float-time buffer-display-time)))) 64 (when buffer-display-time (float-time buffer-display-time))))
70 65
71;;; clean-buffer-list stuff 66;;; clean-buffer-list stuff
@@ -76,18 +71,16 @@ The autokilling is done by `clean-buffer-list' when is it in `midnight-hook'.
76Currently displayed and/or modified (unsaved) buffers, as well as buffers 71Currently displayed and/or modified (unsaved) buffers, as well as buffers
77matching `clean-buffer-list-kill-never-buffer-names' and 72matching `clean-buffer-list-kill-never-buffer-names' and
78`clean-buffer-list-kill-never-regexps' are excluded." 73`clean-buffer-list-kill-never-regexps' are excluded."
79 :type 'integer 74 :type 'integer)
80 :group 'midnight)
81 75
82(defcustom clean-buffer-list-delay-special 3600 76(defcustom clean-buffer-list-delay-special 3600
83 "The number of seconds before some buffers become eligible for autokilling. 77 "The number of seconds before some buffers become eligible for autokilling.
84Buffers matched by `clean-buffer-list-kill-regexps' and 78Buffers matched by `clean-buffer-list-kill-regexps' and
85`clean-buffer-list-kill-buffer-names' are killed if they were last 79`clean-buffer-list-kill-buffer-names' are killed if they were last
86displayed more than this many seconds ago." 80displayed more than this many seconds ago."
87 :type 'integer 81 :type 'integer)
88 :group 'midnight)
89 82
90(defcustom clean-buffer-list-kill-regexps '("^\\*Man ") 83(defcustom clean-buffer-list-kill-regexps '("\\`\\*Man ")
91 "List of regexps saying which buffers will be killed at midnight. 84 "List of regexps saying which buffers will be killed at midnight.
92If buffer name matches a regexp in the list and the buffer was not displayed 85If buffer name matches a regexp in the list and the buffer was not displayed
93in the last `clean-buffer-list-delay-special' seconds, it is killed by 86in the last `clean-buffer-list-delay-special' seconds, it is killed by
@@ -96,9 +89,14 @@ If a member of the list is a cons, its `car' is the regexp and its `cdr' is
96the number of seconds to use instead of `clean-buffer-list-delay-special'. 89the number of seconds to use instead of `clean-buffer-list-delay-special'.
97See also `clean-buffer-list-kill-buffer-names', 90See also `clean-buffer-list-kill-buffer-names',
98`clean-buffer-list-kill-never-regexps' and 91`clean-buffer-list-kill-never-regexps' and
99`clean-buffer-list-kill-never-buffer-names'." 92`clean-buffer-list-kill-never-buffer-names'.
100 :type '(repeat (regexp :tag "Regexp matching Buffer Name")) 93
101 :group 'midnight) 94Each element can also be a function instead of a regexp, in which case
95it takes a single argument (a buffer name) and should return non-nil
96if the buffer should be killed by `clean-buffer-list'."
97 :type '(repeat
98 (choice (regexp :tag "Regexp matching Buffer Name")
99 (function :tag "Predicate function"))))
102 100
103(defcustom clean-buffer-list-kill-buffer-names 101(defcustom clean-buffer-list-kill-buffer-names
104 '("*Help*" "*Apropos*" "*Buffer List*" "*Compile-Log*" "*info*" 102 '("*Help*" "*Apropos*" "*Buffer List*" "*Compile-Log*" "*info*"
@@ -112,8 +110,7 @@ the number of seconds to use instead of `clean-buffer-list-delay-special'.
112See also `clean-buffer-list-kill-regexps', 110See also `clean-buffer-list-kill-regexps',
113`clean-buffer-list-kill-never-regexps' and 111`clean-buffer-list-kill-never-regexps' and
114`clean-buffer-list-kill-never-buffer-names'." 112`clean-buffer-list-kill-never-buffer-names'."
115 :type '(repeat (string :tag "Buffer Name")) 113 :type '(repeat (string :tag "Buffer Name")))
116 :group 'midnight)
117 114
118(defcustom clean-buffer-list-kill-never-buffer-names 115(defcustom clean-buffer-list-kill-never-buffer-names
119 '("*scratch*" "*Messages*") 116 '("*scratch*" "*Messages*")
@@ -122,33 +119,34 @@ See also `clean-buffer-list-kill-never-regexps'.
122Note that this does override `clean-buffer-list-kill-regexps' and 119Note that this does override `clean-buffer-list-kill-regexps' and
123`clean-buffer-list-kill-buffer-names' so a buffer matching any of these 120`clean-buffer-list-kill-buffer-names' so a buffer matching any of these
124two lists will NOT be killed if it is also present in this list." 121two lists will NOT be killed if it is also present in this list."
125 :type '(repeat (string :tag "Buffer Name")) 122 :type '(repeat (string :tag "Buffer Name")))
126 :group 'midnight)
127 123
128(defcustom clean-buffer-list-kill-never-regexps '("^ \\*Minibuf-.*\\*$") 124(defcustom clean-buffer-list-kill-never-regexps '("\\` \\*Minibuf-.*\\*\\'")
129 "List of regexp saying which buffers will never be killed at midnight. 125 "List of regexp saying which buffers will never be killed at midnight.
130See also `clean-buffer-list-kill-never-buffer-names'. 126See also `clean-buffer-list-kill-never-buffer-names'.
131Killing is done by `clean-buffer-list'. 127Killing is done by `clean-buffer-list'.
132Note that this does override `clean-buffer-list-kill-regexps' and 128Note that this does override `clean-buffer-list-kill-regexps' and
133`clean-buffer-list-kill-buffer-names' so a buffer matching any of these 129`clean-buffer-list-kill-buffer-names' so a buffer matching any of these
134two lists will NOT be killed if it also matches anything in this list." 130two lists will NOT be killed if it also matches anything in this list.
135 :type '(repeat (regexp :tag "Regexp matching Buffer Name"))
136 :group 'midnight)
137 131
138(defun midnight-find (el ls test &optional key) 132Each element can also be a function instead of a regexp, in which case
139 "A stopgap solution to the absence of `find' in ELisp." 133it takes a single argument (a buffer name) and should return non-nil
140 (cl-dolist (rr ls) 134if the buffer should never be killed by `clean-buffer-list'."
141 (when (funcall test (if key (funcall key rr) rr) el) 135 :type '(repeat
142 (cl-return rr)))) 136 (choice (regexp :tag "Regexp matching Buffer Name")
137 (function :tag "Predicate function"))))
143 138
144(defun clean-buffer-list-delay (name) 139(defun clean-buffer-list-delay (name)
145 "Return the delay, in seconds, before killing a buffer named NAME. 140 "Return the delay, in seconds, before killing a buffer named NAME.
146Uses `clean-buffer-list-kill-buffer-names', `clean-buffer-list-kill-regexps' 141Uses `clean-buffer-list-kill-buffer-names', `clean-buffer-list-kill-regexps'
147`clean-buffer-list-delay-general' and `clean-buffer-list-delay-special'. 142`clean-buffer-list-delay-general' and `clean-buffer-list-delay-special'.
148Autokilling is done by `clean-buffer-list'." 143Autokilling is done by `clean-buffer-list'."
149 (or (assoc-default name clean-buffer-list-kill-buffer-names 'string= 144 (or (assoc-default name clean-buffer-list-kill-buffer-names #'string=
150 clean-buffer-list-delay-special) 145 clean-buffer-list-delay-special)
151 (assoc-default name clean-buffer-list-kill-regexps 'string-match 146 (assoc-default name clean-buffer-list-kill-regexps
147 (lambda (re str)
148 (if (functionp re)
149 (funcall re str) (string-match re str)))
152 clean-buffer-list-delay-special) 150 clean-buffer-list-delay-special)
153 (* clean-buffer-list-delay-general 24 60 60))) 151 (* clean-buffer-list-delay-general 24 60 60)))
154 152
@@ -172,10 +170,13 @@ lifetime, i.e., its \"age\" when it will be purged."
172 (setq bts (midnight-buffer-display-time buf) bn (buffer-name buf) 170 (setq bts (midnight-buffer-display-time buf) bn (buffer-name buf)
173 delay (if bts (- tm bts) 0) cbld (clean-buffer-list-delay bn)) 171 delay (if bts (- tm bts) 0) cbld (clean-buffer-list-delay bn))
174 (message "[%s] `%s' [%s %d]" ts bn (if bts (round delay)) cbld) 172 (message "[%s] `%s' [%s %d]" ts bn (if bts (round delay)) cbld)
175 (unless (or (midnight-find bn clean-buffer-list-kill-never-regexps 173 (unless (or (cl-find bn clean-buffer-list-kill-never-regexps
176 'string-match) 174 :test (lambda (bn re)
177 (midnight-find bn clean-buffer-list-kill-never-buffer-names 175 (if (functionp re)
178 'string-equal) 176 (funcall re bn)
177 (string-match re bn))))
178 (cl-find bn clean-buffer-list-kill-never-buffer-names
179 :test #'string-equal)
179 (get-buffer-process buf) 180 (get-buffer-process buf)
180 (and (buffer-file-name buf) (buffer-modified-p buf)) 181 (and (buffer-file-name buf) (buffer-modified-p buf))
181 (get-buffer-window buf 'visible) (< delay cbld)) 182 (get-buffer-window buf 'visible) (< delay cbld))
@@ -190,8 +191,7 @@ lifetime, i.e., its \"age\" when it will be purged."
190(defcustom midnight-hook '(clean-buffer-list) 191(defcustom midnight-hook '(clean-buffer-list)
191 "The hook run `midnight-delay' seconds after midnight every day. 192 "The hook run `midnight-delay' seconds after midnight every day.
192The default value is `clean-buffer-list'." 193The default value is `clean-buffer-list'."
193 :type 'hook 194 :type 'hook)
194 :group 'midnight)
195 195
196(defun midnight-next () 196(defun midnight-next ()
197 "Return the number of seconds till the next midnight." 197 "Return the number of seconds till the next midnight."
@@ -209,7 +209,7 @@ to its second argument TM."
209 (when (timerp midnight-timer) (cancel-timer midnight-timer)) 209 (when (timerp midnight-timer) (cancel-timer midnight-timer))
210 (setq midnight-timer 210 (setq midnight-timer
211 (run-at-time (if (numberp tm) (+ (midnight-next) tm) tm) 211 (run-at-time (if (numberp tm) (+ (midnight-next) tm) tm)
212 midnight-period 'run-hooks 'midnight-hook))) 212 midnight-period #'run-hooks 'midnight-hook)))
213 213
214(defcustom midnight-delay 3600 214(defcustom midnight-delay 3600
215 "The number of seconds after the midnight when the `midnight-timer' is run. 215 "The number of seconds after the midnight when the `midnight-timer' is run.
@@ -218,8 +218,7 @@ set it by calling `midnight-delay-set', or use `custom'.
218If you wish, you can use a string instead, it will be passed as the 218If you wish, you can use a string instead, it will be passed as the
219first argument to `run-at-time'." 219first argument to `run-at-time'."
220 :type 'sexp 220 :type 'sexp
221 :set 'midnight-delay-set 221 :set #'midnight-delay-set)
222 :group 'midnight)
223 222
224(provide 'midnight) 223(provide 'midnight)
225 224