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