Merge branch 'master' of https://git.gnus.org/gnus
[gnus] / lisp / gnus-demon.el
index a5765fe..c4e439c 100644 (file)
@@ -1,15 +1,17 @@
-;;; gnus-demon.el --- daemonic Gnus behaviour
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;;; gnus-demon.el --- daemonic Gnus behavior
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+
+;; 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
-;; 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
@@ -17,9 +19,7 @@
 ;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 (require 'gnus-int)
 (require 'nnheader)
 (require 'nntp)
-(eval-and-compile
-  (if (string-match "XEmacs" (emacs-version))
-      (require 'itimer)
-    (require 'timer)))
+(require 'nnmail)
+(require 'gnus-util)
+
+(autoload 'parse-time-string "parse-time" nil nil)
 
 (defgroup gnus-demon nil
-  "Demonic behaviour."
+  "Demonic behavior."
   :group 'gnus)
 
 (defcustom gnus-demon-handlers nil
@@ -80,10 +80,6 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
 (defvar gnus-inhibit-demon nil
   "*If non-nil, no daemonic function will be run.")
 
-(eval-and-compile
-  (autoload 'timezone-parse-date "timezone")
-  (autoload 'timezone-make-arpa-date "timezone"))
-
 ;;; Functions.
 
 (defun gnus-demon-add-handler (function time idle)
@@ -96,9 +92,7 @@ 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."
-  (setq gnus-demon-handlers
-       (delq (assq function gnus-demon-handlers)
-             gnus-demon-handlers))
+  (gnus-pull function gnus-demon-handlers)
   (unless no-init
     (gnus-demon-init)))
 
@@ -109,7 +103,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
   (when gnus-demon-handlers
     ;; Set up the timer.
     (setq gnus-demon-timer
-         (nnheader-run-at-time
+         (run-at-time
           gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
     ;; Reset control variables.
     (setq gnus-demon-handler-state
@@ -119,8 +113,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
                   (nth 2 handler)))
           gnus-demon-handlers))
     (setq gnus-demon-idle-time 0)
-    (setq gnus-demon-idle-has-been-called nil)
-    (setq gnus-use-demon t)))
+    (setq gnus-demon-idle-has-been-called nil)))
 
 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
 
@@ -130,7 +123,6 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
   (when gnus-demon-timer
     (nnheader-cancel-timer gnus-demon-timer))
   (setq gnus-demon-timer nil
-       gnus-use-demon nil
        gnus-demon-idle-has-been-called nil)
   (condition-case ()
       (nnheader-cancel-function-timers 'gnus-demon)
@@ -154,32 +146,32 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
   (if (not (stringp time))
       time
     (let* ((now (current-time))
-           ;; obtain NOW as discrete components -- make a vector for speed
-           (nowParts (apply 'vector (decode-time now)))
-           ;; obtain THEN as discrete components
-           (thenParts (timezone-parse-time time))
-           (thenHour (string-to-int (elt thenParts 0)))
-           (thenMin (string-to-int (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)))))
+          ;; 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)))))
 
@@ -197,6 +189,10 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
     ;; 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))
@@ -216,7 +212,7 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
                   (< 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
+              (gnus-with-local-quit
                 (ignore-errors (funcall (car handler)))
                 ;; And reset the timer.
                 (setcar (nthcdr 1 handler)
@@ -230,28 +226,20 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's."
               (gnus-demon-is-idle-p))
          ;; We want to call this handler each and every time that
          ;; Emacs is idle.
-         (ignore-errors (funcall (car handler))))
+         (gnus-with-local-quit
+           (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
+              (gnus-with-local-quit
                 (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)))
-
 (defun gnus-demon-add-disconnection ()
   "Add daemonic server disconnection to Gnus."
   (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
@@ -264,12 +252,11 @@ 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."
-  (gnus-demon-add-handler 'gnus-demon-close-connections 5 nil))
+  (gnus-demon-add-handler 'gnus-demon-nntp-close-connection 5 nil))
 
 (defun gnus-demon-nntp-close-connection ()
   (save-window-excursion
-    (when (nnmail-time-less '(0 300)
-                           (nnmail-time-since nntp-last-command-time))
+    (when (time-less-p '(0 300) (time-since nntp-last-command-time))
       (nntp-close-server))))
 
 (defun gnus-demon-add-scanmail ()
@@ -279,8 +266,8 @@ minutes, the connection is closed."
 (defun gnus-demon-scan-mail ()
   (save-window-excursion
     (let ((servers gnus-opened-servers)
-         server)
-      (gnus-clear-inboxes-moved)
+         server
+         (nnmail-fetched-sources (list t)))
       (while (setq server (car (pop servers)))
        (and (gnus-check-backend-function 'request-scan (car server))
             (or (gnus-server-opened server)
@@ -295,11 +282,9 @@ minutes, the connection is closed."
   (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 ()