;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(sexp :tag "Methods" ,gnus-select-method)))
(defcustom gnus-outgoing-message-group nil
- "*All outgoing messages will be put in this group.
+ "All outgoing messages will be put in this group.
If you want to store all your outgoing mail and articles in the group
\"nnml:archive\", you set this variable to that value. This variable
can also be a list of group names.
current newsgroup name and then returns a suitable group name (or list
of names)."
:group 'gnus-message
- :type '(choice (string :tag "Group")
- (function)))
+ :type '(choice (const nil)
+ (function)
+ (string :tag "Group")
+ (repeat :tag "List of groups" (string :tag "Group"))))
+
+(make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1")
(defcustom gnus-mailing-list-groups nil
"*If non-nil a regexp matching groups that are really mailing lists.
(defcustom gnus-message-setup-hook nil
"Hook run after setting up a message buffer."
:group 'gnus-message
+ :options '(message-remove-blank-cited-lines)
:type 'hook)
(defcustom gnus-bug-create-help-buffer t
(defcustom gnus-gcc-mark-as-read nil
"If non-nil, automatically mark Gcc articles as read."
- :version "21.1"
+ :version "22.1"
:group 'gnus-message
:type 'boolean)
(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
- 'gnus-gcc-mark-as-read)
+ 'gnus-gcc-mark-as-read "Emacs 22.1")
(defcustom gnus-gcc-externalize-attachments nil
"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."
- :version "21.1"
+ :version "22.1"
:group 'gnus-message
:type '(choice (const nil :tag "None")
(const all :tag "Any")
"gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
"mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
"Files whose variables will be reported in `gnus-bug'."
- :version "21.1"
+ :version "22.1"
:group 'gnus-message
:type '(repeat (string :tag "File")))
'(mm-mime-mule-charset-alist
nnmail-split-fancy message-minibuffer-local-map)
"Variables that should not be reported in `gnus-bug'."
- :version "21.1"
+ :version "22.1"
:group 'gnus-message
:type '(repeat (symbol :tag "Variable")))
'(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
"A list of back ends that are not used in \"real\" newsgroups.
This variable is used only when `gnus-post-method' is `current'."
- :version "21.3"
+ :version "22.1"
:group 'gnus-group-foreign
:type '(repeat (symbol :tag "Back end")))
:group 'gnus-message
:type 'boolean)
-(defcustom gnus-message-replyencrypt
- nil
+(defcustom gnus-message-replyencrypt t
"Automatically encrypt replies to encrypted messages.
See also the `mml-default-encrypt-method' variable."
+ :version "24.1"
:group 'gnus-message
:type 'boolean)
:group 'gnus-message
:type 'boolean)
-(defcustom gnus-confirm-mail-reply-to-news nil
+(defcustom gnus-confirm-mail-reply-to-news (and gnus-novice-user
+ (not gnus-expert-user))
"If non-nil, Gnus requests confirmation when replying to news.
This is done because new users often reply by mistake when reading
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
+parameter, which should return non-nil if a confirmation is needed; or
+a regexp, in which case a confirmation is asked for if the group name
matches the regexp."
+ :version "23.1" ;; No Gnus (default changed)
: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")))
+ (regexp :tag "If group matches regexp")
+ (function :tag "If function evaluates to non-nil")))
(defcustom gnus-confirm-treat-mail-like-news
nil
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."
+ :version "22.1"
:group 'gnus-message
:type 'boolean)
"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'."
+ :version "22.1"
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-highlight-citation
+ t ;; gnus-treat-highlight-citation ;; gnus-cite dependency
+ "Enable highlighting of different citation levels in message-mode."
+ :version "23.1" ;; No Gnus
+ :group 'gnus-cite
:group 'gnus-message
:type 'boolean)
+(autoload 'gnus-message-citation-mode "gnus-cite" nil t)
+
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
Thank you for your help in stamping out bugs.
")
-(eval-and-compile
- (autoload 'gnus-uu-post-news "gnus-uu" nil t))
+(autoload 'gnus-uu-post-news "gnus-uu" nil t)
\f
;;;
(defun gnus-inews-make-draft (articles)
`(lambda ()
(gnus-inews-make-draft-meta-information
- ,gnus-newsgroup-name ',articles)))
+ ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
(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 'gnus-inews-insert-archive-gcc)
+ ;; 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
+ (add-hook 'message-mode-hook
+ (lambda nil
+ (setq message-newsreader
+ (setq message-mailer (gnus-extended-version)))))
;; #### FIXME: for a reason that I did not manage to identify yet,
;; the variable `gnus-newsgroup-name' does not honor a dynamically
;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
;; There may be an old " *gnus article copy*" buffer.
(let (gnus-article-copy)
(gnus-configure-posting-styles ,group)))))
- (gnus-pull ',(intern gnus-draft-meta-information-header)
+ (gnus-alist-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 ,yanked))
+ (gnus-inews-make-draft (or ,yanked ,article)))
message-required-headers))
(unwind-protect
(progn
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(set (make-local-variable 'gnus-newsgroup-name) ,group)
+ ;; Enable highlighting of different citation levels
+ (when gnus-message-highlight-citation
+ (gnus-message-citation-mode 1))
(gnus-run-hooks 'gnus-message-setup-hook)
(if (eq major-mode 'message-mode)
(let ((mbl1 mml-buffer-list))
(defun gnus-inews-make-draft-meta-information (group articles)
(when (numberp articles)
(setq articles (list articles)))
- (concat "(\"" group "\" "
+ (concat "(\"" group "\""
(if articles
- (mapconcat
- (lambda (elem)
- (number-to-string
- (if (consp elem)
- (car elem)
- elem)))
- articles " ")
+ (concat " "
+ (mapconcat
+ (lambda (elem)
+ (number-to-string
+ (if (consp elem)
+ (car elem)
+ elem)))
+ articles " "))
"")
")"))
;;;###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."
mail-buf)
(gnus-setup-message 'message
(message-mail to subject other-headers continue
- nil yank-action send-actions))
+ nil yank-action send-actions return-action))
(when switch-action
(setq mail-buf (current-buffer))
(switch-to-buffer buf)
;; COMPOSEFUNC should return t if succeed. Undocumented ???
t)
-(defvar save-selected-window-window)
-
;;;###autoload
(defun gnus-button-mailto (address)
"Mail to ADDRESS."
(set-buffer (gnus-copy-article-buffer))
(gnus-setup-message 'message
- (message-reply address))
- (and (boundp 'save-selected-window-window)
- (not (window-live-p save-selected-window-window))
- (setq save-selected-window-window (selected-window))))
+ (message-reply address)))
;;;###autoload
(defun gnus-button-reply (&optional to-address wide)
"Like `message-reply'."
(interactive)
(gnus-setup-message 'message
- (message-reply to-address wide))
- (and (boundp 'save-selected-window-window)
- (not (window-live-p save-selected-window-window))
- (setq save-selected-window-window (selected-window))))
+ (message-reply to-address wide)))
;;;###autoload
(define-mail-user-agent 'gnus-user-agent
(gnus-make-local-hook 'message-header-hook)
(add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
(setq message-post-method
- `(lambda (arg)
+ `(lambda (&optional arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
- (setq message-newsreader (setq message-mailer (gnus-extended-version)))
(message-add-action
`(when (gnus-buffer-exists-p ,buffer)
(set-window-configuration ,winconf))
(t nil))))
(message-add-action
`(when (gnus-buffer-exists-p ,buffer)
- (save-excursion
- (set-buffer ,buffer)
+ (with-current-buffer ,buffer
,(when to-be-marked
(if (eq config 'forward)
`(gnus-summary-mark-article-as-forwarded ',to-be-marked)
(setq gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
- (completing-read "Use posting style of group: "
- gnus-active-hashtb nil
- (gnus-read-active-file-p))
+ (gnus-group-completing-read
+ "Use posting style of group"
+ nil (gnus-read-active-file-p))
(gnus-group-group-name))
""))
;; #### see comment in gnus-setup-message -- drv
(gnus-setup-message 'message (message-mail)))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq gnus-newsgroup-name group)))))
(defun gnus-group-news (&optional arg)
(setq gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
- (completing-read "Use group: "
- gnus-active-hashtb nil
- (gnus-read-active-file-p))
+ (gnus-group-completing-read "Use group"
+ nil
+ (gnus-read-active-file-p))
(gnus-group-group-name))
""))
;; #### see comment in gnus-setup-message -- drv
(gnus-setup-message 'message
(message-news (gnus-group-real-name gnus-newsgroup-name))))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq gnus-newsgroup-name group)))))
(defun gnus-group-post-news (&optional arg)
(let ((gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
- (completing-read "Newsgroup: " gnus-active-hashtb nil
- (gnus-read-active-file-p))
+ (gnus-group-completing-read "Newsgroup" nil
+ (gnus-read-active-file-p))
(gnus-group-group-name))
""))
;; make sure last viewed article doesn't affect posting styles:
(setq gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
- (completing-read "Use group: "
- gnus-active-hashtb nil
- (gnus-read-active-file-p))
+ (gnus-group-completing-read "Use group"
+ nil
+ (gnus-read-active-file-p))
"")
gnus-newsgroup-name))
;; #### see comment in gnus-setup-message -- drv
(gnus-setup-message 'message (message-mail)))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq gnus-newsgroup-name group)))))
(defun gnus-summary-news-other-window (&optional arg)
(setq gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
- (completing-read "Use group: "
- gnus-active-hashtb nil
- (gnus-read-active-file-p))
+ (gnus-group-completing-read "Use group"
+ nil
+ (gnus-read-active-file-p))
"")
gnus-newsgroup-name))
;; #### see comment in gnus-setup-message -- drv
(remove
(car (gnus-find-method-for-group gnus-newsgroup-name))
gnus-discouraged-post-methods)))))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(setq gnus-newsgroup-name group)))))
(defun gnus-summary-post-news (&optional arg)
(let ((gnus-newsgroup-name
(if arg
(if (= 1 (prefix-numeric-value arg))
- (completing-read "Newsgroup: " gnus-active-hashtb nil
- (gnus-read-active-file-p))
+ (gnus-group-completing-read "Newsgroup" nil
+ (gnus-read-active-file-p))
"")
gnus-newsgroup-name))
;; make sure last viewed article doesn't affect posting styles:
(nnheader-narrow-to-headers)
(nnheader-parse-naked-head)))))
(message-yank-original)
+ (message-exchange-point-and-mark)
(setq beg (or beg (mark t))))
(when articles
(insert "\n")))
prefix `a', cancel using the standard posting method; if not
post using the current select method."
(interactive (gnus-interactive "P\ny"))
- (let ((articles (gnus-summary-work-articles n))
- (message-post-method
+ (let ((message-post-method
`(lambda (arg)
- (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
- article)
- (while (setq article (pop articles))
+ (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))))
+ (dolist (article (gnus-summary-work-articles n))
(when (gnus-summary-select-article t nil nil article)
(when (gnus-eval-in-buffer-window gnus-original-article-buffer
(message-cancel-news))
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)))
+ (let ((article (gnus-summary-article-number))
+ (mail-parse-charset gnus-newsgroup-charset))
(gnus-setup-message 'reply-yank
(gnus-summary-select-article t)
(set-buffer gnus-original-article-buffer)
(push
`((lambda ()
(when (gnus-buffer-exists-p ,gnus-summary-buffer)
- (save-excursion
- (set-buffer ,gnus-summary-buffer)
+ (with-current-buffer ,gnus-summary-buffer
(gnus-cache-possibly-remove-article ,article nil nil nil t)
(gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
- message-send-actions))))
+ message-send-actions)
+ ;; Add Gcc header.
+ (gnus-inews-insert-gcc))))
\f
;; 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)
+ (with-current-buffer gnus-article-copy
(mm-enable-multibyte))
(let ((article-buffer (or article-buffer gnus-article-buffer))
end beg)
(if (not (and (get-buffer article-buffer)
(gnus-buffer-exists-p article-buffer)))
(error "Can't find any article buffer")
- (save-excursion
- (set-buffer article-buffer)
+ (with-current-buffer article-buffer
(let ((gnus-newsgroup-charset (or gnus-article-charset
gnus-newsgroup-charset))
(gnus-newsgroup-ignored-charsets
(delete-region (point) (point-max))
(insert yank-string))
(gnus-article-delete-text-of-type 'annotation)
+ (gnus-article-delete-text-of-type 'multipart)
(gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next)
(gnus-remove-text-with-property 'gnus-decoration)
;; Decode charsets.
(let ((gnus-article-decode-hook
(delq 'article-decode-charset
- (copy-sequence gnus-article-decode-hook))))
+ (copy-sequence gnus-article-decode-hook)))
+ (rfc2047-quote-decoded-words-containing-tspecials t))
(run-hooks 'gnus-article-decode-hook)))))
gnus-article-copy)))
gnus-last-posting-server)
;; Just use the last value.
gnus-last-posting-server
- (completing-read
- "Posting method: " method-alist nil t
+ (gnus-completing-read
+ "Posting method" (mapcar 'car method-alist) t
(cons (or gnus-last-posting-server "") 0))))
method-alist))))
;; Override normal method.
"Stringified Gnus version and Emacs version.
See the variable `gnus-user-agent'."
(interactive)
- (let* ((float-output-format nil)
- (gnus-v
- (concat "Gnus/"
- (prin1-to-string (gnus-continuum-version gnus-version) t)
- " (" gnus-version ")"))
- (emacs-v (gnus-emacs-version)))
- (if (stringp gnus-user-agent)
- gnus-user-agent
- (concat gnus-v
- (when emacs-v
- (concat " " emacs-v))))))
+ (if (stringp gnus-user-agent)
+ gnus-user-agent
+ ;; `gnus-user-agent' is a list:
+ (let* ((float-output-format nil)
+ (gnus-v
+ (when (memq 'gnus gnus-user-agent)
+ (concat "Gnus/"
+ (prin1-to-string (gnus-continuum-version gnus-version) t)
+ " (" gnus-version ")")))
+ (emacs-v (gnus-emacs-version)))
+ (concat gnus-v (when (and gnus-v emacs-v) " ")
+ emacs-v))))
\f
;;;
(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)))
- (y-or-n-p "Really reply by mail to article author? "))
+ (if (or wide very-wide)
+ t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very
+ ;; wide replies.
+ (y-or-n-p "Really reply by mail to article author? ")))
(let* ((article
(if (listp (car yank))
(caar yank)
(gnus-summary-select-article)
(dolist (article very-wide)
(gnus-summary-select-article nil nil nil article)
- (save-excursion
- (set-buffer (gnus-copy-article-buffer))
+ (with-current-buffer (gnus-copy-article-buffer)
(gnus-msg-treat-broken-reply-to)
(save-restriction
(message-narrow-to-head)
(insert headers))
(goto-char (point-max)))
(mml-quote-region (point) (point-max))
- (message-reply nil wide)
+ (message-reply nil wide 'switch-to-buffer)
(when yank
(gnus-inews-yank-articles yank))
(gnus-summary-handle-replysign)))))
"Check the various replysign variables and take action accordingly."
(when (or gnus-message-replysign gnus-message-replyencrypt)
(let (signed encrypted)
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-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)
(with-current-buffer gnus-original-article-buffer
(nnmail-fetch-field "to"))))
current-prefix-arg))
- (let ((articles (gnus-summary-work-articles n))
- article)
- (while (setq article (pop articles))
- (gnus-summary-select-article nil nil nil article)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (message-resend address))
- (gnus-summary-mark-article-as-forwarded article))))
+ (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)))
;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
(defun gnus-summary-resend-message-edit ()
contents of the message, and then, everything will happen as when
composing a new message."
(interactive)
- (let ((article (gnus-summary-article-number)))
+ (let ((mail-parse-charset gnus-newsgroup-charset))
(gnus-setup-message 'reply-yank
(gnus-summary-select-article t)
(set-buffer gnus-original-article-buffer)
(message-narrow-to-head-1)
;; Gnus will generate a new one when sending.
(message-remove-header "Message-ID")
- (message-remove-header message-ignored-resent-headers t)
;; Remove unwanted headers.
+ (message-remove-header message-ignored-resent-headers t)
(goto-char (point-max))
(insert mail-header-separator)
+ ;; Add Gcc header.
+ (gnus-inews-insert-gcc)
(goto-char (point-min))
(when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
(forward-char 1))
(interactive "P")
(gnus-summary-mail-forward arg t))
-(defvar gnus-nastygram-message
- "The following article was inappropriately posted to %s.\n\n"
- "Format string to insert in nastygrams.
-The current group name will be inserted at \"%s\".")
-
-(defun gnus-summary-mail-nastygram (n)
- "Send a nastygram to the author of the current article."
- (interactive "P")
- (when (or gnus-expert-user
- (gnus-y-or-n-p
- "Really send a nastygram to the author of the current article? "))
- (let ((group gnus-newsgroup-name))
- (gnus-summary-reply-with-original n)
- (set-buffer gnus-message-buffer)
- (message-goto-body)
- (insert (format gnus-nastygram-message group))
- (message-send-and-exit))))
-
(defun gnus-summary-mail-crosspost-complaint (n)
"Send a complaint about crossposting to the current article(s)."
(interactive "P")
- (let ((articles (gnus-summary-work-articles n))
- article)
- (while (setq article (pop articles))
- (set-buffer gnus-summary-buffer)
- (gnus-summary-goto-subject article)
- (let ((group (gnus-group-real-name gnus-newsgroup-name))
- newsgroups followup-to)
- (gnus-summary-select-article)
- (set-buffer gnus-original-article-buffer)
- (if (and (<= (length (message-tokenize-header
- (setq newsgroups
- (mail-fetch-field "newsgroups"))
- ", "))
- 1)
- (or (not (setq followup-to (mail-fetch-field "followup-to")))
- (not (member group (message-tokenize-header
- followup-to ", ")))))
- (if followup-to
- (gnus-message 1 "Followup-to restricted")
- (gnus-message 1 "Not a crossposted article"))
- (set-buffer gnus-summary-buffer)
- (gnus-summary-reply-with-original 1)
- (set-buffer gnus-message-buffer)
- (message-goto-body)
- (insert (format gnus-crosspost-complaint newsgroups group))
- (message-goto-subject)
- (re-search-forward " *$")
- (replace-match " (crosspost notification)" t t)
- (gnus-deactivate-mark)
- (when (gnus-y-or-n-p "Send this complaint? ")
- (message-send-and-exit)))))))
+ (dolist (article (gnus-summary-work-articles n))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-goto-subject article)
+ (let ((group (gnus-group-real-name gnus-newsgroup-name))
+ newsgroups followup-to)
+ (gnus-summary-select-article)
+ (set-buffer gnus-original-article-buffer)
+ (if (and (<= (length (message-tokenize-header
+ (setq newsgroups
+ (mail-fetch-field "newsgroups"))
+ ", "))
+ 1)
+ (or (not (setq followup-to (mail-fetch-field "followup-to")))
+ (not (member group (message-tokenize-header
+ followup-to ", ")))))
+ (if followup-to
+ (gnus-message 1 "Followup-to restricted")
+ (gnus-message 1 "Not a crossposted article"))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-reply-with-original 1)
+ (set-buffer gnus-message-buffer)
+ (message-goto-body)
+ (insert (format gnus-crosspost-complaint newsgroups group))
+ (message-goto-subject)
+ (re-search-forward " *$")
+ (replace-match " (crosspost notification)" t t)
+ (gnus-deactivate-mark)
+ (when (gnus-y-or-n-p "Send this complaint? ")
+ (message-send-and-exit))))))
(defun gnus-mail-parse-comma-list ()
(let (accumulated
(insert nntp-server-type))
(insert "\n\n\n\n\n")
(let (text)
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
+ (with-current-buffer (gnus-get-buffer-create " *gnus environment info*")
(erase-buffer)
(gnus-debug)
(setq text (buffer-string)))
(defun gnus-summary-yank-message (buffer n)
"Yank the current article into a composed message."
(interactive
- (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
+ (list (gnus-completing-read "Buffer" (message-buffers) t)
current-prefix-arg))
(gnus-summary-iterate n
(let ((gnus-inhibit-treatment t))
(gnus-summary-select-article))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(message-yank-buffer gnus-article-buffer))))
(defun gnus-debug ()
(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.
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
+ (with-current-buffer (gnus-get-buffer-create " *gnus bug info*")
(while files
(erase-buffer)
(when (and (setq file (locate-library (pop files)))
;; 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 "[\000-\010\013-\037\200-\237]" nil t)
+ (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))))
this is a reply."
(interactive "P")
(gnus-summary-select-article t)
- (set-buffer gnus-original-article-buffer)
- (gnus-setup-message 'compose-bounce
- (let* ((references (mail-fetch-field "references"))
- (parent (and references (gnus-parent-id references))))
+ (let (summary-buffer parent)
+ (if fetch
+ (progn
+ (setq summary-buffer (current-buffer))
+ (set-buffer gnus-original-article-buffer)
+ (article-goto-body)
+ (when (re-search-forward "^References:\n?" nil t)
+ (while (memq (char-after) '(?\t ? ))
+ (forward-line 1))
+ (skip-chars-backward "\t\n ")
+ (setq parent
+ (gnus-parent-id (buffer-substring (match-end 0) (point))))))
+ (set-buffer gnus-original-article-buffer))
+ (gnus-setup-message 'compose-bounce
(message-bounce)
+ ;; Add Gcc header.
+ (gnus-inews-insert-gcc)
;; If there are references, we fetch the article we answered to.
- (and fetch parent
- (gnus-summary-refer-article parent)
- (gnus-summary-show-all-headers)))))
+ (when parent
+ (with-current-buffer summary-buffer
+ (gnus-summary-refer-article parent)
+ (gnus-summary-show-all-headers))))))
;;; Gcc handling.
(message-tokenize-header gcc " ,")))
;; Copy the article over to some group(s).
(while (setq group (pop groups))
- (unless (gnus-check-server
- (setq method (gnus-inews-group-method group)))
+ (setq method (gnus-inews-group-method group)
+ group (mm-encode-coding-string
+ group
+ (gnus-group-name-charset method group)))
+ (unless (gnus-check-server method)
(error "Can't open server %s" (if (stringp method) method
(car method))))
- (unless (gnus-request-group group nil method)
+ (unless (gnus-request-group group t method)
(gnus-request-create-group group method))
(setq mml-externalize-attachments
(if (stringp gnus-gcc-externalize-attachments)
group method t t))))
(gnus-message 1 "Couldn't store article in group %s: %s"
group (gnus-status-message method)))
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (when (and (listp method)
+ (gnus-native-method-p method))
+ (setq group (gnus-group-short-name group)))
(when (and group-art
;; FIXME: Should gcc-mark-as-read work when
;; Gnus is not running?
(gnus-group-mark-article-read group (cdr group-art)))
(kill-buffer (current-buffer)))))))))
-(defun gnus-inews-insert-gcc ()
- "Insert Gcc headers based on `gnus-outgoing-message-group'."
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (let* ((group gnus-outgoing-message-group)
- (gcc (cond
- ((functionp group)
- (funcall group))
- ((or (stringp group) (list group))
- group))))
- (when gcc
- (insert "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)
+(defun gnus-inews-insert-gcc (&optional group)
"Insert the Gcc to say where the article is to be archived."
- (let* ((var gnus-message-archive-group)
- (group (or group gnus-newsgroup-name ""))
+ (let* ((group (or group gnus-newsgroup-name))
+ (group (when group (gnus-group-decoded-name group)))
+ (var (or gnus-outgoing-message-group gnus-message-archive-group))
(gcc-self-val
- (and gnus-newsgroup-name
- (not (equal gnus-newsgroup-name ""))
- (gnus-group-find-parameter
- gnus-newsgroup-name 'gcc-self)))
+ (and group (gnus-group-find-parameter group 'gcc-self)))
result
(groups
(cond
;; Obsolete format of header match.
(and (gnus-buffer-live-p gnus-article-copy)
(with-current-buffer gnus-article-copy
- (let ((header (message-fetch-field (pop style))))
- (and header
- (string-match (pop style) header))))))
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (let ((header (message-fetch-field (pop style))))
+ (and header
+ (string-match (pop style) header)))))))
((or (symbolp match)
(functionp match))
(cond
;; New format of header match.
(and (gnus-buffer-live-p gnus-article-copy)
(with-current-buffer gnus-article-copy
- (let ((header (message-fetch-field (nth 1 match))))
- (and header
- (string-match (nth 2 match) header))))))
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (let ((header (message-fetch-field (nth 1 match))))
+ (and header
+ (string-match (nth 2 match) header)))))))
(t
;; This is a form to be evaled.
(eval match)))))
(setq v
(cond
((stringp value)
- value)
+ (if (and (stringp match)
+ (gnus-string-match-p "\\\\[&[:digit:]]" value)
+ (match-beginning 1))
+ (gnus-match-substitute-replacement value nil nil group)
+ value))
((or (symbolp value)
(functionp value))
(cond ((functionp value)
((eq element 'x-face-file)
(setq element 'x-face
filep t)))
+ ;; Post-processing for the signature posting-style:
+ (and (eq element 'signature) filep
+ message-signature-directory
+ ;; don't actually use the signature directory
+ ;; if message-signature-file contains a path.
+ (not (file-name-directory v))
+ (setq v (nnheader-concat message-signature-directory v)))
;; 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))))
+ (buffer-substring
+ (point-min)
+ (progn
+ (goto-char (point-max))
+ (if (zerop (skip-chars-backward "\n"))
+ (point)
+ (1+ (point))))))))
(setq results (delq (assoc element results) results))
(push (cons element v) results))))
;; Now we have all the styles, so we insert them.
(provide 'gnus-msg)
-;;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b
;;; gnus-msg.el ends here
projects / gnus / blobdiff