.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   (let ((group (or gnus-newsgroup-name "")))
 206     (when (or (message-fetch-field "newsgroups")
 207               (gnus-group-find-parameter group 'to-address)
 208               (gnus-group-find-parameter group 'to-list))
 209       (insert "Mail-Copies-To: never\n"))))
 210
 211
 212 ;;** Automagisch neue Mail/News holen.
 213 ;;;###autoload
 214 (defun us-get-only-mail ()
 215   "Fetch new mails"
 216   (gnus-group-get-new-news))
 217
 218 ;;;###autoload
 219 (defun september-citation-line ()
 220   (interactive)
 221   (when message-reply-headers
 222     (insert "On "
 223             (int-to-string
 224              (-
 225               (time-to-days (mail-header-parse-date
 226                              (mail-header-date message-reply-headers)))
 227               (time-to-days (encode-time 0 0 0 13 03 1977))))
 228 ;              (time-to-days (encode-time 0 0 0 01 09 1993))))
 229             " March 1977, "
 230             (let* ((email (mail-header-from message-reply-headers))
 231                    (data (mail-extract-address-components email))
 232                    (name (car data))
 233                    (net (car (cdr data))))
 234               (or name net email))
 235             " wrote:\n")))
 236
 237 ;;** Scorefileeinträge sollen nach bestimmter Zeit automagisch gelöscht werden. Speziell die vom
 238 ;;** adaptiven Scoring. Sonst hab ich irgendwann MB grosse Scorefiles.
 239 ;;;###autoload
 240 (defun gnus-decay-score (score)
 241   "Decay SCORE.
 242      This is done according to `gnus-score-decay-constant'
 243      and `gnus-score-decay-scale'."
 244   (floor
 245    (- score
 246       (* (if (< score 0) 1 -1)
 247          (min (abs score)
 248               (max gnus-score-decay-constant
 249                    (* (abs score)
 250                       gnus-score-decay-scale)))))))
 251
 252 ;;** Ein Menu für die genialen Message-Utils erstellen.
 253 ;;;###autoload
 254 (defun message-utils-setup ()
 255   "Add menu-entries for message-utils."
 256   (easy-menu-add-item nil '("Message")
 257                       ["Insert Region Marked" message-mark-inserted-region t] "Spellcheck")
 258   (easy-menu-add-item nil '("Message")
 259                       ["Insert File Marked" message-mark-insert-file t] "Spellcheck")
 260   (easy-menu-add-item nil '("Field")
 261                       ["Crosspost / Followup" message-xpost-fup2 t] "----")
 262   (easy-menu-add-item nil '("Field")
 263                       ["New Subject" message-mark-inserted-region t] "----")
 264   (easy-menu-add-item nil '("Field")
 265                       ["Reduce To: to Cc:" message-reduce-to-to-cc t] "----")
 266   (easy-menu-add-item nil '("Field")
 267                       [ "X-No-Archive:" message-add-archive-header t ]))
 268
 269 ;* This function should be called from the summary buffer with point
 270 ;* on the article to nuke.  It puts a rule in ~/News/FUCKSTAINS to lower
 271 ;* scores of author
 272 ;* It needs an entry in all.SCORE of (files "~/News/FUCKSTAINS").
 273 ; I changed it to only add the from line.
 274 ;;;###autoload
 275 (defun gnus-scum-expunge ()
 276   "Remove this spammer from existance as much as possible."
 277   (interactive)
 278   (let* ((hdr (gnus-summary-article-header))
 279          (subj (aref hdr 1))
 280          (auth (aref hdr 2))
 281          (artid (aref hdr 4))
 282          (atsign (string-match "@" artid))
 283          (host (substring artid (+ atsign 1) (- (length artid) 1)))
 284          (oldscfile gnus-current-score-file)
 285          (scoredate (time-to-days (current-time))))
 286     (gnus-summary-score-entry "references" (concat artid "$") 'R' -1000 scoredate)
 287     (gnus-summary-score-entry "references" artid 'S' -500 scoredate)
 288     ;; Change to our spammer score file
 289     (gnus-score-change-score-file "FUCKSTAINS")
 290     ;; Add our horrible spammer scores
 291     (gnus-summary-score-entry "Subject" subj 'S' -1000 scoredate)
 292     (gnus-summary-score-entry "From" auth 'S' -9999 scoredate)
 293     (gnus-summary-score-entry "Message-ID" host 'S' -5 scoredate) ; mild
 294     ;; Change back to old current score file
 295     (gnus-score-change-score-file oldscfile)
 296     (gnus-score-save)))
 297
 298 ;;;###autoload
 299 (defun lld-notmuch-shortcut ()
 300   (define-key gnus-group-mode-map "GG" 'notmuch-search)
 301   )
 302
 303 ;;;###autoload
 304 (defun lld-notmuch-file-to-group (file)
 305   "Calculate the Gnus group name from the given file name."
 306   (let ((group (file-name-directory (directory-file-name (file-name-directory file)))))
 307     (setq group (replace-regexp-in-string ".*/Maildir/" "nnimap+gkar:" group))
 308     (setq group (replace-regexp-in-string "/$" "" group))
 309     (if (string-match ":$" group)
 310         (concat group "INBOX"))
 311     (setq group (replace-regexp-in-string ":\\." ":" group))))
 312 ;; Seems like we don't even need this part:
 313                                         ;          (setq group (replace-regexp-in-string "nnimap\\+gkar:\\.?" "" group))))
 314
 315 ;;;###autoload
 316 (defun lld-notmuch-goto-message-in-gnus ()
 317   "Open a summary buffer containing the current notmuch article."
 318   (interactive)
 319   (unless (gnus-alive-p) (with-temp-buffer (gnus)))
 320   (let ((group (lld-notmuch-file-to-group (notmuch-show-get-filename)))
 321         (message-id
 322          (replace-regexp-in-string "\"" ""
 323                                    (replace-regexp-in-string "^id:" ""
 324                                                              (notmuch-show-get-message-id)))))
 325     (if (and group message-id)
 326         (progn
 327           (gnus-summary-read-group group 100) ; have to show at least one old message
 328           (gnus-summary-refer-article message-id)) ; simpler than org-gnus method?
 329       (message "Couldn't get relevant infos for switching to Gnus."))))
 330
 331 ;; this corresponds to a topic line format of "%n %A"
 332 ;;;###autoload
 333 (defun gnus-user-format-function-topic-line (dummy)
 334   (let ((topic-face (if (zerop total-number-of-articles)
 335                         'gnus-summary-low-ancient
 336                       'gnus-summary-high-ancient)))
 337     (propertize
 338      (format "%s %d" name total-number-of-articles)
 339      'face topic-face)))
 340
 341 ;;;###autoload
 342 (defun sign-or-crypt ()
 343   (interactive)
 344   (let ((ans (completing-read "Sign/Inlinesign/Encrypt/Nothing? "
 345                               '(("s" s) ("i" i) ("e" e) ("n" n))
 346                               nil t nil)))
 347     (cond ((string= ans "s")
 348            (mml-secure-message mml-default-sign-method 'sign)
 349            ;(message-goto-body)
 350            ;(insert "<#secure method=pgpmime mode=sign>\n")
 351            )
 352           ((string= ans "i")
 353            (mml-secure-message "pgp" 'sign))
 354           ((string= ans "e")
 355            (mml-secure-message-encrypt-pgpmime)
 356            ;(message-goto-body)
 357            ;(insert "<#secure method=pgpmime mode=signencrypt>\n")
 358            )
 359           ((string= ans "n")
 360            (message "Message sent unmodified."))
 361           (t
 362            (error "Invalid choice.")))))
 363
 364 (provide 'ganneff-gnus)