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 | 39 | (setq gnus-summary-make-false-root 'dummy) |
5f78d81e | 40 | (setq gnus-summary-line-format |
0a3466cd | 41 | "%U%R%z%4L %(%[%-16,16f%]%): %&user-date; %B %s\n" |
5f78d81e | 42 | gnus-summary-dummy-line-format |
0a3466cd MW |
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"))) | |
a3bdb4d9 MW |
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 " ") | |
e54d5c43 MW |
54 | (if (memq (coding-system-get (terminal-coding-system) 'mime-charset) |
55 | '(nil utf-8)) | |
a3bdb4d9 MW |
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 "| " | |
23564c2e | 61 | gnus-sum-thread-tree-single-leaf "`->")) |
a3bdb4d9 MW |
62 | |
63 | ;; Sort threads in a useful way. | |
64 | (setq gnus-thread-sort-functions | |
5f78d81e MW |
65 | '(gnus-thread-sort-by-number |
66 | gnus-thread-sort-by-subject | |
67 | gnus-thread-sort-by-total-score)) | |
a3bdb4d9 | 68 | |
b9d030b9 MW |
69 | ;; Configure the crypto. |
70 | (setq mm-verify-option 'known | |
71 | mm-sign-option 'guided | |
72 | mm-decrypt-option 'never) | |
73 | ||
91f00aac MW |
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 | ||
bc9c5623 MW |
80 | ;; Don't skip unread groups. |
81 | (setq gnus-group-goto-unread nil | |
82 | gnus-summary-next-group-on-exit nil) | |
83 | ||
0c639fd6 MW |
84 | ;; Use one article buffer per group. |
85 | (setq gnus-single-article-buffer nil) | |
86 | ||
a3bdb4d9 MW |
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 | ||
ffdcdb3d MW |
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 | ||
f34c1444 MW |
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 | ||
040cb5bc MW |
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 | ||
7bfab029 MW |
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 | ||
169ce333 MW |
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 | ||
867ab7ee MW |
144 | ;; Email addresses definitely contain `.'. |
145 | (modify-syntax-entry ?. "_" table) | |
146 | ||
169ce333 MW |
147 | ;; Done. |
148 | table)) | |
149 | ||
24da4184 MW |
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 | ||
a3bdb4d9 MW |
246 | ;;;-------------------------------------------------------------------------- |
247 | ;;; Local configuration. | |
248 | ||
249 | ;; Fetching news from the local news server seems sensible. | |
50a38814 MW |
250 | (setq gnus-select-method |
251 | (let ((server (mdw-config 'nntp-server))) | |
252 | (if server | |
253 | `(nntp ,server) | |
254 | '(nnnil "")))) | |
a3bdb4d9 MW |
255 | |
256 | ;; Now load a local configuration file. | |
257 | (load "~/.gnus-local.el") | |
258 | ||
259 | ;;;----- That's all, folks -------------------------------------------------- |