1 |
;;; gnus-msg.el --- mail and post interface for Gnus |
;;; gnus-msg.el --- mail and post interface for Gnus |
2 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 |
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
3 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
33 |
(require 'gnus-ems) |
(require 'gnus-ems) |
34 |
(require 'message) |
(require 'message) |
35 |
(require 'gnus-art) |
(require 'gnus-art) |
36 |
|
(require 'gnus-util) |
37 |
|
|
38 |
(defcustom gnus-post-method 'current |
(defcustom gnus-post-method 'current |
39 |
"*Preferred method for posting USENET news. |
"*Preferred method for posting USENET news. |
55 |
(const current) |
(const current) |
56 |
(sexp :tag "Methods" ,gnus-select-method))) |
(sexp :tag "Methods" ,gnus-select-method))) |
57 |
|
|
58 |
(defvar gnus-outgoing-message-group nil |
(defcustom gnus-outgoing-message-group nil |
59 |
"*All outgoing messages will be put in this group. |
"*All outgoing messages will be put in this group. |
60 |
If you want to store all your outgoing mail and articles in the group |
If you want to store all your outgoing mail and articles in the group |
61 |
\"nnml:archive\", you set this variable to that value. This variable |
\"nnml:archive\", you set this variable to that value. This variable |
64 |
If you want to have greater control over what group to put each |
If you want to have greater control over what group to put each |
65 |
message in, you can set this variable to a function that checks the |
message in, you can set this variable to a function that checks the |
66 |
current newsgroup name and then returns a suitable group name (or list |
current newsgroup name and then returns a suitable group name (or list |
67 |
of names).") |
of names)." |
68 |
|
:group 'gnus-message |
69 |
|
:type '(choice (string :tag "Group") |
70 |
|
(function))) |
71 |
|
|
72 |
(defvar gnus-mailing-list-groups nil |
(defcustom gnus-mailing-list-groups nil |
73 |
"*Regexp matching groups that are really mailing lists. |
"*If non-nil a regexp matching groups that are really mailing lists. |
74 |
This is useful when you're reading a mailing list that has been |
This is useful when you're reading a mailing list that has been |
75 |
gatewayed to a newsgroup, and you want to followup to an article in |
gatewayed to a newsgroup, and you want to followup to an article in |
76 |
the group.") |
the group." |
77 |
|
:group 'gnus-message |
78 |
|
:type '(choice (regexp) |
79 |
|
(const nil))) |
80 |
|
|
81 |
|
(defcustom gnus-add-to-list nil |
82 |
|
"*If non-nil, add a `to-list' parameter automatically." |
83 |
|
:group 'gnus-message |
84 |
|
:type 'boolean) |
85 |
|
|
86 |
(defvar gnus-add-to-list nil |
(defcustom gnus-crosspost-complaint |
|
"*If non-nil, add a `to-list' parameter automatically.") |
|
|
|
|
|
(defvar gnus-crosspost-complaint |
|
87 |
"Hi, |
"Hi, |
88 |
|
|
89 |
You posted the article below with the following Newsgroups header: |
You posted the article below with the following Newsgroups header: |
99 |
" |
" |
100 |
"Format string to be inserted when complaining about crossposts. |
"Format string to be inserted when complaining about crossposts. |
101 |
The first %s will be replaced by the Newsgroups header; |
The first %s will be replaced by the Newsgroups header; |
102 |
the second with the current group name.") |
the second with the current group name." |
103 |
|
:group 'gnus-message |
104 |
(defvar gnus-message-setup-hook nil |
:type 'string) |
105 |
"Hook run after setting up a message buffer.") |
|
106 |
|
(defcustom gnus-message-setup-hook nil |
107 |
(defvar gnus-bug-create-help-buffer t |
"Hook run after setting up a message buffer." |
108 |
"*Should we create the *Gnus Help Bug* buffer?") |
:group 'gnus-message |
109 |
|
:type 'hook) |
110 |
(defvar gnus-posting-styles nil |
|
111 |
"*Alist of styles to use when posting.") |
(defcustom gnus-bug-create-help-buffer t |
112 |
|
"*Should we create the *Gnus Help Bug* buffer?" |
113 |
(defcustom gnus-group-posting-charset-alist |
:group 'gnus-message |
114 |
|
:type 'boolean) |
115 |
|
|
116 |
|
(defcustom gnus-posting-styles nil |
117 |
|
"*Alist of styles to use when posting. |
118 |
|
See Info node `(gnus)Posting Styles'." |
119 |
|
:group 'gnus-message |
120 |
|
:link '(custom-manual "(gnus)Posting Styles") |
121 |
|
:type '(repeat (cons (choice (regexp) |
122 |
|
(variable) |
123 |
|
(list (const header) |
124 |
|
(string :tag "Header") |
125 |
|
(regexp :tag "Regexp")) |
126 |
|
(function) |
127 |
|
(sexp)) |
128 |
|
(repeat (list |
129 |
|
(choice (const signature) |
130 |
|
(const signature-file) |
131 |
|
(const organization) |
132 |
|
(const address) |
133 |
|
(const x-face-file) |
134 |
|
(const name) |
135 |
|
(const body) |
136 |
|
(symbol) |
137 |
|
(string :tag "Header")) |
138 |
|
(choice (string) |
139 |
|
(function) |
140 |
|
(variable) |
141 |
|
(sexp))))))) |
142 |
|
|
143 |
|
(defcustom gnus-gcc-mark-as-read nil |
144 |
|
"If non-nil, automatically mark Gcc articles as read." |
145 |
|
:version "21.1" |
146 |
|
:group 'gnus-message |
147 |
|
:type 'boolean) |
148 |
|
|
149 |
|
(make-obsolete-variable 'gnus-inews-mark-gcc-as-read |
150 |
|
'gnus-gcc-mark-as-read) |
151 |
|
|
152 |
|
(defcustom gnus-gcc-externalize-attachments nil |
153 |
|
"Should local-file attachments be included as external parts in Gcc copies? |
154 |
|
If it is `all', attach files as external parts; |
155 |
|
if a regexp and matches the Gcc group name, attach files as external parts; |
156 |
|
if nil, attach files as normal parts." |
157 |
|
:version "21.1" |
158 |
|
:group 'gnus-message |
159 |
|
:type '(choice (const nil :tag "None") |
160 |
|
(const all :tag "Any") |
161 |
|
(string :tag "Regexp"))) |
162 |
|
|
163 |
|
(gnus-define-group-parameter |
164 |
|
posting-charset-alist |
165 |
|
:type list |
166 |
|
:function-document |
167 |
|
"Return the permitted unencoded charsets for posting of GROUP." |
168 |
|
:variable gnus-group-posting-charset-alist |
169 |
|
:variable-default |
170 |
'(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1)) |
'(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1)) |
171 |
("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r)) |
("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r)) |
172 |
(message-this-is-mail nil nil) |
(message-this-is-mail nil nil) |
173 |
(message-this-is-news nil t)) |
(message-this-is-news nil t)) |
174 |
|
:variable-document |
175 |
"Alist of regexps and permitted unencoded charsets for posting. |
"Alist of regexps and permitted unencoded charsets for posting. |
176 |
Each element of the alist has the form (TEST HEADER BODY-LIST), where |
Each element of the alist has the form (TEST HEADER BODY-LIST), where |
177 |
TEST is either a regular expression matching the newsgroup header or a |
TEST is either a regular expression matching the newsgroup header or a |
184 |
|
|
185 |
Note that any value other than nil for HEADER infringes some RFCs, so |
Note that any value other than nil for HEADER infringes some RFCs, so |
186 |
use this option with care." |
use this option with care." |
187 |
:type '(repeat (list :tag "Permitted unencoded charsets" |
:variable-group gnus-charset |
188 |
(choice :tag "Where" |
:variable-type |
189 |
(regexp :tag "Group") |
'(repeat (list :tag "Permitted unencoded charsets" |
190 |
(const :tag "Mail message" :value message-this-is-mail) |
(choice :tag "Where" |
191 |
(const :tag "News article" :value message-this-is-news)) |
(regexp :tag "Group") |
192 |
(choice :tag "Header" |
(const :tag "Mail message" :value message-this-is-mail) |
193 |
(const :tag "None" nil) |
(const :tag "News article" :value message-this-is-news)) |
194 |
(symbol :tag "Charset")) |
(choice :tag "Header" |
195 |
(choice :tag "Body" |
(const :tag "None" nil) |
196 |
(const :tag "Any" :value t) |
(symbol :tag "Charset")) |
197 |
(const :tag "None" :value nil) |
(choice :tag "Body" |
198 |
(repeat :tag "Charsets" |
(const :tag "Any" :value t) |
199 |
(symbol :tag "Charset"))))) |
(const :tag "None" :value nil) |
200 |
:group 'gnus-charset) |
(repeat :tag "Charsets" |
201 |
|
(symbol :tag "Charset"))))) |
202 |
|
:parameter-type '(choice :tag "Permitted unencoded charsets" |
203 |
|
:value nil |
204 |
|
(repeat (symbol))) |
205 |
|
:parameter-document "\ |
206 |
|
List of charsets that are permitted to be unencoded.") |
207 |
|
|
208 |
|
(defcustom gnus-debug-files |
209 |
|
'("gnus.el" "gnus-sum.el" "gnus-group.el" |
210 |
|
"gnus-art.el" "gnus-start.el" "gnus-async.el" |
211 |
|
"gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el" |
212 |
|
"gnus-agent.el" "gnus-cache.el" "gnus-srvr.el" |
213 |
|
"mm-util.el" "mm-decode.el" "nnmail.el" "message.el") |
214 |
|
"Files whose variables will be reported in `gnus-bug'." |
215 |
|
:version "21.1" |
216 |
|
:group 'gnus-message |
217 |
|
:type '(repeat (string :tag "File"))) |
218 |
|
|
219 |
|
(defcustom gnus-debug-exclude-variables |
220 |
|
'(mm-mime-mule-charset-alist |
221 |
|
nnmail-split-fancy message-minibuffer-local-map) |
222 |
|
"Variables that should not be reported in `gnus-bug'." |
223 |
|
:version "21.1" |
224 |
|
:group 'gnus-message |
225 |
|
:type '(repeat (symbol :tag "Variable"))) |
226 |
|
|
227 |
|
(defcustom gnus-discouraged-post-methods |
228 |
|
'(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir) |
229 |
|
"A list of back ends that are not used in \"real\" newsgroups. |
230 |
|
This variable is used only when `gnus-post-method' is `current'." |
231 |
|
:version "21.3" |
232 |
|
:group 'gnus-group-foreign |
233 |
|
:type '(repeat (symbol :tag "Back end"))) |
234 |
|
|
235 |
|
(defcustom gnus-message-replysign |
236 |
|
nil |
237 |
|
"Automatically sign replies to signed messages. |
238 |
|
See also the `mml-default-sign-method' variable." |
239 |
|
:group 'gnus-message |
240 |
|
:type 'boolean) |
241 |
|
|
242 |
|
(defcustom gnus-message-replyencrypt |
243 |
|
nil |
244 |
|
"Automatically encrypt replies to encrypted messages. |
245 |
|
See also the `mml-default-encrypt-method' variable." |
246 |
|
:group 'gnus-message |
247 |
|
:type 'boolean) |
248 |
|
|
249 |
|
(defcustom gnus-message-replysignencrypted |
250 |
|
t |
251 |
|
"Setting this causes automatically encrypted messages to also be signed." |
252 |
|
:group 'gnus-message |
253 |
|
:type 'boolean) |
254 |
|
|
255 |
|
(defcustom gnus-confirm-mail-reply-to-news nil |
256 |
|
"If non-nil, Gnus requests confirmation when replying to news. |
257 |
|
This is done because new users often reply by mistake when reading |
258 |
|
news. |
259 |
|
This can also be a function receiving the group name as the only |
260 |
|
parameter which should return non-nil iff a confirmation is needed, or |
261 |
|
a regexp, in which case a confirmation is asked for iff the group name |
262 |
|
matches the regexp." |
263 |
|
:group 'gnus-message |
264 |
|
:type '(choice (const :tag "No" nil) |
265 |
|
(const :tag "Yes" t) |
266 |
|
(regexp :tag "Iff group matches regexp") |
267 |
|
(function :tag "Iff function evaluates to non-nil"))) |
268 |
|
|
269 |
|
(defcustom gnus-confirm-treat-mail-like-news |
270 |
|
nil |
271 |
|
"If non-nil, Gnus will treat mail like news with regard to confirmation |
272 |
|
when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable |
273 |
|
for fine-tuning this. |
274 |
|
If nil, Gnus will never ask for confirmation if replying to mail." |
275 |
|
:group 'gnus-message |
276 |
|
:type 'boolean) |
277 |
|
|
278 |
|
(defcustom gnus-summary-resend-default-address t |
279 |
|
"If non-nil, Gnus tries to suggest a default address to resend to. |
280 |
|
If nil, the address field will always be empty after invoking |
281 |
|
`gnus-summary-resend-message'." |
282 |
|
:group 'gnus-message |
283 |
|
:type 'boolean) |
284 |
|
|
285 |
;;; Internal variables. |
;;; Internal variables. |
286 |
|
|
287 |
(defvar gnus-inhibit-posting-styles nil |
(defvar gnus-inhibit-posting-styles nil |
288 |
"Inhibit the use of posting styles.") |
"Inhibit the use of posting styles.") |
289 |
|
|
290 |
|
(defvar gnus-article-yanked-articles nil) |
291 |
(defvar gnus-message-buffer "*Mail Gnus*") |
(defvar gnus-message-buffer "*Mail Gnus*") |
292 |
(defvar gnus-article-copy nil) |
(defvar gnus-article-copy nil) |
293 |
|
(defvar gnus-check-before-posting nil) |
294 |
(defvar gnus-last-posting-server nil) |
(defvar gnus-last-posting-server nil) |
295 |
(defvar gnus-message-group-art nil) |
(defvar gnus-message-group-art nil) |
296 |
|
|
297 |
|
(defvar gnus-msg-force-broken-reply-to nil) |
298 |
|
|
299 |
(defconst gnus-bug-message |
(defconst gnus-bug-message |
300 |
"Sending a bug report to the Gnus Towers. |
"Sending a bug report to the Gnus Towers. |
301 |
======================================== |
======================================== |
319 |
|
|
320 |
(eval-and-compile |
(eval-and-compile |
321 |
(autoload 'gnus-uu-post-news "gnus-uu" nil t) |
(autoload 'gnus-uu-post-news "gnus-uu" nil t) |
322 |
|
(autoload 'news-setup "rnewspost") |
323 |
|
(autoload 'news-reply-mode "rnewspost") |
324 |
(autoload 'rmail-dont-reply-to "mail-utils") |
(autoload 'rmail-dont-reply-to "mail-utils") |
325 |
(autoload 'rmail-output "rmailout")) |
(autoload 'rmail-output "rmailout")) |
326 |
|
|
331 |
|
|
332 |
(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map) |
(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map) |
333 |
"p" gnus-summary-post-news |
"p" gnus-summary-post-news |
334 |
|
"i" gnus-summary-news-other-window |
335 |
"f" gnus-summary-followup |
"f" gnus-summary-followup |
336 |
"F" gnus-summary-followup-with-original |
"F" gnus-summary-followup-with-original |
337 |
"c" gnus-summary-cancel-article |
"c" gnus-summary-cancel-article |
341 |
"R" gnus-summary-reply-with-original |
"R" gnus-summary-reply-with-original |
342 |
"w" gnus-summary-wide-reply |
"w" gnus-summary-wide-reply |
343 |
"W" gnus-summary-wide-reply-with-original |
"W" gnus-summary-wide-reply-with-original |
344 |
|
"v" gnus-summary-very-wide-reply |
345 |
|
"V" gnus-summary-very-wide-reply-with-original |
346 |
"n" gnus-summary-followup-to-mail |
"n" gnus-summary-followup-to-mail |
347 |
"N" gnus-summary-followup-to-mail-with-original |
"N" gnus-summary-followup-to-mail-with-original |
348 |
"m" gnus-summary-mail-other-window |
"m" gnus-summary-mail-other-window |
349 |
"u" gnus-uu-post-news |
"u" gnus-uu-post-news |
350 |
"\M-c" gnus-summary-mail-crosspost-complaint |
"\M-c" gnus-summary-mail-crosspost-complaint |
351 |
|
"Br" gnus-summary-reply-broken-reply-to |
352 |
|
"BR" gnus-summary-reply-broken-reply-to-with-original |
353 |
"om" gnus-summary-mail-forward |
"om" gnus-summary-mail-forward |
354 |
"op" gnus-summary-post-forward |
"op" gnus-summary-post-forward |
355 |
"Om" gnus-uu-digest-mail-forward |
"Om" gnus-uu-digest-mail-forward |
358 |
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) |
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) |
359 |
"b" gnus-summary-resend-bounced-mail |
"b" gnus-summary-resend-bounced-mail |
360 |
;; "c" gnus-summary-send-draft |
;; "c" gnus-summary-send-draft |
361 |
"r" gnus-summary-resend-message) |
"r" gnus-summary-resend-message |
362 |
|
"e" gnus-summary-resend-message-edit) |
363 |
|
|
364 |
;;; Internal functions. |
;;; Internal functions. |
365 |
|
|
366 |
|
(defun gnus-inews-make-draft () |
367 |
|
`(lambda () |
368 |
|
(gnus-inews-make-draft-meta-information |
369 |
|
,gnus-newsgroup-name ',gnus-article-reply))) |
370 |
|
|
371 |
(defvar gnus-article-reply nil) |
(defvar gnus-article-reply nil) |
372 |
(defmacro gnus-setup-message (config &rest forms) |
(defmacro gnus-setup-message (config &rest forms) |
373 |
(let ((winconf (make-symbol "gnus-setup-message-winconf")) |
(let ((winconf (make-symbol "gnus-setup-message-winconf")) |
374 |
(buffer (make-symbol "gnus-setup-message-buffer")) |
(buffer (make-symbol "gnus-setup-message-buffer")) |
375 |
(article (make-symbol "gnus-setup-message-article")) |
(article (make-symbol "gnus-setup-message-article")) |
376 |
|
(yanked (make-symbol "gnus-setup-yanked-articles")) |
377 |
(group (make-symbol "gnus-setup-message-group"))) |
(group (make-symbol "gnus-setup-message-group"))) |
378 |
`(let ((,winconf (current-window-configuration)) |
`(let ((,winconf (current-window-configuration)) |
379 |
(,buffer (buffer-name (current-buffer))) |
(,buffer (buffer-name (current-buffer))) |
380 |
(,article (and gnus-article-reply (gnus-summary-article-number))) |
(,article gnus-article-reply) |
381 |
|
(,yanked gnus-article-yanked-articles) |
382 |
(,group gnus-newsgroup-name) |
(,group gnus-newsgroup-name) |
383 |
(message-header-setup-hook |
(message-header-setup-hook |
384 |
(copy-sequence message-header-setup-hook)) |
(copy-sequence message-header-setup-hook)) |
387 |
(setq mml-buffer-list nil) |
(setq mml-buffer-list nil) |
388 |
(add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) |
(add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) |
389 |
(add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) |
(add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) |
390 |
(add-hook 'message-mode-hook 'gnus-configure-posting-styles) |
;; #### FIXME: for a reason that I did not manage to identify yet, |
391 |
|
;; the variable `gnus-newsgroup-name' does not honor a dynamically |
392 |
|
;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'. |
393 |
|
;; After evaluation of @forms below, it gets the value we actually want |
394 |
|
;; to override, and the posting styles are used. For that reason, I've |
395 |
|
;; added an optional argument to `gnus-configure-posting-styles' to |
396 |
|
;; make sure that the correct value for the group name is used. -- drv |
397 |
|
(add-hook 'message-mode-hook |
398 |
|
(lambda () |
399 |
|
(gnus-configure-posting-styles ,group))) |
400 |
|
(gnus-pull ',(intern gnus-draft-meta-information-header) |
401 |
|
message-required-headers) |
402 |
|
(when (and ,group |
403 |
|
(not (string= ,group ""))) |
404 |
|
(push (cons |
405 |
|
(intern gnus-draft-meta-information-header) |
406 |
|
(gnus-inews-make-draft)) |
407 |
|
message-required-headers)) |
408 |
(unwind-protect |
(unwind-protect |
409 |
(progn |
(progn |
410 |
,@forms) |
,@forms) |
411 |
(gnus-inews-add-send-actions ,winconf ,buffer ,article) |
(gnus-inews-add-send-actions ,winconf ,buffer ,article ,config |
412 |
|
,yanked) |
413 |
(setq gnus-message-buffer (current-buffer)) |
(setq gnus-message-buffer (current-buffer)) |
414 |
(set (make-local-variable 'gnus-message-group-art) |
(set (make-local-variable 'gnus-message-group-art) |
415 |
(cons ,group ,article)) |
(cons ,group ,article)) |
419 |
(let ((mbl1 mml-buffer-list)) |
(let ((mbl1 mml-buffer-list)) |
420 |
(setq mml-buffer-list mbl) ;; Global value |
(setq mml-buffer-list mbl) ;; Global value |
421 |
(set (make-local-variable 'mml-buffer-list) mbl1);; Local value |
(set (make-local-variable 'mml-buffer-list) mbl1);; Local value |
422 |
|
(gnus-make-local-hook 'kill-buffer-hook) |
423 |
|
(gnus-make-local-hook 'change-major-mode-hook) |
424 |
(add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t) |
(add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t) |
425 |
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)) |
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)) |
426 |
(mml-destroy-buffers) |
(mml-destroy-buffers) |
427 |
(setq mml-buffer-list mbl))) |
(setq mml-buffer-list mbl))) |
428 |
|
(message-hide-headers) |
429 |
(gnus-add-buffer) |
(gnus-add-buffer) |
430 |
(gnus-configure-windows ,config t) |
(gnus-configure-windows ,config t) |
431 |
|
(run-hooks 'post-command-hook) |
432 |
(set-buffer-modified-p nil)))) |
(set-buffer-modified-p nil)))) |
433 |
|
|
434 |
|
(defun gnus-inews-make-draft-meta-information (group article) |
435 |
|
(concat "(\"" group "\" " |
436 |
|
(if article (number-to-string |
437 |
|
(if (listp article) |
438 |
|
(car article) |
439 |
|
article)) "\"\"") |
440 |
|
")")) |
441 |
|
|
442 |
;;;###autoload |
;;;###autoload |
443 |
(defun gnus-msg-mail (&rest args) |
(defun gnus-msg-mail (&optional to subject other-headers continue |
444 |
|
switch-action yank-action send-actions) |
445 |
"Start editing a mail message to be sent. |
"Start editing a mail message to be sent. |
446 |
Like `message-mail', but with Gnus paraphernalia, particularly the |
Like `message-mail', but with Gnus paraphernalia, particularly the |
447 |
Gcc: header for archiving purposes." |
Gcc: header for archiving purposes." |
448 |
(interactive) |
(interactive) |
449 |
(gnus-setup-message 'message |
(let ((buf (current-buffer)) |
450 |
(apply 'message-mail args)) |
mail-buf) |
451 |
|
(gnus-setup-message 'message |
452 |
|
(message-mail to subject other-headers continue |
453 |
|
nil yank-action send-actions)) |
454 |
|
(when switch-action |
455 |
|
(setq mail-buf (current-buffer)) |
456 |
|
(switch-to-buffer buf) |
457 |
|
(apply switch-action mail-buf nil))) |
458 |
;; COMPOSEFUNC should return t if succeed. Undocumented ??? |
;; COMPOSEFUNC should return t if succeed. Undocumented ??? |
459 |
t) |
t) |
460 |
|
|
461 |
|
(defvar save-selected-window-window) |
462 |
|
|
463 |
|
;;;###autoload |
464 |
|
(defun gnus-button-mailto (address) |
465 |
|
"Mail to ADDRESS." |
466 |
|
(set-buffer (gnus-copy-article-buffer)) |
467 |
|
(gnus-setup-message 'message |
468 |
|
(message-reply address)) |
469 |
|
(and (boundp 'save-selected-window-window) |
470 |
|
(not (window-live-p save-selected-window-window)) |
471 |
|
(setq save-selected-window-window (selected-window)))) |
472 |
|
|
473 |
|
;;;###autoload |
474 |
|
(defun gnus-button-reply (&optional to-address wide) |
475 |
|
"Like `message-reply'." |
476 |
|
(interactive) |
477 |
|
(gnus-setup-message 'message |
478 |
|
(message-reply to-address wide)) |
479 |
|
(and (boundp 'save-selected-window-window) |
480 |
|
(not (window-live-p save-selected-window-window)) |
481 |
|
(setq save-selected-window-window (selected-window)))) |
482 |
|
|
483 |
;;;###autoload |
;;;###autoload |
484 |
(define-mail-user-agent 'gnus-user-agent |
(define-mail-user-agent 'gnus-user-agent |
485 |
'gnus-msg-mail 'message-send-and-exit |
'gnus-msg-mail 'message-send-and-exit |
486 |
'message-kill-buffer 'message-send-hook) |
'message-kill-buffer 'message-send-hook) |
487 |
|
|
488 |
(defun gnus-setup-posting-charset (group) |
(defun gnus-setup-posting-charset (group) |
489 |
(let ((alist gnus-group-posting-charset-alist) |
(let ((alist gnus-group-posting-charset-alist) |
494 |
(while (setq elem (pop alist)) |
(while (setq elem (pop alist)) |
495 |
(when (or (and (stringp (car elem)) |
(when (or (and (stringp (car elem)) |
496 |
(string-match (car elem) group)) |
(string-match (car elem) group)) |
497 |
(and (gnus-functionp (car elem)) |
(and (functionp (car elem)) |
498 |
(funcall (car elem) group)) |
(funcall (car elem) group)) |
499 |
(and (symbolp (car elem)) |
(and (symbolp (car elem)) |
500 |
(symbol-value (car elem)))) |
(symbol-value (car elem)))) |
501 |
(throw 'found (cons (cadr elem) (caddr elem))))))))) |
(throw 'found (cons (cadr elem) (caddr elem))))))))) |
502 |
|
|
503 |
(defun gnus-inews-add-send-actions (winconf buffer article) |
(defun gnus-inews-add-send-actions (winconf buffer article |
504 |
(make-local-hook 'message-sent-hook) |
&optional config yanked) |
505 |
|
(gnus-make-local-hook 'message-sent-hook) |
506 |
(add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc |
(add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc |
507 |
'gnus-inews-do-gcc) nil t) |
'gnus-inews-do-gcc) nil t) |
508 |
(when gnus-agent |
(when gnus-agent |
509 |
(make-local-hook 'message-header-hook) |
(gnus-make-local-hook 'message-header-hook) |
510 |
(add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) |
(add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) |
511 |
(setq message-post-method |
(setq message-post-method |
512 |
`(lambda (arg) |
`(lambda (arg) |
513 |
(gnus-post-method arg ,gnus-newsgroup-name))) |
(gnus-post-method arg ,gnus-newsgroup-name))) |
514 |
(setq message-newsreader (setq message-mailer (gnus-extended-version))) |
(setq message-newsreader (setq message-mailer (gnus-extended-version))) |
515 |
(message-add-action |
(message-add-action |
|
`(set-window-configuration ,winconf) 'exit 'postpone 'kill) |
|
|
(message-add-action |
|
516 |
`(when (gnus-buffer-exists-p ,buffer) |
`(when (gnus-buffer-exists-p ,buffer) |
517 |
(save-excursion |
(set-window-configuration ,winconf)) |
518 |
(set-buffer ,buffer) |
'exit 'postpone 'kill) |
519 |
,(when article |
(let ((to-be-marked (cond |
520 |
`(gnus-summary-mark-article-as-replied ,article)))) |
(yanked |
521 |
'send)) |
(mapcar |
522 |
|
(lambda (x) (if (listp x) (car x) x)) yanked)) |
523 |
|
(article (if (listp article) article (list article))) |
524 |
|
(t nil)))) |
525 |
|
(message-add-action |
526 |
|
`(when (gnus-buffer-exists-p ,buffer) |
527 |
|
(save-excursion |
528 |
|
(set-buffer ,buffer) |
529 |
|
,(when to-be-marked |
530 |
|
(if (eq config 'forward) |
531 |
|
`(gnus-summary-mark-article-as-forwarded ',to-be-marked) |
532 |
|
`(gnus-summary-mark-article-as-replied ',to-be-marked))))) |
533 |
|
'send))) |
534 |
|
|
535 |
(put 'gnus-setup-message 'lisp-indent-function 1) |
(put 'gnus-setup-message 'lisp-indent-function 1) |
536 |
(put 'gnus-setup-message 'edebug-form-spec '(form body)) |
(put 'gnus-setup-message 'edebug-form-spec '(form body)) |
545 |
;; We can't `let' gnus-newsgroup-name here, since that leads |
;; We can't `let' gnus-newsgroup-name here, since that leads |
546 |
;; to local variables leaking. |
;; to local variables leaking. |
547 |
(let ((group gnus-newsgroup-name) |
(let ((group gnus-newsgroup-name) |
548 |
|
;; make sure last viewed article doesn't affect posting styles: |
549 |
|
(gnus-article-copy) |
550 |
(buffer (current-buffer))) |
(buffer (current-buffer))) |
551 |
(unwind-protect |
(unwind-protect |
552 |
(progn |
(progn |
558 |
(gnus-read-active-file-p)) |
(gnus-read-active-file-p)) |
559 |
(gnus-group-group-name)) |
(gnus-group-group-name)) |
560 |
"")) |
"")) |
561 |
|
;; #### see comment in gnus-setup-message -- drv |
562 |
(gnus-setup-message 'message (message-mail))) |
(gnus-setup-message 'message (message-mail))) |
563 |
(save-excursion |
(save-excursion |
564 |
(set-buffer buffer) |
(set-buffer buffer) |
565 |
(setq gnus-newsgroup-name group))))) |
(setq gnus-newsgroup-name group))))) |
566 |
|
|
567 |
|
(defun gnus-group-news (&optional arg) |
568 |
|
"Start composing a news. |
569 |
|
If ARG, post to group under point. |
570 |
|
If ARG is 1, prompt for group name to post to. |
571 |
|
|
572 |
|
This function prepares a news even when using mail groups. This is useful |
573 |
|
for posting messages to mail groups without actually sending them over the |
574 |
|
network. The corresponding back end must have a 'request-post method." |
575 |
|
(interactive "P") |
576 |
|
;; We can't `let' gnus-newsgroup-name here, since that leads |
577 |
|
;; to local variables leaking. |
578 |
|
(let ((group gnus-newsgroup-name) |
579 |
|
;; make sure last viewed article doesn't affect posting styles: |
580 |
|
(gnus-article-copy) |
581 |
|
(buffer (current-buffer))) |
582 |
|
(unwind-protect |
583 |
|
(progn |
584 |
|
(setq gnus-newsgroup-name |
585 |
|
(if arg |
586 |
|
(if (= 1 (prefix-numeric-value arg)) |
587 |
|
(completing-read "Use group: " |
588 |
|
gnus-active-hashtb nil |
589 |
|
(gnus-read-active-file-p)) |
590 |
|
(gnus-group-group-name)) |
591 |
|
"")) |
592 |
|
;; #### see comment in gnus-setup-message -- drv |
593 |
|
(gnus-setup-message 'message |
594 |
|
(message-news (gnus-group-real-name gnus-newsgroup-name)))) |
595 |
|
(save-excursion |
596 |
|
(set-buffer buffer) |
597 |
|
(setq gnus-newsgroup-name group))))) |
598 |
|
|
599 |
(defun gnus-group-post-news (&optional arg) |
(defun gnus-group-post-news (&optional arg) |
600 |
"Start composing a news message. |
"Start composing a message (a news by default). |
601 |
If ARG, post to the group under point. |
If ARG, post to group under point. If ARG is 1, prompt for group name. |
602 |
If ARG is 1, prompt for a group name." |
Depending on the selected group, the message might be either a mail or |
603 |
|
a news." |
604 |
(interactive "P") |
(interactive "P") |
605 |
;; Bind this variable here to make message mode hooks work ok. |
;; Bind this variable here to make message mode hooks work ok. |
606 |
(let ((gnus-newsgroup-name |
(let ((gnus-newsgroup-name |
609 |
(completing-read "Newsgroup: " gnus-active-hashtb nil |
(completing-read "Newsgroup: " gnus-active-hashtb nil |
610 |
(gnus-read-active-file-p)) |
(gnus-read-active-file-p)) |
611 |
(gnus-group-group-name)) |
(gnus-group-group-name)) |
612 |
""))) |
"")) |
613 |
|
;; make sure last viewed article doesn't affect posting styles: |
614 |
|
(gnus-article-copy)) |
615 |
|
(gnus-post-news 'post gnus-newsgroup-name nil nil nil nil |
616 |
|
(string= gnus-newsgroup-name "")))) |
617 |
|
|
618 |
|
(defun gnus-summary-mail-other-window (&optional arg) |
619 |
|
"Start composing a mail in another window. |
620 |
|
Use the posting of the current group by default. |
621 |
|
If ARG, don't do that. If ARG is 1, prompt for group name to find the |
622 |
|
posting style." |
623 |
|
(interactive "P") |
624 |
|
;; We can't `let' gnus-newsgroup-name here, since that leads |
625 |
|
;; to local variables leaking. |
626 |
|
(let ((group gnus-newsgroup-name) |
627 |
|
;; make sure last viewed article doesn't affect posting styles: |
628 |
|
(gnus-article-copy) |
629 |
|
(buffer (current-buffer))) |
630 |
|
(unwind-protect |
631 |
|
(progn |
632 |
|
(setq gnus-newsgroup-name |
633 |
|
(if arg |
634 |
|
(if (= 1 (prefix-numeric-value arg)) |
635 |
|
(completing-read "Use group: " |
636 |
|
gnus-active-hashtb nil |
637 |
|
(gnus-read-active-file-p)) |
638 |
|
"") |
639 |
|
gnus-newsgroup-name)) |
640 |
|
;; #### see comment in gnus-setup-message -- drv |
641 |
|
(gnus-setup-message 'message (message-mail))) |
642 |
|
(save-excursion |
643 |
|
(set-buffer buffer) |
644 |
|
(setq gnus-newsgroup-name group))))) |
645 |
|
|
646 |
|
(defun gnus-summary-news-other-window (&optional arg) |
647 |
|
"Start composing a news in another window. |
648 |
|
Post to the current group by default. |
649 |
|
If ARG, don't do that. If ARG is 1, prompt for group name to post to. |
650 |
|
|
651 |
|
This function prepares a news even when using mail groups. This is useful |
652 |
|
for posting messages to mail groups without actually sending them over the |
653 |
|
network. The corresponding back end must have a 'request-post method." |
654 |
|
(interactive "P") |
655 |
|
;; We can't `let' gnus-newsgroup-name here, since that leads |
656 |
|
;; to local variables leaking. |
657 |
|
(let ((group gnus-newsgroup-name) |
658 |
|
;; make sure last viewed article doesn't affect posting styles: |
659 |
|
(gnus-article-copy) |
660 |
|
(buffer (current-buffer))) |
661 |
|
(unwind-protect |
662 |
|
(progn |
663 |
|
(setq gnus-newsgroup-name |
664 |
|
(if arg |
665 |
|
(if (= 1 (prefix-numeric-value arg)) |
666 |
|
(completing-read "Use group: " |
667 |
|
gnus-active-hashtb nil |
668 |
|
(gnus-read-active-file-p)) |
669 |
|
"") |
670 |
|
gnus-newsgroup-name)) |
671 |
|
;; #### see comment in gnus-setup-message -- drv |
672 |
|
(gnus-setup-message 'message |
673 |
|
(progn |
674 |
|
(message-news (gnus-group-real-name gnus-newsgroup-name)) |
675 |
|
(set (make-local-variable 'gnus-discouraged-post-methods) |
676 |
|
(delq |
677 |
|
(car (gnus-find-method-for-group gnus-newsgroup-name)) |
678 |
|
(copy-sequence gnus-discouraged-post-methods)))))) |
679 |
|
(save-excursion |
680 |
|
(set-buffer buffer) |
681 |
|
(setq gnus-newsgroup-name group))))) |
682 |
|
|
683 |
|
(defun gnus-summary-post-news (&optional arg) |
684 |
|
"Start composing a message. Post to the current group by default. |
685 |
|
If ARG, don't do that. If ARG is 1, prompt for a group name to post to. |
686 |
|
Depending on the selected group, the message might be either a mail or |
687 |
|
a news." |
688 |
|
(interactive "P") |
689 |
|
;; Bind this variable here to make message mode hooks work ok. |
690 |
|
(let ((gnus-newsgroup-name |
691 |
|
(if arg |
692 |
|
(if (= 1 (prefix-numeric-value arg)) |
693 |
|
(completing-read "Newsgroup: " gnus-active-hashtb nil |
694 |
|
(gnus-read-active-file-p)) |
695 |
|
"") |
696 |
|
gnus-newsgroup-name)) |
697 |
|
;; make sure last viewed article doesn't affect posting styles: |
698 |
|
(gnus-article-copy)) |
699 |
(gnus-post-news 'post gnus-newsgroup-name))) |
(gnus-post-news 'post gnus-newsgroup-name))) |
700 |
|
|
|
(defun gnus-summary-post-news () |
|
|
"Start composing a news message." |
|
|
(interactive) |
|
|
(gnus-post-news 'post gnus-newsgroup-name)) |
|
701 |
|
|
702 |
(defun gnus-summary-followup (yank &optional force-news) |
(defun gnus-summary-followup (yank &optional force-news) |
703 |
"Compose a followup to an article. |
"Compose a followup to an article. |
704 |
If prefix argument YANK is non-nil, original article is yanked automatically." |
If prefix argument YANK is non-nil, the original article is yanked |
705 |
|
automatically. |
706 |
|
YANK is a list of elements, where the car of each element is the |
707 |
|
article number, and the cdr is the string to be yanked." |
708 |
(interactive |
(interactive |
709 |
(list (and current-prefix-arg |
(list (and current-prefix-arg |
710 |
(gnus-summary-work-articles 1)))) |
(gnus-summary-work-articles 1)))) |
711 |
(when yank |
(when yank |
712 |
(gnus-summary-goto-subject (car yank))) |
(gnus-summary-goto-subject |
713 |
|
(if (listp (car yank)) |
714 |
|
(caar yank) |
715 |
|
(car yank)))) |
716 |
(save-window-excursion |
(save-window-excursion |
717 |
(gnus-summary-select-article)) |
(gnus-summary-select-article)) |
718 |
(let ((headers (gnus-summary-article-header (gnus-summary-article-number))) |
(let ((headers (gnus-summary-article-header (gnus-summary-article-number))) |
720 |
;; Send a followup. |
;; Send a followup. |
721 |
(gnus-post-news nil gnus-newsgroup-name |
(gnus-post-news nil gnus-newsgroup-name |
722 |
headers gnus-article-buffer |
headers gnus-article-buffer |
723 |
yank nil force-news))) |
yank nil force-news) |
724 |
|
(gnus-summary-handle-replysign))) |
725 |
|
|
726 |
(defun gnus-summary-followup-with-original (n &optional force-news) |
(defun gnus-summary-followup-with-original (n &optional force-news) |
727 |
"Compose a followup to an article and include the original article." |
"Compose a followup to an article and include the original article. |
728 |
|
The text in the region will be yanked. If the region isn't |
729 |
|
active, the entire article will be yanked." |
730 |
(interactive "P") |
(interactive "P") |
731 |
(gnus-summary-followup (gnus-summary-work-articles n) force-news)) |
(gnus-summary-followup (gnus-summary-work-articles n) force-news)) |
732 |
|
|
743 |
(gnus-summary-followup (gnus-summary-work-articles arg) t)) |
(gnus-summary-followup (gnus-summary-work-articles arg) t)) |
744 |
|
|
745 |
(defun gnus-inews-yank-articles (articles) |
(defun gnus-inews-yank-articles (articles) |
746 |
(let (beg article) |
(let (beg article yank-string) |
747 |
(message-goto-body) |
(message-goto-body) |
748 |
(while (setq article (pop articles)) |
(while (setq article (pop articles)) |
749 |
|
(when (listp article) |
750 |
|
(setq yank-string (nth 1 article) |
751 |
|
article (nth 0 article))) |
752 |
(save-window-excursion |
(save-window-excursion |
753 |
(set-buffer gnus-summary-buffer) |
(set-buffer gnus-summary-buffer) |
754 |
(gnus-summary-select-article nil nil nil article) |
(gnus-summary-select-article nil nil nil article) |
755 |
(gnus-summary-remove-process-mark article)) |
(gnus-summary-remove-process-mark article)) |
756 |
(gnus-copy-article-buffer) |
(gnus-copy-article-buffer nil yank-string) |
757 |
(let ((message-reply-buffer gnus-article-copy) |
(let ((message-reply-buffer gnus-article-copy) |
758 |
(message-reply-headers gnus-current-headers)) |
(message-reply-headers |
759 |
|
;; The headers are decoded. |
760 |
|
(with-current-buffer gnus-article-copy |
761 |
|
(save-restriction |
762 |
|
(nnheader-narrow-to-headers) |
763 |
|
(nnheader-parse-naked-head))))) |
764 |
(message-yank-original) |
(message-yank-original) |
765 |
(setq beg (or beg (mark t)))) |
(setq beg (or beg (mark t)))) |
766 |
(when articles |
(when articles |
777 |
(let ((articles (gnus-summary-work-articles n)) |
(let ((articles (gnus-summary-work-articles n)) |
778 |
(message-post-method |
(message-post-method |
779 |
`(lambda (arg) |
`(lambda (arg) |
780 |
(gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name))) |
(gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))) |
781 |
article) |
article) |
782 |
(while (setq article (pop articles)) |
(while (setq article (pop articles)) |
783 |
(when (gnus-summary-select-article t nil nil article) |
(when (gnus-summary-select-article t nil nil article) |
809 |
|
|
810 |
|
|
811 |
|
|
812 |
(defun gnus-copy-article-buffer (&optional article-buffer) |
(defun gnus-copy-article-buffer (&optional article-buffer yank-string) |
813 |
;; make a copy of the article buffer with all text properties removed |
;; make a copy of the article buffer with all text properties removed |
814 |
;; this copy is in the buffer gnus-article-copy. |
;; this copy is in the buffer gnus-article-copy. |
815 |
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used |
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used |
825 |
(error "Can't find any article buffer") |
(error "Can't find any article buffer") |
826 |
(save-excursion |
(save-excursion |
827 |
(set-buffer article-buffer) |
(set-buffer article-buffer) |
828 |
(save-restriction |
(let ((gnus-newsgroup-charset (or gnus-article-charset |
829 |
;; Copy over the (displayed) article buffer, delete |
gnus-newsgroup-charset)) |
830 |
;; hidden text and remove text properties. |
(gnus-newsgroup-ignored-charsets |
831 |
(widen) |
(or gnus-article-ignored-charsets |
832 |
(copy-to-buffer gnus-article-copy (point-min) (point-max)) |
gnus-newsgroup-ignored-charsets))) |
833 |
(set-buffer gnus-article-copy) |
(save-restriction |
834 |
(gnus-article-delete-text-of-type 'annotation) |
;; Copy over the (displayed) article buffer, delete |
835 |
(gnus-remove-text-with-property 'gnus-prev) |
;; hidden text and remove text properties. |
836 |
(gnus-remove-text-with-property 'gnus-next) |
(widen) |
837 |
(insert |
(copy-to-buffer gnus-article-copy (point-min) (point-max)) |
838 |
(prog1 |
(set-buffer gnus-article-copy) |
839 |
(buffer-substring-no-properties (point-min) (point-max)) |
(when yank-string |
840 |
(erase-buffer))) |
(message-goto-body) |
841 |
;; Find the original headers. |
(delete-region (point) (point-max)) |
842 |
(set-buffer gnus-original-article-buffer) |
(insert yank-string)) |
843 |
(goto-char (point-min)) |
(gnus-article-delete-text-of-type 'annotation) |
844 |
(while (looking-at message-unix-mail-delimiter) |
(gnus-remove-text-with-property 'gnus-prev) |
845 |
(forward-line 1)) |
(gnus-remove-text-with-property 'gnus-next) |
846 |
(setq beg (point)) |
(gnus-remove-text-with-property 'gnus-decoration) |
847 |
(setq end (or (search-forward "\n\n" nil t) (point))) |
(insert |
848 |
;; Delete the headers from the displayed articles. |
(prog1 |
849 |
(set-buffer gnus-article-copy) |
(buffer-substring-no-properties (point-min) (point-max)) |
850 |
(delete-region (goto-char (point-min)) |
(erase-buffer))) |
851 |
(or (search-forward "\n\n" nil t) (point-max))) |
;; Find the original headers. |
852 |
;; Insert the original article headers. |
(set-buffer gnus-original-article-buffer) |
853 |
(insert-buffer-substring gnus-original-article-buffer beg end) |
(goto-char (point-min)) |
854 |
(article-decode-encoded-words))) |
(while (looking-at message-unix-mail-delimiter) |
855 |
|
(forward-line 1)) |
856 |
|
(let ((mail-header-separator "")) |
857 |
|
(setq beg (point) |
858 |
|
end (or (message-goto-body) |
859 |
|
;; There may be just a header. |
860 |
|
(point-max)))) |
861 |
|
;; Delete the headers from the displayed articles. |
862 |
|
(set-buffer gnus-article-copy) |
863 |
|
(let ((mail-header-separator "")) |
864 |
|
(delete-region (goto-char (point-min)) |
865 |
|
(or (message-goto-body) (point-max)))) |
866 |
|
;; Insert the original article headers. |
867 |
|
(insert-buffer-substring gnus-original-article-buffer beg end) |
868 |
|
;; Decode charsets. |
869 |
|
(let ((gnus-article-decode-hook |
870 |
|
(delq 'article-decode-charset |
871 |
|
(copy-sequence gnus-article-decode-hook)))) |
872 |
|
(run-hooks 'gnus-article-decode-hook))))) |
873 |
gnus-article-copy))) |
gnus-article-copy))) |
874 |
|
|
875 |
(defun gnus-post-news (post &optional group header article-buffer yank subject |
(defun gnus-post-news (post &optional group header article-buffer yank subject |
876 |
force-news) |
force-news) |
877 |
(when article-buffer |
(when article-buffer |
878 |
(gnus-copy-article-buffer)) |
(gnus-copy-article-buffer)) |
879 |
(let ((gnus-article-reply article-buffer) |
(let ((gnus-article-reply (and article-buffer (gnus-summary-article-number))) |
880 |
|
(gnus-article-yanked-articles yank) |
881 |
(add-to-list gnus-add-to-list)) |
(add-to-list gnus-add-to-list)) |
882 |
(gnus-setup-message (cond (yank 'reply-yank) |
(gnus-setup-message (cond (yank 'reply-yank) |
883 |
(article-buffer 'reply) |
(article-buffer 'reply) |
888 |
to-address to-group mailing-list to-list |
to-address to-group mailing-list to-list |
889 |
newsgroup-p) |
newsgroup-p) |
890 |
(when group |
(when group |
891 |
(setq to-address (gnus-group-find-parameter group 'to-address) |
(setq to-address (gnus-parameter-to-address group) |
892 |
to-group (gnus-group-find-parameter group 'to-group) |
to-group (gnus-group-find-parameter group 'to-group) |
893 |
to-list (gnus-group-find-parameter group 'to-list) |
to-list (gnus-parameter-to-list group) |
894 |
newsgroup-p (gnus-group-find-parameter group 'newsgroup) |
newsgroup-p (gnus-group-find-parameter group 'newsgroup) |
895 |
mailing-list (when gnus-mailing-list-groups |
mailing-list (when gnus-mailing-list-groups |
896 |
(string-match gnus-mailing-list-groups group)) |
(string-match gnus-mailing-list-groups group)) |
902 |
force-news |
force-news |
903 |
(and (gnus-news-group-p |
(and (gnus-news-group-p |
904 |
(or pgroup gnus-newsgroup-name) |
(or pgroup gnus-newsgroup-name) |
905 |
(if header (mail-header-number header) |
(or header gnus-current-article)) |
|
gnus-current-article)) |
|
906 |
(not mailing-list) |
(not mailing-list) |
907 |
(not to-list) |
(not to-list) |
908 |
(not to-address))) |
(not to-address))) |
911 |
(message-news (or to-group group)) |
(message-news (or to-group group)) |
912 |
(set-buffer gnus-article-copy) |
(set-buffer gnus-article-copy) |
913 |
(gnus-msg-treat-broken-reply-to) |
(gnus-msg-treat-broken-reply-to) |
914 |
(message-followup (if (or newsgroup-p force-news) nil to-group))) |
(message-followup (if (or newsgroup-p force-news) |
915 |
|
(if (save-restriction |
916 |
|
(article-narrow-to-head) |
917 |
|
(message-fetch-field "newsgroups")) |
918 |
|
nil |
919 |
|
"") |
920 |
|
to-group))) |
921 |
;; The is mail. |
;; The is mail. |
922 |
(if post |
(if post |
923 |
(progn |
(progn |
935 |
(when yank |
(when yank |
936 |
(gnus-inews-yank-articles yank)))))) |
(gnus-inews-yank-articles yank)))))) |
937 |
|
|
938 |
(defun gnus-msg-treat-broken-reply-to () |
(defun gnus-msg-treat-broken-reply-to (&optional force) |
939 |
"Remove the Reply-to header if broken-reply-to." |
"Remove the Reply-to header if broken-reply-to." |
940 |
(when (gnus-group-find-parameter |
(when (or force |
941 |
gnus-newsgroup-name 'broken-reply-to) |
(gnus-group-find-parameter |
942 |
|
gnus-newsgroup-name 'broken-reply-to)) |
943 |
(save-restriction |
(save-restriction |
944 |
(message-narrow-to-head) |
(message-narrow-to-head) |
945 |
(message-remove-header "reply-to")))) |
(message-remove-header "reply-to")))) |
947 |
(defun gnus-post-method (arg group &optional silent) |
(defun gnus-post-method (arg group &optional silent) |
948 |
"Return the posting method based on GROUP and ARG. |
"Return the posting method based on GROUP and ARG. |
949 |
If SILENT, don't prompt the user." |
If SILENT, don't prompt the user." |
950 |
(let ((group-method (gnus-find-method-for-group group))) |
(let ((gnus-post-method (or (gnus-parameter-post-method group) |
951 |
|
gnus-post-method)) |
952 |
|
(group-method (gnus-find-method-for-group group))) |
953 |
(cond |
(cond |
954 |
;; If the group-method is nil (which shouldn't happen) we use |
;; If the group-method is nil (which shouldn't happen) we use |
955 |
;; the default method. |
;; the default method. |
956 |
((null group-method) |
((null group-method) |
957 |
(or (and (null (eq gnus-post-method 'active)) gnus-post-method) |
(or (and (listp gnus-post-method) ;If not current/native/nil |
958 |
gnus-select-method message-post-method)) |
(not (listp (car gnus-post-method))) ; and not a list of methods |
959 |
|
gnus-post-method) ;then use it. |
960 |
|
gnus-select-method |
961 |
|
message-post-method)) |
962 |
;; We want the inverse of the default |
;; We want the inverse of the default |
963 |
((and arg (not (eq arg 0))) |
((and arg (not (eq arg 0))) |
964 |
(if (eq gnus-post-method 'active) |
(if (eq gnus-post-method 'current) |
965 |
gnus-select-method |
gnus-select-method |
966 |
group-method)) |
group-method)) |
967 |
;; We query the user for a post method. |
;; We query the user for a post method. |
968 |
((or arg |
((or arg |
969 |
(and gnus-post-method |
(and (listp gnus-post-method) |
|
(not (eq gnus-post-method 'current)) |
|
970 |
(listp (car gnus-post-method)))) |
(listp (car gnus-post-method)))) |
971 |
(let* ((methods |
(let* ((methods |
972 |
;; Collect all methods we know about. |
;; Collect all methods we know about. |
973 |
(append |
(append |
974 |
(when (and gnus-post-method |
(when (listp gnus-post-method) |
|
(not (eq gnus-post-method 'current))) |
|
975 |
(if (listp (car gnus-post-method)) |
(if (listp (car gnus-post-method)) |
976 |
gnus-post-method |
gnus-post-method |
977 |
(list gnus-post-method))) |
(list gnus-post-method))) |
992 |
(setq method-alist |
(setq method-alist |
993 |
(mapcar |
(mapcar |
994 |
(lambda (m) |
(lambda (m) |
995 |
(list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) |
(if (equal (cadr m) "") |
996 |
|
(list (symbol-name (car m)) m) |
997 |
|
(list (concat (cadr m) " (" (symbol-name (car m)) ")") m))) |
998 |
post-methods)) |
post-methods)) |
999 |
;; Query the user. |
;; Query the user. |
1000 |
(cadr |
(cadr |
1010 |
method-alist)))) |
method-alist)))) |
1011 |
;; Override normal method. |
;; Override normal method. |
1012 |
((and (eq gnus-post-method 'current) |
((and (eq gnus-post-method 'current) |
1013 |
(not (eq (car group-method) 'nndraft)) |
(not (memq (car group-method) gnus-discouraged-post-methods)) |
1014 |
(gnus-get-function group-method 'request-post t) |
(gnus-get-function group-method 'request-post t)) |
1015 |
(not arg)) |
(assert (not arg)) |
1016 |
group-method) |
group-method) |
1017 |
((and gnus-post-method |
;; Use gnus-post-method. |
1018 |
(not (eq gnus-post-method 'current))) |
((listp gnus-post-method) ;A method... |
1019 |
|
(assert (not (listp (car gnus-post-method)))) ;... not a list of methods. |
1020 |
gnus-post-method) |
gnus-post-method) |
1021 |
;; Use the normal select method. |
;; Use the normal select method (nil or native). |
1022 |
(t gnus-select-method)))) |
(t gnus-select-method)))) |
1023 |
|
|
1024 |
|
|
1025 |
|
|
|
;; Dummies to avoid byte-compile warning. |
|
|
(eval-when-compile |
|
|
(defvar nnspool-rejected-article-hook) |
|
|
(defvar xemacs-codename)) |
|
|
|
|
1026 |
(defun gnus-extended-version () |
(defun gnus-extended-version () |
1027 |
"Stringified Gnus version and Emacs version." |
"Stringified Gnus version and Emacs version. |
1028 |
|
See the variable `gnus-user-agent'." |
1029 |
(interactive) |
(interactive) |
1030 |
(concat |
(let* ((float-output-format nil) |
1031 |
"Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t) |
(gnus-v |
1032 |
" (" gnus-version ")" |
(concat "Gnus/" |
1033 |
" " |
(prin1-to-string (gnus-continuum-version gnus-version) t) |
1034 |
(cond |
" (" gnus-version ")")) |
1035 |
((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) |
(emacs-v (gnus-emacs-version))) |
1036 |
(concat "Emacs/" (match-string 1 emacs-version))) |
(if (stringp gnus-user-agent) |
1037 |
((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" |
gnus-user-agent |
1038 |
emacs-version) |
(concat gnus-v |
1039 |
(concat (match-string 1 emacs-version) |
(when emacs-v |
1040 |
(format "/%d.%d" emacs-major-version emacs-minor-version) |
(concat " " emacs-v)))))) |
|
(if (match-beginning 3) |
|
|
(match-string 3 emacs-version) |
|
|
"") |
|
|
(if (boundp 'xemacs-codename) |
|
|
(concat " (" xemacs-codename ")") |
|
|
""))) |
|
|
(t emacs-version)))) |
|
1041 |
|
|
1042 |
|
|
1043 |
;;; |
;;; |
1046 |
|
|
1047 |
;;; Mail reply commands of Gnus summary mode |
;;; Mail reply commands of Gnus summary mode |
1048 |
|
|
1049 |
(defun gnus-summary-reply (&optional yank wide) |
(defun gnus-summary-reply (&optional yank wide very-wide) |
1050 |
"Start composing a reply mail to the current message. |
"Start composing a mail reply to the current message. |
1051 |
If prefix argument YANK is non-nil, the original article is yanked |
If prefix argument YANK is non-nil, the original article is yanked |
1052 |
automatically." |
automatically. |
1053 |
|
If WIDE, make a wide reply. |
1054 |
|
If VERY-WIDE, make a very wide reply." |
1055 |
(interactive |
(interactive |
1056 |
(list (and current-prefix-arg |
(list (and current-prefix-arg |
1057 |
(gnus-summary-work-articles 1)))) |
(gnus-summary-work-articles 1)))) |
1058 |
;; Stripping headers should be specified with mail-yank-ignored-headers. |
;; Allow user to require confirmation before replying by mail to the |
1059 |
(when yank |
;; author of a news article (or mail message). |
1060 |
(gnus-summary-goto-subject (car yank))) |
(when (or |
1061 |
(let ((gnus-article-reply t)) |
(not (or (gnus-news-group-p gnus-newsgroup-name) |
1062 |
(gnus-setup-message (if yank 'reply-yank 'reply) |
gnus-confirm-treat-mail-like-news)) |
1063 |
(gnus-summary-select-article) |
(not (cond ((stringp gnus-confirm-mail-reply-to-news) |
1064 |
(set-buffer (gnus-copy-article-buffer)) |
(string-match gnus-confirm-mail-reply-to-news |
1065 |
(gnus-msg-treat-broken-reply-to) |
gnus-newsgroup-name)) |
1066 |
(save-restriction |
((functionp gnus-confirm-mail-reply-to-news) |
1067 |
(message-narrow-to-head) |
(funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name)) |
1068 |
(goto-char (point-max))) |
(t gnus-confirm-mail-reply-to-news))) |
1069 |
(mml-quote-region (point) (point-max)) |
(y-or-n-p "Really reply by mail to article author? ")) |
1070 |
(message-reply nil wide) |
(let* ((article |
1071 |
|
(if (listp (car yank)) |
1072 |
|
(caar yank) |
1073 |
|
(car yank))) |
1074 |
|
(gnus-article-reply (or article (gnus-summary-article-number))) |
1075 |
|
(gnus-article-yanked-articles yank) |
1076 |
|
(headers "")) |
1077 |
|
;; Stripping headers should be specified with mail-yank-ignored-headers. |
1078 |
(when yank |
(when yank |
1079 |
(gnus-inews-yank-articles yank))))) |
(gnus-summary-goto-subject article)) |
1080 |
|
(gnus-setup-message (if yank 'reply-yank 'reply) |
1081 |
|
(if (not very-wide) |
1082 |
|
(gnus-summary-select-article) |
1083 |
|
(dolist (article very-wide) |
1084 |
|
(gnus-summary-select-article nil nil nil article) |
1085 |
|
(save-excursion |
1086 |
|
(set-buffer (gnus-copy-article-buffer)) |
1087 |
|
(gnus-msg-treat-broken-reply-to) |
1088 |
|
(save-restriction |
1089 |
|
(message-narrow-to-head) |
1090 |
|
(setq headers (concat headers (buffer-string))))))) |
1091 |
|
(set-buffer (gnus-copy-article-buffer)) |
1092 |
|
(gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to) |
1093 |
|
(save-restriction |
1094 |
|
(message-narrow-to-head) |
1095 |
|
(when very-wide |
1096 |
|
(erase-buffer) |
1097 |
|
(insert headers)) |
1098 |
|
(goto-char (point-max))) |
1099 |
|
(mml-quote-region (point) (point-max)) |
1100 |
|
(message-reply nil wide) |
1101 |
|
(when yank |
1102 |
|
(gnus-inews-yank-articles yank)) |
1103 |
|
(gnus-summary-handle-replysign))))) |
1104 |
|
|
1105 |
|
(defun gnus-summary-handle-replysign () |
1106 |
|
"Check the various replysign variables and take action accordingly." |
1107 |
|
(when (or gnus-message-replysign gnus-message-replyencrypt) |
1108 |
|
(let (signed encrypted) |
1109 |
|
(save-excursion |
1110 |
|
(set-buffer gnus-article-buffer) |
1111 |
|
(setq signed (memq 'signed gnus-article-wash-types)) |
1112 |
|
(setq encrypted (memq 'encrypted gnus-article-wash-types))) |
1113 |
|
(cond ((and gnus-message-replyencrypt encrypted) |
1114 |
|
(mml-secure-message mml-default-encrypt-method |
1115 |
|
(if gnus-message-replysignencrypted |
1116 |
|
'signencrypt |
1117 |
|
'encrypt))) |
1118 |
|
((and gnus-message-replysign signed) |
1119 |
|
(mml-secure-message mml-default-sign-method 'sign)))))) |
1120 |
|
|
1121 |
(defun gnus-summary-reply-with-original (n &optional wide) |
(defun gnus-summary-reply-with-original (n &optional wide) |
1122 |
"Start composing a reply mail to the current message. |
"Start composing a reply mail to the current message. |
1124 |
(interactive "P") |
(interactive "P") |
1125 |
(gnus-summary-reply (gnus-summary-work-articles n) wide)) |
(gnus-summary-reply (gnus-summary-work-articles n) wide)) |
1126 |
|
|
1127 |
|
(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide) |
1128 |
|
"Like `gnus-summary-reply' except removing reply-to field. |
1129 |
|
If prefix argument YANK is non-nil, the original article is yanked |
1130 |
|
automatically. |
1131 |
|
If WIDE, make a wide reply. |
1132 |
|
If VERY-WIDE, make a very wide reply." |
1133 |
|
(interactive |
1134 |
|
(list (and current-prefix-arg |
1135 |
|
(gnus-summary-work-articles 1)))) |
1136 |
|
(let ((gnus-msg-force-broken-reply-to t)) |
1137 |
|
(gnus-summary-reply yank wide very-wide))) |
1138 |
|
|
1139 |
|
(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide) |
1140 |
|
"Like `gnus-summary-reply-with-original' except removing reply-to field. |
1141 |
|
The original article will be yanked." |
1142 |
|
(interactive "P") |
1143 |
|
(gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide)) |
1144 |
|
|
1145 |
(defun gnus-summary-wide-reply (&optional yank) |
(defun gnus-summary-wide-reply (&optional yank) |
1146 |
"Start composing a wide reply mail to the current message. |
"Start composing a wide reply mail to the current message. |
1147 |
If prefix argument YANK is non-nil, the original article is yanked |
If prefix argument YANK is non-nil, the original article is yanked |
1153 |
|
|
1154 |
(defun gnus-summary-wide-reply-with-original (n) |
(defun gnus-summary-wide-reply-with-original (n) |
1155 |
"Start composing a wide reply mail to the current message. |
"Start composing a wide reply mail to the current message. |
1156 |
The original article will be yanked." |
The original article will be yanked. |
1157 |
|
Uses the process/prefix convention." |
1158 |
(interactive "P") |
(interactive "P") |
1159 |
(gnus-summary-reply-with-original n t)) |
(gnus-summary-reply-with-original n t)) |
1160 |
|
|
1161 |
|
(defun gnus-summary-very-wide-reply (&optional yank) |
1162 |
|
"Start composing a very wide reply mail to the current message. |
1163 |
|
If prefix argument YANK is non-nil, the original article is yanked |
1164 |
|
automatically." |
1165 |
|
(interactive |
1166 |
|
(list (and current-prefix-arg |
1167 |
|
(gnus-summary-work-articles 1)))) |
1168 |
|
(gnus-summary-reply yank t (gnus-summary-work-articles yank))) |
1169 |
|
|
1170 |
|
(defun gnus-summary-very-wide-reply-with-original (n) |
1171 |
|
"Start composing a very wide reply mail to the current message. |
1172 |
|
The original article will be yanked." |
1173 |
|
(interactive "P") |
1174 |
|
(gnus-summary-reply |
1175 |
|
(gnus-summary-work-articles n) t (gnus-summary-work-articles n))) |
1176 |
|
|
1177 |
(defun gnus-summary-mail-forward (&optional arg post) |
(defun gnus-summary-mail-forward (&optional arg post) |
1178 |
"Forward the current message to another user. |
"Forward the current message(s) to another user. |
1179 |
If ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml'; |
If process marks exist, forward all marked messages; |
1180 |
|
if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml'; |
1181 |
if ARG is 1, decode the message and forward directly inline; |
if ARG is 1, decode the message and forward directly inline; |
1182 |
if ARG is 2, forward message as an rfc822 MIME section; |
if ARG is 2, forward message as an rfc822 MIME section; |
1183 |
if ARG is 3, decode message and forward as an rfc822 MIME section; |
if ARG is 3, decode message and forward as an rfc822 MIME section; |
1184 |
if ARG is 4, forward message directly inline; |
if ARG is 4, forward message directly inline; |
1185 |
otherwise, use flipped `message-forward-as-mime'. |
otherwise, use flipped `message-forward-as-mime'. |
1186 |
If POST, post instead of mail." |
If POST, post instead of mail. |
1187 |
|
For the `inline' alternatives, also see the variable |
1188 |
|
`message-forward-ignored-headers'." |
1189 |
(interactive "P") |
(interactive "P") |
1190 |
(let ((message-forward-as-mime message-forward-as-mime) |
(if (cdr (gnus-summary-work-articles nil)) |
1191 |
(message-forward-show-mml message-forward-show-mml)) |
;; Process marks are given. |
1192 |
(cond |
(gnus-uu-digest-mail-forward arg post) |
1193 |
((null arg)) |
;; No process marks. |
1194 |
((eq arg 1) (setq message-forward-as-mime nil |
(let ((message-forward-as-mime message-forward-as-mime) |
1195 |
message-forward-show-mml t)) |
(message-forward-show-mml message-forward-show-mml)) |
1196 |
((eq arg 2) (setq message-forward-as-mime t |
(cond |
1197 |
message-forward-show-mml nil)) |
((null arg)) |
1198 |
((eq arg 3) (setq message-forward-as-mime t |
((eq arg 1) |
1199 |
message-forward-show-mml t)) |
(setq message-forward-as-mime nil |
1200 |
((eq arg 4) (setq message-forward-as-mime nil |
message-forward-show-mml t)) |
1201 |
message-forward-show-mml nil)) |
((eq arg 2) |
1202 |
(t (setq message-forward-as-mime (not message-forward-as-mime)))) |
(setq message-forward-as-mime t |
1203 |
(gnus-setup-message 'forward |
message-forward-show-mml nil)) |
1204 |
(gnus-summary-select-article) |
((eq arg 3) |
1205 |
(let ((mail-parse-charset gnus-newsgroup-charset) |
(setq message-forward-as-mime t |
1206 |
(mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) |
message-forward-show-mml t)) |
1207 |
(set-buffer gnus-original-article-buffer) |
((eq arg 4) |
1208 |
(message-forward post))))) |
(setq message-forward-as-mime nil |
1209 |
|
message-forward-show-mml nil)) |
1210 |
|
(t |
1211 |
|
(setq message-forward-as-mime (not message-forward-as-mime)))) |
1212 |
|
(let* ((gnus-article-reply (gnus-summary-article-number)) |
1213 |
|
(gnus-article-yanked-articles (list gnus-article-reply))) |
1214 |
|
(gnus-setup-message 'forward |
1215 |
|
(gnus-summary-select-article) |
1216 |
|
(let ((mail-parse-charset |
1217 |
|
(or (and (gnus-buffer-live-p gnus-article-buffer) |
1218 |
|
(with-current-buffer gnus-article-buffer |
1219 |
|
gnus-article-charset)) |
1220 |
|
gnus-newsgroup-charset)) |
1221 |
|
(mail-parse-ignored-charsets |
1222 |
|
gnus-newsgroup-ignored-charsets)) |
1223 |
|
(set-buffer gnus-original-article-buffer) |
1224 |
|
(message-forward post))))))) |
1225 |
|
|
1226 |
(defun gnus-summary-resend-message (address n) |
(defun gnus-summary-resend-message (address n) |
1227 |
"Resend the current article to ADDRESS." |
"Resend the current article to ADDRESS." |
1228 |
(interactive "sResend message(s) to: \nP") |
(interactive |
1229 |
|
(list (message-read-from-minibuffer |
1230 |
|
"Resend message(s) to: " |
1231 |
|
(when (and gnus-summary-resend-default-address |
1232 |
|
(gnus-buffer-live-p gnus-original-article-buffer)) |
1233 |
|
;; If some other article is currently selected, the |
1234 |
|
;; initial-contents is wrong. Whatever, it is just the |
1235 |
|
;; initial-contents. |
1236 |
|
(with-current-buffer gnus-original-article-buffer |
1237 |
|
(nnmail-fetch-field "to")))) |
1238 |
|
current-prefix-arg)) |
1239 |
(let ((articles (gnus-summary-work-articles n)) |
(let ((articles (gnus-summary-work-articles n)) |
1240 |
article) |
article) |
1241 |
(while (setq article (pop articles)) |
(while (setq article (pop articles)) |
1242 |
(gnus-summary-select-article nil nil nil article) |
(gnus-summary-select-article nil nil nil article) |
1243 |
(save-excursion |
(save-excursion |
1244 |
(set-buffer gnus-original-article-buffer) |
(set-buffer gnus-original-article-buffer) |
1245 |
(message-resend address))))) |
(message-resend address)) |
1246 |
|
(gnus-summary-mark-article-as-forwarded article)))) |
1247 |
|
|
1248 |
|
;; From: Matthieu Moy <Matthieu.Moy@imag.fr> |
1249 |
|
(defun gnus-summary-resend-message-edit () |
1250 |
|
"Resend an article that has already been sent. |
1251 |
|
A new buffer will be created to allow the user to modify body and |
1252 |
|
contents of the message, and then, everything will happen as when |
1253 |
|
composing a new message." |
1254 |
|
(interactive) |
1255 |
|
(let ((article (gnus-summary-article-number))) |
1256 |
|
(gnus-setup-message 'reply-yank |
1257 |
|
(gnus-summary-select-article t) |
1258 |
|
(set-buffer gnus-original-article-buffer) |
1259 |
|
(let ((cur (current-buffer)) |
1260 |
|
(to (message-fetch-field "to"))) |
1261 |
|
;; Get a normal message buffer. |
1262 |
|
(message-pop-to-buffer (message-buffer-name "Resend" to)) |
1263 |
|
(insert-buffer-substring cur) |
1264 |
|
(message-narrow-to-head-1) |
1265 |
|
;; Gnus will generate a new one when sending. |
1266 |
|
(message-remove-header "Message-ID") |
1267 |
|
(message-remove-header message-ignored-resent-headers t) |
1268 |
|
;; Remove unwanted headers. |
1269 |
|
(goto-char (point-max)) |
1270 |
|
(insert mail-header-separator) |
1271 |
|
(goto-char (point-min)) |
1272 |
|
(when (re-search-forward "^To:\\|^Newsgroups:" nil 'move) |
1273 |
|
(forward-char 1)) |
1274 |
|
(widen))))) |
1275 |
|
|
1276 |
(defun gnus-summary-post-forward (&optional arg) |
(defun gnus-summary-post-forward (&optional arg) |
1277 |
"Forward the current article to a newsgroup. |
"Forward the current article to a newsgroup. |
1332 |
(when (gnus-y-or-n-p "Send this complaint? ") |
(when (gnus-y-or-n-p "Send this complaint? ") |
1333 |
(message-send-and-exit))))))) |
(message-send-and-exit))))))) |
1334 |
|
|
|
(defun gnus-summary-mail-other-window () |
|
|
"Compose mail in other window." |
|
|
(interactive) |
|
|
(gnus-setup-message 'message |
|
|
(message-mail))) |
|
|
|
|
1335 |
(defun gnus-mail-parse-comma-list () |
(defun gnus-mail-parse-comma-list () |
1336 |
(let (accumulated |
(let (accumulated |
1337 |
beg) |
beg) |
1366 |
;; This mail group doesn't have a `to-list', so we add one |
;; This mail group doesn't have a `to-list', so we add one |
1367 |
;; here. Magic! |
;; here. Magic! |
1368 |
(when (gnus-y-or-n-p |
(when (gnus-y-or-n-p |
1369 |
(format "Do you want to add this as `to-list': %s " to-address)) |
(format "Do you want to add this as `to-list': %s? " to-address)) |
1370 |
(gnus-group-add-parameter group (cons 'to-list to-address)))))) |
(gnus-group-add-parameter group (cons 'to-list to-address)))))) |
1371 |
|
|
1372 |
(defun gnus-put-message () |
(defun gnus-put-message () |
1375 |
(let ((reply gnus-article-reply) |
(let ((reply gnus-article-reply) |
1376 |
(winconf gnus-prev-winconf) |
(winconf gnus-prev-winconf) |
1377 |
(group gnus-newsgroup-name)) |
(group gnus-newsgroup-name)) |
1378 |
|
(unless (and group |
1379 |
|
(not (gnus-group-read-only-p group))) |
1380 |
|
(setq group (read-string "Put in group: " nil (gnus-writable-groups)))) |
1381 |
|
|
|
(or (and group (not (gnus-group-read-only-p group))) |
|
|
(setq group (read-string "Put in group: " nil |
|
|
(gnus-writable-groups)))) |
|
1382 |
(when (gnus-gethash group gnus-newsrc-hashtb) |
(when (gnus-gethash group gnus-newsrc-hashtb) |
1383 |
(error "No such group: %s" group)) |
(error "No such group: %s" group)) |
|
|
|
1384 |
(save-excursion |
(save-excursion |
1385 |
(save-restriction |
(save-restriction |
1386 |
(widen) |
(widen) |
1387 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
1388 |
(let (gnus-deletable-headers) |
(let ((gnus-deletable-headers nil)) |
1389 |
(if (message-news-p) |
(message-generate-headers |
1390 |
(message-generate-headers message-required-news-headers) |
(if (message-news-p) |
1391 |
(message-generate-headers message-required-mail-headers))) |
message-required-news-headers |
1392 |
|
message-required-mail-headers))) |
1393 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1394 |
(insert "Gcc: " group "\n") |
(if (string-match " " group) |
1395 |
|
(insert "Gcc: \"" group "\"\n") |
1396 |
|
(insert "Gcc: " group "\n")) |
1397 |
(widen))) |
(widen))) |
|
|
|
1398 |
(gnus-inews-do-gcc) |
(gnus-inews-do-gcc) |
1399 |
|
(when (and (get-buffer gnus-group-buffer) |
1400 |
(when (get-buffer gnus-group-buffer) |
(gnus-buffer-exists-p (car-safe reply)) |
1401 |
(when (gnus-buffer-exists-p (car-safe reply)) |
(cdr reply)) |
1402 |
(set-buffer (car reply)) |
(set-buffer (car reply)) |
1403 |
(and (cdr reply) |
(gnus-summary-mark-article-as-replied (cdr reply))) |
1404 |
(gnus-summary-mark-article-as-replied |
(when winconf |
1405 |
(cdr reply)))) |
(set-window-configuration winconf)))) |
|
(when winconf |
|
|
(set-window-configuration winconf))))) |
|
1406 |
|
|
1407 |
(defun gnus-article-mail (yank) |
(defun gnus-article-mail (yank) |
1408 |
"Send a reply to the address near point. |
"Send a reply to the address near point. |
1413 |
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) |
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) |
1414 |
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) |
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) |
1415 |
(when address |
(when address |
1416 |
(message-reply address) |
(gnus-msg-mail address) |
1417 |
(when yank |
(when yank |
1418 |
(gnus-inews-yank-articles (list (cdr gnus-article-current))))))) |
(gnus-inews-yank-articles (list (cdr gnus-article-current))))))) |
1419 |
|
|
1448 |
(let (text) |
(let (text) |
1449 |
(save-excursion |
(save-excursion |
1450 |
(set-buffer (gnus-get-buffer-create " *gnus environment info*")) |
(set-buffer (gnus-get-buffer-create " *gnus environment info*")) |
1451 |
|
(erase-buffer) |
1452 |
(gnus-debug) |
(gnus-debug) |
1453 |
(setq text (buffer-string))) |
(setq text (buffer-string))) |
1454 |
(insert "<#part type=application/x-emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>")) |
(insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>")) |
1455 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1456 |
(search-forward "Subject: " nil t) |
(search-forward "Subject: " nil t) |
1457 |
(message ""))) |
(message ""))) |
1466 |
(list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t) |
(list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t) |
1467 |
current-prefix-arg)) |
current-prefix-arg)) |
1468 |
(gnus-summary-iterate n |
(gnus-summary-iterate n |
1469 |
(let ((gnus-display-mime-function nil) |
(let ((gnus-inhibit-treatment t)) |
|
(gnus-inhibit-treatment t)) |
|
1470 |
(gnus-summary-select-article)) |
(gnus-summary-select-article)) |
1471 |
(save-excursion |
(save-excursion |
1472 |
(set-buffer buffer) |
(set-buffer buffer) |
1476 |
"Attempts to go through the Gnus source file and report what variables have been changed. |
"Attempts to go through the Gnus source file and report what variables have been changed. |
1477 |
The source file has to be in the Emacs load path." |
The source file has to be in the Emacs load path." |
1478 |
(interactive) |
(interactive) |
1479 |
(let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el" |
(let ((files gnus-debug-files) |
|
"gnus-art.el" "gnus-start.el" "gnus-async.el" |
|
|
"gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el" |
|
|
"nnmail.el" "message.el")) |
|
1480 |
(point (point)) |
(point (point)) |
1481 |
file expr olist sym) |
file expr olist sym) |
1482 |
(gnus-message 4 "Please wait while we snoop your variables...") |
(gnus-message 4 "Please wait while we snoop your variables...") |
1499 |
(and (or (eq (car expr) 'defvar) |
(and (or (eq (car expr) 'defvar) |
1500 |
(eq (car expr) 'defcustom)) |
(eq (car expr) 'defcustom)) |
1501 |
(stringp (nth 3 expr)) |
(stringp (nth 3 expr)) |
1502 |
|
(not (memq (nth 1 expr) gnus-debug-exclude-variables)) |
1503 |
(or (not (boundp (nth 1 expr))) |
(or (not (boundp (nth 1 expr))) |
1504 |
(not (equal (eval (nth 2 expr)) |
(not (equal (eval (nth 2 expr)) |
1505 |
(symbol-value (nth 1 expr))))) |
(symbol-value (nth 1 expr))))) |
1509 |
(insert "------------------ Environment follows ------------------\n\n")) |
(insert "------------------ Environment follows ------------------\n\n")) |
1510 |
(while olist |
(while olist |
1511 |
(if (boundp (car olist)) |
(if (boundp (car olist)) |
1512 |
(condition-case () |
(ignore-errors |
1513 |
(pp `(setq ,(car olist) |
(pp `(setq ,(car olist) |
1514 |
,(if (or (consp (setq sym (symbol-value (car olist)))) |
,(if (or (consp (setq sym (symbol-value (car olist)))) |
1515 |
(and (symbolp sym) |
(and (symbolp sym) |
1516 |
(not (or (eq sym nil) |
(not (or (eq sym nil) |
1517 |
(eq sym t))))) |
(eq sym t))))) |
1518 |
(list 'quote (symbol-value (car olist))) |
(list 'quote (symbol-value (car olist))) |
1519 |
(symbol-value (car olist)))) |
(symbol-value (car olist)))) |
1520 |
(current-buffer)) |
(current-buffer))) |
|
(error |
|
|
(format "(setq %s 'whatever)\n" (car olist)))) |
|
1521 |
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) |
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) |
1522 |
(setq olist (cdr olist))) |
(setq olist (cdr olist))) |
1523 |
(insert "\n\n") |
(insert "\n\n") |
1533 |
|
|
1534 |
(defun gnus-summary-resend-bounced-mail (&optional fetch) |
(defun gnus-summary-resend-bounced-mail (&optional fetch) |
1535 |
"Re-mail the current message. |
"Re-mail the current message. |
1536 |
This only makes sense if the current message is a bounce message than |
This only makes sense if the current message is a bounce message that |
1537 |
contains some mail you have written which has been bounced back to |
contains some mail you have written which has been bounced back to |
1538 |
you. |
you. |
1539 |
If FETCH, try to fetch the article that this is a reply to, if indeed |
If FETCH, try to fetch the article that this is a reply to, if indeed |
1553 |
;;; Gcc handling. |
;;; Gcc handling. |
1554 |
|
|
1555 |
(defun gnus-inews-group-method (group) |
(defun gnus-inews-group-method (group) |
1556 |
(cond ((and (null (gnus-get-info group)) |
(cond |
1557 |
(eq (car gnus-message-archive-method) |
;; If the group doesn't exist, we assume |
1558 |
(car |
;; it's an archive group... |
1559 |
(gnus-server-to-method |
((and (null (gnus-get-info group)) |
1560 |
(gnus-group-method group))))) |
(eq (car (gnus-server-to-method gnus-message-archive-method)) |
1561 |
;; If the group doesn't exist, we assume |
(car (gnus-server-to-method (gnus-group-method group))))) |
1562 |
;; it's an archive group... |
gnus-message-archive-method) |
1563 |
gnus-message-archive-method) |
;; Use the method. |
1564 |
;; Use the method. |
((gnus-info-method (gnus-get-info group)) |
1565 |
((gnus-info-method (gnus-get-info group)) |
(gnus-info-method (gnus-get-info group))) |
1566 |
(gnus-info-method (gnus-get-info group))) |
;; Find the method. |
1567 |
;; Find the method. |
(t (gnus-server-to-method (gnus-group-method group))))) |
|
(t (gnus-group-method group)))) |
|
1568 |
|
|
1569 |
;; Do Gcc handling, which copied the message over to some group. |
;; Do Gcc handling, which copied the message over to some group. |
1570 |
(defun gnus-inews-do-gcc (&optional gcc) |
(defun gnus-inews-do-gcc (&optional gcc) |
1571 |
(interactive) |
(interactive) |
1572 |
(when (gnus-alive-p) |
(save-excursion |
1573 |
(save-excursion |
(save-restriction |
1574 |
(save-restriction |
(message-narrow-to-headers) |
1575 |
(message-narrow-to-headers) |
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) |
1576 |
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) |
(cur (current-buffer)) |
1577 |
(cur (current-buffer)) |
groups group method group-art |
1578 |
groups group method) |
mml-externalize-attachments) |
1579 |
(when gcc |
(when gcc |
1580 |
(message-remove-header "gcc") |
(message-remove-header "gcc") |
1581 |
(widen) |
(widen) |
1582 |
(setq groups (message-unquote-tokens |
(setq groups (message-unquote-tokens |
1583 |
(message-tokenize-header gcc " ,"))) |
(message-tokenize-header gcc " ,"))) |
1584 |
;; Copy the article over to some group(s). |
;; Copy the article over to some group(s). |
1585 |
(while (setq group (pop groups)) |
(while (setq group (pop groups)) |
1586 |
(gnus-check-server |
(unless (gnus-check-server |
1587 |
(setq method (gnus-inews-group-method group))) |
(setq method (gnus-inews-group-method group))) |
1588 |
(unless (gnus-request-group group t method) |
(error "Can't open server %s" (if (stringp method) method |
1589 |
(gnus-request-create-group group method)) |
(car method)))) |
1590 |
(save-excursion |
(unless (gnus-request-group group nil method) |
1591 |
(nnheader-set-temp-buffer " *acc*") |
(gnus-request-create-group group method)) |
1592 |
(insert-buffer-substring cur) |
(setq mml-externalize-attachments |
1593 |
(message-encode-message-body) |
(if (stringp gnus-gcc-externalize-attachments) |
1594 |
(save-restriction |
(string-match gnus-gcc-externalize-attachments group) |
1595 |
(message-narrow-to-headers) |
gnus-gcc-externalize-attachments)) |
1596 |
(let ((mail-parse-charset message-default-charset) |
(save-excursion |
1597 |
(rfc2047-header-encoding-alist |
(nnheader-set-temp-buffer " *acc*") |
1598 |
(cons '("Newsgroups" . default) |
(insert-buffer-substring cur) |
1599 |
rfc2047-header-encoding-alist))) |
(message-encode-message-body) |
1600 |
(mail-encode-encoded-word-buffer))) |
(save-restriction |
1601 |
(goto-char (point-min)) |
(message-narrow-to-headers) |
1602 |
(when (re-search-forward |
(let* ((mail-parse-charset message-default-charset) |
1603 |
(concat "^" (regexp-quote mail-header-separator) "$") |
(newsgroups-field (save-restriction |
1604 |
nil t) |
(message-narrow-to-headers-or-head) |
1605 |
(replace-match "" t t )) |
(message-fetch-field "Newsgroups"))) |
1606 |
(unless (gnus-request-accept-article group method t t) |
(followup-field (save-restriction |
1607 |
(gnus-message 1 "Couldn't store article in group %s: %s" |
(message-narrow-to-headers-or-head) |
1608 |
group (gnus-status-message method)) |
(message-fetch-field "Followup-To"))) |
1609 |
(sit-for 2)) |
;; BUG: We really need to get the charset for |
1610 |
(kill-buffer (current-buffer)))))))))) |
;; each name in the Newsgroups and Followup-To |
1611 |
|
;; lines to allow crossposting between group |
1612 |
|
;; namess with incompatible character sets. |
1613 |
|
;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08. |
1614 |
|
(group-field-charset |
1615 |
|
(gnus-group-name-charset |
1616 |
|
method (or newsgroups-field ""))) |
1617 |
|
(followup-field-charset |
1618 |
|
(gnus-group-name-charset |
1619 |
|
method (or followup-field ""))) |
1620 |
|
(rfc2047-header-encoding-alist |
1621 |
|
(append |
1622 |
|
(when group-field-charset |
1623 |
|
(list (cons "Newsgroups" group-field-charset))) |
1624 |
|
(when followup-field-charset |
1625 |
|
(list (cons "Followup-To" followup-field-charset))) |
1626 |
|
rfc2047-header-encoding-alist))) |
1627 |
|
(mail-encode-encoded-word-buffer))) |
1628 |
|
(goto-char (point-min)) |
1629 |
|
(when (re-search-forward |
1630 |
|
(concat "^" (regexp-quote mail-header-separator) "$") |
1631 |
|
nil t) |
1632 |
|
(replace-match "" t t )) |
1633 |
|
(unless (setq group-art |
1634 |
|
(gnus-request-accept-article group method t t)) |
1635 |
|
(gnus-message 1 "Couldn't store article in group %s: %s" |
1636 |
|
group (gnus-status-message method)) |
1637 |
|
(sit-for 2)) |
1638 |
|
(when (and group-art |
1639 |
|
;; FIXME: Should gcc-mark-as-read work when |
1640 |
|
;; Gnus is not running? |
1641 |
|
(gnus-alive-p) |
1642 |
|
(or gnus-gcc-mark-as-read |
1643 |
|
(and |
1644 |
|
(boundp 'gnus-inews-mark-gcc-as-read) |
1645 |
|
(symbol-value 'gnus-inews-mark-gcc-as-read)))) |
1646 |
|
(gnus-group-mark-article-read group (cdr group-art))) |
1647 |
|
(kill-buffer (current-buffer))))))))) |
1648 |
|
|
1649 |
(defun gnus-inews-insert-gcc () |
(defun gnus-inews-insert-gcc () |
1650 |
"Insert Gcc headers based on `gnus-outgoing-message-group'." |
"Insert Gcc headers based on `gnus-outgoing-message-group'." |
1653 |
(message-narrow-to-headers) |
(message-narrow-to-headers) |
1654 |
(let* ((group gnus-outgoing-message-group) |
(let* ((group gnus-outgoing-message-group) |
1655 |
(gcc (cond |
(gcc (cond |
1656 |
((gnus-functionp group) |
((functionp group) |
1657 |
(funcall group)) |
(funcall group)) |
1658 |
((or (stringp group) (list group)) |
((or (stringp group) (list group)) |
1659 |
group)))) |
group)))) |
1660 |
(when gcc |
(when gcc |
1661 |
(insert "Gcc: " |
(insert "Gcc: " |
1662 |
(if (stringp gcc) gcc |
(if (stringp gcc) |
1663 |
(mapconcat 'identity gcc " ")) |
(if (string-match " " gcc) |
1664 |
|
(concat "\"" gcc "\"") |
1665 |
|
gcc) |
1666 |
|
(mapconcat (lambda (group) |
1667 |
|
(if (string-match " " group) |
1668 |
|
(concat "\"" group "\"") |
1669 |
|
group)) |
1670 |
|
gcc " ")) |
1671 |
"\n")))))) |
"\n")))))) |
1672 |
|
|
1673 |
(defun gnus-inews-insert-archive-gcc (&optional group) |
(defun gnus-inews-insert-archive-gcc (&optional group) |
1694 |
((and (listp var) (stringp (car var))) |
((and (listp var) (stringp (car var))) |
1695 |
;; A list of groups. |
;; A list of groups. |
1696 |
var) |
var) |
1697 |
((gnus-functionp var) |
((functionp var) |
1698 |
;; A function. |
;; A function. |
1699 |
(funcall var group)) |
(funcall var group)) |
1700 |
(t |
(t |
1707 |
;; Regexp. |
;; Regexp. |
1708 |
(when (string-match (caar var) group) |
(when (string-match (caar var) group) |
1709 |
(cdar var))) |
(cdar var))) |
1710 |
((gnus-functionp (car var)) |
((functionp (car var)) |
1711 |
;; Function. |
;; Function. |
1712 |
(funcall (car var) group)) |
(funcall (car var) group)) |
1713 |
(t |
(t |
1728 |
(progn |
(progn |
1729 |
(insert |
(insert |
1730 |
(if (stringp gcc-self-val) |
(if (stringp gcc-self-val) |
1731 |
gcc-self-val |
(if (string-match " " gcc-self-val) |
1732 |
group)) |
(concat "\"" gcc-self-val "\"") |
1733 |
|
gcc-self-val) |
1734 |
|
;; In nndoc groups, we use the parent group name |
1735 |
|
;; instead of the current group. |
1736 |
|
(let ((group (or (gnus-group-find-parameter |
1737 |
|
gnus-newsgroup-name 'parent-group) |
1738 |
|
group))) |
1739 |
|
(if (string-match " " group) |
1740 |
|
(concat "\"" group "\"") |
1741 |
|
group)))) |
1742 |
(if (not (eq gcc-self-val 'none)) |
(if (not (eq gcc-self-val 'none)) |
1743 |
(insert "\n") |
(insert "\n") |
1744 |
(progn |
(gnus-delete-line))) |
|
(beginning-of-line) |
|
|
(kill-line)))) |
|
1745 |
;; Use the list of groups. |
;; Use the list of groups. |
1746 |
(while (setq name (pop groups)) |
(while (setq name (pop groups)) |
1747 |
(insert (if (string-match ":" name) |
(let ((str (if (string-match ":" name) |
1748 |
name |
name |
1749 |
(gnus-group-prefixed-name |
(gnus-group-prefixed-name |
1750 |
name gnus-message-archive-method))) |
name gnus-message-archive-method)))) |
1751 |
|
(insert (if (string-match " " str) |
1752 |
|
(concat "\"" str "\"") |
1753 |
|
str))) |
1754 |
(when groups |
(when groups |
1755 |
(insert " "))) |
(insert " "))) |
1756 |
(insert "\n"))))))) |
(insert "\n"))))))) |
1757 |
|
|
1758 |
|
(defun gnus-mailing-list-followup-to () |
1759 |
|
"Look at the headers in the current buffer and return a Mail-Followup-To address." |
1760 |
|
(let ((x-been-there (gnus-fetch-original-field "x-beenthere")) |
1761 |
|
(list-post (gnus-fetch-original-field "list-post"))) |
1762 |
|
(when (and list-post |
1763 |
|
(string-match "mailto:\\([^>]+\\)" list-post)) |
1764 |
|
(setq list-post (match-string 1 list-post))) |
1765 |
|
(or list-post |
1766 |
|
x-been-there))) |
1767 |
|
|
1768 |
;;; Posting styles. |
;;; Posting styles. |
1769 |
|
|
1770 |
(defun gnus-configure-posting-styles () |
(defun gnus-configure-posting-styles (&optional group-name) |
1771 |
"Configure posting styles according to `gnus-posting-styles'." |
"Configure posting styles according to `gnus-posting-styles'." |
1772 |
(unless gnus-inhibit-posting-styles |
(unless gnus-inhibit-posting-styles |
1773 |
(let ((group (or gnus-newsgroup-name "")) |
(let ((group (or group-name gnus-newsgroup-name "")) |
1774 |
(styles gnus-posting-styles) |
(styles gnus-posting-styles) |
1775 |
style match variable attribute value v results |
style match attribute value v results |
1776 |
filep name address element) |
filep name address element) |
1777 |
;; If the group has a posting-style parameter, add it at the end with a |
;; If the group has a posting-style parameter, add it at the end with a |
1778 |
;; regexp matching everything, to be sure it takes precedence over all |
;; regexp matching everything, to be sure it takes precedence over all |
1790 |
;; Regexp string match on the group name. |
;; Regexp string match on the group name. |
1791 |
(string-match match group)) |
(string-match match group)) |
1792 |
((eq match 'header) |
((eq match 'header) |
1793 |
(let ((header (message-fetch-field (pop style)))) |
;; Obsolete format of header match. |
1794 |
(and header |
(and (gnus-buffer-live-p gnus-article-copy) |
1795 |
(string-match (pop style) header)))) |
(with-current-buffer gnus-article-copy |
1796 |
|
(let ((header (message-fetch-field (pop style)))) |
1797 |
|
(and header |
1798 |
|
(string-match (pop style) header)))))) |
1799 |
((or (symbolp match) |
((or (symbolp match) |
1800 |
(gnus-functionp match)) |
(functionp match)) |
1801 |
(cond |
(cond |
1802 |
((gnus-functionp match) |
((functionp match) |
1803 |
;; Function to be called. |
;; Function to be called. |
1804 |
(funcall match)) |
(funcall match)) |
1805 |
((boundp match) |
((boundp match) |
1806 |
;; Variable to be checked. |
;; Variable to be checked. |
1807 |
(symbol-value match)))) |
(symbol-value match)))) |
1808 |
((listp match) |
((listp match) |
1809 |
;; This is a form to be evaled. |
(cond |
1810 |
(eval match))) |
((eq (car match) 'header) |
1811 |
|
;; New format of header match. |
1812 |
|
(and (gnus-buffer-live-p gnus-article-copy) |
1813 |
|
(with-current-buffer gnus-article-copy |
1814 |
|
(let ((header (message-fetch-field (nth 1 match)))) |
1815 |
|
(and header |
1816 |
|
(string-match (nth 2 match) header)))))) |
1817 |
|
(t |
1818 |
|
;; This is a form to be evaled. |
1819 |
|
(eval match))))) |
1820 |
;; We have a match, so we set the variables. |
;; We have a match, so we set the variables. |
1821 |
(dolist (attribute style) |
(dolist (attribute style) |
1822 |
(setq element (pop attribute) |
(setq element (pop attribute) |
|
variable nil |
|
1823 |
filep nil) |
filep nil) |
1824 |
(setq value |
(setq value |
1825 |
(cond |
(cond |
1836 |
((stringp value) |
((stringp value) |
1837 |
value) |
value) |
1838 |
((or (symbolp value) |
((or (symbolp value) |
1839 |
(gnus-functionp value)) |
(functionp value)) |
1840 |
(cond ((gnus-functionp value) |
(cond ((functionp value) |
1841 |
(funcall value)) |
(funcall value)) |
1842 |
((boundp value) |
((boundp value) |
1843 |
(symbol-value value)))) |
(symbol-value value)))) |
1844 |
((listp value) |
((listp value) |
1845 |
(eval value)))) |
(eval value)))) |
1846 |
;; Translate obsolescent value. |
;; Translate obsolescent value. |
1847 |
(when (eq element 'signature-file) |
(cond |
1848 |
|
((eq element 'signature-file) |
1849 |
(setq element 'signature |
(setq element 'signature |
1850 |
filep t)) |
filep t)) |
1851 |
|
((eq element 'x-face-file) |
1852 |
|
(setq element 'x-face |
1853 |
|
filep t))) |
1854 |
;; Get the contents of file elems. |
;; Get the contents of file elems. |
1855 |
(when (and filep v) |
(when (and filep v) |
1856 |
(setq v (with-temp-buffer |
(setq v (with-temp-buffer |
1857 |
(insert-file-contents v) |
(insert-file-contents v) |
1858 |
|
(goto-char (point-max)) |
1859 |
|
(while (bolp) |
1860 |
|
(delete-char -1)) |
1861 |
(buffer-string)))) |
(buffer-string)))) |
1862 |
(setq results (delq (assoc element results) results)) |
(setq results (delq (assoc element results) results)) |
1863 |
(push (cons element v) results)))) |
(push (cons element v) results)))) |
1865 |
(setq name (assq 'name results) |
(setq name (assq 'name results) |
1866 |
address (assq 'address results)) |
address (assq 'address results)) |
1867 |
(setq results (delq name (delq address results))) |
(setq results (delq name (delq address results))) |
1868 |
(make-local-variable 'message-setup-hook) |
(gnus-make-local-hook 'message-setup-hook) |
1869 |
|
(setq results (sort results (lambda (x y) |
1870 |
|
(string-lessp (car x) (car y))))) |
1871 |
(dolist (result results) |
(dolist (result results) |
1872 |
(add-hook 'message-setup-hook |
(add-hook 'message-setup-hook |
1873 |
(cond |
(cond |
1899 |
(let ((value ,(cdr result))) |
(let ((value ,(cdr result))) |
1900 |
(when value |
(when value |
1901 |
(message-goto-eoh) |
(message-goto-eoh) |
1902 |
(insert ,header ": " value "\n")))))))))) |
(insert ,header ": " value) |
1903 |
|
(unless (bolp) |
1904 |
|
(insert "\n"))))))))) |
1905 |
|
nil 'local)) |
1906 |
(when (or name address) |
(when (or name address) |
1907 |
(add-hook 'message-setup-hook |
(add-hook 'message-setup-hook |
1908 |
`(lambda () |
`(lambda () |
1909 |
(set (make-local-variable 'user-mail-address) |
(set (make-local-variable 'user-mail-address) |
1910 |
,(or (cdr address) user-mail-address)) |
,(or (cdr address) user-mail-address)) |
1911 |
(let ((user-full-name ,(or (cdr name) (user-full-name))) |
(let ((user-full-name ,(or (cdr name) (user-full-name))) |
1912 |
(user-mail-address |
(user-mail-address |
1913 |
,(or (cdr address) user-mail-address))) |
,(or (cdr address) user-mail-address))) |
1914 |
(save-excursion |
(save-excursion |
1915 |
(message-remove-header "From") |
(message-remove-header "From") |
1916 |
(message-goto-eoh) |
(message-goto-eoh) |
1917 |
(insert "From: " (message-make-from) "\n"))))))))) |
(insert "From: " (message-make-from) "\n")))) |
1918 |
|
nil 'local))))) |
1919 |
|
|
1920 |
;;; Allow redefinition of functions. |
;;; Allow redefinition of functions. |
1921 |
|
|