lisp/gnus/gnus-demon.el

   1 ;;; gnus-demon.el --- daemonic Gnus behaviour
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  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
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (eval-when-compile (require 'cl))
  29
  30 (require 'gnus)
  31 (require 'gnus-int)
  32 (require 'nnheader)
  33 (require 'nntp)
  34 (require 'nnmail)
  35 (require 'gnus-util)
  36
  37 (autoload 'parse-time-string "parse-time" nil nil)
  38
  39 (defgroup gnus-demon nil
  40   "Demonic behavior."
  41   :group 'gnus)
  42
  43 (defcustom gnus-demon-handlers nil
  44   "Alist of daemonic handlers to be run at intervals.
  45 Each handler is a list on the form
  46
  47 \(FUNCTION TIME IDLE)
  48
  49 FUNCTION is the function to be called.
  50 TIME is the number of `gnus-demon-timestep's between each call.
  51 If nil, never call.  If t, call each `gnus-demon-timestep'.
  52 If IDLE is t, only call if Emacs has been idle for a while.  If IDLE
  53 is a number, only call when Emacs has been idle more than this number
  54 of `gnus-demon-timestep's.  If IDLE is nil, don't care about
  55 idleness.  If IDLE is a number and TIME is nil, then call once each
  56 time Emacs has been idle for IDLE `gnus-demon-timestep's."
  57   :group 'gnus-demon
  58   :type '(repeat (list function
  59                        (choice :tag "Time"
  60                                (const :tag "never" nil)
  61                                (const :tag "one" t)
  62                                (integer :tag "steps" 1))
  63                        (choice :tag "Idle"
  64                                (const :tag "don't care" nil)
  65                                (const :tag "for a while" t)
  66                                (integer :tag "steps" 1)))))
  67
  68 (defcustom gnus-demon-timestep 60
  69   "*Number of seconds in each demon timestep."
  70   :group 'gnus-demon
  71   :type 'integer)
  72
  73 ;;; Internal variables.
  74
  75 (defvar gnus-demon-timer nil)
  76 (defvar gnus-demon-idle-has-been-called nil)
  77 (defvar gnus-demon-idle-time 0)
  78 (defvar gnus-demon-handler-state nil)
  79 (defvar gnus-demon-last-keys nil)
  80 (defvar gnus-inhibit-demon nil
  81   "*If non-nil, no daemonic function will be run.")
  82
  83 ;;; Functions.
  84
  85 (defun gnus-demon-add-handler (function time idle)
  86   "Add the handler FUNCTION to be run at TIME and IDLE."
  87   ;; First remove any old handlers that use this function.
  88   (gnus-demon-remove-handler function)
  89   ;; Then add the new one.
  90   (push (list function time idle) gnus-demon-handlers)
  91   (gnus-demon-init))
  92
  93 (defun gnus-demon-remove-handler (function &optional no-init)
  94   "Remove the handler FUNCTION from the list of handlers."
  95   (gnus-pull function gnus-demon-handlers)
  96   (unless no-init
  97     (gnus-demon-init)))
  98
  99 (defun gnus-demon-init ()
 100   "Initialize the Gnus daemon."
 101   (interactive)
 102   (gnus-demon-cancel)
 103   (when gnus-demon-handlers
 104     ;; Set up the timer.
 105     (setq gnus-demon-timer
 106           (run-at-time
 107            gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
 108     ;; Reset control variables.
 109     (setq gnus-demon-handler-state
 110           (mapcar
 111            (lambda (handler)
 112              (list (car handler) (gnus-demon-time-to-step (nth 1 handler))
 113                    (nth 2 handler)))
 114            gnus-demon-handlers))
 115     (setq gnus-demon-idle-time 0)
 116     (setq gnus-demon-idle-has-been-called nil)))
 117
 118 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
 119
 120 (defun gnus-demon-cancel ()
 121   "Cancel any Gnus daemons."
 122   (interactive)
 123   (when gnus-demon-timer
 124     (nnheader-cancel-timer gnus-demon-timer))
 125   (setq gnus-demon-timer nil
 126         gnus-demon-idle-has-been-called nil)
 127   (condition-case ()
 128       (nnheader-cancel-function-timers 'gnus-demon)
 129     (error t)))
 130
 131 (defun gnus-demon-is-idle-p ()
 132   "Whether Emacs is idle or not."
 133   ;; We do this simply by comparing the 100 most recent keystrokes
 134   ;; with the ones we had last time.  If they are the same, one might
 135   ;; guess that Emacs is indeed idle.  This only makes sense if one
 136   ;; calls this function seldom -- like once a minute, which is what
 137   ;; we do here.
 138   (let ((keys (recent-keys)))
 139     (or (equal keys gnus-demon-last-keys)
 140         (progn
 141           (setq gnus-demon-last-keys keys)
 142           nil))))
 143
 144 (defun gnus-demon-time-to-step (time)
 145   "Find out how many seconds to TIME, which is on the form \"17:43\"."
 146   (if (not (stringp time))
 147       time
 148     (let* ((now (current-time))
 149            ;; obtain NOW as discrete components -- make a vector for speed
 150            (nowParts (decode-time now))
 151            ;; obtain THEN as discrete components
 152            (thenParts (parse-time-string time))
 153            (thenHour (elt thenParts 2))
 154            (thenMin (elt thenParts 1))
 155            ;; convert time as elements into number of seconds since EPOCH.
 156            (then (encode-time 0
 157                               thenMin
 158                               thenHour
 159                               ;; If THEN is earlier than NOW, make it
 160                               ;; same time tomorrow.  Doc for encode-time
 161                               ;; says that this is OK.
 162                               (+ (elt nowParts 3)
 163                                  (if (or (< thenHour (elt nowParts 2))
 164                                          (and (= thenHour (elt nowParts 2))
 165                                               (<= thenMin (elt nowParts 1))))
 166                                      1 0))
 167                               (elt nowParts 4)
 168                               (elt nowParts 5)
 169                               (elt nowParts 6)
 170                               (elt nowParts 7)
 171                               (elt nowParts 8)))
 172            ;; calculate number of seconds between NOW and THEN
 173            (diff (+ (* 65536 (- (car then) (car now)))
 174                     (- (cadr then) (cadr now)))))
 175       ;; return number of timesteps in the number of seconds
 176       (round (/ diff gnus-demon-timestep)))))
 177
 178 (defun gnus-demon ()
 179   "The Gnus daemon that takes care of running all Gnus handlers."
 180   ;; Increase or reset the time Emacs has been idle.
 181   (if (gnus-demon-is-idle-p)
 182       (incf gnus-demon-idle-time)
 183     (setq gnus-demon-idle-time 0)
 184     (setq gnus-demon-idle-has-been-called nil))
 185   ;; Disable all daemonic stuff if we're in the minibuffer
 186   (when (and (not (window-minibuffer-p (selected-window)))
 187              (not gnus-inhibit-demon))
 188     ;; Then we go through all the handler and call those that are
 189     ;; sufficiently ripe.
 190     (let ((handlers gnus-demon-handler-state)
 191           (gnus-inhibit-demon t)
 192           ;; Try to avoid dialog boxes, e.g. by Mailcrypt.
 193           ;; Unfortunately, Emacs 20's `message-or-box...' doesn't
 194           ;; obey `use-dialog-box'.
 195           use-dialog-box (last-nonmenu-event 10)
 196           handler time idle)
 197       (while handlers
 198         (setq handler (pop handlers))
 199         (cond
 200          ((numberp (setq time (nth 1 handler)))
 201           ;; These handlers use a regular timeout mechanism.  We decrease
 202           ;; the timer if it hasn't reached zero yet.
 203           (unless (zerop time)
 204             (setcar (nthcdr 1 handler) (decf time)))
 205           (and (zerop time)             ; If the timer now is zero...
 206                ;; Test for appropriate idleness
 207                (progn
 208                  (setq idle (nth 2 handler))
 209                  (cond
 210                   ((null idle) t)       ; Don't care about idle.
 211                   ((numberp idle)       ; Numerical idle...
 212                    (< idle gnus-demon-idle-time)) ; Idle timed out.
 213                   (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle.
 214                ;; So we call the handler.
 215                (gnus-with-local-quit
 216                  (ignore-errors (funcall (car handler)))
 217                  ;; And reset the timer.
 218                  (setcar (nthcdr 1 handler)
 219                          (gnus-demon-time-to-step
 220                           (nth 1 (assq (car handler) gnus-demon-handlers)))))))
 221          ;; These are only supposed to be called when Emacs is idle.
 222          ((null (setq idle (nth 2 handler)))
 223           ;; We do nothing.
 224           )
 225          ((and (not (numberp idle))
 226                (gnus-demon-is-idle-p))
 227           ;; We want to call this handler each and every time that
 228           ;; Emacs is idle.
 229           (gnus-with-local-quit
 230             (ignore-errors (funcall (car handler)))))
 231          (t
 232           ;; We want to call this handler only if Emacs has been idle
 233           ;; for a specified number of timesteps.
 234           (and (not (memq (car handler) gnus-demon-idle-has-been-called))
 235                (< idle gnus-demon-idle-time)
 236                (gnus-demon-is-idle-p)
 237                (gnus-with-local-quit
 238                  (ignore-errors (funcall (car handler)))
 239                  ;; Make sure the handler won't be called once more in
 240                  ;; this idle-cycle.
 241                  (push (car handler) gnus-demon-idle-has-been-called)))))))))
 242
 243 (defun gnus-demon-add-nocem ()
 244   "Add daemonic NoCeM handling to Gnus."
 245   (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30))
 246
 247 (defun gnus-demon-scan-nocem ()
 248   "Scan NoCeM groups for NoCeM messages."
 249   (save-window-excursion
 250     (gnus-nocem-scan-groups)))
 251
 252 (defun gnus-demon-add-disconnection ()
 253   "Add daemonic server disconnection to Gnus."
 254   (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
 255
 256 (defun gnus-demon-close-connections ()
 257   (save-window-excursion
 258     (gnus-close-backends)))
 259
 260 (defun gnus-demon-add-nntp-close-connection ()
 261   "Add daemonic nntp server disconnection to Gnus.
 262 If no commands have gone out via nntp during the last five
 263 minutes, the connection is closed."
 264   (gnus-demon-add-handler 'gnus-demon-nntp-close-connections 5 nil))
 265
 266 (defun gnus-demon-nntp-close-connection ()
 267   (save-window-excursion
 268     (when (time-less-p '(0 300) (time-since nntp-last-command-time))
 269       (nntp-close-server))))
 270
 271 (defun gnus-demon-add-scanmail ()
 272   "Add daemonic scanning of mail from the mail backends."
 273   (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
 274
 275 (defun gnus-demon-scan-mail ()
 276   (save-window-excursion
 277     (let ((servers gnus-opened-servers)
 278           server
 279           (nnmail-fetched-sources (list t)))
 280       (while (setq server (car (pop servers)))
 281         (and (gnus-check-backend-function 'request-scan (car server))
 282              (or (gnus-server-opened server)
 283                  (gnus-open-server server))
 284              (gnus-request-scan nil server))))))
 285
 286 (defun gnus-demon-add-rescan ()
 287   "Add daemonic scanning of new articles from all backends."
 288   (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
 289
 290 (defun gnus-demon-scan-news ()
 291   (let ((win (current-window-configuration)))
 292     (unwind-protect
 293         (save-window-excursion
 294           (save-excursion
 295             (when (gnus-alive-p)
 296               (save-excursion
 297                 (set-buffer gnus-group-buffer)
 298                 (gnus-group-get-new-news)))))
 299       (set-window-configuration win))))
 300
 301 (defun gnus-demon-add-scan-timestamps ()
 302   "Add daemonic updating of timestamps in empty newgroups."
 303   (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
 304
 305 (defun gnus-demon-scan-timestamps ()
 306   "Set the timestamp on all newsgroups with no unread and no ticked articles."
 307   (when (gnus-alive-p)
 308     (let ((cur-time (current-time))
 309           (newsrc (cdr gnus-newsrc-alist))
 310           info group unread has-ticked)
 311       (while (setq info (pop newsrc))
 312         (setq group (gnus-info-group info)
 313               unread (gnus-group-unread group)
 314               has-ticked (cdr (assq 'tick (gnus-info-marks info))))
 315         (when (and (numberp unread)
 316                    (= unread 0)
 317                    (not has-ticked))
 318           (gnus-group-set-parameter group 'timestamp cur-time))))))
 319
 320 (provide 'gnus-demon)
 321
 322 ;; arch-tag: 8dd5cd3d-6ae4-46b4-9b15-f5fca09fd392
 323 ;;; gnus-demon.el ends here