* lisp/gnus/gnus-msg.el (gnus-configure-posting-style):

Allow string replacements in values when matching against a header.

* doc/misc/gnus.texi (Posting Styles): Document the possibility to
perform string replacements when matching against headers.

2 files changed, 14 insertions, 5 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index e3c978331ec..cdfe4f4dea8 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
+2013-07-17  Albert Krewinkel  <albert@zeitkraut.de>
+
+        * gnus-msg.el (gnus-configure-posting-style):
+        Allow string replacements in values when matching against a header.
+
 2014-07-07  Katsumi Yamaoka  <yamaoka@jpl.org>
 
         * gnus-start.el (gnus-dribble-read-file): Don't stop the auto-saving of
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 1c8635c5992..469b9d2cf81 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1826,7 +1826,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
@@ -1846,7 +1846,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)
@@ -1875,7 +1877,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)))))
@@ -1896,10 +1899,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))