1 ;;; gnus-draft.el --- draft message support for Gnus
2 ;; Copyright (C) 1997,98 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
34 (eval-when-compile (require 'cl
))
38 (defvar gnus-draft-mode nil
39 "Minor mode for providing a draft summary buffers.")
41 (defvar gnus-draft-mode-map nil
)
43 (unless gnus-draft-mode-map
44 (setq gnus-draft-mode-map
(make-sparse-keymap))
46 (gnus-define-keys gnus-draft-mode-map
47 "Dt" gnus-draft-toggle-sending
48 "De" gnus-draft-edit-message
49 "Ds" gnus-draft-send-message
50 "DS" gnus-draft-send-all-messages
))
52 (defun gnus-draft-make-menu-bar ()
53 (unless (boundp 'gnus-draft-menu
)
55 gnus-draft-menu gnus-draft-mode-map
""
57 ["Toggle whether to send" gnus-draft-toggle-sending t
]
58 ["Edit" gnus-draft-edit-message t
]
59 ["Send selected message(s)" gnus-draft-send-message t
]
60 ["Send all messages" gnus-draft-send-all-messages t
]
61 ["Delete draft" gnus-summary-delete-article t
]))))
63 (defun gnus-draft-mode (&optional arg
)
64 "Minor mode for providing a draft summary buffers.
66 \\{gnus-draft-mode-map}"
68 (when (eq major-mode
'gnus-summary-mode
)
69 (when (set (make-local-variable 'gnus-draft-mode
)
70 (if (null arg
) (not gnus-draft-mode
)
71 (> (prefix-numeric-value arg
) 0)))
73 (when (gnus-visual-p 'draft-menu
'menu
)
74 (gnus-draft-make-menu-bar))
75 (gnus-add-minor-mode 'gnus-draft-mode
" Draft" gnus-draft-mode-map
)
76 (gnus-run-hooks 'gnus-draft-mode-hook
))))
80 (defun gnus-draft-toggle-sending (article)
81 "Toggle whether to send an article or not."
82 (interactive (list (gnus-summary-article-number)))
83 (if (gnus-draft-article-sendable-p article
)
85 (push article gnus-newsgroup-unsendable
)
86 (gnus-summary-mark-article article gnus-unsendable-mark
))
87 (setq gnus-newsgroup-unsendable
88 (delq article gnus-newsgroup-unsendable
))
89 (gnus-summary-mark-article article gnus-unread-mark
))
90 (gnus-summary-position-point))
92 (defun gnus-draft-edit-message ()
93 "Enter a mail/post buffer to edit and send the draft."
95 (let ((article (gnus-summary-article-number)))
96 (gnus-summary-mark-as-read article gnus-canceled-mark
)
97 (gnus-draft-setup article gnus-newsgroup-name
)
98 (set-buffer-modified-p t
)
102 (when (gnus-buffer-exists-p ,gnus-summary-buffer
)
104 (set-buffer ,gnus-summary-buffer
)
105 (gnus-cache-possibly-remove-article ,article nil nil nil t
)))))
106 message-send-actions
)))
108 (defun gnus-draft-send-message (&optional n
)
109 "Send the current draft."
111 (let ((articles (gnus-summary-work-articles n
))
113 (while (setq article
(pop articles
))
114 (gnus-summary-remove-process-mark article
)
115 (unless (memq article gnus-newsgroup-unsendable
)
116 (gnus-draft-send article gnus-newsgroup-name
)
117 (gnus-summary-mark-article article gnus-canceled-mark
)))))
119 (defun gnus-draft-send (article &optional group
)
120 "Send message ARTICLE."
121 (gnus-draft-setup article
(or group
"nndraft:queue"))
122 (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me
)
123 message-send-hook type method
)
124 ;; We read the meta-information that says how and where
125 ;; this message is to be sent.
127 (message-narrow-to-head)
128 (when (re-search-forward
129 (concat "^" (regexp-quote gnus-agent-meta-information-header
) ":")
131 (setq type
(ignore-errors (read (current-buffer)))
132 method
(ignore-errors (read (current-buffer))))
133 (message-remove-header gnus-agent-meta-information-header
)))
134 ;; Then we send it. If we have no meta-information, we just send
135 ;; it and let Message figure out how.
136 (when (and (or (null method
)
137 (gnus-server-opened method
)
138 (gnus-open-server method
))
140 (let ((message-this-is-news (eq type
'news
))
141 (message-this-is-mail (eq type
'mail
))
142 (gnus-post-method method
)
143 (message-post-method method
))
144 (message-send-and-exit))
145 (message-send-and-exit)))
146 (let ((gnus-verbose-backends nil
))
147 (gnus-request-expire-articles
148 (list article
) (or group
"nndraft:queue") t
)))))
150 (defun gnus-draft-send-all-messages ()
151 "Send all the sendable drafts."
153 (gnus-uu-mark-buffer)
154 (gnus-draft-send-message))
156 (defun gnus-group-send-drafts ()
157 "Send all sendable articles from the queue group."
159 (gnus-activate-group "nndraft:queue")
161 (let ((articles (nndraft-articles))
162 (unsendable (gnus-uncompress-range
165 (gnus-get-info "nndraft:queue"))))))
167 (while (setq article
(pop articles
))
168 (unless (memq article unsendable
)
169 (gnus-draft-send article
))))))
171 ;;; Utility functions
173 ;;;!!!If this is byte-compiled, it fails miserably.
174 ;;;!!!This is because `gnus-setup-message' uses uninterned symbols.
175 ;;;!!!This has been fixed in recent versions of Emacs and XEmacs,
176 ;;;!!!but for the time being, we'll just run this tiny function uncompiled.
179 (defun gnus-draft-setup (narticle group
)
180 (gnus-setup-message 'forward
181 (let ((article narticle
))
184 (if (not (gnus-request-restore-buffer article group
))
185 (error "Couldn't restore the article")
186 ;; Insert the separator.
187 (goto-char (point-min))
188 (search-forward "\n\n")
190 (insert mail-header-separator
)
192 (message-set-auto-save-file-name))))))
194 (defun gnus-draft-article-sendable-p (article)
195 "Say whether ARTICLE is sendable."
196 (not (memq article gnus-newsgroup-unsendable
)))
198 (provide 'gnus-draft
)
200 ;;; gnus-draft.el ends here