1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
5 ;;; (c) 2009 Mark Wooding
8 ;;;----- Licensing notice ---------------------------------------------------
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.
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.
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
24 ;;;--------------------------------------------------------------------------
25 ;;; General Gnus preferences.
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)
31 ;; Use hacky movemail program to move mail.
32 (setq mail-source-movemail-program "~/bin/movemail-hack")
34 ;; Don't force use of a full window.
35 (setq gnus-use-full-window nil)
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")
47 ((gnus-seconds-month) . " %a %_d")
48 ((gnus-seconds-year) . " %_d %b")
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)
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 "`->"))
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))
69 ;; Configure the crypto.
70 (setq mm-verify-option 'known
71 mm-sign-option 'guided
72 mm-decrypt-option 'never)
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)
80 ;; Don't skip unread groups.
81 (setq gnus-group-goto-unread nil
82 gnus-summary-next-group-on-exit nil)
84 ;; Use one article buffer per group.
85 (setq gnus-single-article-buffer nil)
87 ;; Don't expand threads on initial opening.
88 (setq gnus-thread-hide-subtree t)
90 ;; Don't use strange icons instead of traditional smileys.
91 (setq gnus-treat-display-smileys nil)
93 ;; Fairly large numbers of articles are OK; don't bother warning me.
94 (setq gnus-large-newsgroup 500)
96 ;; When splitting articles, crossposting is a reasonable thing to do.
97 (setq nnimap-split-crosspost t)
99 ;; We may have the misfortune to talk to an Exchange server.
100 (setq imap-enable-exchange-bug-workaround t)
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)
107 ;; Clean up properly when closing the summary.
108 (defadvice gnus-summary-exit (before mdw-kill-debris compile activate)
109 (gnus-summary-expand-window))
111 ;; Configure article display a bit.
112 (defun mdw-gnus-article-setup ()
113 (setq truncate-lines nil
114 truncate-partial-width-windows nil
116 wrap-prefix (concat (propertize "..." 'face 'mdw-ellipsis-face)
118 (add-hook 'gnus-article-mode-hook #'mdw-gnus-article-setup)
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)
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
130 (setq gnus-level-unsubscribed 6)
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)))
136 ;; This is from upstream. I don't know what it's for.
137 (modify-syntax-entry ?% "." table)
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)
144 ;; Email addresses definitely contain `.'.
145 (modify-syntax-entry ?. "_" table)
150 ;;;--------------------------------------------------------------------------
151 ;;; Magic for sending mail the correct way.
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'.")
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.")
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
174 (defvar mdw-default-send-mail-method nil
175 "The name of the default mail-sending method.")
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.
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.
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
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)))
207 ;; Look up the sender's address in the guess list.
208 (let* ((sender (some #'message-fetch-field
209 '("resent-sender" "resent-from"
211 (addr (cadr (mail-extract-address-components sender)))
212 (alist mdw-guess-send-mail-alist)
216 (setq assoc (pop alist))
217 (when (string-match (car assoc) addr)
218 (throw 'found (cdr assoc))))
221 ;; Otherwise use the default.
222 mdw-default-send-mail-method))
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'."
230 ;; Bind the appropriate variables.
232 (mapcar #'car method)
233 (mapcar #'cdr method)
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)))
241 (message-remove-header mdw-send-mail-header-name)
242 (funcall send-mail-function))))))
244 (setq message-send-mail-function 'mdw-message-send-it)
246 ;;;--------------------------------------------------------------------------
247 ;;; Local configuration.
249 ;; Fetching news from the local news server seems sensible.
250 (setq gnus-select-method
251 (let ((server (mdw-config 'nntp-server)))
256 ;; Now load a local configuration file.
257 (load "~/.gnus-local.el")
259 ;;;----- That's all, folks --------------------------------------------------