X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-demon.el;h=caf9f8784b933feef64456d25abccbba85a8af5c;hb=0f63151c0cfcb3498678c203edb84e6a1d2b57e0;hp=e7bf2be329d5093444c6991dde2a7b4f8fdaf3b4;hpb=b28454eed83f245c4160228b076134ce930b320a;p=gnus diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el index e7bf2be32..caf9f8784 100644 --- a/lisp/gnus-demon.el +++ b/lisp/gnus-demon.el @@ -1,15 +1,17 @@ -;;; gnus-demon.el --- daemonic Gnus behaviour -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. +;;; gnus-demon.el --- daemonic Gnus behavior -;; Author: Lars Magne Ingebrigtsen +;; 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 ;; 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,24 +19,25 @@ ;; 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 . ;;; Commentary: ;;; Code: +(eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-int) (require 'nnheader) -(eval-and-compile - (if (string-match "XEmacs" (emacs-version)) - (require 'itimer) - (require 'timer))) +(require 'nntp) +(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 @@ -74,10 +77,8 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (defvar gnus-demon-idle-time 0) (defvar gnus-demon-handler-state nil) (defvar gnus-demon-last-keys nil) - -(eval-and-compile - (autoload 'timezone-parse-date "timezone") - (autoload 'timezone-make-arpa-date "timezone")) +(defvar gnus-inhibit-demon nil + "*If non-nil, no daemonic function will be run.") ;;; Functions. @@ -91,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))) @@ -101,11 +100,10 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." "Initialize the Gnus daemon." (interactive) (gnus-demon-cancel) - (if (null gnus-demon-handlers) - () ; Nothing to do. - ;; Set up timer. + (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 @@ -115,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) @@ -126,7 +123,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) (error t))) @@ -148,21 +145,35 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." "Find out how many seconds to TIME, which is on the form \"17:43\"." (if (not (stringp time)) time - (let* ((date (current-time-string)) - (dv (timezone-parse-date date)) - (tdate (timezone-make-arpa-date - (string-to-number (aref dv 0)) - (string-to-number (aref dv 1)) - (string-to-number (aref dv 2)) time - (or (aref dv 4) "UT"))) - (nseconds (gnus-time-minus - (gnus-encode-date tdate) (gnus-encode-date date)))) - (round - (/ (+ (if (< (car nseconds) 0) - 86400 0) - (* 65536 (car nseconds)) - (nth 1 nseconds)) - gnus-demon-timestep))))) + (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." @@ -172,10 +183,16 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (setq gnus-demon-idle-time 0) (setq gnus-demon-idle-has-been-called nil)) ;; Disable all daemonic stuff if we're in the minibuffer - (unless (window-minibuffer-p (selected-window)) + (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)) @@ -195,8 +212,8 @@ 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 - (funcall (car handler)) + (gnus-with-local-quit + (ignore-errors (funcall (car handler))) ;; And reset the timer. (setcar (nthcdr 1 handler) (gnus-demon-time-to-step @@ -205,24 +222,27 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." ((null (setq idle (nth 2 handler))) ;; We do nothing. ) - ((not (numberp idle)) + ((and (not (numberp idle)) + (gnus-demon-is-idle-p)) ;; We want to call this handler each and every time that ;; Emacs is idle. - (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) - (progn - (funcall (car handler)) + (gnus-demon-is-idle-p) + (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 t)) + (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30)) (defun gnus-demon-scan-nocem () "Scan NoCeM groups for NoCeM messages." @@ -237,6 +257,17 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (save-window-excursion (gnus-close-backends))) +(defun gnus-demon-add-nntp-close-connection () + "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-connection 5 nil)) + +(defun gnus-demon-nntp-close-connection () + (save-window-excursion + (when (time-less-p '(0 300) (time-since nntp-last-command-time)) + (nntp-close-server)))) + (defun gnus-demon-add-scanmail () "Add daemonic scanning of mail from the mail backends." (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60)) @@ -244,7 +275,8 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (defun gnus-demon-scan-mail () (save-window-excursion (let ((servers gnus-opened-servers) - server) + 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) @@ -256,11 +288,15 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." (gnus-demon-add-handler 'gnus-demon-scan-news 120 60)) (defun gnus-demon-scan-news () - (save-window-excursion - (when (gnus-alive-p) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-get-new-news))))) + (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))))) + (set-window-configuration win)))) (defun gnus-demon-add-scan-timestamps () "Add daemonic updating of timestamps in empty newgroups."