Mercurial > emacs
comparison lisp/gnus/gnus-draft.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; gnus-draft.el --- draft message support for Gnus | 1 ;;; gnus-draft.el --- draft message support for Gnus |
2 ;; Copyright (C) 1997, 1998, 1999, 2000 | 2 |
3 ;; Free Software Foundation, Inc. | 3 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
4 ;; 2005 Free Software Foundation, Inc. | |
4 | 5 |
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | 6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
6 ;; Keywords: news | 7 ;; Keywords: news |
7 | 8 |
8 ;; This file is part of GNU Emacs. | 9 ;; This file is part of GNU Emacs. |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
18 ;; GNU General Public License for more details. | 19 ;; GNU General Public License for more details. |
19 | 20 |
20 ;; You should have received a copy of the GNU General Public License | 21 ;; 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 the | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 ;; Boston, MA 02111-1307, USA. | 24 ;; Boston, MA 02110-1301, USA. |
24 | 25 |
25 ;;; Commentary: | 26 ;;; Commentary: |
26 | 27 |
27 ;;; Code: | 28 ;;; Code: |
28 | 29 |
44 (unless gnus-draft-mode-map | 45 (unless gnus-draft-mode-map |
45 (setq gnus-draft-mode-map (make-sparse-keymap)) | 46 (setq gnus-draft-mode-map (make-sparse-keymap)) |
46 | 47 |
47 (gnus-define-keys gnus-draft-mode-map | 48 (gnus-define-keys gnus-draft-mode-map |
48 "Dt" gnus-draft-toggle-sending | 49 "Dt" gnus-draft-toggle-sending |
50 "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' | |
49 "De" gnus-draft-edit-message | 51 "De" gnus-draft-edit-message |
50 "Ds" gnus-draft-send-message | 52 "Ds" gnus-draft-send-message |
51 "DS" gnus-draft-send-all-messages)) | 53 "DS" gnus-draft-send-all-messages)) |
52 | 54 |
53 (defun gnus-draft-make-menu-bar () | 55 (defun gnus-draft-make-menu-bar () |
92 (gnus-summary-position-point)) | 94 (gnus-summary-position-point)) |
93 | 95 |
94 (defun gnus-draft-edit-message () | 96 (defun gnus-draft-edit-message () |
95 "Enter a mail/post buffer to edit and send the draft." | 97 "Enter a mail/post buffer to edit and send the draft." |
96 (interactive) | 98 (interactive) |
97 (let ((article (gnus-summary-article-number))) | 99 (let ((article (gnus-summary-article-number)) |
100 (group gnus-newsgroup-name)) | |
98 (gnus-summary-mark-as-read article gnus-canceled-mark) | 101 (gnus-summary-mark-as-read article gnus-canceled-mark) |
99 (gnus-draft-setup article gnus-newsgroup-name t) | 102 (gnus-draft-setup article group t) |
100 (set-buffer-modified-p t) | 103 (set-buffer-modified-p t) |
104 (save-excursion | |
105 (save-restriction | |
106 (message-narrow-to-headers) | |
107 (message-remove-header "date"))) | |
101 (save-buffer) | 108 (save-buffer) |
102 (let ((gnus-verbose-backends nil)) | 109 (let ((gnus-verbose-backends nil)) |
103 (gnus-request-expire-articles (list article) gnus-newsgroup-name t)) | 110 (gnus-request-expire-articles (list article) group t)) |
104 (push | 111 (push |
105 `((lambda () | 112 `((lambda () |
106 (when (gnus-buffer-exists-p ,gnus-summary-buffer) | 113 (when (gnus-buffer-exists-p ,gnus-summary-buffer) |
107 (save-excursion | 114 (save-excursion |
108 (set-buffer ,gnus-summary-buffer) | 115 (set-buffer ,gnus-summary-buffer) |
124 (gnus-draft-send article gnus-newsgroup-name t)) | 131 (gnus-draft-send article gnus-newsgroup-name t)) |
125 (gnus-summary-mark-article article gnus-canceled-mark))))) | 132 (gnus-summary-mark-article article gnus-canceled-mark))))) |
126 | 133 |
127 (defun gnus-draft-send (article &optional group interactive) | 134 (defun gnus-draft-send (article &optional group interactive) |
128 "Send message ARTICLE." | 135 "Send message ARTICLE." |
129 (let ((message-syntax-checks (if interactive nil | 136 (let* ((is-queue (or (not group) |
130 'dont-check-for-anything-just-trust-me)) | 137 (equal group "nndraft:queue"))) |
131 (message-inhibit-body-encoding (or (not group) | 138 (message-syntax-checks (if interactive message-syntax-checks |
132 (equal group "nndraft:queue") | 139 'dont-check-for-anything-just-trust-me)) |
133 message-inhibit-body-encoding)) | 140 (message-hidden-headers nil) |
134 (message-send-hook (and group (not (equal group "nndraft:queue")) | 141 (message-inhibit-body-encoding (or is-queue |
135 message-send-hook)) | 142 message-inhibit-body-encoding)) |
136 (message-setup-hook (and group (not (equal group "nndraft:queue")) | 143 (message-send-hook (and (not is-queue) |
137 message-setup-hook)) | 144 message-send-hook)) |
138 type method) | 145 (message-setup-hook (and (not is-queue) |
146 message-setup-hook)) | |
147 (gnus-agent-queue-mail (and (not is-queue) | |
148 gnus-agent-queue-mail)) | |
149 (rfc2047-encode-encoded-words nil) | |
150 type method move-to) | |
139 (gnus-draft-setup article (or group "nndraft:queue")) | 151 (gnus-draft-setup article (or group "nndraft:queue")) |
140 ;; We read the meta-information that says how and where | 152 ;; We read the meta-information that says how and where |
141 ;; this message is to be sent. | 153 ;; this message is to be sent. |
142 (save-restriction | 154 (save-restriction |
143 (message-narrow-to-head) | 155 (message-narrow-to-head) |
156 (when (re-search-forward | |
157 (concat "^" (regexp-quote gnus-agent-target-move-group-header) | |
158 ":") nil t) | |
159 (skip-syntax-forward "-") | |
160 (setq move-to (buffer-substring (point) (gnus-point-at-eol))) | |
161 (message-remove-header gnus-agent-target-move-group-header)) | |
162 (goto-char (point-min)) | |
144 (when (re-search-forward | 163 (when (re-search-forward |
145 (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") | 164 (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") |
146 nil t) | 165 nil t) |
147 (setq type (ignore-errors (read (current-buffer))) | 166 (setq type (ignore-errors (read (current-buffer))) |
148 method (ignore-errors (read (current-buffer)))) | 167 method (ignore-errors (read (current-buffer)))) |
157 (if type | 176 (if type |
158 (let ((message-this-is-news (eq type 'news)) | 177 (let ((message-this-is-news (eq type 'news)) |
159 (message-this-is-mail (eq type 'mail)) | 178 (message-this-is-mail (eq type 'mail)) |
160 (gnus-post-method method) | 179 (gnus-post-method method) |
161 (message-post-method method)) | 180 (message-post-method method)) |
162 (message-send-and-exit)) | 181 (if move-to |
163 (message-send-and-exit))) | 182 (gnus-inews-do-gcc move-to) |
183 (message-send-and-exit))) | |
184 (if move-to | |
185 (gnus-inews-do-gcc move-to) | |
186 (message-send-and-exit)))) | |
164 (let ((gnus-verbose-backends nil)) | 187 (let ((gnus-verbose-backends nil)) |
165 (gnus-request-expire-articles | 188 (gnus-request-expire-articles |
166 (list article) (or group "nndraft:queue") t))))) | 189 (list article) (or group "nndraft:queue") t))))) |
167 | 190 |
168 (defun gnus-draft-send-all-messages () | 191 (defun gnus-draft-send-all-messages () |
169 "Send all the sendable drafts." | 192 "Send all the sendable drafts." |
170 (interactive) | 193 (interactive) |
171 (gnus-uu-mark-buffer) | 194 (when (or |
172 (gnus-draft-send-message)) | 195 gnus-expert-user |
173 | 196 (gnus-y-or-n-p |
174 (defun gnus-group-send-drafts () | 197 "Send all drafts? ")) |
198 (gnus-uu-mark-buffer) | |
199 (gnus-draft-send-message))) | |
200 | |
201 (defun gnus-group-send-queue () | |
175 "Send all sendable articles from the queue group." | 202 "Send all sendable articles from the queue group." |
176 (interactive) | 203 (interactive) |
177 (gnus-activate-group "nndraft:queue") | 204 (when (or gnus-plugged |
178 (save-excursion | 205 (not gnus-agent-prompt-send-queue) |
179 (let* ((articles (nndraft-articles)) | 206 (gnus-y-or-n-p "Gnus is unplugged; really send queue? ")) |
180 (unsendable (gnus-uncompress-range | 207 (gnus-activate-group "nndraft:queue") |
181 (cdr (assq 'unsend | 208 (save-excursion |
182 (gnus-info-marks | 209 (let* ((articles (nndraft-articles)) |
183 (gnus-get-info "nndraft:queue")))))) | 210 (unsendable (gnus-uncompress-range |
184 (total (length articles)) | 211 (cdr (assq 'unsend |
185 article) | 212 (gnus-info-marks |
186 (while (setq article (pop articles)) | 213 (gnus-get-info "nndraft:queue")))))) |
187 (unless (memq article unsendable) | 214 (gnus-posting-styles nil) |
188 (let ((message-sending-message | 215 (total (length articles)) |
189 (format "Sending message %d of %d..." | 216 article) |
190 (- total (length articles)) total))) | 217 (while (setq article (pop articles)) |
191 (gnus-draft-send article))))))) | 218 (unless (memq article unsendable) |
219 (let ((message-sending-message | |
220 (format "Sending message %d of %d..." | |
221 (- total (length articles)) total))) | |
222 (gnus-draft-send article)))))))) | |
223 | |
224 ;;;###autoload | |
225 (defun gnus-draft-reminder () | |
226 "Reminder user if there are unsent drafts." | |
227 (interactive) | |
228 (if (gnus-alive-p) | |
229 (let (active) | |
230 (catch 'continue | |
231 (dolist (group '("nndraft:drafts" "nndraft:queue")) | |
232 (setq active (gnus-activate-group group)) | |
233 (if (and active (>= (cdr active) (car active))) | |
234 (if (y-or-n-p "There are unsent drafts. Confirm to exit? ") | |
235 (throw 'continue t) | |
236 (error "Stop!")))))))) | |
192 | 237 |
193 ;;; Utility functions | 238 ;;; Utility functions |
194 | 239 |
195 ;;;!!!If this is byte-compiled, it fails miserably. | 240 ;;;!!!If this is byte-compiled, it fails miserably. |
196 ;;;!!!This is because `gnus-setup-message' uses uninterned symbols. | 241 ;;;!!!This is because `gnus-setup-message' uses uninterned symbols. |
197 ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, | 242 ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, |
198 ;;;!!!but for the time being, we'll just run this tiny function uncompiled. | 243 ;;;!!!but for the time being, we'll just run this tiny function uncompiled. |
199 | 244 |
200 (progn | 245 (progn |
201 (defun gnus-draft-setup (narticle group &optional restore) | 246 (defun gnus-draft-setup (narticle group &optional restore) |
202 (gnus-setup-message 'forward | 247 (let (ga) |
203 (let ((article narticle)) | 248 (gnus-setup-message 'forward |
204 (message-mail) | 249 (let ((article narticle)) |
205 (erase-buffer) | 250 (message-mail) |
206 (if (not (gnus-request-restore-buffer article group)) | 251 (erase-buffer) |
207 (error "Couldn't restore the article") | 252 (if (not (gnus-request-restore-buffer article group)) |
208 (if (and restore (equal group "nndraft:queue")) | 253 (error "Couldn't restore the article") |
254 (when (and restore | |
255 (equal group "nndraft:queue")) | |
209 (mime-to-mml)) | 256 (mime-to-mml)) |
210 ;; Insert the separator. | 257 ;; Insert the separator. |
211 (goto-char (point-min)) | 258 (goto-char (point-min)) |
212 (search-forward "\n\n") | 259 (search-forward "\n\n") |
213 (forward-char -1) | 260 (forward-char -1) |
214 (insert mail-header-separator) | 261 (insert mail-header-separator) |
215 (forward-line 1) | 262 (forward-line 1) |
216 (message-set-auto-save-file-name)))))) | 263 (setq ga (message-fetch-field gnus-draft-meta-information-header)) |
264 (message-set-auto-save-file-name)))) | |
265 (gnus-backlog-remove-article group narticle) | |
266 (when (and ga | |
267 (ignore-errors (setq ga (car (read-from-string ga))))) | |
268 (setq gnus-newsgroup-name | |
269 (if (equal (car ga) "") nil (car ga))) | |
270 (gnus-configure-posting-styles) | |
271 (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) | |
272 (setq message-post-method | |
273 `(lambda (arg) | |
274 (gnus-post-method arg ,(car ga)))) | |
275 (unless (equal (cadr ga) "") | |
276 (dolist (article (cdr ga)) | |
277 (message-add-action | |
278 `(progn | |
279 (gnus-add-mark ,(car ga) 'replied ,article) | |
280 (gnus-request-set-mark ,(car ga) (list (list (list ,article) | |
281 'add '(reply))))) | |
282 'send))))))) | |
217 | 283 |
218 (defun gnus-draft-article-sendable-p (article) | 284 (defun gnus-draft-article-sendable-p (article) |
219 "Say whether ARTICLE is sendable." | 285 "Say whether ARTICLE is sendable." |
220 (not (memq article gnus-newsgroup-unsendable))) | 286 (not (memq article gnus-newsgroup-unsendable))) |
221 | 287 |
222 (provide 'gnus-draft) | 288 (provide 'gnus-draft) |
223 | 289 |
290 ;;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022 | |
224 ;;; gnus-draft.el ends here | 291 ;;; gnus-draft.el ends here |