|
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 ()
|
|
|
311 (gnus-cache-possibly-remove-article ,article nil nil nil t)))
|
|
16
|
312 message-send-actions)
|
|
|
313 (push
|
|
|
314 `((lambda ()
|
|
|
315 (when (buffer-name (get-buffer ,gnus-summary-buffer))
|
|
|
316 (save-excursion
|
|
|
317 (set-buffer (get-buffer ,gnus-summary-buffer))
|
|
|
318 (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
|
|
0
|
319 message-send-actions))))
|
|
|
320
|
|
|
321
|
|
|
322
|
|
|
323 (defun gnus-copy-article-buffer (&optional article-buffer)
|
|
|
324 ;; make a copy of the article buffer with all text properties removed
|
|
|
325 ;; this copy is in the buffer gnus-article-copy.
|
|
|
326 ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
|
|
|
327 ;; this buffer should be passed to all mail/news reply/post routines.
|
|
|
328 (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
|
|
|
329 (buffer-disable-undo gnus-article-copy)
|
|
|
330 (or (memq gnus-article-copy gnus-buffer-list)
|
|
16
|
331 (push gnus-article-copy gnus-buffer-list))
|
|
0
|
332 (let ((article-buffer (or article-buffer gnus-article-buffer))
|
|
|
333 end beg contents)
|
|
16
|
334 (if (not (and (get-buffer article-buffer)
|
|
|
335 (buffer-name (get-buffer article-buffer))))
|
|
|
336 (error "Can't find any article buffer")
|
|
0
|
337 (save-excursion
|
|
|
338 (set-buffer article-buffer)
|
|
|
339 (save-restriction
|
|
16
|
340 ;; Copy over the (displayed) article buffer, delete
|
|
|
341 ;; hidden text and remove text properties.
|
|
0
|
342 (widen)
|
|
16
|
343 (copy-to-buffer gnus-article-copy (point-min) (point-max))
|
|
|
344 (set-buffer gnus-article-copy)
|
|
|
345 (gnus-article-delete-text-of-type 'annotation)
|
|
|
346 (gnus-remove-text-with-property 'gnus-prev)
|
|
|
347 (gnus-remove-text-with-property 'gnus-next)
|
|
|
348 (insert
|
|
|
349 (prog1
|
|
|
350 (format "%s" (buffer-string))
|
|
|
351 (erase-buffer)))
|
|
|
352 ;; Find the original headers.
|
|
0
|
353 (set-buffer gnus-original-article-buffer)
|
|
|
354 (goto-char (point-min))
|
|
|
355 (while (looking-at message-unix-mail-delimiter)
|
|
|
356 (forward-line 1))
|
|
|
357 (setq beg (point))
|
|
|
358 (setq end (or (search-forward "\n\n" nil t) (point)))
|
|
16
|
359 ;; Delete the headers from the displayed articles.
|
|
0
|
360 (set-buffer gnus-article-copy)
|
|
|
361 (delete-region (goto-char (point-min))
|
|
|
362 (or (search-forward "\n\n" nil t) (point)))
|
|
16
|
363 ;; Insert the original article headers.
|
|
|
364 (insert-buffer-substring gnus-original-article-buffer beg end)
|
|
|
365 (gnus-article-decode-rfc1522)))
|
|
0
|
366 gnus-article-copy)))
|
|
|
367
|
|
|
368 (defun gnus-post-news (post &optional group header article-buffer yank subject
|
|
|
369 force-news)
|
|
|
370 (when article-buffer
|
|
|
371 (gnus-copy-article-buffer))
|
|
|
372 (let ((gnus-article-reply article-buffer))
|
|
|
373 (gnus-setup-message (cond (yank 'reply-yank)
|
|
|
374 (article-buffer 'reply)
|
|
|
375 (t 'message))
|
|
|
376 (let* ((group (or group gnus-newsgroup-name))
|
|
|
377 (pgroup group)
|
|
30
|
378 to-address to-group mailing-list to-list
|
|
16
|
379 newsgroup-p)
|
|
0
|
380 (when group
|
|
16
|
381 (setq to-address (gnus-group-find-parameter group 'to-address)
|
|
|
382 to-group (gnus-group-find-parameter group 'to-group)
|
|
|
383 to-list (gnus-group-find-parameter group 'to-list)
|
|
|
384 newsgroup-p (gnus-group-find-parameter group 'newsgroup)
|
|
0
|
385 mailing-list (when gnus-mailing-list-groups
|
|
|
386 (string-match gnus-mailing-list-groups group))
|
|
|
387 group (gnus-group-real-name group)))
|
|
|
388 (if (or (and to-group
|
|
|
389 (gnus-news-group-p to-group))
|
|
16
|
390 newsgroup-p
|
|
0
|
391 force-news
|
|
30
|
392 (and (gnus-news-group-p
|
|
0
|
393 (or pgroup gnus-newsgroup-name)
|
|
|
394 (if header (mail-header-number header)
|
|
|
395 gnus-current-article))
|
|
|
396 (not mailing-list)
|
|
|
397 (not to-list)
|
|
|
398 (not to-address)))
|
|
|
399 ;; This is news.
|
|
|
400 (if post
|
|
|
401 (message-news (or to-group group))
|
|
|
402 (set-buffer gnus-article-copy)
|
|
16
|
403 (message-followup (if (or newsgroup-p force-news) nil to-group)))
|
|
0
|
404 ;; The is mail.
|
|
|
405 (if post
|
|
|
406 (progn
|
|
|
407 (message-mail (or to-address to-list))
|
|
|
408 ;; Arrange for mail groups that have no `to-address' to
|
|
|
409 ;; get that when the user sends off the mail.
|
|
|
410 (push (list 'gnus-inews-add-to-address group)
|
|
|
411 message-send-actions))
|
|
|
412 (set-buffer gnus-article-copy)
|
|
|
413 (message-wide-reply to-address)))
|
|
|
414 (when yank
|
|
|
415 (gnus-inews-yank-articles yank))))))
|
|
|
416
|
|
|
417 (defun gnus-post-method (arg group &optional silent)
|
|
|
418 "Return the posting method based on GROUP and ARG.
|
|
|
419 If SILENT, don't prompt the user."
|
|
|
420 (let ((group-method (gnus-find-method-for-group group)))
|
|
30
|
421 (cond
|
|
|
422 ;; If the group-method is nil (which shouldn't happen) we use
|
|
0
|
423 ;; the default method.
|
|
16
|
424 ((null group-method)
|
|
0
|
425 (or gnus-post-method gnus-select-method message-post-method))
|
|
|
426 ;; We want this group's method.
|
|
|
427 ((and arg (not (eq arg 0)))
|
|
|
428 group-method)
|
|
|
429 ;; We query the user for a post method.
|
|
|
430 ((or arg
|
|
|
431 (and gnus-post-method
|
|
|
432 (listp (car gnus-post-method))))
|
|
|
433 (let* ((methods
|
|
|
434 ;; Collect all methods we know about.
|
|
|
435 (append
|
|
|
436 (when gnus-post-method
|
|
|
437 (if (listp (car gnus-post-method))
|
|
|
438 gnus-post-method
|
|
|
439 (list gnus-post-method)))
|
|
|
440 gnus-secondary-select-methods
|
|
|
441 (list gnus-select-method)
|
|
|
442 (list group-method)))
|
|
|
443 method-alist post-methods method)
|
|
|
444 ;; Weed out all mail methods.
|
|
|
445 (while methods
|
|
|
446 (setq method (gnus-server-get-method "" (pop methods)))
|
|
|
447 (when (or (gnus-method-option-p method 'post)
|
|
|
448 (gnus-method-option-p method 'post-mail))
|
|
|
449 (push method post-methods)))
|
|
|
450 ;; Create a name-method alist.
|
|
|
451 (setq method-alist
|
|
30
|
452 (mapcar
|
|
0
|
453 (lambda (m)
|
|
|
454 (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
|
|
|
455 post-methods))
|
|
|
456 ;; Query the user.
|
|
|
457 (cadr
|
|
|
458 (assoc
|
|
|
459 (setq gnus-last-posting-server
|
|
|
460 (if (and silent
|
|
|
461 gnus-last-posting-server)
|
|
|
462 ;; Just use the last value.
|
|
|
463 gnus-last-posting-server
|
|
|
464 (completing-read
|
|
|
465 "Posting method: " method-alist nil t
|
|
|
466 (cons (or gnus-last-posting-server "") 0))))
|
|
|
467 method-alist))))
|
|
|
468 ;; Override normal method.
|
|
16
|
469 (gnus-post-method
|
|
0
|
470 gnus-post-method)
|
|
|
471 ;; Use the normal select method.
|
|
|
472 (t gnus-select-method))))
|
|
|
473
|
|
|
474 (defun gnus-inews-narrow-to-headers ()
|
|
|
475 (widen)
|
|
|
476 (narrow-to-region
|
|
|
477 (goto-char (point-min))
|
|
30
|
478 (or (and (re-search-forward
|
|
0
|
479 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
|
|
|
480 (match-beginning 0))
|
|
|
481 (point-max)))
|
|
|
482 (goto-char (point-min)))
|
|
|
483
|
|
|
484 ;;;
|
|
|
485 ;;; Check whether the message has been sent already.
|
|
|
486 ;;;
|
|
|
487
|
|
|
488 (defvar gnus-inews-sent-ids nil)
|
|
|
489
|
|
|
490 (defun gnus-inews-reject-message ()
|
|
|
491 "Check whether this message has already been sent."
|
|
|
492 (when gnus-sent-message-ids-file
|
|
|
493 (let ((message-id (save-restriction (gnus-inews-narrow-to-headers)
|
|
|
494 (mail-fetch-field "message-id")))
|
|
|
495 end)
|
|
|
496 (when message-id
|
|
|
497 (unless gnus-inews-sent-ids
|
|
16
|
498 (ignore-errors
|
|
|
499 (load t t t)))
|
|
0
|
500 (if (member message-id gnus-inews-sent-ids)
|
|
|
501 ;; Reject this message.
|
|
30
|
502 (not (gnus-yes-or-no-p
|
|
0
|
503 (format "Message %s already sent. Send anyway? "
|
|
|
504 message-id)))
|
|
|
505 (push message-id gnus-inews-sent-ids)
|
|
|
506 ;; Chop off the last Message-IDs.
|
|
30
|
507 (when (setq end (nthcdr gnus-sent-message-ids-length
|
|
0
|
508 gnus-inews-sent-ids))
|
|
|
509 (setcdr end nil))
|
|
|
510 (nnheader-temp-write gnus-sent-message-ids-file
|
|
16
|
511 (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids)))
|
|
0
|
512 nil)))))
|
|
|
513
|
|
|
514
|
|
|
515
|
|
|
516 ;; Dummy to avoid byte-compile warning.
|
|
|
517 (defvar nnspool-rejected-article-hook)
|
|
|
518
|
|
|
519 ;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
|
|
|
520 ;;; as well include the Emacs version as well.
|
|
|
521 ;;; The following function works with later GNU Emacs, and XEmacs.
|
|
|
522 (defun gnus-extended-version ()
|
|
|
523 "Stringified Gnus version and Emacs version"
|
|
|
524 (interactive)
|
|
|
525 (concat
|
|
|
526 gnus-version
|
|
|
527 "/"
|
|
|
528 (cond
|
|
|
529 ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
|
|
|
530 (concat "Emacs " (substring emacs-version
|
|
|
531 (match-beginning 1)
|
|
|
532 (match-end 1))))
|
|
|
533 ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)" emacs-version)
|
|
|
534 (concat (substring emacs-version
|
|
|
535 (match-beginning 1)
|
|
|
536 (match-end 1))
|
|
|
537 (format " %d.%d" emacs-major-version emacs-minor-version)))
|
|
|
538 (t emacs-version))))
|
|
|
539
|
|
16
|
540 ;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
|
|
0
|
541 (defun gnus-inews-insert-mime-headers ()
|
|
|
542 (goto-char (point-min))
|
|
30
|
543 (let ((mail-header-separator
|
|
|
544 (progn
|
|
0
|
545 (goto-char (point-min))
|
|
|
546 (if (and (search-forward (concat "\n" mail-header-separator "\n")
|
|
|
547 nil t)
|
|
|
548 (not (search-backward "\n\n" nil t)))
|
|
|
549 mail-header-separator
|
|
|
550 ""))))
|
|
|
551 (or (mail-position-on-field "Mime-Version")
|
|
|
552 (insert "1.0")
|
|
|
553 (cond ((save-restriction
|
|
|
554 (widen)
|
|
|
555 (goto-char (point-min))
|
|
|
556 (re-search-forward "[\200-\377]" nil t))
|
|
|
557 (or (mail-position-on-field "Content-Type")
|
|
|
558 (insert "text/plain; charset=ISO-8859-1"))
|
|
|
559 (or (mail-position-on-field "Content-Transfer-Encoding")
|
|
|
560 (insert "8bit")))
|
|
|
561 (t (or (mail-position-on-field "Content-Type")
|
|
|
562 (insert "text/plain; charset=US-ASCII"))
|
|
|
563 (or (mail-position-on-field "Content-Transfer-Encoding")
|
|
|
564 (insert "7bit")))))))
|
|
|
565
|
|
|
566
|
|
|
567 ;;;
|
|
30
|
568 ;;; Gnus Mail Functions
|
|
0
|
569 ;;;
|
|
|
570
|
|
|
571 ;;; Mail reply commands of Gnus summary mode
|
|
|
572
|
|
16
|
573 (defun gnus-summary-reply (&optional yank wide)
|
|
|
574 "Start composing a reply mail to the current message.
|
|
30
|
575 If prefix argument YANK is non-nil, the original article is yanked
|
|
16
|
576 automatically."
|
|
30
|
577 (interactive
|
|
|
578 (list (and current-prefix-arg
|
|
0
|
579 (gnus-summary-work-articles 1))))
|
|
|
580 ;; Stripping headers should be specified with mail-yank-ignored-headers.
|
|
|
581 (gnus-set-global-variables)
|
|
30
|
582 (when yank
|
|
0
|
583 (gnus-summary-goto-subject (car yank)))
|
|
|
584 (let ((gnus-article-reply t))
|
|
|
585 (gnus-setup-message (if yank 'reply-yank 'reply)
|
|
|
586 (gnus-summary-select-article)
|
|
|
587 (set-buffer (gnus-copy-article-buffer))
|
|
16
|
588 (message-reply nil wide (gnus-group-find-parameter
|
|
|
589 gnus-newsgroup-name 'broken-reply-to))
|
|
0
|
590 (when yank
|
|
|
591 (gnus-inews-yank-articles yank)))))
|
|
|
592
|
|
16
|
593 (defun gnus-summary-reply-with-original (n &optional wide)
|
|
|
594 "Start composing a reply mail to the current message.
|
|
|
595 The original article will be yanked."
|
|
0
|
596 (interactive "P")
|
|
22
|
597 (gnus-summary-reply (gnus-summary-work-articles n) wide))
|
|
0
|
598
|
|
16
|
599 (defun gnus-summary-wide-reply (&optional yank)
|
|
|
600 "Start composing a wide reply mail to the current message.
|
|
30
|
601 If prefix argument YANK is non-nil, the original article is yanked
|
|
16
|
602 automatically."
|
|
30
|
603 (interactive
|
|
|
604 (list (and current-prefix-arg
|
|
16
|
605 (gnus-summary-work-articles 1))))
|
|
|
606 (gnus-summary-reply yank t))
|
|
|
607
|
|
|
608 (defun gnus-summary-wide-reply-with-original (n)
|
|
|
609 "Start composing a wide reply mail to the current message.
|
|
|
610 The original article will be yanked."
|
|
|
611 (interactive "P")
|
|
|
612 (gnus-summary-reply-with-original n t))
|
|
|
613
|
|
|
614 (defun gnus-summary-mail-forward (&optional full-headers post)
|
|
|
615 "Forward the current message to another user.
|
|
|
616 If FULL-HEADERS (the prefix), include full headers when forwarding."
|
|
0
|
617 (interactive "P")
|
|
|
618 (gnus-set-global-variables)
|
|
|
619 (gnus-setup-message 'forward
|
|
|
620 (gnus-summary-select-article)
|
|
|
621 (set-buffer gnus-original-article-buffer)
|
|
16
|
622 (let ((message-included-forward-headers
|
|
|
623 (if full-headers "" message-included-forward-headers)))
|
|
|
624 (message-forward post))))
|
|
0
|
625
|
|
16
|
626 (defun gnus-summary-resend-message (address n)
|
|
0
|
627 "Resend the current article to ADDRESS."
|
|
16
|
628 (interactive "sResend message(s) to: \nP")
|
|
|
629 (let ((articles (gnus-summary-work-articles n))
|
|
|
630 article)
|
|
|
631 (while (setq article (pop articles))
|
|
|
632 (gnus-summary-select-article nil nil nil article)
|
|
|
633 (save-excursion
|
|
|
634 (set-buffer gnus-original-article-buffer)
|
|
|
635 (message-resend address)))))
|
|
0
|
636
|
|
16
|
637 (defun gnus-summary-post-forward (&optional full-headers)
|
|
|
638 "Forward the current article to a newsgroup.
|
|
|
639 If FULL-HEADERS (the prefix), include full headers when forwarding."
|
|
|
640 (interactive "P")
|
|
|
641 (gnus-summary-mail-forward full-headers t))
|
|
0
|
642
|
|
30
|
643 (defvar gnus-nastygram-message
|
|
16
|
644 "The following article was inappropriately posted to %s.\n\n"
|
|
0
|
645 "Format string to insert in nastygrams.
|
|
|
646 The current group name will be inserted at \"%s\".")
|
|
|
647
|
|
|
648 (defun gnus-summary-mail-nastygram (n)
|
|
|
649 "Send a nastygram to the author of the current article."
|
|
|
650 (interactive "P")
|
|
16
|
651 (when (or gnus-expert-user
|
|
30
|
652 (gnus-y-or-n-p
|
|
16
|
653 "Really send a nastygram to the author of the current article? "))
|
|
|
654 (let ((group gnus-newsgroup-name))
|
|
|
655 (gnus-summary-reply-with-original n)
|
|
|
656 (set-buffer gnus-message-buffer)
|
|
|
657 (message-goto-body)
|
|
|
658 (insert (format gnus-nastygram-message group))
|
|
|
659 (message-send-and-exit))))
|
|
|
660
|
|
|
661 (defun gnus-summary-mail-crosspost-complaint (n)
|
|
|
662 "Send a complaint about crossposting to the current article(s)."
|
|
|
663 (interactive "P")
|
|
|
664 (let ((articles (gnus-summary-work-articles n))
|
|
|
665 article)
|
|
|
666 (while (setq article (pop articles))
|
|
|
667 (set-buffer gnus-summary-buffer)
|
|
|
668 (gnus-summary-goto-subject article)
|
|
|
669 (let ((group (gnus-group-real-name gnus-newsgroup-name))
|
|
|
670 newsgroups followup-to)
|
|
|
671 (gnus-summary-select-article)
|
|
|
672 (set-buffer gnus-original-article-buffer)
|
|
|
673 (if (and (<= (length (message-tokenize-header
|
|
|
674 (setq newsgroups (mail-fetch-field "newsgroups"))
|
|
|
675 ", "))
|
|
|
676 1)
|
|
|
677 (or (not (setq followup-to (mail-fetch-field "followup-to")))
|
|
|
678 (not (member group (message-tokenize-header
|
|
|
679 followup-to ", ")))))
|
|
|
680 (if followup-to
|
|
|
681 (gnus-message 1 "Followup-to restricted")
|
|
|
682 (gnus-message 1 "Not a crossposted article"))
|
|
|
683 (set-buffer gnus-summary-buffer)
|
|
|
684 (gnus-summary-reply-with-original 1)
|
|
|
685 (set-buffer gnus-message-buffer)
|
|
|
686 (message-goto-body)
|
|
|
687 (insert (format gnus-crosspost-complaint newsgroups group))
|
|
|
688 (message-goto-subject)
|
|
|
689 (re-search-forward " *$")
|
|
|
690 (replace-match " (crosspost notification)" t t)
|
|
|
691 (when (gnus-y-or-n-p "Send this complaint? ")
|
|
|
692 (message-send-and-exit)))))))
|
|
0
|
693
|
|
|
694 (defun gnus-summary-mail-other-window ()
|
|
|
695 "Compose mail in other window."
|
|
|
696 (interactive)
|
|
|
697 (gnus-setup-message 'message
|
|
|
698 (message-mail)))
|
|
|
699
|
|
|
700 (defun gnus-mail-parse-comma-list ()
|
|
|
701 (let (accumulated
|
|
|
702 beg)
|
|
|
703 (skip-chars-forward " ")
|
|
|
704 (while (not (eobp))
|
|
|
705 (setq beg (point))
|
|
|
706 (skip-chars-forward "^,")
|
|
|
707 (while (zerop
|
|
30
|
708 (save-excursion
|
|
0
|
709 (save-restriction
|
|
|
710 (let ((i 0))
|
|
|
711 (narrow-to-region beg (point))
|
|
|
712 (goto-char beg)
|
|
|
713 (logand (progn
|
|
|
714 (while (search-forward "\"" nil t)
|
|
|
715 (incf i))
|
|
16
|
716 (if (zerop i) 2 i))
|
|
|
717 2)))))
|
|
0
|
718 (skip-chars-forward ",")
|
|
|
719 (skip-chars-forward "^,"))
|
|
|
720 (skip-chars-backward " ")
|
|
16
|
721 (push (buffer-substring beg (point))
|
|
|
722 accumulated)
|
|
0
|
723 (skip-chars-forward "^,")
|
|
|
724 (skip-chars-forward ", "))
|
|
|
725 accumulated))
|
|
|
726
|
|
|
727 (defun gnus-inews-add-to-address (group)
|
|
|
728 (let ((to-address (mail-fetch-field "to")))
|
|
|
729 (when (and to-address
|
|
|
730 (gnus-alive-p))
|
|
|
731 ;; This mail group doesn't have a `to-list', so we add one
|
|
30
|
732 ;; here. Magic!
|
|
0
|
733 (gnus-group-add-parameter group (cons 'to-list to-address)))))
|
|
|
734
|
|
|
735 (defun gnus-put-message ()
|
|
|
736 "Put the current message in some group and return to Gnus."
|
|
|
737 (interactive)
|
|
|
738 (let ((reply gnus-article-reply)
|
|
|
739 (winconf gnus-prev-winconf)
|
|
|
740 (group gnus-newsgroup-name))
|
|
30
|
741
|
|
0
|
742 (or (and group (not (gnus-group-read-only-p group)))
|
|
|
743 (setq group (read-string "Put in group: " nil
|
|
|
744 (gnus-writable-groups))))
|
|
16
|
745 (when (gnus-gethash group gnus-newsrc-hashtb)
|
|
|
746 (error "No such group: %s" group))
|
|
0
|
747
|
|
|
748 (save-excursion
|
|
|
749 (save-restriction
|
|
|
750 (widen)
|
|
|
751 (gnus-inews-narrow-to-headers)
|
|
|
752 (let (gnus-deletable-headers)
|
|
|
753 (if (message-news-p)
|
|
|
754 (message-generate-headers message-required-news-headers)
|
|
|
755 (message-generate-headers message-required-mail-headers)))
|
|
|
756 (goto-char (point-max))
|
|
|
757 (insert "Gcc: " group "\n")
|
|
|
758 (widen)))
|
|
|
759
|
|
|
760 (gnus-inews-do-gcc)
|
|
|
761
|
|
16
|
762 (when (get-buffer gnus-group-buffer)
|
|
|
763 (when (gnus-buffer-exists-p (car-safe reply))
|
|
|
764 (set-buffer (car reply))
|
|
|
765 (and (cdr reply)
|
|
30
|
766 (gnus-summary-mark-article-as-replied
|
|
16
|
767 (cdr reply))))
|
|
|
768 (when winconf
|
|
|
769 (set-window-configuration winconf)))))
|
|
0
|
770
|
|
|
771 (defun gnus-article-mail (yank)
|
|
|
772 "Send a reply to the address near point.
|
|
|
773 If YANK is non-nil, include the original article."
|
|
|
774 (interactive "P")
|
|
30
|
775 (let ((address
|
|
0
|
776 (buffer-substring
|
|
|
777 (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
|
|
|
778 (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
|
|
|
779 (when address
|
|
|
780 (message-reply address)
|
|
|
781 (when yank
|
|
2
|
782 (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
|
|
0
|
783
|
|
16
|
784 (defvar nntp-server-type)
|
|
0
|
785 (defun gnus-bug ()
|
|
|
786 "Send a bug report to the Gnus maintainers."
|
|
|
787 (interactive)
|
|
16
|
788 (unless (gnus-alive-p)
|
|
|
789 (error "Gnus has been shut down"))
|
|
0
|
790 (gnus-setup-message 'bug
|
|
|
791 (delete-other-windows)
|
|
|
792 (switch-to-buffer "*Gnus Help Bug*")
|
|
|
793 (erase-buffer)
|
|
|
794 (insert gnus-bug-message)
|
|
|
795 (goto-char (point-min))
|
|
|
796 (message-pop-to-buffer "*Gnus Bug*")
|
|
|
797 (message-setup `((To . ,gnus-maintainer) (Subject . "")))
|
|
|
798 (push `(gnus-bug-kill-buffer) message-send-actions)
|
|
|
799 (goto-char (point-min))
|
|
|
800 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
|
|
|
801 (forward-line 1)
|
|
|
802 (insert (gnus-version) "\n")
|
|
16
|
803 (insert (emacs-version) "\n")
|
|
|
804 (when (and (boundp 'nntp-server-type)
|
|
|
805 (stringp nntp-server-type))
|
|
|
806 (insert nntp-server-type))
|
|
0
|
807 (insert "\n\n\n\n\n")
|
|
|
808 (gnus-debug)
|
|
|
809 (goto-char (point-min))
|
|
|
810 (search-forward "Subject: " nil t)
|
|
|
811 (message "")))
|
|
|
812
|
|
|
813 (defun gnus-bug-kill-buffer ()
|
|
16
|
814 (when (get-buffer "*Gnus Help Bug*")
|
|
|
815 (kill-buffer "*Gnus Help Bug*")))
|
|
0
|
816
|
|
|
817 (defun gnus-debug ()
|
|
16
|
818 "Attempts to go through the Gnus source file and report what variables have been changed.
|
|
0
|
819 The source file has to be in the Emacs load path."
|
|
|
820 (interactive)
|
|
16
|
821 (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
|
|
|
822 "gnus-art.el" "gnus-start.el" "gnus-async.el"
|
|
|
823 "gnus-msg.el" "gnus-score.el" "gnus-win.el"
|
|
|
824 "nnmail.el" "message.el"))
|
|
|
825 file expr olist sym)
|
|
0
|
826 (gnus-message 4 "Please wait while we snoop your variables...")
|
|
|
827 (sit-for 0)
|
|
16
|
828 ;; Go through all the files looking for non-default values for variables.
|
|
0
|
829 (save-excursion
|
|
|
830 (set-buffer (get-buffer-create " *gnus bug info*"))
|
|
|
831 (buffer-disable-undo (current-buffer))
|
|
|
832 (while files
|
|
|
833 (erase-buffer)
|
|
16
|
834 (when (and (setq file (locate-library (pop files)))
|
|
|
835 (file-exists-p file))
|
|
|
836 (insert-file-contents file)
|
|
|
837 (goto-char (point-min))
|
|
|
838 (if (not (re-search-forward "^;;* *Internal variables" nil t))
|
|
|
839 (gnus-message 4 "Malformed sources in file %s" file)
|
|
|
840 (narrow-to-region (point-min) (point))
|
|
0
|
841 (goto-char (point-min))
|
|
16
|
842 (while (setq expr (ignore-errors (read (current-buffer))))
|
|
|
843 (ignore-errors
|
|
|
844 (and (or (eq (car expr) 'defvar)
|
|
|
845 (eq (car expr) 'defcustom))
|
|
|
846 (stringp (nth 3 expr))
|
|
|
847 (or (not (boundp (nth 1 expr)))
|
|
|
848 (not (equal (eval (nth 2 expr))
|
|
|
849 (symbol-value (nth 1 expr)))))
|
|
|
850 (push (nth 1 expr) olist)))))))
|
|
0
|
851 (kill-buffer (current-buffer)))
|
|
|
852 (when (setq olist (nreverse olist))
|
|
|
853 (insert "------------------ Environment follows ------------------\n\n"))
|
|
|
854 (while olist
|
|
|
855 (if (boundp (car olist))
|
|
|
856 (condition-case ()
|
|
|
857 (pp `(setq ,(car olist)
|
|
|
858 ,(if (or (consp (setq sym (symbol-value (car olist))))
|
|
|
859 (and (symbolp sym)
|
|
|
860 (not (or (eq sym nil)
|
|
|
861 (eq sym t)))))
|
|
|
862 (list 'quote (symbol-value (car olist)))
|
|
|
863 (symbol-value (car olist))))
|
|
|
864 (current-buffer))
|
|
|
865 (error
|
|
|
866 (format "(setq %s 'whatever)\n" (car olist))))
|
|
|
867 (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
|
|
|
868 (setq olist (cdr olist)))
|
|
|
869 (insert "\n\n")
|
|
|
870 ;; Remove any null chars - they seem to cause trouble for some
|
|
16
|
871 ;; mailers. (Byte-compiled output from the stuff above.)
|
|
0
|
872 (goto-char (point-min))
|
|
|
873 (while (re-search-forward "[\000\200]" nil t)
|
|
|
874 (replace-match "" t t))))
|
|
|
875
|
|
|
876 ;;; Treatment of rejected articles.
|
|
|
877 ;;; Bounced mail.
|
|
|
878
|
|
|
879 (defun gnus-summary-resend-bounced-mail (&optional fetch)
|
|
|
880 "Re-mail the current message.
|
|
|
881 This only makes sense if the current message is a bounce message than
|
|
|
882 contains some mail you have written which has been bounced back to
|
|
|
883 you.
|
|
|
884 If FETCH, try to fetch the article that this is a reply to, if indeed
|
|
|
885 this is a reply."
|
|
|
886 (interactive "P")
|
|
|
887 (gnus-summary-select-article t)
|
|
|
888 (set-buffer gnus-original-article-buffer)
|
|
|
889 (gnus-setup-message 'compose-bounce
|
|
|
890 (let* ((references (mail-fetch-field "references"))
|
|
|
891 (parent (and references (gnus-parent-id references))))
|
|
|
892 (message-bounce)
|
|
30
|
893 ;; If there are references, we fetch the article we answered to.
|
|
0
|
894 (and fetch parent
|
|
|
895 (gnus-summary-refer-article parent)
|
|
|
896 (gnus-summary-show-all-headers)))))
|
|
|
897
|
|
|
898 ;;; Gcc handling.
|
|
|
899
|
|
30
|
900 ;; Do Gcc handling, which copied the message over to some group.
|
|
0
|
901 (defun gnus-inews-do-gcc (&optional gcc)
|
|
30
|
902 (interactive)
|
|
0
|
903 (when (gnus-alive-p)
|
|
|
904 (save-excursion
|
|
|
905 (save-restriction
|
|
|
906 (message-narrow-to-headers)
|
|
|
907 (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
|
|
|
908 (cur (current-buffer))
|
|
|
909 groups group method)
|
|
|
910 (when gcc
|
|
|
911 (message-remove-header "gcc")
|
|
|
912 (widen)
|
|
|
913 (setq groups (message-tokenize-header gcc " ,"))
|
|
|
914 ;; Copy the article over to some group(s).
|
|
|
915 (while (setq group (pop groups))
|
|
30
|
916 (gnus-check-server
|
|
0
|
917 (setq method
|
|
|
918 (cond ((and (null (gnus-get-info group))
|
|
|
919 (eq (car gnus-message-archive-method)
|
|
30
|
920 (car
|
|
0
|
921 (gnus-server-to-method
|
|
|
922 (gnus-group-method group)))))
|
|
|
923 ;; If the group doesn't exist, we assume
|
|
|
924 ;; it's an archive group...
|
|
|
925 gnus-message-archive-method)
|
|
|
926 ;; Use the method.
|
|
|
927 ((gnus-info-method (gnus-get-info group))
|
|
|
928 (gnus-info-method (gnus-get-info group)))
|
|
|
929 ;; Find the method.
|
|
|
930 (t (gnus-group-method group)))))
|
|
|
931 (gnus-check-server method)
|
|
|
932 (unless (gnus-request-group group t method)
|
|
|
933 (gnus-request-create-group group method))
|
|
|
934 (save-excursion
|
|
|
935 (nnheader-set-temp-buffer " *acc*")
|
|
|
936 (insert-buffer-substring cur)
|
|
|
937 (goto-char (point-min))
|
|
30
|
938 (when (re-search-forward
|
|
0
|
939 (concat "^" (regexp-quote mail-header-separator) "$")
|
|
|
940 nil t)
|
|
|
941 (replace-match "" t t ))
|
|
|
942 (unless (gnus-request-accept-article group method t)
|
|
30
|
943 (gnus-message 1 "Couldn't store article in group %s: %s"
|
|
0
|
944 group (gnus-status-message method))
|
|
|
945 (sit-for 2))
|
|
|
946 (kill-buffer (current-buffer))))))))))
|
|
|
947
|
|
|
948 (defun gnus-inews-insert-gcc ()
|
|
|
949 "Insert Gcc headers based on `gnus-outgoing-message-group'."
|
|
|
950 (save-excursion
|
|
|
951 (save-restriction
|
|
|
952 (gnus-inews-narrow-to-headers)
|
|
|
953 (let* ((group gnus-outgoing-message-group)
|
|
30
|
954 (gcc (cond
|
|
0
|
955 ((gnus-functionp group)
|
|
|
956 (funcall group))
|
|
|
957 ((or (stringp group) (list group))
|
|
|
958 group))))
|
|
|
959 (when gcc
|
|
|
960 (insert "Gcc: "
|
|
|
961 (if (stringp gcc) gcc
|
|
|
962 (mapconcat 'identity gcc " "))
|
|
|
963 "\n"))))))
|
|
|
964
|
|
|
965 (defun gnus-inews-insert-archive-gcc (&optional group)
|
|
|
966 "Insert the Gcc to say where the article is to be archived."
|
|
|
967 (let* ((var gnus-message-archive-group)
|
|
|
968 (group (or group gnus-newsgroup-name ""))
|
|
|
969 result
|
|
16
|
970 gcc-self-val
|
|
0
|
971 (groups
|
|
30
|
972 (cond
|
|
0
|
973 ((null gnus-message-archive-method)
|
|
|
974 ;; Ignore.
|
|
|
975 nil)
|
|
|
976 ((stringp var)
|
|
|
977 ;; Just a single group.
|
|
|
978 (list var))
|
|
|
979 ((null var)
|
|
|
980 ;; We don't want this.
|
|
|
981 nil)
|
|
|
982 ((and (listp var) (stringp (car var)))
|
|
|
983 ;; A list of groups.
|
|
|
984 var)
|
|
|
985 ((gnus-functionp var)
|
|
|
986 ;; A function.
|
|
|
987 (funcall var group))
|
|
|
988 (t
|
|
|
989 ;; An alist of regexps/functions/forms.
|
|
|
990 (while (and var
|
|
|
991 (not
|
|
|
992 (setq result
|
|
30
|
993 (cond
|
|
0
|
994 ((stringp (caar var))
|
|
|
995 ;; Regexp.
|
|
|
996 (when (string-match (caar var) group)
|
|
|
997 (cdar var)))
|
|
|
998 ((gnus-functionp (car var))
|
|
|
999 ;; Function.
|
|
|
1000 (funcall (car var) group))
|
|
|
1001 (t
|
|
|
1002 (eval (car var)))))))
|
|
|
1003 (setq var (cdr var)))
|
|
|
1004 result)))
|
|
|
1005 name)
|
|
|
1006 (when groups
|
|
|
1007 (when (stringp groups)
|
|
|
1008 (setq groups (list groups)))
|
|
|
1009 (save-excursion
|
|
|
1010 (save-restriction
|
|
|
1011 (gnus-inews-narrow-to-headers)
|
|
|
1012 (goto-char (point-max))
|
|
|
1013 (insert "Gcc: ")
|
|
16
|
1014 (if (and gnus-newsgroup-name
|
|
|
1015 (setq gcc-self-val
|
|
|
1016 (gnus-group-find-parameter
|
|
|
1017 gnus-newsgroup-name 'gcc-self)))
|
|
30
|
1018 (progn
|
|
16
|
1019 (insert
|
|
|
1020 (if (stringp gcc-self-val)
|
|
|
1021 gcc-self-val
|
|
|
1022 group))
|
|
|
1023 (if (not (eq gcc-self-val 'none))
|
|
|
1024 (insert "\n")
|
|
|
1025 (progn
|
|
|
1026 (beginning-of-line)
|
|
|
1027 (kill-line))))
|
|
|
1028 (while (setq name (pop groups))
|
|
|
1029 (insert (if (string-match ":" name)
|
|
|
1030 name
|
|
30
|
1031 (gnus-group-prefixed-name
|
|
16
|
1032 name gnus-message-archive-method)))
|
|
|
1033 (when groups
|
|
|
1034 (insert " ")))
|
|
|
1035 (insert "\n")))))))
|
|
0
|
1036
|
|
|
1037 (defun gnus-summary-send-draft ()
|
|
|
1038 "Enter a mail/post buffer to edit and send the draft."
|
|
|
1039 (interactive)
|
|
|
1040 (gnus-set-global-variables)
|
|
|
1041 (let (buf)
|
|
30
|
1042 (if (not (setq buf (gnus-request-restore-buffer
|
|
0
|
1043 (gnus-summary-article-number) gnus-newsgroup-name)))
|
|
|
1044 (error "Couldn't restore the article")
|
|
|
1045 (switch-to-buffer buf)
|
|
|
1046 (when (eq major-mode 'news-reply-mode)
|
|
|
1047 (local-set-key "\C-c\C-c" 'gnus-inews-news))
|
|
|
1048 ;; Insert the separator.
|
|
|
1049 (goto-char (point-min))
|
|
|
1050 (search-forward "\n\n")
|
|
|
1051 (forward-char -1)
|
|
|
1052 (insert mail-header-separator)
|
|
|
1053 ;; Configure windows.
|
|
|
1054 (let ((gnus-draft-buffer (current-buffer)))
|
|
|
1055 (gnus-configure-windows 'draft t)
|
|
|
1056 (goto-char (point))))))
|
|
30
|
1057
|
|
0
|
1058 (gnus-add-shutdown 'gnus-inews-close 'gnus)
|
|
|
1059
|
|
|
1060 (defun gnus-inews-close ()
|
|
|
1061 (setq gnus-inews-sent-ids nil))
|
|
30
|
1062
|
|
0
|
1063 ;;; Allow redefinition of functions.
|
|
|
1064
|
|
|
1065 (gnus-ems-redefine)
|
|
|
1066
|
|
|
1067 (provide 'gnus-msg)
|
|
|
1068
|
|
|
1069 ;;; gnus-msg.el ends here
|
