From f45fdccd49992cf9232a0b66959d38e172de7fe7 Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Wed, 7 Sep 2022 05:10:40 +0100
Subject: attic reorganisation

---
 attic/org/email.org | 391 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 391 insertions(+)
 create mode 100644 attic/org/email.org

(limited to 'attic/org/email.org')

diff --git a/attic/org/email.org b/attic/org/email.org
new file mode 100644
index 0000000..e8a8a71
--- /dev/null
+++ b/attic/org/email.org
@@ -0,0 +1,391 @@
+#+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 :tangle no
+      (defun jao-message--dont-reply ()
+        (let ((x (message-dont-reply-to-names)))
+          (if (functionp x)
+              x
+            (lambda (mail) (unless (string-match-p x 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
-- 
cgit v1.2.3