emacs/mail.el

   1 ;;                                -*- mode: emacs-lisp; lexical-binding: t -*-
   2 ;; mail.el  -- Mail configuration file
   3 ;; Copyright 2006-2020 by Michal Nazarewicz (mina86@mina86.com)
   4 ;;
   5
   6 (eval-when-compile (setq load-path (cons user-emacs-directory load-path)))
   7 (require 'init)
   8 (require 'message)
   9
  10 ;;{{{ Identify
  11
  12 (defconst corp-mail-address (eval-when-compile (rot13-string "zca@pbzcbfnoyr.svanapr")))
  13
  14 (setq user-full-name "Michal Nazarewicz"
  15       user-mail-address (eval-when-compile (rot13-string "zvan86@zvan86.pbz"))
  16       message-user-fqdn "mina86.com"
  17
  18       message-alternative-emails (regexp-opt (list user-mail-address
  19                                                    corp-mail-address
  20                                                    (rot13-string "zanmnerjvpm@tznvy.pbz")
  21                                                    (rot13-string "zvpuny@arne.bet"))
  22                                              nil)
  23       message-dont-reply-to-names message-alternative-emails
  24
  25       message-subject-trailing-was-query t
  26       message-subject-trailing-was-regexp
  27       "[ \t]*\\((*[Ww][Aa][Ss]:.*)\\|\\[*[Ww][Aa][Ss]:.*\\]\\)"
  28       message-subject-re-regexp
  29       (eval-when-compile (concat "^[ \t]*\\("
  30                                    "\\(" "[Ff][Ww][Dd]?"
  31                                    "\\|" "[Oo][Dd][Pp]"
  32                                    "\\|" "[Rr][Ee]"
  33                                    "\\)"
  34                                    "\\(\\[[0-9]*\\]\\)*:[ \t]*"
  35                                    "\\)*[ \t]*"))
  36
  37       message-kill-buffer-on-exit t
  38       message-citation-line-function 'message-insert-formatted-citation-line
  39       message-citation-line-format   "On %a, %b %d %Y, %N wrote:"
  40       send-mail-function    'message-smtpmail-send-it)
  41
  42 (setq-default smtpmail-smtp-server  "smtp.gmail.com"
  43               smtpmail-smtp-service 587)
  44
  45 ;; Get domain from the From address when generating Message-IDs
  46 (defun mn-message-make-fqdn ()
  47   (if-let* ((addr (message-fetch-field "from"))
  48             (addr (cadr (mail-extract-address-components addr))))
  49       (and (string-match "@\\(.*\\)\\'" addr)
  50            (match-string 1 addr))))
  51 (advice-add #'message-make-fqdn :before-until #'mn-message-make-fqdn)
  52
  53 ;; Use random left part of the Message-ID
  54 (defun mn-message-unique-id ()
  55   (random t)
  56   (let ((chars "0123456789abcdefghijklmnopqrstuvwxyz+") str)
  57     (while (< (length str) 24)
  58       (setq str (cons (aref chars (random (length chars))) str)))
  59     (apply #'string str)))
  60 (advice-add #'message-unique-id :before-until #'mn-message-unique-id)
  61
  62
  63 ;; Since 27.1 message-from-style is obsolete; suppress warning.
  64 (with-no-warnings (setq message-from-style 'angels))
  65
  66 (defun message-narrow-to-body ()
  67   (widen)
  68   (goto-char (point-min))
  69   (re-search-forward
  70    (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
  71   (narrow-to-region
  72    (point)
  73    (if (re-search-forward message-signature-separator)
  74        (match-beginning 0) (point-max))))
  75
  76 (defun mn-ack-patch ()
  77   (interactive)
  78   (save-restriction
  79     (message-narrow-to-body)
  80     (let ((case-fold-search t)
  81           (prefix (concat "^" message-cite-prefix-regexp "[[:blank:]]*"))
  82           (p (point)))
  83       (goto-char (point-min))
  84       (beginning-of-line
  85        (cond
  86         ;; Insert Acked-by just below ‘> Cc: User’ if found.
  87         ((re-search-forward (concat prefix "Cc:[[:blank:]]*"
  88                                     (regexp-quote user-full-name))
  89                             nil t) 2)
  90         ;; Insert Acked-by above --- line separating message from diff.
  91         ((re-search-forward (concat prefix "---$") nil t) 1)
  92         ;; Insert Acked-by below diff stats line.
  93         ((re-search-forward (concat prefix "[0-9]+ files? changed") nil t) 2)
  94         ;; Lastly, try ‘diff <file-name>’ line in front of first hunk.
  95         ((re-search-forward (concat prefix "diff ") nil t) 1)
  96         ;; If even that fails, insert where we are (were).
  97         ((goto-char p) 2))))
  98     (insert "\nAcked-by: " user-full-name " <" user-mail-address ">\n\n")))
  99
 100 (set-key message-mode-map "\C-ca" mn-ack-patch)
 101
 102 (defun mn-load-face (face-png)
 103   "Returns Face header encoding specified face image or nil on error."
 104   (if (not (file-exists-p face-png))
 105       (message "%s.png missing; no Face header will be used" face-png)
 106     (with-temp-buffer
 107       (insert-file-contents face-png)
 108       (if (> (base64-encode-region (point-min) (point-max) t) 967)
 109           (message "%s > 966 chars after encoding; no Face header will be used"
 110                    face-png)
 111         (cons "Face" (buffer-string))))))
 112
 113 (require 'gnus-alias)
 114 (let ((signature (expand-file-name "~/.mail/signature.txt"))
 115       (headers (if-let ((face-png (expand-file-name "~/.mail/face.png"))
 116                         (face-hdr (mn-load-face face-png)))
 117                    (cons face-hdr nil)))
 118       (user-from (concat user-full-name " <" user-mail-address ">"))
 119       (corp-from (concat user-full-name " <" corp-mail-address ">")))
 120   (setq gnus-alias-identity-alist
 121         `(("priv" nil    ,user-from nil                  ,headers "\n" ,signature)
 122           ("comp" nil    ,corp-from "Composable Finance" ,headers "\n" ,signature))
 123         gnus-alias-default-identity (caar gnus-alias-identity-alist)
 124         gnus-alias-identity-rules
 125         '(("to Composable" ("to" "@composable.finance") "comp"))))
 126 (add-hook 'message-setup-hook 'gnus-alias-determine-identity)
 127
 128 ;;}}}
 129 ;;{{{ Message mode
 130
 131 (defvar mn-message-home--point 0)
 132 (defun mn-message-home ()
 133   "‘message-mode’-aware ‘my-home’.
 134
 135 When point is on a header line, the point goes to 1. beginning of
 136 the header, 2. beginning and 3. wraps to it’s original position.
 137
 138 Otherwise (when it’s in message body), the point goes
 139 to 1. beginning of line, 2. beginning of the message body
 140 and 3. wrap to it’s original position."
 141   (interactive)
 142   (seq-times-do (setq mn-message-home--point (point))
 143     ;; First time:
 144     (progn
 145       (beginning-of-line)
 146       (when (message-point-in-header-p)
 147         (re-search-forward ": *" (point-at-eol) t)))
 148     ;; Second time:
 149     (if (message-point-in-header-p)
 150         (beginning-of-line)
 151       (message-goto-body))
 152     ;; Third time:
 153     (goto-char mn-message-home--point)))
 154
 155 (define-key message-mode-map [remap message-beginning-of-line]
 156   #'mn-message-home)
 157
 158 (add-lambda-hook 'message-mode-hook (flyspell-mode 1))
 159 ;(add-hook 'message-setup-hook 'mml-secure-sign-pgpmime)
 160
 161 ;(autoload 'pgg-encrypt-region "pgg"
 162 ;  "Encrypt the current region." t)
 163 ;(autoload 'pgg-encrypt-symmetric-region "pgg"
 164 ;  "Encrypt the current region with symmetric algorithm." t)
 165 ;(autoload 'pgg-decrypt-region "pgg"
 166 ;  "Decrypt the current region." t)
 167 ;(autoload 'pgg-sign-region "pgg"
 168 ;  "Sign the current region." t)
 169 ;(autoload 'pgg-verify-region "pgg"
 170 ;  "Verify the current region." t)
 171 ;(autoload 'pgg-insert-key "pgg"
 172 ;  "Insert the ASCII armored public key." t)
 173 ;(autoload 'pgg-snarf-keys-region "pgg"
 174 ;  "Import public keys in the current region." t)
 175 ;
 176 ;(setq pgg-scheme 'gpg
 177 ;      pgg-gpg-user-id "mina86"
 178 ;      pgg-gpg-program "gpg2"
 179 ;;      pgg-gpg-use-agent nil
 180 ;;      pgg-cache-passphrase nil
 181 ;      gnus-treat-x-pgp-sig t
 182 ;      mm-verify-option 'known
 183 ;      mm-decrypt-option 'known)
 184
 185 ;;}}}
 186 ;;{{{ Notmuch
 187
 188 (require 'notmuch)
 189
 190 (setq notmuch-show-logo nil
 191
 192       notmuch-search-oldest-first nil
 193       notmuch-search-result-format
 194       '(("subject" . " %-69.69s")
 195         ("count"   . "  %7s")
 196         ("tags"    . "  (%s)\n")
 197         ("authors" . "  %-63.63s")
 198         ("date"    . "  %12s"))
 199
 200       notmuch-show-mark-read-tags nil
 201       notmuch-show-all-multipart/alternative-parts nil
 202       notmuch-show-relative-dates nil
 203       notmuch-show-insert-text/plain-hook '(notmuch-wash-tidy-citations
 204                                             notmuch-wash-elide-blank-lines
 205                                             notmuch-wash-excerpt-citations)
 206
 207       notmuch-message-replied-tags (list "+replied" "-unread")
 208       notmuch-message-headers '("Subject" "To" "Cc" "Bcc" "Date")
 209
 210       notmuch-hello-sections
 211       '(notmuch-hello-insert-saved-searches
 212         notmuch-hello-insert-search notmuch-hello-insert-recent-searches
 213         notmuch-hello-insert-alltags)
 214
 215       notmuch-saved-searches
 216       '(("to me"   . "is:unread and  is:me and -is:corp")
 217         ("comp me" . "is:unread and  is:me and  is:comp")
 218         ("comp"    . "is:unread and -is:me and  is:comp")
 219         ;; ("near me" . "is:unread and  is:me and  is:near")
 220         ;; ("near"    . "is:unread and -is:me and  is:near")
 221         ("rest"    . "is:unread and -is:me and -is:corp"))
 222
 223       notmuch-tag-formats
 224       '(("unread" (propertize tag 'face '(:foreground "red")))
 225         ("flagged" (notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))
 226       notmuch-search-line-faces
 227       '(("unread" :weight bold)))
 228
 229 (setq-default notmuch-mua-cite-function
 230               'message-cite-original-without-signature
 231               notmuch-search-oldest-first nil)
 232
 233 (add-lambda-hook 'notmuch-hello-refresh-hook
 234   (if (and (eq (point) (point-min))
 235            (search-forward "Saved searches:" nil t))
 236       (progn
 237         (forward-line)
 238         (widget-forward 1))
 239     (if (eq (widget-type (widget-at)) 'editable-field)
 240         (beginning-of-line))))
 241
 242 ;(define-key notmuch-hello-mode-map [tab] 'widget-forward)
 243
 244 (set-key notmuch-show-mode-map "h" (unless (notmuch-show-next-open-message)
 245                                      (notmuch-show-next-thread t)))
 246 (set-key notmuch-show-mode-map "H" (notmuch-show-next-message t))
 247 (set-key notmuch-show-mode-map "t" (unless (notmuch-show-previous-open-message)
 248                                      (notmuch-show-previous-thread-show)))
 249 (set-key notmuch-show-mode-map "T" (notmuch-show-previous-message))
 250
 251 (define-key notmuch-search-mode-map "h" 'notmuch-search-next-thread)
 252 (define-key notmuch-search-mode-map "t" 'notmuch-search-previous-thread)
 253
 254 (define-key notmuch-show-mode-map "\C-t" 'notmuch-show-view-raw-message)
 255 (define-key notmuch-show-mode-map "q"    'notmuch-bury-or-kill-this-buffer)
 256
 257 (define-key notmuch-show-mode-map "f" 'notmuch-show-reply)
 258 (define-key notmuch-show-mode-map "F" 'notmuch-show-reply-sender)
 259 (define-key notmuch-search-mode-map "f" 'notmuch-search-reply-to-thread)
 260 (define-key notmuch-search-mode-map "F" 'notmuch-search-reply-to-thread-sender)
 261
 262 (define-key notmuch-show-mode-map "s" 'notmuch-search)
 263 (define-key notmuch-show-mode-map "w" 'notmuch-show-save-attachments)
 264
 265 (dolist (x '(("V"    t   "+mute" "-unread")
 266              ("v"    t   "-unread")
 267              ("b"    nil "+trash" "-unread")
 268              ("u"    nil "+unread")
 269              ("\M-u" nil "-trash" "+unread")
 270              ("d"    nil "-unread")))
 271   (let ((key  (car  x))
 272         (all  (cadr x))
 273         (tags (cddr x)))
 274    (set-key notmuch-show-mode-map key
 275             (if all
 276                 (notmuch-show-tag-all tags)
 277               (notmuch-show-tag tags))
 278             (if (or all (not (notmuch-show-next-open-message)))
 279               (notmuch-show-next-thread t)))
 280    (set-key notmuch-search-mode-map key
 281             (notmuch-search-tag tags)
 282             (notmuch-search-next-thread))))
 283
 284 ;; (add-lambda-hook '(notmuch-hello-mode-hook notmuch-search-hook)
 285 ;;   (if (fboundp 'turn-off-fci-mode)
 286 ;;      (turn-off-fci-mode)))
 287
 288 (defun mn-prettify-subject (subject)
 289   (save-match-data
 290     (setq subject (if subject (string-trim subject) "(no subject)"))
 291     (let ((start 0))
 292       (while (string-match (eval-when-compile
 293                              (let ((chrs "[:cntrl:]\x7f\u2028\u2029"))
 294                                (concat "[ " chrs "]\\{2,\\}\\|[" chrs "]+")))
 295                            subject start)
 296         (setq subject (replace-match " " t t subject)
 297               start (1+ (match-beginning 0)))))
 298     (if (string-match
 299          (concat "^\\[Differential] \\[[^]]+] \\(?:\\[[-+ ]+] \\)?\\|"
 300                  "^\\[JIRA] Updates for ")
 301                       subject)
 302         (substring subject (match-end 0))
 303       subject)))
 304
 305 (defun mn-notmuch-search-insert-field-advice (orig field format-string result)
 306   (if (string-equal field "subject")
 307       (insert (propertize
 308                (format format-string
 309                        (mn-prettify-subject (plist-get result :subject)))
 310                'face 'notmuch-search-subject))
 311     (funcall orig field format-string result)))
 312
 313 (add-function :around (symbol-function #'notmuch-search-insert-field)
 314               #'mn-notmuch-search-insert-field-advice)
 315 (add-lambda-hook 'notmuch-show-hook
 316   (when header-line-format
 317     (setq header-line-format (mn-prettify-subject header-line-format))))
 318
 319 ;;}}}