#+property: header-args:emacs-lisp :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t; -*-" :tangle-mode (identity #o644)
#+title: email handling (message mode, bbdb, gnus, notmuch)

* personal emails and others
  #+begin_src emacs-lisp
    (defvar jao-mails)
    (defvar jao-extra-mails)
    (defvar jao-mails-regexp (regexp-opt jao-mails))
    (defvar jao-notmuch-enabled (eq jao-afio-mail-function 'notmuch))
  #+end_src
* gnus
  #+begin_src emacs-lisp
    (setq gnus-init-file "~/.emacs.d/gnus.el"
          gnus-home-directory "~/.emacs.d/gnus"
          gnus-directory gnus-home-directory
          gnus-cache-directory (expand-file-name "cache" gnus-home-directory)
          gnus-kill-files-directory (expand-file-name "News" gnus-home-directory)
          message-directory (expand-file-name "Mail" gnus-home-directory)
          mail-source-directory (expand-file-name "Mail" gnus-home-directory))

    (let ((org-file (expand-file-name "gnus.org" jao-emacs-dir)))
      (when (file-newer-than-file-p org-file gnus-init-file)
        (org-babel-tangle-file org-file)))

  #+end_src
* message mode
*** Customization
    #+begin_src emacs-lisp
      (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
            (regexp-opt (append jao-mails jao-extra-mails)))
      (setq message-dont-reply-to-names
            (regexp-opt (append jao-mails '("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: <https://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
*** Adjust Bcc
    #+begin_src emacs-lisp
      (defvar jao-message--bcc-rx (regexp-opt '("mail.io" "gnu.org")))

      (defun jao-message-insert-bcc ()
        (let ((f (or (message-fetch-field "From") "")))
          (when (or (string-blank-p f) (string-match-p jao-message--bcc-rx f))
            (insert "Bcc: proton@jao.io\n"))))

      (add-hook 'message-header-setup-hook #'jao-message-insert-bcc)
    #+end_src
*** To->From and Bcc
    #+begin_src emacs-lisp
      (defvar jao-message-to-from nil)

      (defun jao-message-adjust-from ()
        (let ((to (concat (message-fetch-field "To") (message-fetch-field "Cc"))))
          (when-let* ((tf (seq-find (lambda (tf) (string-match-p (car tf) to))
                                    jao-message-to-from))
                      (from (message-make-from "Jose A Ortega Ruiz" (cdr tf))))
            (save-restriction
              (widen)
              (message-replace-header "From" from)))))

      (when jao-notmuch-enabled
        (add-hook 'message-header-setup-hook #'jao-message-adjust-from))
    #+end_src
*** Clean up reply addresses
    #+begin_src emacs-lisp
      (defun jao-message--dont-reply (mail)
        (unless (string-match-p message-dont-reply-to-names mail) mail))

      (defun jao-message-strip-replies ()
        (dolist (header '("To" "Cc"))
          (when-let ((v (message-fetch-field header)))
            (let* ((v (message-tokenize-header v))
                   (vs (delq nil (mapcar #'jao-message--dont-reply v)))
                   (v (when vs (mapconcat #'string-trim vs ", "))))
              (message-replace-header header v)))))

      (when jao-notmuch-enabled
        (add-hook 'message-setup-hook #'jao-message-strip-replies))

    #+end_src
*** Encryption
    #+begin_src emacs-lisp
      ;; 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
            (expand-file-name "certs/" gnus-directory))

      (with-eval-after-load "mm-decode"
        ;; 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$")
        ;; But don't display the signatures, please.
        (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)))
    #+end_src
*** Attach image to message
    Use ~C-c C-p~ in message-mode, and ~C-c y~.
*** 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 Fcc/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 (or (message-fetch-field "Gcc")
                           (message-fetch-field "Fcc"))
                       (not (y-or-n-p "Archive? ")))
              (message-remove-header "\\(?:[BFG]cc\\)")))))
    #+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
      (with-eval-after-load "message"
        (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)
          (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-recipient
                   jao-message-maybe-sign))
        (add-hook 'message-send-hook h))
      (unless jao-notmuch-enabled
        (add-hook 'message-send-hook #'jao-message-check-attachment))
    #+end_src
*** Keybindings
    #+begin_src emacs-lisp
      (with-eval-after-load "message"
        ;; (define-key message-mode-map [f7] 'mml-secure-message-sign-pgp)
        (define-key message-mode-map [f8] 'mml-secure-message-encrypt-pgp)
        (define-key message-mode-map (kbd "C-c y") #'yank-media))
    #+end_src
* sendmail/smtp
  #+begin_src emacs-lisp
    (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 send-mail-function 'sendmail-send-it)
      (setq smtpmail-auth-supported nil) ;; (cram-md5 plain login)
      (setq smtpmail-smtp-server "127.0.0.1")
      (setq smtpmail-smtp-service 25))

    (defun jao-sendmail-msmtp ()
      (setq send-mail-function 'sendmail-send-it
            sendmail-program "/usr/bin/msmtp"
            mail-specify-envelope-from t
            message-sendmail-envelope-from 'header
            mail-envelope-from 'header))

    (jao-sendmail-local)
  #+end_src
* mailcap
  #+begin_src emacs-lisp
    (use-package mailcap
      :config
      (add-to-list 'mailcap-mime-extensions '(".JPEG" . "image/jpeg"))
      (add-to-list 'mailcap-mime-extensions '(".JPG" . "image/jpeg"))

      (defun jao-icalendar-import-buffer ()
        (let ((icalendar-import-format "%s%u%l%d"))
          (icalendar-import-buffer diary-file t nil))
        (kill-buffer)
        (message "Event imported into diary"))

      :custom
      ((mailcap-user-mime-data
        '((jao-icalendar-import-buffer "application/ics")
          ("viewpdf.sh %s" "application/pdf")))))
  #+end_src
* multipart html renderer
  #+begin_src emacs-lisp
    (defun jao-w3m-html-renderer (handle)
      (let ((w3m-message-silent t)
            (mm-w3m-safe-url-regexp nil))
        (condition-case nil
            (mm-inline-text-html-render-with-w3m handle)
          (error (delete-region (point) (point-max))
                 (let ((shr-use-fonts nil)
                       (shr-use-colors nil))
                   (mm-shr handle))))))

    (defun jao-shr-html-renderer (handle)
      (let (;; (shr-use-fonts t)
            ;; (shr-use-colors t)
            (shr-width 130))
        (mm-shr handle)))

    ;; (setq mm-text-html-renderer #'jao-w3m-html-renderer)
    (setq mm-text-html-renderer #'jao-shr-html-renderer)
  #+end_src
* bbdb
  #+begin_src emacs-lisp :tangle no
    (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)

      (setq bbdb-file (expand-file-name "~/.emacs.d/bbdb"))
      (if jao-notmuch-enabled
          (bbdb-initialize 'message 'pgp)
        (bbdb-initialize 'message 'pgp 'gnus)))
   #+end_src
* mailboxes
  #+begin_src emacs-lisp
    (defun jao-list-mailboxes (base &rest excl)
      (let ((dir (expand-file-name base "~/var/mail")))
        (seq-difference (directory-files dir) (append '("." "..") excl))))


  #+end_src
* consult narrowing
  #+begin_src emacs-lisp
    (defvar jao-mail-consult-buffer-history nil)

    (defun jao-mail-buffer-p (b)
      (or (member (buffer-name b)
                  '("*Calendar*" "inbox.org" "*Org Agenda*"
                    "*Fancy Diary Entries*" "diary"))
          (with-current-buffer b
            (derived-mode-p 'notmuch-show-mode
		            'notmuch-search-mode
		            'notmuch-tree-mode
		            'notmuch-hello-mode
		            'notmuch-message-mode
                            'gnus-group-mode
                            'gnus-summary-mode
                            'gnus-article-mode))))

    (defvar jao-mail-consult-source
      (list :name "mail buffer"
            :category 'buffer
            :hidden t
            :narrow (cons ?n "mail buffer")
            :history 'jao-mail-consult-buffer-history
            :action (lambda (b)
                      (when (not (string-blank-p (or b "")))
                        (jao-afio--goto-mail)
                        (if (get-buffer-window b)
                            (pop-to-buffer b)
                          (pop-to-buffer-same-window b))))
            :items (lambda ()
                     (mapcar #'buffer-name
                             (seq-filter #'jao-mail-buffer-p (buffer-list))))))

    (jao-consult-add-buffer-source 'jao-mail-consult-source "Mail" ?n)
  #+end_src
* notmuch
  #+begin_src emacs-lisp
    (jao-load-org "notmuch")
  #+end_src