gnus-demon.el 9.09 KB
Newer Older
Glenn Morris's avatar
Glenn Morris committed
1
;;; gnus-demon.el --- daemonic Gnus behavior
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1995-2019 Free Software Foundation, Inc.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
4

5
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
6 7 8 9
;; Keywords: news

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
14 15 16 17 18 19 20

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
22 23 24 25 26

;;; Commentary:

;;; Code:

Glenn Morris's avatar
Glenn Morris committed
27
(eval-when-compile (require 'cl-lib))
28

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
29 30 31
(require 'gnus)
(require 'gnus-int)
(require 'nnheader)
32 33
(require 'nntp)
(require 'nnmail)
34

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
35
(defgroup gnus-demon nil
36
  "Demonic behavior."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
37 38 39 40 41 42 43 44
  :group 'gnus)

(defcustom gnus-demon-handlers nil
  "Alist of daemonic handlers to be run at intervals.
Each handler is a list on the form

\(FUNCTION TIME IDLE)

45 46 47 48 49 50 51 52 53 54
FUNCTION is the function to be called.  TIME is the number of
`gnus-demon-timestep's between each call.
If nil, never call. If t, call each `gnus-demon-timestep'.

If IDLE is t, only call each time Emacs has been idle for TIME.
If IDLE is a number, only call when Emacs has been idle more than
this number of `gnus-demon-timestep's.
If IDLE is nil, don't care about idleness.
If IDLE is a number and TIME is nil, then call once each time
Emacs has been idle for IDLE `gnus-demon-timestep's."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
55 56 57 58 59 60 61 62 63 64 65 66
  :group 'gnus-demon
  :type '(repeat (list function
		       (choice :tag "Time"
			       (const :tag "never" nil)
			       (const :tag "one" t)
			       (integer :tag "steps" 1))
		       (choice :tag "Idle"
			       (const :tag "don't care" nil)
			       (const :tag "for a while" t)
			       (integer :tag "steps" 1)))))

(defcustom gnus-demon-timestep 60
67
  "Number of seconds in each demon timestep."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
68 69 70 71 72
  :group 'gnus-demon
  :type 'integer)

;;; Internal variables.

73
(defvar gnus-demon-timers nil
74
  "Plist of idle timers which are running.")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
75
(defvar gnus-inhibit-demon nil
76
  "If non-nil, no daemonic function will be run.")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
77 78 79 80 81 82 83 84 85 86 87 88 89

;;; Functions.

(defun gnus-demon-add-handler (function time idle)
  "Add the handler FUNCTION to be run at TIME and IDLE."
  ;; First remove any old handlers that use this function.
  (gnus-demon-remove-handler function)
  ;; Then add the new one.
  (push (list function time idle) gnus-demon-handlers)
  (gnus-demon-init))

(defun gnus-demon-remove-handler (function &optional no-init)
  "Remove the handler FUNCTION from the list of handlers."
90
  (gnus-alist-pull function gnus-demon-handlers)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
91 92 93
  (unless no-init
    (gnus-demon-init)))

94 95
(defun gnus-demon-idle-since ()
  "Return the number of seconds since when Emacs is idle."
96
  (float-time (or (current-idle-time) '(0 0 0))))
97

98 99 100 101 102
(defun gnus-demon-run-callback (func &optional idle time special)
  "Run FUNC if Emacs has been idle for longer than IDLE seconds.
If not, and a TIME is given, restart a new idle timer, so FUNC
can be called at the next opportunity. Such a special idle run is
marked with SPECIAL."
103
  (unless gnus-inhibit-demon
Glenn Morris's avatar
Glenn Morris committed
104
    (cl-block run-callback
105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
      (when (eq idle t)
        (setq idle 0.001))
      (cond (special
             (setq gnus-demon-timers
                   (plist-put gnus-demon-timers func
                              (run-with-timer time time 'gnus-demon-run-callback
                                              func idle time))))
            ((and idle (> idle (gnus-demon-idle-since)))
             (when time
               (nnheader-cancel-timer (plist-get gnus-demon-timers func))
               (setq gnus-demon-timers
                     (plist-put gnus-demon-timers func
				(run-with-idle-timer idle nil
						     'gnus-demon-run-callback
						     func idle time t))))
Glenn Morris's avatar
Glenn Morris committed
120
             (cl-return-from run-callback)))
121
      (with-local-quit
122 123
        (ignore-errors
          (funcall func))))))
124

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
125 126 127 128
(defun gnus-demon-init ()
  "Initialize the Gnus daemon."
  (interactive)
  (gnus-demon-cancel)
129
  (dolist (handler gnus-demon-handlers)
130
    ;; Set up the timer.
131 132 133 134 135 136 137
    (let* ((func (nth 0 handler))
           (time (nth 1 handler))
           (idle (nth 2 handler))
           ;; Compute time according with timestep.
           ;; If t, replace by 1
           (time (cond ((eq time t)
                        gnus-demon-timestep)
138 139 140
                       ((null time)
			nil)
		       ((stringp time)
141
			(* (gnus-demon-time-to-step time) gnus-demon-timestep))
142 143
                       (t
			(* time gnus-demon-timestep))))
144 145 146 147 148 149
	   (idle (cond ((numberp idle)
			(* idle gnus-demon-timestep))
		       ((and (eq idle t) (numberp time))
			time)
		       (t
			idle)))
150

151 152 153 154 155
           (timer
            (cond
             ;; (func nil number)
             ;; Only call when Emacs has been idle for `idle'
             ((and (null time) (numberp idle))
156
              (run-with-idle-timer idle t 'gnus-demon-run-callback func))
157
             ;; (func number any)
158
             ;; Call every `time'
159
             ((integerp time)
160 161
              (run-with-timer time time 'gnus-demon-run-callback
			      func idle time))
162
             ;; (func string any)
163
             ((stringp time)
164 165
              (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback
			      func idle)))))
166
      (when timer
167
        (setq gnus-demon-timers (plist-put gnus-demon-timers func timer))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
168

169
(defun gnus-demon-time-to-step (time)
170
  "Find out how many steps to TIME, which is on the form \"17:43\"."
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
  (let* ((now (current-time))
	 ;; obtain NOW as discrete components -- make a vector for speed
	 (nowParts (decode-time now))
	 ;; obtain THEN as discrete components
	 (thenParts (parse-time-string time))
	 (thenHour (elt thenParts 2))
	 (thenMin (elt thenParts 1))
	 ;; convert time as elements into number of seconds since EPOCH.
	 (then (encode-time 0
			    thenMin
			    thenHour
			    ;; If THEN is earlier than NOW, make it
			    ;; same time tomorrow.  Doc for encode-time
			    ;; says that this is OK.
			    (+ (elt nowParts 3)
			       (if (or (< thenHour (elt nowParts 2))
				       (and (= thenHour (elt nowParts 2))
					    (<= thenMin (elt nowParts 1))))
				   1 0))
			    (elt nowParts 4)
			    (elt nowParts 5)
			    (elt nowParts 6)
			    (elt nowParts 7)
			    (elt nowParts 8)))
195 196 197
	 (diff (float-time (time-subtract then now))))
    ;; Return number of timesteps in the number of seconds.
    (round diff gnus-demon-timestep)))
198

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
199 200 201 202 203
(gnus-add-shutdown 'gnus-demon-cancel 'gnus)

(defun gnus-demon-cancel ()
  "Cancel any Gnus daemons."
  (interactive)
204 205
  (dotimes (i (/ (length gnus-demon-timers) 2))
    (nnheader-cancel-timer (nth (1+ (* i 2)) gnus-demon-timers)))
206
  (setq gnus-demon-timers nil))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
207 208 209 210 211 212 213 214 215

(defun gnus-demon-add-disconnection ()
  "Add daemonic server disconnection to Gnus."
  (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))

(defun gnus-demon-close-connections ()
  (save-window-excursion
    (gnus-close-backends)))

216 217 218 219
(defun gnus-demon-add-nntp-close-connection ()
  "Add daemonic nntp server disconnection to Gnus.
If no commands have gone out via nntp during the last five
minutes, the connection is closed."
220
  (gnus-demon-add-handler 'gnus-demon-nntp-close-connection 5 nil))
221 222 223

(defun gnus-demon-nntp-close-connection ()
  (save-window-excursion
224
    (when (time-less-p '(0 300) (time-since nntp-last-command-time))
225 226
      (nntp-close-server))))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
227 228 229 230 231 232 233
(defun gnus-demon-add-scanmail ()
  "Add daemonic scanning of mail from the mail backends."
  (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))

(defun gnus-demon-scan-mail ()
  (save-window-excursion
    (let ((servers gnus-opened-servers)
234 235
	  server
	  (nnmail-fetched-sources (list t)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
236 237 238 239 240 241 242 243 244 245 246
      (while (setq server (car (pop servers)))
	(and (gnus-check-backend-function 'request-scan (car server))
	     (or (gnus-server-opened server)
		 (gnus-open-server server))
	     (gnus-request-scan nil server))))))

(defun gnus-demon-add-rescan ()
  "Add daemonic scanning of new articles from all backends."
  (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))

(defun gnus-demon-scan-news ()
247 248 249
  (let ((win (current-window-configuration)))
    (unwind-protect
	(save-window-excursion
250 251 252
	  (when (gnus-alive-p)
	    (with-current-buffer gnus-group-buffer
	      (gnus-group-get-new-news))))
253
      (set-window-configuration win))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276

(defun gnus-demon-add-scan-timestamps ()
  "Add daemonic updating of timestamps in empty newgroups."
  (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))

(defun gnus-demon-scan-timestamps ()
  "Set the timestamp on all newsgroups with no unread and no ticked articles."
  (when (gnus-alive-p)
    (let ((cur-time (current-time))
	  (newsrc (cdr gnus-newsrc-alist))
	  info group unread has-ticked)
      (while (setq info (pop newsrc))
	(setq group (gnus-info-group info)
	      unread (gnus-group-unread group)
	      has-ticked (cdr (assq 'tick (gnus-info-marks info))))
	(when (and (numberp unread)
		   (= unread 0)
		   (not has-ticked))
	  (gnus-group-set-parameter group 'timestamp cur-time))))))

(provide 'gnus-demon)

;;; gnus-demon.el ends here