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