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