(require 'rfc822)
(eval-and-compile
+ (autoload 'customize-save-variable "cus-edit") ;; for Mule 2.
(autoload 'sha1 "sha1-el")
(autoload 'gnus-find-method-for-group "gnus")
(autoload 'nnvirtual-find-group-art "nnvirtual")
- (autoload 'customize-save-variable "cus-edit")) ;; for Mule 2.
+ (autoload 'gnus-group-decoded-name "gnus-group"))
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
;;;###autoload
(defun message-change-subject (new-subject)
"Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
- ;; <URL:http://www.karlsruhe.org/rfc/son1036.txt>
- ;; <URL:http://www.karlsruhe.org/rfc/draft-ietf-usefor-article-09.txt>
- ;; But not mentioned in...
- ;; <URL:http://www.karlsruhe.org/rfc/draft-ietf-usefor-article-11.txt>
+ ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
(interactive
(list
(read-from-minibuffer "New subject: ")))
(easy-menu-define
message-mode-field-menu message-mode-map ""
`("Field"
- ["Fetch To" message-insert-to t]
- ["Fetch Newsgroups" message-insert-newsgroups t]
- "----"
["To" message-goto-to t]
["From" message-goto-from t]
["Subject" message-goto-subject t]
["Summary" message-goto-summary t]
["Keywords" message-goto-keywords t]
["Newsgroups" message-goto-newsgroups t]
+ ["Fetch Newsgroups" message-insert-newsgroups t]
["Followup-To" message-goto-followup-to t]
;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
["Crosspost / Followup-To..." message-cross-post-followup-to t]
["X-No-Archive:" message-add-archive-header t ]
"----"
;; (typical) mailing-lists stuff
+ ["Fetch To" message-insert-to
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert a To header that points to the author."))]
+ ["Fetch To and Cc" message-insert-wide-reply
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help
+ "Insert To and Cc headers as if you were doing a wide reply."))]
+ "----"
["Send to list only" message-to-list-only t]
["Mail-Followup-To" message-goto-mail-followup-to t]
["Mail-Reply-To" message-goto-mail-reply-to t]
(defun message-insert-to (&optional force)
"Insert a To header that points to the author of the article being replied to.
-If the original author requested not to be sent mail, the function signals
-an error.
-With the prefix argument FORCE, insert the header anyway."
+If the original author requested not to be sent mail, don't insert unless the
+prefix FORCE is given."
(interactive "P")
- (let ((co (message-fetch-reply-field "mail-copies-to")))
- (when (and (null force)
- co
- (or (equal (downcase co) "never")
- (equal (downcase co) "nobody")))
- (error "The user has requested not to have copies sent via mail")))
- (message-carefully-insert-headers
- (list (cons 'To
- (or (message-fetch-reply-field "mail-reply-to")
- (message-fetch-reply-field "reply-to")
- (message-fetch-reply-field "from")
- "")))))
+ (let* ((mct (message-fetch-reply-field "mail-copies-to"))
+ (dont (and mct (or (equal (downcase mct) "never")
+ (equal (downcase mct) "nobody"))))
+ (to (or (message-fetch-reply-field "mail-reply-to")
+ (message-fetch-reply-field "reply-to")
+ (message-fetch-reply-field "from"))))
+ (when (and dont to)
+ (gnus-message
+ 3
+ (if force
+ "Ignoring the user request not to have copies sent via mail"
+ "Complying with the user request not to have copies sent via mail")))
+ (when (and force (not to))
+ (error "No mail address in the article"))
+ (when (and to (or force (not dont)))
+ (message-carefully-insert-headers (list (cons 'To to))))))
(defun message-insert-wide-reply ()
"Insert To and Cc headers as if you were doing a wide reply."
(user-domain
(if (and user-mail
(string-match "@\\(.*\\)\\'" user-mail))
- (match-string 1 user-mail))))
+ (match-string 1 user-mail)))
+ (case-fold-search t))
(cond
((and message-user-fqdn
(stringp message-user-fqdn)
(defvar message-forward-decoded-p nil
"Non-nil means the original message is decoded.")
-(defun message-forward-subject-author-subject (subject)
+(defun message-forward-subject-name-subject (subject)
"Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
-Source is the sender, and if the original message was news, Source is
-the list of newsgroups is was posted to."
+Source is the name of the sender, and if the original message was
+news, Source is the list of newsgroups is was posted to."
(concat "["
- (let ((prefix (message-fetch-field "newsgroups")))
- (or prefix
- (and (setq prefix (message-fetch-field "from"))
- (nnheader-decode-from prefix))
- "(nowhere)"))
+ (let ((group (message-fetch-field "newsgroups"))
+ from)
+ (if group
+ (gnus-group-decoded-name group)
+ (or (and (setq from (message-fetch-field "from"))
+ (car (std11-extract-address-components
+ (nnheader-decode-from from))))
+ "(nowhere)")))
"] " subject))
-(defun message-forward-subject-name-subject (subject)
+(defun message-forward-subject-author-subject (subject)
"Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
-Source is the name of the sender, and if the original message was
-news, Source is the list of newsgroups is was posted to."
+Source is the sender, and if the original message was news, Source is
+the list of newsgroups is was posted to."
(concat "["
- (let ((prefix (message-fetch-field "newsgroups")))
- (or prefix
- (and (setq prefix (message-fetch-field "from"))
- (car (std11-extract-address-components
- (nnheader-decode-from prefix))))
- "(nowhere)"))
+ (let ((group (message-fetch-field "newsgroups"))
+ from)
+ (if group
+ (gnus-group-decoded-name group)
+ (if (setq from (message-fetch-field "from"))
+ (nnheader-decode-from from)
+ "(nowhere)")))
"] " subject))
(defun message-forward-subject-fwd (subject)
(insert
"\n-------------------- Start of forwarded message --------------------\n")
(let ((b (point)) e)
- (save-restriction
- (narrow-to-region (point) (point))
- (mml-insert-buffer forward-buffer)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (goto-char (point-max)))
+ (insert
+ (with-temp-buffer
+ (mm-disable-multibyte)
+ (insert
+ (with-current-buffer forward-buffer
+ (mm-with-unibyte-current-buffer (buffer-string))))
+ (mm-enable-multibyte)
+ (mime-to-mml)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (buffer-string)))
(setq e (point))
(insert
- "\n-------------------- End of forwarded message --------------------\n")))
+ "\n-------------------- End of forwarded message --------------------\n")
+ (when (and (not current-prefix-arg)
+ message-forward-ignored-headers)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (message-remove-header message-forward-ignored-headers t)))))
(defun message-forward-make-body-mime (forward-buffer)
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
projects / elisp / gnus.git- / blobdiff