;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
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"))))
(defcustom gnus-mailing-list-groups nil
- "*Regexp matching groups that are really mailing lists.
+ "*If non-nil a regexp matching groups that are really mailing lists.
This is useful when you're reading a mailing list that has been
gatewayed to a newsgroup, and you want to followup to an article in
the group."
:group 'gnus-message
- :type 'regexp)
+ :type '(choice (regexp)
+ (const nil)))
(defcustom gnus-add-to-list nil
"*If non-nil, add a `to-list' parameter automatically."
(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)
-(defvar gnus-inews-mark-gcc-as-read nil
- "Obsolete variable. Use `gnus-gcc-mark-as-read' instead.")
-
(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
'gnus-gcc-mark-as-read)
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")))
(defcustom gnus-message-replysignencrypted
t
- "Setting this causes automatically encryped messages to also be signed."
+ "Setting this causes automatically encrypted messages to also be signed."
: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.
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."
+ :version "22.1"
:group 'gnus-message
:type '(choice (const :tag "No" nil)
(const :tag "Yes" t)
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-user-agent 'emacs-gnus-type
- "Which information should be exposed in the User-Agent header.
-
-It can be one of the symbols `gnus' \(show only Gnus version\), `emacs-gnus'
-\(show only Emacs and Gnus versions\), `emacs-gnus-config' \(same as
-`emacs-gnus' plus system configuration\), `emacs-gnus-type' \(same as
-`emacs-gnus' plus system type\) 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 Gnus and Emacs versions and system type"
- emacs-gnus-type)
- (item :tag "Show Gnus and Emacs versions and system configuration"
- emacs-gnus-config)
- (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
")
(eval-and-compile
- (autoload 'gnus-uu-post-news "gnus-uu" nil t)
- (autoload 'news-setup "rnewspost")
- (autoload 'news-reply-mode "rnewspost")
- (autoload 'rmail-dont-reply-to "mail-utils")
- (autoload 'rmail-output "rmailout"))
+ (autoload 'gnus-uu-post-news "gnus-uu" nil t))
\f
;;;
;;; Internal functions.
-(defun gnus-inews-make-draft ()
+(defun gnus-inews-make-draft (articles)
`(lambda ()
(gnus-inews-make-draft-meta-information
- ,gnus-newsgroup-name ',gnus-article-reply)))
+ ,gnus-newsgroup-name ',articles)))
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
;; added an optional argument to `gnus-configure-posting-styles' to
;; make sure that the correct value for the group name is used. -- drv
(add-hook 'message-mode-hook
- (lambda ()
- (gnus-configure-posting-styles ,group)))
+ (if (memq ,config '(reply-yank reply))
+ (lambda ()
+ (gnus-configure-posting-styles ,group))
+ (lambda ()
+ ;; 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)
message-required-headers)
(when (and ,group
(not (string= ,group "")))
(push (cons
(intern gnus-draft-meta-information-header)
- (gnus-inews-make-draft))
+ (gnus-inews-make-draft (or ,yanked ,article)))
message-required-headers))
(unwind-protect
(progn
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl) ;; Global value
(set (make-local-variable 'mml-buffer-list) mbl1);; Local value
- ;; LOCAL argument of add-hook differs between GNU Emacs
- ;; and XEmacs. make-local-hook makes sure they are local.
- (make-local-hook 'kill-buffer-hook)
- (make-local-hook 'change-major-mode-hook)
+ (gnus-make-local-hook 'kill-buffer-hook)
+ (gnus-make-local-hook 'change-major-mode-hook)
(add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
(mml-destroy-buffers)
(setq mml-buffer-list mbl)))
+ (message-hide-headers)
(gnus-add-buffer)
(gnus-configure-windows ,config t)
(run-hooks 'post-command-hook)
(set-buffer-modified-p nil))))
-(defun gnus-inews-make-draft-meta-information (group article)
- (concat "(\"" group "\" "
- (if article (number-to-string
- (if (listp article)
- (car article)
- article)) "\"\"")
+(defun gnus-inews-make-draft-meta-information (group articles)
+ (when (numberp articles)
+ (setq articles (list articles)))
+ (concat "(\"" group "\""
+ (if articles
+ (concat " "
+ (mapconcat
+ (lambda (elem)
+ (number-to-string
+ (if (consp elem)
+ (car elem)
+ elem)))
+ articles " "))
+ "")
")"))
;;;###autoload
;; 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
(while (setq elem (pop alist))
(when (or (and (stringp (car elem))
(string-match (car elem) group))
- (and (gnus-functionp (car elem))
+ (and (functionp (car elem))
(funcall (car elem) group))
(and (symbolp (car elem))
(symbol-value (car elem))))
(defun gnus-inews-add-send-actions (winconf buffer article
&optional config yanked)
- (make-local-hook 'message-sent-hook)
+ (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)
(when gnus-agent
- (make-local-hook 'message-header-hook)
+ (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
(set-window-configuration ,winconf))
'exit 'postpone 'kill)
(let ((to-be-marked (cond
- (yanked yanked)
+ (yanked
+ (mapcar
+ (lambda (x) (if (listp x) (car x) x)) yanked))
(article (if (listp article) article (list article)))
(t nil))))
(message-add-action
This function prepares a news even when using mail groups. This is useful
for posting messages to mail groups without actually sending them over the
-network. The corresponding backend must have a 'request-post method."
+network. The corresponding back end must have a 'request-post method."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
This function prepares a news even when using mail groups. This is useful
for posting messages to mail groups without actually sending them over the
-network. The corresponding backend must have a 'request-post method."
+network. The corresponding back end must have a 'request-post method."
(interactive "P")
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
gnus-newsgroup-name))
;; #### see comment in gnus-setup-message -- drv
(gnus-setup-message 'message
- (message-news (gnus-group-real-name gnus-newsgroup-name))))
+ (progn
+ (message-news (gnus-group-real-name gnus-newsgroup-name))
+ (set (make-local-variable 'gnus-discouraged-post-methods)
+ (remove
+ (car (gnus-find-method-for-group gnus-newsgroup-name))
+ gnus-discouraged-post-methods)))))
(save-excursion
(set-buffer buffer)
(setq gnus-newsgroup-name group)))))
If prefix argument YANK is non-nil, the original article is yanked
automatically.
YANK is a list of elements, where the car of each element is the
-article number, and the two following numbers is the region to be
-yanked."
+article number, and the cdr is the string to be yanked."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(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."
+ "Compose a followup to an article and include the original article.
+The text in the region will be yanked. If the region isn't
+active, the entire article will be yanked."
(interactive "P")
(gnus-summary-followup (gnus-summary-work-articles n) force-news))
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))
(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)))
(not to-address)))
;; This is news.
(if post
- (message-news (or to-group group))
+ (message-news
+ (or to-group
+ (and (not (gnus-virtual-group-p pgroup)) group)))
(set-buffer gnus-article-copy)
(gnus-msg-treat-broken-reply-to)
(message-followup (if (or newsgroup-p force-news)
\f
-;; Dummies to avoid byte-compile warning.
-(eval-when-compile
- (defvar nnspool-rejected-article-hook)
- (defvar xemacs-codename))
-
(defun gnus-extended-version ()
"Stringified Gnus version and Emacs version.
See the variable `gnus-user-agent'."
(interactive)
- (let* ((gnus-v
- (concat "Gnus/"
- (prin1-to-string (gnus-continuum-version gnus-version) t)
- " (" gnus-version ")"))
- (system-v
- (cond
- ((eq gnus-user-agent 'emacs-gnus-config)
- system-configuration)
- ((eq gnus-user-agent 'emacs-gnus-type)
- (symbol-name system-type))
- (t nil)))
- (emacs-v
- (cond
- ((eq gnus-user-agent 'gnus)
- nil)
- ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
- (concat "Emacs/" (match-string 1 emacs-version)
- (if system-v
- (concat " (" system-v ")")
- "")))
- ((string-match
- "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
- emacs-version)
- (concat
- (match-string 1 emacs-version)
- (format "/%d.%d" emacs-major-version emacs-minor-version)
- (if (match-beginning 3)
- (match-string 3 emacs-version)
- "")
- (if (boundp 'xemacs-codename)
- (concat
- " (" xemacs-codename
- (if system-v
- (concat ", " system-v ")")
- ")"))
- "")))
- (t 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
+ (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)
(defun gnus-summary-wide-reply-with-original (n)
"Start composing a wide reply mail to the current message.
-The original article will be yanked."
+The original article will be yanked.
+Uses the process/prefix convention."
(interactive "P")
(gnus-summary-reply-with-original n t))
(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)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (message-resend address))
+ (gnus-summary-mark-article-as-forwarded article)))
;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
(defun gnus-summary-resend-message-edit ()
(goto-char (point-max))
(insert mail-header-separator)
(goto-char (point-min))
- (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
- (forward-char 1)
+ (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
+ (forward-char 1))
(widen)))))
(defun gnus-summary-post-forward (&optional arg)
(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
;; This mail group doesn't have a `to-list', so we add one
;; here. Magic!
(when (gnus-y-or-n-p
- (format "Do you want to add this as `to-list': %s " 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 ()
(not (gnus-group-read-only-p group)))
(setq group (read-string "Put in group: " nil (gnus-writable-groups))))
- (when (gnus-gethash group gnus-newsrc-hashtb)
+ (when (gnus-group-entry group)
(error "No such group: %s" group))
(save-excursion
(save-restriction
(list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
current-prefix-arg))
(gnus-summary-iterate n
- (let ((gnus-display-mime-function nil)
- (gnus-inhibit-treatment t))
+ (let ((gnus-inhibit-treatment t))
(gnus-summary-select-article))
(save-excursion
(set-buffer buffer)
(while olist
(if (boundp (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)))
+ (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 "[\000-\010\013-\037\200-\237]" nil t)
+ (while (re-search-forward (mm-string-as-multibyte
+ "[\000-\010\013-\037\200-\237]") nil t)
(replace-match (format "\\%03o" (string-to-char (match-string 0)))
t t))))
(defun gnus-summary-resend-bounced-mail (&optional fetch)
"Re-mail the current message.
-This only makes sense if the current message is a bounce message than
+This only makes sense if the current message is a bounce message that
contains some mail you have written which has been bounced back to
you.
If FETCH, try to fetch the article that this is a reply to, if indeed
(concat "^" (regexp-quote mail-header-separator) "$")
nil t)
(replace-match "" t t ))
- (unless (setq group-art
- (gnus-request-accept-article group method t t))
+ (when (or (not (gnus-check-backend-function
+ 'request-accept-article group))
+ (not (setq group-art
+ (gnus-request-accept-article
+ group method t t))))
(gnus-message 1 "Couldn't store article in group %s: %s"
- group (gnus-status-message method))
- (sit-for 2))
+ group (gnus-status-message method)))
(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))
+ (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)))
(kill-buffer (current-buffer)))))))))
(message-narrow-to-headers)
(let* ((group gnus-outgoing-message-group)
(gcc (cond
- ((gnus-functionp group)
+ ((functionp group)
(funcall group))
- ((or (stringp group) (list group))
+ ((or (stringp group) (listp group))
group))))
(when gcc
(insert "Gcc: "
((and (listp var) (stringp (car var)))
;; A list of groups.
var)
- ((gnus-functionp var)
+ ((functionp var)
;; A function.
(funcall var group))
(t
;; Regexp.
(when (string-match (caar var) group)
(cdar var)))
- ((gnus-functionp (car var))
+ ((functionp (car var))
;; Function.
(funcall (car var) group))
(t
(if (string-match " " gcc-self-val)
(concat "\"" gcc-self-val "\"")
gcc-self-val)
- (if (string-match " " group)
- (concat "\"" group "\"")
- group)))
+ ;; In nndoc groups, we use the parent group name
+ ;; instead of the current group.
+ (let ((group (or (gnus-group-find-parameter
+ gnus-newsgroup-name 'parent-group)
+ group)))
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group))))
(if (not (eq gcc-self-val 'none))
(insert "\n")
(gnus-delete-line)))
(unless gnus-inhibit-posting-styles
(let ((group (or group-name gnus-newsgroup-name ""))
(styles gnus-posting-styles)
- style match variable attribute value v results
+ 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
;; regexp matching everything, to be sure it takes precedence over all
;; 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)
- (gnus-functionp match))
+ (functionp match))
(cond
- ((gnus-functionp match)
+ ((functionp match)
;; Function to be called.
(funcall match))
((boundp match)
;; 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)))))
;; We have a match, so we set the variables.
(dolist (attribute style)
(setq element (pop attribute)
- variable nil
filep nil)
(setq value
(cond
((stringp value)
value)
((or (symbolp value)
- (gnus-functionp value))
- (cond ((gnus-functionp value)
+ (functionp value))
+ (cond ((functionp value)
(funcall value))
((boundp value)
(symbol-value value))))
(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.
(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)
+ (gnus-make-local-hook 'message-setup-hook)
(setq results (sort results (lambda (x y)
(string-lessp (car x) (car y)))))
(dolist (result results)
(provide 'gnus-msg)
+;;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b
;;; gnus-msg.el ends here
projects / gnus / blobdiff