diff gnus-init.el @ 78:0abfe9bf83a0

merge
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Thu, 25 Sep 2025 17:57:05 +0100
parents 104736399f86
children 6dc30991613b
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gnus-init.el	Thu Sep 25 17:57:05 2025 +0100
@@ -0,0 +1,234 @@
+;; gnus customisation
+
+(eval-when-compile
+  (setq my-mail-dir "/bogus")  ; will be overwritten by the following
+)
+
+(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)
+	     (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 ()))
+	    )
+
+;; things based on my-mail-dir, or set-ht-compiled-split
+;; which are defined in one of the above
+
+(set-ht-compiled-split)
+
+(setq
+ gnus-article-save-directory (expand-file-name
+			      (concat my-mail-dir "/Mail"))
+ nnml-directory (expand-file-name (concat my-mail-dir "/Mail"))
+ gnus-message-archive-method
+ `(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-get-new-mail nil)
+   (nnfolder-inhibit-expiry t)
+   )
+)
+
+(setq gnus-novice-user nil)
+
+(setq gnus-message-archive-group
+      '((concat "general." (format-time-string
+			   "%Y-%m" (current-time)))))
+
+
+
+(setq gnus-auto-select-next 'quietly
+      gnus-buttonized-mime-types '("multipart/signed")
+      gnus-group-line-format "%M%S%p%P%5y:%uH%(%g%)%l %O
+"
+      gnus-ignored-headers "^Errors-To:\\|^Precedence:\\|^UNIX-From:"
+      gnus-inhibit-mime-unbuttonizing nil
+      gnus-mime-display-multipart-related-as-mixed t
+      gnus-show-mime t
+      gnus-simplify-subject-regexp "^\\(re[:;.]\\| \\|fwd:\\)*"
+      gnus-summary-display-arrow nil
+      gnus-summary-gather-subject-limit nil
+      gnus-summary-ignore-duplicates t
+      gnus-summary-line-format "%U%R%5N%I%(%[%4L: %-12,12A%]%) %s\n"
+      gnus-summary-make-false-root 'none
+      gnus-thread-sort-functions '(gnus-thread-sort-by-number
+				   gnus-thread-sort-by-simpl-subject)
+      gnus-use-scoring nil	; not used yet
+      message-from-style 'angles
+      mm-discouraged-alternatives '("text/html")
+      nnmail-expiry-wait 28
+      no-select-groups '("nnml+ht:cygwin")
+     )
+
+(setq bbdb/news-auto-create-p t)
+
+(setq wsp-cache nil)
+
+;;;(setq blacklist-db (open-database "~/.blacklist"))
+
+(require 'my-news) ; defines db functions
+
+(open-white)
+(open-ad)
+(open-quaker)
+
+(add-hook 'kill-emacs-hook
+	  (lambda ()
+	    (if (database-live-p whitelist-db)
+		(close-database whitelist-db))
+	    (if (database-live-p quaker-db)
+		(close-database quaker-db))
+	    (if (database-live-p adlist-db)
+		(close-database adlist-db))))
+
+(add-hook 'bbdb-complete-name-hooks 'quaker-sig-if-quaker)
+(add-hook 'gnus-message-setup-hook 'quaker-sig-if-to-quaker)
+
+(setq nnmail-crosspost nil)
+(setq nnmail-split-methods 'nnmail-split-fancy)
+
+(setq white-subjects "\\b\\(phd\\|ilcc\\)\\b")
+
+(setq white-domains (list))
+
+(setq ad-domains (list "planetx.co.uk" "substack.com"))
+
+(defvar ht-compiled-split nil)
+
+(setq gnus-show-mime t) ; stale
+(setq mml1991-use 'pgg
+      mml2015-use 'pgg
+      mm-verify-option 'always)
+
+(require 'mm-decode)
+(setq mm-automatic-display (remove "text/html" mm-automatic-display))
+
+(custom-set-faces)
+
+(defun ht-gnus-summary-delete-forward ()
+  "REAL delete for nnmail gnus"  
+  (interactive)
+  (gnus-summary-delete-article)
+  (gnus-summary-next-unread-article))
+
+(add-hook 'kill-emacs-hook
+	  (lambda ()
+ 	    (if (database-live-p whitelist-db)
+ 		(close-database whitelist-db))
+ 	    (if (database-live-p quaker-db)
+ 		(close-database quaker-db))
+	    (if (database-live-p adlist-db)
+		(close-database adlist-db))
+	    ))
+
+(add-hook 'bbdb-complete-name-hooks 'quaker-sig-if-quaker)
+
+(custom-set-variables
+ '(gnus-treat-display-picons nil))
+(custom-set-faces)
+
+(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
+
+(add-hook 'gnus-summary-mode-hook 'gnus-summary-mode-fun1)
+ 
+(add-hook 'message-mode-hook 'message-mode-fun1)
+
+(add-hook 'message-sent-hook (function whiten-recip))
+
+(add-hook 'gnus-group-mode-hook 'gnus-group-mode-fun1)
+ 
+
+(defun gnus-regen-group ()
+  (nnml-generate-nov-databases-1 (concat
+				  (expand-file-name nnml-directory)
+				  "/"
+				  (substring (gnus-group-group-name) 8))
+				 nil t)
+  )
+(require 'mailcrypt)
+(add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
+(add-hook 'message-mode-hook 'mc-install-write-mode)
+(add-hook 'news-reply-mode-hook 'mc-install-write-mode)
+
+(defun gnus-user-format-function-t (header)
+  "display the to field (for archive messages)"
+  (let ((n (mail-header-number header)))
+    (with-current-buffer nntp-server-buffer
+      (save-excursion
+        (save-restriction
+          (let ((inhibit-point-motion-hooks t))
+            (goto-char (point-min))
+            (let ((beg (search-forward (format " %d Article retrieved." n)))
+                  (end (search-forward "\n.\n")))
+              (narrow-to-region beg end)
+              (goto-char beg)
+              (message-fetch-field "To"))))))))
+
+(make-variable-buffer-local 'gnus-extra-headers)
+(make-variable-buffer-local 'nnmail-extra-headers)
+
+(add-hook 'gnus-parse-headers-hook
+          '(lambda ()
+             (gnus-summary-set-local-parameters gnus-newsgroup-name)))
+
+(defvar ht-gnus-just-read nil)
+
+(add-hook 'gnus-get-new-news-hook (lambda () (setq ht-gnus-just-read nil)))
+
+(add-hook 'gnus-after-getting-new-news-hook
+          (lambda () (message "%s" ht-gnus-just-read)))
+
+(defun ht-gnus-note-save-to-group ()
+  (let ((g (caar group-art)))
+    (if (not (member g ht-gnus-just-read))
+	(setq ht-gnus-just-read (cons g ht-gnus-just-read)))))
+
+(add-hook 'nnml-prepare-save-mail-hook (function ht-gnus-note-save-to-group))
+
+(require 'gnus-art)
+
+(nconc gnus-treatment-function-alist
+       '((gnus-treat-strip-uoe-warning  gnus-article-strip-uoe-warning)))
+
+(defun gnus-article-strip-uoe-warning (&optional interactive &rest args)
+  "redirect for stripping"
+  (interactive (list t))
+  (save-excursion
+    (set-buffer gnus-article-buffer)
+    (if interactive
+	(call-interactively 'article-strip-uoe-warning)
+      (apply 'article-strip-uoe-warning args))))
+
+(defun article-strip-uoe-warning ()
+  "strip the stupid uoe warning"
+  (interactive)
+  (save-excursion
+    (article-goto-body)
+    (let ((case-fold-search t))
+      (when
+	  (looking-at "This email was sent to you by someone outside the University.")
+	(gnus-delete-line))
+      (when
+	  (looking-at "You should only click on links or attachments if you are certain that the email is genuine and the content is safe.")
+	(gnus-delete-line))
+      )))
+
+(setq gnus-treat-strip-uoe-warning t)
+
+(provide 'gnus-init)