Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-demon.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 376386a54a3c
children ec9a17fef872
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
1 ;;; gnus-demon.el --- daemonic Gnus behaviour 1 ;;; gnus-demon.el --- daemonic Gnus behaviour
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
3 3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Keywords: news 5 ;; Keywords: news
6 6
7 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
24 ;;; Commentary: 24 ;;; Commentary:
25 25
26 ;;; Code: 26 ;;; Code:
27 27
28 (require 'gnus) 28 (require 'gnus)
29 29 (require 'gnus-int)
30 (eval-when-compile (require 'cl)) 30 (require 'nnheader)
31 31 (eval-and-compile
32 (defvar gnus-demon-handlers nil 32 (if (string-match "XEmacs" (emacs-version))
33 (require 'itimer)
34 (require 'timer)))
35
36 (defgroup gnus-demon nil
37 "Demonic behaviour."
38 :group 'gnus)
39
40 (defcustom gnus-demon-handlers nil
33 "Alist of daemonic handlers to be run at intervals. 41 "Alist of daemonic handlers to be run at intervals.
34 Each handler is a list on the form 42 Each handler is a list on the form
35 43
36 \(FUNCTION TIME IDLE) 44 \(FUNCTION TIME IDLE)
37 45
40 If nil, never call. If t, call each `gnus-demon-timestep'. 48 If nil, never call. If t, call each `gnus-demon-timestep'.
41 If IDLE is t, only call if Emacs has been idle for a while. If IDLE 49 If IDLE is t, only call if Emacs has been idle for a while. If IDLE
42 is a number, only call when Emacs has been idle more than this number 50 is a number, only call when Emacs has been idle more than this number
43 of `gnus-demon-timestep's. If IDLE is nil, don't care about 51 of `gnus-demon-timestep's. If IDLE is nil, don't care about
44 idleness. If IDLE is a number and TIME is nil, then call once each 52 idleness. If IDLE is a number and TIME is nil, then call once each
45 time Emacs has been idle for IDLE `gnus-demon-timestep's.") 53 time Emacs has been idle for IDLE `gnus-demon-timestep's."
46 54 :group 'gnus-demon
47 (defvar gnus-demon-timestep 60 55 :type '(repeat (list function
48 "*Number of seconds in each demon timestep.") 56 (choice :tag "Time"
57 (const :tag "never" nil)
58 (const :tag "one" t)
59 (integer :tag "steps" 1))
60 (choice :tag "Idle"
61 (const :tag "don't care" nil)
62 (const :tag "for a while" t)
63 (integer :tag "steps" 1)))))
64
65 (defcustom gnus-demon-timestep 60
66 "*Number of seconds in each demon timestep."
67 :group 'gnus-demon
68 :type 'integer)
49 69
50 ;;; Internal variables. 70 ;;; Internal variables.
51 71
52 (defvar gnus-demon-timer nil) 72 (defvar gnus-demon-timer nil)
53 (defvar gnus-demon-idle-has-been-called nil) 73 (defvar gnus-demon-idle-has-been-called nil)
54 (defvar gnus-demon-idle-time 0) 74 (defvar gnus-demon-idle-time 0)
55 (defvar gnus-demon-handler-state nil) 75 (defvar gnus-demon-handler-state nil)
56 (defvar gnus-demon-is-idle nil) 76 (defvar gnus-demon-last-keys nil)
57 (defvar gnus-demon-last-keys nil)
58 77
59 (eval-and-compile 78 (eval-and-compile
60 (autoload 'timezone-parse-date "timezone") 79 (autoload 'timezone-parse-date "timezone")
61 (autoload 'timezone-make-arpa-date "timezone")) 80 (autoload 'timezone-make-arpa-date "timezone"))
62 81
73 (defun gnus-demon-remove-handler (function &optional no-init) 92 (defun gnus-demon-remove-handler (function &optional no-init)
74 "Remove the handler FUNCTION from the list of handlers." 93 "Remove the handler FUNCTION from the list of handlers."
75 (setq gnus-demon-handlers 94 (setq gnus-demon-handlers
76 (delq (assq function gnus-demon-handlers) 95 (delq (assq function gnus-demon-handlers)
77 gnus-demon-handlers)) 96 gnus-demon-handlers))
78 (or no-init (gnus-demon-init))) 97 (unless no-init
98 (gnus-demon-init)))
79 99
80 (defun gnus-demon-init () 100 (defun gnus-demon-init ()
81 "Initialize the Gnus daemon." 101 "Initialize the Gnus daemon."
82 (interactive) 102 (interactive)
83 (gnus-demon-cancel) 103 (gnus-demon-cancel)
84 (if (null gnus-demon-handlers) 104 (if (null gnus-demon-handlers)
85 () ; Nothing to do. 105 () ; Nothing to do.
86 ;; Set up timer. 106 ;; Set up timer.
87 (setq gnus-demon-timer 107 (setq gnus-demon-timer
88 (nnheader-run-at-time 108 (nnheader-run-at-time
89 gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) 109 gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
90 ;; Reset control variables. 110 ;; Reset control variables.
101 (gnus-add-shutdown 'gnus-demon-cancel 'gnus) 121 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
102 122
103 (defun gnus-demon-cancel () 123 (defun gnus-demon-cancel ()
104 "Cancel any Gnus daemons." 124 "Cancel any Gnus daemons."
105 (interactive) 125 (interactive)
106 (and gnus-demon-timer 126 (when gnus-demon-timer
107 (nnheader-cancel-timer gnus-demon-timer)) 127 (nnheader-cancel-timer gnus-demon-timer))
108 (setq gnus-demon-timer nil 128 (setq gnus-demon-timer nil
109 gnus-use-demon nil)) 129 gnus-use-demon nil)
130 (condition-case ()
131 (nnheader-cancel-function-timers 'gnus-demon)
132 (error t)))
110 133
111 (defun gnus-demon-is-idle-p () 134 (defun gnus-demon-is-idle-p ()
112 "Whether Emacs is idle or not." 135 "Whether Emacs is idle or not."
113 ;; We do this simply by comparing the 100 most recent keystrokes 136 ;; We do this simply by comparing the 100 most recent keystrokes
114 ;; with the ones we had last time. If they are the same, one might 137 ;; with the ones we had last time. If they are the same, one might
133 (string-to-number (aref dv 2)) time 156 (string-to-number (aref dv 2)) time
134 (or (aref dv 4) "UT"))) 157 (or (aref dv 4) "UT")))
135 (nseconds (gnus-time-minus 158 (nseconds (gnus-time-minus
136 (gnus-encode-date tdate) (gnus-encode-date date)))) 159 (gnus-encode-date tdate) (gnus-encode-date date))))
137 (round 160 (round
138 (/ (if (< nseconds 0) 161 (/ (+ (if (< (car nseconds) 0)
139 (+ nseconds (* 60 60 24)) 162 86400 0)
140 nseconds) gnus-demon-timestep))))) 163 (* 65536 (car nseconds))
164 (nth 1 nseconds))
165 gnus-demon-timestep)))))
141 166
142 (defun gnus-demon () 167 (defun gnus-demon ()
143 "The Gnus daemon that takes care of running all Gnus handlers." 168 "The Gnus daemon that takes care of running all Gnus handlers."
144 ;; Increase or reset the time Emacs has been idle. 169 ;; Increase or reset the time Emacs has been idle.
145 (if (gnus-demon-is-idle-p) 170 (if (gnus-demon-is-idle-p)
146 (incf gnus-demon-idle-time) 171 (incf gnus-demon-idle-time)
147 (setq gnus-demon-idle-time 0) 172 (setq gnus-demon-idle-time 0)
148 (setq gnus-demon-idle-has-been-called nil)) 173 (setq gnus-demon-idle-has-been-called nil))
149 ;; Then we go through all the handler and call those that are 174 ;; Disable all daemonic stuff if we're in the minibuffer
150 ;; sufficiently ripe. 175 (unless (window-minibuffer-p (selected-window))
151 (let ((handlers gnus-demon-handler-state) 176 ;; Then we go through all the handler and call those that are
152 handler time idle) 177 ;; sufficiently ripe.
153 (while handlers 178 (let ((handlers gnus-demon-handler-state)
154 (setq handler (pop handlers)) 179 handler time idle)
155 (cond 180 (while handlers
156 ((numberp (setq time (nth 1 handler))) 181 (setq handler (pop handlers))
157 ;; These handlers use a regular timeout mechanism. We decrease 182 (cond
158 ;; the timer if it hasn't reached zero yet. 183 ((numberp (setq time (nth 1 handler)))
159 (or (zerop time) 184 ;; These handlers use a regular timeout mechanism. We decrease
185 ;; the timer if it hasn't reached zero yet.
186 (unless (zerop time)
160 (setcar (nthcdr 1 handler) (decf time))) 187 (setcar (nthcdr 1 handler) (decf time)))
161 (and (zerop time) ; If the timer now is zero... 188 (and (zerop time) ; If the timer now is zero...
162 (or (not (setq idle (nth 2 handler))) ; Don't care about idle. 189 ;; Test for appropriate idleness
163 (and (numberp idle) ; Numerical idle... 190 (progn
164 (< idle gnus-demon-idle-time)) ; Idle timed out. 191 (setq idle (nth 2 handler))
165 gnus-demon-is-idle) ; Or just need to be idle. 192 (cond
166 ;; So we call the handler. 193 ((null idle) t) ; Don't care about idle.
167 (progn 194 ((numberp idle) ; Numerical idle...
168 (funcall (car handler)) 195 (< idle gnus-demon-idle-time)) ; Idle timed out.
169 ;; And reset the timer. 196 (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle.
170 (setcar (nthcdr 1 handler) 197 ;; So we call the handler.
171 (gnus-demon-time-to-step 198 (progn
172 (nth 1 (assq (car handler) gnus-demon-handlers))))))) 199 (funcall (car handler))
173 ;; These are only supposed to be called when Emacs is idle. 200 ;; And reset the timer.
174 ((null (setq idle (nth 2 handler))) 201 (setcar (nthcdr 1 handler)
175 ;; We do nothing. 202 (gnus-demon-time-to-step
176 ) 203 (nth 1 (assq (car handler) gnus-demon-handlers)))))))
177 ((not (numberp idle)) 204 ;; These are only supposed to be called when Emacs is idle.
178 ;; We want to call this handler each and every time that 205 ((null (setq idle (nth 2 handler)))
179 ;; Emacs is idle. 206 ;; We do nothing.
180 (funcall (car handler))) 207 )
181 (t 208 ((not (numberp idle))
182 ;; We want to call this handler only if Emacs has been idle 209 ;; We want to call this handler each and every time that
183 ;; for a specified number of timesteps. 210 ;; Emacs is idle.
184 (and (not (memq (car handler) gnus-demon-idle-has-been-called)) 211 (funcall (car handler)))
185 (< idle gnus-demon-idle-time) 212 (t
186 (progn 213 ;; We want to call this handler only if Emacs has been idle
187 (funcall (car handler)) 214 ;; for a specified number of timesteps.
188 ;; Make sure the handler won't be called once more in 215 (and (not (memq (car handler) gnus-demon-idle-has-been-called))
189 ;; this idle-cycle. 216 (< idle gnus-demon-idle-time)
190 (push (car handler) gnus-demon-idle-has-been-called)))))))) 217 (progn
218 (funcall (car handler))
219 ;; Make sure the handler won't be called once more in
220 ;; this idle-cycle.
221 (push (car handler) gnus-demon-idle-has-been-called)))))))))
191 222
192 (defun gnus-demon-add-nocem () 223 (defun gnus-demon-add-nocem ()
193 "Add daemonic NoCeM handling to Gnus." 224 "Add daemonic NoCeM handling to Gnus."
194 (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 t)) 225 (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 t))
195 226
196 (defun gnus-demon-scan-nocem () 227 (defun gnus-demon-scan-nocem ()
197 "Scan NoCeM groups for NoCeM messages." 228 "Scan NoCeM groups for NoCeM messages."
198 (gnus-nocem-scan-groups)) 229 (save-window-excursion
230 (gnus-nocem-scan-groups)))
199 231
200 (defun gnus-demon-add-disconnection () 232 (defun gnus-demon-add-disconnection ()
201 "Add daemonic server disconnection to Gnus." 233 "Add daemonic server disconnection to Gnus."
202 (gnus-demon-add-handler 'gnus-demon-close-connections nil 30)) 234 (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
203 235
204 (defun gnus-demon-close-connections () 236 (defun gnus-demon-close-connections ()
205 (gnus-close-backends)) 237 (save-window-excursion
238 (gnus-close-backends)))
206 239
207 (defun gnus-demon-add-scanmail () 240 (defun gnus-demon-add-scanmail ()
208 "Add daemonic scanning of mail from the mail backends." 241 "Add daemonic scanning of mail from the mail backends."
209 (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60)) 242 (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
210 243
211 (defun gnus-demon-scan-mail () 244 (defun gnus-demon-scan-mail ()
212 (let ((servers gnus-opened-servers) 245 (save-window-excursion
213 server) 246 (let ((servers gnus-opened-servers)
214 (while (setq server (car (pop servers))) 247 server)
215 (and (gnus-check-backend-function 'request-scan (car server)) 248 (while (setq server (car (pop servers)))
216 (or (gnus-server-opened server) 249 (and (gnus-check-backend-function 'request-scan (car server))
217 (gnus-open-server server)) 250 (or (gnus-server-opened server)
218 (gnus-request-scan nil server))))) 251 (gnus-open-server server))
252 (gnus-request-scan nil server))))))
253
254 (defun gnus-demon-add-rescan ()
255 "Add daemonic scanning of new articles from all backends."
256 (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
257
258 (defun gnus-demon-scan-news ()
259 (save-window-excursion
260 (when (gnus-alive-p)
261 (save-excursion
262 (set-buffer gnus-group-buffer)
263 (gnus-group-get-new-news)))))
264
265 (defun gnus-demon-add-scan-timestamps ()
266 "Add daemonic updating of timestamps in empty newgroups."
267 (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
268
269 (defun gnus-demon-scan-timestamps ()
270 "Set the timestamp on all newsgroups with no unread and no ticked articles."
271 (when (gnus-alive-p)
272 (let ((cur-time (current-time))
273 (newsrc (cdr gnus-newsrc-alist))
274 info group unread has-ticked)
275 (while (setq info (pop newsrc))
276 (setq group (gnus-info-group info)
277 unread (gnus-group-unread group)
278 has-ticked (cdr (assq 'tick (gnus-info-marks info))))
279 (when (and (numberp unread)
280 (= unread 0)
281 (not has-ticked))
282 (gnus-group-set-parameter group 'timestamp cur-time))))))
219 283
220 (provide 'gnus-demon) 284 (provide 'gnus-demon)
221 285
222 ;;; gnus-demon.el ends here 286 ;;; gnus-demon.el ends here