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