;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2013 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.3"
+ :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
: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
+ :version "24.3"
+ :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
+ :version "24.3"
+ :type 'hook)
+
(autoload 'gnus-message-citation-mode "gnus-cite" nil t)
;;; Internal variables.
(gnus-inews-make-draft-meta-information
,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
+(autoload 'nnir-article-number "nnir" nil nil 'macro)
+(autoload 'nnir-article-group "nnir" nil nil 'macro)
+(autoload 'gnus-nnir-group-p "nnir")
+
+
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
`(let ((,winconf (current-window-configuration))
(,winconf-name gnus-current-window-configuration)
(,buffer (buffer-name (current-buffer)))
- (,article gnus-article-reply)
+ (,article (if (and (gnus-nnir-group-p gnus-newsgroup-name)
+ gnus-article-reply)
+ (nnir-article-number (or (car-safe gnus-article-reply)
+ gnus-article-reply))
+ gnus-article-reply))
(,yanked gnus-article-yanked-articles)
- (,group gnus-newsgroup-name)
+ (,group (if (and (gnus-nnir-group-p gnus-newsgroup-name)
+ gnus-article-reply)
+ (nnir-article-group (or (car-safe gnus-article-reply)
+ gnus-article-reply))
+ gnus-newsgroup-name))
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
(mbl mml-buffer-list)
(message-mode-hook (copy-sequence message-mode-hook)))
(setq mml-buffer-list nil)
- (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
+ (add-hook 'message-header-setup-hook (lambda ()
+ (gnus-inews-insert-gcc ,group)))
;; message-newsreader and message-mailer were formerly set in
;; gnus-inews-add-send-actions, but this is too late when
;; message-generate-headers-first is used. --ansel
;;;###autoload
(defun gnus-msg-mail (&optional to subject other-headers continue
- switch-action yank-action send-actions return-action)
+ 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
- (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)
+ (if (not (gnus-alive-p))
+ (progn
+ (message "Gnus not running; using plain Message mode")
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions return-action))
+ (let ((buf (current-buffer))
+ ;; Don't use posting styles corresponding to any existing group.
+ (gnus-newsgroup-name "")
+ 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)
(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)
(with-current-buffer article-buffer
(let ((gnus-newsgroup-charset (or gnus-article-charset
gnus-newsgroup-charset))
+ (inhibit-read-only t)
(gnus-newsgroup-ignored-charsets
(or gnus-article-ignored-charsets
gnus-newsgroup-ignored-charsets)))
(gnus-v
(when (memq 'gnus gnus-user-agent)
(concat "Gnus/"
- (prin1-to-string (gnus-continuum-version gnus-version) t)
+ (gnus-replace-in-string
+ (format "%1.8f" (gnus-continuum-version gnus-version))
+ "0+\\'" "")
" (" gnus-version ")")))
(emacs-v (gnus-emacs-version)))
(concat gnus-v (when (and gnus-v emacs-v) " ")
(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))
+ ;; Honor posting-style for `name' and `address' in Resent-From header.
+ (styles (gnus-group-find-parameter gnus-newsgroup-name
+ 'posting-style t))
+ (user-full-name user-full-name)
+ (user-mail-address user-mail-address)
+ tem)
+ (dolist (style styles)
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-decode-coding-string (cadr style) 'utf-8)))))
+ (dolist (style (if styles
+ (append gnus-posting-styles (list (cons ".*" styles)))
+ gnus-posting-styles))
+ (when (and (stringp (car style))
+ (string-match (pop style) gnus-newsgroup-name))
+ (when (setq tem (cadr (assq 'name style)))
+ (setq user-full-name tem))
+ (when (setq tem (cadr (assq 'address style)))
+ (setq user-mail-address tem))))
+ ;; `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 ()
(when (gnus-y-or-n-p "Send this complaint? ")
(message-send-and-exit))))))
-(defun gnus-mail-parse-comma-list ()
- (let (accumulated
- beg)
- (skip-chars-forward " ")
- (while (not (eobp))
- (setq beg (point))
- (skip-chars-forward "^,")
- (while (zerop
- (save-excursion
- (save-restriction
- (let ((i 0))
- (narrow-to-region beg (point))
- (goto-char beg)
- (logand (progn
- (while (search-forward "\"" nil t)
- (incf i))
- (if (zerop i) 2 i))
- 2)))))
- (skip-chars-forward ",")
- (skip-chars-forward "^,"))
- (skip-chars-backward " ")
- (push (buffer-substring beg (point))
- accumulated)
- (skip-chars-forward "^,")
- (skip-chars-forward ", "))
- accumulated))
-
(defun gnus-inews-add-to-address (group)
(let ((to-address (mail-fetch-field "to")))
(when (and to-address
(format "Do you want to add this as `to-list': %s? " to-address))
(gnus-group-add-parameter group (cons 'to-list to-address))))))
-(defun gnus-put-message ()
- "Put the current message in some group and return to Gnus."
- (interactive)
- (let ((reply gnus-article-reply)
- (winconf gnus-prev-winconf)
- (group gnus-newsgroup-name))
- (unless (and group
- (not (gnus-group-read-only-p group)))
- (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
-
- (when (gnus-group-entry group)
- (error "No such group: %s" group))
- (save-excursion
- (save-restriction
- (widen)
- (message-narrow-to-headers)
- (let ((gnus-deletable-headers nil))
- (message-generate-headers
- (if (message-news-p)
- message-required-news-headers
- message-required-mail-headers)))
- (goto-char (point-max))
- (if (string-match " " group)
- (insert "Gcc: \"" group "\"\n")
- (insert "Gcc: " group "\n"))
- (widen)))
- (gnus-inews-do-gcc)
- (when (and (get-buffer gnus-group-buffer)
- (gnus-buffer-exists-p (car-safe reply))
- (cdr reply))
- (set-buffer (car reply))
- (gnus-summary-mark-article-as-replied (cdr reply)))
- (when winconf
- (set-window-configuration winconf))))
-
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
If YANK is non-nil, include the original article."
(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)
(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)
(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)))))))))
(group (when group (gnus-group-decoded-name group)))
(var (or gnus-outgoing-message-group gnus-message-archive-group))
(gcc-self-val
- (and group (gnus-group-find-parameter group 'gcc-self)))
+ (and group (not (gnus-virtual-group-p group))
+ (gnus-group-find-parameter group 'gcc-self)))
result
(groups
(cond
((functionp var)
;; A function.
(funcall var group))
- (t
+ (group
;; An alist of regexps/functions/forms.
(while (and var
(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
(setq var (cdr var)))
result)))
name)
- (when (or groups gcc-self-val)
+ (when (and (or groups gcc-self-val)
+ (gnus-alive-p))
(when (stringp groups)
(setq groups (list groups)))
(save-excursion
(when gnus-newsgroup-name
(let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
(when tmp-style
+ (dolist (style tmp-style)
+ (when (stringp (cadr style))
+ (setcdr style (list (mm-decode-coding-string (cadr style)
+ 'utf-8)))))
(setq styles (append styles (list (cons ".*" tmp-style)))))))
;; Go through all styles and look for matches.
(dolist (style styles)
projects / gnus / blobdiff