1;;; gnus-delay.el --- Delayed posting of articles
2
3;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
5;; Author: Kai Gro�johann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
6;; Keywords: mail, news, extensions
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published
12;; by the Free Software Foundation; either version 2, or (at your
13;; option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful, but
16;; WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18;; General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING.  If not, write to
22;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; Provide delayed posting of articles.
28
29;;; Todo:
30
31;; * `gnus-delay-send-queue' barfs when group does not exist.
32;; * Integrate gnus-delay.el into the rest of Gnus automatically.  How
33;;   should this be done?  Basically, we need to do what
34;;   `gnus-delay-initialize' does.  But in which files?
35
36;;; Code:
37
38(require 'nndraft)
39(require 'gnus-draft)
40(autoload 'parse-time-string "parse-time" nil nil)
41
42(defgroup gnus-delay nil
43  "Arrange for sending postings later."
44  :version "22.1"
45  :group 'gnus)
46
47(defcustom gnus-delay-group "delayed"
48  "Group name for storing delayed articles."
49  :type 'string
50  :group 'gnus-delay)
51
52(defcustom gnus-delay-header "X-Gnus-Delayed"
53  "Header name for storing info about delayed articles."
54  :type 'string
55  :group 'gnus-delay)
56
57(defcustom gnus-delay-default-delay "3d"
58  "*Default length of delay."
59  :type 'string
60  :group 'gnus-delay)
61
62(defcustom gnus-delay-default-hour 8
63  "*If deadline is given as date, then assume this time of day."
64  :version "22.1"
65  :type 'integer
66  :group 'gnus-delay)
67
68;;;###autoload
69(defun gnus-delay-article (delay)
70  "Delay this article by some time.
71DELAY is a string, giving the length of the time.  Possible values are:
72
73* <digits><units> for <units> in minutes (`m'), hours (`h'), days (`d'),
74  weeks (`w'), months (`M'), or years (`Y');
75
76* YYYY-MM-DD for a specific date.  The time of day is given by the
77  variable `gnus-delay-default-hour', minute and second are zero.
78
79* hh:mm for a specific time.  Use 24h format.  If it is later than this
80  time, then the deadline is tomorrow, else today."
81  (interactive
82   (list (read-string
83	  "Target date (YYYY-MM-DD) or length of delay (units in [mhdwMY]): "
84	  gnus-delay-default-delay)))
85  (let (num unit days year month day hour minute deadline)
86    (cond ((string-match
87	    "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)"
88	    delay)
89	   (setq year  (string-to-number (match-string 1 delay))
90		 month (string-to-number (match-string 2 delay))
91		 day   (string-to-number (match-string 3 delay)))
92	   (setq deadline
93		 (message-make-date
94		  (encode-time 0 0      ; second and minute
95			       gnus-delay-default-hour
96			       day month year))))
97	  ((string-match "\\([0-9]+\\):\\([0-9]+\\)" delay)
98	   (setq hour   (string-to-number (match-string 1 delay))
99		 minute (string-to-number (match-string 2 delay)))
100	   ;; Use current time, except...
101	   (setq deadline (apply 'vector (decode-time (current-time))))
102	   ;; ... for minute and hour.
103	   (aset deadline 1 minute)
104	   (aset deadline 2 hour)
105	   ;; Convert to seconds.
106	   (setq deadline (time-to-seconds (apply 'encode-time
107						  (append deadline nil))))
108	   ;; If this time has passed already, add a day.
109	   (when (< deadline (time-to-seconds (current-time)))
110	     (setq deadline (+ 3600 deadline))) ;3600 secs/day
111	   ;; Convert seconds to date header.
112	   (setq deadline (message-make-date
113			   (seconds-to-time deadline))))
114	  ((string-match "\\([0-9]+\\)\\s-*\\([mhdwMY]\\)" delay)
115	   (setq num (match-string 1 delay))
116	   (setq unit (match-string 2 delay))
117	   ;; Start from seconds, then multiply into needed units.
118	   (setq num (string-to-number num))
119	   (cond ((string= unit "Y")
120		  (setq delay (* num 60 60 24 365)))
121		 ((string= unit "M")
122		  (setq delay (* num 60 60 24 30)))
123		 ((string= unit "w")
124		  (setq delay (* num 60 60 24 7)))
125		 ((string= unit "d")
126		  (setq delay (* num 60 60 24)))
127		 ((string= unit "h")
128		  (setq delay (* num 60 60)))
129		 (t
130		  (setq delay (* num 60))))
131	   (setq deadline (message-make-date
132			   (seconds-to-time (+ (time-to-seconds (current-time))
133					       delay)))))
134	  (t (error "Malformed delay `%s'" delay)))
135    (message-add-header (format "%s: %s" gnus-delay-header deadline)))
136  (set-buffer-modified-p t)
137  ;; If group does not exist, create it.
138  (let ((group (format "nndraft:%s" gnus-delay-group)))
139    (gnus-agent-queue-setup gnus-delay-group))
140  (message-disassociate-draft)
141  (nndraft-request-associate-buffer gnus-delay-group)
142  (save-buffer 0)
143  (kill-buffer (current-buffer))
144  (message-do-actions message-postpone-actions))
145
146;;;###autoload
147(defun gnus-delay-send-queue ()
148  "Send all the delayed messages that are due now."
149  (interactive)
150  (save-excursion
151    (let* ((group (format "nndraft:%s" gnus-delay-group))
152	   (message-send-hook (copy-sequence message-send-hook))
153	   articles
154	   article deadline)
155      (when (gnus-gethash group gnus-newsrc-hashtb)
156	(gnus-activate-group group)
157	(add-hook 'message-send-hook
158		  '(lambda ()
159		     (message-remove-header gnus-delay-header)))
160	(setq articles (nndraft-articles))
161	(while (setq article (pop articles))
162	  (gnus-request-head article group)
163	  (set-buffer nntp-server-buffer)
164	  (goto-char (point-min))
165	  (if (re-search-forward
166	       (concat "^" (regexp-quote gnus-delay-header) ":\\s-+")
167	       nil t)
168	      (progn
169		(setq deadline (nnheader-header-value))
170		(setq deadline (apply 'encode-time
171				      (parse-time-string deadline)))
172		(setq deadline (time-since deadline))
173		(when (and (>= (nth 0 deadline) 0)
174			   (>= (nth 1 deadline) 0))
175		  (message "Sending delayed article %d" article)
176		  (gnus-draft-send article group)
177		  (message "Sending delayed article %d...done" article)))
178	    (message "Delay header missing for article %d" article)))))))
179
180;;;###autoload
181(defun gnus-delay-initialize (&optional no-keymap no-check)
182  "Initialize the gnus-delay package.
183This sets up a key binding in `message-mode' to delay a message.
184This tells Gnus to look for delayed messages after getting new news.
185
186The optional arg NO-KEYMAP is ignored.
187Checking delayed messages is skipped if optional arg NO-CHECK is non-nil."
188  (unless no-check
189    (add-hook 'gnus-get-new-news-hook 'gnus-delay-send-queue)))
190
191(provide 'gnus-delay)
192
193;; Local Variables:
194;; coding: iso-8859-1
195;; End:
196
197;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d
198;;; gnus-delay.el ends here
199