diff my-news.el @ 70:ef61b0f32027

merge
author Henry Thompson <ht@markup.co.uk>
date Mon, 09 Jun 2025 13:21:36 +0100
parents a9b2a2335782
children e5b0b98e81a0
line wrap: on
line diff
--- a/my-news.el	Mon Jun 09 13:21:04 2025 +0100
+++ b/my-news.el	Mon Jun 09 13:21:36 2025 +0100
@@ -122,17 +122,25 @@
 	res
       (message "%s" res))))
 
-(defun add-white (&optional addToBBDB)
+(defun add-white (&optional dontAddToBBDB)
+  "While reading an article, add to whitelist"
   (interactive "P")
   (gnus-summary-goto-article (gnus-summary-article-number))
-  (let* ((components (get-current-from-components))
+  (do-add-white (gnus-fetch-original-field "From") dontAddToBBDB))
+
+(defun do-add-white (addr &optional dontAddToBBDB)
+  (let* ((components (gnus-extract-address-components addr))
 	 (addr (get-canonical-from-addr components)))
+    (if (not dontAddToBBDB)
+	(let ((bbdb-no-duplicates-p t))
+	  (condition-case nil
+	      (bbdb-create-internal (car components) nil
+				    (cadr components) nil nil nil)
+	    (error
+	     ;; OK, just means already present
+	     ))))
     (if (new-white addr)
-	(save-white))
-    (if addToBBDB
-	(let ((bbdb-no-duplicates-p t))
-	  (bbdb-create-internal (car components) nil (cadr components)
-				nil nil nil)))))
+	(save-white))))
 
 (defun add-ad ()             
   (interactive)                 
@@ -150,7 +158,7 @@
       (save-quaker))
     (quaker-sig-maybe)))
 
-; not needed anymore because of gnus-posting-styles (q.v. in gnus-init)
+; not needed anymore because of gnus-posting-styles (q.v. in mail-from-*)
 (defun quaker-sig-if-to-quaker ()
   (let ((message-options))
     (save-excursion (message-options-set-recipient))
@@ -274,10 +282,11 @@
 
 (defun whiten-recip ()
   ;;; a hook for outgoing mail
-  (let* ((recips (message-options-get 'message-recipients))
-         (res (mapcar (function new-white)
-		      (split-string (downcase recips)
-				    ",[ \f\t\n\r\v]*" t))))
+  (let* ((to (message-fetch-field "To"))
+	 (cc (message-fetch-field "cc"))
+	 (msg-recipients (concat to (and to cc ", ") cc))
+	 (recips (message-tokenize-header msg-recipients))
+         (res (mapcar (function do-add-white) recips)))
     (while (and res (not (car res)))
       (setq res (cdr res)))
     (if res (save-white))))
@@ -290,6 +299,7 @@
     t))
 
 (defun new-ad (addr)
+  (new-white addr)
   (if (get-database addr adlist-db)
       nil
     (put-database addr "t" adlist-db)
@@ -799,7 +809,7 @@
 
 (defun use-text-not-html (&optional clear)
   (when (and (if clear (looking-at "<html")
-	       (looking-at "> <html"))
+	       (looking-at "> <\\(html\\|div\\)"))
 	     (bufferp (get-buffer "*Shell Command Output*")))
     ;; replace HTML only with result of my HTML filter
     (delete-region (point)(mark t))