gnus-msg.el (gnus-setup-message): Fix last commit
[gnus] / lisp / gnus-msg.el
index bcd2cd4..87eb6af 100644 (file)
@@ -1,6 +1,6 @@
 ;;; gnus-msg.el --- mail and post interface for Gnus
 
-;; Copyright (C) 1995-201 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>
@@ -174,7 +174,7 @@ 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"
+  :version "24.3"
   :group 'gnus-message
   :type '(choice (const none) (const t) string (const nil)
                 (const no-gcc-self)))
@@ -319,6 +319,7 @@ 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
@@ -327,6 +328,7 @@ 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)
@@ -413,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"))
@@ -424,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
@@ -524,7 +540,8 @@ 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.
+         (gnus-newsgroup-name "")
          mail-buf)
       (gnus-setup-message 'message
        (message-mail to subject other-headers continue
@@ -905,6 +922,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)))
@@ -1116,7 +1134,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) " ")
@@ -1369,7 +1389,25 @@ For the \"inline\" alternatives, also see the variable
              (nnmail-fetch-field "to"))))
         current-prefix-arg))
   (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
-       (message-sent-hook (copy-sequence message-sent-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)
@@ -1686,7 +1724,8 @@ 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)))
         result
         (groups
          (cond
@@ -1725,7 +1764,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
@@ -1793,6 +1833,10 @@ this is a reply."
       (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)