[patch] Posting styles when resending

[patch] Posting styles when resending

[Peder O. Klingenberg]

[-- Attachment #1: Type: text/plain, Size: 709 bytes --]

A (long) while ago I was bitten by the fact that
gnus-summary-resend-message used different logic to determine the
posting style to apply than did gnus-configure-posting-styles.

I hacked up a patch, and wanted to test it for a bit before I passed it
on.  Then I forgot.  Today I refreshed my git repo, and got a conflict,
which reminded me.

Since it hasn't caused me any trouble over the last year or so since I
wrote it, I figure I might as well pass it on.  It contains almost no
original work, it's just a simple refactoring.  As such, I wouldn't
think it requires copyright signoff, but I'm willing so sign papers if
necessary.

...Peder...
-- 
I wish a new life awaited _me_ in some off-world colony.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: resend-posting-style.patch --]
[-- Type: text/x-diff, Size: 4152 bytes --]

diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 0f78f2e..1369827 100644
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -1400,8 +1400,7 @@ For the \"inline\" alternatives, also see the variable
     (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 (gnus-posting-style-match style gnus-newsgroup-name)
 	(when (setq tem (cadr (assq 'name style)))
 	  (setq user-full-name tem))
 	(when (setq tem (cadr (assq 'address style)))
@@ -1823,7 +1822,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 attributes 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
@@ -1838,46 +1837,12 @@ this is a reply."
 	    (setq styles (append styles (list (cons ".*" tmp-style)))))))
       ;; Go through all styles and look for matches.
       (dolist (style styles)
-	(setq match (pop style))
+	(setq match (car style))
 	(goto-char (point-min))
-	(when (cond
-	       ((stringp match)
-		;; Regexp string match on the group name.
-		(string-match match group))
-	       ((eq match 'header)
-		;; Obsolete format of header match.
-		(and (gnus-buffer-live-p gnus-article-copy)
-		     (with-current-buffer gnus-article-copy
-		       (save-restriction
-			 (nnheader-narrow-to-headers)
-			 (let ((header (message-fetch-field (pop style))))
-			   (and header
-				(string-match (pop style) header)))))))
-	       ((or (symbolp match)
-		    (functionp match))
-		(cond
-		 ((functionp match)
-		  ;; Function to be called.
-		  (funcall match))
-		 ((boundp match)
-		  ;; Variable to be checked.
-		  (symbol-value match))))
-	       ((listp match)
-		(cond
-		 ((eq (car match) 'header)
-		  ;; New format of header match.
-		  (and (gnus-buffer-live-p gnus-article-copy)
-		       (with-current-buffer gnus-article-copy
-			 (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 evalled.
-		  (eval match)))))
+	(when (setq attributes (gnus-posting-style-match style
+							 group))
 	  ;; We have a match, so we set the variables.
-	  (dolist (attribute style)
+	  (dolist (attribute attributes)
 	    (setq element (pop attribute)
 		  filep nil)
 	    (setq value
@@ -1990,6 +1955,46 @@ this is a reply."
 			 (insert "From: " (message-make-from) "\n"))))
 		  nil 'local)))))
 
+(defun gnus-posting-style-match (style group)
+  (let ((match (pop style)))
+    (when (cond
+	   ((stringp match)
+	    ;; Regexp string match on the group name.
+	    (string-match match group))
+	   ((eq match 'header)
+	    ;; Obsolete format of header match.
+	    (and (gnus-buffer-live-p gnus-article-copy)
+		 (with-current-buffer gnus-article-copy
+		   (save-restriction
+		     (nnheader-narrow-to-headers)
+		     (let ((header (message-fetch-field (pop style))))
+		       (and header
+			    (string-match (pop style) header)))))))
+	   ((or (symbolp match)
+		(functionp match))
+	    (cond
+	     ((functionp match)
+	      ;; Function to be called.
+	      (funcall match))
+	     ((boundp match)
+	      ;; Variable to be checked.
+	      (symbol-value match))))
+	   ((listp match)
+	    (cond
+	     ((eq (car match) 'header)
+	      ;; New format of header match.
+	      (and (gnus-buffer-live-p gnus-article-copy)
+		   (with-current-buffer gnus-article-copy
+		     (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 evalled.
+	      (eval match)))))
+      style)))
+
 ;;; Allow redefinition of functions.
 
 (gnus-ems-redefine)