This commit was generated by cvs2svn to compensate for changes in r5947,
[elisp/gnus.git-] / lisp / gnus-demon.el
index 2c73b37..0015a90 100644 (file)
@@ -1,7 +1,5 @@
 ;;; gnus-demon.el --- daemonic Gnus behaviour
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
-;;      Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -36,7 +34,7 @@
 (require 'nnmail)
 (require 'gnus-util)
 (eval-and-compile
-  (if (featurep 'xemacs)
+  (if (string-match "XEmacs" (emacs-version))
       (require 'itimer)
     (require 'timer)))
 
@@ -84,6 +82,10 @@ 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)
@@ -117,7 +119,8 @@ 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-demon-idle-has-been-called nil)
+    (setq gnus-use-demon t)))
 
 (gnus-add-shutdown 'gnus-demon-cancel 'gnus)
 
@@ -127,6 +130,7 @@ 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)
@@ -150,32 +154,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 (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)))))
+           ;; 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)))))
       ;; return number of timesteps in the number of seconds
       (round (/ diff gnus-demon-timestep)))))
 
@@ -193,10 +197,6 @@ 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))
@@ -264,11 +264,12 @@ 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-nntp-close-connections 5 nil))
+  (gnus-demon-add-handler 'gnus-demon-close-connections 5 nil))
 
 (defun gnus-demon-nntp-close-connection ()
   (save-window-excursion
-    (when (time-less-p '(0 300) (time-since nntp-last-command-time))
+    (when (nnmail-time-less '(0 300)
+                           (nnmail-time-since nntp-last-command-time))
       (nntp-close-server))))
 
 (defun gnus-demon-add-scanmail ()
@@ -278,8 +279,8 @@ minutes, the connection is closed."
 (defun gnus-demon-scan-mail ()
   (save-window-excursion
     (let ((servers gnus-opened-servers)
-         server
-         (nnmail-fetched-sources (list t)))
+         server)
+      (gnus-clear-inboxes-moved)
       (while (setq server (car (pop servers)))
        (and (gnus-check-backend-function 'request-scan (car server))
             (or (gnus-server-opened server)