1 files changed, 0 insertions, 439 deletions

@@ -1,439 +0,0 @@
-;;; acdw-mail.el --- My email configuration  -*- lexical-binding: t; -*-
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'message)
-
-;;; 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 -inbox -unread")
-  "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'."
-  (unless +message-send-dispatch-rules
-    (load notmuch-init-file)
-    (or +message-send-dispatch-rules
-        (error "`+message-send-dispatch-rules' isn't set!")))
-  (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 "))
-
-;;;###autoload
-(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))
-                               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))))))
-
-(defun notmuch-async-poll ()
-  "Run `notmuch-poll' in an async process."
-  (interactive)
-  (if (require 'async nil t)
-      (progn
-        (message "Polling mail (async)...")
-        (async-start
-         (lambda ()
-           (ignore-errors
-             (push "~/usr/share/emacs/site-lisp/" load-path)
-             (require 'notmuch-lib)
-             (notmuch-poll)))
-         (lambda (_)
-           (message "Polling mail (async)...done"))))
-    (user-error "Feature `async' not found!")
-    (notmuch-poll)))
-
-;;; https://kitchingroup.cheme.cmu.edu/blog/2015/09/04/Checking-for-email-attachments-before-you-send-email/
-
-(defun email-says-attach-p ()
-  "Return t if email suggests there could be an attachment."
-  (save-excursion
-    (goto-char (point-min))
-    (re-search-forward "attach" nil t)))
-
-(defun email-has-attachment-p ()
-  "Return t if the currently open email has an attachment."
-  (save-excursion
-    (goto-char (point-min))
-    (re-search-forward "<#part" nil t)))
-
-(defun email-pre-send-check-attachment ()
-  (when (and (email-says-attach-p)
-             (not (email-has-attachment-p)))
-    (unless
-        (y-or-n-p
-         "Your email suggests an attachment, but none was found. Send anyway?")
-      (error "No attachment.  Aborting send."))))
-
-;;; Process ical attachments
-;; https://www.reddit.com/r/emacs/comments/8s1ion/comment/e0x5kgd/
-
-(defun ical2org (&optional replace output-buffer)
-  "Run ical2org on contents of this buffer.
-If REPLACE (interactive prefix argument), replace contents of the
-buffer.  If no REPLACE nor OUTPUT-BUFFER, output goes to
-minibuffer."
-  (interactive "P")
-  (shell-command-on-region (point-min) (point-max)
-                           "ical2org.awk"
-                           output-buffer
-                           replace
-                           "*ical2org errors*"
-                           'display-errors))
-
-(defun ical2org-capture ()
-  "Run `ical2org' on this buffer, then `org-capture' the result.
-Leaves current buffer as-was afterwards."
-  (interactive)
-  (let ((buf (current-buffer))
-        (ics (buffer-string)))
-    (ical2org 'replace buf)
-    (mark-whole-buffer)
-    (org-capture nil "a")
-    (mark-whole-buffer)
-    (delete-region (point-min) (point-max))
-    (insert ics)))
-
-(defun notmuch-ics-refile (filename header)
-  "Refile the current ICS buffer to FILENAME, under HEADER."
-  (org-refile nil nil
-              (list header
-                    filename
-                    nil
-                    (with-current-buffer (find-file-noselect filename)
-                      (org-find-exact-headline-in-buffer header))))
-  (notmuch-ics-kill))
-
-(defun notmuch-ics-kill ()
-  "Kill the current ICS buffer and delete its file."
-  (let ((kill-buffer-hook nil)
-        (kill-buffer-query-functions nil)
-        (file (buffer-file-name)))
-    (set-buffer-modified-p nil)
-    (kill-buffer-and-window)
-    (delete-file file)))
-
-(defun notmuch-ics-cancel ()
-  "Cancel saving ICS buffer."
-  (interactive)
-  (notmuch-ics-kill))
-
-(define-derived-mode notmuch-save-ics-mode org-mode
-  "Org-mode but with a different keymap.")
-
-(defun notmuch-save-ics ()
-  ;; XXX: this is hacky as hell
-  "Save a .ics file in a message."
-  (interactive)
-  (with-current-notmuch-show-message
-   (notmuch-foreach-mime-part
-    (lambda (part)
-      (when (and (listp part)
-                 (or (equal "application/ics" (caadr part))
-                     ;; (equal "text/calendar" (caadr part))
-                     ))
-        (let* ((filename (format "/dev/shm/notmuch-%s.ics"
-                                 (time-convert (current-time) 'integer))))
-          (mm-save-part-to-file part filename)
-          (message "Converting ICS to org ...")
-          (with-current-buffer (find-file-other-window filename)
-            (ical2org 'replace (current-buffer))
-            (deactivate-mark)
-            (let ((org-mode-hook nil))
-              (notmuch-save-ics-mode))
-            (local-set-key (kbd "C-c C-c")
-                           (lambda () (interactive)
-                             (notmuch-ics-refile (sync/ "org/diary.org") "Appointments")))
-            (local-set-key (kbd "C-c C-k") #'notmuch-ics-cancel)
-            (setq-local header-line-format
-                        (concat "ICAL buffer.  "
-                                "Finish: `C-c C-c'.  "
-                                "Abort: `C-c C-k'."))))))
-    (mm-dissect-buffer t t))))
-
-(add-hook 'notmuch-show-hook #'notmuch-save-ics)
-
-
-;;; Fixes
-
-;; https://nmbug.notmuchmail.org/nmweb/show/87bklhricc.fsf%40tethera.net
-
-(defun notmuch--indent-rigidly (start end count)
-  (cond
-   ((zerop count) t)
-   ((< count 0) (indent-rigidly start end count))
-   (t
-    (save-excursion
-      (let ((startpt (progn (goto-char start) (line-beginning-position)))
-            (endpt (progn (goto-char end) (line-end-position)))
-            (spaces (spaces-string count)))
-        (goto-char startpt)
-        (while
-            (progn
-              (insert spaces)
-              (cl-incf endpt count)
-              (and (zerop (forward-line 1)) (bolp)
-                   (<= (point) endpt)))))))))
-
-(with-eval-after-load 'notmuch-show
-  ;; Redefine `notmuch-show-lazy-part' --- XXX: this is the most braindead way
-  ;; of doing this
-  (defun notmuch-show-lazy-part (part-args button)
-    ;; Insert the lazy part after the button for the part. We would just
-    ;; move to the start of the new line following the button and insert
-    ;; the part but that point might have text properties (eg colours
-    ;; from a message header etc) so instead we start from the last
-    ;; character of the button by adding a newline and finish by
-    ;; removing the extra newline from the end of the part.
-    (save-excursion
-      (goto-char (button-end button))
-      (insert "\n")
-      (let* ((inhibit-read-only t)
-             ;; We need to use markers for the start and end of the part
-             ;; because the part insertion functions do not guarantee
-             ;; to leave point at the end of the part.
-             (part-beg (copy-marker (point) nil))
-             (part-end (copy-marker (point) t))
-             ;; We have to save the depth as we can't find the depth
-             ;; when narrowed.
-             (depth (notmuch-show-get-depth)))
-        (save-restriction
-          (narrow-to-region part-beg part-end)
-          (delete-region part-beg part-end)
-          (apply #'notmuch-show-insert-bodypart-internal part-args)
-          (notmuch--indent-rigidly part-beg
-                                   part-end
-                                   (* notmuch-show-indent-messages-width depth)))
-        (goto-char part-end)
-        (delete-char 1)
-        (notmuch-show-record-part-information (cadr part-args)
-                                              (button-start button)
-                                              part-end)
-        ;; Create the overlay. If the lazy-part turned out to be empty/not
-        ;; showable this returns nil.
-        (notmuch-show-create-part-overlays button part-beg part-end))))
-  )
-
-
-;;; 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 30
-  :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")
-          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
-          message-signature "Case Duckworth\nhttps://www.acdw.net"
-          send-mail-function #'sendmail-send-it
-          mail-specify-envelope-from t
-          message-sendmail-envelope-from 'header
-          message-envelope-from 'header
-          notmuch-saved-searches nil
-          notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option
-          )
-  (load notmuch-init-file)
-  ;; Key bindings
-  (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-set-variables)
-  (add-hook 'message-send-hook #'email-pre-send-check-attachment)
-  (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-bury-or-kill-this-buffer (:after (&rest _) poll-async)
-    (call-process "swaymail"))
-
-  (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)
-      (require 'message)
-      (when ml
-        (with-buffer-modified-unmodified
-         (message-remove-header "To")
-         (message-add-header
-          (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1"
-                                                     ml)))
-         (message-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))
-
-(use-package notmuch-tags
-  :load-path "~/src/emacs/notmuch-tags.el/"
-  :commands (notmuch-tags-mode))
-
-(provide 'acdw-mail)
-;;; acdw-mail.el ends here