;;; gnus-msg.el --- mail and post interface for Semi-gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
:group 'gnus-message
:type 'string)
-(defcustom gnus-message-setup-hook '(gnus-maybe-setup-default-charset)
+(defcustom gnus-message-setup-hook nil
"Hook run after setting up a message buffer."
:group 'gnus-message
:type 'hook)
"*Alist of styles to use when posting.
See Info node `(gnus)Posting Styles'."
:group 'gnus-message
+ :link '(custom-manual "(gnus)Posting Styles")
:type '(repeat (cons (choice (regexp)
(variable)
(list (const header)
(const x-face-file)
(const name)
(const body)
+ (const import)
+ (symbol)
+ (string :tag "Header"))
+ (choice (string)
+ (function)
+ (variable)
+ (sexp)))))))
+
+(defcustom gnus-named-posting-styles nil
+ "Alist mapping names to the user-defined posting styles."
+ :group 'gnus-message
+ :type '(repeat (cons string
+ (repeat (list
+ (choice (const signature)
+ (const signature-file)
+ (const organization)
+ (const address)
+ (const x-face-file)
+ (const name)
+ (const body)
+ (const import)
(symbol)
(string :tag "Header"))
(choice (string)
"Should local-file attachments be included as external parts in Gcc copies?
If it is `all', attach files as external parts;
if a regexp and matches the Gcc group name, attach files as external parts;
-If nil, attach files as normal parts."
+if nil, attach files as normal parts."
:version "21.1"
:group 'gnus-message
:type '(choice (const nil :tag "None")
(const all :tag "Any")
(string :tag "Regexp")))
-(defcustom gnus-group-posting-charset-alist
- '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
- ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
- (message-this-is-mail nil nil)
- (message-this-is-news nil t))
- "Alist of regexps and permitted unencoded charsets for posting.
+(gnus-define-group-parameter
+ posting-charset-alist
+ :type list
+ :function-document
+ "Return the permitted unencoded charsets for posting of GROUP."
+ :variable gnus-group-posting-charset-alist
+ :variable-default
+ '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
+ ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
+ (message-this-is-mail nil nil)
+ (message-this-is-news nil t))
+ :variable-document
+ "Alist of regexps and permitted unencoded charsets for posting.
Each element of the alist has the form (TEST HEADER BODY-LIST), where
TEST is either a regular expression matching the newsgroup header or a
variable to query,
Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
- :type '(repeat (list :tag "Permitted unencoded charsets"
- (choice :tag "Where"
- (regexp :tag "Group")
- (const :tag "Mail message"
- :value message-this-is-mail)
- (const :tag "News article"
- :value message-this-is-news))
- (choice :tag "Header"
- (const :tag "None" nil)
- (symbol :tag "Charset"))
- (choice :tag "Body"
- (const :tag "Any" :value t)
- (const :tag "None" :value nil)
- (repeat :tag "Charsets"
- (symbol :tag "Charset")))))
- :group 'gnus-charset)
+ :variable-group gnus-charset
+ :variable-type
+ '(repeat (list :tag "Permitted unencoded charsets"
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message" :value message-this-is-mail)
+ (const :tag "News article" :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
+ :parameter-type '(choice :tag "Permitted unencoded charsets"
+ :value nil
+ (repeat (symbol)))
+ :parameter-document "\
+List of charsets that are permitted to be unencoded.")
(defcustom gnus-debug-files
'("gnus.el" "gnus-sum.el" "gnus-group.el"
(defcustom gnus-message-replysign
nil
- "Automatically sign replys to signed messages.
+ "Automatically sign replies to signed messages.
See also the `mml-default-sign-method' variable."
:group 'gnus-message
:type 'boolean)
(defcustom gnus-message-replyencrypt
nil
- "Automatically encrypt replys to encrypted messages.
+ "Automatically encrypt replies to encrypted messages.
See also the `mml-default-encrypt-method' variable."
:group 'gnus-message
:type 'boolean)
(defcustom gnus-confirm-mail-reply-to-news nil
"If non-nil, Gnus requests confirmation when replying to news.
This is done because new users often reply by mistake when reading
-news."
+news.
+This can also be a function receiving the group name as the only
+parameter which should return non-nil iff a confirmation is needed, or
+a regexp, in which case a confirmation is asked for iff the group name
+matches the regexp."
+ :group 'gnus-message
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Yes" t)
+ (regexp :tag "Iff group matches regexp")
+ (function :tag "Iff function evaluates to non-nil")))
+
+(defcustom gnus-confirm-treat-mail-like-news
+ nil
+ "If non-nil, Gnus will treat mail like news with regard to confirmation
+when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable
+for fine-tuning this.
+If nil, Gnus will never ask for confirmation if replying to mail."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-summary-resend-default-address t
+ "If non-nil, Gnus tries to suggest a default address to resend to.
+If nil, the address field will always be empty after invoking
+`gnus-summary-resend-message'."
:group 'gnus-message
:type 'boolean)
+(defcustom gnus-user-agent 'full
+ "Which information should be exposed in the User-Agent header.
+
+It can be one of the symbols `full' \(show full information, i.e. Emacs and
+Gnus version and system configuration\), `emacs-gnus' \(show only Emacs and
+Gnus version\), `emacs-gnus-type' \(same as `emacs-gnus' plus system type\),
+`gnus' \(show only Gnus version\) or a custom string. If you set it to a
+string, be sure to use a valid format, see RFC 2616."
+ :group 'gnus-message
+ :type '(choice (item :tag "Show full info" full)
+ (item :tag "Show Gnus and Emacs versions and system type"
+ emacs-gnus-type)
+ (item :tag "Show Gnus and Emacs versions" emacs-gnus)
+ (item :tag "Show only Gnus version" gnus)
+ (string :tag "Other")))
+
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
"Inhibit the use of posting styles.")
+(defvar gnus-article-yanked-articles nil)
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
(defvar gnus-check-before-posting nil)
"om" gnus-summary-mail-forward
"op" gnus-summary-post-forward
"Om" gnus-summary-digest-mail-forward
- "Op" gnus-summary-digest-post-forward)
+ "Op" gnus-summary-digest-post-forward
+ "P" gnus-summary-execute-command-with-posting-style)
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
;;; Internal functions.
+(defun gnus-inews-make-draft ()
+ `(lambda ()
+ (gnus-inews-make-draft-meta-information
+ ,gnus-newsgroup-name ',gnus-article-reply)))
+
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
+ (yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,buffer (buffer-name (current-buffer)))
(,article gnus-article-reply)
+ (,yanked gnus-article-yanked-articles)
(,group gnus-newsgroup-name)
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
(add-hook 'message-mode-hook
(lambda ()
(gnus-configure-posting-styles ,group)))
+ (gnus-pull ',(intern gnus-draft-meta-information-header)
+ message-required-headers)
+ (when (and ,group
+ (not (string= ,group "")))
+ (push (cons
+ (intern gnus-draft-meta-information-header)
+ (gnus-inews-make-draft))
+ message-required-headers))
(unwind-protect
(progn
,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config)
- (gnus-inews-insert-draft-meta-information ,group ,article)
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+ ,yanked)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(set (make-local-variable 'gnus-newsgroup-name) ,group)
+ (gnus-maybe-setup-default-charset)
(gnus-run-hooks 'gnus-message-setup-hook))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
(run-hooks 'post-command-hook)
(set-buffer-modified-p nil))))
-(defun gnus-inews-insert-draft-meta-information (group article)
- (save-excursion
- (when (and group
- (not (string= group ""))
- (not (message-fetch-field gnus-draft-meta-information-header)))
- (goto-char (point-min))
- (insert gnus-draft-meta-information-header ": (\"" group "\" "
- (if article (number-to-string
- (if (listp article)
- (car article)
- article)) "\"\"")
- ")\n"))))
+(defun gnus-inews-make-draft-meta-information (group article)
+ (concat "(\"" group "\" "
+ (if article (number-to-string
+ (if (listp article)
+ (car article)
+ article)) "\"\"")
+ ")"))
;;;###autoload
(defun gnus-msg-mail (&optional to subject other-headers continue
(symbol-value (car elem))))
(throw 'found (cons (cadr elem) (caddr elem)))))))))
-(defun gnus-inews-add-send-actions (winconf buffer article &optional config)
+(defun gnus-inews-add-send-actions (winconf buffer article
+ &optional config yanked)
(make-local-hook 'message-sent-hook)
(add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
'gnus-inews-do-gcc) nil t)
(when (not message-use-multi-frames)
(message-add-action
`(set-window-configuration ,winconf) 'exit 'postpone 'kill))
- (message-add-action
- `(when (gnus-buffer-exists-p ,buffer)
- (save-excursion
- (set-buffer ,buffer)
- ,(when article
- (if (eq config 'forward)
- `(gnus-summary-mark-article-as-forwarded ',article)
- `(gnus-summary-mark-article-as-replied ',article)))))
- 'send))
+ (let ((to-be-marked (cond
+ (yanked yanked)
+ (article (if (listp article) article (list article)))
+ (t nil))))
+ (message-add-action
+ `(when (gnus-buffer-exists-p ,buffer)
+ (save-excursion
+ (set-buffer ,buffer)
+ ,(when to-be-marked
+ (if (eq config 'forward)
+ `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
+ `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
+ 'send)))
(put 'gnus-setup-message 'lisp-indent-function 1)
(put 'gnus-setup-message 'edebug-form-spec '(form body))
""))
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy))
- (gnus-post-news 'post gnus-newsgroup-name)))
+ (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
+ (string= gnus-newsgroup-name ""))))
(defun gnus-summary-mail-other-window (&optional arg)
"Start composing a mail in another window.
;; Send a followup.
(gnus-post-news nil gnus-newsgroup-name
headers gnus-article-buffer
- yank nil force-news)))
+ yank nil force-news)
+ (gnus-summary-handle-replysign)))
(defun gnus-summary-followup-with-original (n &optional force-news)
"Compose a followup to an article and include the original article."
(with-current-buffer gnus-article-copy
(save-restriction
(nnheader-narrow-to-headers)
- (ietf-drums-unfold-fws)
- (nnheader-parse-head t)))))
+ (nnheader-parse-naked-head)))))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
(interactive)
- (let ((article (gnus-summary-article-number))
- (gnus-message-setup-hook '(gnus-maybe-setup-default-charset)))
+ (let ((article (gnus-summary-article-number)))
(gnus-setup-message 'reply-yank
(gnus-summary-select-article t)
(set-buffer gnus-original-article-buffer)
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
;; this buffer should be passed to all mail/news reply/post routines.
(setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
+ (save-excursion
+ (set-buffer gnus-article-copy)
+ (set-buffer-multibyte t))
(let ((article-buffer (or article-buffer gnus-article-buffer))
end beg)
(if (not (and (get-buffer article-buffer)
;; Copy over the (displayed) article buffer, delete
;; hidden text and remove text properties.
(widen)
- (let ((inhibit-read-only t))
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
- (set-buffer gnus-article-copy)
- (when yank-string
- (message-goto-body)
- (delete-region (point) (point-max))
- (insert yank-string))
- ;; Encode bitmap smileys to ordinary text.
- ;; Possibly, the original text might be restored.
- (static-unless (featurep 'xemacs)
- (when (featurep 'smiley-mule)
- (smiley-encode-buffer)))
- (gnus-article-delete-text-of-type 'annotation)
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next)
- (gnus-remove-text-with-property 'gnus-decoration)
- (gnus-remove-text-with-property 'x-face-mule-bitmap-image)
- (insert
- (prog1
- (static-if (featurep 'xemacs)
- ;; Revome smiley extents for (possibly) XEmacs 21.1.
- (format "%s"
- (buffer-substring-no-properties (point-min)
- (point-max)))
- (buffer-substring-no-properties (point-min) (point-max)))
- (erase-buffer))))
+ (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-buffer gnus-article-copy)
+ ;; There's invisible and intangible text in T-gnus. Especially,
+ ;; if there is a boundary line (X-Boundary: ------------------),
+ ;; in the end of a header, it will cause a serious problem.
+ (add-text-properties (point-min) (point-max)
+ '(invisible nil intangible nil))
+ (when yank-string
+ (message-goto-body)
+ (delete-region (point) (point-max))
+ (insert yank-string))
+ ;; Encode bitmap smileys to ordinary text.
+ ;; Possibly, the original text might be restored.
+ (static-unless (featurep 'xemacs)
+ (when (featurep 'smiley-mule)
+ (smiley-encode-buffer)))
+ (gnus-article-delete-text-of-type 'annotation)
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)
+ (gnus-remove-text-with-property 'gnus-decoration)
+ (gnus-remove-text-with-property 'x-face-mule-bitmap-image)
+ (insert
+ (prog1
+ (static-if (featurep 'xemacs)
+ ;; Revome smiley extents for (possibly) XEmacs 21.1.
+ (format "%s"
+ (buffer-substring-no-properties (point-min)
+ (point-max)))
+ (buffer-substring-no-properties (point-min) (point-max)))
+ (erase-buffer)))
;; Find the original headers.
(set-buffer gnus-original-article-buffer)
(goto-char (point-min))
(while (looking-at message-unix-mail-delimiter)
(forward-line 1))
- (setq beg (point)
- end (or (message-goto-body) beg))
+ (let ((mail-header-separator ""))
+ (setq beg (point)
+ end (or (message-goto-body)
+ ;; There may be just a header.
+ (point-max))))
;; Delete the headers from the displayed articles.
(set-buffer gnus-article-copy)
- (delete-region (goto-char (point-min))
- (or (message-goto-body) (point-max)))
+ (let ((mail-header-separator ""))
+ (delete-region (goto-char (point-min))
+ (or (message-goto-body) (point-max))))
;; Insert the original article headers.
(insert-buffer-substring gnus-original-article-buffer beg end)
;; Decode charsets.
(when article-buffer
(gnus-copy-article-buffer))
(let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
(add-to-list gnus-add-to-list))
(gnus-setup-message (cond (yank 'reply-yank)
(article-buffer 'reply)
(gnus-inews-yank-articles yank))))))
(defun gnus-msg-treat-broken-reply-to (&optional force)
- "Remove the Reply-to header iff broken-reply-to."
+ "Remove the Reply-to header if broken-reply-to."
(when (or force
(gnus-group-find-parameter
gnus-newsgroup-name 'broken-reply-to))
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
;; Allow user to require confirmation before replying by mail to the
- ;; author of a news article.
- (when (or (not (gnus-news-group-p gnus-newsgroup-name))
- (not gnus-confirm-mail-reply-to-news)
+ ;; author of a news article (or mail message).
+ (when (or
+ (not (or (gnus-news-group-p gnus-newsgroup-name)
+ gnus-confirm-treat-mail-like-news))
+ (not (cond ((stringp gnus-confirm-mail-reply-to-news)
+ (string-match gnus-confirm-mail-reply-to-news
+ gnus-newsgroup-name))
+ ((functionp gnus-confirm-mail-reply-to-news)
+ (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
+ (t gnus-confirm-mail-reply-to-news)))
(y-or-n-p "Really reply by mail to article author? "))
(let* ((article
(if (listp (car yank))
(caar yank)
(car yank)))
(gnus-article-reply (or article (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
(headers ""))
;; Stripping headers should be specified with mail-yank-ignored-headers.
(when yank
(message-reply nil wide)
(when yank
(gnus-inews-yank-articles yank))
-;; (when (or gnus-message-replysign gnus-message-replyencrypt)
-;; (let (signed encrypted)
-;; (save-excursion
-;; (set-buffer gnus-article-buffer)
-;; (setq signed (memq 'signed gnus-article-wash-types))
-;; (setq encrypted (memq 'encrypted gnus-article-wash-types)))
-;; (cond ((and gnus-message-replysign signed)
-;; (mml-secure-message mml-default-sign-method 'sign))
-;; ((and gnus-message-replyencrypt encrypted)
-;; (mml-secure-message mml-default-encrypt-method
-;; (if gnus-message-replysignencrypted
-;; 'signencrypt
-;; 'encrypt))))))
- ))))
+ (gnus-summary-handle-replysign)))))
+
+(defun gnus-summary-handle-replysign ()
+ "Check the various replysign variables and take action accordingly."
+ (when nil;;(or gnus-message-replysign gnus-message-replyencrypt)
+ (let (signed encrypted)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (setq signed (memq 'signed gnus-article-wash-types))
+ (setq encrypted (memq 'encrypted gnus-article-wash-types)))
+ (cond ((and gnus-message-replyencrypt encrypted)
+ (mml-secure-message mml-default-encrypt-method
+ (if gnus-message-replysignencrypted
+ 'signencrypt
+ 'encrypt)))
+ ((and gnus-message-replysign signed)
+ (mml-secure-message mml-default-sign-method 'sign))))))
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
Note that this function definition for T-gnus is totally different
from the original Gnus."
(interactive "P")
- (if (null (cdr (gnus-summary-work-articles nil)))
+ (if (cdr (gnus-summary-work-articles nil))
+ ;; Process marks are given.
+ (gnus-summary-digest-mail-forward nil post)
+ ;; No process marks.
+ (let* ((gnus-article-reply (gnus-summary-article-number))
+ (gnus-article-yanked-articles (list gnus-article-reply))
+ charset
+ (message-included-forward-headers
+ (if full-headers "" message-included-forward-headers)))
(gnus-setup-message 'forward
(gnus-summary-select-article)
- (let ((charset default-mime-charset))
- (set-buffer gnus-original-article-buffer)
- (make-local-variable 'default-mime-charset)
- (setq default-mime-charset charset))
- (let ((message-included-forward-headers
- (if full-headers "" message-included-forward-headers)))
- (message-forward post)))
- (gnus-summary-digest-mail-forward nil post)))
+ (setq charset default-mime-charset)
+ (set-buffer gnus-original-article-buffer)
+ (make-local-variable 'default-mime-charset)
+ (setq default-mime-charset charset)
+ (message-forward post)))))
(defun gnus-summary-digest-mail-forward (&optional n post)
"Digests and forwards all articles in this series.
forward those articles instead.
Optional POST will use news to forward instead of mail."
(interactive "P")
- (let ((articles (gnus-summary-work-articles n))
- (topics "Topics:\n")
- subject article frame)
+ (let* ((articles (gnus-summary-work-articles n))
+ (gnus-article-yanked-articles (copy-sequence articles))
+ (topics "Topics:\n")
+ subject article frame)
(when (car articles)
(gnus-setup-message 'forward
(gnus-summary-select-article)
(interactive
(list (message-read-from-minibuffer
"Resend message(s) to: "
- (when (gnus-buffer-live-p gnus-original-article-buffer)
+ (when (and gnus-summary-resend-default-address
+ (gnus-buffer-live-p gnus-original-article-buffer))
;; If some other article is currently selected, the
;; initial-contents is wrong. Whatever, it is just the
;; initial-contents.
message-required-news-headers
message-required-mail-headers)))
(goto-char (point-max))
- (insert "Gcc: " group "\n")
+ (if (string-match " " group)
+ (insert "Gcc: \"" group "\"\n")
+ (insert "Gcc: " group "\n"))
(widen)))
(gnus-inews-do-gcc)
(when (and (get-buffer gnus-group-buffer)
(insert ";----------------- Environment follows ------------------\n\n"))
(while olist
(if (boundp (car olist))
- (condition-case ()
- (pp `(setq ,(car olist)
- ,(if (or (consp (setq sym (symbol-value (car olist))))
- (and (symbolp sym)
- (not (or (eq sym nil)
- (eq sym t)))))
- (list 'quote (symbol-value (car olist)))
- (symbol-value (car olist))))
- (current-buffer))
- (error
- (format "(setq %s 'whatever)\n" (car olist))))
+ (ignore-errors
+ (pp `(setq ,(car olist)
+ ,(if (or (consp (setq sym (symbol-value (car olist))))
+ (and (symbolp sym)
+ (not (or (eq sym nil)
+ (eq sym t)))))
+ (list 'quote (symbol-value (car olist)))
+ (symbol-value (car olist))))
+ (current-buffer)))
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
;; Remove any control chars - they seem to cause trouble for some
(interactive "P")
(gnus-summary-select-article t)
(set-buffer gnus-original-article-buffer)
- (let ((gnus-message-setup-hook '(gnus-maybe-setup-default-charset)))
- (gnus-setup-message 'compose-bounce
- (let* ((references (mail-fetch-field "references"))
- (parent (and references (gnus-parent-id references))))
- (message-bounce)
- ;; If there are references, we fetch the article we answered to.
- (and fetch parent
- (gnus-summary-refer-article parent)
- (gnus-summary-show-all-headers))))))
+ (gnus-setup-message 'compose-bounce
+ (let* ((references (mail-fetch-field "references"))
+ (parent (and references (gnus-parent-id references))))
+ (message-bounce)
+ ;; If there are references, we fetch the article we answered to.
+ (and fetch parent
+ (gnus-summary-refer-article parent)
+ (gnus-summary-show-all-headers)))))
;;; Gcc handling.
group (gnus-status-message method))
(sit-for 2))
(when (and group-art
+ ;; FIXME: Should gcc-mark-as-read work when
+ ;; Gnus is not running?
+ (gnus-alive-p)
(or gnus-gcc-mark-as-read
gnus-inews-mark-gcc-as-read))
(gnus-group-mark-article-read group (cdr group-art)))
group))))
(when gcc
(insert "Gcc: "
- (if (stringp gcc) gcc
- (mapconcat 'identity gcc " "))
+ (if (stringp gcc)
+ (if (string-match " " gcc)
+ (concat "\"" gcc "\"")
+ gcc)
+ (mapconcat (lambda (group)
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group))
+ gcc " "))
"\n"))))))
(defun gnus-inews-insert-archive-gcc (&optional group)
(progn
(insert
(if (stringp gcc-self-val)
- gcc-self-val
- group))
+ (if (string-match " " gcc-self-val)
+ (concat "\"" gcc-self-val "\"")
+ gcc-self-val)
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group)))
(if (not (eq gcc-self-val 'none))
(insert "\n")
(progn
(kill-line))))
;; Use the list of groups.
(while (setq name (pop groups))
- (insert (if (string-match ":" name)
- name
- (gnus-group-prefixed-name
- name gnus-message-archive-method)))
+ (let ((str (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method))))
+ (insert (if (string-match " " str)
+ (concat "\"" str "\"")
+ str)))
(when groups
(insert " ")))
(insert "\n")))))))
+(defun gnus-mailing-list-followup-to ()
+ "Look at the headers in the current buffer and return a Mail-Followup-To address."
+ (let ((x-been-there (gnus-fetch-original-field "x-beenthere"))
+ (list-post (gnus-fetch-original-field "list-post")))
+ (when (and list-post
+ (string-match "mailto:\\([^>]+\\)" list-post))
+ (setq list-post (match-string 1 list-post)))
+ (or list-post
+ x-been-there)))
+
;;; Posting styles.
(defun gnus-configure-posting-styles (&optional group-name)
(unless gnus-inhibit-posting-styles
(let ((group (or group-name gnus-newsgroup-name ""))
(styles gnus-posting-styles)
- style match variable attribute value v results
- filep name address element)
+ style match attribute results
+ name address)
;; If the group has a posting-style parameter, add it at the end with a
;; regexp matching everything, to be sure it takes precedence over all
;; the others.
;; This is a form to be evaled.
(eval match)))))
;; We have a match, so we set the variables.
+ (setq style (gnus-configure-posting-style style nil))
(dolist (attribute style)
- (setq element (pop attribute)
- variable nil
- filep nil)
- (setq value
- (cond
- ((eq (car attribute) ':file)
- (setq filep t)
- (cadr attribute))
- ((eq (car attribute) :value)
- (cadr attribute))
- (t
- (car attribute))))
- ;; We get the value.
- (setq v
- (cond
- ((stringp value)
- value)
- ((or (symbolp value)
- (gnus-functionp value))
- (cond ((gnus-functionp value)
- (funcall value))
- ((boundp value)
- (symbol-value value))))
- ((listp value)
- (eval value))))
- ;; Translate obsolescent value.
- (cond
- ((eq element 'signature-file)
- (setq element 'signature
- filep t))
- ((eq element 'x-face-file)
- (setq element 'x-face
- filep t)))
- ;; Get the contents of file elems.
- (when (and filep v)
- (setq v (with-temp-buffer
- (insert-file-contents v)
- (goto-char (point-max))
- (while (bolp)
- (delete-char -1))
- (buffer-string))))
- (setq results (delq (assoc element results) results))
- (push (cons element v) results))))
+ (setq results (delq (assoc (car attribute) results) results))
+ (push attribute results))))
;; Now we have all the styles, so we insert them.
(setq name (assq 'name results)
address (assq 'address results))
(setq results (delq name (delq address results)))
;; make-local-hook is not obsolete in Emacs 20 or XEmacs.
(make-local-hook 'message-setup-hook)
+ (setq results (sort results (lambda (x y)
+ (string-lessp (car x) (car y)))))
(dolist (result results)
(add-hook 'message-setup-hook
(cond
(let ((value ,(cdr result)))
(when value
(message-goto-eoh)
- (insert ,header ": " value "\n"))))))))
+ (insert ,header ": " value)
+ (unless (bolp)
+ (insert "\n")))))))))
nil 'local))
(when (or name address)
(add-hook 'message-setup-hook
(insert "From: " (message-make-from) "\n"))))
nil 'local)))))
+;; splitted from gnus-configure-posting-styles to allow recursive traversal.
+(defun gnus-configure-posting-style (style stack)
+ "Parse one posting style STYLE and returns the value as an alist."
+ (let (results element variable filep value v)
+ (dolist (attribute style)
+ (setq element (pop attribute)
+ variable nil
+ filep nil)
+ (setq value
+ (cond
+ ((eq (car attribute) ':file)
+ (setq filep t)
+ (cadr attribute))
+ ((eq (car attribute) :value)
+ (cadr attribute))
+ (t
+ (car attribute))))
+ ;; We get the value.
+ (setq v
+ (cond
+ ((stringp value)
+ value)
+ ((or (symbolp value)
+ (gnus-functionp value))
+ (cond ((gnus-functionp value)
+ (funcall value))
+ ((boundp value)
+ (symbol-value value))))
+ ((listp value)
+ (eval value))))
+ ;; Translate obsolescent value.
+ (cond
+ ((eq element 'signature-file)
+ (setq element 'signature
+ filep t))
+ ((eq element 'x-face-file)
+ (setq element 'x-face
+ filep t)))
+ ;; Get the contents of file elems.
+ (when (and filep v)
+ (setq v (with-temp-buffer
+ (insert-file-contents v)
+ (goto-char (point-max))
+ (while (bolp)
+ (delete-char -1))
+ (buffer-string))))
+ (if (eq element 'import)
+ (progn
+ (if (member v stack)
+ (error "Circular import of \"%s\"" v))
+ (setq results
+ (nconc (nreverse (gnus-configure-posting-style
+ (cdr (assoc v gnus-named-posting-styles))
+ (cons v stack)))
+ results)))
+ (push (cons element v) results)))
+ (nreverse results)))
+
+(defun gnus-summary-execute-command-with-posting-style (style command)
+ "Temporarily select a posting-style named STYLE and execute COMMAND."
+ (interactive
+ (let ((style (completing-read "Posting style: "
+ gnus-named-posting-styles nil t)))
+ (list style
+ (key-binding
+ (read-key-sequence
+ (format "Command to execute with %s: " style))))))
+ (let ((gnus-posting-styles (list (list ".*" (list 'import style)))))
+ (call-interactively command)))
+
;;; @ for MIME Edit mode
;;;
projects / elisp / gnus.git- / blobdiff