1 |
;;; gnus-draft.el --- draft message support for Gnus |
;;; gnus-draft.el --- draft message support for Gnus |
2 |
;; Copyright (C) 1997, 1998, 1999, 2000 |
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
46 |
|
|
47 |
(gnus-define-keys gnus-draft-mode-map |
(gnus-define-keys gnus-draft-mode-map |
48 |
"Dt" gnus-draft-toggle-sending |
"Dt" gnus-draft-toggle-sending |
49 |
|
"e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' |
50 |
"De" gnus-draft-edit-message |
"De" gnus-draft-edit-message |
51 |
"Ds" gnus-draft-send-message |
"Ds" gnus-draft-send-message |
52 |
"DS" gnus-draft-send-all-messages)) |
"DS" gnus-draft-send-all-messages)) |
95 |
(defun gnus-draft-edit-message () |
(defun gnus-draft-edit-message () |
96 |
"Enter a mail/post buffer to edit and send the draft." |
"Enter a mail/post buffer to edit and send the draft." |
97 |
(interactive) |
(interactive) |
98 |
(let ((article (gnus-summary-article-number))) |
(let ((article (gnus-summary-article-number)) |
99 |
|
(group gnus-newsgroup-name)) |
100 |
(gnus-summary-mark-as-read article gnus-canceled-mark) |
(gnus-summary-mark-as-read article gnus-canceled-mark) |
101 |
(gnus-draft-setup article gnus-newsgroup-name t) |
(gnus-draft-setup article group t) |
102 |
(set-buffer-modified-p t) |
(set-buffer-modified-p t) |
103 |
|
(save-excursion |
104 |
|
(save-restriction |
105 |
|
(message-narrow-to-headers) |
106 |
|
(message-remove-header "date"))) |
107 |
(save-buffer) |
(save-buffer) |
108 |
(let ((gnus-verbose-backends nil)) |
(let ((gnus-verbose-backends nil)) |
109 |
(gnus-request-expire-articles (list article) gnus-newsgroup-name t)) |
(gnus-request-expire-articles (list article) group t)) |
110 |
(push |
(push |
111 |
`((lambda () |
`((lambda () |
112 |
(when (gnus-buffer-exists-p ,gnus-summary-buffer) |
(when (gnus-buffer-exists-p ,gnus-summary-buffer) |
132 |
|
|
133 |
(defun gnus-draft-send (article &optional group interactive) |
(defun gnus-draft-send (article &optional group interactive) |
134 |
"Send message ARTICLE." |
"Send message ARTICLE." |
135 |
(let ((message-syntax-checks (if interactive nil |
(let ((message-syntax-checks (if interactive message-syntax-checks |
136 |
'dont-check-for-anything-just-trust-me)) |
'dont-check-for-anything-just-trust-me)) |
137 |
|
(message-hidden-headers nil) |
138 |
(message-inhibit-body-encoding (or (not group) |
(message-inhibit-body-encoding (or (not group) |
139 |
(equal group "nndraft:queue") |
(equal group "nndraft:queue") |
140 |
message-inhibit-body-encoding)) |
message-inhibit-body-encoding)) |
142 |
message-send-hook)) |
message-send-hook)) |
143 |
(message-setup-hook (and group (not (equal group "nndraft:queue")) |
(message-setup-hook (and group (not (equal group "nndraft:queue")) |
144 |
message-setup-hook)) |
message-setup-hook)) |
145 |
type method) |
type method move-to) |
146 |
(gnus-draft-setup article (or group "nndraft:queue")) |
(gnus-draft-setup article (or group "nndraft:queue")) |
147 |
;; We read the meta-information that says how and where |
;; We read the meta-information that says how and where |
148 |
;; this message is to be sent. |
;; this message is to be sent. |
149 |
(save-restriction |
(save-restriction |
150 |
(message-narrow-to-head) |
(message-narrow-to-head) |
151 |
(when (re-search-forward |
(when (re-search-forward |
152 |
|
(concat "^" (regexp-quote gnus-agent-target-move-group-header) |
153 |
|
":") nil t) |
154 |
|
(skip-syntax-forward "-") |
155 |
|
(setq move-to (buffer-substring (point) (gnus-point-at-eol))) |
156 |
|
(message-remove-header gnus-agent-target-move-group-header)) |
157 |
|
(goto-char (point-min)) |
158 |
|
(when (re-search-forward |
159 |
(concat "^" (regexp-quote gnus-agent-meta-information-header) ":") |
(concat "^" (regexp-quote gnus-agent-meta-information-header) ":") |
160 |
nil t) |
nil t) |
161 |
(setq type (ignore-errors (read (current-buffer))) |
(setq type (ignore-errors (read (current-buffer))) |
173 |
(message-this-is-mail (eq type 'mail)) |
(message-this-is-mail (eq type 'mail)) |
174 |
(gnus-post-method method) |
(gnus-post-method method) |
175 |
(message-post-method method)) |
(message-post-method method)) |
176 |
(message-send-and-exit)) |
(if move-to |
177 |
(message-send-and-exit))) |
(gnus-inews-do-gcc move-to) |
178 |
|
(message-send-and-exit))) |
179 |
|
(if move-to |
180 |
|
(gnus-inews-do-gcc move-to) |
181 |
|
(message-send-and-exit)))) |
182 |
(let ((gnus-verbose-backends nil)) |
(let ((gnus-verbose-backends nil)) |
183 |
(gnus-request-expire-articles |
(gnus-request-expire-articles |
184 |
(list article) (or group "nndraft:queue") t))))) |
(list article) (or group "nndraft:queue") t))))) |
186 |
(defun gnus-draft-send-all-messages () |
(defun gnus-draft-send-all-messages () |
187 |
"Send all the sendable drafts." |
"Send all the sendable drafts." |
188 |
(interactive) |
(interactive) |
189 |
(gnus-uu-mark-buffer) |
(when (or |
190 |
(gnus-draft-send-message)) |
gnus-expert-user |
191 |
|
(gnus-y-or-n-p |
192 |
|
"Send all drafts? ")) |
193 |
|
(gnus-uu-mark-buffer) |
194 |
|
(gnus-draft-send-message))) |
195 |
|
|
196 |
(defun gnus-group-send-drafts () |
(defun gnus-group-send-queue () |
197 |
"Send all sendable articles from the queue group." |
"Send all sendable articles from the queue group." |
198 |
(interactive) |
(interactive) |
199 |
(gnus-activate-group "nndraft:queue") |
(gnus-activate-group "nndraft:queue") |
203 |
(cdr (assq 'unsend |
(cdr (assq 'unsend |
204 |
(gnus-info-marks |
(gnus-info-marks |
205 |
(gnus-get-info "nndraft:queue")))))) |
(gnus-get-info "nndraft:queue")))))) |
206 |
|
(gnus-posting-styles nil) |
207 |
(total (length articles)) |
(total (length articles)) |
208 |
article) |
article) |
209 |
(while (setq article (pop articles)) |
(while (setq article (pop articles)) |
213 |
(- total (length articles)) total))) |
(- total (length articles)) total))) |
214 |
(gnus-draft-send article))))))) |
(gnus-draft-send article))))))) |
215 |
|
|
216 |
|
;;;###autoload |
217 |
|
(defun gnus-draft-reminder () |
218 |
|
"Reminder user if there are unsent drafts." |
219 |
|
(interactive) |
220 |
|
(if (gnus-alive-p) |
221 |
|
(let (active) |
222 |
|
(catch 'continue |
223 |
|
(dolist (group '("nndraft:drafts" "nndraft:queue")) |
224 |
|
(setq active (gnus-activate-group group)) |
225 |
|
(if (and active (>= (cdr active) (car active))) |
226 |
|
(if (y-or-n-p "There are unsent drafts. Confirm to exit? ") |
227 |
|
(throw 'continue t) |
228 |
|
(error "Stop!")))))))) |
229 |
|
|
230 |
;;; Utility functions |
;;; Utility functions |
231 |
|
|
232 |
;;;!!!If this is byte-compiled, it fails miserably. |
;;;!!!If this is byte-compiled, it fails miserably. |
236 |
|
|
237 |
(progn |
(progn |
238 |
(defun gnus-draft-setup (narticle group &optional restore) |
(defun gnus-draft-setup (narticle group &optional restore) |
239 |
(gnus-setup-message 'forward |
(let (ga) |
240 |
(let ((article narticle)) |
(gnus-setup-message 'forward |
241 |
(message-mail) |
(let ((article narticle)) |
242 |
(erase-buffer) |
(message-mail) |
243 |
(if (not (gnus-request-restore-buffer article group)) |
(erase-buffer) |
244 |
(error "Couldn't restore the article") |
(if (not (gnus-request-restore-buffer article group)) |
245 |
(if (and restore (equal group "nndraft:queue")) |
(error "Couldn't restore the article") |
246 |
|
(when (and restore |
247 |
|
(equal group "nndraft:queue")) |
248 |
(mime-to-mml)) |
(mime-to-mml)) |
249 |
;; Insert the separator. |
;; Insert the separator. |
250 |
(goto-char (point-min)) |
(goto-char (point-min)) |
251 |
(search-forward "\n\n") |
(search-forward "\n\n") |
252 |
(forward-char -1) |
(forward-char -1) |
253 |
(insert mail-header-separator) |
(insert mail-header-separator) |
254 |
(forward-line 1) |
(forward-line 1) |
255 |
(message-set-auto-save-file-name)))))) |
(setq ga (message-fetch-field gnus-draft-meta-information-header)) |
256 |
|
(message-set-auto-save-file-name)))) |
257 |
|
(gnus-backlog-remove-article group narticle) |
258 |
|
(when (and ga |
259 |
|
(ignore-errors (setq ga (car (read-from-string ga))))) |
260 |
|
(setq gnus-newsgroup-name |
261 |
|
(if (equal (car ga) "") nil (car ga))) |
262 |
|
(gnus-configure-posting-styles) |
263 |
|
(setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) |
264 |
|
(setq message-post-method |
265 |
|
`(lambda (arg) |
266 |
|
(gnus-post-method arg ,(car ga)))) |
267 |
|
(unless (equal (cadr ga) "") |
268 |
|
(message-add-action |
269 |
|
`(progn |
270 |
|
(gnus-add-mark ,(car ga) 'replied ,(cadr ga)) |
271 |
|
(gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga)) |
272 |
|
'add '(reply))))) |
273 |
|
'send)))))) |
274 |
|
|
275 |
(defun gnus-draft-article-sendable-p (article) |
(defun gnus-draft-article-sendable-p (article) |
276 |
"Say whether ARTICLE is sendable." |
"Say whether ARTICLE is sendable." |