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