Commit | Line | Data |
---|---|---|
a3bdb4d9 MW |
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) | |
9961661f MW |
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") | |
a3bdb4d9 MW |
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 " ") | |
e54d5c43 MW |
46 | (if (memq (coding-system-get (terminal-coding-system) 'mime-charset) |
47 | '(nil utf-8)) | |
a3bdb4d9 MW |
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 "| " | |
23564c2e | 53 | gnus-sum-thread-tree-single-leaf "`->")) |
a3bdb4d9 MW |
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 | ||
b9d030b9 MW |
61 | ;; Configure the crypto. |
62 | (setq mm-verify-option 'known | |
63 | mm-sign-option 'guided | |
64 | mm-decrypt-option 'never) | |
65 | ||
91f00aac MW |
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 | ||
0c639fd6 MW |
72 | ;; Use one article buffer per group. |
73 | (setq gnus-single-article-buffer nil) | |
74 | ||
a3bdb4d9 MW |
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 | ||
ffdcdb3d MW |
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 | ||
f34c1444 MW |
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 | ||
040cb5bc MW |
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 | ||
7bfab029 MW |
108 | ;; Don't expire articles on selection if they're alread read. This provides |
109 | ;; a handy way to prevent expiry, and actually forcing expiry isn't | |
110 | ;; significantly harder. | |
111 | (remove-hook 'gnus-mark-article-hook | |
112 | 'gnus-summary-mark-read-and-unread-as-read) | |
113 | (add-hook 'gnus-mark-article-hook 'gnus-summary-mark-unread-as-read) | |
114 | ||
115 | ;; Leave an oubliette level 7 for broken things which look like mailboxes. | |
116 | ;; Otherwise Gnus keeps on resurrecting them and later realising that they're | |
117 | ;; bogus. | |
118 | (setq gnus-level-unsubscribed 6) | |
119 | ||
169ce333 MW |
120 | ;; Reconfigure the `nnmail-split-fancy' syntax table to be less mad. |
121 | (setq nnmail-split-fancy-syntax-table | |
122 | (let ((table (make-syntax-table))) | |
123 | ||
124 | ;; This is from upstream. I don't know what it's for. | |
125 | (modify-syntax-entry ?% "." table) | |
126 | ||
127 | ;; Email addresses are often wrapped in `<...>', so don't consider | |
128 | ;; those to be part of the address. | |
129 | (modify-syntax-entry ?< "(>" table) | |
130 | (modify-syntax-entry ?> ")<" table) | |
131 | ||
867ab7ee MW |
132 | ;; Email addresses definitely contain `.'. |
133 | (modify-syntax-entry ?. "_" table) | |
134 | ||
169ce333 MW |
135 | ;; Done. |
136 | table)) | |
137 | ||
a3bdb4d9 | 138 | ;;;-------------------------------------------------------------------------- |
24da4184 MW |
139 | ;;; Magic for sending mail the correct way. |
140 | ||
141 | (defvar mdw-send-mail-alist nil | |
142 | "An alist containing ways of sending email. | |
143 | The keys are symbols naming mail-sending methods. The values are | |
144 | alists mapping Lisp variable names to values which will be bound | |
145 | around a call to the underlying `send-mail-function'. See | |
146 | `mdw-message-send-it'.") | |
147 | ||
148 | (defvar mdw-guess-send-mail-alist nil | |
149 | "An alist for guessing the right way to send mail from a `From' address. | |
150 | The keys are (Emacs-style) regular expressions. The values are | |
151 | strings naming mail-sending methods, to be used if there is no | |
152 | `mdw-send-mail-header-name' mail header.") | |
153 | ||
154 | (defvar mdw-send-mail-header-name "X-mdw-Send-Mail" | |
155 | "Mail header used to override the mail-sending method. | |
156 | If a header with this name exists, then `mdw-message-send-it' | |
157 | will look its value up in `mdw-send-mail-alist' to find out how | |
158 | to send the message. The idea is that you can set this header | |
159 | from `gnus-posting-styles'. The header will be stripped on | |
160 | sending.") | |
161 | ||
162 | (defvar mdw-default-send-mail-method nil | |
163 | "The name of the default mail-sending method.") | |
164 | ||
165 | (defun mdw-message-send-it () | |
166 | "Send mail using the appropriate mail sending method. | |
167 | Firstly, a mail-sending method name is determined. If | |
168 | `mdw-send-mail-header-name' has a non-nil value, and a header | |
169 | with this name exists in the message being sent, then its value | |
170 | is used as the name. Otherwise, the email address from the | |
171 | `From' header is matched against the named of the association in | |
172 | `mdw-guess-send-mail-alist', and if any of them match then the | |
173 | corresponding value is used as the name. Otherwise, the value of | |
174 | `mdw-default-send-mail-method' is used. | |
175 | ||
176 | The name is then looked up in `mdw-send-mail-alist' to find an | |
177 | alist of temporary variable bindings; an error is reported if no | |
178 | matching entry is found. The variables are temporarily bound to | |
179 | their corresponding values, and the (possibly freshly rebound) | |
180 | `send-mail-function' is invoked with no parameters. | |
181 | ||
182 | If the method name is `nil', then `send-mail-function' is simply | |
183 | invoked without doing anything else very special. This can | |
184 | therefore be left as a useful default, if it's generally the | |
185 | right thing." | |
186 | ||
187 | (let* ((method-name | |
188 | (or | |
189 | ||
190 | ;; Firstly, if there's an explicit header in the message, then | |
191 | ;; we'd better use that. | |
192 | (let ((method (message-fetch-field mdw-send-mail-header-name))) | |
193 | (and method (intern method))) | |
194 | ||
195 | ;; Look up the sender's address in the guess list. | |
196 | (let* ((sender (some #'message-fetch-field | |
197 | '("resent-sender" "resent-from" | |
198 | "sender" "from"))) | |
199 | (addr (cadr (mail-extract-address-components sender))) | |
200 | (alist mdw-guess-send-mail-alist) | |
201 | assoc) | |
202 | (catch 'found | |
203 | (while alist | |
204 | (setq assoc (pop alist)) | |
205 | (when (string-match (car assoc) addr) | |
206 | (throw 'found (cdr assoc)))) | |
207 | nil)) | |
208 | ||
209 | ;; Otherwise use the default. | |
210 | mdw-default-send-mail-method)) | |
211 | ||
212 | (method (and method-name | |
213 | (let ((assoc (assq method-name mdw-send-mail-alist))) | |
214 | (if assoc (cdr assoc) | |
215 | (error "Unknown send-mail method `%s'." | |
216 | method-name)))))) | |
217 | ||
218 | ;; Bind the appropriate variables. | |
219 | (progv | |
220 | (mapcar #'car method) | |
221 | (mapcar #'cdr method) | |
222 | ||
223 | ;; Make a copy of the buffer and strip out our magic header. (If the | |
224 | ;; message send fails, it would be annoying to have lost the magic | |
225 | ;; token which tells us how to retry properly.) | |
226 | (let ((buf (current-buffer))) | |
227 | (with-temp-buffer | |
228 | (insert-buffer buf) | |
229 | (message-remove-header mdw-send-mail-header-name) | |
230 | (funcall send-mail-function)))))) | |
231 | ||
232 | (setq message-send-mail-function 'mdw-message-send-it) | |
233 | ||
234 | ;;;-------------------------------------------------------------------------- | |
a3bdb4d9 MW |
235 | ;;; Local configuration. |
236 | ||
237 | ;; Fetching news from the local news server seems sensible. | |
50a38814 MW |
238 | (setq gnus-select-method |
239 | (let ((server (mdw-config 'nntp-server))) | |
240 | (if server | |
241 | `(nntp ,server) | |
242 | '(nnnil "")))) | |
a3bdb4d9 MW |
243 | |
244 | ;; Now load a local configuration file. | |
245 | (load "~/.gnus-local.el") | |
246 | ||
247 | ;;;----- That's all, folks -------------------------------------------------- |