1 ;;; gnus-demon.el --- daemonic Gnus behaviour
2 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
28 (eval-when-compile (require 'cl))
37 (if (string-match "XEmacs" (emacs-version))
41 (defgroup gnus-demon nil
45 (defcustom gnus-demon-handlers nil
46 "Alist of daemonic handlers to be run at intervals.
47 Each handler is a list on the form
51 FUNCTION is the function to be called.
52 TIME is the number of `gnus-demon-timestep's between each call.
53 If nil, never call. If t, call each `gnus-demon-timestep'.
54 If IDLE is t, only call if Emacs has been idle for a while. If IDLE
55 is a number, only call when Emacs has been idle more than this number
56 of `gnus-demon-timestep's. If IDLE is nil, don't care about
57 idleness. If IDLE is a number and TIME is nil, then call once each
58 time Emacs has been idle for IDLE `gnus-demon-timestep's."
60 :type '(repeat (list function
62 (const :tag "never" nil)
64 (integer :tag "steps" 1))
66 (const :tag "don't care" nil)
67 (const :tag "for a while" t)
68 (integer :tag "steps" 1)))))
70 (defcustom gnus-demon-timestep 60
71 "*Number of seconds in each demon timestep."
75 ;;; Internal variables.
77 (defvar gnus-demon-timer nil)
78 (defvar gnus-demon-idle-has-been-called nil)
79 (defvar gnus-demon-idle-time 0)
80 (defvar gnus-demon-handler-state nil)
81 (defvar gnus-demon-last-keys nil)
82 (defvar gnus-inhibit-demon nil
83 "*If non-nil, no daemonic function will be run.")
86 (autoload 'timezone-parse-date "timezone")
87 (autoload 'timezone-make-arpa-date "timezone"))
91 (defun gnus-demon-add-handler (function time idle)
92 "Add the handler FUNCTION to be run at TIME and IDLE."
93 ;; First remove any old handlers that use this function.
94 (gnus-demon-remove-handler function)
95 ;; Then add the new one.
96 (push (list function time idle) gnus-demon-handlers)
99 (defun gnus-demon-remove-handler (function &optional no-init)
100 "Remove the handler FUNCTION from the list of handlers."
101 (gnus-pull function gnus-demon-handlers)
105 (defun gnus-demon-init ()
106 "Initialize the Gnus daemon."
109 (when gnus-demon-handlers
111 (setq gnus-demon-timer
112 (nnheader-run-at-time
113 gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
114 ;; Reset control variables.
115 (setq gnus-demon-handler-state
118 (list (car handler) (gnus-demon-time-to-step (nth 1 handler))
120 gnus-demon-handlers))
121 (setq gnus-demon-idle-time 0)
122 (setq gnus-demon-idle-has-been-called nil)
123 (setq gnus-use-demon t)))
125 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
127 (defun gnus-demon-cancel ()
128 "Cancel any Gnus daemons."
130 (when gnus-demon-timer
131 (nnheader-cancel-timer gnus-demon-timer))
132 (setq gnus-demon-timer nil
134 gnus-demon-idle-has-been-called nil)
136 (nnheader-cancel-function-timers 'gnus-demon)
139 (defun gnus-demon-is-idle-p ()
140 "Whether Emacs is idle or not."
141 ;; We do this simply by comparing the 100 most recent keystrokes
142 ;; with the ones we had last time. If they are the same, one might
143 ;; guess that Emacs is indeed idle. This only makes sense if one
144 ;; calls this function seldom -- like once a minute, which is what
146 (let ((keys (recent-keys)))
147 (or (equal keys gnus-demon-last-keys)
149 (setq gnus-demon-last-keys keys)
152 (defun gnus-demon-time-to-step (time)
153 "Find out how many seconds to TIME, which is on the form \"17:43\"."
154 (if (not (stringp time))
156 (let* ((now (current-time))
157 ;; obtain NOW as discrete components -- make a vector for speed
158 (nowParts (apply 'vector (decode-time now)))
159 ;; obtain THEN as discrete components
160 (thenParts (timezone-parse-time time))
161 (thenHour (string-to-int (elt thenParts 0)))
162 (thenMin (string-to-int (elt thenParts 1)))
163 ;; convert time as elements into number of seconds since EPOCH.
167 ;; If THEN is earlier than NOW, make it
168 ;; same time tomorrow. Doc for encode-time
169 ;; says that this is OK.
171 (if (or (< thenHour (elt nowParts 2))
172 (and (= thenHour (elt nowParts 2))
173 (<= thenMin (elt nowParts 1))))
180 ;; calculate number of seconds between NOW and THEN
181 (diff (+ (* 65536 (- (car then) (car now)))
182 (- (cadr then) (cadr now)))))
183 ;; return number of timesteps in the number of seconds
184 (round (/ diff gnus-demon-timestep)))))
187 "The Gnus daemon that takes care of running all Gnus handlers."
188 ;; Increase or reset the time Emacs has been idle.
189 (if (gnus-demon-is-idle-p)
190 (incf gnus-demon-idle-time)
191 (setq gnus-demon-idle-time 0)
192 (setq gnus-demon-idle-has-been-called nil))
193 ;; Disable all daemonic stuff if we're in the minibuffer
194 (when (and (not (window-minibuffer-p (selected-window)))
195 (not gnus-inhibit-demon))
196 ;; Then we go through all the handler and call those that are
197 ;; sufficiently ripe.
198 (let ((handlers gnus-demon-handler-state)
199 (gnus-inhibit-demon t)
202 (setq handler (pop handlers))
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.
208 (setcar (nthcdr 1 handler) (decf time)))
209 (and (zerop time) ; If the timer now is zero...
210 ;; Test for appropriate idleness
212 (setq idle (nth 2 handler))
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.
220 (ignore-errors (funcall (car handler)))
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)))
229 ((and (not (numberp idle))
230 (gnus-demon-is-idle-p))
231 ;; We want to call this handler each and every time that
233 (ignore-errors (funcall (car handler))))
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)
239 (gnus-demon-is-idle-p)
241 (ignore-errors (funcall (car handler)))
242 ;; Make sure the handler won't be called once more in
244 (push (car handler) gnus-demon-idle-has-been-called)))))))))
246 (defun gnus-demon-add-nocem ()
247 "Add daemonic NoCeM handling to Gnus."
248 (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30))
250 (defun gnus-demon-scan-nocem ()
251 "Scan NoCeM groups for NoCeM messages."
252 (save-window-excursion
253 (gnus-nocem-scan-groups)))
255 (defun gnus-demon-add-disconnection ()
256 "Add daemonic server disconnection to Gnus."
257 (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
259 (defun gnus-demon-close-connections ()
260 (save-window-excursion
261 (gnus-close-backends)))
263 (defun gnus-demon-add-nntp-close-connection ()
264 "Add daemonic nntp server disconnection to Gnus.
265 If no commands have gone out via nntp during the last five
266 minutes, the connection is closed."
267 (gnus-demon-add-handler 'gnus-demon-close-connections 5 nil))
269 (defun gnus-demon-nntp-close-connection ()
270 (save-window-excursion
271 (when (nnmail-time-less '(0 300)
272 (nnmail-time-since nntp-last-command-time))
273 (nntp-close-server))))
275 (defun gnus-demon-add-scanmail ()
276 "Add daemonic scanning of mail from the mail backends."
277 (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
279 (defun gnus-demon-scan-mail ()
280 (save-window-excursion
281 (let ((servers gnus-opened-servers)
283 (gnus-clear-inboxes-moved)
284 (while (setq server (car (pop servers)))
285 (and (gnus-check-backend-function 'request-scan (car server))
286 (or (gnus-server-opened server)
287 (gnus-open-server server))
288 (gnus-request-scan nil server))))))
290 (defun gnus-demon-add-rescan ()
291 "Add daemonic scanning of new articles from all backends."
292 (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
294 (defun gnus-demon-scan-news ()
295 (let ((win (current-window-configuration)))
297 (save-window-excursion
301 (set-buffer gnus-group-buffer)
302 (gnus-group-get-new-news)))))
303 (set-window-configuration win))))
305 (defun gnus-demon-add-scan-timestamps ()
306 "Add daemonic updating of timestamps in empty newgroups."
307 (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
309 (defun gnus-demon-scan-timestamps ()
310 "Set the timestamp on all newsgroups with no unread and no ticked articles."
312 (let ((cur-time (current-time))
313 (newsrc (cdr gnus-newsrc-alist))
314 info group unread has-ticked)
315 (while (setq info (pop newsrc))
316 (setq group (gnus-info-group info)
317 unread (gnus-group-unread group)
318 has-ticked (cdr (assq 'tick (gnus-info-marks info))))
319 (when (and (numberp unread)
322 (gnus-group-set-parameter group 'timestamp cur-time))))))
324 (provide 'gnus-demon)
326 ;;; gnus-demon.el ends here