changeset 70:ef61b0f32027

merge
author Henry Thompson <ht@markup.co.uk>
date Mon, 09 Jun 2025 13:21:36 +0100
parents d43503e9e431 (current diff) a9b2a2335782 (diff)
children 27003cf1744b
files
diffstat 4 files changed, 43 insertions(+), 18 deletions(-) [+]
line wrap: on
line diff
Binary file common-init.el has changed
--- a/gnus-init.el	Mon Jun 09 13:21:04 2025 +0100
+++ b/gnus-init.el	Mon Jun 09 13:21:36 2025 +0100
@@ -7,8 +7,20 @@
 (site-caseq (edin
 	     (require 'mail-from-inf))
 	    (maritain
+	     (message "1 %s %s" (and (boundp 'gnus-server-alist)
+				     gnus-server-alist)
+				     (and (boundp 'gnus-message-archive-method)
+					  gnus-message-archive-method))
 	     (require 'mail-from-m)
-	     (load-file (expand-file-name "~/.xemacs/gnus.el")))
+	     (message "2 %s %s" (and (boundp 'gnus-server-alist)
+				     gnus-server-alist)
+				     (and (boundp 'gnus-message-archive-method)
+					  gnus-message-archive-method))
+	     (load-file (expand-file-name "~/.xemacs/gnus.el"))
+	     (message "3 %s %s" (and (boundp 'gnus-server-alist)
+				     gnus-server-alist)
+				     (and (boundp 'gnus-message-archive-method)
+					  gnus-message-archive-method)))
 	    (t
 	     (defun set-ht-compiled-split ()))
 	    )
@@ -23,11 +35,13 @@
 			      (concat my-mail-dir "/Mail"))
  nnml-directory (expand-file-name (concat my-mail-dir "/Mail"))
  gnus-message-archive-method
- '(nnfolder "archive"
+ `(nnfolder "archive"
    ;; the following two are not taking effect, not sure why, answer
    ;; _may_ lie in gnus-setup-news...
-   (nnfolder-directory (concat my-mail-dir "/cpy"))
-   (nnfolder-active-file (concat my-mail-dir "/cpy/active"))
+   (nnfolder-directory ,(concat my-mail-dir "/cpy"))
+   (nnfolder-active-file ,(concat my-mail-dir "/cpy/active"))
+   (nnfolder-get-new-mail nil)
+   (nnfolder-inhibit-expiry t)
    )
 )
 
--- a/mail-from-m.el	Mon Jun 09 13:21:04 2025 +0100
+++ b/mail-from-m.el	Mon Jun 09 13:21:36 2025 +0100
@@ -1,7 +1,8 @@
 ;;; Load to read and send mail from maritain
 
 (setq mail-append-host "home.hst.name")
-(setq user-mail-address (format "%s@home.hst.name" user-name))
+(make-variable-buffer-local 'user-mail-address)
+(setq-default user-mail-address (format "%s@home.hst.name" user-name))
 (setq mail-host-address "home.hst.name")
 (defun system-name () "home.hst.name")
 
--- 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))