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 ;; Honour character widths correctly.  Otherwise the screen gets properly
  38 ;; messed up.
  39 (setq gnus-use-correct-string-widths t)
  40
  41 ;; Display a slrn-like tree view in the summary window.
  42 (setq gnus-use-trees nil)
  43 (setq gnus-summary-make-false-root 'dummy)
  44 (setq gnus-summary-line-format
  45         "%U%R%z%4L %(%[%-16,16f%]%): %&user-date; %B %s\n"
  46       gnus-summary-dummy-line-format
  47         "        %(%[----------------%]%):           * %S\n"
  48       gnus-user-date-format-alist
  49         '(((gnus-seconds-today) . "*** %H:%M")
  50           (604800 . "%a %H:%M")
  51           ((gnus-seconds-month) . "   %a %_d")
  52           ((gnus-seconds-year) . "   %_d %b")
  53           (t . " %b %Y")))
  54 (setq gnus-sum-thread-tree-root ">"
  55       gnus-sum-thread-tree-false-root ">"
  56       gnus-sum-thread-tree-single-indent "="
  57       gnus-sum-thread-tree-indent "  ")
  58 (if (memq (coding-system-get (terminal-coding-system) 'mime-charset)
  59           '(nil utf-8))
  60     (setq gnus-sum-thread-tree-leaf-with-other "├─>"
  61           gnus-sum-thread-tree-vertical        "│ "
  62           gnus-sum-thread-tree-single-leaf     "╰─>")
  63   (setq gnus-sum-thread-tree-leaf-with-other   "|->"
  64         gnus-sum-thread-tree-vertical          "| "
  65         gnus-sum-thread-tree-single-leaf       "`->"))
  66
  67 ;; Sort threads in a useful way.
  68 (setq gnus-thread-sort-functions
  69         '(gnus-thread-sort-by-number
  70           gnus-thread-sort-by-subject
  71           gnus-thread-sort-by-total-score))
  72
  73 ;; Configure the crypto.
  74 (setq mm-verify-option 'known
  75       mm-sign-option 'guided
  76       mm-decrypt-option 'never)
  77
  78 ;; Tracking available groups.  These should work for sane servers, but maybe
  79 ;; they'll need hacking in the local file.
  80 (setq gnus-save-killed-list nil
  81       gnus-check-bogus-newsgroups nil
  82       gnus-read-active-file 'ask-server)
  83
  84 ;; Don't skip unread groups.
  85 (setq gnus-group-goto-unread nil
  86       gnus-summary-next-group-on-exit nil)
  87
  88 ;; Use one article buffer per group.
  89 (setq gnus-single-article-buffer nil)
  90
  91 ;; Don't expand threads on initial opening.
  92 (setq gnus-thread-hide-subtree t)
  93
  94 ;; Don't use strange icons instead of traditional smileys.
  95 (setq gnus-treat-display-smileys nil)
  96
  97 ;; Fairly large numbers of articles are OK; don't bother warning me.
  98 (setq gnus-large-newsgroup 500)
  99
 100 ;; When splitting articles, crossposting is a reasonable thing to do.
 101 (setq nnimap-split-crosspost t)
 102
 103 ;; We may have the misfortune to talk to an Exchange server.
 104 (setq imap-enable-exchange-bug-workaround t)
 105
 106 ;; Save articles in mbox format by default, of course, and save an entire
 107 ;; batch with the same name.
 108 (setq gnus-prompt-before-saving t
 109       gnus-default-article-saver 'gnus-summary-save-in-mail)
 110
 111 ;; Clean up properly when closing the summary.
 112 (defadvice gnus-summary-exit (before mdw-kill-debris compile activate)
 113   (gnus-summary-expand-window))
 114
 115 ;; Configure article display a bit.
 116 (defun mdw-gnus-article-setup ()
 117   (setq truncate-lines nil
 118         truncate-partial-width-windows nil
 119         word-wrap t
 120         wrap-prefix (concat (propertize "..." 'face 'mdw-ellipsis-face)
 121                             " ")))
 122 (add-hook 'gnus-article-mode-hook #'mdw-gnus-article-setup)
 123
 124 ;; Don't expire articles on selection if they're alread read.  This provides
 125 ;; a handy way to prevent expiry, and actually forcing expiry isn't
 126 ;; significantly harder.
 127 (remove-hook 'gnus-mark-article-hook
 128              'gnus-summary-mark-read-and-unread-as-read)
 129 (add-hook 'gnus-mark-article-hook 'gnus-summary-mark-unread-as-read)
 130
 131 ;; Leave an oubliette level 7 for broken things which look like mailboxes.
 132 ;; Otherwise Gnus keeps on resurrecting them and later realising that they're
 133 ;; bogus.
 134 (setq gnus-level-unsubscribed 6)
 135
 136 ;; Reconfigure the `nnmail-split-fancy' syntax table to be less mad.
 137 (setq nnmail-split-fancy-syntax-table
 138       (let ((table (make-syntax-table)))
 139
 140         ;; This is from upstream.  I don't know what it's for.
 141         (modify-syntax-entry ?% "." table)
 142
 143         ;; Email addresses are often wrapped in `<...>', so don't consider
 144         ;; those to be part of the address.
 145         (modify-syntax-entry ?< "(>" table)
 146         (modify-syntax-entry ?> ")<" table)
 147
 148         ;; Email addresses definitely contain `.'.
 149         (modify-syntax-entry ?. "_" table)
 150
 151         ;; Done.
 152         table))
 153
 154 ;;;--------------------------------------------------------------------------
 155 ;;; Magic for sending mail the correct way.
 156
 157 (defvar mdw-send-mail-alist nil
 158   "An alist containing ways of sending email.
 159 The keys are symbols naming mail-sending methods.  The values are
 160 alists mapping Lisp variable names to values which will be bound
 161 around a call to the underlying `send-mail-function'.  See
 162 `mdw-message-send-it'.")
 163
 164 (defvar mdw-guess-send-mail-alist nil
 165   "An alist for guessing the right way to send mail from a `From' address.
 166 The keys are (Emacs-style) regular expressions.  The values are
 167 strings naming mail-sending methods, to be used if there is no
 168 `mdw-send-mail-header-name' mail header.")
 169
 170 (defvar mdw-send-mail-header-name "X-mdw-Send-Mail"
 171   "Mail header used to override the mail-sending method.
 172 If a header with this name exists, then `mdw-message-send-it'
 173 will look its value up in `mdw-send-mail-alist' to find out how
 174 to send the message.  The idea is that you can set this header
 175 from `gnus-posting-styles'.  The header will be stripped on
 176 sending.")
 177
 178 (defvar mdw-default-send-mail-method nil
 179   "The name of the default mail-sending method.")
 180
 181 (defun mdw-message-send-it ()
 182   "Send mail using the appropriate mail sending method.
 183 Firstly, a mail-sending method name is determined.  If
 184 `mdw-send-mail-header-name' has a non-nil value, and a header
 185 with this name exists in the message being sent, then its value
 186 is used as the name.  Otherwise, the email address from the
 187 `From' header is matched against the named of the association in
 188 `mdw-guess-send-mail-alist', and if any of them match then the
 189 corresponding value is used as the name.  Otherwise, the value of
 190 `mdw-default-send-mail-method' is used.
 191
 192 The name is then looked up in `mdw-send-mail-alist' to find an
 193 alist of temporary variable bindings; an error is reported if no
 194 matching entry is found.  The variables are temporarily bound to
 195 their corresponding values, and the (possibly freshly rebound)
 196 `send-mail-function' is invoked with no parameters.
 197
 198 If the method name is `nil', then `send-mail-function' is simply
 199 invoked without doing anything else very special.  This can
 200 therefore be left as a useful default, if it's generally the
 201 right thing."
 202
 203   (let* ((method-name
 204           (or
 205
 206            ;; Firstly, if there's an explicit header in the message, then
 207            ;; we'd better use that.
 208            (let ((method (message-fetch-field mdw-send-mail-header-name)))
 209              (and method (intern method)))
 210
 211            ;; Look up the sender's address in the guess list.
 212            (let* ((sender (some #'message-fetch-field
 213                                 '("resent-sender" "resent-from"
 214                                   "sender" "from")))
 215                   (addr (cadr (mail-extract-address-components sender)))
 216                   (alist mdw-guess-send-mail-alist)
 217                   assoc)
 218              (catch 'found
 219                (while alist
 220                  (setq assoc (pop alist))
 221                  (when (string-match (car assoc) addr)
 222                    (throw 'found (cdr assoc))))
 223                nil))
 224
 225            ;; Otherwise use the default.
 226            mdw-default-send-mail-method))
 227
 228          (method (and method-name
 229                       (let ((assoc (assq method-name mdw-send-mail-alist)))
 230                         (if assoc (cdr assoc)
 231                           (error "Unknown send-mail method `%s'."
 232                                  method-name))))))
 233
 234     ;; Bind the appropriate variables.
 235     (progv
 236         (mapcar #'car method)
 237         (mapcar #'cdr method)
 238
 239       ;; Make a copy of the buffer and strip out our magic header.  (If the
 240       ;; message send fails, it would be annoying to have lost the magic
 241       ;; token which tells us how to retry properly.)
 242       (let ((buf (current-buffer)))
 243         (with-temp-buffer
 244           (insert-buffer buf)
 245           (message-remove-header mdw-send-mail-header-name)
 246           (funcall send-mail-function))))))
 247
 248 (setq message-send-mail-function 'mdw-message-send-it)
 249
 250 ;;;--------------------------------------------------------------------------
 251 ;;; Local configuration.
 252
 253 ;; Fetching news from the local news server seems sensible.
 254 (setq gnus-select-method
 255       (let ((server (mdw-config 'nntp-server)))
 256         (if server
 257             `(nntp ,server)
 258           '(nnnil ""))))
 259
 260 ;; Now load a local configuration file.
 261 (load "~/.gnus-local.el")
 262
 263 ;;;----- That's all, folks --------------------------------------------------