doomemacs/modules/email/mu4e/autoload/email.el

;;; email/mu4e/autoload/email.el -*- lexical-binding: t; -*-

;;;###autodef
(defun set-email-account! (label letvars &optional default-p)
  "Registers an email address for mu4e. The LABEL is a string. LETVARS are a
list of cons cells (VARIABLE . VALUE) -- you may want to modify:

 + `user-full-name' (this or the global `user-full-name' is required)
 + `user-mail-address' (required in mu4e < 1.4)
 + `smtpmail-smtp-user' (required for sending mail from Emacs)

OPTIONAL:
 + `mu4e-sent-folder'
 + `mu4e-drafts-folder'
 + `mu4e-trash-folder'
 + `mu4e-refile-folder'
 + `mu4e-compose-signature'
 + `+mu4e-personal-adresses'

DEFAULT-P is a boolean. If non-nil, it marks that email account as the
default/fallback account."
  (after! mu4e
    (when (version< mu4e-mu-version "1.4")
      (when-let (address (cdr (assq 'user-mail-address letvars)))
        (add-to-list 'mu4e-user-mail-address-list address)))
    (setq mu4e-contexts
          (cl-loop for context in mu4e-contexts
                   unless (string= (mu4e-context-name context) label)
                   collect context))
    (let ((context (make-mu4e-context
                    :name label
                    :enter-func (lambda () (mu4e-message "Switched to %s" label))
                    :leave-func #'mu4e-clear-caches
                    :match-func
                    (lambda (msg)
                      (when msg
                        (string-prefix-p (format "/%s" label)
                                         (mu4e-message-field msg :maildir))))
                    :vars letvars)))
      (push context mu4e-contexts)
      (when default-p
        (setq-default mu4e-context-current context))
      context)))



(defvar +mu4e-workspace-name "*mu4e*"
  "TODO")
(defvar +mu4e--old-wconf nil)

(add-hook 'mu4e-main-mode-hook #'+mu4e-init-h)

;;;###autoload
(defun =mu4e ()
  "Start email client."
  (interactive)
  (require 'mu4e)
  (if (featurep! :ui workspaces)
      ;; delete current workspace if empty
      ;; this is useful when mu4e is in the daemon
      ;; as otherwise you can accumulate empty workspaces
      (progn
        (unless (+workspace-buffer-list)
          (+workspace-delete (+workspace-current-name)))
        (+workspace-switch +mu4e-workspace-name t))
    (setq +mu4e--old-wconf (current-window-configuration))
    (delete-other-windows)
    (switch-to-buffer (doom-fallback-buffer)))
  (mu4e~start 'mu4e~main-view)
  ;; (save-selected-window
  ;;   (prolusion-mail-show))
  )

;;;###autoload
(defun +mu4e/compose ()
  "Compose a new email."
  (interactive)
  ;; TODO Interactively select email account
  (call-interactively #'mu4e-compose-new))

;; Icons need a bit of work
;; Spacing needs to be determined and adjucted
;;;###autoload
(defun +get-string-width (str)
  "Return the width in pixels of a string in the current
window's default font. If the font is mono-spaced, this
will also be the width of all other printable characters."
  (let ((window (selected-window))
        (remapping face-remapping-alist))
    (with-temp-buffer
      (make-local-variable 'face-remapping-alist)
      (setq face-remapping-alist remapping)
      (set-window-buffer window (current-buffer))
      (insert str)
      (car (window-text-pixel-size)))))

;;;###autoload
(cl-defun +mu4e-normalised-icon (name &key set colour height v-adjust)
  "Convert :icon declaration to icon"
  (let* ((icon-set (intern (concat "all-the-icons-" (or set "faicon"))))
         (v-adjust (or v-adjust 0.02))
         (height (or height 0.8))
         (icon (if colour
                   (apply icon-set `(,name :face ,(intern (concat "all-the-icons-" colour)) :height ,height :v-adjust ,v-adjust))
                 (apply icon-set `(,name  :height ,height :v-adjust ,v-adjust))))
         (icon-width (+get-string-width icon))
         (space-width (+get-string-width " "))
         (space-factor (- 2 (/ (float icon-width) space-width))))
    (concat (propertize " " 'display `(space . (:width ,space-factor))) icon)))

;; Set up all the fancy icons
;;;###autoload
(defun +mu4e-initialise-icons ()
  (setq mu4e-use-fancy-chars t
        mu4e-headers-draft-mark      (cons "D" (+mu4e-normalised-icon "pencil"))
        mu4e-headers-flagged-mark    (cons "F" (+mu4e-normalised-icon "flag"))
        mu4e-headers-new-mark        (cons "N" (+mu4e-normalised-icon "sync" :set "material" :height 0.8 :v-adjust -0.10))
        mu4e-headers-passed-mark     (cons "P" (+mu4e-normalised-icon "arrow-right"))
        mu4e-headers-replied-mark    (cons "R" (+mu4e-normalised-icon "arrow-right"))
        mu4e-headers-seen-mark       (cons "S" "") ;(+mu4e-normalised-icon "eye" :height 0.6 :v-adjust 0.07 :colour "dsilver"))
        mu4e-headers-trashed-mark    (cons "T" (+mu4e-normalised-icon "trash"))
        mu4e-headers-attach-mark     (cons "a" (+mu4e-normalised-icon "file-text-o" :colour "silver"))
        mu4e-headers-encrypted-mark  (cons "x" (+mu4e-normalised-icon "lock"))
        mu4e-headers-signed-mark     (cons "s" (+mu4e-normalised-icon "certificate" :height 0.7 :colour "dpurple"))
        mu4e-headers-unread-mark     (cons "u" (+mu4e-normalised-icon "eye-slash" :v-adjust 0.05))))

;;;###autoload
(defun +mu4e-header-colourise (str)
  (let* ((str-sum (apply #'+ (mapcar (lambda (c) (% c 3)) str)))
         (colour (nth (% str-sum (length mu4e-header-colourised-faces))
                      mu4e-header-colourised-faces)))
    (put-text-property 0 (length str) 'face colour str)
    str))

;; Adding emails to the agenda
;; Perfect for when you see an email you want to reply to
;; later, but don't want to forget about
;;;###autoload
(defun +mu4e-msg-to-agenda (arg)
  "Refile a message and add a entry in the agenda file with a
deadline.  Default deadline is today.  With one prefix, deadline
is tomorrow.  With two prefixes, select the deadline."
  (interactive "p")
  (let ((file (car org-agenda-files))
        (sec  "^* Email")
        (msg  (mu4e-message-at-point)))
    (when msg
      ;; put the message in the agenda
      (with-current-buffer (find-file-noselect file)
        (save-excursion
          ;; find header section
          (goto-char (point-min))
          (when (re-search-forward sec nil t)
            (let (org-M-RET-may-split-line
                  (lev (org-outline-level))
                  (folded-p (invisible-p (point-at-eol))))
              ;; place the subheader
              (when folded-p (show-branches))    ; unfold if necessary
              (org-end-of-meta-data) ; skip property drawer
              (org-insert-todo-heading 1)        ; insert a todo heading
              (when (= (org-outline-level) lev)  ; demote if necessary
                (org-do-demote))
              ;; insert message and add deadline
              (insert (concat " Respond to "
                              "[[mu4e:msgid:"
                              (plist-get msg :message-id) "]["
                              (truncate-string-to-width
                               (caar (plist-get msg :from)) 25 nil nil t)
                              " - "
                              (truncate-string-to-width
                               (plist-get msg :subject) 40 nil nil t)
                              "]] "))
              (org-deadline nil
                            (cond ((= arg 1) (format-time-string "%Y-%m-%d"))
                                  ((= arg 4) "+1d")))

              (org-update-parent-todo-statistics)

              ;; refold as necessary
              (if folded-p
                  (progn
                    (org-up-heading-safe)
                    (hide-subtree))
                (hide-entry))))))
      ;; refile the message and update
      ;; (cond ((eq major-mode 'mu4e-view-mode)
      ;;        (mu4e-view-mark-for-refile))
      ;;       ((eq major-mode 'mu4e-headers-mode)
      ;;        (mu4e-headers-mark-for-refile)))
      (message "Refiled \"%s\" and added to the agenda for %s"
               (truncate-string-to-width
                (plist-get msg :subject) 40 nil nil t)
               (cond ((= arg 1) "today")
                     ((= arg 4) "tomorrow")
                     (t         "later"))))))

;;;###autoload
(defun +mu4e-set-from-address ()
  "Set the account for composing a message. If a 'To' header is present,
and correspands to an email address, this address will be selected.
Otherwise, the user is prompted for the address they wish to use. Possible
selections come from the mu database or a list of email addresses associated
with the current context."
  (unless (and mu4e-compose-parent-message
               (let ((to (cdr (car (mu4e-message-field mu4e-compose-parent-message :to))))
                     (from (cdr (car (mu4e-message-field mu4e-compose-parent-message :from)))))
                 (if (member to (mu4e-personal-addresses))
                     (setq user-mail-address to)
                   (if (member from (mu4e-personal-addresses))
                       (setq user-mail-address from)
                     nil))))
    (ivy-read "From: " (if-let ((context-addresses (alist-get '+mu4e-personal-addresses (mu4e-context-vars mu4e~context-current))))
                           context-addresses
                         (mu4e-personal-addresses))
              :action (lambda (candidate) (setq user-mail-address candidate)))))

;;;###autoload
(defun +mu4e~main-action-str-prettier (str &optional func-or-shortcut)
  "Highlight the first occurrence of [.] in STR.
If FUNC-OR-SHORTCUT is non-nil and if it is a function, call it
when STR is clicked (using RET or mouse-2); if FUNC-OR-SHORTCUT is
a string, execute the corresponding keyboard action when it is
clicked."
  :override #'mu4e~main-action-str
  (let ((newstr
         (replace-regexp-in-string
          "\\[\\(..?\\)\\]"
          (lambda(m)
            (format "%s"
                    (propertize (match-string 1 m) 'face '(mode-line-emphasis bold))))
          (replace-regexp-in-string "\t\\*" "\t⚫" str)))
        (map (make-sparse-keymap))
        (func (if (functionp func-or-shortcut)
                  func-or-shortcut
                (if (stringp func-or-shortcut)
                    (lambda()(interactive)
                      (execute-kbd-macro func-or-shortcut))))))
    (define-key map [mouse-2] func)
    (define-key map (kbd "RET") func)
    (put-text-property 0 (length newstr) 'keymap map newstr)
    (put-text-property (string-match "[A-Za-z].+$" newstr)
                       (- (length newstr) 1) 'mouse-face 'highlight newstr)
    newstr))

;;
;; Hooks

(defun +mu4e-init-h ()
  (add-hook 'kill-buffer-hook #'+mu4e-kill-mu4e-h nil t))

(defun +mu4e-kill-mu4e-h ()
  ;; (prolusion-mail-hide)
  (cond
   ((and (featurep! :ui workspaces) (+workspace-exists-p +mu4e-workspace-name))
    (+workspace/delete +mu4e-workspace-name))

   (+mu4e--old-wconf
    (set-window-configuration +mu4e--old-wconf)
    (setq +mu4e--old-wconf nil))))

;; org-msg hooks

;;;###autoload
(defun +org-msg-img-scale-css (img-uri)
  "For a given IMG-URI, use imagemagik to find its width."
  (if org-msg-currently-exporting
      (list :width
            (format "%.1fpx"
                    (/ (string-to-number
                        (shell-command-to-string
                         ;; TODO change to use 'file'
                         (format "identify -format %%w %s"
                                 (substring img-uri 7)))) ; 7=(length "file://")
                       (plist-get org-format-latex-options :scale))))
    (list :style (format "transform: scale(%.3f)"
                         (/ 1.0 (plist-get org-format-latex-options :scale))))))

;;;###autoload
(defun +org-html-latex-fragment-scaled (latex-fragment _contents info)
  "Transcode a LATEX-FRAGMENT object from Org to HTML.
CONTENTS is nil.  INFO is a plist holding contextual information.

This differs from `org-html-latex-fragment' in that it uses the LaTeX fragment
as a meaningful alt value, applies a class to indicate what sort of fragment it is
(latex-fragment-inline or latex-fragment-block), and (on Linux) scales the image to
account for the value of :scale in `org-format-latex-options'."
  (let ((latex-frag (org-element-property :value latex-fragment))
        (processing-type (plist-get info :with-latex)))
    (cond
     ((memq processing-type '(t mathjax))
      (org-html-format-latex latex-frag 'mathjax info))
     ((memq processing-type '(t html))
      (org-html-format-latex latex-frag 'html info))
     ((assq processing-type org-preview-latex-process-alist)
      (let ((formula-link
             (org-html-format-latex latex-frag processing-type info)))
        (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
          (let ((source (org-export-file-uri (match-string 1 formula-link)))
                (attributes (list :alt latex-frag
                                  :class (concat "latex-fragment-"
                                                 (if (equal "\\(" (substring latex-frag 0 2))
                                                     "inline" "block")))))
            (when (and (memq processing-type '(dvipng convert))
                       (not IS-WINDOWS) ; relies on posix path
                       (executable-find "identify"))
              (apply #'plist-put attributes (+org-msg-img-scale-css source)))
            (org-html--format-image source attributes info)))))
     (t latex-frag))))

;;;###autoload
(defun +org-html-latex-environment-scaled (latex-environment _contents info)
  "Transcode a LATEX-ENVIRONMENT element from Org to HTML.
CONTENTS is nil.  INFO is a plist holding contextual information.

This differs from `org-html-latex-environment' in that (on Linux) it
scales the image to account for the value of :scale in `org-format-latex-options'."
  (let ((processing-type (plist-get info :with-latex))
        (latex-frag (org-remove-indentation
                     (org-element-property :value latex-environment)))
        (attributes (org-export-read-attribute :attr_html latex-environment))
        (label (and (org-element-property :name latex-environment)
                    (org-export-get-reference latex-environment info)))
        (caption (and (org-html--latex-environment-numbered-p latex-environment)
                      (number-to-string
                       (org-export-get-ordinal
                        latex-environment info nil
                        (lambda (l _)
                          (and (org-html--math-environment-p l)
                               (org-html--latex-environment-numbered-p l))))))))
    (plist-put attributes :class "latex-environment")
    (cond
     ((memq processing-type '(t mathjax))
      (org-html-format-latex
       (if (org-string-nw-p label)
           (replace-regexp-in-string "\\`.*"
                                     (format "\\&\n\\\\label{%s}" label)
                                     latex-frag)
         latex-frag)
       'mathjax info))
     ((assq processing-type org-preview-latex-process-alist)
      (let ((formula-link
             (org-html-format-latex
              (org-html--unlabel-latex-environment latex-frag)
              processing-type info)))
        (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
          (let ((source (org-export-file-uri (match-string 1 formula-link))))
            (when (and (memq processing-type '(dvipng convert))
                       (not IS-WINDOWS) ; relies on posix path
                       (executable-find "identify"))
              (apply #'plist-put attributes (+org-msg-img-scale-css source)))
            (org-html--wrap-latex-environment
             (org-html--format-image source attributes info)
             info caption label)))))
     (t (org-html--wrap-latex-environment latex-frag info caption label)))))

;;
;; Cooperative locking

(defvar +mu4e-lock-file "/tmp/mu4e_lock"
  "Location of the lock file which stores the PID of the process currenty running mu4e")
(defvar +mu4e-lock-request-file "/tmp/mu4e_lock_request"
  "Location of the lock file for which creating indicated that another process wants the lock to be released")

(defvar +mu4e-lock-greedy nil
  "Whether to 'grab' the `+mu4e-lock-file' if nobody else has it, i.e. start Mu4e")
(defvar +mu4e-lock-relaxed t
  "Whether if someone else wants the lock (signaled via `+mu4e-lock-request-file'), we should stop Mu4e and let go of it")

;;;###autoload
(defun +mu4e-lock-pid-info ()
  "Get info on the PID refered to in `+mu4e-lock-file' in the form (pid . process-attributes)
 If the file or process do not exist, the lock file is deleted an nil returned."
  (when (file-exists-p +mu4e-lock-file)
    (let* ((pid (string-to-number (f-read-text +mu4e-lock-file 'utf-8)))
           (process (process-attributes pid)))
      (if process (cons pid process)
        (delete-file +mu4e-lock-file) nil))))

;;;###autoload
(defun +mu4e-lock-avalible (&optional strict)
  "If the `+mu4e-lock-file' is avalible (unset or owned by this emacs) return t.
If STRICT only accept an unset lock file."
  (not (when-let* ((lock-info (+mu4e-lock-pid-info))
                   (pid (car lock-info)))
         (when (or strict (/= (emacs-pid) pid)) t))))

;;;###autoload
(defun +mu4e-lock-file-delete-maybe ()
  "Check `+mu4e-lock-file', and delete it if this process is responsible for it."
  (when (+mu4e-lock-avalible)
    (delete-file +mu4e-lock-file)
    (file-notify-rm-watch +mu4e-lock--request-watcher)))

;;;###autoload
(defun +mu4e-lock-start (orig-fun &optional callback)
  "Check `+mu4e-lock-file', and if another process is responsible for it, abort starting.
Else, write to this process' PID to the lock file"
  (unless (+mu4e-lock-avalible)
    (shell-command (format "touch %s" +mu4e-lock-request-file))
    (message "Lock file exists, requesting that it be given up")
    (sleep-for 0.1)
    (delete-file +mu4e-lock-request-file))
  (if (not (+mu4e-lock-avalible))
      (user-error "Unfortunately another Emacs is already doing stuff with Mu4e, and you can only have one at a time")
    (f-write-text (number-to-string (emacs-pid)) 'utf-8 +mu4e-lock-file)
    (delete-file +mu4e-lock-request-file)
    (funcall orig-fun callback)
    (setq +mu4e-lock--request-watcher
          (file-notify-add-watch +mu4e-lock-request-file
                                 '(change)
                                 #'+mu4e-lock-request))))

(defvar +mu4e-lock--file-watcher nil)
(defvar +mu4e-lock--file-just-deleted nil)
(defvar +mu4e-lock--request-watcher nil)

;;;###autoload
(defun +mu4e-lock-add-watcher ()
  (setq +mu4e-lock--file-just-deleted nil)
  (file-notify-rm-watch +mu4e-lock--file-watcher)
  (setq +mu4e-lock--file-watcher
        (file-notify-add-watch +mu4e-lock-file
                               '(change)
                               #'++mu4e-lock-file-updated)))

;;;###autoload
(defun +mu4e-lock-request (event)
  "Handle another process requesting the Mu4e lock."
  (when (equal (nth 1 event) 'created)
    (when +mu4e-lock-relaxed
      (mu4e~stop)
      (file-notify-rm-watch +mu4e-lock--file-watcher)
      (message "Someone else wants to use Mu4e, releasing lock")
      (delete-file +mu4e-lock-file)
      (run-at-time 0.2 nil #'+mu4e-lock-add-watcher))
    (delete-file +mu4e-lock-request-file)))

;;;###autoload
(defun ++mu4e-lock-file-updated (event)
  (if +mu4e-lock--file-just-deleted
      (+mu4e-lock-add-watcher)
    (when (equal (nth 1 event) 'deleted)
      (setq +mu4e-lock--file-just-deleted t)
      (when (and +mu4e-lock-greedy (+mu4e-lock-avalible t))
        (message "Noticed Mu4e lock was avalible, grabbed it")
        (run-at-time 0.2 nil #'mu4e~start)))))