/[emacs]/emacs/lisp/gnus/gnus-delay.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-delay.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by schwab, Thu Jul 22 16:45:46 2004 UTC revision 1.2 by miles, Sat Sep 4 13:13:43 2004 UTC
# Line 0  Line 1 
1    ;;; gnus-delay.el --- Delayed posting of articles
2    
3    ;; Copyright (C) 2001, 2002, 2003  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., 59 Temple Place - Suite 330,
23    ;; Boston, MA 02111-1307, 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    
41    ;;;###autoload
42    (defgroup gnus-delay nil
43      "Arrange for sending postings later."
44      :group 'gnus)
45    
46    (defcustom gnus-delay-group "delayed"
47      "Group name for storing delayed articles."
48      :type 'string
49      :group 'gnus-delay)
50    
51    (defcustom gnus-delay-header "X-Gnus-Delayed"
52      "Header name for storing info about delayed articles."
53      :type 'string
54      :group 'gnus-delay)
55    
56    (defcustom gnus-delay-default-delay "3d"
57      "*Default length of delay."
58      :type 'string
59      :group 'gnus-delay)
60    
61    (defcustom gnus-delay-default-hour 8
62      "*If deadline is given as date, then assume this time of day."
63      :type 'integer
64      :group 'gnus-delay)
65    
66    ;;;###autoload
67    (defun gnus-delay-article (delay)
68      "Delay this article by some time.
69    DELAY is a string, giving the length of the time.  Possible values are:
70    
71    * <digits><units> for <units> in minutes (`m'), hours (`h'), days (`d'),
72      weeks (`w'), months (`M'), or years (`Y');
73    
74    * YYYY-MM-DD for a specific date.  The time of day is given by the
75      variable `gnus-delay-default-hour', minute and second are zero.
76    
77    * hh:mm for a specific time.  Use 24h format.  If it is later than this
78      time, then the deadline is tomorrow, else today."
79      (interactive
80       (list (read-string
81              "Target date (YYYY-MM-DD) or length of delay (units in [mhdwMY]): "
82              gnus-delay-default-delay)))
83      (let (num unit days year month day hour minute deadline)
84        (cond ((string-match
85                "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)"
86                delay)
87               (setq year  (string-to-number (match-string 1 delay))
88                     month (string-to-number (match-string 2 delay))
89                     day   (string-to-number (match-string 3 delay)))
90               (setq deadline
91                     (message-make-date
92                      (encode-time 0 0      ; second and minute
93                                   gnus-delay-default-hour
94                                   day month year))))
95              ((string-match "\\([0-9]+\\):\\([0-9]+\\)" delay)
96               (setq hour   (string-to-number (match-string 1 delay))
97                     minute (string-to-number (match-string 2 delay)))
98               ;; Use current time, except...
99               (setq deadline (apply 'vector (decode-time (current-time))))
100               ;; ... for minute and hour.
101               (aset deadline 1 minute)
102               (aset deadline 2 hour)
103               ;; Convert to seconds.
104               (setq deadline (time-to-seconds (apply 'encode-time
105                                                      (append deadline nil))))
106               ;; If this time has passed already, add a day.
107               (when (< deadline (time-to-seconds (current-time)))
108                 (setq deadline (+ 3600 deadline))) ;3600 secs/day
109               ;; Convert seconds to date header.
110               (setq deadline (message-make-date
111                               (seconds-to-time deadline))))
112              ((string-match "\\([0-9]+\\)\\s-*\\([mhdwMY]\\)" delay)
113               (setq num (match-string 1 delay))
114               (setq unit (match-string 2 delay))
115               ;; Start from seconds, then multiply into needed units.
116               (setq num (string-to-number num))
117               (cond ((string= unit "Y")
118                      (setq delay (* num 60 60 24 365)))
119                     ((string= unit "M")
120                      (setq delay (* num 60 60 24 30)))
121                     ((string= unit "w")
122                      (setq delay (* num 60 60 24 7)))
123                     ((string= unit "d")
124                      (setq delay (* num 60 60 24)))
125                     ((string= unit "h")
126                      (setq delay (* num 60 60)))
127                     (t
128                      (setq delay (* num 60))))
129               (setq deadline (message-make-date
130                               (seconds-to-time (+ (time-to-seconds (current-time))
131                                                   delay)))))
132              (t (error "Malformed delay `%s'" delay)))
133        (message-add-header (format "%s: %s" gnus-delay-header deadline)))
134      (set-buffer-modified-p t)
135      ;; If group does not exist, create it.
136      (let ((group (format "nndraft:%s" gnus-delay-group)))
137        (gnus-agent-queue-setup gnus-delay-group))
138      (message-disassociate-draft)
139      (nndraft-request-associate-buffer gnus-delay-group)
140      (save-buffer 0)
141      (kill-buffer (current-buffer))
142      (message-do-actions message-postpone-actions))
143    
144    ;;;###autoload
145    (defun gnus-delay-send-queue ()
146      "Send all the delayed messages that are due now."
147      (interactive)
148      (save-excursion
149        (let* ((group (format "nndraft:%s" gnus-delay-group))
150               (message-send-hook (copy-sequence message-send-hook))
151               articles
152               article deadline)
153          (when (gnus-gethash group gnus-newsrc-hashtb)
154            (gnus-activate-group group)
155            (add-hook 'message-send-hook
156                      '(lambda ()
157                         (message-remove-header gnus-delay-header)))
158            (setq articles (nndraft-articles))
159            (while (setq article (pop articles))
160              (gnus-request-head article group)
161              (set-buffer nntp-server-buffer)
162              (goto-char (point-min))
163              (if (re-search-forward
164                   (concat "^" (regexp-quote gnus-delay-header) ":\\s-+")
165                   nil t)
166                  (progn
167                    (setq deadline (nnheader-header-value))
168                    (setq deadline (apply 'encode-time
169                                          (parse-time-string deadline)))
170                    (setq deadline (time-since deadline))
171                    (when (and (>= (nth 0 deadline) 0)
172                               (>= (nth 1 deadline) 0))
173                      (message "Sending delayed article %d" article)
174                      (gnus-draft-send article group)
175                      (message "Sending delayed article %d...done" article)))
176                (message "Delay header missing for article %d" article)))))))
177    
178    ;;;###autoload
179    (defun gnus-delay-initialize (&optional no-keymap no-check)
180      "Initialize the gnus-delay package.
181    This sets up a key binding in `message-mode' to delay a message.
182    This tells Gnus to look for delayed messages after getting new news.
183    
184    The optional arg NO-KEYMAP is ignored.
185    Checking delayed messages is skipped if optional arg NO-CHECK is non-nil."
186      (unless no-check
187        (add-hook 'gnus-get-new-news-hook 'gnus-delay-send-queue)))
188    
189    (provide 'gnus-delay)
190    
191    ;; Local Variables:
192    ;; coding: iso-8859-1
193    ;; End:
194    
195    ;;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d
196    ;;; gnus-delay.el ends here

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26