[bpt/emacs.git] / lisp / gnus / gnus-demon.el

;;; gnus-demon.el --- daemonic Gnus behavior

;; Copyright (C) 1995-2012 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
;; it under the terms of the GNU General Public License as published by
;; 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl))

(require 'gnus)
(require 'gnus-int)
(require 'nnheader)
(require 'nntp)
(require 'nnmail)

(defgroup gnus-demon nil
  "Demonic behavior."
  :group 'gnus)

(defcustom gnus-demon-handlers nil
  "Alist of daemonic handlers to be run at intervals.
Each handler is a list on the form

\(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 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"
			       (const :tag "never" nil)
			       (const :tag "one" t)
			       (integer :tag "steps" 1))
		       (choice :tag "Idle"
			       (const :tag "don't care" nil)
			       (const :tag "for a while" t)
			       (integer :tag "steps" 1)))))

(defcustom gnus-demon-timestep 60
  "Number of seconds in each demon timestep."
  :group 'gnus-demon
  :type 'integer)

;;; Internal variables.

(defvar gnus-demon-timers nil
  "List of idle timers which are running.")
(defvar gnus-inhibit-demon nil
  "If non-nil, no daemonic function will be run.")

;;; Functions.

(defun gnus-demon-add-handler (function time idle)
  "Add the handler FUNCTION to be run at TIME and IDLE."
  ;; First remove any old handlers that use this function.
  (gnus-demon-remove-handler function)
  ;; Then add the new one.
  (push (list function time idle) gnus-demon-handlers)
  (gnus-demon-init))

(defun gnus-demon-remove-handler (function &optional no-init)
  "Remove the handler FUNCTION from the list of handlers."
  (gnus-alist-pull function gnus-demon-handlers)
  (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)
  "Run FUNC if Emacs has been idle for longer than IDLE seconds."
  (unless gnus-inhibit-demon
    (when (or (not idle)
              (<= idle (gnus-demon-idle-since)))
      (with-local-quit
       (ignore-errors
         (funcall func))))))

(defun gnus-demon-init ()
  "Initialize the Gnus daemon."
  (interactive)
  (gnus-demon-cancel)
  (dolist (handler gnus-demon-handlers)
    ;; Set up the timer.
    (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))
                       (t
			(* time gnus-demon-timestep))))
           (timer
            (cond
             ;; (func number t)
             ;; Call when Emacs has been idle for `time'
             ((and (numberp time) (eq idle t))
              (run-with-timer time time 'gnus-demon-run-callback func time))
             ;; (func number number)
             ;; Call every `time' when Emacs has been idle for `idle'
             ((and (numberp time) (numberp idle))
              (run-with-timer time time 'gnus-demon-run-callback func idle))
             ;; (func nil number)
             ;; Only call when Emacs has been idle for `idle'
             ((and (null time) (numberp idle))
              (run-with-idle-timer (* idle gnus-demon-timestep) t
                                   'gnus-demon-run-callback func))
             ;; (func number nil)
             ;; Call every `time'
             ((and (numberp time) (null idle))
              (run-with-timer time time 'gnus-demon-run-callback func)))))
      (when timer
        (add-to-list 'gnus-demon-timers timer)))))

(defun gnus-demon-time-to-step (time)
  "Find out how many seconds 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)
  (dolist (timer gnus-demon-timers)
    (nnheader-cancel-timer timer))
  (setq gnus-demon-timers nil))

(defun gnus-demon-add-disconnection ()
  "Add daemonic server disconnection to Gnus."
  (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))

(defun gnus-demon-close-connections ()
  (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))

(defun gnus-demon-scan-mail ()
  (save-window-excursion
    (let ((servers gnus-opened-servers)
	  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)
		 (gnus-open-server server))
	     (gnus-request-scan nil server))))))

(defun gnus-demon-add-rescan ()
  "Add daemonic scanning of new articles from all backends."
  (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))

(defun gnus-demon-scan-news ()
  (let ((win (current-window-configuration)))
    (unwind-protect
	(save-window-excursion
	  (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 ()
  "Add daemonic updating of timestamps in empty newgroups."
  (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))

(defun gnus-demon-scan-timestamps ()
  "Set the timestamp on all newsgroups with no unread and no ticked articles."
  (when (gnus-alive-p)
    (let ((cur-time (current-time))
	  (newsrc (cdr gnus-newsrc-alist))
	  info group unread has-ticked)
      (while (setq info (pop newsrc))
	(setq group (gnus-info-group info)
	      unread (gnus-group-unread group)
	      has-ticked (cdr (assq 'tick (gnus-info-marks info))))
	(when (and (numberp unread)
		   (= unread 0)
		   (not has-ticked))
	  (gnus-group-set-parameter group 'timestamp cur-time))))))

(provide 'gnus-demon)

;;; gnus-demon.el ends here
Commit	Line	Data
fffa137c	1	;;; gnus-demon.el --- daemonic Gnus behavior
23f87bed	2
7e67562f	3	;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
eec82323	4
6748645f	5	;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
eec82323 LMI	6	;; Keywords: news
	7
	8	;; This file is part of GNU Emacs.
	9
5e809f55	10	;; GNU Emacs is free software: you can redistribute it and/or modify
eec82323	11	;; it under the terms of the GNU General Public License as published by
5e809f55 GM	12	;; the Free Software Foundation, either version 3 of the License, or
5e809f55 GM	13	;; (at your option) any later version.
eec82323 LMI	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
5e809f55	21	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
eec82323 LMI	22
	23	;;; Commentary:
	24
	25	;;; Code:
	26
7df7482d RS	27	(eval-when-compile (require 'cl))
7df7482d RS	28
eec82323 LMI	29	(require 'gnus)
	30	(require 'gnus-int)
	31	(require 'nnheader)
6748645f LMI	32	(require 'nntp)
6748645f LMI	33	(require 'nnmail)
498063ec	34
eec82323	35	(defgroup gnus-demon nil
4525646f	36	"Demonic behavior."
eec82323 LMI	37	:group 'gnus)
	38
	39	(defcustom gnus-demon-handlers nil
	40	"Alist of daemonic handlers to be run at intervals.
	41	Each handler is a list on the form
	42
	43	\(FUNCTION TIME IDLE)
	44
84acb2f6 JD	45	FUNCTION is the function to be called. TIME is the number of
	46	`gnus-demon-timestep's between each call.
	47	If nil, never call. If t, call each `gnus-demon-timestep'.
	48
	49	If IDLE is t, only call each time Emacs has been idle for TIME.
	50	If IDLE is a number, only call when Emacs has been idle more than
	51	this number of `gnus-demon-timestep's.
	52	If IDLE is nil, don't care about idleness.
	53	If IDLE is a number and TIME is nil, then call once each time
	54	Emacs has been idle for IDLE `gnus-demon-timestep's."
eec82323 LMI	55	:group 'gnus-demon
	56	:type '(repeat (list function
	57	(choice :tag "Time"
	58	(const :tag "never" nil)
	59	(const :tag "one" t)
	60	(integer :tag "steps" 1))
	61	(choice :tag "Idle"
	62	(const :tag "don't care" nil)
	63	(const :tag "for a while" t)
	64	(integer :tag "steps" 1)))))
	65
	66	(defcustom gnus-demon-timestep 60
84acb2f6	67	"Number of seconds in each demon timestep."
eec82323 LMI	68	:group 'gnus-demon
	69	:type 'integer)
	70
	71	;;; Internal variables.
	72
84acb2f6 JD	73	(defvar gnus-demon-timers nil
84acb2f6 JD	74	"List of idle timers which are running.")
eec82323	75	(defvar gnus-inhibit-demon nil
84acb2f6	76	"If non-nil, no daemonic function will be run.")
eec82323	77
eec82323 LMI	78	;;; Functions.
	79
	80	(defun gnus-demon-add-handler (function time idle)
	81	"Add the handler FUNCTION to be run at TIME and IDLE."
	82	;; First remove any old handlers that use this function.
	83	(gnus-demon-remove-handler function)
	84	;; Then add the new one.
	85	(push (list function time idle) gnus-demon-handlers)
	86	(gnus-demon-init))
	87
	88	(defun gnus-demon-remove-handler (function &optional no-init)
	89	"Remove the handler FUNCTION from the list of handlers."
36d3245f	90	(gnus-alist-pull function gnus-demon-handlers)
eec82323 LMI	91	(unless no-init
	92	(gnus-demon-init)))
	93
84acb2f6 JD	94	(defun gnus-demon-idle-since ()
	95	"Return the number of seconds since when Emacs is idle."
	96	(if (featurep 'xemacs)
	97	(itimer-time-difference (current-time) last-command-event-time)
	98	(float-time (or (current-idle-time)
	99	'(0 0 0)))))
	100
	101	(defun gnus-demon-run-callback (func &optional idle)
	102	"Run FUNC if Emacs has been idle for longer than IDLE seconds."
	103	(unless gnus-inhibit-demon
	104	(when (or (not idle)
	105	(<= idle (gnus-demon-idle-since)))
	106	(with-local-quit
	107	(ignore-errors
	108	(funcall func))))))
	109
eec82323 LMI	110	(defun gnus-demon-init ()
	111	"Initialize the Gnus daemon."
	112	(interactive)
	113	(gnus-demon-cancel)
84acb2f6	114	(dolist (handler gnus-demon-handlers)
6748645f	115	;; Set up the timer.
84acb2f6 JD	116	(let* ((func (nth 0 handler))
	117	(time (nth 1 handler))
	118	(idle (nth 2 handler))
	119	;; Compute time according with timestep.
	120	;; If t, replace by 1
	121	(time (cond ((eq time t)
	122	gnus-demon-timestep)
7e67562f G	123	((null time)
	124	nil)
	125	((stringp time)
	126	(gnus-demon-time-to-step time))
	127	(t
	128	(* time gnus-demon-timestep))))
84acb2f6 JD	129	(timer
	130	(cond
	131	;; (func number t)
	132	;; Call when Emacs has been idle for `time'
	133	((and (numberp time) (eq idle t))
4ef06429	134	(run-with-timer time time 'gnus-demon-run-callback func time))
84acb2f6 JD	135	;; (func number number)
	136	;; Call every `time' when Emacs has been idle for `idle'
	137	((and (numberp time) (numberp idle))
4ef06429	138	(run-with-timer time time 'gnus-demon-run-callback func idle))
84acb2f6 JD	139	;; (func nil number)
	140	;; Only call when Emacs has been idle for `idle'
	141	((and (null time) (numberp idle))
	142	(run-with-idle-timer (* idle gnus-demon-timestep) t
	143	'gnus-demon-run-callback func))
	144	;; (func number nil)
	145	;; Call every `time'
	146	((and (numberp time) (null idle))
003522ce	147	(run-with-timer time time 'gnus-demon-run-callback func)))))
84acb2f6 JD	148	(when timer
84acb2f6 JD	149	(add-to-list 'gnus-demon-timers timer)))))
eec82323	150
7e67562f G	151	(defun gnus-demon-time-to-step (time)
	152	"Find out how many seconds to TIME, which is on the form \"17:43\"."
	153	(let* ((now (current-time))
	154	;; obtain NOW as discrete components -- make a vector for speed
	155	(nowParts (decode-time now))
	156	;; obtain THEN as discrete components
	157	(thenParts (parse-time-string time))
	158	(thenHour (elt thenParts 2))
	159	(thenMin (elt thenParts 1))
	160	;; convert time as elements into number of seconds since EPOCH.
	161	(then (encode-time 0
	162	thenMin
	163	thenHour
	164	;; If THEN is earlier than NOW, make it
	165	;; same time tomorrow. Doc for encode-time
	166	;; says that this is OK.
	167	(+ (elt nowParts 3)
	168	(if (or (< thenHour (elt nowParts 2))
	169	(and (= thenHour (elt nowParts 2))
	170	(<= thenMin (elt nowParts 1))))
	171	1 0))
	172	(elt nowParts 4)
	173	(elt nowParts 5)
	174	(elt nowParts 6)
	175	(elt nowParts 7)
	176	(elt nowParts 8)))
	177	;; calculate number of seconds between NOW and THEN
	178	(diff (+ (* 65536 (- (car then) (car now)))
	179	(- (cadr then) (cadr now)))))
	180	;; return number of timesteps in the number of seconds
	181	(round (/ diff gnus-demon-timestep))))
	182
eec82323 LMI	183	(gnus-add-shutdown 'gnus-demon-cancel 'gnus)
	184
	185	(defun gnus-demon-cancel ()
	186	"Cancel any Gnus daemons."
	187	(interactive)
84acb2f6 JD	188	(dolist (timer gnus-demon-timers)
	189	(nnheader-cancel-timer timer))
	190	(setq gnus-demon-timers nil))
eec82323	191
eec82323 LMI	192	(defun gnus-demon-add-disconnection ()
	193	"Add daemonic server disconnection to Gnus."
	194	(gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
	195
	196	(defun gnus-demon-close-connections ()
	197	(save-window-excursion
	198	(gnus-close-backends)))
	199
6748645f LMI	200	(defun gnus-demon-add-nntp-close-connection ()
	201	"Add daemonic nntp server disconnection to Gnus.
	202	If no commands have gone out via nntp during the last five
	203	minutes, the connection is closed."
1d2faf98	204	(gnus-demon-add-handler 'gnus-demon-nntp-close-connection 5 nil))
6748645f LMI	205
	206	(defun gnus-demon-nntp-close-connection ()
	207	(save-window-excursion
16409b0b	208	(when (time-less-p '(0 300) (time-since nntp-last-command-time))
6748645f LMI	209	(nntp-close-server))))
6748645f LMI	210
eec82323 LMI	211	(defun gnus-demon-add-scanmail ()
	212	"Add daemonic scanning of mail from the mail backends."
	213	(gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
	214
	215	(defun gnus-demon-scan-mail ()
	216	(save-window-excursion
	217	(let ((servers gnus-opened-servers)
16409b0b GM	218	server
16409b0b GM	219	(nnmail-fetched-sources (list t)))
eec82323 LMI	220	(while (setq server (car (pop servers)))
	221	(and (gnus-check-backend-function 'request-scan (car server))
	222	(or (gnus-server-opened server)
	223	(gnus-open-server server))
	224	(gnus-request-scan nil server))))))
	225
	226	(defun gnus-demon-add-rescan ()
	227	"Add daemonic scanning of new articles from all backends."
	228	(gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
	229
	230	(defun gnus-demon-scan-news ()
6748645f LMI	231	(let ((win (current-window-configuration)))
	232	(unwind-protect
	233	(save-window-excursion
20a673b2 KY	234	(when (gnus-alive-p)
	235	(with-current-buffer gnus-group-buffer
	236	(gnus-group-get-new-news))))
6748645f	237	(set-window-configuration win))))
eec82323 LMI	238
	239	(defun gnus-demon-add-scan-timestamps ()
	240	"Add daemonic updating of timestamps in empty newgroups."
	241	(gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
	242
	243	(defun gnus-demon-scan-timestamps ()
	244	"Set the timestamp on all newsgroups with no unread and no ticked articles."
	245	(when (gnus-alive-p)
	246	(let ((cur-time (current-time))
	247	(newsrc (cdr gnus-newsrc-alist))
	248	info group unread has-ticked)
	249	(while (setq info (pop newsrc))
	250	(setq group (gnus-info-group info)
	251	unread (gnus-group-unread group)
	252	has-ticked (cdr (assq 'tick (gnus-info-marks info))))
	253	(when (and (numberp unread)
	254	(= unread 0)
	255	(not has-ticked))
	256	(gnus-group-set-parameter group 'timestamp cur-time))))))
	257
	258	(provide 'gnus-demon)
	259
	260	;;; gnus-demon.el ends here