lisp/my-gnus.el
author Fabien Ninoles <fabien@tzone.org>
Sat, 16 Apr 2016 13:57:38 -0400
changeset 18 f9712f62d202
parent 1 a234a7579958
permissions -rw-r--r--
Add mounted path.

(setq mm-coding-system-priorities
      '(iso-latin-1 iso-latin-9))

(defun local-nnmail-match-expiry  (newsgroup)
  "Return default expiry for different newsgroup."
  (cond ((string-match "archives" newsgroup) 'never)
        ((string-match "sentmail" newsgroup) 'never)
        ((string-match "postponed" newsgroup) 'never)
        ((string-match "debian" newsgroup) 7)
        ((string-match "jabber" newsgroup) 7)
        ((string-match "gnucash" newsgroup) 7)
        ((string-match "egroups" newsgroup) 7)
        ((string-match "emacs.ding" newsgroup) 7)
        ((string-match "spam" newsgroup) 1)
        (t 31)))

(defvar local-signature-alist nil)
(setq local-signature-alist 
      '(("default" . (("name" . "Fabien Niñoles")
                      ("title" . "")
                      ("email" . "fabien@tzone.org")
                      ("web" . "http://www.tzone.org")
                      ("key" . "C15D FE9E BB35 F596 127F  BF7D 8F1F DFC9 BCE0 9436")))
    ("debian" . (("email" . "fabien@debian.org")
                 ("web" . "http://www.debian.org")
                 ("title" . "Debian Maintainer")))
    ("clef" . (("email" . "veneur@tzone.org")
               ("web" . "http://harmonies.tzone.org")
               ("title" . "Chevalier de la Loge des Terres de l'Aube")
               ("name" . "Le Veneur Gris")))
    ("hdf" . (("email" . "veneur@tzone.org")
               ("web" . "http://harmonies.tzone.org")
               ("title" . "Chevalier Servant de Sa Dame")
               ("name" . "Le Veneur Gris")))
    ("nephilim" . (("email" . "coeurdelune@nephilim-rpg.com")
                   ("name" . "Coeur de Lune")
                   ("title" . "Zéphir orphelin")
                   ("web" . "http://harmonies.tzone.org")))
    ("ids" . (("name" . "Goudron Sauvage")
              ("title" . "Valier Vampire Décalé Rêvolutionnaire")
              ("email" . "veneur@tzone.org")
              ("web" . "http://cruche.valiere.free.fr")))
    ("rdd" . (("name" . "Baffouille")
              ("title" . "Enrêveur et Archimage")
              ("email" . "veneur@tzone.org")
              ("web" . "http://harmonies.tzone.org")))
    ("jdr" . (("title" . "Arpèges, le jeu des Harmonies")
              ("web" . "http://harmonies.tzone.org")))
    ("baff" . (("name" . "Baffouille")
              ("title" . "Enrêveur et Archimage")))))

(defun local-gen-sign (type)
  "Generate a signature."
  (let 
      ((default-keys 
         (copy-alist
          (cdr (assoc "default" local-signature-alist))))
       (selected-keys 
        (cdr (assoc type local-signature-alist))))
    (dolist (pair selected-keys default-keys)
      (setcdr (assoc (car pair) default-keys)
              (cdr pair)))
    (let*
        ((GPG-title "GPG KeyID:")
         (name (cdr (assoc "name" default-keys)))
         (title (cdr (assoc "title" default-keys)))
         (email (cdr (assoc "email" default-keys)))
         (web (cdr (assoc "web" default-keys)))
         (key (cdr (assoc "key" default-keys)))
         (maxlenght
          (max (+ 2 (string-width name) (string-width title))
               (+ 2 (string-width email) (string-width web))
               (+ 1 (string-width GPG-title) (string-width key)))))
      (concat name 
              (make-string (- maxlenght (string-width name) (string-width title)) ? )
              title
              "\n"
              email
              (make-string (- maxlenght (string-width email) (string-width web)) ? )
              web
              "\n"
              GPG-title
              (make-string (- maxlenght (string-width GPG-title) (string-width key)) ? )
              key
              "\n"))))

(defvar local-last-sig nil)
(defun local-insert-signature (type)
  "Insert a signature."
  (interactive (list
                (completing-read "Which signature: "
                                 local-signature-alist
                                 nil
                                 nil
                                 nil
                                 nil
                                 (or local-last-sig "default"))))
  (setq local-last-sig type)
  (save-excursion
    (goto-char (point-max))
    (let ((beg-sign
           (re-search-backward message-signature-separator nil t)))
      (if beg-sign
          (kill-region
           beg-sign (point-max))))
    (goto-char (point-max))
    (unless (bolp)
      (insert "\n"))
    (insert "-- \n")
    (insert (local-gen-sign type))))

(defun local-alter-message-map ()
  (local-set-key "\C-c\C-w" 'local-insert-signature))

(defun local-outgoing-message-group ()
  "Return the sentmail group."
  (concat "mail/sentmail-archives/"
          (format-time-string "%Y.%m")))

(setq gnus-outgoing-message-group
      'local-outgoing-message-group)

(provide 'local-gnus)