Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-msg.el @ 70:131b0175ea99 r20-0b30

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