Refactor mail handling.
[emacs.git] / .emacs.d / elisp / local / ganneff-gnus.el
1 ;;; ganneff.el --- Lotsa functiuons and their variables for stuff
2 ;;; ganneffs .emacs wants
3
4 ;; Copyright (C) 2012 Joerg Jaspert
5
6 ;; Filename: ganneff.de
7 ;; Author: Joerg Jaspert <joerg@debian.org>
8
9 ;; The functions in the bh/ namespace are taken from
10 ;; http://doc.norang.ca/org-mode.org.html which has:
11 ;; #+AUTHOR: Bernt Hansen (IRC:Thumper_ on freenode)
12 ;; #+EMAIL: bernt@norang.ca
13 ;; and the following license statement:
14 ;;
15 ;; This document http://doc.norang.ca/org-mode.html and (either in its
16 ;; HTML format or in its Org format) is licensed under the GNU Free
17 ;; Documentation License version 1.3 or later
18 ;; (http://www.gnu.org/copyleft/fdl.html).
19
20 ;; The code examples and css stylesheets are licensed under the GNU
21 ;; General Public License v3 or later
22 ;; (http://www.gnu.org/licenses/gpl.html).
23
24
25 ;;** Correct message and unread count (http://www.emacswiki.org/emacs/GnusNiftyTricks)
26 (require 'imap)
27
28 ;;;###autoload
29 (defun gnus-nnimap-count-format (n)
30 (let ((method (or gnus-tmp-method gnus-select-method)))
31 (when (eq (car method) 'nnimap)
32 (let ((counts (nnimap-request-message-counts gnus-tmp-group method)))
33 (if counts (format "%d" (nth n counts)) "?")))))
34
35 ;;;###autoload
36 (defun gnus-user-format-function-t (dummy)
37 (or (gnus-nnimap-count-format 0)
38 gnus-tmp-number-total))
39
40 ;;;###autoload
41 (defun gnus-user-format-function-x (dummy)
42 (or (gnus-nnimap-count-format 1)
43 gnus-tmp-number-of-unread))
44
45 (defvar gnus-user-format-function-g-prev "" "")
46 ;;;###autoload
47 (defun empty-common-prefix (left right)
48 "Given `left' '(\"foo\" \"bar\" \"fie\") and `right' '(\"foo\"
49 \"bar\" \"fum\"), return '(\" \" \" \" \"fum\")."
50 (if (and (cdr right) ; always keep the last part of right
51 (equal (car left) (car right)))
52 (cons (make-string (length (car left)) ? )
53 (empty-common-prefix (cdr left) (cdr right)))
54 right))
55 ;;;###autoload
56 (defun gnus-user-format-function-g (arg)
57 "The full group name, but if it starts with a previously seen
58 prefix, empty that prefix."
59 (if (equal gnus-user-format-function-g-prev gnus-tmp-group) ; line-format is updated on exiting the summary, making prev equal this
60 gnus-tmp-group
61 (let* ((prev (split-string-and-unquote gnus-user-format-function-g-prev "\\.\\|:"))
62 (this (split-string-and-unquote gnus-tmp-group "\\.\\|:")))
63 (setq gnus-user-format-function-g-prev gnus-tmp-group)
64 (combine-and-quote-strings
65 (empty-common-prefix prev this)
66 "."))))
67
68
69 (defvar nnimap-message-count-cache-alist nil)
70
71 ;;;###autoload
72 (defun nnimap-message-count-cache-clear ()
73 (setq nnimap-message-count-cache-alist nil))
74
75 ;;;###autoload
76 (defun nnimap-message-count-cache-get (group)
77 (cadr (assoc group nnimap-message-count-cache-alist)))
78
79 ;;;###autoload
80 (defun nnimap-message-count-cache-set (group count)
81 (push (list group count) nnimap-message-count-cache-alist))
82
83 ;;;###autoload
84 (defun nnimap-request-message-counts (group method)
85 (or (nnimap-message-count-cache-get group)
86 (let ((counts (nnimap-fetch-message-counts group method)))
87 (nnimap-message-count-cache-set group counts)
88 counts)))
89
90 ;;;###autoload
91 (defun nnimap-fetch-message-counts (group method)
92 (let ((imap-group (nnimap-decode-gnus-group (car (last (split-string group ":")))))
93 (server (cadr method)))
94 (when (nnimap-change-group imap-group server)
95 (message "Requesting message count for %s..." group)
96 (with-current-buffer (nnimap-buffer)
97 (let ((response
98 (assoc "MESSAGES"
99 (assoc "STATUS"
100 (nnimap-command "STATUS %S (MESSAGES UNSEEN)"
101 (utf7-encode imap-group t))))))
102 (message "Requesting message count for %s...done" group)
103 (and response
104 (mapcar #'string-to-number
105 (list
106 (nth 1 response) (nth 3 response)))))))))
107
108 ;;;###autoload
109 (defun jj-forward-spam ()
110 (interactive)
111 (gnus-summary-mail-forward 1)
112 (message-goto-to)
113 (insert "joerg@ganneff.de")
114 (message-goto-body)
115 (let ((ans (completing-read "Spam / Nospam? "
116 '(("s") ("n"))
117 t nil nil)))
118 (cond ((string= ans "s")
119 (insert "command ganneffcrm spam"))
120 ((string= ans "n")
121 (insert "command ganneffcrm nonspam"))
122 (t
123 (error "Invalid choice.")))))
124
125 ;;;###autoload
126 (defun jj-forward-ham-lists-debconf ()
127 (interactive)
128 (gnus-summary-resend-message "mailmansplit-and-learn-as-ham@smithers.debconf.org" 1)
129 )
130 ;;;###autoload
131 (defun jj-forward-spam-lists-debconf ()
132 (interactive)
133 (gnus-summary-resend-message "mailmansplit-discard-and-learn-as-spam@smithers.debconf.org" 1)
134 )
135
136 ;;;###autoload
137 (defun jj-forward-ham-lists-oftc ()
138 (interactive)
139 (gnus-summary-resend-message "mailmansplit-and-learn-as-ham@lists.oftc.net" 1)
140 )
141
142 ;;;###autoload
143 (defun jj-forward-spam-lists-oftc ()
144 (interactive)
145 (gnus-summary-resend-message "mailmansplit-discard-and-learn-as-spam@lists.oftc.net" 1)
146 )
147
148 ;;;###autoload
149 (defun jj-forward-ham-lists-spi ()
150 (interactive)
151 (gnus-summary-resend-message "mailmansplit-and-learn-as-ham@lists.spi-inc.org" 1)
152 )
153
154 ;;;###autoload
155 (defun jj-forward-spam-lists-spi ()
156 (interactive)
157 (gnus-summary-resend-message "mailmansplit-discard-and-learn-as-spam@lists.spi-inc.org" 1)
158 )
159 ;;;###autoload
160 (defun jj-forward-issue ()
161 (interactive)
162 (gnus-summary-resend-message "ganneff_tm+c57957@rmilk.com" 1)
163 )
164 ;;;###autoload
165 (defun jj-move-mail-spambox ()
166 (interactive)
167 (gnus-summary-move-article nil "nnfolder+archive:Spam" nil))
168 ; (gnus-summary-move-article nil "nnimap+gkar:learnspam" nil))
169
170 ;;;###autoload
171 (defun jj-copy-mail-hambox ()
172 (interactive)
173 (gnus-summary-copy-article nil "nnfolder+archive:Ham" nil))
174
175 ;;** Funktion liefert einen korrekten Datumsstring zurueck, fuer Summaryanzeige
176 ;;;###autoload
177 (defun gnus-user-format-function-y (header)
178 "Convert the DATE to DD.MM.YYYY, HH:MM."
179 (format-time-string "%d.%m.%y, %R"
180 (gnus-date-get-time (mail-header-date header))))
181
182 ;;;###autoload
183 (defun gnus-user-format-function-j (headers)
184 (let ((to (gnus-extra-header 'To headers)))
185 (if (string-match gnus-ignored-from-addresses to)
186 (if (string-match "," to) "~" "»")
187 (if (or (string-match gnus-ignored-from-addresses
188 (gnus-extra-header 'Cc headers))
189 (string-match gnus-ignored-from-addresses
190 (gnus-extra-header 'BCc headers)))
191 "~"
192 " "))))
193
194 ;;** Ich will jeder Nachricht/Mail Header beifügen. Dies tu ich mit Aufruf dieser Funktion.
195 ;;;###autoload
196 (defun my-message-add-content ()
197 (message-add-header "X-GPG-ID: 0xB12525C4")
198 (message-add-header "X-GPG-FP: FBFA BDB5 41B5 DC95 5BD9 BA6E DB16 CF5B B125 25C4")
199 (message-add-header "X-message-flag: Formating hard disk. please wait... 10%... 20%..."))
200
201 ;;** Und was ich hasse sind Antworten auf Mails in Mailinglisten die auch per CC an mich gesandt wird. Son
202 ;;** Scheiss, ich lese die Listen mit wo ich schreibe !
203 ;;;###autoload
204 (defun my-message-header-setup-hook ()
205 (my-message-add-content)
206 (september-citation-line))
207
208
209 ;;** Automagisch neue Mail/News holen.
210 ;;;###autoload
211 (defun us-get-only-mail ()
212 "Fetch new mails"
213 (gnus-group-get-new-news))
214
215 ;;;###autoload
216 (defun september-citation-line ()
217 (interactive)
218 (when message-reply-headers
219 (insert "On "
220 (int-to-string
221 (-
222 (time-to-days (mail-header-parse-date
223 (mail-header-date message-reply-headers)))
224 (time-to-days (encode-time 0 0 0 13 03 1977))))
225 ; (time-to-days (encode-time 0 0 0 01 09 1993))))
226 " March 1977, "
227 (let* ((email (mail-header-from message-reply-headers))
228 (data (mail-extract-address-components email))
229 (name (car data))
230 (net (car (cdr data))))
231 (or name net email))
232 " wrote:\n")))
233
234 ;;** Scorefileeinträge sollen nach bestimmter Zeit automagisch gelöscht werden. Speziell die vom
235 ;;** adaptiven Scoring. Sonst hab ich irgendwann MB grosse Scorefiles.
236 ;;;###autoload
237 (defun gnus-decay-score (score)
238 "Decay SCORE.
239 This is done according to `gnus-score-decay-constant'
240 and `gnus-score-decay-scale'."
241 (floor
242 (- score
243 (* (if (< score 0) 1 -1)
244 (min (abs score)
245 (max gnus-score-decay-constant
246 (* (abs score)
247 gnus-score-decay-scale)))))))
248
249 ;;** Ein Menu für die genialen Message-Utils erstellen.
250 ;;;###autoload
251 (defun message-utils-setup ()
252 "Add menu-entries for message-utils."
253 (easy-menu-add-item nil '("Message")
254 ["Insert Region Marked" message-mark-inserted-region t] "Spellcheck")
255 (easy-menu-add-item nil '("Message")
256 ["Insert File Marked" message-mark-insert-file t] "Spellcheck")
257 (easy-menu-add-item nil '("Field")
258 ["Crosspost / Followup" message-xpost-fup2 t] "----")
259 (easy-menu-add-item nil '("Field")
260 ["New Subject" message-mark-inserted-region t] "----")
261 (easy-menu-add-item nil '("Field")
262 ["Reduce To: to Cc:" message-reduce-to-to-cc t] "----")
263 (easy-menu-add-item nil '("Field")
264 [ "X-No-Archive:" message-add-archive-header t ]))
265
266 ;* This function should be called from the summary buffer with point
267 ;* on the article to nuke. It puts a rule in ~/News/FUCKSTAINS to lower
268 ;* scores of author
269 ;* It needs an entry in all.SCORE of (files "~/News/FUCKSTAINS").
270 ; I changed it to only add the from line.
271 ;;;###autoload
272 (defun gnus-scum-expunge ()
273 "Remove this spammer from existance as much as possible."
274 (interactive)
275 (let* ((hdr (gnus-summary-article-header))
276 (subj (aref hdr 1))
277 (auth (aref hdr 2))
278 (artid (aref hdr 4))
279 (atsign (string-match "@" artid))
280 (host (substring artid (+ atsign 1) (- (length artid) 1)))
281 (oldscfile gnus-current-score-file)
282 (scoredate (time-to-days (current-time))))
283 (gnus-summary-score-entry "references" (concat artid "$") 'R' -1000 scoredate)
284 (gnus-summary-score-entry "references" artid 'S' -500 scoredate)
285 ;; Change to our spammer score file
286 (gnus-score-change-score-file "FUCKSTAINS")
287 ;; Add our horrible spammer scores
288 (gnus-summary-score-entry "Subject" subj 'S' -1000 scoredate)
289 (gnus-summary-score-entry "From" auth 'S' -9999 scoredate)
290 (gnus-summary-score-entry "Message-ID" host 'S' -5 scoredate) ; mild
291 ;; Change back to old current score file
292 (gnus-score-change-score-file oldscfile)
293 (gnus-score-save)))
294
295 ;;;###autoload
296 (defun lld-notmuch-shortcut ()
297 (define-key gnus-group-mode-map "GG" 'notmuch-search)
298 )
299
300 ;;;###autoload
301 (defun notmuch-file-to-group (file)
302 "Calculate the Gnus group name from the given file name."
303
304 (let ((group (file-name-directory (directory-file-name (file-name-directory file)))))
305
306 (if (string-match ".*/Maildir/ganneff" file)
307 (progn
308 (setq group (replace-regexp-in-string ".*/Maildir/ganneff/\." "" group))
309 (setq group (replace-regexp-in-string ".*/Maildir/ganneff" "" group))
310 ))
311 (if (string-match ".*/Maildir/nsb" file)
312 (progn
313 (setq group (replace-regexp-in-string ".*/Maildir/nsb/\." "nnimap+nsb:" group))
314 (setq group (replace-regexp-in-string ".*/Maildir/nsb" "nnimap+nsb:" group))
315 ))
316 (if (string-match ".*/Maildir/gmail" file)
317 (progn
318 (setq group (replace-regexp-in-string ".*/Maildir/gmail/\." "nnimap+gmail:" group))
319 (setq group (replace-regexp-in-string ".*/Maildir/gmail" "nnimap+gmail:" group))
320 ))
321
322 (setq group (replace-regexp-in-string "/$" "" group))
323 (if (= (length group) 0)
324 (setq group "INBOX"))
325 (if (string-match ":$" group)
326 (concat group "INBOX")
327 (replace-regexp-in-string ":\\." ":" group))))
328
329 ;;;###autoload
330 (defun lld-notmuch-goto-message-in-gnus ()
331 "Open a summary buffer containing the current notmuch article."
332 (interactive)
333 (unless (gnus-alive-p) (with-temp-buffer (gnus)))
334 (let ((group (notmuch-file-to-group (notmuch-show-get-filename)))
335 (message-id
336 (replace-regexp-in-string "\"" ""
337 (replace-regexp-in-string "^id:" ""
338 (notmuch-show-get-message-id)))))
339 (if (and group message-id)
340 (progn
341 (gnus-summary-read-group group 100) ; have to show at least one old message
342 (gnus-summary-refer-article message-id)) ; simpler than org-gnus method?
343 (message "Couldn't get relevant infos for switching to Gnus."))))
344
345 ;; this corresponds to a topic line format of "%n %A"
346 ;;;###autoload
347 (defun gnus-user-format-function-topic-line (dummy)
348 (let ((topic-face (if (zerop total-number-of-articles)
349 'gnus-summary-low-ancient
350 'gnus-summary-high-ancient)))
351 (propertize
352 (format "%s %d" name total-number-of-articles)
353 'face topic-face)))
354
355 ;;;###autoload
356 (defun sign-or-crypt ()
357 (interactive)
358 (let ((ans (completing-read "Sign/Inlinesign/Encrypt/Nothing? "
359 '(("s" s) ("i" i) ("e" e) ("n" n))
360 nil t nil)))
361 (cond ((string= ans "s")
362 (mml-secure-message mml-default-sign-method 'sign)
363 ;(message-goto-body)
364 ;(insert "<#secure method=pgpmime mode=sign>\n")
365 )
366 ((string= ans "i")
367 (mml-secure-message "pgp" 'sign))
368 ((string= ans "e")
369 (mml-secure-message-encrypt-pgpmime)
370 ;(message-goto-body)
371 ;(insert "<#secure method=pgpmime mode=signencrypt>\n")
372 )
373 ((string= ans "n")
374 (message "Message sent unmodified."))
375 (t
376 (error "Invalid choice.")))))
377
378 (provide 'ganneff-gnus)