chiark - git - mdw - profile/blob - dot/gnus.el

   1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
   2 ;;;
   3 ;;; GNUS configuration
   4 ;;;
   5 ;;; (c) 2009 Mark Wooding
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 2 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software
  22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
  23
  24 ;;;--------------------------------------------------------------------------
  25 ;;; General Gnus preferences.
  26
  27 ;; Divide the main groups list by topics.
  28 (add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
  29 (setq gnus-subscribe-newsgroup-method 'gnus-subscribe-topics)
  30
  31 ;; Use hacky movemail program to move mail.
  32 (setq mail-source-movemail-program "~/bin/movemail-hack")
  33
  34 ;; Don't force use of a full window.
  35 (setq gnus-use-full-window nil)
  36
  37 ;; Display a slrn-like tree view in the summary window.
  38 (setq gnus-use-trees nil)
  39 (setq gnus-summary-line-format "%U%R%z%4L %(%[%-16,16f%]%): %B %s\n")
  40 (setq gnus-sum-thread-tree-root ">"
  41       gnus-sum-thread-tree-false-root ">"
  42       gnus-sum-thread-tree-single-indent "="
  43       gnus-sum-thread-tree-indent "  ")
  44 (if (memq (coding-system-get (terminal-coding-system) 'mime-charset)
  45           '(nil utf-8))
  46     (setq gnus-sum-thread-tree-leaf-with-other "├─>"
  47           gnus-sum-thread-tree-vertical        "│ "
  48           gnus-sum-thread-tree-single-leaf     "╰─>")
  49   (setq gnus-sum-thread-tree-leaf-with-other   "|->"
  50         gnus-sum-thread-tree-vertical          "| "
  51         gnus-sum-thread-tree-single-leaf       "`->"))
  52
  53 ;; Sort threads in a useful way.
  54 (setq gnus-thread-sort-functions
  55       '(gnus-thread-sort-by-number
  56         gnus-thread-sort-by-subject
  57         gnus-thread-sort-by-total-score))
  58
  59 ;; Configure the crypto.
  60 (setq mm-verify-option 'known
  61       mm-sign-option 'guided
  62       mm-decrypt-option 'never)
  63
  64 ;; Tracking available groups.  These should work for sane servers, but maybe
  65 ;; they'll need hacking in the local file.
  66 (setq gnus-save-killed-list nil
  67       gnus-check-bogus-newsgroups nil
  68       gnus-read-active-file 'ask-server)
  69
  70 ;; Use one article buffer per group.
  71 (setq gnus-single-article-buffer nil)
  72
  73 ;; Don't expand threads on initial opening.
  74 (setq gnus-thread-hide-subtree t)
  75
  76 ;; Don't use strange icons instead of traditional smileys.
  77 (setq gnus-treat-display-smileys nil)
  78
  79 ;; Fairly large numbers of articles are OK; don't bother warning me.
  80 (setq gnus-large-newsgroup 500)
  81
  82 ;; When splitting articles, crossposting is a reasonable thing to do.
  83 (setq nnimap-split-crosspost t)
  84
  85 ;; We may have the misfortune to talk to an Exchange server.
  86 (setq imap-enable-exchange-bug-workaround t)
  87
  88 ;; Save articles in mbox format by default, of course, and save an entire
  89 ;; batch with the same name.
  90 (setq gnus-prompt-before-saving t
  91       gnus-default-article-saver 'gnus-summary-save-in-mail)
  92
  93 ;; Clean up properly when closing the summary.
  94 (defadvice gnus-summary-exit (before mdw-kill-debris compile activate)
  95   (gnus-summary-expand-window))
  96
  97 ;; Configure article display a bit.
  98 (defun mdw-gnus-article-setup ()
  99   (setq truncate-lines nil
 100         truncate-partial-width-windows nil
 101         word-wrap t
 102         wrap-prefix (concat (propertize "..." 'face 'mdw-ellipsis-face)
 103                             " ")))
 104 (add-hook 'gnus-article-mode-hook #'mdw-gnus-article-setup)
 105
 106 ;;;--------------------------------------------------------------------------
 107 ;;; Magic for sending mail the correct way.
 108
 109 (defvar mdw-send-mail-alist nil
 110   "An alist containing ways of sending email.
 111 The keys are symbols naming mail-sending methods.  The values are
 112 alists mapping Lisp variable names to values which will be bound
 113 around a call to the underlying `send-mail-function'.  See
 114 `mdw-message-send-it'.")
 115
 116 (defvar mdw-guess-send-mail-alist nil
 117   "An alist for guessing the right way to send mail from a `From' address.
 118 The keys are (Emacs-style) regular expressions.  The values are
 119 strings naming mail-sending methods, to be used if there is no
 120 `mdw-send-mail-header-name' mail header.")
 121
 122 (defvar mdw-send-mail-header-name "X-mdw-Send-Mail"
 123   "Mail header used to override the mail-sending method.
 124 If a header with this name exists, then `mdw-message-send-it'
 125 will look its value up in `mdw-send-mail-alist' to find out how
 126 to send the message.  The idea is that you can set this header
 127 from `gnus-posting-styles'.  The header will be stripped on
 128 sending.")
 129
 130 (defvar mdw-default-send-mail-method nil
 131   "The name of the default mail-sending method.")
 132
 133 (defun mdw-message-send-it ()
 134   "Send mail using the appropriate mail sending method.
 135 Firstly, a mail-sending method name is determined.  If
 136 `mdw-send-mail-header-name' has a non-nil value, and a header
 137 with this name exists in the message being sent, then its value
 138 is used as the name.  Otherwise, the email address from the
 139 `From' header is matched against the named of the association in
 140 `mdw-guess-send-mail-alist', and if any of them match then the
 141 corresponding value is used as the name.  Otherwise, the value of
 142 `mdw-default-send-mail-method' is used.
 143
 144 The name is then looked up in `mdw-send-mail-alist' to find an
 145 alist of temporary variable bindings; an error is reported if no
 146 matching entry is found.  The variables are temporarily bound to
 147 their corresponding values, and the (possibly freshly rebound)
 148 `send-mail-function' is invoked with no parameters.
 149
 150 If the method name is `nil', then `send-mail-function' is simply
 151 invoked without doing anything else very special.  This can
 152 therefore be left as a useful default, if it's generally the
 153 right thing."
 154
 155   (let* ((method-name
 156           (or
 157
 158            ;; Firstly, if there's an explicit header in the message, then
 159            ;; we'd better use that.
 160            (let ((method (message-fetch-field mdw-send-mail-header-name)))
 161              (and method (intern method)))
 162
 163            ;; Look up the sender's address in the guess list.
 164            (let* ((sender (some #'message-fetch-field
 165                                 '("resent-sender" "resent-from"
 166                                   "sender" "from")))
 167                   (addr (cadr (mail-extract-address-components sender)))
 168                   (alist mdw-guess-send-mail-alist)
 169                   assoc)
 170              (catch 'found
 171                (while alist
 172                  (setq assoc (pop alist))
 173                  (when (string-match (car assoc) addr)
 174                    (throw 'found (cdr assoc))))
 175                nil))
 176
 177            ;; Otherwise use the default.
 178            mdw-default-send-mail-method))
 179
 180          (method (and method-name
 181                       (let ((assoc (assq method-name mdw-send-mail-alist)))
 182                         (if assoc (cdr assoc)
 183                           (error "Unknown send-mail method `%s'."
 184                                  method-name))))))
 185
 186     ;; Bind the appropriate variables.
 187     (progv
 188         (mapcar #'car method)
 189         (mapcar #'cdr method)
 190
 191       ;; Make a copy of the buffer and strip out our magic header.  (If the
 192       ;; message send fails, it would be annoying to have lost the magic
 193       ;; token which tells us how to retry properly.)
 194       (let ((buf (current-buffer)))
 195         (with-temp-buffer
 196           (insert-buffer buf)
 197           (message-remove-header mdw-send-mail-header-name)
 198           (funcall send-mail-function))))))
 199
 200 (setq message-send-mail-function 'mdw-message-send-it)
 201
 202 ;;;--------------------------------------------------------------------------
 203 ;;; Local configuration.
 204
 205 ;; Fetching news from the local news server seems sensible.
 206 (setq gnus-select-method
 207       (let ((server (mdw-config 'nntp-server)))
 208         (if server
 209             `(nntp ,server)
 210           '(nnnil ""))))
 211
 212 ;; Now load a local configuration file.
 213 (load "~/.gnus-local.el")
 214
 215 ;;;----- That's all, folks --------------------------------------------------