X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/3e0bbf902b9e91e6bbea4774672c8a1ac0835fe0..aa6eb0dd5935f5aac2e2cbc251477540e6415229:/dot/gnus.el

diff --git a/dot/gnus.el b/dot/gnus.el
index 7276865..ff2210e 100644
--- a/dot/gnus.el
+++ b/dot/gnus.el
@@ -36,7 +36,17 @@
 
 ;; Display a slrn-like tree view in the summary window.
 (setq gnus-use-trees nil)
-(setq gnus-summary-line-format "%U%R%z%4L %(%[%-16,16f%]%): %B %s\n")
+(setq gnus-summary-make-false-root 'dummy)
+(setq gnus-summary-line-format
+	"%U%R%z%4L %(%[%-16,16f%]%): %&user-date; %B %s\n"
+      gnus-summary-dummy-line-format
+	"        %(%[----------------%]%):           * %S\n"
+      gnus-user-date-format-alist
+	'(((gnus-seconds-today) . "*** %H:%M")
+	  (604800 . "%a %H:%M")
+	  ((gnus-seconds-month) . "   %a %_d")
+	  ((gnus-seconds-year) . "   %_d %b")
+	  (t . " %b %Y")))
 (setq gnus-sum-thread-tree-root ">"
       gnus-sum-thread-tree-false-root ">"
       gnus-sum-thread-tree-single-indent "="
@@ -52,9 +62,24 @@
 
 ;; Sort threads in a useful way.
 (setq gnus-thread-sort-functions
-      '(gnus-thread-sort-by-number
-	gnus-thread-sort-by-subject
-	gnus-thread-sort-by-total-score))
+	'(gnus-thread-sort-by-number
+	  gnus-thread-sort-by-subject
+	  gnus-thread-sort-by-total-score))
+
+;; Configure the crypto.
+(setq mm-verify-option 'known
+      mm-sign-option 'guided
+      mm-decrypt-option 'never)
+
+;; Tracking available groups.  These should work for sane servers, but maybe
+;; they'll need hacking in the local file.
+(setq gnus-save-killed-list nil
+      gnus-check-bogus-newsgroups nil
+      gnus-read-active-file 'ask-server)
+
+;; Don't skip unread groups.
+(setq gnus-group-goto-unread nil
+      gnus-summary-next-group-on-exit nil)
 
 ;; Use one article buffer per group.
 (setq gnus-single-article-buffer nil)
@@ -74,11 +99,159 @@
 ;; We may have the misfortune to talk to an Exchange server.
 (setq imap-enable-exchange-bug-workaround t)
 
+;; Save articles in mbox format by default, of course, and save an entire
+;; batch with the same name.
+(setq gnus-prompt-before-saving t
+      gnus-default-article-saver 'gnus-summary-save-in-mail)
+
+;; Clean up properly when closing the summary.
+(defadvice gnus-summary-exit (before mdw-kill-debris compile activate)
+  (gnus-summary-expand-window))
+
+;; Configure article display a bit.
+(defun mdw-gnus-article-setup ()
+  (setq truncate-lines nil
+	truncate-partial-width-windows nil
+	word-wrap t
+	wrap-prefix (concat (propertize "..." 'face 'mdw-ellipsis-face)
+			    " ")))
+(add-hook 'gnus-article-mode-hook #'mdw-gnus-article-setup)
+
+;; Don't expire articles on selection if they're alread read.  This provides
+;; a handy way to prevent expiry, and actually forcing expiry isn't
+;; significantly harder.
+(remove-hook 'gnus-mark-article-hook
+	     'gnus-summary-mark-read-and-unread-as-read)
+(add-hook 'gnus-mark-article-hook 'gnus-summary-mark-unread-as-read)
+
+;; Leave an oubliette level 7 for broken things which look like mailboxes.
+;; Otherwise Gnus keeps on resurrecting them and later realising that they're
+;; bogus.
+(setq gnus-level-unsubscribed 6)
+
+;; Reconfigure the `nnmail-split-fancy' syntax table to be less mad.
+(setq nnmail-split-fancy-syntax-table
+      (let ((table (make-syntax-table)))
+
+	;; This is from upstream.  I don't know what it's for.
+	(modify-syntax-entry ?% "." table)
+
+	;; Email addresses are often wrapped in `<...>', so don't consider
+	;; those to be part of the address.
+	(modify-syntax-entry ?< "(>" table)
+	(modify-syntax-entry ?> ")<" table)
+
+	;; Email addresses definitely contain `.'.
+	(modify-syntax-entry ?. "_" table)
+
+	;; Done.
+	table))
+
+;;;--------------------------------------------------------------------------
+;;; Magic for sending mail the correct way.
+
+(defvar mdw-send-mail-alist nil
+  "An alist containing ways of sending email.
+The keys are symbols naming mail-sending methods.  The values are
+alists mapping Lisp variable names to values which will be bound
+around a call to the underlying `send-mail-function'.  See
+`mdw-message-send-it'.")
+
+(defvar mdw-guess-send-mail-alist nil
+  "An alist for guessing the right way to send mail from a `From' address.
+The keys are (Emacs-style) regular expressions.  The values are
+strings naming mail-sending methods, to be used if there is no
+`mdw-send-mail-header-name' mail header.")
+
+(defvar mdw-send-mail-header-name "X-mdw-Send-Mail"
+  "Mail header used to override the mail-sending method.
+If a header with this name exists, then `mdw-message-send-it'
+will look its value up in `mdw-send-mail-alist' to find out how
+to send the message.  The idea is that you can set this header
+from `gnus-posting-styles'.  The header will be stripped on
+sending.")
+
+(defvar mdw-default-send-mail-method nil
+  "The name of the default mail-sending method.")
+
+(defun mdw-message-send-it ()
+  "Send mail using the appropriate mail sending method.
+Firstly, a mail-sending method name is determined.  If
+`mdw-send-mail-header-name' has a non-nil value, and a header
+with this name exists in the message being sent, then its value
+is used as the name.  Otherwise, the email address from the
+`From' header is matched against the named of the association in
+`mdw-guess-send-mail-alist', and if any of them match then the
+corresponding value is used as the name.  Otherwise, the value of
+`mdw-default-send-mail-method' is used.
+
+The name is then looked up in `mdw-send-mail-alist' to find an
+alist of temporary variable bindings; an error is reported if no
+matching entry is found.  The variables are temporarily bound to
+their corresponding values, and the (possibly freshly rebound)
+`send-mail-function' is invoked with no parameters.
+
+If the method name is `nil', then `send-mail-function' is simply
+invoked without doing anything else very special.  This can
+therefore be left as a useful default, if it's generally the
+right thing."
+
+  (let* ((method-name
+	  (or
+
+	   ;; Firstly, if there's an explicit header in the message, then
+	   ;; we'd better use that.
+	   (let ((method (message-fetch-field mdw-send-mail-header-name)))
+	     (and method (intern method)))
+
+	   ;; Look up the sender's address in the guess list.
+	   (let* ((sender (some #'message-fetch-field
+				'("resent-sender" "resent-from"
+				  "sender" "from")))
+		  (addr (cadr (mail-extract-address-components sender)))
+		  (alist mdw-guess-send-mail-alist)
+		  assoc)
+	     (catch 'found
+	       (while alist
+		 (setq assoc (pop alist))
+		 (when (string-match (car assoc) addr)
+		   (throw 'found (cdr assoc))))
+	       nil))
+
+	   ;; Otherwise use the default.
+	   mdw-default-send-mail-method))
+
+	 (method (and method-name
+		      (let ((assoc (assq method-name mdw-send-mail-alist)))
+			(if assoc (cdr assoc)
+			  (error "Unknown send-mail method `%s'."
+				 method-name))))))
+
+    ;; Bind the appropriate variables.
+    (progv
+	(mapcar #'car method)
+	(mapcar #'cdr method)
+
+      ;; Make a copy of the buffer and strip out our magic header.  (If the
+      ;; message send fails, it would be annoying to have lost the magic
+      ;; token which tells us how to retry properly.)
+      (let ((buf (current-buffer)))
+	(with-temp-buffer
+	  (insert-buffer buf)
+	  (message-remove-header mdw-send-mail-header-name)
+	  (funcall send-mail-function))))))
+
+(setq message-send-mail-function 'mdw-message-send-it)
+
 ;;;--------------------------------------------------------------------------
 ;;; Local configuration.
 
 ;; Fetching news from the local news server seems sensible.
-(setq gnus-select-method `(nntp ,(mdw-config 'nntp-server)))
+(setq gnus-select-method
+      (let ((server (mdw-config 'nntp-server)))
+	(if server
+	    `(nntp ,server)
+	  '(nnnil ""))))
 
 ;; Now load a local configuration file.
 (load "~/.gnus-local.el")