Mercurial > hg > xemacs

changeset 63:e7c2deb7de20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
old changes ??, get add-white working
author Henry S Thompson <ht@inf.ed.ac.uk>
date Mon, 16 Dec 2024 18:19:39 +0000
parents fea10b67cc09
children bb72900f9e0b
files my-news.el
diffstat 1 files changed, 21 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- a/my-news.el	Thu Sep 19 16:00:40 2024 +0100
+++ b/my-news.el	Mon Dec 16 18:19:39 2024 +0000
@@ -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))))