658 lines
22 KiB
Plaintext
658 lines
22 KiB
Plaintext
|
;;; gnus --- Daniel's Gnus Configuration
|
|||
|
|
|
|||
|
|
;;; Commentary:
|
|||
|
|
|
|||
|
|
;; Sources:
|
|||
|
|
;; - http://page.math.tu-berlin.de/~freundt/.gnus
|
|||
|
|
;; - Formatting from http://www.emacswiki.org/emacs/GnusFormatting, Version 3
|
|||
|
|
;; - http://www.emacswiki.org/emacs/GnusDemon
|
|||
|
|
;; - http://people.irisa.fr/Nicolas.Berthier/file:.gnus.el
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; General
|
|||
|
|
|
|||
|
|
;; Requires
|
|||
|
|
|
|||
|
|
(require 'gnus)
|
|||
|
|
(require 'message)
|
|||
|
|
(require 'gnus-util)
|
|||
|
|
(require 'gnus-start)
|
|||
|
|
(require 'gnus-group)
|
|||
|
|
(require 'gnus-sum)
|
|||
|
|
(require 'gnus-art)
|
|||
|
|
(require 'gnus-score)
|
|||
|
|
(require 'nntp)
|
|||
|
|
(require 'gnus-agent)
|
|||
|
|
(require 'nnml)
|
|||
|
|
(require 'gnus-async)
|
|||
|
|
|
|||
|
|
;; Debugging
|
|||
|
|
|
|||
|
|
(setq gnus-verbose 10)
|
|||
|
|
|
|||
|
|
;; Accounts
|
|||
|
|
|
|||
|
|
(setq-default message-dont-reply-to-names
|
|||
|
|
(regexp-opt (list db/personal-mail-address db/work-mail-address)
|
|||
|
|
'words))
|
|||
|
|
|
|||
|
|
(setq gnus-select-method '(nnnil "")
|
|||
|
|
gnus-secondary-select-methods
|
|||
|
|
`((nntp "dfn"
|
|||
|
|
(nntp-open-connection-function nntp-open-tls-stream)
|
|||
|
|
(nntp-port-number 563)
|
|||
|
|
(nntp-address "news.cis.dfn.de"))
|
|||
|
|
(nntp "gmane"
|
|||
|
|
(nntp-open-connection-function nntp-open-tls-stream)
|
|||
|
|
(nntp-port-number 563)
|
|||
|
|
(nntp-address "news.gmane.org"))
|
|||
|
|
(nnimap "tu"
|
|||
|
|
(nnimap-stream shell)
|
|||
|
|
(nnimap-shell-program "/usr/lib/dovecot/imap -o mail_location=maildir:$HOME/Mail/zih")
|
|||
|
|
(nnimap-inbox "INBOX")
|
|||
|
|
(nnimap-split-methods nnimap-split-fancy)
|
|||
|
|
(nnimap-split-fancy ,db/work-gnus-filter-rules))
|
|||
|
|
(nnimap "algebra20"
|
|||
|
|
(nnimap-stream shell)
|
|||
|
|
(nnimap-shell-program "/usr/lib/dovecot/imap -o mail_location=maildir:$HOME/Mail/algebra20")
|
|||
|
|
(nnimap-split-methods nnimap-split-fancy)
|
|||
|
|
(nnimap-inbox "INBOX")
|
|||
|
|
(nnimap-split-fancy ,db/personal-gnus-filter-rules))
|
|||
|
|
(nnml ""
|
|||
|
|
(nnmail-split-methods nnmail-split-fancy)
|
|||
|
|
(nnmail-split-fancy
|
|||
|
|
(| ("subject" ".*Tiger Auditing Report for.*" "mail.tiger")
|
|||
|
|
"mail.misc")))
|
|||
|
|
(nnmaildir "archive"
|
|||
|
|
(directory "~/Mail/archive/")
|
|||
|
|
(directory-files nnheader-directory-files-safe)
|
|||
|
|
(nnir-search-engine notmuch)
|
|||
|
|
(nnir-notmuch-remove-prefix ,(expand-file-name "~/Mail/archive/")))))
|
|||
|
|
|
|||
|
|
;; General Configuration
|
|||
|
|
|
|||
|
|
(setq gnus-ignored-from-addresses message-dont-reply-to-names
|
|||
|
|
message-directory (expand-file-name "mail/" gnus-directory)
|
|||
|
|
nnmail-message-id-cache-file (expand-file-name ".nnmail-cache" gnus-directory)
|
|||
|
|
nnml-directory message-directory
|
|||
|
|
mail-sources '((file))
|
|||
|
|
mail-source-delete-incoming t
|
|||
|
|
nntp-nov-is-evil t
|
|||
|
|
gnus-asynchronous t
|
|||
|
|
gnus-save-killed-list nil
|
|||
|
|
gnus-save-newsrc-file nil
|
|||
|
|
gnus-read-newsrc-file nil
|
|||
|
|
gnus-check-new-newsgroups nil
|
|||
|
|
gnus-use-cache 'passive
|
|||
|
|
gnus-read-active-file 'some
|
|||
|
|
gnus-build-sparse-threads 'some
|
|||
|
|
gnus-subscribe-newsgroup-method 'gnus-subscribe-killed
|
|||
|
|
gnus-group-list-inactive-groups nil
|
|||
|
|
gnus-suppress-duplicates nil
|
|||
|
|
gnus-large-newsgroup 200
|
|||
|
|
nnmail-expiry-wait 7
|
|||
|
|
nnmail-cache-accepted-message-ids t
|
|||
|
|
gnus-summary-next-group-on-exit nil
|
|||
|
|
gnus-use-full-window nil
|
|||
|
|
gnus-always-force-window-configuration t
|
|||
|
|
gnus-fetch-old-headers nil)
|
|||
|
|
|
|||
|
|
(setq gnus-visible-headers (regexp-opt '("From:"
|
|||
|
|
"Newsgroups:"
|
|||
|
|
"Subject:"
|
|||
|
|
"Date:"
|
|||
|
|
"Followup-To:"
|
|||
|
|
"Reply-To:"
|
|||
|
|
"Organization:"
|
|||
|
|
"Summary:"
|
|||
|
|
"Keywords:"
|
|||
|
|
"Mail-Copies-To:"
|
|||
|
|
"To:"
|
|||
|
|
"Cc:"
|
|||
|
|
"BCC:"
|
|||
|
|
"X-Newsreader:"
|
|||
|
|
"X-Mailer:"
|
|||
|
|
"X-Sent:"
|
|||
|
|
"Posted-To:"
|
|||
|
|
"Mail-Copies-To:"
|
|||
|
|
"Apparently-To:"
|
|||
|
|
"Gnus-Warning:"
|
|||
|
|
"Resent-From:"
|
|||
|
|
"gpg-key-ID:"
|
|||
|
|
"fingerprint:"
|
|||
|
|
"X-Jabber-ID:"
|
|||
|
|
"User-Agent:")))
|
|||
|
|
|
|||
|
|
(defadvice gnus-group-mail (before inhibit-no-argument activate)
|
|||
|
|
(unless (ad-get-arg 0)
|
|||
|
|
(ad-set-arg 0 1)))
|
|||
|
|
|
|||
|
|
(remove-hook 'gnus-mark-article-hook
|
|||
|
|
'gnus-summary-mark-read-and-unread-as-read)
|
|||
|
|
(add-hook 'gnus-mark-article-hook 'gnus-summary-mark-unread-as-read)
|
|||
|
|
|
|||
|
|
(add-hook 'kill-emacs-hook
|
|||
|
|
#'(lambda ()
|
|||
|
|
(interactive)
|
|||
|
|
(when (get-buffer "*Group*")
|
|||
|
|
(gnus-group-exit))))
|
|||
|
|
|
|||
|
|
(bind-key "q" #'gnus-summary-expand-window gnus-article-mode-map)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Appearence
|
|||
|
|
|
|||
|
|
(setq gnus-group-line-format "%S%p%P%5y(%2i):%B%(%-70g%)
|
|||
|
|
"
|
|||
|
|
gnus-auto-select-first nil
|
|||
|
|
gnus-auto-select-next nil)
|
|||
|
|
|
|||
|
|
(setq gnus-summary-line-format "%U%O%R%6k %(%&user-date; %-13,13f %B%s%)\n"
|
|||
|
|
gnus-thread-sort-functions '(gnus-thread-sort-by-most-recent-date)
|
|||
|
|
gnus-subthread-sort-functions '(gnus-thread-sort-by-date)
|
|||
|
|
gnus-thread-hide-subtree t
|
|||
|
|
gnus-user-date-format-alist '((t . "%Y-%m-%d %H:%M"))
|
|||
|
|
gnus-sum-thread-tree-indent " "
|
|||
|
|
gnus-sum-thread-tree-root "● "
|
|||
|
|
gnus-sum-thread-tree-false-root "◎ "
|
|||
|
|
gnus-sum-thread-tree-single-indent "◯ "
|
|||
|
|
gnus-sum-thread-tree-single-leaf "╰► "
|
|||
|
|
gnus-sum-thread-tree-leaf-with-other "├► "
|
|||
|
|
gnus-sum-thread-tree-vertical "│"
|
|||
|
|
gnus-summary-thread-gathering-function 'gnus-gather-threads-by-references
|
|||
|
|
|
|||
|
|
;; Yay (seen here: `https://github.com/cofi/dotfiles/blob/master/gnus.el')
|
|||
|
|
gnus-ancient-mark ?✓
|
|||
|
|
;; gnus-cached-mark ?☍
|
|||
|
|
gnus-canceled-mark ?↗
|
|||
|
|
gnus-del-mark ?✗
|
|||
|
|
;; gnus-dormant-mark ?⚐
|
|||
|
|
gnus-expirable-mark ?♻
|
|||
|
|
gnus-forwarded-mark ?↪
|
|||
|
|
;; gnus-killed-mark ?☠
|
|||
|
|
;; gnus-process-mark ?⚙
|
|||
|
|
gnus-read-mark ?✓
|
|||
|
|
gnus-recent-mark ?✩
|
|||
|
|
gnus-replied-mark ?↺
|
|||
|
|
gnus-unread-mark ?✉
|
|||
|
|
;; gnus-unseen-mark ?★
|
|||
|
|
;; gnus-ticked-mark ?⚑
|
|||
|
|
)
|
|||
|
|
|
|||
|
|
;; we need to do some magic as otherwise the agent does not delete articles from
|
|||
|
|
;; its .overview when we move them around
|
|||
|
|
(defadvice gnus-summary-move-article (around
|
|||
|
|
no-cancel-mark
|
|||
|
|
(&optional n to-newsgroup
|
|||
|
|
select-method action)
|
|||
|
|
activate)
|
|||
|
|
(let ((articles (gnus-summary-work-articles n))
|
|||
|
|
(return ad-do-it))
|
|||
|
|
(when (or (null action)
|
|||
|
|
(eq action 'move))
|
|||
|
|
(dolist (article articles)
|
|||
|
|
(gnus-summary-mark-article article gnus-expirable-mark)))
|
|||
|
|
return))
|
|||
|
|
|
|||
|
|
(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
|
|||
|
|
|
|||
|
|
(setq gnus-treat-hide-boring-headers 'head
|
|||
|
|
gnus-treat-strip-multiple-blank-lines nil
|
|||
|
|
gnus-treat-display-smileys t
|
|||
|
|
gnus-treat-emphasize 'head
|
|||
|
|
gnus-treat-unsplit-urls t)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Adaptive Scoring
|
|||
|
|
|
|||
|
|
(setq gnus-use-scoring nil
|
|||
|
|
gnus-use-adaptive-scoring nil
|
|||
|
|
gnus-adaptive-word-length-limit 5
|
|||
|
|
gnus-adaptive-word-no-group-words t
|
|||
|
|
gnus-default-adaptive-score-alist
|
|||
|
|
'((gnus-unread-mark)
|
|||
|
|
(gnus-ticked-mark (from 4))
|
|||
|
|
(gnus-dormant-mark (from 5))
|
|||
|
|
(gnus-del-mark (from -4) (subject -1))
|
|||
|
|
(gnus-read-mark (from 4) (subject 2))
|
|||
|
|
(gnus-expirable-mark (from -1) (subject -1))
|
|||
|
|
(gnus-killed-mark (from -1) (subject -3))
|
|||
|
|
(gnus-kill-file-mark)
|
|||
|
|
(gnus-ancient-mark)
|
|||
|
|
(gnus-low-score-mark)
|
|||
|
|
(gnus-catchup-mark (from -1) (subject -1))))
|
|||
|
|
|
|||
|
|
(setq-default gnus-summary-mark-below nil)
|
|||
|
|
|
|||
|
|
(setq gnus-parameters
|
|||
|
|
'(("^nnimap.*"
|
|||
|
|
(gnus-use-scoring nil))
|
|||
|
|
("^nnimap.*:lists.*"
|
|||
|
|
(gnus-use-scoring t)
|
|||
|
|
(gnus-use-adaptive-scoring '(word line)))
|
|||
|
|
("^nntp.*"
|
|||
|
|
(gnus-use-scoring nil)
|
|||
|
|
(gnus-summary-mark-below -1000)
|
|||
|
|
(gnus-use-adaptive-scoring '(word line)))))
|
|||
|
|
|
|||
|
|
(add-hook 'gnus-summary-exit-hook
|
|||
|
|
'gnus-summary-bubble-group)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Gnus Registry
|
|||
|
|
|
|||
|
|
(require 'gnus-registry)
|
|||
|
|
|
|||
|
|
(setq gnus-registry-split-strategy 'majority
|
|||
|
|
gnus-registry-ignored-groups '(("^nntp" t)
|
|||
|
|
("^nnfolder" t)
|
|||
|
|
("^nnir" t)
|
|||
|
|
("^nnmaildir" t)
|
|||
|
|
("INBOX$" t))
|
|||
|
|
gnus-registry-max-entries nil
|
|||
|
|
gnus-registry-track-extra '(sender subject recipient)
|
|||
|
|
gnus-registry-cache-file (expand-file-name "gnus.registry.eioioi"
|
|||
|
|
emacs-d))
|
|||
|
|
|
|||
|
|
(setq gnus-refer-article-method
|
|||
|
|
'(current (nnregistry)))
|
|||
|
|
|
|||
|
|
(gnus-registry-initialize)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; MIME
|
|||
|
|
|
|||
|
|
(use-package dash
|
|||
|
|
:demand t
|
|||
|
|
:ensure t)
|
|||
|
|
|
|||
|
|
(add-to-list 'gnus-boring-article-headers 'long-to)
|
|||
|
|
|
|||
|
|
(setq gnus-ignored-mime-types '("text/x-vcard")
|
|||
|
|
mm-discouraged-alternatives '("text/richtext" "text/html")
|
|||
|
|
mm-automatic-display (-difference mm-automatic-display
|
|||
|
|
'("text/html"
|
|||
|
|
"text/enriched"
|
|||
|
|
"text/richtext"))
|
|||
|
|
message-forward-as-mime t
|
|||
|
|
gnus-inhibit-mime-unbuttonizing nil
|
|||
|
|
gnus-buttonized-mime-types '("multipart/signed" "multipart/encrypted")
|
|||
|
|
gnus-inhibit-images t)
|
|||
|
|
|
|||
|
|
(setq message-citation-line-function
|
|||
|
|
(lambda ()
|
|||
|
|
(when message-reply-headers
|
|||
|
|
(insert "ghItlhpu' "(mail-header-from message-reply-headers) ":")
|
|||
|
|
(newline))))
|
|||
|
|
|
|||
|
|
(use-package mm-decode
|
|||
|
|
:config (progn
|
|||
|
|
;; Tells Gnus to inline the part
|
|||
|
|
(add-to-list 'mm-inlined-types "application/pgp$")
|
|||
|
|
;; Tells Gnus how to display the part when it is requested
|
|||
|
|
(add-to-list 'mm-inline-media-tests
|
|||
|
|
'("application/pgp$" mm-inline-text identity))
|
|||
|
|
;; Tell Gnus not to wait for a request, just display the thing
|
|||
|
|
;; straight away.
|
|||
|
|
(add-to-list 'mm-automatic-display "application/pgp$")
|
|||
|
|
|
|||
|
|
(setq mm-text-html-renderer 'shr)))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Signing and Encryption
|
|||
|
|
|
|||
|
|
(setq mm-encrypt-option nil
|
|||
|
|
mm-sign-option nil
|
|||
|
|
mm-decrypt-option 'known
|
|||
|
|
mm-verify-option 'known
|
|||
|
|
mml-smime-use 'epg
|
|||
|
|
;;mml2015-encrypt-to-self t
|
|||
|
|
mml2015-display-key-image nil
|
|||
|
|
gnus-message-replysign t
|
|||
|
|
gnus-message-replyencrypt t
|
|||
|
|
gnus-message-replysignencrypted t
|
|||
|
|
mml-secure-cache-passphrase nil
|
|||
|
|
mml-smime-cache-passphrase nil)
|
|||
|
|
|
|||
|
|
;; Automatic encryption if all necessary keys are present
|
|||
|
|
|
|||
|
|
(require 'mail-extr)
|
|||
|
|
|
|||
|
|
(defun db/public-key (address &optional method)
|
|||
|
|
"Return valid public keys for ADDRESS and given METHOD.
|
|||
|
|
|
|||
|
|
METHOD can be \"smime\" or \"pgpmime\"; defaults to \"pgpmime\".
|
|||
|
|
ADDRESS is a string containing exactly one email address."
|
|||
|
|
(check-type address string)
|
|||
|
|
(unless method (setq method "pgpmime"))
|
|||
|
|
(epg-list-keys (epg-make-context
|
|||
|
|
(cond
|
|||
|
|
((string= method "smime")
|
|||
|
|
'CMS)
|
|||
|
|
((string= method "pgpmime")
|
|||
|
|
'OpenPGP)
|
|||
|
|
(t (error "Unknown method %s" method))))
|
|||
|
|
address))
|
|||
|
|
|
|||
|
|
(defun db/encryption-possible-p (recipients method)
|
|||
|
|
"Check whether sending encrypted emails to all RECIPIENTS is possible.
|
|||
|
|
|
|||
|
|
METHOD specifies the encrypt method used. Can be either
|
|||
|
|
\"smime\" or \"pgpmime\"."
|
|||
|
|
(every (lambda (recipient)
|
|||
|
|
(not (null (db/public-key recipient method))))
|
|||
|
|
recipients))
|
|||
|
|
|
|||
|
|
(defun db/message-recipients ()
|
|||
|
|
"Return all recipients of the email in the current buffer."
|
|||
|
|
(cl-mapcan (lambda (field)
|
|||
|
|
(let ((field-value (message-field-value field)))
|
|||
|
|
(when field-value
|
|||
|
|
(mapcar #'cadr
|
|||
|
|
(mail-extract-address-components field-value t)))))
|
|||
|
|
(list "to" "cc" "bcc")))
|
|||
|
|
|
|||
|
|
(defun db/signencrypt-message-when-possible ()
|
|||
|
|
"Add mml markers for signing and encryption of an email if possible."
|
|||
|
|
(interactive)
|
|||
|
|
(when (eq major-mode 'message-mode)
|
|||
|
|
(let ((from (message-field-value "from")))
|
|||
|
|
(when from
|
|||
|
|
(let ((methods (if (string-match "@tu-dresden\.de>" from)
|
|||
|
|
(list "smime" "pgpmime")
|
|||
|
|
(list "pgpmime" "smime")))
|
|||
|
|
(recipients (db/message-recipients)))
|
|||
|
|
|
|||
|
|
;; if there is no recipient, encrypt with default method
|
|||
|
|
(if (null recipients)
|
|||
|
|
(mml-secure-message (first methods) 'signencrypt)
|
|||
|
|
|
|||
|
|
;; go through available keys
|
|||
|
|
(let ((available-method
|
|||
|
|
(cl-find-if (lambda (method)
|
|||
|
|
(db/encryption-possible-p recipients method))
|
|||
|
|
methods)))
|
|||
|
|
|
|||
|
|
(if available-method
|
|||
|
|
(mml-secure-message available-method 'signencrypt)
|
|||
|
|
|
|||
|
|
;; if nothing works, sign with default method
|
|||
|
|
(mml-secure-message (first methods) 'sign)))))))))
|
|||
|
|
|
|||
|
|
(add-hook 'gnus-message-setup-hook
|
|||
|
|
#'db/signencrypt-message-when-possible)
|
|||
|
|
|
|||
|
|
;; inspired by https://www.emacswiki.org/emacs/ExtendSMIME
|
|||
|
|
|
|||
|
|
(use-package ldap
|
|||
|
|
:config (progn
|
|||
|
|
(setq ldap-default-host "")
|
|||
|
|
(setq ldap-default-base "O=DFN-Verein,C=DE"
|
|||
|
|
ldap-ldapsearch-args '("-x" "-tt" "-H ldaps://ldap.pca.dfn.de"))))
|
|||
|
|
|
|||
|
|
(defun db/lookup-smime-key (mail)
|
|||
|
|
"Look up `MAIL' on ldap-server of the DFN.
|
|||
|
|
|
|||
|
|
If found, imports the certificate via gpgsm."
|
|||
|
|
(interactive "sMail: ")
|
|||
|
|
(when (get-buffer " *ldap-value*")
|
|||
|
|
(kill-buffer " *ldap-value*"))
|
|||
|
|
(ldap-search (format "(mail=%s)" mail))
|
|||
|
|
(let ((bufval (get-buffer " *ldap-value*")))
|
|||
|
|
(when bufval
|
|||
|
|
(with-current-buffer bufval
|
|||
|
|
(save-restriction
|
|||
|
|
(widen) ; just to be sure
|
|||
|
|
(let ((result (call-process-region (point-min) (point-max)
|
|||
|
|
"gpgsm"
|
|||
|
|
nil nil nil
|
|||
|
|
"--import")))
|
|||
|
|
(if (zerop result)
|
|||
|
|
(message "Successfully imported certificate for <%s>" mail)
|
|||
|
|
(error "Could not import certificate for <%s>" mail))))))))
|
|||
|
|
|
|||
|
|
;; Fix
|
|||
|
|
|
|||
|
|
(defun mm-view-pkcs7-verify (handle)
|
|||
|
|
(let ((verified nil))
|
|||
|
|
(with-temp-buffer
|
|||
|
|
(if (eq mml-smime-use 'epg)
|
|||
|
|
;; Use gpgsm
|
|||
|
|
(progn
|
|||
|
|
(insert-buffer-substring (mm-handle-buffer handle))
|
|||
|
|
(setq verified (epg-verify-string (epg-make-context 'CMS)
|
|||
|
|
(base64-decode-string (buffer-string)))))
|
|||
|
|
;; FIXME: insert valid signature
|
|||
|
|
;; use openssl
|
|||
|
|
(progn
|
|||
|
|
(insert "MIME-Version: 1.0\n")
|
|||
|
|
(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
|
|||
|
|
(insert-buffer-substring (mm-handle-buffer handle))
|
|||
|
|
(setq verified (smime-verify-region (point-min) (point-max))))))
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(mm-insert-part handle)
|
|||
|
|
(if (search-forward "Content-Type: " nil t)
|
|||
|
|
(delete-region (point-min) (match-beginning 0)))
|
|||
|
|
(goto-char (point-max))
|
|||
|
|
(if (re-search-backward "--\r?\n?" nil t)
|
|||
|
|
(delete-region (match-end 0) (point-max)))
|
|||
|
|
(unless verified
|
|||
|
|
(insert-buffer-substring smime-details-buffer)))
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(while (search-forward "\r\n" nil t)
|
|||
|
|
(replace-match "\n"))
|
|||
|
|
t)
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Custom commands
|
|||
|
|
|
|||
|
|
(bind-key "v u"
|
|||
|
|
'(lambda ()
|
|||
|
|
(interactive)
|
|||
|
|
(save-mark-and-excursion
|
|||
|
|
(when (gnus-topic-select-group)
|
|||
|
|
(gnus-summary-exit))))
|
|||
|
|
gnus-group-mode-map)
|
|||
|
|
|
|||
|
|
(bind-key "v j"
|
|||
|
|
'(lambda ()
|
|||
|
|
(interactive)
|
|||
|
|
(gnus-agent-toggle-plugged nil)
|
|||
|
|
(gnus-agent-toggle-plugged t)
|
|||
|
|
(gnus-group-get-new-news 3))
|
|||
|
|
gnus-group-mode-map)
|
|||
|
|
|
|||
|
|
(add-hook 'gnus-get-new-news-hook
|
|||
|
|
(lambda ()
|
|||
|
|
(when gnus-plugged
|
|||
|
|
(gnus-agent-toggle-plugged nil)
|
|||
|
|
(gnus-agent-toggle-plugged t))))
|
|||
|
|
|
|||
|
|
;; (bind-key "v g" #'db/get-mail gnus-group-mode-map)
|
|||
|
|
|
|||
|
|
(bind-key "v c"
|
|||
|
|
(lambda ()
|
|||
|
|
(interactive)
|
|||
|
|
(save-mark-and-excursion
|
|||
|
|
(gnus-topic-jump-to-topic "News")
|
|||
|
|
(gnus-topic-read-group)))
|
|||
|
|
gnus-group-mode-map)
|
|||
|
|
|
|||
|
|
(defun db/gnus-summary-open-Link ()
|
|||
|
|
"Open link named \"Link\" in current article."
|
|||
|
|
(interactive)
|
|||
|
|
(save-window-excursion
|
|||
|
|
(save-mark-and-excursion
|
|||
|
|
(save-restriction
|
|||
|
|
(widen)
|
|||
|
|
(let ((url nil))
|
|||
|
|
(unless (eq major-mode 'gnus-article-mode)
|
|||
|
|
(gnus-summary-select-article-buffer))
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(while (and (not url)
|
|||
|
|
(search-forward "Link"))
|
|||
|
|
(backward-char)
|
|||
|
|
(setq url (get-text-property (point) 'shr-url)))
|
|||
|
|
(when url
|
|||
|
|
(browse-url url)))))))
|
|||
|
|
|
|||
|
|
(bind-key "C-<return>" #'db/gnus-summary-open-Link gnus-summary-mode-map)
|
|||
|
|
(bind-key "C-<return>" #'db/gnus-summary-open-Link gnus-article-mode-map)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Timeout for fetching news
|
|||
|
|
|
|||
|
|
(setq nntp-connection-timeout nil)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Agents
|
|||
|
|
|
|||
|
|
(setq gnus-agent-mark-unread-after-downloaded nil
|
|||
|
|
gnus-agent-synchronize-flags t
|
|||
|
|
gnus-agent-go-online t)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Do some pretty printing before saving the newsrc file
|
|||
|
|
|
|||
|
|
(defun db/gnus-save-newsrc-with-whitespace-1 ()
|
|||
|
|
"Save ~/.newsrc.eld with extra whitespace."
|
|||
|
|
;; http://ding.gnus.narkive.com/pq3Z8ZjQ/pretty-printing-newsrc-eld#post3
|
|||
|
|
(gnus-message 5 "Adding whitespace to .newsrc.eld")
|
|||
|
|
(save-excursion
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(while (re-search-forward "(\\\"\\| ((\\| (nn" nil t)
|
|||
|
|
(replace-match "\n \\&" t))
|
|||
|
|
(delete-trailing-whitespace)))
|
|||
|
|
|
|||
|
|
(add-hook 'gnus-save-quick-newsrc-hook #'db/gnus-save-newsrc-with-whitespace-1)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Mail Formatting
|
|||
|
|
|
|||
|
|
(setq gnus-posting-styles
|
|||
|
|
`((".*"
|
|||
|
|
(name ,user-full-name)
|
|||
|
|
(address ,db/work-mail-address)
|
|||
|
|
(signature-file "~/.signature-minimal")
|
|||
|
|
("X-Jabber-ID" ,db/jabber-id))
|
|||
|
|
(message-mail-p
|
|||
|
|
(signature-file "~/.signature"))
|
|||
|
|
("algebra20:.*"
|
|||
|
|
(address ,db/personal-mail-address)
|
|||
|
|
(signature-file "~/.signature"))
|
|||
|
|
("tu:.*"
|
|||
|
|
(name ,user-full-name)
|
|||
|
|
(address ,db/work-mail-address)
|
|||
|
|
(signature-file "~/.signature-official"))))
|
|||
|
|
|
|||
|
|
;; http://mbork.pl/2015-11-28_Fixing_mml-attach-file_using_advice
|
|||
|
|
(defun db/mml-attach-file--go-to-eob (orig-fun &rest args)
|
|||
|
|
"Go to the end of buffer before attaching files."
|
|||
|
|
(save-excursion
|
|||
|
|
(save-restriction
|
|||
|
|
(widen)
|
|||
|
|
(goto-char (point-max))
|
|||
|
|
(apply orig-fun args))))
|
|||
|
|
|
|||
|
|
(advice-add 'mml-attach-file :around #'db/mml-attach-file--go-to-eob)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Archiving
|
|||
|
|
|
|||
|
|
;; FIXME: this is obsolete
|
|||
|
|
(setq gnus-message-archive-method
|
|||
|
|
`(nnfolder "archive"
|
|||
|
|
(nnfolder-inhibit-expiry t)
|
|||
|
|
(nnfolder-active-file ,(expand-file-name "archive/active" gnus-directory))
|
|||
|
|
(nnfolder-directory ,(expand-file-name "archive/" gnus-directory)))
|
|||
|
|
gnus-update-message-archive-method t
|
|||
|
|
gnus-message-archive-group "archive"
|
|||
|
|
gnus-gcc-mark-as-read t)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; SMTP configuration
|
|||
|
|
|
|||
|
|
(require 'smtpmail)
|
|||
|
|
(require 'starttls)
|
|||
|
|
|
|||
|
|
(defadvice smtpmail-send-it (around display-trace-buffer disable)
|
|||
|
|
"If an error is signalled, display the process buffer."
|
|||
|
|
(condition-case signals-data
|
|||
|
|
ad-do-it
|
|||
|
|
(error (shrink-window-if-larger-than-buffer
|
|||
|
|
(display-buffer (get-buffer (format "*trace of SMTP session to %s*"
|
|||
|
|
smtpmail-smtp-server))))
|
|||
|
|
(signal (car signals-data) (cdr signals-data)))))
|
|||
|
|
|
|||
|
|
(setq send-mail-function 'smtpmail-send-it
|
|||
|
|
smtpmail-stream-type 'starttls
|
|||
|
|
smtpmail-smtp-service 587
|
|||
|
|
starttls-use-gnutls t
|
|||
|
|
starttls-extra-arguments '("--strict-tofu")
|
|||
|
|
smtpmail-smtp-server (nth 1 (car db/smtp-accounts))
|
|||
|
|
smtpmail-smtp-user (nth 4 (car db/smtp-accounts)))
|
|||
|
|
|
|||
|
|
(defun db/set-smtp-server-from-header (orig-fun &rest args)
|
|||
|
|
"Choose smtp-settings dynamically, based on the From: header
|
|||
|
|
entry of the current mail."
|
|||
|
|
(require 'mail-extr)
|
|||
|
|
(let* ((from (or (save-restriction
|
|||
|
|
(message-narrow-to-headers)
|
|||
|
|
(mail-fetch-field "From"))
|
|||
|
|
user-mail-address))
|
|||
|
|
(address (cadr (mail-extract-address-components from)))
|
|||
|
|
;; db/smtp-accounts set in db-private
|
|||
|
|
(account (assoc address db/smtp-accounts)))
|
|||
|
|
(message "Using address: %s" address)
|
|||
|
|
(if account
|
|||
|
|
(progn
|
|||
|
|
(message "Sending with account for %s" address)
|
|||
|
|
(cl-destructuring-bind (smtpmail-smtp-server
|
|||
|
|
smtpmail-stream-type
|
|||
|
|
smtpmail-smtp-service
|
|||
|
|
smtpmail-smtp-user)
|
|||
|
|
(cdr account)
|
|||
|
|
(apply orig-fun args)))
|
|||
|
|
(progn
|
|||
|
|
(message "Sending with default account settings")
|
|||
|
|
(apply orig-fun args)))))
|
|||
|
|
|
|||
|
|
(advice-add 'smtpmail-via-smtp
|
|||
|
|
:around #'db/set-smtp-server-from-header)
|
|||
|
|
|
|||
|
|
(setq smtpmail-debug-info t)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Notmuch
|
|||
|
|
|
|||
|
|
(require 'nnir)
|
|||
|
|
|
|||
|
|
(setq nnir-method-default-engines '((nnimap . imap)
|
|||
|
|
(nnmaildir . notmuch)
|
|||
|
|
(nntp . gmane)))
|
|||
|
|
|
|||
|
|
(use-package notmuch
|
|||
|
|
:config (progn
|
|||
|
|
;; (bind-key "GG" 'notmuch-search gnus-group-mode-map)
|
|||
|
|
|
|||
|
|
(defun db/notmuch-search-update-index (orig-fun &rest args)
|
|||
|
|
"Update notmuch index before searching"
|
|||
|
|
(message "Indexing new Mail...")
|
|||
|
|
(shell-command "notmuch new --quiet 2>&1 | grep -v \"Note: Ignoring\"")
|
|||
|
|
(message "Indexing new Mail... done.")
|
|||
|
|
(apply orig-fun args))
|
|||
|
|
|
|||
|
|
(advice-add 'notmuch-search
|
|||
|
|
:around #'db/notmuch-search-update-index)
|
|||
|
|
(advice-add 'nnir-run-notmuch
|
|||
|
|
:around #'db/notmuch-search-update-index)
|
|||
|
|
|
|||
|
|
(setq notmuch-fcc-dirs nil)))
|
|||
|
|
|
|||
|
|
;;;
|
|||
|
|
|
|||
|
|
t
|