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

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