From: peder@news.klingenberg.no (Peder O. Klingenberg)
To: ding@gnus.org
Subject: [patch] Posting styles when resending
Date: Fri, 16 Aug 2013 12:51:18 +0200 [thread overview]
Message-ID: <ks8v01rjrt.fsf@netfonds.no> (raw)
[-- 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)
reply other threads:[~2013-08-16 10:51 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=ks8v01rjrt.fsf@netfonds.no \
--to=peder@news.klingenberg.no \
--cc=ding@gnus.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).