* 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.

diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 44c2272a63d22178979b886871753b9862b2562c..d78543183df5387d87e048d280e0be25412e06bc 100644 (file)
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,8 @@
+2014-07-18  Albert Krewinkel  <albert+gnus@zeitkraut.de>
+
+       * gnus.texi (Posting Styles): Document the possibility to perform
+       string replacements when matching against headers.
+
 2014-07-09  Stephen Berman  <stephen.berman@gmx.net>
 
        * todo-mode.texi (Levels of Organization): Comment out statement

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index f77fd20dbf2622d8f2d8775808e499cfef18d768..80c1cc2ef038f49a5d8349da419402fb104ea7b1 100644 (file)
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -12813,10 +12813,12 @@ variable, which is a vector of the following headers: number subject
 from date id references chars lines xref extra.
 
 In the case of a string value, if the @code{match} is a regular
-expression, a @samp{gnus-match-substitute-replacement} is proceed on
-the value to replace the positional parameters @samp{\@var{n}} by the
-corresponding parenthetical matches (see @xref{Replacing Match,,
-Replacing the Text that Matched, elisp, The Emacs Lisp Reference Manual}.)
+expression, or if it takes the form @code{(header @var{match}
+@var{regexp})}, a @samp{gnus-match-substitute-replacement} is proceed
+on the value to replace the positional parameters @samp{\@var{n}} by
+the corresponding parenthetical matches (see @xref{Replacing Match,,
+Replacing the Text that Matched, elisp, The Emacs Lisp Reference
+Manual}.)
 
 @vindex message-reply-headers
 
@@ -12848,6 +12850,10 @@ So here's a new example:
         ;; @r{If I'm replying to Larsi, set the Organization header.}
         ((header "from" "larsi.*org")
          (Organization "Somewhere, Inc."))
+        ;; @r{Reply to a message from the same subaddress the message}
+        ;; @r{was sent to.}
+        ((header "x-original-to" "me\\(\\+.+\\)@@example.org")
+         (address "me\\1@@example.org"))
         ((posting-from-work-p) ;; @r{A user defined function}
          (signature-file "~/.work-signature")
          (address "user@@bar.foo")

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index e3c978331ec5a311f5b49de4b5dcf9f22e1f6e1e..cdfe4f4dea803f1a763042100d5d0fb6b78b82cd 100644 (file)
--- 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 1c8635c5992bc03cfd70c2aa579ff8db5e227968..469b9d2cf811ca239a094340f3af1072662347bb 100644 (file)
--- 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))