Mercurial > emacs
comparison lisp/gnus/gnus-draft.el @ 68940:808f636eb13e
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 30-34)
- Merge from emacs--devo--0
- Update from CVS
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Fri, 17 Feb 2006 00:24:04 +0000 |
| parents | 1077b8039c32 |
| children | 6580c61aced7 9e490faa9f6b |
comparison
equal
deleted
inserted
replaced
| 68939:2eed293b58ff | 68940:808f636eb13e |
|---|---|
| 96 (defun gnus-draft-edit-message () | 96 (defun gnus-draft-edit-message () |
| 97 "Enter a mail/post buffer to edit and send the draft." | 97 "Enter a mail/post buffer to edit and send the draft." |
| 98 (interactive) | 98 (interactive) |
| 99 (let ((article (gnus-summary-article-number)) | 99 (let ((article (gnus-summary-article-number)) |
| 100 (group gnus-newsgroup-name)) | 100 (group gnus-newsgroup-name)) |
| 101 (gnus-draft-check-draft-articles (list article)) | |
| 101 (gnus-summary-mark-as-read article gnus-canceled-mark) | 102 (gnus-summary-mark-as-read article gnus-canceled-mark) |
| 102 (gnus-draft-setup article group t) | 103 (gnus-draft-setup article group t) |
| 103 (set-buffer-modified-p t) | 104 (set-buffer-modified-p t) |
| 104 (save-excursion | 105 (save-excursion |
| 105 (save-restriction | 106 (save-restriction |
| 120 "Send the current draft." | 121 "Send the current draft." |
| 121 (interactive "P") | 122 (interactive "P") |
| 122 (let* ((articles (gnus-summary-work-articles n)) | 123 (let* ((articles (gnus-summary-work-articles n)) |
| 123 (total (length articles)) | 124 (total (length articles)) |
| 124 article) | 125 article) |
| 126 (gnus-draft-check-draft-articles articles) | |
| 125 (while (setq article (pop articles)) | 127 (while (setq article (pop articles)) |
| 126 (gnus-summary-remove-process-mark article) | 128 (gnus-summary-remove-process-mark article) |
| 127 (unless (memq article gnus-newsgroup-unsendable) | 129 (unless (memq article gnus-newsgroup-unsendable) |
| 128 (let ((message-sending-message | 130 (let ((message-sending-message |
| 129 (format "Sending message %d of %d..." | 131 (format "Sending message %d of %d..." |
| 150 type method move-to) | 152 type method move-to) |
| 151 (gnus-draft-setup article (or group "nndraft:queue")) | 153 (gnus-draft-setup article (or group "nndraft:queue")) |
| 152 ;; We read the meta-information that says how and where | 154 ;; We read the meta-information that says how and where |
| 153 ;; this message is to be sent. | 155 ;; this message is to be sent. |
| 154 (save-restriction | 156 (save-restriction |
| 155 (message-narrow-to-head) | 157 (message-narrow-to-headers) |
| 156 (when (re-search-forward | 158 (when (re-search-forward |
| 157 (concat "^" (regexp-quote gnus-agent-target-move-group-header) | 159 (concat "^" (regexp-quote gnus-agent-target-move-group-header) |
| 158 ":") nil t) | 160 ":") nil t) |
| 159 (skip-syntax-forward "-") | 161 (skip-syntax-forward "-") |
| 160 (setq move-to (buffer-substring (point) (gnus-point-at-eol))) | 162 (setq move-to (buffer-substring (point) (gnus-point-at-eol))) |
| 256 (mime-to-mml)) | 258 (mime-to-mml)) |
| 257 ;; Insert the separator. | 259 ;; Insert the separator. |
| 258 (goto-char (point-min)) | 260 (goto-char (point-min)) |
| 259 (search-forward "\n\n") | 261 (search-forward "\n\n") |
| 260 (forward-char -1) | 262 (forward-char -1) |
| 263 (save-restriction | |
| 264 (narrow-to-region (point-min) (point)) | |
| 265 (setq ga | |
| 266 (message-fetch-field gnus-draft-meta-information-header))) | |
| 261 (insert mail-header-separator) | 267 (insert mail-header-separator) |
| 262 (forward-line 1) | 268 (forward-line 1) |
| 263 (setq ga (message-fetch-field gnus-draft-meta-information-header)) | |
| 264 (message-set-auto-save-file-name)))) | 269 (message-set-auto-save-file-name)))) |
| 265 (gnus-backlog-remove-article group narticle) | 270 (gnus-backlog-remove-article group narticle) |
| 266 (when (and ga | 271 (when (and ga |
| 267 (ignore-errors (setq ga (car (read-from-string ga))))) | 272 (ignore-errors (setq ga (car (read-from-string ga))))) |
| 268 (setq gnus-newsgroup-name | 273 (setq gnus-newsgroup-name |
| 283 | 288 |
| 284 (defun gnus-draft-article-sendable-p (article) | 289 (defun gnus-draft-article-sendable-p (article) |
| 285 "Say whether ARTICLE is sendable." | 290 "Say whether ARTICLE is sendable." |
| 286 (not (memq article gnus-newsgroup-unsendable))) | 291 (not (memq article gnus-newsgroup-unsendable))) |
| 287 | 292 |
| 293 (defun gnus-draft-check-draft-articles (articles) | |
| 294 "Check whether the draft articles ARTICLES are under edit." | |
| 295 (when (equal gnus-newsgroup-name "nndraft:drafts") | |
| 296 (let ((buffers (buffer-list)) | |
| 297 file buffs buff) | |
| 298 (save-current-buffer | |
| 299 (while (and articles | |
| 300 (not buff)) | |
| 301 (setq file (nndraft-article-filename (pop articles)) | |
| 302 buffs buffers) | |
| 303 (while buffs | |
| 304 (set-buffer (setq buff (pop buffs))) | |
| 305 (if (and buffer-file-name | |
| 306 (string-equal (file-truename buffer-file-name) | |
| 307 (file-truename file)) | |
| 308 (buffer-modified-p)) | |
| 309 (setq buffs nil) | |
| 310 (setq buff nil))))) | |
| 311 (when buff | |
| 312 (let* ((window (get-buffer-window buff t)) | |
| 313 (frame (and window (window-frame window)))) | |
| 314 (if frame | |
| 315 (gnus-select-frame-set-input-focus frame) | |
| 316 (pop-to-buffer buff t))) | |
| 317 (error "The draft %s is under edit" file))))) | |
| 318 | |
| 288 (provide 'gnus-draft) | 319 (provide 'gnus-draft) |
| 289 | 320 |
| 290 ;;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022 | 321 ;;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022 |
| 291 ;;; gnus-draft.el ends here | 322 ;;; gnus-draft.el ends here |