From 22b0a6b56ffe8c423047ee25440dce79a990610c Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Thu, 12 Jan 2023 16:39:38 -0600 Subject: Make it work for ... $work --- lisp/acdw-mail.el | 233 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 233 insertions(+) create mode 100644 lisp/acdw-mail.el (limited to 'lisp/acdw-mail.el') diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el new file mode 100644 index 0000000..d0ee28e --- /dev/null +++ b/lisp/acdw-mail.el @@ -0,0 +1,233 @@ +;;; acdw-mail.el --- My email configuration -*- lexical-binding: t; -*- + +;;; Code: + +(require 'cl-lib) + +;;; Variables + +(defcustom +message-send-dispatch-rules nil + "Alist to set variables based on the current from address." + :group 'message + :type '(alist :key-type (string :tag "From address") + :value-type (alist :tag "Rules" + :key-type (symbol :tag "Variable") + :value-type (sexp :tag "Value")))) + +(defcustom +notmuch-spam-tags '("+spam") + "List of tag changes to apply when marking a thread as spam." + :group 'notmuch + :type '(repeat string)) + +;;; Functions + +(defun +message-send-set-variables () + "Set variables for `message-send' depending on the From: header. +Useful in `message-send-hook'." + (let ((from (message-fetch-field "from"))) + (cl-loop for (var . val) in (cl-loop for (address . bindings) + in +message-send-dispatch-rules + if (string-match-p address from) + return bindings) + do (set (make-local-variable var) val)))) + +;; Thanks to Alex Schroeder! +;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically +(defun +message-check-for-signature-change (&rest ignore) + "Check for a change in the To: or Cc: fields" + (when (and (message--in-tocc-p) + (not (buffer-narrowed-p))) + (save-excursion + (goto-char (point-max)) + (let ((end (point))) + (when (re-search-backward message-signature-separator nil t) + (delete-region (1- (match-beginning 0)) end))) + (message-insert-signature)))) + +(defun +message-signature-setup () + (make-local-variable 'after-change-functions) + (push '+message-check-for-signature-change after-change-functions)) + +(defun +notmuch-field-match-p (field regexp) + "Return whether message FIELD matches REGEXP." + (string-match-p regexp (or (message-fetch-field field) ""))) + +(defun +notmuch-query-concat (&rest queries) + "Concatenate `notmuch' QUERIES with AND." + (mapconcat #'identity queries " AND ")) + +(defun +notmuch-goto (&optional prefix) + "Perform a saved `notmuch' search. +Without a PREFIX argument, perform the first search in +`notmuch-saved-searches'. With a single PREFIX argument +(\\[universal-argument]), prompt the user as to which saved +search to perform. With two PREFIX arguments, prompt the user +for a free-form search. With any other PREFIX argument, open +`notmuch-hello'." + (interactive "P") + (pcase prefix + ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) + ('(4) (notmuch-search + (plist-get (cl-find (completing-read "Saved search: " + (mapcar (lambda (elt) + (plist-get elt :name)) + notmuch-saved-searches)) + :key (lambda (elt) (plist-get elt :name)) + :test #'equal) + :query))) + ('(16) (notmuch-search)) + (_ (notmuch-hello)))) + +(defun +notmuch-search-mark-spam (&optional ham start end) + "Mark the current thread or region as spam. +That is, add the tags in `+notmuch-spam-tags' to the message. +With an optional HAM argument (interactively, +\\[universal-argument]), mark the message as not-spam, or ham, by +reversing the tag changes." + (interactive (cons current-prefix-arg (notmuch-interactive-region))) + (when +notmuch-spam-tags + (notmuch-search-tag (notmuch-tag-change-list +notmuch-spam-tags ham) + start end)) + (when (eq start end) + (notmuch-search-next-thread))) + +(defun +notmuch-tree-mark-spam (&optional ham) + "Mark the current message as spam. +That is, add the tags in `+notmuch-spam-tags' to the message. +With an optional HAM argument (interactively, +\\[universal-argument]), mark the message as not-spam, or ham, by +reversing the tag changes." + (interactive (cons current-prefix-arg (notmuch-interactive-region))) + (when +notmuch-spam-tags + (notmuch-tree-tag (notmuch-tag-change-list +notmuch-spam-tags ham))) + (notmuch-tree-next-matching-message)) + +(defun +notmuch-define-saved-search (name key search-type &rest queries) + "Wrapper to ease `notmuch-saved-searches' defining. +NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in +`notmuch-saved-searches', which see. QUERIES are all concatenated together with +AND. If QUERIES is prepended with more keyword arguments, those are added to +the saved search as well." + (declare (indent 3)) + (let (extra-keywords) + (while (keywordp (car queries)) + (push (cadr queries) extra-keywords) + (push (car queries) extra-keywords) + (setf queries (cddr queries))) + (add-to-list 'notmuch-saved-searches + (append (list :name name + :key key + :search-type search-type + :query (apply #'+notmuch-query-concat queries)) + (reverse extra-keywords)) + :append + (lambda (a b) + (equal (plist-get a :name) + (plist-get b :name)))))) + +;;; Packages + +(use-package bbdb + :ensure t + :config + (setopt bbdb-complete-mail-allow-cycling t + bbdb-file (private/ "bbdb")) + (add-hook 'custom-allowed-after-load-hook + (defun bbdb@after-custom () + (require 'bbdb) + (require 'bbdb-message) + (bbdb-initialize 'message)))) + +(use-package bbdb-vcard + :ensure t + :after bbdb) + +(use-package notmuch + :when (executable-find "notmuch") + :load-path "~/usr/share/emacs/site-lisp/" + :defer t + :commands (notmuch-mua-new-mail + notmuch-search + notmuch-hello) + :preface (defdir notmuch/ (sync/ "emacs/notmuch/") + "Notmuch configuration directory." + :makedir) + :config + ;; Options + (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t) + notmuch-address-save-filename (notmuch/ "addresses" t) + notmuch-address-use-company (featurep 'company) + notmuch-search-oldest-first nil + notmuch-archive-tags '("-inbox" "-unread") + notmuch-draft-tags '("+draft" "-inbox" "-unread") + +notmuch-spam-tags '("+spam" "+Spam") + mail-user-agent 'notmuch-user-agent + message-mail-user-agent t + notmuch-show-indent-content nil + message-kill-buffer-on-exit t + message-auto-save-directory nil + send-mail-function #'sendmail-send-it + mail-specify-envelope-from t + message-sendmail-envelope-from 'header + message-envelope-from 'header + notmuch-saved-searches nil) + ;; Key bindings + (keymap-global-set "C-c m" #'nomtuch-mua-new-mail) + (keymap-global-set "C-c n" #'+notmuch-goto) + (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam) + (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) + (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread) + (keymap-set notmuch-tree-mode-map "!" #'+notmuch-tree-mark-spam) + ;; Saved searches + (+notmuch-define-saved-search "inbox+unread" "m" 'tree + "tag:inbox" "tag:unread" "NOT tag:Spam") + (+notmuch-define-saved-search "inbox" "i" 'tree + "tag:inbox" "NOT tag:Spam") + (+notmuch-define-saved-search "lists+unread" "l" 'tree + "tag:/List/" "tag:unread") + (+notmuch-define-saved-search "lists" "L" 'tree + "tag:/List/") + (+notmuch-define-saved-search "unread" "u" 'tree + "tag:unread" "NOT tag:Spam") + (+notmuch-define-saved-search "flagged" "f" 'tree + "tag:flagged") + (+notmuch-define-saved-search "sent" "t" 'tree + "tag:sent") + (+notmuch-define-saved-search "drafts" "d" 'tree + "tag:draft") + (+notmuch-define-saved-search "all mail" "a" 'tree "*") + ;; Hooks and advice + (add-hook 'message-send-hook #'+message-send-dispatch-rules) + (add-hook 'message-setup-hook #'+message-signature-setup) + (autoload 'visual-fill-column-mode "visual-fill-column" nil t) + (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode) + (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode) + + (define-advice notmuch-address-selection-function + (:override (prompt collection _) no-initial-input) + "Call `completing-read' with `notmuch-address-history'. +This version doesn't add any initial-input." + (completing-read prompt collection nil nil nil 'notmuch-address-history)) + + (add-to-list 'notmuch-message-headers "List-Post" :append #'equal) + (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) + "Make `notmuch-mua-new-reply' list-aware." + (let ((ml (notmuch-show-get-header :List-Post))) + (apply orig r) + (when ml + (with-buffer-modified-unmodified + (message-remove-header "To") + (message-add-header + (format "To: %s" (replace-regexp-in-string "" "\\1" + ml))) + (messgage-goto-body))))) + + (define-advice notmuch-tag (:filter-args (args) trim) + "Trim whitespace from ends of tags." + (list (car args) (mapcar #'string-trim (cadr args)))) + ;; Load init file + ;; (load notmuch-init-file 'noerror) + ) + +(provide 'acdw-mail) +;;; acdw-mail.el ends here -- cgit 1.4.1-21-gabe81