#+title: email handling (message mode, bbdb, notmuch, et al.)
#+property: header-args :tangle no :comments no :results silent :shebang "#!/bin/bash"
#+auto_tangle: t

* Message mode
*** Customization
    #+begin_src emacs-lisp
      (defvar jao-mails "")
      (defvar jao-mails-regexp)
      (setq jao-mails-regexp (regexp-opt jao-mails))

      (require 'message)
      (setq message-send-mail-function 'message-send-mail-with-sendmail
            message-sendmail-envelope-from 'header
            message-sendmail-f-is-evil nil)
      (setq imap-store-password t)
      (setq password-cache-expiry nil)
      (setq message-generate-headers-first t)
      (setq message-forward-before-signature nil)
      (setq message-alternative-emails jao-mails-regexp)
      (setq message-dont-reply-to-names
            (format "%s\\|%s" jao-mails-regexp (regexp-opt '("noreply@" "@noreply"
                                                             "no-reply@" "@no-reply"
                                                             "notifications@github"))))
      (setq message-citation-line-format "On %a, %b %d %Y, %N wrote:\n")
      (setq message-citation-line-function 'message-insert-formatted-citation-line)

      (setq message-user-fqdn "gnus.jao.io")

      ;; writing messages
      (setq message-kill-buffer-on-exit t)
      (setq message-max-buffers 5)
      (setq message-insert-signature t)
      (setq message-from-style 'angles
            user-mail-address (car jao-mails)
            mail-host-address system-name
            message-syntax-checks '((sender . disabled))
            message-default-headers
            (concat
             "X-Attribution: jao\n"
             "X-Clacks-Overhead: GNU Terry Pratchett\n"
             "X-URL: <http://jao.io/>\n")
            message-hidden-headers
            '("^References:" "^Face:" "^X-Face:" "^X-Draft-From:")
            message-make-forward-subject-function 'message-forward-subject-fwd)

      (setq message-expand-name-standard-ui t)
    #+end_src
*** Encryption
    #+BEGIN_SRC emacs-lisp
      (require 'gnutls)
      ;; avoiding bogus warning
      (setq gnutls-min-prime-bits nil)
      (setq gnus-buttonized-mime-types
            '("multipart/encrypted" "multipart/signed" "multipart/alternative"))

      (setq mm-verify-option 'always)
      (setq mm-decrypt-option 'always)

      (setq mm-sign-option 'guided)
      (setq mm-encrypt-option 'guided)

      (setq mml-secure-passphrase-cache-expiry (* 3600 24)
            password-cache-expiry (* 3600 24))

      (setq smime-CA-directory "/etc/ssl/certs/"
            smime-certificate-directory"/home/jao/.emacs.d/gnus/Mail/certs/")

      ;; Tells Gnus to inline the part
      (eval-after-load "mm-decode"
        '(add-to-list 'mm-inlined-types "application/pgp$"))
      ;; Tells Gnus how to display the part when it is requested
      (eval-after-load "mm-decode"
        '(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.
      (eval-after-load "mm-decode"
        '(add-to-list 'mm-automatic-display "application/pgp$"))
      ;; But don't display the signatures, please.
      (eval-after-load "mm-decode"
        (quote (setq mm-automatic-display (remove "application/pgp-signature"
                                                  mm-automatic-display))))

      ;; decide whether to encrypt or just sign outgoing messages
      (defvar jao-message-try-sign nil)
      (defun jao-message-maybe-sign ()
        (when (and jao-message-try-sign (y-or-n-p "Sign message? "))
          (if (y-or-n-p "Encrypt message? ")
              (let ((recipient (message-fetch-field "To")))
                (if (or (pgg-lookup-key recipient)
                        (and (y-or-n-p (format "Fetch %s's key? " recipient))
                             (pgg-fetch-key pgg-default-keyserver-address
                                            recipient)))
                    (mml-secure-message-encrypt-pgp)
                  (mml-secure-message-sign-pgp)))
            (mml-secure-message-sign-pgp))))

      ;; for ma gnus
      (eval-after-load "rfc2047"
        '(add-to-list 'rfc2047-header-encoding-alist
                      '("User-Agent" . address-mime)))

      ;; (define-key message-mode-map [f7] 'mml-secure-message-sign-pgp)
      (define-key message-mode-map [f8] 'mml-secure-message-encrypt-pgp)
    #+END_SRC
*** Attach image to message
    Use ~C-c C-p~ in message-mode.
*** Check attachment
    #+BEGIN_SRC emacs-lisp
      (defvar jao-message-attachment-regexp "\\([Ww]e send\\|[Ii] send\\|attach\\)")
      (defun jao-message-check-attachment ()
        "Check if there is an attachment in the message if I claim it."
        (save-excursion
          (message-goto-body)
          (when (search-forward-regexp jao-message-attachment-regexp nil t nil)
            (message-goto-body)
            (unless (or (search-forward "<#part" nil t nil)
                        (message-y-or-n-p
                         "No attachment. Send the message? " nil nil))
              (error "No message sent")))))
    #+END_SRC
*** Check Gcc
    #+BEGIN_SRC emacs-lisp
      (defun jao-message-check-gcc ()
        "Ask whether to keep a copy of message."
        (save-excursion
          (save-restriction
            (message-narrow-to-headers)
            (when (and (message-fetch-field "Gcc")
                       (not (y-or-n-p "Archive? ")))
              (message-remove-header "Gcc")))))

      (defun jao-message-toggle-gcc ()
        "Insert or remove the \"Gcc\" header."
        (interactive)
        (save-excursion
          (save-restriction
            (message-narrow-to-headers)
            (if (message-fetch-field "Gcc")
                (message-remove-header "Gcc")
              (gnus-inews-insert-gcc)))))

      ;; (define-key message-mode-map [(f6)] 'jao-message-toggle-gcc)
    #+END_SRC
*** Check recipient
    #+begin_src emacs-lisp
      (defun jao-message-check-recipient ()
        (save-excursion
          (save-restriction
            (message-narrow-to-headers)
            (when-let ((to (message-fetch-field "To")))
              (when (string-match-p jao-mails-regexp to)
                (unless (y-or-n-p "Message is addressed to yourself.  Continue?")
                  (error "Message not sent")))))))
    #+end_src
*** Randomsig
    #+BEGIN_SRC emacs-lisp
      (when (require 'randomsig nil t)
        (define-key message-mode-map (kbd "C-c s") 'randomsig-replace-sig)
        (define-key message-mode-map (kbd "C-c S") 'randomsig-select-sig)
        (eval-after-load "gnus-sum"
          '(define-key gnus-summary-save-map "-" 'gnus/randomsig-summary-read-sig))
        (setq randomsig-dir (expand-file-name "~/etc/config/emacs"))
        (setq randomsig-files '("signatures.txt"))
        ;; or (setq randomsig-files (randomsig-search-sigfiles))
        ;; or (setq randomsig-files 'randomsig-search-sigfiles)
        (setq message-signature 'randomsig-signature)
        (setq randomsig-delimiter-pattern "^%$"
              randomsig-delimiter "%"))
    #+END_SRC
*** Send mail hooks
    #+BEGIN_SRC emacs-lisp
      (dolist (h '(jao-message-check-gcc
                   jao-message-check-attachment
                   jao-message-check-recipient
                   jao-message-maybe-sign))
        (add-hook 'message-send-hook h))
    #+END_SRC
* sendmail/smtp
  #+BEGIN_SRC emacs-lisp
    (require 'smtpmail)

    (defun jao-sendmail-gmail ()
      (setq smtpmail-auth-supported '(login cram-md5 plain))
      (setq smtpmail-smtp-server "smtp.gmail.com")
      (setq smtpmail-smtp-service 587))

    (defun jao-sendmail-local ()
      (setq smtpmail-auth-supported nil) ;; (cram-md5 plain login)
      (setq smtpmail-smtp-server "127.0.0.1")
      (setq smtpmail-smtp-service 25))

    ;; (jao-sendmail-gmail)
    (jao-sendmail-local)
  #+END_SRC
* notmuch
*** hello page
    #+begin_src emacs-lisp
      (defun jao-notmuch--mboxes-search (box)
        (mapcar (lambda (m)
                  `(:name ,(format "%s:%s" box m)
                          :search-type tree
                          :query ,(format "folder:%s/%s and tag:unread" box m)))
                (jao-list-mailboxes box)))

      (defun jao--refresh-agenda () (save-window-excursion (org-agenda-list)))

      (with-eval-after-load "notmuch-hello"
        (add-hook 'notmuch-hello-refresh-hook #'jao--refresh-agenda))

      (setq notmuch-saved-searches
            `((:name "jao" :key "j"
                     :query "folder:jao/inbox"
                     :search-type tree
                     :count-query "folder:jao/inbox and tag:unread")
              (:name "bigml" :key "b"
               :count-query "folder:bigml/inbox and tag:unread"
               :search-type tree
               :query "folder:bigml/inbox")
              (:name "today" :key "t" :search-type tree
                     :query "tag:/support|inbox|bugs|bills|hacking/ and date:1d..")
              ,@(jao-notmuch--mboxes-search "bigml")
              ,@(jao-notmuch--mboxes-search "jao")
              ,@(jao-notmuch--mboxes-search "feeds")
              (:name "feeds" :query "tag:new and tag:feeds and not tag:emacs"
               :key "f" :search-type tree)
              (:name "new" :query "tag:new" :key "n" :search-type tree))
            notmuch-hello-sections '(notmuch-hello-insert-saved-searches
                                     notmuch-hello-insert-alltags
                                     notmuch-hello-insert-recent-searches
                                     notmuch-hello-insert-header)
            notmuch-hello-thousands-separator ","
            notmuch-hello-recent-searches-max 5
            notmuch-show-all-tags-list t
            notmuch-show-logo nil
            notmuch-show-empty-saved-searches nil)
    #+end_src
*** extended commands
    #+begin_src emacs-lisp
      (defvar-local jao-notmuch--tree-buffer nil)

      (defun jao-notmuch-goto-message-buffer ()
        (interactive)
        (when (window-live-p notmuch-tree-message-window)
          (let ((b (current-buffer)))
            (select-window notmuch-tree-message-window)
            (setq-local jao-notmuch--tree-buffer b))))

      (defun jao-notmuch-goto-index-buffer ()
        (interactive)
        (if (buffer-live-p jao-notmuch--tree-buffer)
            (pop-to-buffer jao-notmuch--tree-buffer)
          (user-error "No index for this buffer")))

      (defun jao-notmuch-jump ()
        (interactive)
        (let ((resize-mini-windows t)) (notmuch-jump-search)))

      (defun jao-notmuch-tag-jump (reverse)
        (interactive "P")
        (let ((resize-mini-windows t)) (notmuch-tag-jump reverse)))

      (defun jao-notmuch-tree-tag (&optional new)
        (interactive "P")
        (when-let (tag (notmuch-select-tag-with-completion "Forest of tag: "))
          (notmuch-tree (concat "tag:" tag) (when new "tag:/unread|new/"))))

      (defun jao-notmuch-browse-urls ()
        (interactive)
        (when (or (derived-mode-p 'notmuch-show-mode)
                  (jao-notmuch-goto-message-buffer))
          (notmuch-show-browse-urls)))
    #+end_src
*** package
    #+begin_src emacs-lisp
      (use-package notmuch
        :ensure t
        :init
        (setq notmuch-fcc-dirs
              '(("jao@bigml.com" . "bigml/sent") (".*" . "jao/sent"))
              notmuch-message-headers-visible t
              jao-notmuch-message-headers '("Subject" "To" "Cc" "Date" "List-Id"
                                            "Reply-To"
                                            "X-Mailer" "User-Agent" "X-User-Agent")
              notmuch-message-headers jao-notmuch-message-headers
              notmuch-show-mark-read-tags '("-new" "-unread")
              notmuch-archive-tags '("+archive" "-new" "-unread")
              notmuch-tagging-keys
              '(("a" notmuch-archive-tags "Archive")
                ("u" notmuch-show-mark-read-tags "Mark read")
                ("f" ("+flagged") "Flag")
                ("s" ("+spam" "-new") "Mark as spam")
                ("d" ("+deleted" "-new" "-unread") "Delete"))
              notmuch-show-all-multipart/alternative-parts nil
              notmuch-show-indent-messages-width 2
              notmuch-show-part-button-default-action 'notmuch-show-view-part
              notmuch-tree-result-format
              '(("date" . "%12s  ")
                ("authors" . "%-35s")
                ((("subject" . "%.95s")) . "  %-95s")
                ("tags" . "  (%s)"))
              notmuch-search-result-format
              '(("date" . "%12s ")
                ("count" . "%-7s ")
                ("authors" . "%-35s")
                ("subject" . "%-95s")
                ("tags" . "(%s)"))
              notmuch-show-only-matching-messages t
              notmuch-unthreaded-result-format notmuch-tree-result-format
              notmuch-wash-wrap-lines-length 80
              notmuch-wash-citation-lines-prefix 10
              notmuch-wash-citation-lines-suffix 20)
        :config
        (setq mm-text-html-renderer 'shr)

        (defun jao-mail-clean-address (fun address)
          (let ((address (if (string-match ".+ updates on arXiv.org: \\(.+\\)"
                                           address)
                             (with-temp-buffer
                               (insert (match-string 1 address))
                               (let ((shr-width 1000))
                                 (shr-render-region (point-min) (point-max)))
                               (buffer-string))
                           address)))
            (funcall fun address)))

        (advice-add 'notmuch-clean-address :around #'jao-mail-clean-address)

        :bind (:map
               notmuch-common-keymap (("T" . jao-notmuch-tree-tag)
                                      ("B" . jao-notmuch-browse-urls))
               :map notmuch-show-mode-map
               (("h" . jao-notmuch-goto-index-buffer)
                ("k" . jao-notmuch-tag-jump)
                ("C-c C-c" . jao-notmuch-goto-message-in-gnus))
               :map notmuch-hello-mode-map
               (("j" . jao-notmuch-jump)
                ("S" . consult-notmuch))
               :map notmuch-tree-mode-map
               (("h" . jao-notmuch-goto-message-buffer)
                ("k" . jao-notmuch-tag-jump))))
    #+end_src
*** tag shell script
    #+begin_src bash :tangle ./bin/notmuch-tags.sh :tangle-mode (identity #o755)
      notmuch new > $HOME/var/log/notmuch.log 2>&1

      function tag_deleted {
        notmuch tag -inbox +deleted -- folder:$1 AND date:..3d AND NOT tag:flagged
      }

      for f in drivel lists reports deploys; do
        notmuch tag +bigml +$f -- tag:new AND folder:bigml/$f
        tag_deleted bigm/$f
      done;

      for f in inbox support; do
        notmuch tag +bigml +$f -- tag:new AND folder:bigml/$f
      done;

      for f in ~/var/mail/feeds/*; do
        f=$(basename $f)
        notmuch tag +feeds +$f -- tag:new AND folder:feeds/$f
      done
      tag_deleted "/feeds.+/"

      notmuch tag +jao -- tag:new AND folder:/jao.+/

      for f in drivel lists books think; do
        notmuch tag +$f -- tag:new AND folder:jao/$f
        tag_deleted jao/$f
      done

      notmuch search --output=files --format=text0 tag:deleted | xargs -r0 rm

      notmuch new >> $HOME/var/log/notmuch.log 2>&1
      notmuch compact >> $HOME/var/log/notmuch.log 2>&1
    #+end_src
*** expire shell script
    #+begin_src bash :tangle ./bin/notmuch-expire.sh :tangle-mode (identity #o755)
      notmuch search --output=files --format=text0 tag:deleted | xargs -r0 rm
      notmuch new > $HOME/var/log/notmuch-expire.log 2>&1
    #+end_src
* gnus
*** notmuch -> gnus
    #+begin_src emacs-lisp
      (defun jao-notmuch-goto-message-in-gnus ()
        "Open a summary buffer containing the current notmuch article."
        (interactive)
        (let ((group (jao-maildir-file-to-group (notmuch-show-get-filename)))
              (message-id (replace-regexp-in-string "^id:"
                                                    ""
                                                    (notmuch-show-get-message-id))))
          (if (and group message-id)
              (org-gnus-follow-link group message-id)
            (message "Couldn't get relevant infos for switching to Gnus."))))
  #+end_src
*** gnus.el tangling
    The core of Gnus's configuration is tangled to the usual ~gnus.el~
    from [[./gnus.org][gnus.org]].
    #+begin_src emacs-lisp
      (defalias 'jao-open-gnus-frame 'jao-afio--goto-mail)
      (setq gnus-init-file (jao-maybe-tangle "gnus"))
  #+end_src
*** Directories
    #+begin_src emacs-lisp
      (setq gnus-home-directory "~/.emacs.d/gnus"
            gnus-directory gnus-home-directory)

      (defun jao-gnus-dir (dir)
        (expand-file-name dir gnus-home-directory))

      (setq smtpmail-queue-dir (jao-gnus-dir "Mail/queued-mail/"))

      (setq mail-source-directory (jao-gnus-dir "Mail/")
            message-auto-save-directory (jao-gnus-dir "Mail/drafts/")
            message-directory (jao-gnus-dir "Mail/"))

      (setq gnus-default-directory (expand-file-name "~")
            gnus-startup-file (jao-gnus-dir "newsrc")
            gnus-agent-directory (jao-gnus-dir "News/agent")
            gnus-home-score-file (jao-gnus-dir "scores")
            gnus-article-save-directory (jao-gnus-dir "saved/")
            nntp-authinfo-file (jao-gnus-dir "authinfo")
            nnmail-message-id-cache-file (jao-gnus-dir "nnmail-cache")
            nndraft-directory (jao-gnus-dir "drafts")
            nnrss-directory (jao-gnus-dir "rss"))
    #+end_src
* mailcap
  #+BEGIN_SRC emacs-lisp
    (require 'mailcap)

    (add-to-list 'mailcap-mime-extensions '(".JPEG" . "image/jpeg"))
    (add-to-list 'mailcap-mime-extensions '(".JPG" . "image/jpeg"))

    (let* ((apps (cdr (assoc "application" mailcap-mime-data)))
           (apps (cl-remove-if (lambda (x) (string= (car x) "pdf")) apps)))
      (setcdr (assoc "application" mailcap-mime-data) apps)
      (mailcap-parse-mailcaps nil t))
  #+END_SRC
* frm
  #+begin_src emacs-lisp
    (use-package jao-frm
      :init (setq jao-frm-mail-command 'jao-open-gnus-frame))

    (defun jao-frm--formatter (mbox n)
      (apply #'format "%s/%s: %s" `(,@(last (split-string mbox "/") 2) ,n)))

    (defun jao-frm--show ()
      (interactive)
      (jao-frm-show-mail-numbers #'jao-frm--formatter))

    (global-set-key [(f12)] 'jao-frm--show)
    (global-set-key [(f8)] 'jao-frm)

  #+end_src
* maildirs
  #+begin_src emacs-lisp
    (defun jao-list-mailboxes (base)
      (let ((dir (expand-file-name base "~/var/mail")))
        (cl-remove-if (lambda (x)
                        (member x '("." ".." "sent" "inbox" "trash")))
                      (directory-files dir))))

    (defvar jao-maildir-maildirs nil)
    (defvar jao-maildir-tracked-maildirs nil)
    (use-package jao-maildir
      :config
      (defun jao-maildir--ensure-counts ()
        (when gnus-newsgroup-name
          (when (string-match "^nnimap.*:\\(.+\\)" gnus-newsgroup-name)
            (let ((mbox (format "/home/jao/var/mail/%s"
                                (match-string 1 gnus-newsgroup-name))))
              (jao-maildir-update-info-string mbox)))))
      (with-eval-after-load "gnus-sum"
        (add-hook 'gnus-exit-group-hook #'jao-maildir--ensure-counts)))

    (jao-maildir-setup jao-maildir-maildirs jao-maildir-tracked-maildirs -20)
  #+end_src
* bbdb
  #+begin_src emacs-lisp
    (use-package bbdb
      :ensure t
      :init (setq bbdb-complete-name-allow-cycling t
                  bbdb-completion-display-record nil
                  bbdb-gui t
                  bbdb-message-all-addresses t
                  bbdb-complete-mail-allow-cycling t
                  bbdb-north-american-phone-numbers-p nil
                  bbdb-add-aka t
                  bbdb-add-name 2
                  bbdb-message-all-addresses t
                  bbdb-mua-pop-up t ;; 'horiz
                  bbdb-mua-pop-up-window-size 0.3
                  bbdb-layout 'multi-line
                  bbdb-mua-update-interactive-p '(query . create)
                  bbdb-mua-auto-update-p 'bbdb-select-message
                  bbdb-user-mail-address-re jao-mails-regexp
                  bbdb-auto-notes-ignore-headers
                  `(("From" . ,jao-mails-regexp)
                    ("From" . ".*@.*github\.com.*")
                    ("To" . ".*@.*github\.com.*")
                    ("Reply-to" . ".*")
                    ("References" . ".*"))
                  bbdb-auto-notes-ignore-messages
                  `(("To" . ".*@.*github\\.com.*")
                    ("From" . ".*@.*github\\.com.*")
                    ("From" . "info-list")
                    ("From" . "no-?reply\\|deploy")
                    ("X-Mailer" . "MailChimp"))
                  bbdb-accept-message-alist
                  `(("To" . ,jao-mails-regexp)
                    ("Cc" . ,jao-mails-regexp)
                    ("BCc" . ,jao-mails-regexp))
                  bbdb-ignore-message-alist bbdb-auto-notes-ignore-messages)
      :config
      (add-hook 'message-setup-hook 'bbdb-mail-aliases)
      ;; (add-hook 'bbdb-notice-mail-hook 'bbdb-auto-notes)
      (add-hook 'bbdb-after-change-hook (lambda (arg) (bbdb-save)))
      (require 'bbdb-anniv) ;; BBDB 3.x this gets birthdays in org agenda
                            ;; and diary - clever stuff
      (add-hook 'diary-list-entries-hook 'bbdb-anniv-diary-entries)
      (eval-after-load "gnus-sum"
        '(progn
           (define-key gnus-summary-mode-map ":" 'bbdb-mua-annotate-sender)
           (define-key gnus-summary-mode-map ";" 'bbdb-mua-annotate-recipients))))

    (require 'bbdb)
    (bbdb-initialize 'gnus 'message 'pgp 'mail)
    (bbdb-mua-auto-update-init 'gnus)
    (setq bbdb-file (expand-file-name "bbdb" gnus-home-directory))
   #+end_src