cgit.sxemacs.org Git - gnus/blob - lisp/gnus-demon.el

   1 ;;; gnus-demon.el --- daemonic Gnus behavior
   2
   3 ;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (eval-when-compile (require 'cl))
  28
  29 (require 'gnus)
  30 (require 'gnus-int)
  31 (require 'nnheader)
  32 (require 'nntp)
  33 (require 'nnmail)
  34
  35 (defgroup gnus-demon nil
  36   "Demonic behavior."
  37   :group 'gnus)
  38
  39 (defcustom gnus-demon-handlers nil
  40   "Alist of daemonic handlers to be run at intervals.
  41 Each handler is a list on the form
  42
  43 \(FUNCTION TIME IDLE)
  44
  45 FUNCTION is the function to be called.  TIME is the number of
  46 `gnus-demon-timestep's between each call.
  47 If nil, never call. If t, call each `gnus-demon-timestep'.
  48
  49 If IDLE is t, only call each time Emacs has been idle for TIME.
  50 If IDLE is a number, only call when Emacs has been idle more than
  51 this number of `gnus-demon-timestep's.
  52 If IDLE is nil, don't care about idleness.
  53 If IDLE is a number and TIME is nil, then call once each time
  54 Emacs has been idle for IDLE `gnus-demon-timestep's."
  55   :group 'gnus-demon
  56   :type '(repeat (list function
  57                        (choice :tag "Time"
  58                                (const :tag "never" nil)
  59                                (const :tag "one" t)
  60                                (integer :tag "steps" 1))
  61                        (choice :tag "Idle"
  62                                (const :tag "don't care" nil)
  63                                (const :tag "for a while" t)
  64                                (integer :tag "steps" 1)))))
  65
  66 (defcustom gnus-demon-timestep 60
  67   "Number of seconds in each demon timestep."
  68   :group 'gnus-demon
  69   :type 'integer)
  70
  71 ;;; Internal variables.
  72
  73 (defvar gnus-demon-timers nil
  74   "Plist of idle timers which are running.")
  75 (defvar gnus-inhibit-demon nil
  76   "If non-nil, no daemonic function will be run.")
  77
  78 ;;; Functions.
  79
  80 (defun gnus-demon-add-handler (function time idle)
  81   "Add the handler FUNCTION to be run at TIME and IDLE."
  82   ;; First remove any old handlers that use this function.
  83   (gnus-demon-remove-handler function)
  84   ;; Then add the new one.
  85   (push (list function time idle) gnus-demon-handlers)
  86   (gnus-demon-init))
  87
  88 (defun gnus-demon-remove-handler (function &optional no-init)
  89   "Remove the handler FUNCTION from the list of handlers."
  90   (gnus-alist-pull function gnus-demon-handlers)
  91   (unless no-init
  92     (gnus-demon-init)))
  93
  94 (defun gnus-demon-idle-since ()
  95   "Return the number of seconds since when Emacs is idle."
  96   (if (featurep 'xemacs)
  97       (itimer-time-difference (current-time) last-command-event-time)
  98     (float-time (or (current-idle-time)
  99                     '(0 0 0)))))
 100
 101 (defun gnus-demon-run-callback (func &optional idle time special)
 102   "Run FUNC if Emacs has been idle for longer than IDLE seconds.
 103 If not, and a TIME is given, restart a new idle timer, so FUNC
 104 can be called at the next opportunity. Such a special idle run is
 105 marked with SPECIAL."
 106   (unless gnus-inhibit-demon
 107     (block run-callback
 108       (when (eq idle t)
 109         (setq idle 0.001))
 110       (cond (special
 111              (setq gnus-demon-timers
 112                    (plist-put gnus-demon-timers func
 113                               (run-with-timer time time 'gnus-demon-run-callback
 114                                               func idle time))))
 115             ((and idle (> idle (gnus-demon-idle-since)))
 116              (when time
 117                (nnheader-cancel-timer (plist-get gnus-demon-timers func))
 118                (setq gnus-demon-timers
 119                      (plist-put gnus-demon-timers func
 120                                 (run-with-idle-timer idle nil
 121                                                      'gnus-demon-run-callback
 122                                                      func idle time t))))
 123              (return-from run-callback)))
 124       (with-local-quit
 125         (ignore-errors
 126           (funcall func))))))
 127
 128 (defun gnus-demon-init ()
 129   "Initialize the Gnus daemon."
 130   (interactive)
 131   (gnus-demon-cancel)
 132   (dolist (handler gnus-demon-handlers)
 133     ;; Set up the timer.
 134     (let* ((func (nth 0 handler))
 135            (time (nth 1 handler))
 136            (time-type (type-of time))
 137            (idle (nth 2 handler))
 138            ;; Compute time according with timestep.
 139            ;; If t, replace by 1
 140            (time (cond ((eq time t)
 141                         gnus-demon-timestep)
 142                        ((null time)
 143                         nil)
 144                        ((stringp time)
 145                         (* (gnus-demon-time-to-step time) gnus-demon-timestep))
 146                        (t
 147                         (* time gnus-demon-timestep))))
 148            (idle (if (numberp idle)
 149                      (* idle gnus-demon-timestep)
 150                    idle))
 151
 152            (timer
 153             (cond
 154              ;; (func nil number)
 155              ;; Only call when Emacs has been idle for `idle'
 156              ((and (null time) (numberp idle))
 157               (run-with-idle-timer idle t 'gnus-demon-run-callback func))
 158              ;; (func number any)
 159              ;; Call every `time'
 160              ((eq time-type 'integer)
 161               (run-with-timer time time 'gnus-demon-run-callback
 162                               func idle time))
 163              ;; (func string any)
 164              ((eq time-type 'string)
 165               (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback
 166                               func idle)))))
 167       (when timer
 168         (setq gnus-demon-timers (plist-put gnus-demon-timers func timer))))))
 169
 170 (defun gnus-demon-time-to-step (time)
 171   "Find out how many steps to TIME, which is on the form \"17:43\"."
 172   (let* ((now (current-time))
 173          ;; obtain NOW as discrete components -- make a vector for speed
 174          (nowParts (decode-time now))
 175          ;; obtain THEN as discrete components
 176          (thenParts (parse-time-string time))
 177          (thenHour (elt thenParts 2))
 178          (thenMin (elt thenParts 1))
 179          ;; convert time as elements into number of seconds since EPOCH.
 180          (then (encode-time 0
 181                             thenMin
 182                             thenHour
 183                             ;; If THEN is earlier than NOW, make it
 184                             ;; same time tomorrow.  Doc for encode-time
 185                             ;; says that this is OK.
 186                             (+ (elt nowParts 3)
 187                                (if (or (< thenHour (elt nowParts 2))
 188                                        (and (= thenHour (elt nowParts 2))
 189                                             (<= thenMin (elt nowParts 1))))
 190                                    1 0))
 191                             (elt nowParts 4)
 192                             (elt nowParts 5)
 193                             (elt nowParts 6)
 194                             (elt nowParts 7)
 195                             (elt nowParts 8)))
 196          ;; calculate number of seconds between NOW and THEN
 197          (diff (+ (* 65536 (- (car then) (car now)))
 198                   (- (cadr then) (cadr now)))))
 199     ;; return number of timesteps in the number of seconds
 200     (round (/ diff gnus-demon-timestep))))
 201
 202 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
 203
 204 (defun gnus-demon-cancel ()
 205   "Cancel any Gnus daemons."
 206   (interactive)
 207   (dotimes (i (/ (length gnus-demon-timers) 2))
 208     (nnheader-cancel-timer (nth (1+ (* i 2)) gnus-demon-timers)))
 209   (setq gnus-demon-timers nil))
 210
 211 (defun gnus-demon-add-disconnection ()
 212   "Add daemonic server disconnection to Gnus."
 213   (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
 214
 215 (defun gnus-demon-close-connections ()
 216   (save-window-excursion
 217     (gnus-close-backends)))
 218
 219 (defun gnus-demon-add-nntp-close-connection ()
 220   "Add daemonic nntp server disconnection to Gnus.
 221 If no commands have gone out via nntp during the last five
 222 minutes, the connection is closed."
 223   (gnus-demon-add-handler 'gnus-demon-nntp-close-connection 5 nil))
 224
 225 (defun gnus-demon-nntp-close-connection ()
 226   (save-window-excursion
 227     (when (time-less-p '(0 300) (time-since nntp-last-command-time))
 228       (nntp-close-server))))
 229
 230 (defun gnus-demon-add-scanmail ()
 231   "Add daemonic scanning of mail from the mail backends."
 232   (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
 233
 234 (defun gnus-demon-scan-mail ()
 235   (save-window-excursion
 236     (let ((servers gnus-opened-servers)
 237           server
 238           (nnmail-fetched-sources (list t)))
 239       (while (setq server (car (pop servers)))
 240         (and (gnus-check-backend-function 'request-scan (car server))
 241              (or (gnus-server-opened server)
 242                  (gnus-open-server server))
 243              (gnus-request-scan nil server))))))
 244
 245 (defun gnus-demon-add-rescan ()
 246   "Add daemonic scanning of new articles from all backends."
 247   (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
 248
 249 (defun gnus-demon-scan-news ()
 250   (let ((win (current-window-configuration)))
 251     (unwind-protect
 252         (save-window-excursion
 253           (when (gnus-alive-p)
 254             (with-current-buffer gnus-group-buffer
 255               (gnus-group-get-new-news))))
 256       (set-window-configuration win))))
 257
 258 (defun gnus-demon-add-scan-timestamps ()
 259   "Add daemonic updating of timestamps in empty newgroups."
 260   (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
 261
 262 (defun gnus-demon-scan-timestamps ()
 263   "Set the timestamp on all newsgroups with no unread and no ticked articles."
 264   (when (gnus-alive-p)
 265     (let ((cur-time (current-time))
 266           (newsrc (cdr gnus-newsrc-alist))
 267           info group unread has-ticked)
 268       (while (setq info (pop newsrc))
 269         (setq group (gnus-info-group info)
 270               unread (gnus-group-unread group)
 271               has-ticked (cdr (assq 'tick (gnus-info-marks info))))
 272         (when (and (numberp unread)
 273                    (= unread 0)
 274                    (not has-ticked))
 275           (gnus-group-set-parameter group 'timestamp cur-time))))))
 276
 277 (provide 'gnus-demon)
 278
 279 ;;; gnus-demon.el ends here