* [patch] Posting styles when resending
@ 2013-08-16 10:51 Peder O. Klingenberg
0 siblings, 0 replies; only message in thread
From: Peder O. Klingenberg @ 2013-08-16 10:51 UTC (permalink / raw)
To: ding
[-- 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)
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2013-08-16 10:51 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-08-16 10:51 [patch] Posting styles when resending Peder O. Klingenberg
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).