Commit | Line | Data |
---|---|---|
fffa137c | 1 | ;;; gnus-demon.el --- daemonic Gnus behavior |
23f87bed | 2 | |
ba318903 | 3 | ;; Copyright (C) 1995-2014 Free Software Foundation, Inc. |
eec82323 | 4 | |
6748645f | 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
eec82323 LMI |
6 | ;; Keywords: news |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
5e809f55 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
eec82323 | 11 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
eec82323 LMI |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
eec82323 LMI |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;;; Code: | |
26 | ||
7df7482d RS |
27 | (eval-when-compile (require 'cl)) |
28 | ||
eec82323 LMI |
29 | (require 'gnus) |
30 | (require 'gnus-int) | |
31 | (require 'nnheader) | |
6748645f LMI |
32 | (require 'nntp) |
33 | (require 'nnmail) | |
498063ec | 34 | |
eec82323 | 35 | (defgroup gnus-demon nil |
4525646f | 36 | "Demonic behavior." |
eec82323 LMI |
37 | :group 'gnus) |
38 | ||
39 | (defcustom gnus-demon-handlers nil | |
40 | "Alist of daemonic handlers to be run at intervals. | |
41 | Each handler is a list on the form | |
42 | ||
43 | \(FUNCTION TIME IDLE) | |
44 | ||
84acb2f6 JD |
45 | FUNCTION is the function to be called. TIME is the number of |
46 | `gnus-demon-timestep's between each call. | |
47 | If nil, never call. If t, call each `gnus-demon-timestep'. | |
48 | ||
49 | If IDLE is t, only call each time Emacs has been idle for TIME. | |
50 | If IDLE is a number, only call when Emacs has been idle more than | |
51 | this number of `gnus-demon-timestep's. | |
52 | If IDLE is nil, don't care about idleness. | |
53 | If IDLE is a number and TIME is nil, then call once each time | |
54 | Emacs has been idle for IDLE `gnus-demon-timestep's." | |
eec82323 LMI |
55 | :group 'gnus-demon |
56 | :type '(repeat (list function | |
57 | (choice :tag "Time" | |
58 | (const :tag "never" nil) | |
59 | (const :tag "one" t) | |
60 | (integer :tag "steps" 1)) | |
61 | (choice :tag "Idle" | |
62 | (const :tag "don't care" nil) | |
63 | (const :tag "for a while" t) | |
64 | (integer :tag "steps" 1))))) | |
65 | ||
66 | (defcustom gnus-demon-timestep 60 | |
84acb2f6 | 67 | "Number of seconds in each demon timestep." |
eec82323 LMI |
68 | :group 'gnus-demon |
69 | :type 'integer) | |
70 | ||
71 | ;;; Internal variables. | |
72 | ||
84acb2f6 | 73 | (defvar gnus-demon-timers nil |
89b163db | 74 | "Plist of idle timers which are running.") |
eec82323 | 75 | (defvar gnus-inhibit-demon nil |
84acb2f6 | 76 | "If non-nil, no daemonic function will be run.") |
eec82323 | 77 | |
eec82323 LMI |
78 | ;;; Functions. |
79 | ||
80 | (defun gnus-demon-add-handler (function time idle) | |
81 | "Add the handler FUNCTION to be run at TIME and IDLE." | |
82 | ;; First remove any old handlers that use this function. | |
83 | (gnus-demon-remove-handler function) | |
84 | ;; Then add the new one. | |
85 | (push (list function time idle) gnus-demon-handlers) | |
86 | (gnus-demon-init)) | |
87 | ||
88 | (defun gnus-demon-remove-handler (function &optional no-init) | |
89 | "Remove the handler FUNCTION from the list of handlers." | |
36d3245f | 90 | (gnus-alist-pull function gnus-demon-handlers) |
eec82323 LMI |
91 | (unless no-init |
92 | (gnus-demon-init))) | |
93 | ||
84acb2f6 JD |
94 | (defun gnus-demon-idle-since () |
95 | "Return the number of seconds since when Emacs is idle." | |
96 | (if (featurep 'xemacs) | |
97 | (itimer-time-difference (current-time) last-command-event-time) | |
98 | (float-time (or (current-idle-time) | |
99 | '(0 0 0))))) | |
100 | ||
89b163db G |
101 | (defun gnus-demon-run-callback (func &optional idle time special) |
102 | "Run FUNC if Emacs has been idle for longer than IDLE seconds. | |
103 | If not, and a TIME is given, restart a new idle timer, so FUNC | |
104 | can be called at the next opportunity. Such a special idle run is | |
105 | marked with SPECIAL." | |
84acb2f6 | 106 | (unless gnus-inhibit-demon |
89b163db G |
107 | (block run-callback |
108 | (when (eq idle t) | |
109 | (setq idle 0.001)) | |
110 | (cond (special | |
111 | (setq gnus-demon-timers | |
112 | (plist-put gnus-demon-timers func | |
113 | (run-with-timer time time 'gnus-demon-run-callback | |
114 | func idle time)))) | |
115 | ((and idle (> idle (gnus-demon-idle-since))) | |
116 | (when time | |
117 | (nnheader-cancel-timer (plist-get gnus-demon-timers func)) | |
118 | (setq gnus-demon-timers | |
119 | (plist-put gnus-demon-timers func | |
120 | (run-with-idle-timer idle nil | |
121 | 'gnus-demon-run-callback | |
122 | func idle time t)))) | |
123 | (return-from run-callback))) | |
84acb2f6 | 124 | (with-local-quit |
89b163db G |
125 | (ignore-errors |
126 | (funcall func)))))) | |
84acb2f6 | 127 | |
eec82323 LMI |
128 | (defun gnus-demon-init () |
129 | "Initialize the Gnus daemon." | |
130 | (interactive) | |
131 | (gnus-demon-cancel) | |
84acb2f6 | 132 | (dolist (handler gnus-demon-handlers) |
6748645f | 133 | ;; Set up the timer. |
84acb2f6 JD |
134 | (let* ((func (nth 0 handler)) |
135 | (time (nth 1 handler)) | |
136 | (idle (nth 2 handler)) | |
137 | ;; Compute time according with timestep. | |
138 | ;; If t, replace by 1 | |
139 | (time (cond ((eq time t) | |
140 | gnus-demon-timestep) | |
7e67562f G |
141 | ((null time) |
142 | nil) | |
143 | ((stringp time) | |
39ddff39 | 144 | (* (gnus-demon-time-to-step time) gnus-demon-timestep)) |
7e67562f G |
145 | (t |
146 | (* time gnus-demon-timestep)))) | |
067b39d4 G |
147 | (idle (cond ((numberp idle) |
148 | (* idle gnus-demon-timestep)) | |
149 | ((and (eq idle t) (numberp time)) | |
150 | time) | |
151 | (t | |
152 | idle))) | |
39ddff39 | 153 | |
84acb2f6 JD |
154 | (timer |
155 | (cond | |
84acb2f6 JD |
156 | ;; (func nil number) |
157 | ;; Only call when Emacs has been idle for `idle' | |
158 | ((and (null time) (numberp idle)) | |
e1c92ac7 | 159 | (run-with-idle-timer idle t 'gnus-demon-run-callback func)) |
39ddff39 | 160 | ;; (func number any) |
84acb2f6 | 161 | ;; Call every `time' |
a179e3f7 | 162 | ((integerp time) |
89b163db G |
163 | (run-with-timer time time 'gnus-demon-run-callback |
164 | func idle time)) | |
39ddff39 | 165 | ;; (func string any) |
a179e3f7 | 166 | ((stringp time) |
89b163db G |
167 | (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback |
168 | func idle))))) | |
84acb2f6 | 169 | (when timer |
89b163db | 170 | (setq gnus-demon-timers (plist-put gnus-demon-timers func timer)))))) |
eec82323 | 171 | |
7e67562f | 172 | (defun gnus-demon-time-to-step (time) |
39ddff39 | 173 | "Find out how many steps to TIME, which is on the form \"17:43\"." |
7e67562f G |
174 | (let* ((now (current-time)) |
175 | ;; obtain NOW as discrete components -- make a vector for speed | |
176 | (nowParts (decode-time now)) | |
177 | ;; obtain THEN as discrete components | |
178 | (thenParts (parse-time-string time)) | |
179 | (thenHour (elt thenParts 2)) | |
180 | (thenMin (elt thenParts 1)) | |
181 | ;; convert time as elements into number of seconds since EPOCH. | |
182 | (then (encode-time 0 | |
183 | thenMin | |
184 | thenHour | |
185 | ;; If THEN is earlier than NOW, make it | |
186 | ;; same time tomorrow. Doc for encode-time | |
187 | ;; says that this is OK. | |
188 | (+ (elt nowParts 3) | |
189 | (if (or (< thenHour (elt nowParts 2)) | |
190 | (and (= thenHour (elt nowParts 2)) | |
191 | (<= thenMin (elt nowParts 1)))) | |
192 | 1 0)) | |
193 | (elt nowParts 4) | |
194 | (elt nowParts 5) | |
195 | (elt nowParts 6) | |
196 | (elt nowParts 7) | |
197 | (elt nowParts 8))) | |
198 | ;; calculate number of seconds between NOW and THEN | |
199 | (diff (+ (* 65536 (- (car then) (car now))) | |
200 | (- (cadr then) (cadr now))))) | |
201 | ;; return number of timesteps in the number of seconds | |
202 | (round (/ diff gnus-demon-timestep)))) | |
203 | ||
eec82323 LMI |
204 | (gnus-add-shutdown 'gnus-demon-cancel 'gnus) |
205 | ||
206 | (defun gnus-demon-cancel () | |
207 | "Cancel any Gnus daemons." | |
208 | (interactive) | |
89b163db G |
209 | (dotimes (i (/ (length gnus-demon-timers) 2)) |
210 | (nnheader-cancel-timer (nth (1+ (* i 2)) gnus-demon-timers))) | |
84acb2f6 | 211 | (setq gnus-demon-timers nil)) |
eec82323 | 212 | |
eec82323 LMI |
213 | (defun gnus-demon-add-disconnection () |
214 | "Add daemonic server disconnection to Gnus." | |
215 | (gnus-demon-add-handler 'gnus-demon-close-connections nil 30)) | |
216 | ||
217 | (defun gnus-demon-close-connections () | |
218 | (save-window-excursion | |
219 | (gnus-close-backends))) | |
220 | ||
6748645f LMI |
221 | (defun gnus-demon-add-nntp-close-connection () |
222 | "Add daemonic nntp server disconnection to Gnus. | |
223 | If no commands have gone out via nntp during the last five | |
224 | minutes, the connection is closed." | |
1d2faf98 | 225 | (gnus-demon-add-handler 'gnus-demon-nntp-close-connection 5 nil)) |
6748645f LMI |
226 | |
227 | (defun gnus-demon-nntp-close-connection () | |
228 | (save-window-excursion | |
16409b0b | 229 | (when (time-less-p '(0 300) (time-since nntp-last-command-time)) |
6748645f LMI |
230 | (nntp-close-server)))) |
231 | ||
eec82323 LMI |
232 | (defun gnus-demon-add-scanmail () |
233 | "Add daemonic scanning of mail from the mail backends." | |
234 | (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60)) | |
235 | ||
236 | (defun gnus-demon-scan-mail () | |
237 | (save-window-excursion | |
238 | (let ((servers gnus-opened-servers) | |
16409b0b GM |
239 | server |
240 | (nnmail-fetched-sources (list t))) | |
eec82323 LMI |
241 | (while (setq server (car (pop servers))) |
242 | (and (gnus-check-backend-function 'request-scan (car server)) | |
243 | (or (gnus-server-opened server) | |
244 | (gnus-open-server server)) | |
245 | (gnus-request-scan nil server)))))) | |
246 | ||
247 | (defun gnus-demon-add-rescan () | |
248 | "Add daemonic scanning of new articles from all backends." | |
249 | (gnus-demon-add-handler 'gnus-demon-scan-news 120 60)) | |
250 | ||
251 | (defun gnus-demon-scan-news () | |
6748645f LMI |
252 | (let ((win (current-window-configuration))) |
253 | (unwind-protect | |
254 | (save-window-excursion | |
20a673b2 KY |
255 | (when (gnus-alive-p) |
256 | (with-current-buffer gnus-group-buffer | |
257 | (gnus-group-get-new-news)))) | |
6748645f | 258 | (set-window-configuration win)))) |
eec82323 LMI |
259 | |
260 | (defun gnus-demon-add-scan-timestamps () | |
261 | "Add daemonic updating of timestamps in empty newgroups." | |
262 | (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30)) | |
263 | ||
264 | (defun gnus-demon-scan-timestamps () | |
265 | "Set the timestamp on all newsgroups with no unread and no ticked articles." | |
266 | (when (gnus-alive-p) | |
267 | (let ((cur-time (current-time)) | |
268 | (newsrc (cdr gnus-newsrc-alist)) | |
269 | info group unread has-ticked) | |
270 | (while (setq info (pop newsrc)) | |
271 | (setq group (gnus-info-group info) | |
272 | unread (gnus-group-unread group) | |
273 | has-ticked (cdr (assq 'tick (gnus-info-marks info)))) | |
274 | (when (and (numberp unread) | |
275 | (= unread 0) | |
276 | (not has-ticked)) | |
277 | (gnus-group-set-parameter group 'timestamp cur-time)))))) | |
278 | ||
279 | (provide 'gnus-demon) | |
280 | ||
281 | ;;; gnus-demon.el ends here |