My Emacs settings
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

281 lines
10 KiB

(require 'notmuch)
(require 'seq)
(require 'org-notmuch)
(require 'fetch-email)
(require 'alert)
(require 'yasnippet)
(require 'debbugs)
(setq-default notmuch-command (expand-file-name "~/.emacs.d/lib/notmuch/notmuch"))
;; For existing org links, load mu4e anyway
;; use notmuch for sending emails
(global-set-key (kbd "C-x m") #'notmuch-mua-new-mail)
;; don't keep message buffers around
(setq message-kill-buffer-on-exit t)
;; Attach files from dired
(add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)
;; use imagemagick, if available
(when (fboundp 'imagemagick-register-types)
(defvar nico-pgp-sign-excluded-emails '("monitor\.issues@gmail\.com"))
;; Sign messages by default
(add-hook 'message-setup-hook #'nico-maybe-sign-email)
(add-hook 'message-setup-hook #'yas-minor-mode-on)
(defun nico-maybe-sign-email ()
"Sign the current buffer's email unless the message is sent to
one of `nico-pgp-sign-excluded-emails'."
(let ((email (message-fetch-field "to")))
(unless (and email
(seq-some (lambda (regex)
(string-match regex email))
(define-key global-map (kbd "M-N") #'notmuch)
(add-to-list 'fetch-email-post-command-hook #'nico-notmuch-update)
(define-key notmuch-hello-mode-map (kbd "C-c C-c") #'fetch-email)
(define-key notmuch-hello-mode-map "g" #'notmuch-refresh-this-buffer)
(define-key notmuch-search-mode-map "g" #'notmuch-refresh-this-buffer)
(define-key notmuch-search-mode-map "d" #'nico-notmuch-search-tag-read)
(define-key notmuch-search-mode-map "D" #'nico-notmuch-search-tag-all-read)
(define-key notmuch-search-mode-map "u" #'nico-notmuch-search-tag-unread)
(define-key notmuch-show-mode-map "d" #'nico-notmuch-show-tag-read)
(define-key notmuch-show-mode-map "D" #'nico-notmuch-show-tag-all-read)
(define-key notmuch-show-mode-map "u" #'nico-notmuch-show-tag-unread)
(defun nico-notmuch-update (&rest args)
(defun nico-notmuch-address-selection-function (prompt collection initial-input)
"Call (`completing-read'
PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
prompt (cons initial-input collection) nil nil initial-input 'notmuch-address-history))
(defun nico-notmuch-search-tag (tags)
(notmuch-search-tag tags)
(forward-line 1))
(defun nico-notmuch-search-tag-read ()
(nico-notmuch-search-tag '("-unread")))
(defun nico-notmuch-search-tag-all-read ()
(if (y-or-n-p "Mark all threads as read? ")
(notmuch-search-tag-all '("-unread")))))
(defun nico-notmuch-search-tag-unread ()
(nico-notmuch-search-tag '("+unread")))
(defun nico-notmuch-show-tag-read ()
(notmuch-show-tag '("-unread")))
(defun nico-notmuch-show-tag-all-read ()
(if (y-or-n-p "Mark all threads as read? ")
(notmuch-show-tag-all '("-unread")))))
(defun nico-notmuch-show-tag-unread ()
(notmuch-show-tag '("+unread")))
(setq message-send-mail-function #'message-send-mail-with-sendmail
sendmail-program "msmtpq"
user-full-name "Nicolas Petton"
starttls-use-gnutls t)
(defvar nico-notmuch-account-alist
(user-mail-address ""))
(user-mail-address ""))))
(setq notmuch-fcc-dirs '(("" . "petton/Sent -unread")
("" . "\"ftgp/Sent Items\" -unread")))
(defun nico-setup-mail-account (account)
(let ((account-vars (cdr (assoc account nico-notmuch-account-alist))))
(mapc (lambda (var)
(set (car var) (cadr var)))
(defun nico-select-mail-account ()
(completing-read (format "Compose with account: (%s) "
(mapconcat (lambda (var) (car var)) nico-notmuch-account-alist "/"))
(mapcar (lambda (var) (car var)) nico-notmuch-account-alist)
nil t nil nil (caar nico-notmuch-account-alist)))
(add-hook 'message-setup-hook #'nico-set-email-account-and-setup-message)
(defun nico-set-email-account ()
"Set the account for composing a message."
(let* ((account
(nico-setup-mail-account account)))
(defun nico-set-email-account-and-setup-message ()
(delete-region (point) (point-at-eol))
(insert (format "%s <%s>" user-full-name user-mail-address)))
(nico-setup-mail-account "")
(setq smtpmail-debug-info t)
;; notifications
(defvar nico-notmuch-refresh-count 0)
(defun nico-notmuch-refresh-status-message ()
(let* ((new-count
(car (process-lines notmuch-command "count"))))
(diff-count (- new-count nico-notmuch-refresh-count)))
(if (and (not (zerop nico-notmuch-refresh-count))
(> diff-count 0))
(alert (format "You have %s messages."
(notmuch-hello-nice-number diff-count))
:title "New messages"
:icon "/usr/share/icons/gnome/32x32/status/mail-unread.png"))
(setq nico-notmuch-refresh-count new-count)))
;; (add-hook 'notmuch-hello-refresh-hook #'nico-notmuch-refresh-status-message)
;; opening attachments within emacs & xwidgets
(define-key notmuch-show-part-map "e" #'nico-notmuch-view-part-in-emacs)
(define-key notmuch-show-part-map "w" #'nico-notmuch-view-part-in-webkit)
(define-key notmuch-show-part-map "p" #'nico-notmuch-apply-git-patch)
(define-key notmuch-show-part-map "a" #'nico-notmuch-git-am-patch)
(defun nico-notmuch-view-part-in-emacs ()
"View the MIME part containing point from within Emacs."
(notmuch-show-apply-to-current-part-handle #'nico-view-part-in-emacs))
(defun nico-notmuch-view-part-in-webkit ()
"View the MIME part containing point from within an xwidget webkit buffer."
(notmuch-show-apply-to-current-part-handle #'nico-view-part-in-webkit))
(defun nico-notmuch-apply-git-patch ()
"Apply the MIME part at point as a git patch using `git patch'."
(notmuch-show-apply-to-current-part-handle #'nico-notmuch-apply-git-patch-part))
(defun nico-notmuch-git-am-patch ()
"Apply the MIME part at point as a git patch using `git am'."
(notmuch-show-apply-to-current-part-handle #'nico-notmuch-git-am-part))
(defun nico-view-part-in-emacs (handle)
(let* ((dir (make-temp-dir))
(filename (or (mail-content-type-get
(mm-handle-disposition handle) 'filename)
(mm-handle-type handle) 'name)
(contents (mm-get-part handle))
(file (expand-file-name filename dir))
(buf (find-file-noselect file)))
(with-current-buffer buf
(insert contents)
(kill-buffer buf)
(pop-to-buffer (find-file-noselect file))))
(defun nico-view-part-in-webkit (handle)
(let* ((dir (make-temp-dir))
(filename (or (mail-content-type-get
(mm-handle-disposition handle) 'filename)
(mm-handle-type handle) 'name)
(contents (mm-get-part handle))
(file (expand-file-name filename dir))
(encoding 'raw-text)
(buf (find-file-noselect file)))
(with-current-buffer buf
(insert contents)
(set-buffer-file-coding-system encoding)
(kill-buffer buf)
(xwidget-webkit-browse-url (format "file://%s" file))))
(defun nico-notmuch-apply-git-patch-part (handle)
(let ((dir (read-directory-name "Git directory: ")))
(mm-pipe-part handle (format "cd %s; git apply" (expand-file-name dir)))))
(defun nico-notmuch-git-am-part (handle)
(let ((dir (read-directory-name "Git directory: ")))
(mm-pipe-part handle (format "cd %s; git am" (expand-file-name dir)))))
(defun make-temp-dir ()
(let* ((dirname (make-temp-name temporary-file-directory))
(absolute-name (expand-file-name dirname temporary-file-directory)))
(make-directory absolute-name)
;; Function to return first name of email recipient
;; Used by yasnippet
;; Based closely on
(defun nico-yas-get-first-name-from-to-field ()
(let ((rlt "NAME") str rlt2)
(goto-char (point-min))
;; first line in email could be some hidden line containing NO to field
(setq str (buffer-substring-no-properties (point-min) (point-max))))
;; take name from TO field
(when (string-match "^To: \"?\\([^ ,]+\\)" str)
(setq rlt (match-string 1 str)))
;;get name in FROM field if available
(when (string-match "^\\([^ ,\n]+\\).+writes:$" str)
(progn (setq rlt2 (match-string 1 str))
;;prefer name in FROM field if TO field has "@"
(when (string-match "@" rlt)
(setq rlt rlt2))
(message "rlt=%s" rlt)
(advice-add 'debbugs-gnu-select-report :override #'debbugs-notmuch-select-report)
(defun debbugs-notmuch-select-report (&rest _)
(let* ((status (debbugs-gnu-current-status))
(id (cdr (assq 'id status)))
(merged (cdr (assq 'mergedwith status))))
(setq merged (if (listp merged) merged (list merged)))
(unless id
(user-error "No bug report on the current line"))
(let ((address (format "" id))
(merged-addresses (string-join (mapcar (lambda (id)
(format "" id))
" ")))
(notmuch-search (format "%s %s" address merged-addresses)))))
(provide 'init-notmuch)
;;; init-notmuch ends here