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

   1 ;;; gnus-demon.el --- daemonic Gnus behavior
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010 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 (defgroup gnus-demon nil
  38   "Demonic behavior."
  39   :group 'gnus)
  40
  41 (defcustom gnus-demon-handlers nil
  42   "Alist of daemonic handlers to be run at intervals.
  43 Each handler is a list on the form
  44
  45 \(FUNCTION TIME IDLE)
  46
  47 FUNCTION is the function to be called.  TIME is the number of
  48 `gnus-demon-timestep's between each call.
  49 If nil, never call. If t, call each `gnus-demon-timestep'.
  50
  51 If IDLE is t, only call each time Emacs has been idle for TIME.
  52 If IDLE is a number, only call when Emacs has been idle more than
  53 this number of `gnus-demon-timestep's.
  54 If IDLE is nil, don't care about idleness.
  55 If IDLE is a number and TIME is nil, then call once each time
  56 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-timers nil
  76   "List of idle timers which are running.")
  77 (defvar gnus-inhibit-demon nil
  78   "If non-nil, no daemonic function will be run.")
  79
  80 ;;; Functions.
  81
  82 (defun gnus-demon-add-handler (function time idle)
  83   "Add the handler FUNCTION to be run at TIME and IDLE."
  84   ;; First remove any old handlers that use this function.
  85   (gnus-demon-remove-handler function)
  86   ;; Then add the new one.
  87   (push (list function time idle) gnus-demon-handlers)
  88   (gnus-demon-init))
  89
  90 (defun gnus-demon-remove-handler (function &optional no-init)
  91   "Remove the handler FUNCTION from the list of handlers."
  92   (gnus-alist-pull function gnus-demon-handlers)
  93   (unless no-init
  94     (gnus-demon-init)))
  95
  96 (defun gnus-demon-idle-since ()
  97   "Return the number of seconds since when Emacs is idle."
  98   (if (featurep 'xemacs)
  99       (itimer-time-difference (current-time) last-command-event-time)
 100     (float-time (or (current-idle-time)
 101                     '(0 0 0)))))
 102
 103 (defun gnus-demon-run-callback (func &optional idle)
 104   "Run FUNC if Emacs has been idle for longer than IDLE seconds."
 105   (unless gnus-inhibit-demon
 106     (when (or (not idle)
 107               (<= idle (gnus-demon-idle-since)))
 108       (gnus-with-local-quit
 109        (ignore-errors
 110          (funcall func))))))
 111
 112 (defun gnus-demon-init ()
 113   "Initialize the Gnus daemon."
 114   (interactive)
 115   (gnus-demon-cancel)
 116   (dolist (handler gnus-demon-handlers)
 117     ;; Set up the timer.
 118     (let* ((func (nth 0 handler))
 119            (time (nth 1 handler))
 120            (idle (nth 2 handler))
 121            ;; Compute time according with timestep.
 122            ;; If t, replace by 1
 123            (time (cond ((eq time t)
 124                         gnus-demon-timestep)
 125                        ((null time))
 126                        (t (* time gnus-demon-timestep))))
 127            (timer
 128             (cond
 129              ;; (func number t)
 130              ;; Call when Emacs has been idle for `time'
 131              ((and (numberp time) (eq idle t))
 132               (run-with-timer t time 'gnus-demon-run-callback func time))
 133              ;; (func number number)
 134              ;; Call every `time' when Emacs has been idle for `idle'
 135              ((and (numberp time) (numberp idle))
 136               (run-with-timer t time 'gnus-demon-run-callback func idle))
 137              ;; (func nil number)
 138              ;; Only call when Emacs has been idle for `idle'
 139              ((and (null time) (numberp idle))
 140               (run-with-idle-timer (* idle gnus-demon-timestep) t
 141                                    'gnus-demon-run-callback func))
 142              ;; (func number nil)
 143              ;; Call every `time'
 144              ((and (numberp time) (null idle))
 145               (run-with-timer t time 'gnus-demon-run-callback func)))))
 146       (when timer
 147         (add-to-list 'gnus-demon-timers timer)))))
 148
 149 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
 150
 151 (defun gnus-demon-cancel ()
 152   "Cancel any Gnus daemons."
 153   (interactive)
 154   (dolist (timer gnus-demon-timers)
 155     (nnheader-cancel-timer timer))
 156   (setq gnus-demon-timers nil))
 157
 158 (defun gnus-demon-add-disconnection ()
 159   "Add daemonic server disconnection to Gnus."
 160   (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
 161
 162 (defun gnus-demon-close-connections ()
 163   (save-window-excursion
 164     (gnus-close-backends)))
 165
 166 (defun gnus-demon-add-nntp-close-connection ()
 167   "Add daemonic nntp server disconnection to Gnus.
 168 If no commands have gone out via nntp during the last five
 169 minutes, the connection is closed."
 170   (gnus-demon-add-handler 'gnus-demon-nntp-close-connection 5 nil))
 171
 172 (defun gnus-demon-nntp-close-connection ()
 173   (save-window-excursion
 174     (when (time-less-p '(0 300) (time-since nntp-last-command-time))
 175       (nntp-close-server))))
 176
 177 (defun gnus-demon-add-scanmail ()
 178   "Add daemonic scanning of mail from the mail backends."
 179   (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
 180
 181 (defun gnus-demon-scan-mail ()
 182   (save-window-excursion
 183     (let ((servers gnus-opened-servers)
 184           server
 185           (nnmail-fetched-sources (list t)))
 186       (while (setq server (car (pop servers)))
 187         (and (gnus-check-backend-function 'request-scan (car server))
 188              (or (gnus-server-opened server)
 189                  (gnus-open-server server))
 190              (gnus-request-scan nil server))))))
 191
 192 (defun gnus-demon-add-rescan ()
 193   "Add daemonic scanning of new articles from all backends."
 194   (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
 195
 196 (defun gnus-demon-scan-news ()
 197   (let ((win (current-window-configuration)))
 198     (unwind-protect
 199         (save-window-excursion
 200           (when (gnus-alive-p)
 201             (with-current-buffer gnus-group-buffer
 202               (gnus-group-get-new-news))))
 203       (set-window-configuration win))))
 204
 205 (defun gnus-demon-add-scan-timestamps ()
 206   "Add daemonic updating of timestamps in empty newgroups."
 207   (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
 208
 209 (defun gnus-demon-scan-timestamps ()
 210   "Set the timestamp on all newsgroups with no unread and no ticked articles."
 211   (when (gnus-alive-p)
 212     (let ((cur-time (current-time))
 213           (newsrc (cdr gnus-newsrc-alist))
 214           info group unread has-ticked)
 215       (while (setq info (pop newsrc))
 216         (setq group (gnus-info-group info)
 217               unread (gnus-group-unread group)
 218               has-ticked (cdr (assq 'tick (gnus-info-marks info))))
 219         (when (and (numberp unread)
 220                    (= unread 0)
 221                    (not has-ticked))
 222           (gnus-group-set-parameter group 'timestamp cur-time))))))
 223
 224 (provide 'gnus-demon)
 225
 226 ;;; gnus-demon.el ends here