Add 2011 to FSF/AIST copyright years.
[bpt/emacs.git] / lisp / gnus / gnus-demon.el
CommitLineData
fffa137c 1;;; gnus-demon.el --- daemonic Gnus behavior
23f87bed 2
b6c2d8c6 3;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
5df4f04c 4;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
eec82323 5
6748645f 6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
eec82323
LMI
7;; Keywords: news
8
9;; This file is part of GNU Emacs.
10
5e809f55 11;; GNU Emacs is free software: you can redistribute it and/or modify
eec82323 12;; it under the terms of the GNU General Public License as published by
5e809f55
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
eec82323
LMI
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
5e809f55 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
eec82323
LMI
23
24;;; Commentary:
25
26;;; Code:
27
7df7482d
RS
28(eval-when-compile (require 'cl))
29
eec82323
LMI
30(require 'gnus)
31(require 'gnus-int)
32(require 'nnheader)
6748645f
LMI
33(require 'nntp)
34(require 'nnmail)
35(require 'gnus-util)
eec82323 36
498063ec
MB
37(autoload 'parse-time-string "parse-time" nil nil)
38
eec82323 39(defgroup gnus-demon nil
4525646f 40 "Demonic behavior."
eec82323
LMI
41 :group 'gnus)
42
43(defcustom gnus-demon-handlers nil
44 "Alist of daemonic handlers to be run at intervals.
45Each handler is a list on the form
46
47\(FUNCTION TIME IDLE)
48
49FUNCTION is the function to be called.
50TIME is the number of `gnus-demon-timestep's between each call.
51If nil, never call. If t, call each `gnus-demon-timestep'.
52If IDLE is t, only call if Emacs has been idle for a while. If IDLE
53is a number, only call when Emacs has been idle more than this number
54of `gnus-demon-timestep's. If IDLE is nil, don't care about
55idleness. If IDLE is a number and TIME is nil, then call once each
56time Emacs has been idle for IDLE `gnus-demon-timestep's."
57 :group 'gnus-demon
58 :type '(repeat (list function
59 (choice :tag "Time"
60 (const :tag "never" nil)
61 (const :tag "one" t)
62 (integer :tag "steps" 1))
63 (choice :tag "Idle"
64 (const :tag "don't care" nil)
65 (const :tag "for a while" t)
66 (integer :tag "steps" 1)))))
67
68(defcustom gnus-demon-timestep 60
69 "*Number of seconds in each demon timestep."
70 :group 'gnus-demon
71 :type 'integer)
72
73;;; Internal variables.
74
75(defvar gnus-demon-timer nil)
76(defvar gnus-demon-idle-has-been-called nil)
77(defvar gnus-demon-idle-time 0)
78(defvar gnus-demon-handler-state nil)
79(defvar gnus-demon-last-keys nil)
80(defvar gnus-inhibit-demon nil
81 "*If non-nil, no daemonic function will be run.")
82
eec82323
LMI
83;;; Functions.
84
85(defun gnus-demon-add-handler (function time idle)
86 "Add the handler FUNCTION to be run at TIME and IDLE."
87 ;; First remove any old handlers that use this function.
88 (gnus-demon-remove-handler function)
89 ;; Then add the new one.
90 (push (list function time idle) gnus-demon-handlers)
91 (gnus-demon-init))
92
93(defun gnus-demon-remove-handler (function &optional no-init)
94 "Remove the handler FUNCTION from the list of handlers."
6748645f 95 (gnus-pull function gnus-demon-handlers)
eec82323
LMI
96 (unless no-init
97 (gnus-demon-init)))
98
99(defun gnus-demon-init ()
100 "Initialize the Gnus daemon."
101 (interactive)
102 (gnus-demon-cancel)
6748645f
LMI
103 (when gnus-demon-handlers
104 ;; Set up the timer.
eec82323 105 (setq gnus-demon-timer
01c52d31 106 (run-at-time
eec82323
LMI
107 gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
108 ;; Reset control variables.
109 (setq gnus-demon-handler-state
110 (mapcar
111 (lambda (handler)
112 (list (car handler) (gnus-demon-time-to-step (nth 1 handler))
113 (nth 2 handler)))
114 gnus-demon-handlers))
115 (setq gnus-demon-idle-time 0)
16409b0b 116 (setq gnus-demon-idle-has-been-called nil)))
eec82323
LMI
117
118(gnus-add-shutdown 'gnus-demon-cancel 'gnus)
119
120(defun gnus-demon-cancel ()
121 "Cancel any Gnus daemons."
122 (interactive)
123 (when gnus-demon-timer
124 (nnheader-cancel-timer gnus-demon-timer))
125 (setq gnus-demon-timer nil
6748645f 126 gnus-demon-idle-has-been-called nil)
eec82323
LMI
127 (condition-case ()
128 (nnheader-cancel-function-timers 'gnus-demon)
129 (error t)))
130
131(defun gnus-demon-is-idle-p ()
132 "Whether Emacs is idle or not."
133 ;; We do this simply by comparing the 100 most recent keystrokes
134 ;; with the ones we had last time. If they are the same, one might
135 ;; guess that Emacs is indeed idle. This only makes sense if one
136 ;; calls this function seldom -- like once a minute, which is what
137 ;; we do here.
138 (let ((keys (recent-keys)))
139 (or (equal keys gnus-demon-last-keys)
140 (progn
141 (setq gnus-demon-last-keys keys)
142 nil))))
143
144(defun gnus-demon-time-to-step (time)
145 "Find out how many seconds to TIME, which is on the form \"17:43\"."
146 (if (not (stringp time))
147 time
a8151ef7 148 (let* ((now (current-time))
23f87bed
MB
149 ;; obtain NOW as discrete components -- make a vector for speed
150 (nowParts (decode-time now))
151 ;; obtain THEN as discrete components
152 (thenParts (parse-time-string time))
153 (thenHour (elt thenParts 2))
154 (thenMin (elt thenParts 1))
155 ;; convert time as elements into number of seconds since EPOCH.
156 (then (encode-time 0
157 thenMin
158 thenHour
159 ;; If THEN is earlier than NOW, make it
160 ;; same time tomorrow. Doc for encode-time
161 ;; says that this is OK.
162 (+ (elt nowParts 3)
163 (if (or (< thenHour (elt nowParts 2))
164 (and (= thenHour (elt nowParts 2))
165 (<= thenMin (elt nowParts 1))))
166 1 0))
167 (elt nowParts 4)
168 (elt nowParts 5)
169 (elt nowParts 6)
170 (elt nowParts 7)
171 (elt nowParts 8)))
172 ;; calculate number of seconds between NOW and THEN
173 (diff (+ (* 65536 (- (car then) (car now)))
174 (- (cadr then) (cadr now)))))
a8151ef7
LMI
175 ;; return number of timesteps in the number of seconds
176 (round (/ diff gnus-demon-timestep)))))
eec82323
LMI
177
178(defun gnus-demon ()
179 "The Gnus daemon that takes care of running all Gnus handlers."
180 ;; Increase or reset the time Emacs has been idle.
181 (if (gnus-demon-is-idle-p)
182 (incf gnus-demon-idle-time)
183 (setq gnus-demon-idle-time 0)
184 (setq gnus-demon-idle-has-been-called nil))
185 ;; Disable all daemonic stuff if we're in the minibuffer
186 (when (and (not (window-minibuffer-p (selected-window)))
187 (not gnus-inhibit-demon))
188 ;; Then we go through all the handler and call those that are
189 ;; sufficiently ripe.
190 (let ((handlers gnus-demon-handler-state)
191 (gnus-inhibit-demon t)
16409b0b
GM
192 ;; Try to avoid dialog boxes, e.g. by Mailcrypt.
193 ;; Unfortunately, Emacs 20's `message-or-box...' doesn't
194 ;; obey `use-dialog-box'.
195 use-dialog-box (last-nonmenu-event 10)
eec82323
LMI
196 handler time idle)
197 (while handlers
198 (setq handler (pop handlers))
199 (cond
200 ((numberp (setq time (nth 1 handler)))
201 ;; These handlers use a regular timeout mechanism. We decrease
202 ;; the timer if it hasn't reached zero yet.
203 (unless (zerop time)
204 (setcar (nthcdr 1 handler) (decf time)))
205 (and (zerop time) ; If the timer now is zero...
206 ;; Test for appropriate idleness
207 (progn
208 (setq idle (nth 2 handler))
209 (cond
210 ((null idle) t) ; Don't care about idle.
211 ((numberp idle) ; Numerical idle...
212 (< idle gnus-demon-idle-time)) ; Idle timed out.
213 (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle.
214 ;; So we call the handler.
996aa8c1 215 (gnus-with-local-quit
a8151ef7 216 (ignore-errors (funcall (car handler)))
eec82323
LMI
217 ;; And reset the timer.
218 (setcar (nthcdr 1 handler)
219 (gnus-demon-time-to-step
220 (nth 1 (assq (car handler) gnus-demon-handlers)))))))
221 ;; These are only supposed to be called when Emacs is idle.
222 ((null (setq idle (nth 2 handler)))
223 ;; We do nothing.
224 )
a8151ef7
LMI
225 ((and (not (numberp idle))
226 (gnus-demon-is-idle-p))
eec82323
LMI
227 ;; We want to call this handler each and every time that
228 ;; Emacs is idle.
996aa8c1 229 (gnus-with-local-quit
90e93246 230 (ignore-errors (funcall (car handler)))))
eec82323
LMI
231 (t
232 ;; We want to call this handler only if Emacs has been idle
233 ;; for a specified number of timesteps.
234 (and (not (memq (car handler) gnus-demon-idle-has-been-called))
235 (< idle gnus-demon-idle-time)
a8151ef7 236 (gnus-demon-is-idle-p)
996aa8c1 237 (gnus-with-local-quit
a8151ef7 238 (ignore-errors (funcall (car handler)))
eec82323
LMI
239 ;; Make sure the handler won't be called once more in
240 ;; this idle-cycle.
241 (push (car handler) gnus-demon-idle-has-been-called)))))))))
242
243(defun gnus-demon-add-nocem ()
244 "Add daemonic NoCeM handling to Gnus."
a8151ef7 245 (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30))
eec82323
LMI
246
247(defun gnus-demon-scan-nocem ()
248 "Scan NoCeM groups for NoCeM messages."
249 (save-window-excursion
250 (gnus-nocem-scan-groups)))
251
252(defun gnus-demon-add-disconnection ()
253 "Add daemonic server disconnection to Gnus."
254 (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
255
256(defun gnus-demon-close-connections ()
257 (save-window-excursion
258 (gnus-close-backends)))
259
6748645f
LMI
260(defun gnus-demon-add-nntp-close-connection ()
261 "Add daemonic nntp server disconnection to Gnus.
262If no commands have gone out via nntp during the last five
263minutes, the connection is closed."
1d2faf98 264 (gnus-demon-add-handler 'gnus-demon-nntp-close-connection 5 nil))
6748645f
LMI
265
266(defun gnus-demon-nntp-close-connection ()
267 (save-window-excursion
16409b0b 268 (when (time-less-p '(0 300) (time-since nntp-last-command-time))
6748645f
LMI
269 (nntp-close-server))))
270
eec82323
LMI
271(defun gnus-demon-add-scanmail ()
272 "Add daemonic scanning of mail from the mail backends."
273 (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
274
275(defun gnus-demon-scan-mail ()
276 (save-window-excursion
277 (let ((servers gnus-opened-servers)
16409b0b
GM
278 server
279 (nnmail-fetched-sources (list t)))
eec82323
LMI
280 (while (setq server (car (pop servers)))
281 (and (gnus-check-backend-function 'request-scan (car server))
282 (or (gnus-server-opened server)
283 (gnus-open-server server))
284 (gnus-request-scan nil server))))))
285
286(defun gnus-demon-add-rescan ()
287 "Add daemonic scanning of new articles from all backends."
288 (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
289
290(defun gnus-demon-scan-news ()
6748645f
LMI
291 (let ((win (current-window-configuration)))
292 (unwind-protect
293 (save-window-excursion
294 (save-excursion
295 (when (gnus-alive-p)
296 (save-excursion
297 (set-buffer gnus-group-buffer)
298 (gnus-group-get-new-news)))))
299 (set-window-configuration win))))
eec82323
LMI
300
301(defun gnus-demon-add-scan-timestamps ()
302 "Add daemonic updating of timestamps in empty newgroups."
303 (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
304
305(defun gnus-demon-scan-timestamps ()
306 "Set the timestamp on all newsgroups with no unread and no ticked articles."
307 (when (gnus-alive-p)
308 (let ((cur-time (current-time))
309 (newsrc (cdr gnus-newsrc-alist))
310 info group unread has-ticked)
311 (while (setq info (pop newsrc))
312 (setq group (gnus-info-group info)
313 unread (gnus-group-unread group)
314 has-ticked (cdr (assq 'tick (gnus-info-marks info))))
315 (when (and (numberp unread)
316 (= unread 0)
317 (not has-ticked))
318 (gnus-group-set-parameter group 'timestamp cur-time))))))
319
320(provide 'gnus-demon)
321
cbee283d 322;; arch-tag: 8dd5cd3d-6ae4-46b4-9b15-f5fca09fd392
eec82323 323;;; gnus-demon.el ends here