# HG changeset patch # User Henry S Thompson # Date 1734373179 0 # Node ID e7c2deb7de205495cc21af481902a542141a349f # Parent fea10b67cc09260e4f23b6414377fb77a641e6d4 old changes ??, get add-white working diff -r fea10b67cc09 -r e7c2deb7de20 my-news.el --- 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))))