Mercurial > hg > xemacs
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
--- 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))
