From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/83740 Path: news.gmane.org!not-for-mail From: peder@news.klingenberg.no (Peder O. Klingenberg) Newsgroups: gmane.emacs.gnus.general Subject: [patch] Posting styles when resending Date: Fri, 16 Aug 2013 12:51:18 +0200 Organization: Persons in a Position to Know, inc. Message-ID: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1376669407 22497 80.91.229.3 (16 Aug 2013 16:10:07 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 16 Aug 2013 16:10:07 +0000 (UTC) To: ding@gnus.org Original-X-From: ding-owner+M31996@lists.math.uh.edu Fri Aug 16 18:10:07 2013 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VAMbG-0001tD-Ly for ding-account@gmane.org; Fri, 16 Aug 2013 18:10:07 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1VAMaA-0002Jg-4N; Fri, 16 Aug 2013 11:08:58 -0500 Original-Received: from mx1.math.uh.edu ([129.7.128.32]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1VAHd5-000117-85 for ding@lists.math.uh.edu; Fri, 16 Aug 2013 05:51:39 -0500 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx1.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.76) (envelope-from ) id 1VAHd2-00008W-OO for ding@lists.math.uh.edu; Fri, 16 Aug 2013 05:51:38 -0500 Original-Received: from plane.gmane.org ([80.91.229.3]) by quimby.gnus.org with esmtp (Exim 4.72) (envelope-from ) id 1VAHd0-0004Ig-Pr for ding@gnus.org; Fri, 16 Aug 2013 12:51:34 +0200 Original-Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1VAHcy-0002qt-TA for ding@gnus.org; Fri, 16 Aug 2013 12:51:32 +0200 Original-Received: from luna.netfonds.no ([80.91.225.79]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 16 Aug 2013 12:51:32 +0200 Original-Received: from peder by luna.netfonds.no with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 16 Aug 2013 12:51:32 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 149 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: luna.netfonds.no User-Agent: Gnus/5.130008 (Ma Gnus v0.8) Emacs/24.3.50 (gnu/linux) Cancel-Lock: sha1:TCd8UrcihT22IbRkPEGFDEEPVi4= X-Spam-Score: -4.6 (----) List-ID: Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:83740 Archived-At: --=-=-= Content-Type: text/plain 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. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=resend-posting-style.patch 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) --=-=-=--