;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(const all :tag "Any")
(string :tag "Regexp")))
+(defcustom gnus-gcc-self-resent-messages 'no-gcc-self
+ "Like `gcc-self' group parameter, only for unmodified resent messages.
+Applied to messages sent by `gnus-summary-resend-message'. Non-nil
+value of this variable takes precedence over any existing Gcc header.
+
+If this is `none', no Gcc copy will be made. If this is t, messages
+resent will be Gcc'd to the current group. If this is a string, it
+specifies a group to which resent messages will be Gcc'd. If this is
+nil, Gcc will be done according to existing Gcc header(s), if any.
+If this is `no-gcc-self', resent messages will be Gcc'd to groups that
+existing Gcc header specifies, except for the current group."
+ :version "24.2"
+ :group 'gnus-message
+ :type '(choice (const none) (const t) string (const nil)
+ (const no-gcc-self)))
+
(gnus-define-group-parameter
posting-charset-alist
:type list
(defcustom gnus-message-replyencrypt t
"Automatically encrypt replies to encrypted messages.
See also the `mml-default-encrypt-method' variable."
- :version "22.1"
+ :version "24.1"
:group 'gnus-message
:type 'boolean)
:group 'gnus-message
:type 'boolean)
+(defcustom gnus-gcc-pre-body-encode-hook nil
+ "A hook called before encoding the body of the Gcc copy of a message.
+The current buffer (when the hook is run) contains the message
+including the message header. Changes made to the message will
+only affect the Gcc copy, but not the original message."
+ :group 'gnus-message
+ :type 'hook)
+
+(defcustom gnus-gcc-post-body-encode-hook nil
+ "A hook called after encoding the body of the Gcc copy of a message.
+The current buffer (when the hook is run) contains the message
+including the message header. Changes made to the message will
+only affect the Gcc copy, but not the original message."
+ :group 'gnus-message
+ :type 'hook)
+
(autoload 'gnus-message-citation-mode "gnus-cite" nil t)
;;; Internal variables.
"r" gnus-summary-reply
"y" gnus-summary-yank-message
"R" gnus-summary-reply-with-original
+ "L" gnus-summary-reply-to-list-with-original
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
"v" gnus-summary-very-wide-reply
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
+ (winconf-name (make-symbol "gnus-setup-message-winconf-name"))
(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))
+ (,winconf-name gnus-current-window-configuration)
(,buffer (buffer-name (current-buffer)))
(,article gnus-article-reply)
(,yanked gnus-article-yanked-articles)
(progn
,@forms)
(gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
- ,yanked)
+ ,yanked ,winconf-name)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
;;;###autoload
(defun gnus-msg-mail (&optional to subject other-headers continue
- switch-action yank-action send-actions)
+ switch-action yank-action send-actions
+ return-action)
"Start editing a mail message to be sent.
Like `message-mail', but with Gnus paraphernalia, particularly the
-Gcc: header for archiving purposes."
+Gcc: header for archiving purposes.
+If Gnus isn't running, a plain `message-mail' setup is used
+instead."
(interactive)
- (let ((buf (current-buffer))
- mail-buf)
- (gnus-setup-message 'message
+ (if (not (gnus-alive-p))
(message-mail to subject other-headers continue
- nil yank-action send-actions))
- (when switch-action
- (setq mail-buf (current-buffer))
- (switch-to-buffer buf)
- (apply switch-action mail-buf nil)))
- ;; COMPOSEFUNC should return t if succeed. Undocumented ???
- t)
+ nil yank-action send-actions return-action)
+ (let ((buf (current-buffer))
+ mail-buf)
+ (gnus-setup-message 'message
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions return-action))
+ (when switch-action
+ (setq mail-buf (current-buffer))
+ (switch-to-buffer buf)
+ (apply switch-action mail-buf nil))
+ ;; COMPOSEFUNC should return t if succeed. Undocumented ???
+ t)))
;;;###autoload
(defun gnus-button-mailto (address)
(throw 'found (cons (cadr elem) (caddr elem)))))))))
(defun gnus-inews-add-send-actions (winconf buffer article
- &optional config yanked)
+ &optional config yanked
+ winconf-name)
(gnus-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)
`(lambda (&optional arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
(message-add-action
- `(when (gnus-buffer-exists-p ,buffer)
- (set-window-configuration ,winconf))
+ `(progn
+ (setq gnus-current-window-configuration ',winconf-name)
+ (when (gnus-buffer-exists-p ,buffer)
+ (set-window-configuration ,winconf)))
'exit 'postpone 'kill)
(let ((to-be-marked (cond
(yanked
(if (= 1 (prefix-numeric-value arg))
(gnus-group-completing-read "Newsgroup" nil
(gnus-read-active-file-p))
- (gnus-group-group-name))
+ (or (gnus-group-group-name) ""))
""))
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy))
(interactive (gnus-interactive "P\ny"))
(let ((message-post-method
`(lambda (arg)
- (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))))
+ (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
+ (user-mail-address user-mail-address))
(dolist (article (gnus-summary-work-articles n))
(when (gnus-summary-select-article t nil nil article)
+ ;; Pretend that we're doing a followup so that we can see what
+ ;; the From header would have ended up being.
+ (save-window-excursion
+ (save-excursion
+ (gnus-summary-followup nil)
+ (let ((from (message-fetch-field "from")))
+ (when from
+ (setq user-mail-address
+ (car (mail-header-parse-address from)))))
+ (kill-buffer (current-buffer))))
+ ;; Now cancel the article using the From header we got.
(when (gnus-eval-in-buffer-window gnus-original-article-buffer
(message-cancel-news))
(gnus-summary-mark-as-read article gnus-canceled-mark)
(gnus-summary-work-articles 1))))
;; Allow user to require confirmation before replying by mail to the
;; author of a news article (or mail message).
- (when (or
- (not (or (gnus-news-group-p gnus-newsgroup-name)
+ (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))
+ (funcall gnus-confirm-mail-reply-to-news
+ gnus-newsgroup-name))
(t gnus-confirm-mail-reply-to-news)))
(if (or wide very-wide)
t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very
(interactive "P")
(gnus-summary-reply (gnus-summary-work-articles n) wide))
+(defun gnus-summary-reply-to-list-with-original (n &optional wide)
+ "Start composing a reply mail to the current message.
+The reply goes only to the mailing list.
+The original article will be yanked."
+ (interactive "P")
+ (let ((message-reply-to-function
+ (lambda nil
+ `((To . ,(gnus-mailing-list-followup-to))))))
+ (gnus-summary-reply (gnus-summary-work-articles n) wide)))
+
(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
"Like `gnus-summary-reply' except removing reply-to field.
If prefix argument YANK is non-nil, the original article is yanked
if ARG is 4, forward message directly inline;
otherwise, use flipped `message-forward-as-mime'.
If POST, post instead of mail.
-For the `inline' alternatives, also see the variable
+For the \"inline\" alternatives, also see the variable
`message-forward-ignored-headers'."
(interactive "P")
(if (cdr (gnus-summary-work-articles nil))
;; Process marks are given.
- (gnus-uu-digest-mail-forward arg post)
+ (gnus-uu-digest-mail-forward nil post)
;; No process marks.
(let ((message-forward-as-mime message-forward-as-mime)
(message-forward-show-mml message-forward-show-mml))
(set-buffer gnus-original-article-buffer)
(message-forward post)))))))
+(defun gnus-summary-resend-message-insert-gcc ()
+ "Insert Gcc header according to `gnus-gcc-self-resent-messages'."
+ (gnus-inews-insert-gcc)
+ (let ((gcc (mapcar
+ (lambda (group)
+ (mm-encode-coding-string
+ group
+ (gnus-group-name-charset (gnus-inews-group-method group)
+ group)))
+ (message-unquote-tokens
+ (message-tokenize-header (mail-fetch-field "gcc" nil t)
+ " ,"))))
+ (self (with-current-buffer gnus-summary-buffer
+ gnus-gcc-self-resent-messages)))
+ (message-remove-header "gcc")
+ (when gcc
+ (goto-char (point-max))
+ (cond ((eq self 'none))
+ ((eq self t)
+ (insert "Gcc: \"" gnus-newsgroup-name "\"\n"))
+ ((stringp self)
+ (insert "Gcc: "
+ (mm-encode-coding-string
+ (if (string-match " " self)
+ (concat "\"" self "\"")
+ self)
+ (gnus-group-name-charset (gnus-inews-group-method self)
+ self))
+ "\n"))
+ ((null self)
+ (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
+ ((eq self 'no-gcc-self)
+ (when (setq gcc (delete
+ gnus-newsgroup-name
+ (delete (concat "\"" gnus-newsgroup-name "\"")
+ gcc)))
+ (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
+
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(interactive
(with-current-buffer gnus-original-article-buffer
(nnmail-fetch-field "to"))))
current-prefix-arg))
- (dolist (article (gnus-summary-work-articles n))
- (gnus-summary-select-article nil nil nil article)
- (with-current-buffer gnus-original-article-buffer
- (let ((gnus-gcc-externalize-attachments nil))
- (message-resend address)))
- (gnus-summary-mark-article-as-forwarded article)))
+ (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
+ (message-sent-hook (copy-sequence message-sent-hook)))
+ ;; `gnus-summary-resend-message-insert-gcc' must run last.
+ (add-hook 'message-header-setup-hook
+ 'gnus-summary-resend-message-insert-gcc t)
+ (add-hook 'message-sent-hook
+ `(lambda ()
+ (let ((rfc2047-encode-encoded-words nil))
+ ,(if gnus-agent
+ '(gnus-agent-possibly-do-gcc)
+ '(gnus-inews-do-gcc)))))
+ (dolist (article (gnus-summary-work-articles n))
+ (gnus-summary-select-article nil nil nil article)
+ (with-current-buffer gnus-original-article-buffer
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address)))
+ (gnus-summary-mark-article-as-forwarded article))))
;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
(defun gnus-summary-resend-message-edit ()
(error "Gnus has been shut down"))
(gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
(unless (message-mail-user-agent)
- (delete-other-windows)
(when gnus-bug-create-help-buffer
(switch-to-buffer "*Gnus Help Bug*")
(erase-buffer)
(goto-char (point-min)))
(message-pop-to-buffer "*Gnus Bug*"))
(let ((message-this-is-mail t))
- (message-setup `((To . ,gnus-maintainer) (Subject . ""))))
+ (message-setup `((To . ,gnus-maintainer)
+ (Subject . "")
+ (X-Debbugs-Package
+ . ,(format "%s" gnus-bug-package))
+ (X-Debbugs-Version
+ . ,(format "%s" (gnus-continuum-version))))))
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
+ (message-goto-body)
+ (insert "\n\n\n\n\n")
(insert (gnus-version) "\n"
(emacs-version) "\n")
(when (and (boundp 'nntp-server-type)
(stringp nntp-server-type))
(insert nntp-server-type))
- (insert "\n\n\n\n\n")
- (let (text)
- (with-current-buffer (gnus-get-buffer-create " *gnus environment info*")
- (erase-buffer)
- (gnus-debug)
- (setq text (buffer-string)))
- (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
(with-current-buffer buffer
(message-yank-buffer gnus-article-buffer))))
-(defun gnus-debug ()
- "Attempts to go through the Gnus source file and report what variables have been changed.
-The source file has to be in the Emacs load path."
- (interactive)
- (let ((files gnus-debug-files)
- (point (point))
- file expr olist sym)
- (gnus-message 4 "Please wait while we snoop your variables...")
- (sit-for 0)
- ;; Go through all the files looking for non-default values for variables.
- (with-current-buffer (gnus-get-buffer-create " *gnus bug info*")
- (while files
- (erase-buffer)
- (when (and (setq file (locate-library (pop files)))
- (file-exists-p file))
- (insert-file-contents file)
- (goto-char (point-min))
- (if (not (re-search-forward "^;;* *Internal variables" nil t))
- (gnus-message 4 "Malformed sources in file %s" file)
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (while (setq expr (ignore-errors (read (current-buffer))))
- (ignore-errors
- (and (or (eq (car expr) 'defvar)
- (eq (car expr) 'defcustom))
- (stringp (nth 3 expr))
- (not (memq (nth 1 expr) gnus-debug-exclude-variables))
- (or (not (boundp (nth 1 expr)))
- (not (equal (eval (nth 2 expr))
- (symbol-value (nth 1 expr)))))
- (push (nth 1 expr) olist)))))))
- (kill-buffer (current-buffer)))
- (when (setq olist (nreverse olist))
- (insert "------------------ Environment follows ------------------\n\n"))
- (while olist
- (if (boundp (car olist))
- (ignore-errors
- (gnus-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))))))
- (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
- (setq olist (cdr olist)))
- (insert "\n\n")
- ;; Remove any control chars - they seem to cause trouble for some
- ;; mailers. (Byte-compiled output from the stuff above.)
- (goto-char point)
- (while (re-search-forward (mm-string-to-multibyte
- "[\000-\010\013-\037\200-\237]") nil t)
- (replace-match (format "\\%03o" (string-to-char (match-string 0)))
- t t))))
-
;;; Treatment of rejected articles.
;;; Bounced mail.
(message-narrow-to-headers)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
(cur (current-buffer))
- groups group method group-art
+ groups group method group-art options
mml-externalize-attachments)
(when gcc
(message-remove-header "gcc")
gnus-gcc-externalize-attachments))
(save-excursion
(nnheader-set-temp-buffer " *acc*")
+ (setq message-options (with-current-buffer cur message-options))
(insert-buffer-substring cur)
+ (run-hooks 'gnus-gcc-pre-body-encode-hook)
(message-encode-message-body)
+ (run-hooks 'gnus-gcc-post-body-encode-hook)
(save-restriction
(message-narrow-to-headers)
(let* ((mail-parse-charset message-default-charset)
;; BUG: We really need to get the charset for
;; each name in the Newsgroups and Followup-To
;; lines to allow crossposting between group
- ;; namess with incompatible character sets.
+ ;; names with incompatible character sets.
;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
(group-field-charset
(gnus-group-name-charset
(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
- (and
- (boundp 'gnus-inews-mark-gcc-as-read)
- (symbol-value 'gnus-inews-mark-gcc-as-read))))
- (gnus-group-mark-article-read group (cdr group-art)))
+ (gnus-alive-p))
+ (if (or gnus-gcc-mark-as-read
+ (and (boundp 'gnus-inews-mark-gcc-as-read)
+ (symbol-value 'gnus-inews-mark-gcc-as-read)))
+ (gnus-group-mark-article-read group (cdr group-art))
+ (with-current-buffer gnus-group-buffer
+ (let ((gnus-group-marked (list group))
+ (gnus-get-new-news-hook nil)
+ (inhibit-read-only t))
+ (gnus-group-get-new-news-this-group nil t)))))
+ (setq options message-options)
+ (with-current-buffer cur (setq message-options options))
(kill-buffer (current-buffer)))))))))
(defun gnus-inews-insert-gcc (&optional group)
(not
(setq result
(cond
- ((stringp (caar var))
+ ((and group
+ (stringp (caar var)))
;; Regexp.
(when (string-match (caar var) group)
(cdar var)))
- ((functionp (car var))
+ ((and group
+ (functionp (car var)))
;; Function.
(funcall (car var) group))
(t
"Configure posting styles according to `gnus-posting-styles'."
(unless gnus-inhibit-posting-styles
(let ((group (or group-name gnus-newsgroup-name ""))
- (styles gnus-posting-styles)
+ (styles (if (gnus-buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ gnus-posting-styles)
+ gnus-posting-styles))
style match attribute value v results
filep name address element)
;; If the group has a posting-style parameter, add it at the end with a
(and header
(string-match (nth 2 match) header)))))))
(t
- ;; This is a form to be evaled.
+ ;; This is a form to be evalled.
(eval match)))))
;; We have a match, so we set the variables.
(dolist (attribute style)
projects / gnus / blobdiff