96376
|
1 ;;; gnus-demon.el --- daemonic Gnus behavior
|
56927
|
2
|
74547
|
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
112218
|
4 ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
|
17493
|
5
|
24357
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
17493
|
7 ;; Keywords: news
|
|
8
|
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
94662
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
17493
|
12 ;; it under the terms of the GNU General Public License as published by
|
94662
|
13 ;; the Free Software Foundation, either version 3 of the License, or
|
|
14 ;; (at your option) any later version.
|
17493
|
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
|
94662
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
17493
|
23
|
|
24 ;;; Commentary:
|
|
25
|
|
26 ;;; Code:
|
|
27
|
19493
|
28 (eval-when-compile (require 'cl))
|
|
29
|
17493
|
30 (require 'gnus)
|
|
31 (require 'gnus-int)
|
|
32 (require 'nnheader)
|
24357
|
33 (require 'nntp)
|
|
34 (require 'nnmail)
|
61304
|
35
|
17493
|
36 (defgroup gnus-demon nil
|
79417
|
37 "Demonic behavior."
|
17493
|
38 :group 'gnus)
|
|
39
|
|
40 (defcustom gnus-demon-handlers nil
|
|
41 "Alist of daemonic handlers to be run at intervals.
|
|
42 Each handler is a list on the form
|
|
43
|
|
44 \(FUNCTION TIME IDLE)
|
|
45
|
111180
|
46 FUNCTION is the function to be called. TIME is the number of
|
|
47 `gnus-demon-timestep's between each call.
|
|
48 If nil, never call. If t, call each `gnus-demon-timestep'.
|
|
49
|
|
50 If IDLE is t, only call each time Emacs has been idle for TIME.
|
|
51 If IDLE is a number, only call when Emacs has been idle more than
|
|
52 this number of `gnus-demon-timestep's.
|
|
53 If IDLE is nil, don't care about idleness.
|
|
54 If IDLE is a number and TIME is nil, then call once each time
|
|
55 Emacs has been idle for IDLE `gnus-demon-timestep's."
|
17493
|
56 :group 'gnus-demon
|
|
57 :type '(repeat (list function
|
|
58 (choice :tag "Time"
|
|
59 (const :tag "never" nil)
|
|
60 (const :tag "one" t)
|
|
61 (integer :tag "steps" 1))
|
|
62 (choice :tag "Idle"
|
|
63 (const :tag "don't care" nil)
|
|
64 (const :tag "for a while" t)
|
|
65 (integer :tag "steps" 1)))))
|
|
66
|
|
67 (defcustom gnus-demon-timestep 60
|
111180
|
68 "Number of seconds in each demon timestep."
|
17493
|
69 :group 'gnus-demon
|
|
70 :type 'integer)
|
|
71
|
|
72 ;;; Internal variables.
|
|
73
|
111180
|
74 (defvar gnus-demon-timers nil
|
|
75 "List of idle timers which are running.")
|
17493
|
76 (defvar gnus-inhibit-demon nil
|
111180
|
77 "If non-nil, no daemonic function will be run.")
|
17493
|
78
|
|
79 ;;; Functions.
|
|
80
|
|
81 (defun gnus-demon-add-handler (function time idle)
|
|
82 "Add the handler FUNCTION to be run at TIME and IDLE."
|
|
83 ;; First remove any old handlers that use this function.
|
|
84 (gnus-demon-remove-handler function)
|
|
85 ;; Then add the new one.
|
|
86 (push (list function time idle) gnus-demon-handlers)
|
|
87 (gnus-demon-init))
|
|
88
|
|
89 (defun gnus-demon-remove-handler (function &optional no-init)
|
|
90 "Remove the handler FUNCTION from the list of handlers."
|
110859
|
91 (gnus-alist-pull function gnus-demon-handlers)
|
17493
|
92 (unless no-init
|
|
93 (gnus-demon-init)))
|
|
94
|
111180
|
95 (defun gnus-demon-idle-since ()
|
|
96 "Return the number of seconds since when Emacs is idle."
|
|
97 (if (featurep 'xemacs)
|
|
98 (itimer-time-difference (current-time) last-command-event-time)
|
|
99 (float-time (or (current-idle-time)
|
|
100 '(0 0 0)))))
|
|
101
|
|
102 (defun gnus-demon-run-callback (func &optional idle)
|
|
103 "Run FUNC if Emacs has been idle for longer than IDLE seconds."
|
|
104 (unless gnus-inhibit-demon
|
|
105 (when (or (not idle)
|
|
106 (<= idle (gnus-demon-idle-since)))
|
|
107 (with-local-quit
|
|
108 (ignore-errors
|
|
109 (funcall func))))))
|
|
110
|
17493
|
111 (defun gnus-demon-init ()
|
|
112 "Initialize the Gnus daemon."
|
|
113 (interactive)
|
|
114 (gnus-demon-cancel)
|
111180
|
115 (dolist (handler gnus-demon-handlers)
|
24357
|
116 ;; Set up the timer.
|
111180
|
117 (let* ((func (nth 0 handler))
|
|
118 (time (nth 1 handler))
|
|
119 (idle (nth 2 handler))
|
|
120 ;; Compute time according with timestep.
|
|
121 ;; If t, replace by 1
|
|
122 (time (cond ((eq time t)
|
|
123 gnus-demon-timestep)
|
111812
5e488dbb17f7
nnir.el: Rearrange code to allow macros to be autoloaded by gnus-sum.el.
Katsumi Yamaoka <yamaoka@jpl.org>
diff
changeset
|
124 ((null time) nil)
|
111180
|
125 (t (* time gnus-demon-timestep))))
|
|
126 (timer
|
|
127 (cond
|
|
128 ;; (func number t)
|
|
129 ;; Call when Emacs has been idle for `time'
|
|
130 ((and (numberp time) (eq idle t))
|
111855
c587007a09f2
gnus-demon.el (gnus-demon-init): Call run-with-timer with time as argument, not t. XEmacs does not support that.
Katsumi Yamaoka <yamaoka@jpl.org>
diff
changeset
|
131 (run-with-timer time time 'gnus-demon-run-callback func time))
|
111180
|
132 ;; (func number number)
|
|
133 ;; Call every `time' when Emacs has been idle for `idle'
|
|
134 ((and (numberp time) (numberp idle))
|
111855
c587007a09f2
gnus-demon.el (gnus-demon-init): Call run-with-timer with time as argument, not t. XEmacs does not support that.
Katsumi Yamaoka <yamaoka@jpl.org>
diff
changeset
|
135 (run-with-timer time time 'gnus-demon-run-callback func idle))
|
111180
|
136 ;; (func nil number)
|
|
137 ;; Only call when Emacs has been idle for `idle'
|
|
138 ((and (null time) (numberp idle))
|
|
139 (run-with-idle-timer (* idle gnus-demon-timestep) t
|
|
140 'gnus-demon-run-callback func))
|
|
141 ;; (func number nil)
|
|
142 ;; Call every `time'
|
|
143 ((and (numberp time) (null idle))
|
|
144 (run-with-timer t time 'gnus-demon-run-callback func)))))
|
|
145 (when timer
|
|
146 (add-to-list 'gnus-demon-timers timer)))))
|
17493
|
147
|
|
148 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
|
|
149
|
|
150 (defun gnus-demon-cancel ()
|
|
151 "Cancel any Gnus daemons."
|
|
152 (interactive)
|
111180
|
153 (dolist (timer gnus-demon-timers)
|
|
154 (nnheader-cancel-timer timer))
|
|
155 (setq gnus-demon-timers nil))
|
17493
|
156
|
|
157 (defun gnus-demon-add-disconnection ()
|
|
158 "Add daemonic server disconnection to Gnus."
|
|
159 (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
|
|
160
|
|
161 (defun gnus-demon-close-connections ()
|
|
162 (save-window-excursion
|
|
163 (gnus-close-backends)))
|
|
164
|
24357
|
165 (defun gnus-demon-add-nntp-close-connection ()
|
|
166 "Add daemonic nntp server disconnection to Gnus.
|
|
167 If no commands have gone out via nntp during the last five
|
|
168 minutes, the connection is closed."
|
104050
|
169 (gnus-demon-add-handler 'gnus-demon-nntp-close-connection 5 nil))
|
24357
|
170
|
|
171 (defun gnus-demon-nntp-close-connection ()
|
|
172 (save-window-excursion
|
31716
|
173 (when (time-less-p '(0 300) (time-since nntp-last-command-time))
|
24357
|
174 (nntp-close-server))))
|
|
175
|
17493
|
176 (defun gnus-demon-add-scanmail ()
|
|
177 "Add daemonic scanning of mail from the mail backends."
|
|
178 (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
|
|
179
|
|
180 (defun gnus-demon-scan-mail ()
|
|
181 (save-window-excursion
|
|
182 (let ((servers gnus-opened-servers)
|
31716
|
183 server
|
|
184 (nnmail-fetched-sources (list t)))
|
17493
|
185 (while (setq server (car (pop servers)))
|
|
186 (and (gnus-check-backend-function 'request-scan (car server))
|
|
187 (or (gnus-server-opened server)
|
|
188 (gnus-open-server server))
|
|
189 (gnus-request-scan nil server))))))
|
|
190
|
|
191 (defun gnus-demon-add-rescan ()
|
|
192 "Add daemonic scanning of new articles from all backends."
|
|
193 (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
|
|
194
|
|
195 (defun gnus-demon-scan-news ()
|
24357
|
196 (let ((win (current-window-configuration)))
|
|
197 (unwind-protect
|
|
198 (save-window-excursion
|
110410
|
199 (when (gnus-alive-p)
|
|
200 (with-current-buffer gnus-group-buffer
|
|
201 (gnus-group-get-new-news))))
|
24357
|
202 (set-window-configuration win))))
|
17493
|
203
|
|
204 (defun gnus-demon-add-scan-timestamps ()
|
|
205 "Add daemonic updating of timestamps in empty newgroups."
|
|
206 (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
|
|
207
|
|
208 (defun gnus-demon-scan-timestamps ()
|
|
209 "Set the timestamp on all newsgroups with no unread and no ticked articles."
|
|
210 (when (gnus-alive-p)
|
|
211 (let ((cur-time (current-time))
|
|
212 (newsrc (cdr gnus-newsrc-alist))
|
|
213 info group unread has-ticked)
|
|
214 (while (setq info (pop newsrc))
|
|
215 (setq group (gnus-info-group info)
|
|
216 unread (gnus-group-unread group)
|
|
217 has-ticked (cdr (assq 'tick (gnus-info-marks info))))
|
|
218 (when (and (numberp unread)
|
|
219 (= unread 0)
|
|
220 (not has-ticked))
|
|
221 (gnus-group-set-parameter group 'timestamp cur-time))))))
|
|
222
|
|
223 (provide 'gnus-demon)
|
|
224
|
|
225 ;;; gnus-demon.el ends here
|