Update copyright year to 2014
[gnus] / lisp / gnus-demon.el
index 5720b64..9d2cf19 100644 (file)
@@ -1,17 +1,16 @@
-;;; gnus-demon.el --- daemonic Gnus behaviour
+;;; gnus-demon.el --- daemonic Gnus behavior
 
 
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2014 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +18,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 
 (require 'nnheader)
 (require 'nntp)
 (require 'nnmail)
 (require 'nnheader)
 (require 'nntp)
 (require 'nnmail)
-(require 'gnus-util)
-
-(autoload 'parse-time-string "parse-time" nil nil)
 
 (defgroup gnus-demon nil
 
 (defgroup gnus-demon nil
-  "Demonic behaviour."
+  "Demonic behavior."
   :group 'gnus)
 
 (defcustom gnus-demon-handlers nil
   :group 'gnus)
 
 (defcustom gnus-demon-handlers nil
@@ -48,14 +42,16 @@ Each handler is a list on the form
 
 \(FUNCTION TIME IDLE)
 
 
 \(FUNCTION TIME IDLE)
 
-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 if Emacs has been idle for a while.  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."
+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."
   :group 'gnus-demon
   :type '(repeat (list function
                       (choice :tag "Time"
   :group 'gnus-demon
   :type '(repeat (list function
                       (choice :tag "Time"
@@ -68,19 +64,16 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
                               (integer :tag "steps" 1)))))
 
 (defcustom gnus-demon-timestep 60
                               (integer :tag "steps" 1)))))
 
 (defcustom gnus-demon-timestep 60
-  "*Number of seconds in each demon timestep."
+  "Number of seconds in each demon timestep."
   :group 'gnus-demon
   :type 'integer)
 
 ;;; Internal variables.
 
   :group 'gnus-demon
   :type 'integer)
 
 ;;; Internal variables.
 
-(defvar gnus-demon-timer nil)
-(defvar gnus-demon-idle-has-been-called nil)
-(defvar gnus-demon-idle-time 0)
-(defvar gnus-demon-handler-state nil)
-(defvar gnus-demon-last-keys nil)
+(defvar gnus-demon-timers nil
+  "Plist of idle timers which are running.")
 (defvar gnus-inhibit-demon nil
 (defvar gnus-inhibit-demon nil
-  "*If non-nil, no daemonic function will be run.")
+  "If non-nil, no daemonic function will be run.")
 
 ;;; Functions.
 
 
 ;;; Functions.
 
@@ -94,161 +87,128 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
 
 (defun gnus-demon-remove-handler (function &optional no-init)
   "Remove the handler FUNCTION from the list of handlers."
 
 (defun gnus-demon-remove-handler (function &optional no-init)
   "Remove the handler FUNCTION from the list of handlers."
-  (gnus-pull function gnus-demon-handlers)
+  (gnus-alist-pull function gnus-demon-handlers)
   (unless no-init
     (gnus-demon-init)))
 
   (unless no-init
     (gnus-demon-init)))
 
+(defun gnus-demon-idle-since ()
+  "Return the number of seconds since when Emacs is idle."
+  (if (featurep 'xemacs)
+      (itimer-time-difference (current-time) last-command-event-time)
+    (float-time (or (current-idle-time)
+                    '(0 0 0)))))
+
+(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."
+  (unless gnus-inhibit-demon
+    (block run-callback
+      (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))))
+             (return-from run-callback)))
+      (with-local-quit
+        (ignore-errors
+          (funcall func))))))
+
 (defun gnus-demon-init ()
   "Initialize the Gnus daemon."
   (interactive)
   (gnus-demon-cancel)
 (defun gnus-demon-init ()
   "Initialize the Gnus daemon."
   (interactive)
   (gnus-demon-cancel)
-  (when gnus-demon-handlers
+  (dolist (handler gnus-demon-handlers)
     ;; Set up the timer.
     ;; Set up the timer.
-    (setq gnus-demon-timer
-         (run-at-time
-          gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
-    ;; Reset control variables.
-    (setq gnus-demon-handler-state
-         (mapcar
-          (lambda (handler)
-            (list (car handler) (gnus-demon-time-to-step (nth 1 handler))
-                  (nth 2 handler)))
-          gnus-demon-handlers))
-    (setq gnus-demon-idle-time 0)
-    (setq gnus-demon-idle-has-been-called nil)))
+    (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)
+                       ((null time)
+                       nil)
+                      ((stringp time)
+                       (* (gnus-demon-time-to-step time) gnus-demon-timestep))
+                       (t
+                       (* time gnus-demon-timestep))))
+          (idle (cond ((numberp idle)
+                       (* idle gnus-demon-timestep))
+                      ((and (eq idle t) (numberp time))
+                       time)
+                      (t
+                       idle)))
+
+           (timer
+            (cond
+             ;; (func nil number)
+             ;; Only call when Emacs has been idle for `idle'
+             ((and (null time) (numberp idle))
+              (run-with-idle-timer idle t 'gnus-demon-run-callback func))
+             ;; (func number any)
+             ;; Call every `time'
+             ((integerp time)
+              (run-with-timer time time 'gnus-demon-run-callback
+                             func idle time))
+             ;; (func string any)
+             ((stringp time)
+              (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback
+                             func idle)))))
+      (when timer
+        (setq gnus-demon-timers (plist-put gnus-demon-timers func timer))))))
+
+(defun gnus-demon-time-to-step (time)
+  "Find out how many steps to TIME, which is on the form \"17:43\"."
+  (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)))
+        ;; calculate number of seconds between NOW and THEN
+        (diff (+ (* 65536 (- (car then) (car now)))
+                 (- (cadr then) (cadr now)))))
+    ;; return number of timesteps in the number of seconds
+    (round (/ diff gnus-demon-timestep))))
 
 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
 
 (defun gnus-demon-cancel ()
   "Cancel any Gnus daemons."
   (interactive)
 
 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
 
 (defun gnus-demon-cancel ()
   "Cancel any Gnus daemons."
   (interactive)
-  (when gnus-demon-timer
-    (nnheader-cancel-timer gnus-demon-timer))
-  (setq gnus-demon-timer nil
-       gnus-demon-idle-has-been-called nil)
-  (condition-case ()
-      (nnheader-cancel-function-timers 'gnus-demon)
-    (error t)))
-
-(defun gnus-demon-is-idle-p ()
-  "Whether Emacs is idle or not."
-  ;; We do this simply by comparing the 100 most recent keystrokes
-  ;; with the ones we had last time.  If they are the same, one might
-  ;; guess that Emacs is indeed idle.  This only makes sense if one
-  ;; calls this function seldom -- like once a minute, which is what
-  ;; we do here.
-  (let ((keys (recent-keys)))
-    (or (equal keys gnus-demon-last-keys)
-       (progn
-         (setq gnus-demon-last-keys keys)
-         nil))))
-
-(defun gnus-demon-time-to-step (time)
-  "Find out how many seconds to TIME, which is on the form \"17:43\"."
-  (if (not (stringp time))
-      time
-    (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)))
-          ;; calculate number of seconds between NOW and THEN
-          (diff (+ (* 65536 (- (car then) (car now)))
-                   (- (cadr then) (cadr now)))))
-      ;; return number of timesteps in the number of seconds
-      (round (/ diff gnus-demon-timestep)))))
-
-(defun gnus-demon ()
-  "The Gnus daemon that takes care of running all Gnus handlers."
-  ;; Increase or reset the time Emacs has been idle.
-  (if (gnus-demon-is-idle-p)
-      (incf gnus-demon-idle-time)
-    (setq gnus-demon-idle-time 0)
-    (setq gnus-demon-idle-has-been-called nil))
-  ;; Disable all daemonic stuff if we're in the minibuffer
-  (when (and (not (window-minibuffer-p (selected-window)))
-            (not gnus-inhibit-demon))
-    ;; Then we go through all the handler and call those that are
-    ;; sufficiently ripe.
-    (let ((handlers gnus-demon-handler-state)
-         (gnus-inhibit-demon t)
-         ;; Try to avoid dialog boxes, e.g. by Mailcrypt.
-         ;; Unfortunately, Emacs 20's `message-or-box...' doesn't
-         ;; obey `use-dialog-box'.
-         use-dialog-box (last-nonmenu-event 10)
-         handler time idle)
-      (while handlers
-       (setq handler (pop handlers))
-       (cond
-        ((numberp (setq time (nth 1 handler)))
-         ;; These handlers use a regular timeout mechanism.  We decrease
-         ;; the timer if it hasn't reached zero yet.
-         (unless (zerop time)
-           (setcar (nthcdr 1 handler) (decf time)))
-         (and (zerop time)             ; If the timer now is zero...
-              ;; Test for appropriate idleness
-              (progn
-                (setq idle (nth 2 handler))
-                (cond
-                 ((null idle) t)       ; Don't care about idle.
-                 ((numberp idle)       ; Numerical idle...
-                  (< idle gnus-demon-idle-time)) ; Idle timed out.
-                 (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle.
-              ;; So we call the handler.
-              (progn
-                (ignore-errors (funcall (car handler)))
-                ;; And reset the timer.
-                (setcar (nthcdr 1 handler)
-                        (gnus-demon-time-to-step
-                         (nth 1 (assq (car handler) gnus-demon-handlers)))))))
-        ;; These are only supposed to be called when Emacs is idle.
-        ((null (setq idle (nth 2 handler)))
-         ;; We do nothing.
-         )
-        ((and (not (numberp idle))
-              (gnus-demon-is-idle-p))
-         ;; We want to call this handler each and every time that
-         ;; Emacs is idle.
-         (ignore-errors (funcall (car handler))))
-        (t
-         ;; We want to call this handler only if Emacs has been idle
-         ;; for a specified number of timesteps.
-         (and (not (memq (car handler) gnus-demon-idle-has-been-called))
-              (< idle gnus-demon-idle-time)
-              (gnus-demon-is-idle-p)
-              (progn
-                (ignore-errors (funcall (car handler)))
-                ;; Make sure the handler won't be called once more in
-                ;; this idle-cycle.
-                (push (car handler) gnus-demon-idle-has-been-called)))))))))
-
-(defun gnus-demon-add-nocem ()
-  "Add daemonic NoCeM handling to Gnus."
-  (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30))
-
-(defun gnus-demon-scan-nocem ()
-  "Scan NoCeM groups for NoCeM messages."
-  (save-window-excursion
-    (gnus-nocem-scan-groups)))
+  (dotimes (i (/ (length gnus-demon-timers) 2))
+    (nnheader-cancel-timer (nth (1+ (* i 2)) gnus-demon-timers)))
+  (setq gnus-demon-timers nil))
 
 (defun gnus-demon-add-disconnection ()
   "Add daemonic server disconnection to Gnus."
 
 (defun gnus-demon-add-disconnection ()
   "Add daemonic server disconnection to Gnus."
@@ -262,7 +222,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
   "Add daemonic nntp server disconnection to Gnus.
 If no commands have gone out via nntp during the last five
 minutes, the connection is closed."
   "Add daemonic nntp server disconnection to Gnus.
 If no commands have gone out via nntp during the last five
 minutes, the connection is closed."
-  (gnus-demon-add-handler 'gnus-demon-nntp-close-connections 5 nil))
+  (gnus-demon-add-handler 'gnus-demon-nntp-close-connection 5 nil))
 
 (defun gnus-demon-nntp-close-connection ()
   (save-window-excursion
 
 (defun gnus-demon-nntp-close-connection ()
   (save-window-excursion
@@ -292,11 +252,9 @@ minutes, the connection is closed."
   (let ((win (current-window-configuration)))
     (unwind-protect
        (save-window-excursion
   (let ((win (current-window-configuration)))
     (unwind-protect
        (save-window-excursion
-         (save-excursion
-           (when (gnus-alive-p)
-             (save-excursion
-               (set-buffer gnus-group-buffer)
-               (gnus-group-get-new-news)))))
+         (when (gnus-alive-p)
+           (with-current-buffer gnus-group-buffer
+             (gnus-group-get-new-news))))
       (set-window-configuration win))))
 
 (defun gnus-demon-add-scan-timestamps ()
       (set-window-configuration win))))
 
 (defun gnus-demon-add-scan-timestamps ()
@@ -320,5 +278,4 @@ minutes, the connection is closed."
 
 (provide 'gnus-demon)
 
 
 (provide 'gnus-demon)
 
-;;; arch-tag: 8dd5cd3d-6ae4-46b4-9b15-f5fca09fd392
 ;;; gnus-demon.el ends here
 ;;; gnus-demon.el ends here