path: root/custom/jao-custom-email.el

;; -*- lexical-binding: t; -*-

;;; main email system
(require 'jao-afio)
;; (setq jao-afio-mail-function 'gnus)
(setq jao-afio-mail-function 'notmuch)

(defvar jao-notmuch-enabled (eq jao-afio-mail-function 'notmuch))

;;; personal emails and others
(defvar jao-mails)
(defvar jao-extra-mails)
(defvar jao-mails-regexp (regexp-opt jao-mails))

;;; gnus
(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)))

;;; proton
(use-package jao-proton-utils)

;;; message mode
;;;; customization
(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 "mail.jao.io")

(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)

;;;; adjust bcc
(defvar jao-message--bcc-alist
  `((,(regexp-quote "mail@jao.io") . "proton@jao.io")
    (,(regexp-quote "jao@gnu.org") . "hacking@jao.io")))

(defun jao-message-insert-bcc ()
  (when jao-notmuch-enabled
    (let ((f (or (message-fetch-field "From") "")))
      (when-let (b (seq-some (lambda (x) (when (string-match-p (car x) f) (cdr x)))
                             jao-message--bcc-alist))
        (insert "Bcc: " b "\n")))))

;; (when jao-notmuch-enabled
;;   (add-hook 'message-header-setup-hook #'jao-message-insert-bcc))

;;;; to->from
(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))

;;;; encryption
(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)))

;;;; check attachment
(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")))))

;;;; check fcc/gcc
(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\\)")))))

;;;; check recipient
(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")))))))

;;;; randomsig
(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 "%")))

;;;; send mail hooks
(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))

;;;; keybindings
(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))

;;; sendmail/smtp
(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-servers-requiring-authorization nil)
  (setq smtpmail-smtp-user nil)
  (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)

;;; bbdb
;; (jao-load-path "bbdb/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
  (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 'notmuch)
    (bbdb-initialize 'message 'pgp 'gnus)))

;; (load "bbdb-loaddefs")

;;; narrowing
(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
                        'message-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)

(require 'jao-custom-notmuch)

;;; .
(provide 'jao-custom-email)