|
0
|
1 ;;; gnus-msg.el --- mail and post interface for Gnus
|
|
16
|
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
|
|
0
|
3
|
|
|
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
|
|
|
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
|
|
|
6 ;; Keywords: news
|
|
|
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 by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
18 ;; GNU 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 the
|
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Commentary:
|
|
|
26
|
|
|
27 ;;; Code:
|
|
|
28
|
|
|
29 (require 'gnus)
|
|
|
30 (require 'gnus-ems)
|
|
|
31 (require 'message)
|
|
16
|
32 (require 'gnus-art)
|
|
0
|
33
|
|
|
34 ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
|
|
|
35 (defvar gnus-post-method nil
|
|
|
36 "*Preferred method for posting USENET news.
|
|
|
37 If this variable is nil, Gnus will use the current method to decide
|
|
|
38 which method to use when posting. If it is non-nil, it will override
|
|
|
39 the current method. This method will not be used in mail groups and
|
|
|
40 the like, only in \"real\" newsgroups.
|
|
|
41
|
|
|
42 The value must be a valid method as discussed in the documentation of
|
|
|
43 `gnus-select-method'. It can also be a list of methods. If that is
|
|
|
44 the case, the user will be queried for what select method to use when
|
|
|
45 posting.")
|
|
|
46
|
|
|
47 (defvar gnus-outgoing-message-group nil
|
|
|
48 "*All outgoing messages will be put in this group.
|
|
|
49 If you want to store all your outgoing mail and articles in the group
|
|
16
|
50 \"nnml:archive\", you set this variable to that value. This variable
|
|
30
|
51 can also be a list of group names.
|
|
0
|
52
|
|
|
53 If you want to have greater control over what group to put each
|
|
|
54 message in, you can set this variable to a function that checks the
|
|
|
55 current newsgroup name and then returns a suitable group name (or list
|
|
|
56 of names).")
|
|
|
57
|
|
|
58 (defvar gnus-mailing-list-groups nil
|
|
|
59 "*Regexp matching groups that are really mailing lists.
|
|
|
60 This is useful when you're reading a mailing list that has been
|
|
|
61 gatewayed to a newsgroup, and you want to followup to an article in
|
|
|
62 the group.")
|
|
|
63
|
|
30
|
64 (defvar gnus-sent-message-ids-file
|
|
0
|
65 (nnheader-concat gnus-directory "Sent-Message-IDs")
|
|
|
66 "File where Gnus saves a cache of sent message ids.")
|
|
|
67
|
|
|
68 (defvar gnus-sent-message-ids-length 1000
|
|
|
69 "The number of sent Message-IDs to save.")
|
|
|
70
|
|
16
|
71 (defvar gnus-crosspost-complaint
|
|
|
72 "Hi,
|
|
|
73
|
|
|
74 You posted the article below with the following Newsgroups header:
|
|
|
75
|
|
|
76 Newsgroups: %s
|
|
|
77
|
|
|
78 The %s group, at least, was an inappropriate recipient
|
|
|
79 of this message. Please trim your Newsgroups header to exclude this
|
|
|
80 group before posting in the future.
|
|
|
81
|
|
|
82 Thank you.
|
|
|
83
|
|
|
84 "
|
|
|
85 "Format string to be inserted when complaining about crossposts.
|
|
|
86 The first %s will be replaced by the Newsgroups header;
|
|
|
87 the second with the current group name.")
|
|
|
88
|
|
|
89 (defvar gnus-message-setup-hook nil
|
|
|
90 "Hook run after setting up a message buffer.")
|
|
|
91
|
|
0
|
92 ;;; Internal variables.
|
|
|
93
|
|
|
94 (defvar gnus-message-buffer "*Mail Gnus*")
|
|
|
95 (defvar gnus-article-copy nil)
|
|
|
96 (defvar gnus-last-posting-server nil)
|
|
|
97
|
|
16
|
98 (defconst gnus-bug-message
|
|
|
99 "Sending a bug report to the Gnus Towers.
|
|
|
100 ========================================
|
|
|
101
|
|
|
102 The buffer below is a mail buffer. When you press `C-c C-c', it will
|
|
|
103 be sent to the Gnus Bug Exterminators.
|
|
|
104
|
|
|
105 At the bottom of the buffer you'll see lots of variable settings.
|
|
|
106 Please do not delete those. They will tell the Bug People what your
|
|
|
107 environment is, so that it will be easier to locate the bugs.
|
|
|
108
|
|
|
109 If you have found a bug that makes Emacs go \"beep\", set
|
|
|
110 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
|
|
|
111 and include the backtrace in your bug report.
|
|
|
112
|
|
|
113 Please describe the bug in annoying, painstaking detail.
|
|
|
114
|
|
|
115 Thank you for your help in stamping out bugs.
|
|
|
116 ")
|
|
|
117
|
|
0
|
118 (eval-and-compile
|
|
|
119 (autoload 'gnus-uu-post-news "gnus-uu" nil t)
|
|
|
120 (autoload 'news-setup "rnewspost")
|
|
|
121 (autoload 'news-reply-mode "rnewspost")
|
|
|
122 (autoload 'rmail-dont-reply-to "mail-utils")
|
|
|
123 (autoload 'rmail-output "rmailout"))
|
|
|
124
|
|
|
125
|
|
|
126 ;;;
|
|
|
127 ;;; Gnus Posting Functions
|
|
|
128 ;;;
|
|
|
129
|
|
16
|
130 (gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
|
|
|
131 "p" gnus-summary-post-news
|
|
|
132 "f" gnus-summary-followup
|
|
|
133 "F" gnus-summary-followup-with-original
|
|
|
134 "c" gnus-summary-cancel-article
|
|
|
135 "s" gnus-summary-supersede-article
|
|
|
136 "r" gnus-summary-reply
|
|
|
137 "R" gnus-summary-reply-with-original
|
|
|
138 "w" gnus-summary-wide-reply
|
|
|
139 "W" gnus-summary-wide-reply-with-original
|
|
|
140 "n" gnus-summary-followup-to-mail
|
|
|
141 "N" gnus-summary-followup-to-mail-with-original
|
|
|
142 "m" gnus-summary-mail-other-window
|
|
|
143 "u" gnus-uu-post-news
|
|
|
144 "\M-c" gnus-summary-mail-crosspost-complaint
|
|
|
145 "om" gnus-summary-mail-forward
|
|
|
146 "op" gnus-summary-post-forward
|
|
|
147 "Om" gnus-uu-digest-mail-forward
|
|
|
148 "Op" gnus-uu-digest-post-forward)
|
|
0
|
149
|
|
16
|
150 (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
|
|
|
151 "b" gnus-summary-resend-bounced-mail
|
|
|
152 ;; "c" gnus-summary-send-draft
|
|
|
153 "r" gnus-summary-resend-message)
|
|
0
|
154
|
|
|
155 ;;; Internal functions.
|
|
|
156
|
|
|
157 (defvar gnus-article-reply nil)
|
|
|
158 (defmacro gnus-setup-message (config &rest forms)
|
|
|
159 (let ((winconf (make-symbol "winconf"))
|
|
|
160 (buffer (make-symbol "buffer"))
|
|
|
161 (article (make-symbol "article")))
|
|
|
162 `(let ((,winconf (current-window-configuration))
|
|
16
|
163 (,buffer (buffer-name (current-buffer)))
|
|
0
|
164 (,article (and gnus-article-reply (gnus-summary-article-number)))
|
|
|
165 (message-header-setup-hook
|
|
|
166 (copy-sequence message-header-setup-hook)))
|
|
|
167 (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
|
|
|
168 (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
|
|
16
|
169 (unwind-protect
|
|
|
170 ,@forms
|
|
|
171 (gnus-inews-add-send-actions ,winconf ,buffer ,article)
|
|
|
172 (setq gnus-message-buffer (current-buffer))
|
|
|
173 (make-local-variable 'gnus-newsgroup-name)
|
|
|
174 (run-hooks 'gnus-message-setup-hook))
|
|
0
|
175 (gnus-configure-windows ,config t))))
|
|
30
|
176
|
|
0
|
177 (defun gnus-inews-add-send-actions (winconf buffer article)
|
|
22
|
178 (make-local-hook 'message-sent-hook)
|
|
0
|
179 (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
|
|
|
180 (setq message-post-method
|
|
|
181 `(lambda (arg)
|
|
|
182 (gnus-post-method arg ,gnus-newsgroup-name)))
|
|
|
183 (setq message-newsreader (setq message-mailer (gnus-extended-version)))
|
|
|
184 (message-add-action
|
|
|
185 `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
|
|
|
186 (message-add-action
|
|
16
|
187 `(when (buffer-name (get-buffer ,buffer))
|
|
0
|
188 (save-excursion
|
|
16
|
189 (set-buffer (get-buffer ,buffer))
|
|
0
|
190 ,(when article
|
|
|
191 `(gnus-summary-mark-article-as-replied ,article))))
|
|
|
192 'send))
|
|
|
193
|
|
|
194 (put 'gnus-setup-message 'lisp-indent-function 1)
|
|
|
195 (put 'gnus-setup-message 'edebug-form-spec '(form body))
|
|
|
196
|
|
|
197 ;;; Post news commands of Gnus group mode and summary mode
|
|
|
198
|
|
|
199 (defun gnus-group-mail ()
|
|
|
200 "Start composing a mail."
|
|
|
201 (interactive)
|
|
|
202 (gnus-setup-message 'message
|
|
|
203 (message-mail)))
|
|
|
204
|
|
|
205 (defun gnus-group-post-news (&optional arg)
|
|
|
206 "Start composing a news message.
|
|
|
207 If ARG, post to the group under point.
|
|
|
208 If ARG is 1, prompt for a group name."
|
|
|
209 (interactive "P")
|
|
|
210 ;; Bind this variable here to make message mode hooks
|
|
|
211 ;; work ok.
|
|
|
212 (let ((gnus-newsgroup-name
|
|
|
213 (if arg
|
|
|
214 (if (= 1 (prefix-numeric-value arg))
|
|
|
215 (completing-read "Newsgroup: " gnus-active-hashtb nil
|
|
|
216 (gnus-read-active-file-p))
|
|
|
217 (gnus-group-group-name))
|
|
|
218 "")))
|
|
|
219 (gnus-post-news 'post gnus-newsgroup-name)))
|
|
|
220
|
|
|
221 (defun gnus-summary-post-news ()
|
|
|
222 "Start composing a news message."
|
|
|
223 (interactive)
|
|
|
224 (gnus-set-global-variables)
|
|
|
225 (gnus-post-news 'post gnus-newsgroup-name))
|
|
|
226
|
|
|
227 (defun gnus-summary-followup (yank &optional force-news)
|
|
|
228 "Compose a followup to an article.
|
|
|
229 If prefix argument YANK is non-nil, original article is yanked automatically."
|
|
30
|
230 (interactive
|
|
|
231 (list (and current-prefix-arg
|
|
0
|
232 (gnus-summary-work-articles 1))))
|
|
|
233 (gnus-set-global-variables)
|
|
|
234 (when yank
|
|
|
235 (gnus-summary-goto-subject (car yank)))
|
|
|
236 (save-window-excursion
|
|
|
237 (gnus-summary-select-article))
|
|
|
238 (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
|
|
|
239 (gnus-newsgroup-name gnus-newsgroup-name))
|
|
|
240 ;; Send a followup.
|
|
|
241 (gnus-post-news nil gnus-newsgroup-name
|
|
30
|
242 headers gnus-article-buffer
|
|
0
|
243 yank nil force-news)))
|
|
|
244
|
|
|
245 (defun gnus-summary-followup-with-original (n &optional force-news)
|
|
|
246 "Compose a followup to an article and include the original article."
|
|
|
247 (interactive "P")
|
|
|
248 (gnus-summary-followup (gnus-summary-work-articles n) force-news))
|
|
|
249
|
|
16
|
250 (defun gnus-summary-followup-to-mail (&optional arg)
|
|
|
251 "Followup to the current mail message via news."
|
|
30
|
252 (interactive
|
|
|
253 (list (and current-prefix-arg
|
|
16
|
254 (gnus-summary-work-articles 1))))
|
|
|
255 (gnus-summary-followup arg t))
|
|
|
256
|
|
|
257 (defun gnus-summary-followup-to-mail-with-original (&optional arg)
|
|
|
258 "Followup to the current mail message via news."
|
|
|
259 (interactive "P")
|
|
|
260 (gnus-summary-followup (gnus-summary-work-articles arg) t))
|
|
|
261
|
|
0
|
262 (defun gnus-inews-yank-articles (articles)
|
|
|
263 (let (beg article)
|
|
16
|
264 (message-goto-body)
|
|
0
|
265 (while (setq article (pop articles))
|
|
|
266 (save-window-excursion
|
|
|
267 (set-buffer gnus-summary-buffer)
|
|
|
268 (gnus-summary-select-article nil nil nil article)
|
|
|
269 (gnus-summary-remove-process-mark article))
|
|
|
270 (gnus-copy-article-buffer)
|
|
|
271 (let ((message-reply-buffer gnus-article-copy)
|
|
|
272 (message-reply-headers gnus-current-headers))
|
|
|
273 (message-yank-original)
|
|
|
274 (setq beg (or beg (mark t))))
|
|
16
|
275 (when articles
|
|
|
276 (insert "\n")))
|
|
0
|
277 (push-mark)
|
|
|
278 (goto-char beg)))
|
|
|
279
|
|
|
280 (defun gnus-summary-cancel-article (n)
|
|
|
281 "Cancel an article you posted."
|
|
|
282 (interactive "P")
|
|
|
283 (gnus-set-global-variables)
|
|
|
284 (let ((articles (gnus-summary-work-articles n))
|
|
|
285 (message-post-method
|
|
|
286 `(lambda (arg)
|
|
|
287 (gnus-post-method nil ,gnus-newsgroup-name)))
|
|
|
288 article)
|
|
|
289 (while (setq article (pop articles))
|
|
|
290 (when (gnus-summary-select-article t nil nil article)
|
|
16
|
291 (when (gnus-eval-in-buffer-window gnus-original-article-buffer
|
|
|
292 (message-cancel-news))
|
|
0
|
293 (gnus-summary-mark-as-read article gnus-canceled-mark)
|
|
|
294 (gnus-cache-remove-article 1))
|
|
|
295 (gnus-article-hide-headers-if-wanted))
|
|
|
296 (gnus-summary-remove-process-mark article))))
|
|
|
297
|
|
|
298 (defun gnus-summary-supersede-article ()
|
|
|
299 "Compose an article that will supersede a previous article.
|
|
|
300 This is done simply by taking the old article and adding a Supersedes
|
|
|
301 header line with the old Message-ID."
|
|
|
302 (interactive)
|
|
|
303 (gnus-set-global-variables)
|
|
|
304 (let ((article (gnus-summary-article-number)))
|
|
|
305 (gnus-setup-message 'reply-yank
|
|
|
306 (gnus-summary-select-article t)
|
|
|
307 (set-buffer gnus-original-article-buffer)
|
|
|
308 (message-supersede)
|
|
|
309 (push
|
|
|
310 `((lambda ()
|
|
16
|
311 (when (buffer-name (get-buffer ,gnus-summary-buffer))
|
|
|
312 (save-excursion
|
|
|
313 (set-buffer (get-buffer ,gnus-summary-buffer))
|
|
36
|
314 (gnus-cache-possibly-remove-article ,article nil nil nil t)
|
|
16
|
315 (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
|
|
0
|
316 message-send-actions))))
|
|
|
317
|
|
|
318
|
|
|
319
|
|
|
320 (defun gnus-copy-article-buffer (&optional article-buffer)
|
|
|
321 ;; make a copy of the article buffer with all text properties removed
|
|
|
322 ;; this copy is in the buffer gnus-article-copy.
|
|
|
323 ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
|
|
|
324 ;; this buffer should be passed to all mail/news reply/post routines.
|
|
|
325 (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
|
|
|
326 (buffer-disable-undo gnus-article-copy)
|
|
|
327 (or (memq gnus-article-copy gnus-buffer-list)
|
|
16
|
328 (push gnus-article-copy gnus-buffer-list))
|
|
0
|
329 (let ((article-buffer (or article-buffer gnus-article-buffer))
|
|
|
330 end beg contents)
|
|
16
|
331 (if (not (and (get-buffer article-buffer)
|
|
|
332 (buffer-name (get-buffer article-buffer))))
|
|
|
333 (error "Can't find any article buffer")
|
|
0
|
334 (save-excursion
|
|
|
335 (set-buffer article-buffer)
|
|
|
336 (save-restriction
|
|
16
|
337 ;; Copy over the (displayed) article buffer, delete
|
|
|
338 ;; hidden text and remove text properties.
|
|
0
|
339 (widen)
|
|
16
|
340 (copy-to-buffer gnus-article-copy (point-min) (point-max))
|
|
|
341 (set-buffer gnus-article-copy)
|
|
|
342 (gnus-article-delete-text-of-type 'annotation)
|
|
|
343 (gnus-remove-text-with-property 'gnus-prev)
|
|
|
344 (gnus-remove-text-with-property 'gnus-next)
|
|
|
345 (insert
|
|
|
346 (prog1
|
|
|
347 (format "%s" (buffer-string))
|
|
|
348 (erase-buffer)))
|
|
|
349 ;; Find the original headers.
|
|
0
|
350 (set-buffer gnus-original-article-buffer)
|
|
|
351 (goto-char (point-min))
|
|
|
352 (while (looking-at message-unix-mail-delimiter)
|
|
|
353 (forward-line 1))
|
|
|
354 (setq beg (point))
|
|
|
355 (setq end (or (search-forward "\n\n" nil t) (point)))
|
|
16
|
356 ;; Delete the headers from the displayed articles.
|
|
0
|
357 (set-buffer gnus-article-copy)
|
|
|
358 (delete-region (goto-char (point-min))
|
|
|
359 (or (search-forward "\n\n" nil t) (point)))
|
|
16
|
360 ;; Insert the original article headers.
|
|
|
361 (insert-buffer-substring gnus-original-article-buffer beg end)
|
|
|
362 (gnus-article-decode-rfc1522)))
|
|
0
|
363 gnus-article-copy)))
|
|
|
364
|
|
|
365 (defun gnus-post-news (post &optional group header article-buffer yank subject
|
|
|
366 force-news)
|
|
|
367 (when article-buffer
|
|
|
368 (gnus-copy-article-buffer))
|
|
|
369 (let ((gnus-article-reply article-buffer))
|
|
|
370 (gnus-setup-message (cond (yank 'reply-yank)
|
|
|
371 (article-buffer 'reply)
|
|
|
372 (t 'message))
|
|
|
373 (let* ((group (or group gnus-newsgroup-name))
|
|
|
374 (pgroup group)
|
|
30
|
375 to-address to-group mailing-list to-list
|
|
16
|
376 newsgroup-p)
|
|
0
|
377 (when group
|
|
16
|
378 (setq to-address (gnus-group-find-parameter group 'to-address)
|
|
|
379 to-group (gnus-group-find-parameter group 'to-group)
|
|
|
380 to-list (gnus-group-find-parameter group 'to-list)
|
|
|
381 newsgroup-p (gnus-group-find-parameter group 'newsgroup)
|
|
0
|
382 mailing-list (when gnus-mailing-list-groups
|
|
|
383 (string-match gnus-mailing-list-groups group))
|
|
|
384 group (gnus-group-real-name group)))
|
|
|
385 (if (or (and to-group
|
|
|
386 (gnus-news-group-p to-group))
|
|
16
|
387 newsgroup-p
|
|
0
|
388 force-news
|
|
30
|
389 (and (gnus-news-group-p
|
|
0
|
390 (or pgroup gnus-newsgroup-name)
|
|
|
391 (if header (mail-header-number header)
|
|
|
392 gnus-current-article))
|
|
|
393 (not mailing-list)
|
|
|
394 (not to-list)
|
|
|
395 (not to-address)))
|
|
|
396 ;; This is news.
|
|
|
397 (if post
|
|
|
398 (message-news (or to-group group))
|
|
|
399 (set-buffer gnus-article-copy)
|
|
16
|
400 (message-followup (if (or newsgroup-p force-news) nil to-group)))
|
|
0
|
401 ;; The is mail.
|
|
|
402 (if post
|
|
|
403 (progn
|
|
|
404 (message-mail (or to-address to-list))
|
|
|
405 ;; Arrange for mail groups that have no `to-address' to
|
|
|
406 ;; get that when the user sends off the mail.
|
|
34
|
407 (push (list 'gnus-inews-add-to-address pgroup)
|
|
0
|
408 message-send-actions))
|
|
|
409 (set-buffer gnus-article-copy)
|
|
|
410 (message-wide-reply to-address)))
|
|
|
411 (when yank
|
|
|
412 (gnus-inews-yank-articles yank))))))
|
|
|
413
|
|
|
414 (defun gnus-post-method (arg group &optional silent)
|
|
|
415 "Return the posting method based on GROUP and ARG.
|
|
|
416 If SILENT, don't prompt the user."
|
|
|
417 (let ((group-method (gnus-find-method-for-group group)))
|
|
30
|
418 (cond
|
|
|
419 ;; If the group-method is nil (which shouldn't happen) we use
|
|
0
|
420 ;; the default method.
|
|
16
|
421 ((null group-method)
|
|
0
|
422 (or gnus-post-method gnus-select-method message-post-method))
|
|
|
423 ;; We want this group's method.
|
|
|
424 ((and arg (not (eq arg 0)))
|
|
|
425 group-method)
|
|
|
426 ;; We query the user for a post method.
|
|
|
427 ((or arg
|
|
|
428 (and gnus-post-method
|
|
|
429 (listp (car gnus-post-method))))
|
|
|
430 (let* ((methods
|
|
|
431 ;; Collect all methods we know about.
|
|
|
432 (append
|
|
|
433 (when gnus-post-method
|
|
|
434 (if (listp (car gnus-post-method))
|
|
|
435 gnus-post-method
|
|
|
436 (list gnus-post-method)))
|
|
|
437 gnus-secondary-select-methods
|
|
|
438 (list gnus-select-method)
|
|
|
439 (list group-method)))
|
|
|
440 method-alist post-methods method)
|
|
|
441 ;; Weed out all mail methods.
|
|
|
442 (while methods
|
|
|
443 (setq method (gnus-server-get-method "" (pop methods)))
|
|
|
444 (when (or (gnus-method-option-p method 'post)
|
|
|
445 (gnus-method-option-p method 'post-mail))
|
|
|
446 (push method post-methods)))
|
|
|
447 ;; Create a name-method alist.
|
|
|
448 (setq method-alist
|
|
30
|
449 (mapcar
|
|
0
|
450 (lambda (m)
|
|
|
451 (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
|
|
|
452 post-methods))
|
|
|
453 ;; Query the user.
|
|
|
454 (cadr
|
|
|
455 (assoc
|
|
|
456 (setq gnus-last-posting-server
|
|
|
457 (if (and silent
|
|
|
458 gnus-last-posting-server)
|
|
|
459 ;; Just use the last value.
|
|
|
460 gnus-last-posting-server
|
|
|
461 (completing-read
|
|
|
462 "Posting method: " method-alist nil t
|
|
|
463 (cons (or gnus-last-posting-server "") 0))))
|
|
|
464 method-alist))))
|
|
|
465 ;; Override normal method.
|
|
16
|
466 (gnus-post-method
|
|
0
|
467 gnus-post-method)
|
|
|
468 ;; Use the normal select method.
|
|
|
469 (t gnus-select-method))))
|
|
|
470
|
|
|
471 ;;;
|
|
|
472 ;;; Check whether the message has been sent already.
|
|
|
473 ;;;
|
|
|
474
|
|
|
475 (defvar gnus-inews-sent-ids nil)
|
|
|
476
|
|
|
477 (defun gnus-inews-reject-message ()
|
|
|
478 "Check whether this message has already been sent."
|
|
|
479 (when gnus-sent-message-ids-file
|
|
34
|
480 (let ((message-id (save-restriction (message-narrow-to-headers)
|
|
0
|
481 (mail-fetch-field "message-id")))
|
|
|
482 end)
|
|
|
483 (when message-id
|
|
|
484 (unless gnus-inews-sent-ids
|
|
16
|
485 (ignore-errors
|
|
|
486 (load t t t)))
|
|
0
|
487 (if (member message-id gnus-inews-sent-ids)
|
|
|
488 ;; Reject this message.
|
|
30
|
489 (not (gnus-yes-or-no-p
|
|
0
|
490 (format "Message %s already sent. Send anyway? "
|
|
|
491 message-id)))
|
|
|
492 (push message-id gnus-inews-sent-ids)
|
|
|
493 ;; Chop off the last Message-IDs.
|
|
30
|
494 (when (setq end (nthcdr gnus-sent-message-ids-length
|
|
0
|
495 gnus-inews-sent-ids))
|
|
|
496 (setcdr end nil))
|
|
|
497 (nnheader-temp-write gnus-sent-message-ids-file
|
|
16
|
498 (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids)))
|
|
0
|
499 nil)))))
|
|
|
500
|
|
|
501
|
|
|
502
|
|
|
503 ;; Dummy to avoid byte-compile warning.
|
|
|
504 (defvar nnspool-rejected-article-hook)
|
|
|
505
|
|
|
506 ;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
|
|
|
507 ;;; as well include the Emacs version as well.
|
|
|
508 ;;; The following function works with later GNU Emacs, and XEmacs.
|
|
|
509 (defun gnus-extended-version ()
|
|
|
510 "Stringified Gnus version and Emacs version"
|
|
|
511 (interactive)
|
|
|
512 (concat
|
|
|
513 gnus-version
|
|
|
514 "/"
|
|
|
515 (cond
|
|
|
516 ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
|
|
|
517 (concat "Emacs " (substring emacs-version
|
|
|
518 (match-beginning 1)
|
|
|
519 (match-end 1))))
|
|
32
|
520 ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
|
|
|
521 emacs-version)
|
|
0
|
522 (concat (substring emacs-version
|
|
|
523 (match-beginning 1)
|
|
|
524 (match-end 1))
|
|
32
|
525 (format " %d.%d" emacs-major-version emacs-minor-version)
|
|
|
526 (if (match-beginning 3)
|
|
|
527 (substring emacs-version
|
|
|
528 (match-beginning 3)
|
|
|
529 (match-end 3))
|
|
|
530 "")))
|
|
0
|
531 (t emacs-version))))
|
|
|
532
|
|
16
|
533 ;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
|
|
0
|
534 (defun gnus-inews-insert-mime-headers ()
|
|
|
535 (goto-char (point-min))
|
|
30
|
536 (let ((mail-header-separator
|
|
|
537 (progn
|
|
0
|
538 (goto-char (point-min))
|
|
|
539 (if (and (search-forward (concat "\n" mail-header-separator "\n")
|
|
|
540 nil t)
|
|
|
541 (not (search-backward "\n\n" nil t)))
|
|
|
542 mail-header-separator
|
|
|
543 ""))))
|
|
|
544 (or (mail-position-on-field "Mime-Version")
|
|
|
545 (insert "1.0")
|
|
|
546 (cond ((save-restriction
|
|
|
547 (widen)
|
|
|
548 (goto-char (point-min))
|
|
|
549 (re-search-forward "[\200-\377]" nil t))
|
|
|
550 (or (mail-position-on-field "Content-Type")
|
|
|
551 (insert "text/plain; charset=ISO-8859-1"))
|
|
|
552 (or (mail-position-on-field "Content-Transfer-Encoding")
|
|
|
553 (insert "8bit")))
|
|
|
554 (t (or (mail-position-on-field "Content-Type")
|
|
|
555 (insert "text/plain; charset=US-ASCII"))
|
|
|
556 (or (mail-position-on-field "Content-Transfer-Encoding")
|
|
|
557 (insert "7bit")))))))
|
|
|
558
|
|
|
559
|
|
|
560 ;;;
|
|
30
|
561 ;;; Gnus Mail Functions
|
|
0
|
562 ;;;
|
|
|
563
|
|
|
564 ;;; Mail reply commands of Gnus summary mode
|
|
|
565
|
|
16
|
566 (defun gnus-summary-reply (&optional yank wide)
|
|
|
567 "Start composing a reply mail to the current message.
|
|
30
|
568 If prefix argument YANK is non-nil, the original article is yanked
|
|
16
|
569 automatically."
|
|
30
|
570 (interactive
|
|
|
571 (list (and current-prefix-arg
|
|
0
|
572 (gnus-summary-work-articles 1))))
|
|
|
573 ;; Stripping headers should be specified with mail-yank-ignored-headers.
|
|
|
574 (gnus-set-global-variables)
|
|
30
|
575 (when yank
|
|
0
|
576 (gnus-summary-goto-subject (car yank)))
|
|
|
577 (let ((gnus-article-reply t))
|
|
|
578 (gnus-setup-message (if yank 'reply-yank 'reply)
|
|
|
579 (gnus-summary-select-article)
|
|
|
580 (set-buffer (gnus-copy-article-buffer))
|
|
16
|
581 (message-reply nil wide (gnus-group-find-parameter
|
|
|
582 gnus-newsgroup-name 'broken-reply-to))
|
|
0
|
583 (when yank
|
|
|
584 (gnus-inews-yank-articles yank)))))
|
|
|
585
|
|
16
|
586 (defun gnus-summary-reply-with-original (n &optional wide)
|
|
|
587 "Start composing a reply mail to the current message.
|
|
|
588 The original article will be yanked."
|
|
0
|
589 (interactive "P")
|
|
22
|
590 (gnus-summary-reply (gnus-summary-work-articles n) wide))
|
|
0
|
591
|
|
16
|
592 (defun gnus-summary-wide-reply (&optional yank)
|
|
|
593 "Start composing a wide reply mail to the current message.
|
|
30
|
594 If prefix argument YANK is non-nil, the original article is yanked
|
|
16
|
595 automatically."
|
|
30
|
596 (interactive
|
|
|
597 (list (and current-prefix-arg
|
|
16
|
598 (gnus-summary-work-articles 1))))
|
|
|
599 (gnus-summary-reply yank t))
|
|
|
600
|
|
|
601 (defun gnus-summary-wide-reply-with-original (n)
|
|
|
602 "Start composing a wide reply mail to the current message.
|
|
|
603 The original article will be yanked."
|
|
|
604 (interactive "P")
|
|
|
605 (gnus-summary-reply-with-original n t))
|
|
|
606
|
|
|
607 (defun gnus-summary-mail-forward (&optional full-headers post)
|
|
|
608 "Forward the current message to another user.
|
|
|
609 If FULL-HEADERS (the prefix), include full headers when forwarding."
|
|
0
|
610 (interactive "P")
|
|
|
611 (gnus-set-global-variables)
|
|
|
612 (gnus-setup-message 'forward
|
|
|
613 (gnus-summary-select-article)
|
|
|
614 (set-buffer gnus-original-article-buffer)
|
|
16
|
615 (let ((message-included-forward-headers
|
|
|
616 (if full-headers "" message-included-forward-headers)))
|
|
|
617 (message-forward post))))
|
|
0
|
618
|
|
16
|
619 (defun gnus-summary-resend-message (address n)
|
|
0
|
620 "Resend the current article to ADDRESS."
|
|
16
|
621 (interactive "sResend message(s) to: \nP")
|
|
|
622 (let ((articles (gnus-summary-work-articles n))
|
|
|
623 article)
|
|
|
624 (while (setq article (pop articles))
|
|
|
625 (gnus-summary-select-article nil nil nil article)
|
|
|
626 (save-excursion
|
|
|
627 (set-buffer gnus-original-article-buffer)
|
|
|
628 (message-resend address)))))
|
|
0
|
629
|
|
16
|
630 (defun gnus-summary-post-forward (&optional full-headers)
|
|
|
631 "Forward the current article to a newsgroup.
|
|
|
632 If FULL-HEADERS (the prefix), include full headers when forwarding."
|
|
|
633 (interactive "P")
|
|
|
634 (gnus-summary-mail-forward full-headers t))
|
|
0
|
635
|
|
30
|
636 (defvar gnus-nastygram-message
|
|
16
|
637 "The following article was inappropriately posted to %s.\n\n"
|
|
0
|
638 "Format string to insert in nastygrams.
|
|
|
639 The current group name will be inserted at \"%s\".")
|
|
|
640
|
|
|
641 (defun gnus-summary-mail-nastygram (n)
|
|
|
642 "Send a nastygram to the author of the current article."
|
|
|
643 (interactive "P")
|
|
16
|
644 (when (or gnus-expert-user
|
|
30
|
645 (gnus-y-or-n-p
|
|
16
|
646 "Really send a nastygram to the author of the current article? "))
|
|
|
647 (let ((group gnus-newsgroup-name))
|
|
|
648 (gnus-summary-reply-with-original n)
|
|
|
649 (set-buffer gnus-message-buffer)
|
|
|
650 (message-goto-body)
|
|
|
651 (insert (format gnus-nastygram-message group))
|
|
|
652 (message-send-and-exit))))
|
|
|
653
|
|
|
654 (defun gnus-summary-mail-crosspost-complaint (n)
|
|
|
655 "Send a complaint about crossposting to the current article(s)."
|
|
|
656 (interactive "P")
|
|
|
657 (let ((articles (gnus-summary-work-articles n))
|
|
|
658 article)
|
|
|
659 (while (setq article (pop articles))
|
|
|
660 (set-buffer gnus-summary-buffer)
|
|
|
661 (gnus-summary-goto-subject article)
|
|
|
662 (let ((group (gnus-group-real-name gnus-newsgroup-name))
|
|
|
663 newsgroups followup-to)
|
|
|
664 (gnus-summary-select-article)
|
|
|
665 (set-buffer gnus-original-article-buffer)
|
|
|
666 (if (and (<= (length (message-tokenize-header
|
|
|
667 (setq newsgroups (mail-fetch-field "newsgroups"))
|
|
|
668 ", "))
|
|
|
669 1)
|
|
|
670 (or (not (setq followup-to (mail-fetch-field "followup-to")))
|
|
|
671 (not (member group (message-tokenize-header
|
|
|
672 followup-to ", ")))))
|
|
|
673 (if followup-to
|
|
|
674 (gnus-message 1 "Followup-to restricted")
|
|
|
675 (gnus-message 1 "Not a crossposted article"))
|
|
|
676 (set-buffer gnus-summary-buffer)
|
|
|
677 (gnus-summary-reply-with-original 1)
|
|
|
678 (set-buffer gnus-message-buffer)
|
|
|
679 (message-goto-body)
|
|
|
680 (insert (format gnus-crosspost-complaint newsgroups group))
|
|
|
681 (message-goto-subject)
|
|
|
682 (re-search-forward " *$")
|
|
|
683 (replace-match " (crosspost notification)" t t)
|
|
|
684 (when (gnus-y-or-n-p "Send this complaint? ")
|
|
|
685 (message-send-and-exit)))))))
|
|
0
|
686
|
|
|
687 (defun gnus-summary-mail-other-window ()
|
|
|
688 "Compose mail in other window."
|
|
|
689 (interactive)
|
|
|
690 (gnus-setup-message 'message
|
|
|
691 (message-mail)))
|
|
|
692
|
|
|
693 (defun gnus-mail-parse-comma-list ()
|
|
|
694 (let (accumulated
|
|
|
695 beg)
|
|
|
696 (skip-chars-forward " ")
|
|
|
697 (while (not (eobp))
|
|
|
698 (setq beg (point))
|
|
|
699 (skip-chars-forward "^,")
|
|
|
700 (while (zerop
|
|
30
|
701 (save-excursion
|
|
0
|
702 (save-restriction
|
|
|
703 (let ((i 0))
|
|
|
704 (narrow-to-region beg (point))
|
|
|
705 (goto-char beg)
|
|
|
706 (logand (progn
|
|
|
707 (while (search-forward "\"" nil t)
|
|
|
708 (incf i))
|
|
16
|
709 (if (zerop i) 2 i))
|
|
|
710 2)))))
|
|
0
|
711 (skip-chars-forward ",")
|
|
|
712 (skip-chars-forward "^,"))
|
|
|
713 (skip-chars-backward " ")
|
|
16
|
714 (push (buffer-substring beg (point))
|
|
|
715 accumulated)
|
|
0
|
716 (skip-chars-forward "^,")
|
|
|
717 (skip-chars-forward ", "))
|
|
|
718 accumulated))
|
|
|
719
|
|
|
720 (defun gnus-inews-add-to-address (group)
|
|
|
721 (let ((to-address (mail-fetch-field "to")))
|
|
|
722 (when (and to-address
|
|
|
723 (gnus-alive-p))
|
|
|
724 ;; This mail group doesn't have a `to-list', so we add one
|
|
30
|
725 ;; here. Magic!
|
|
36
|
726 (when (gnus-y-or-n-p
|
|
|
727 (format "Do you want to add this as `to-list': %s " to-address))
|
|
|
728 (gnus-group-add-parameter group (cons 'to-list to-address))))))
|
|
0
|
729
|
|
|
730 (defun gnus-put-message ()
|
|
|
731 "Put the current message in some group and return to Gnus."
|
|
|
732 (interactive)
|
|
|
733 (let ((reply gnus-article-reply)
|
|
|
734 (winconf gnus-prev-winconf)
|
|
|
735 (group gnus-newsgroup-name))
|
|
30
|
736
|
|
0
|
737 (or (and group (not (gnus-group-read-only-p group)))
|
|
|
738 (setq group (read-string "Put in group: " nil
|
|
|
739 (gnus-writable-groups))))
|
|
16
|
740 (when (gnus-gethash group gnus-newsrc-hashtb)
|
|
|
741 (error "No such group: %s" group))
|
|
0
|
742
|
|
|
743 (save-excursion
|
|
|
744 (save-restriction
|
|
|
745 (widen)
|
|
34
|
746 (message-narrow-to-headers)
|
|
0
|
747 (let (gnus-deletable-headers)
|
|
|
748 (if (message-news-p)
|
|
|
749 (message-generate-headers message-required-news-headers)
|
|
|
750 (message-generate-headers message-required-mail-headers)))
|
|
|
751 (goto-char (point-max))
|
|
|
752 (insert "Gcc: " group "\n")
|
|
|
753 (widen)))
|
|
|
754
|
|
|
755 (gnus-inews-do-gcc)
|
|
|
756
|
|
16
|
757 (when (get-buffer gnus-group-buffer)
|
|
|
758 (when (gnus-buffer-exists-p (car-safe reply))
|
|
|
759 (set-buffer (car reply))
|
|
|
760 (and (cdr reply)
|
|
30
|
761 (gnus-summary-mark-article-as-replied
|
|
16
|
762 (cdr reply))))
|
|
|
763 (when winconf
|
|
|
764 (set-window-configuration winconf)))))
|
|
0
|
765
|
|
|
766 (defun gnus-article-mail (yank)
|
|
|
767 "Send a reply to the address near point.
|
|
|
768 If YANK is non-nil, include the original article."
|
|
|
769 (interactive "P")
|
|
30
|
770 (let ((address
|
|
0
|
771 (buffer-substring
|
|
|
772 (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
|
|
|
773 (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
|
|
|
774 (when address
|
|
|
775 (message-reply address)
|
|
|
776 (when yank
|
|
2
|
777 (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
|
|
0
|
778
|
|
16
|
779 (defvar nntp-server-type)
|
|
0
|
780 (defun gnus-bug ()
|
|
|
781 "Send a bug report to the Gnus maintainers."
|
|
|
782 (interactive)
|
|
16
|
783 (unless (gnus-alive-p)
|
|
|
784 (error "Gnus has been shut down"))
|
|
0
|
785 (gnus-setup-message 'bug
|
|
|
786 (delete-other-windows)
|
|
|
787 (switch-to-buffer "*Gnus Help Bug*")
|
|
|
788 (erase-buffer)
|
|
|
789 (insert gnus-bug-message)
|
|
|
790 (goto-char (point-min))
|
|
|
791 (message-pop-to-buffer "*Gnus Bug*")
|
|
|
792 (message-setup `((To . ,gnus-maintainer) (Subject . "")))
|
|
|
793 (push `(gnus-bug-kill-buffer) message-send-actions)
|
|
|
794 (goto-char (point-min))
|
|
|
795 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
|
|
|
796 (forward-line 1)
|
|
|
797 (insert (gnus-version) "\n")
|
|
16
|
798 (insert (emacs-version) "\n")
|
|
|
799 (when (and (boundp 'nntp-server-type)
|
|
|
800 (stringp nntp-server-type))
|
|
|
801 (insert nntp-server-type))
|
|
0
|
802 (insert "\n\n\n\n\n")
|
|
|
803 (gnus-debug)
|
|
|
804 (goto-char (point-min))
|
|
|
805 (search-forward "Subject: " nil t)
|
|
|
806 (message "")))
|
|
|
807
|
|
|
808 (defun gnus-bug-kill-buffer ()
|
|
16
|
809 (when (get-buffer "*Gnus Help Bug*")
|
|
|
810 (kill-buffer "*Gnus Help Bug*")))
|
|
0
|
811
|
|
|
812 (defun gnus-debug ()
|
|
16
|
813 "Attempts to go through the Gnus source file and report what variables have been changed.
|
|
0
|
814 The source file has to be in the Emacs load path."
|
|
|
815 (interactive)
|
|
16
|
816 (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
|
|
|
817 "gnus-art.el" "gnus-start.el" "gnus-async.el"
|
|
|
818 "gnus-msg.el" "gnus-score.el" "gnus-win.el"
|
|
|
819 "nnmail.el" "message.el"))
|
|
|
820 file expr olist sym)
|
|
0
|
821 (gnus-message 4 "Please wait while we snoop your variables...")
|
|
|
822 (sit-for 0)
|
|
16
|
823 ;; Go through all the files looking for non-default values for variables.
|
|
0
|
824 (save-excursion
|
|
|
825 (set-buffer (get-buffer-create " *gnus bug info*"))
|
|
|
826 (buffer-disable-undo (current-buffer))
|
|
|
827 (while files
|
|
|
828 (erase-buffer)
|
|
16
|
829 (when (and (setq file (locate-library (pop files)))
|
|
|
830 (file-exists-p file))
|
|
|
831 (insert-file-contents file)
|
|
|
832 (goto-char (point-min))
|
|
|
833 (if (not (re-search-forward "^;;* *Internal variables" nil t))
|
|
|
834 (gnus-message 4 "Malformed sources in file %s" file)
|
|
|
835 (narrow-to-region (point-min) (point))
|
|
0
|
836 (goto-char (point-min))
|
|
16
|
837 (while (setq expr (ignore-errors (read (current-buffer))))
|
|
|
838 (ignore-errors
|
|
|
839 (and (or (eq (car expr) 'defvar)
|
|
|
840 (eq (car expr) 'defcustom))
|
|
|
841 (stringp (nth 3 expr))
|
|
|
842 (or (not (boundp (nth 1 expr)))
|
|
|
843 (not (equal (eval (nth 2 expr))
|
|
|
844 (symbol-value (nth 1 expr)))))
|
|
|
845 (push (nth 1 expr) olist)))))))
|
|
0
|
846 (kill-buffer (current-buffer)))
|
|
|
847 (when (setq olist (nreverse olist))
|
|
|
848 (insert "------------------ Environment follows ------------------\n\n"))
|
|
|
849 (while olist
|
|
|
850 (if (boundp (car olist))
|
|
|
851 (condition-case ()
|
|
|
852 (pp `(setq ,(car olist)
|
|
|
853 ,(if (or (consp (setq sym (symbol-value (car olist))))
|
|
|
854 (and (symbolp sym)
|
|
|
855 (not (or (eq sym nil)
|
|
|
856 (eq sym t)))))
|
|
|
857 (list 'quote (symbol-value (car olist)))
|
|
|
858 (symbol-value (car olist))))
|
|
|
859 (current-buffer))
|
|
|
860 (error
|
|
|
861 (format "(setq %s 'whatever)\n" (car olist))))
|
|
|
862 (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
|
|
|
863 (setq olist (cdr olist)))
|
|
|
864 (insert "\n\n")
|
|
|
865 ;; Remove any null chars - they seem to cause trouble for some
|
|
16
|
866 ;; mailers. (Byte-compiled output from the stuff above.)
|
|
0
|
867 (goto-char (point-min))
|
|
|
868 (while (re-search-forward "[\000\200]" nil t)
|
|
|
869 (replace-match "" t t))))
|
|
|
870
|
|
|
871 ;;; Treatment of rejected articles.
|
|
|
872 ;;; Bounced mail.
|
|
|
873
|
|
|
874 (defun gnus-summary-resend-bounced-mail (&optional fetch)
|
|
|
875 "Re-mail the current message.
|
|
|
876 This only makes sense if the current message is a bounce message than
|
|
|
877 contains some mail you have written which has been bounced back to
|
|
|
878 you.
|
|
|
879 If FETCH, try to fetch the article that this is a reply to, if indeed
|
|
|
880 this is a reply."
|
|
|
881 (interactive "P")
|
|
|
882 (gnus-summary-select-article t)
|
|
|
883 (set-buffer gnus-original-article-buffer)
|
|
|
884 (gnus-setup-message 'compose-bounce
|
|
|
885 (let* ((references (mail-fetch-field "references"))
|
|
|
886 (parent (and references (gnus-parent-id references))))
|
|
|
887 (message-bounce)
|
|
30
|
888 ;; If there are references, we fetch the article we answered to.
|
|
0
|
889 (and fetch parent
|
|
|
890 (gnus-summary-refer-article parent)
|
|
|
891 (gnus-summary-show-all-headers)))))
|
|
|
892
|
|
|
893 ;;; Gcc handling.
|
|
|
894
|
|
30
|
895 ;; Do Gcc handling, which copied the message over to some group.
|
|
0
|
896 (defun gnus-inews-do-gcc (&optional gcc)
|
|
30
|
897 (interactive)
|
|
0
|
898 (when (gnus-alive-p)
|
|
|
899 (save-excursion
|
|
|
900 (save-restriction
|
|
|
901 (message-narrow-to-headers)
|
|
|
902 (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
|
|
|
903 (cur (current-buffer))
|
|
|
904 groups group method)
|
|
|
905 (when gcc
|
|
|
906 (message-remove-header "gcc")
|
|
|
907 (widen)
|
|
|
908 (setq groups (message-tokenize-header gcc " ,"))
|
|
|
909 ;; Copy the article over to some group(s).
|
|
|
910 (while (setq group (pop groups))
|
|
30
|
911 (gnus-check-server
|
|
0
|
912 (setq method
|
|
|
913 (cond ((and (null (gnus-get-info group))
|
|
|
914 (eq (car gnus-message-archive-method)
|
|
30
|
915 (car
|
|
0
|
916 (gnus-server-to-method
|
|
|
917 (gnus-group-method group)))))
|
|
|
918 ;; If the group doesn't exist, we assume
|
|
|
919 ;; it's an archive group...
|
|
|
920 gnus-message-archive-method)
|
|
|
921 ;; Use the method.
|
|
|
922 ((gnus-info-method (gnus-get-info group))
|
|
|
923 (gnus-info-method (gnus-get-info group)))
|
|
|
924 ;; Find the method.
|
|
|
925 (t (gnus-group-method group)))))
|
|
|
926 (gnus-check-server method)
|
|
|
927 (unless (gnus-request-group group t method)
|
|
|
928 (gnus-request-create-group group method))
|
|
|
929 (save-excursion
|
|
|
930 (nnheader-set-temp-buffer " *acc*")
|
|
|
931 (insert-buffer-substring cur)
|
|
|
932 (goto-char (point-min))
|
|
30
|
933 (when (re-search-forward
|
|
0
|
934 (concat "^" (regexp-quote mail-header-separator) "$")
|
|
|
935 nil t)
|
|
|
936 (replace-match "" t t ))
|
|
|
937 (unless (gnus-request-accept-article group method t)
|
|
30
|
938 (gnus-message 1 "Couldn't store article in group %s: %s"
|
|
0
|
939 group (gnus-status-message method))
|
|
|
940 (sit-for 2))
|
|
|
941 (kill-buffer (current-buffer))))))))))
|
|
|
942
|
|
|
943 (defun gnus-inews-insert-gcc ()
|
|
|
944 "Insert Gcc headers based on `gnus-outgoing-message-group'."
|
|
|
945 (save-excursion
|
|
|
946 (save-restriction
|
|
34
|
947 (message-narrow-to-headers)
|
|
0
|
948 (let* ((group gnus-outgoing-message-group)
|
|
30
|
949 (gcc (cond
|
|
0
|
950 ((gnus-functionp group)
|
|
|
951 (funcall group))
|
|
|
952 ((or (stringp group) (list group))
|
|
|
953 group))))
|
|
|
954 (when gcc
|
|
|
955 (insert "Gcc: "
|
|
|
956 (if (stringp gcc) gcc
|
|
|
957 (mapconcat 'identity gcc " "))
|
|
|
958 "\n"))))))
|
|
|
959
|
|
|
960 (defun gnus-inews-insert-archive-gcc (&optional group)
|
|
|
961 "Insert the Gcc to say where the article is to be archived."
|
|
|
962 (let* ((var gnus-message-archive-group)
|
|
|
963 (group (or group gnus-newsgroup-name ""))
|
|
|
964 result
|
|
16
|
965 gcc-self-val
|
|
0
|
966 (groups
|
|
30
|
967 (cond
|
|
0
|
968 ((null gnus-message-archive-method)
|
|
|
969 ;; Ignore.
|
|
|
970 nil)
|
|
|
971 ((stringp var)
|
|
|
972 ;; Just a single group.
|
|
|
973 (list var))
|
|
|
974 ((null var)
|
|
|
975 ;; We don't want this.
|
|
|
976 nil)
|
|
|
977 ((and (listp var) (stringp (car var)))
|
|
|
978 ;; A list of groups.
|
|
|
979 var)
|
|
|
980 ((gnus-functionp var)
|
|
|
981 ;; A function.
|
|
|
982 (funcall var group))
|
|
|
983 (t
|
|
|
984 ;; An alist of regexps/functions/forms.
|
|
|
985 (while (and var
|
|
|
986 (not
|
|
|
987 (setq result
|
|
30
|
988 (cond
|
|
0
|
989 ((stringp (caar var))
|
|
|
990 ;; Regexp.
|
|
|
991 (when (string-match (caar var) group)
|
|
|
992 (cdar var)))
|
|
|
993 ((gnus-functionp (car var))
|
|
|
994 ;; Function.
|
|
|
995 (funcall (car var) group))
|
|
|
996 (t
|
|
|
997 (eval (car var)))))))
|
|
|
998 (setq var (cdr var)))
|
|
|
999 result)))
|
|
|
1000 name)
|
|
|
1001 (when groups
|
|
|
1002 (when (stringp groups)
|
|
|
1003 (setq groups (list groups)))
|
|
|
1004 (save-excursion
|
|
|
1005 (save-restriction
|
|
34
|
1006 (message-narrow-to-headers)
|
|
0
|
1007 (goto-char (point-max))
|
|
|
1008 (insert "Gcc: ")
|
|
16
|
1009 (if (and gnus-newsgroup-name
|
|
|
1010 (setq gcc-self-val
|
|
|
1011 (gnus-group-find-parameter
|
|
|
1012 gnus-newsgroup-name 'gcc-self)))
|
|
30
|
1013 (progn
|
|
16
|
1014 (insert
|
|
|
1015 (if (stringp gcc-self-val)
|
|
|
1016 gcc-self-val
|
|
|
1017 group))
|
|
|
1018 (if (not (eq gcc-self-val 'none))
|
|
|
1019 (insert "\n")
|
|
|
1020 (progn
|
|
|
1021 (beginning-of-line)
|
|
|
1022 (kill-line))))
|
|
|
1023 (while (setq name (pop groups))
|
|
|
1024 (insert (if (string-match ":" name)
|
|
|
1025 name
|
|
30
|
1026 (gnus-group-prefixed-name
|
|
16
|
1027 name gnus-message-archive-method)))
|
|
|
1028 (when groups
|
|
|
1029 (insert " ")))
|
|
|
1030 (insert "\n")))))))
|
|
0
|
1031
|
|
|
1032 (defun gnus-summary-send-draft ()
|
|
|
1033 "Enter a mail/post buffer to edit and send the draft."
|
|
|
1034 (interactive)
|
|
|
1035 (gnus-set-global-variables)
|
|
|
1036 (let (buf)
|
|
30
|
1037 (if (not (setq buf (gnus-request-restore-buffer
|
|
0
|
1038 (gnus-summary-article-number) gnus-newsgroup-name)))
|
|
|
1039 (error "Couldn't restore the article")
|
|
|
1040 (switch-to-buffer buf)
|
|
|
1041 (when (eq major-mode 'news-reply-mode)
|
|
|
1042 (local-set-key "\C-c\C-c" 'gnus-inews-news))
|
|
|
1043 ;; Insert the separator.
|
|
|
1044 (goto-char (point-min))
|
|
|
1045 (search-forward "\n\n")
|
|
|
1046 (forward-char -1)
|
|
|
1047 (insert mail-header-separator)
|
|
|
1048 ;; Configure windows.
|
|
|
1049 (let ((gnus-draft-buffer (current-buffer)))
|
|
|
1050 (gnus-configure-windows 'draft t)
|
|
|
1051 (goto-char (point))))))
|
|
30
|
1052
|
|
0
|
1053 (gnus-add-shutdown 'gnus-inews-close 'gnus)
|
|
|
1054
|
|
|
1055 (defun gnus-inews-close ()
|
|
|
1056 (setq gnus-inews-sent-ids nil))
|
|
30
|
1057
|
|
0
|
1058 ;;; Allow redefinition of functions.
|
|
|
1059
|
|
|
1060 (gnus-ems-redefine)
|
|
|
1061
|
|
|
1062 (provide 'gnus-msg)
|
|
|
1063
|
|
|
1064 ;;; gnus-msg.el ends here
|
