X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=b95bec2ace6879cce2fc082b11a37ed43fe36f82;hp=c967bc06565b0f2520d629eaf7b96407ea14330f;hb=b52037f4a9c6bee1ff556c22750e158da1208d4b;hpb=56144f96a2ab04718c8ed5dd84d8fb315847480d diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index c967bc065..b95bec2ac 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,6 +1,6 @@ ;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995-2012 Free Software Foundation, Inc. +;; Copyright (C) 1995-2016 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -415,6 +415,11 @@ Thank you for your help in stamping out bugs. (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")) @@ -426,15 +431,24 @@ Thank you for your help in stamping out bugs. `(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 @@ -526,11 +540,16 @@ instead." (message-mail to subject other-headers continue nil yank-action send-actions return-action)) (let ((buf (current-buffer)) - (gnus-newsgroup-name (or gnus-newsgroup-name "")) + ;; Don't use posting styles corresponding to any existing group. + (group-name gnus-newsgroup-name) mail-buf) - (gnus-setup-message 'message - (message-mail to subject other-headers continue - nil yank-action send-actions return-action)) + (unwind-protect + (progn + (setq gnus-newsgroup-name "") + (gnus-setup-message 'message + (message-mail to subject other-headers continue + nil yank-action send-actions return-action))) + (setq gnus-newsgroup-name group-name)) (when switch-action (setq mail-buf (current-buffer)) (switch-to-buffer buf) @@ -847,7 +866,7 @@ post using the current select method." (let ((message-post-method `(lambda (arg) (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))) - (user-mail-address user-mail-address)) + (custom-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 @@ -857,12 +876,13 @@ post using the current select method." (gnus-summary-followup nil) (let ((from (message-fetch-field "from"))) (when from - (setq user-mail-address + (setq custom-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)) + (let ((user-mail-address (or custom-address user-mail-address))) + (message-cancel-news))) (gnus-summary-mark-as-read article gnus-canceled-mark) (gnus-cache-remove-article 1)) (gnus-article-hide-headers-if-wanted)) @@ -907,6 +927,7 @@ header line with the old Message-ID." (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))) @@ -1118,7 +1139,9 @@ See the variable `gnus-user-agent'." (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) " ") @@ -1706,7 +1729,21 @@ this is a reply." (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 t))) + (gcc-self-get (lambda (gcc-self-val group) + (if (stringp gcc-self-val) + (if (string-match " " gcc-self-val) + (concat "\"" gcc-self-val "\"") + gcc-self-val) + ;; 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))))) result (groups (cond @@ -1745,7 +1782,8 @@ this is a reply." (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 @@ -1756,19 +1794,11 @@ this is a reply." (if gcc-self-val ;; Use the `gcc-self' param value instead. (progn - (insert - (if (stringp gcc-self-val) - (if (string-match " " gcc-self-val) - (concat "\"" gcc-self-val "\"") - gcc-self-val) - ;; 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)))) + (insert (if (listp gcc-self-val) + (mapconcat (lambda (val) + (funcall gcc-self-get val group)) + gcc-self-val ", ") + (funcall gcc-self-get gcc-self-val group))) (if (not (eq gcc-self-val 'none)) (insert "\n") (gnus-delete-line))) @@ -1805,7 +1835,7 @@ this is a reply." (with-current-buffer gnus-summary-buffer gnus-posting-styles) gnus-posting-styles)) - style match attribute value v results + style match attribute value v results matched-string 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 @@ -1825,7 +1855,9 @@ this is a reply." (when (cond ((stringp match) ;; Regexp string match on the group name. - (string-match match group)) + (when (string-match match group) + (setq matched-string group) + t)) ((eq match 'header) ;; Obsolete format of header match. (and (gnus-buffer-live-p gnus-article-copy) @@ -1854,7 +1886,8 @@ this is a reply." (nnheader-narrow-to-headers) (let ((header (message-fetch-field (nth 1 match)))) (and header - (string-match (nth 2 match) header))))))) + (string-match (nth 2 match) header) + (setq matched-string header))))))) (t ;; This is a form to be evalled. (eval match))))) @@ -1875,10 +1908,11 @@ this is a reply." (setq v (cond ((stringp value) - (if (and (stringp match) + (if (and matched-string (gnus-string-match-p "\\\\[&[:digit:]]" value) (match-beginning 1)) - (gnus-match-substitute-replacement value nil nil group) + (gnus-match-substitute-replacement value nil nil + matched-string) value)) ((or (symbolp value) (functionp value))