Gnus development mailing list
 help / color / mirror / Atom feed
From: Michael Shields <shields@msrl.com>
Subject: [PATCH] Strip banners based on both user address and group (resend)
Date: Wed, 12 Feb 2003 17:59:44 +0000	[thread overview]
Message-ID: <87isvp752n.fsf@mulligatwani.msrl.com> (raw)

Resending now that I have papers on file.

Currently, if you've defined a banner in the group parameters,
`gnus-article-address-banner-alist' will be ignored.  This patch
corrects that.

(It looks like a big patch, but it's mostly indentation change.)


2003-02-12  Michael Shields  <shields@msrl.com>

	* gnus-art.el (article-strip-banner): Strip both per-group and
	per-user-address banners.
	(article-really-strip-banner): New.

Index: lisp/gnus-art.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus-art.el,v
retrieving revision 6.293
diff -u -r6.293 gnus-art.el
--- lisp/gnus-art.el	12 Feb 2003 15:06:16 -0000	6.293
+++ lisp/gnus-art.el	12 Feb 2003 18:03:15 -0000
@@ -2299,43 +2301,50 @@
 	     (match-beginning 0) (match-end 0) 'pem)))))))
 
 (defun article-strip-banner ()
-  "Strip the banner specified by the `banner' group parameter."
+  "Strip the banners specified by the `banner' group parameter and by
+`gnus-article-address-banner-alist'."
   (interactive)
   (save-excursion
     (save-restriction
+      (let ((inhibit-point-motion-hooks t))
+	(when (gnus-parameter-banner gnus-newsgroup-name)
+	  (article-really-strip-banner
+	   (gnus-parameter-banner gnus-newsgroup-name)))
+	(when gnus-article-address-banner-alist
+	  (article-really-strip-banner
+	   (let ((from (save-restriction
+			 (widen)
+			 (article-narrow-to-head)
+			 (mail-fetch-field "from"))))
+	     (when (and from
+			(setq from
+			      (caar (mail-header-parse-addresses from))))
+	       (catch 'found
+		 (dolist (pair gnus-article-address-banner-alist)
+		   (when (string-match (car pair) from)
+		     (throw 'found (cdr pair)))))))))))))
+
+(defun article-really-strip-banner (banner)
+  "Strip the banner specified by the argument."
+  (save-excursion
+    (save-restriction
       (let ((inhibit-point-motion-hooks t)
-	    (banner (gnus-parameter-banner gnus-newsgroup-name))
 	    (gnus-signature-limit nil)
-	    buffer-read-only beg end)
-	(when (and gnus-article-address-banner-alist
-		   (not banner))
-	  (setq banner
-		(let ((from (save-restriction
-			      (widen)
-			      (article-narrow-to-head)
-			      (mail-fetch-field "from"))))
-		  (when (and from
-			     (setq from
-				   (caar (mail-header-parse-addresses from))))
-		    (catch 'found
-		      (dolist (pair gnus-article-address-banner-alist)
-			(when (string-match (car pair) from)
-			  (throw 'found (cdr pair)))))))))
-	(when banner
-	  (article-goto-body)
-	  (cond
-	   ((eq banner 'signature)
-	    (when (gnus-article-narrow-to-signature)
-	      (widen)
-	      (forward-line -1)
-	      (delete-region (point) (point-max))))
-	   ((symbolp banner)
-	    (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
-		(while (re-search-forward banner nil t)
-		  (delete-region (match-beginning 0) (match-end 0)))))
-	   ((stringp banner)
-	    (while (re-search-forward banner nil t)
-	      (delete-region (match-beginning 0) (match-end 0))))))))))
+	    buffer-read-only)
+	(article-goto-body)
+	(cond
+	 ((eq banner 'signature)
+	  (when (gnus-article-narrow-to-signature)
+	    (widen)
+	    (forward-line -1)
+	    (delete-region (point) (point-max))))
+	 ((symbolp banner)
+	  (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
+	      (while (re-search-forward banner nil t)
+		(delete-region (match-beginning 0) (match-end 0)))))
+	 ((stringp banner)
+	  (while (re-search-forward banner nil t)
+	    (delete-region (match-beginning 0) (match-end 0)))))))))
 
 (defun article-babel ()
   "Translate article using an online translation service."

-- 
Shields.




             reply	other threads:[~2003-02-12 17:59 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2003-02-12 17:59 Michael Shields [this message]
2003-02-12 20:23 ` Kai Großjohann
2003-02-12 23:38   ` Michael Shields
2003-02-13 11:28     ` Kai Großjohann

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=87isvp752n.fsf@mulligatwani.msrl.com \
    --to=shields@msrl.com \
    /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).