355 lines
14 KiB
EmacsLisp
355 lines
14 KiB
EmacsLisp
|
;;; org-mu4e-compose.el --- Write mu4e messages with org-mode. -*- lexical-binding: t; -*-
|
||
|
|
;;; Commentary:
|
||
|
|
|
||
|
|
;; I use evil. This file does not depend on evil, but some of these keybindings
|
||
|
|
;; shadow useful org keybinding with message mode keybindings because the org
|
||
|
|
;; bindings being shadowed are available with evil under some other key sequence.
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
(require 'mu4e)
|
||
|
|
(require 'org-mime)
|
||
|
|
(require 'shr)
|
||
|
|
(require 'dom)
|
||
|
|
(require 'sgml-mode)
|
||
|
|
(require 'cl-lib)
|
||
|
|
|
||
|
|
(defvar-local org-mu4e--html-message-p t
|
||
|
|
"Weather or not the current message should be htmlized.")
|
||
|
|
|
||
|
|
(defvar-local org-mu4e--override-org-mode-check nil
|
||
|
|
"Internal variable.
|
||
|
|
See `org-mu4e--override-org-mode-check-advice' for information about what this
|
||
|
|
does.")
|
||
|
|
|
||
|
|
(defvar org-mu4e--internal-message-mode-function
|
||
|
|
(symbol-function 'mu4e-compose-mode)
|
||
|
|
"The `message-mode' (or derived mode) used by `org-mu4e-compose-mode'.")
|
||
|
|
|
||
|
|
(defun org-mu4e--override-org-mode-check-advice (oldfun &rest r)
|
||
|
|
"Around advice for various org mode functions.
|
||
|
|
This function will call OLDFUN with arguments R with `major-mode' let-bound to
|
||
|
|
\\='org-mode when `org-mu4e--override-org-mode-check' is t."
|
||
|
|
(let ((major-mode (if org-mu4e--override-org-mode-check
|
||
|
|
'org-mode
|
||
|
|
major-mode)))
|
||
|
|
(apply oldfun r)))
|
||
|
|
|
||
|
|
(advice-add 'org-element-at-point :around
|
||
|
|
'org-mu4e--override-org-mode-check-advice)
|
||
|
|
|
||
|
|
(defun org-mu4e-toggle-htmlize-mssage (&optional arg no-message)
|
||
|
|
"Toggle weather the current message should be htmlized.
|
||
|
|
If ARG is a positive number or zero, enable htmlization, if it is negative,
|
||
|
|
disable it. Otherwise, toggle it. With NO-MESSAGE, don't display a message
|
||
|
|
about this change."
|
||
|
|
(interactive "P")
|
||
|
|
(setq org-mu4e--html-message-p (or (wholenump arg)
|
||
|
|
(and (not arg)
|
||
|
|
(not org-mu4e--html-message-p))))
|
||
|
|
(unless no-message
|
||
|
|
(message "Message will be %ssent with an HTML part."
|
||
|
|
(if org-mu4e--html-message-p "" "not ")))
|
||
|
|
(force-mode-line-update))
|
||
|
|
|
||
|
|
(defun org-mu4e--bounds-of-mime-part (type)
|
||
|
|
"Find the bounds of the mime part for TYPE in the current buffer."
|
||
|
|
(save-excursion
|
||
|
|
(goto-char (point-min))
|
||
|
|
(when (and
|
||
|
|
(re-search-forward (rx bol (literal mail-header-separator) eol)
|
||
|
|
nil t)
|
||
|
|
(re-search-forward (rx "<#multipart" (* any) ">")
|
||
|
|
nil t)
|
||
|
|
(re-search-forward (rx "<#part " (* any)
|
||
|
|
"type=" (literal type) (* any) ">")
|
||
|
|
nil t))
|
||
|
|
(let ((start (match-end 0))
|
||
|
|
(end (point-max)))
|
||
|
|
(when (re-search-forward
|
||
|
|
(rx (or (and "<#/" (or "part" "multipart") ">")
|
||
|
|
(and "<#part" (* any) ">")))
|
||
|
|
nil t)
|
||
|
|
(setq end (match-beginning 0)))
|
||
|
|
(cons (1+ start) end)))))
|
||
|
|
|
||
|
|
(defun org-mu4e--pretty-print-fontify-html-part ()
|
||
|
|
"Pretty print and fontify the HTML part of the current buffer."
|
||
|
|
(when-let ((bounds (org-mu4e--bounds-of-mime-part "text/html"))
|
||
|
|
(real-buf (current-buffer)))
|
||
|
|
(save-excursion
|
||
|
|
(let ((content
|
||
|
|
(with-temp-buffer
|
||
|
|
(insert-buffer-substring real-buf (car bounds) (cdr bounds))
|
||
|
|
(let (sgml-mode-hook html-mode-hook text-mode-hook)
|
||
|
|
(html-mode))
|
||
|
|
(sgml-pretty-print (point-min) (point-max))
|
||
|
|
(indent-region (point-min) (point-max))
|
||
|
|
(put-text-property (point-min) (point-max) 'fontified nil)
|
||
|
|
(font-lock-ensure)
|
||
|
|
(buffer-string))))
|
||
|
|
(delete-region (car bounds) (cdr bounds))
|
||
|
|
(goto-char (car bounds))
|
||
|
|
(insert content)))))
|
||
|
|
|
||
|
|
(defun org-mu4e--htmlize-and-cleanup ()
|
||
|
|
"HTMLize and cleanup the visible portion of the buffer.
|
||
|
|
This moves point, wrap it in `save-excursion' if that is a problem."
|
||
|
|
(org-mime-htmlize)
|
||
|
|
;; IDK why, but the above function adds a bunch of newlines to the end
|
||
|
|
;; of the buffer.
|
||
|
|
(goto-char (point-min))
|
||
|
|
(when (re-search-forward (rx (group (* "\n")) "\n" eos) nil t)
|
||
|
|
(delete-region (match-beginning 1)
|
||
|
|
(match-end 1)))
|
||
|
|
(font-lock-ensure)
|
||
|
|
(org-mu4e--pretty-print-fontify-html-part))
|
||
|
|
|
||
|
|
(defun org-mu4e-preview-html ()
|
||
|
|
"Preview the HTML version of the current buffer in a new buffer.
|
||
|
|
Return the newly created buffer."
|
||
|
|
(interactive)
|
||
|
|
(let ((msg-buffer (current-buffer))
|
||
|
|
(buffer (get-buffer-create "*Org-Mu4e HTML Preview*"))
|
||
|
|
(bounds (point-min))
|
||
|
|
(cur-max (point-max)))
|
||
|
|
(without-restriction
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(special-mode)
|
||
|
|
(setq-local org-mu4e--override-org-mode-check t)
|
||
|
|
;; Setup font-lock without all the other pesky major mode stuff
|
||
|
|
(org-set-font-lock-defaults)
|
||
|
|
(font-lock-add-keywords nil message-font-lock-keywords)
|
||
|
|
(let ((inhibit-read-only t))
|
||
|
|
(erase-buffer)
|
||
|
|
(insert-buffer-substring msg-buffer)
|
||
|
|
(narrow-to-region bounds cur-max)
|
||
|
|
(org-mu4e--htmlize-and-cleanup))
|
||
|
|
(goto-char (point-min))))
|
||
|
|
(switch-to-buffer-other-window buffer)
|
||
|
|
buffer))
|
||
|
|
|
||
|
|
(defun org-mu4e-render-preview ()
|
||
|
|
"Render a preview of the HTML message."
|
||
|
|
(interactive)
|
||
|
|
(let ((msg-buffer (current-buffer))
|
||
|
|
(buffer (get-buffer-create "*Org-Mu4e Render Preview*")))
|
||
|
|
(save-excursion
|
||
|
|
(without-restriction
|
||
|
|
(goto-char (point-min))
|
||
|
|
(if (re-search-forward (rx bol (literal mail-header-separator) eol)
|
||
|
|
nil t)
|
||
|
|
(let* ((start (1+ (match-end 0)))
|
||
|
|
(org-export-with-latex org-mime-org-html-with-latex-default)
|
||
|
|
(org-preview-latex-image-directory
|
||
|
|
(expand-file-name "ltximg/" mm-tmp-directory))
|
||
|
|
(default-directory org-preview-latex-image-directory)
|
||
|
|
(org-html-postamble nil))
|
||
|
|
(narrow-to-region start (point-max))
|
||
|
|
(if-let ((export-data (org-export-as
|
||
|
|
'html nil t nil
|
||
|
|
org-mime-export-options)))
|
||
|
|
(progn
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(special-mode)
|
||
|
|
(let ((inhibit-read-only t)
|
||
|
|
(default-directory
|
||
|
|
org-preview-latex-image-directory))
|
||
|
|
(erase-buffer)
|
||
|
|
(insert export-data)
|
||
|
|
(shr-render-region (point-min) (point-max))
|
||
|
|
;; The above function inserts a text directionality
|
||
|
|
;; character and then two newlines, just to be safe,
|
||
|
|
;; check for them, then hide them
|
||
|
|
(goto-char (point-min))
|
||
|
|
(let ((new-start (point-min)))
|
||
|
|
(when (or (eq (char-after) #x200e)
|
||
|
|
(eq (char-after) #x200f))
|
||
|
|
(cl-incf new-start))
|
||
|
|
(dotimes (_ 2)
|
||
|
|
(forward-char)
|
||
|
|
(when (eq (char-after) ?\n)
|
||
|
|
(cl-incf new-start)))
|
||
|
|
(narrow-to-region new-start (point-max)))))
|
||
|
|
(switch-to-buffer-other-window buffer))
|
||
|
|
(user-error "HTML export failed")))
|
||
|
|
(user-error "Can't find message start in current buffer"))))))
|
||
|
|
|
||
|
|
(defun org-mu4e-send (&optional arg)
|
||
|
|
"HTMLize and send the message in the current buffer.
|
||
|
|
ARG is passed directly to `message-send'."
|
||
|
|
;; This has to return a non-nil value so that org knows we handled the C-c C-c
|
||
|
|
(interactive "P")
|
||
|
|
(let ((modified (buffer-modified-p))
|
||
|
|
;; we only restore the restriction if the sending below fails
|
||
|
|
(old-rest (cons (point-min) (point-max))))
|
||
|
|
(widen)
|
||
|
|
(let ((save-text (buffer-substring-no-properties (point-min)
|
||
|
|
(point-max))))
|
||
|
|
(condition-case _
|
||
|
|
(progn
|
||
|
|
(when org-mu4e--html-message-p
|
||
|
|
(org-mu4e--htmlize-and-cleanup))
|
||
|
|
(message-send arg)
|
||
|
|
'sent)
|
||
|
|
((or error quit)
|
||
|
|
(erase-buffer)
|
||
|
|
(insert save-text)
|
||
|
|
(narrow-to-region (car old-rest) (cdr old-rest))
|
||
|
|
(restore-buffer-modified-p modified)
|
||
|
|
'failed)))))
|
||
|
|
|
||
|
|
(defun org-mu4e-send-and-exit (&optional arg)
|
||
|
|
"Call `org-mu4e-send', the save and kill the buffer.
|
||
|
|
ARG is passed directly to `message-send'."
|
||
|
|
(interactive "P")
|
||
|
|
(when (eq (org-mu4e-send arg) 'sent)
|
||
|
|
(message-kill-buffer))
|
||
|
|
t ;; this tells org that we have handled the C-c C-c
|
||
|
|
)
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun org-mu4e-compose-new (&rest r)
|
||
|
|
"This is like `mu4e-compose-new', but it utilizes `org-mu4e-compose-mode'.
|
||
|
|
Each of the arguments in R are the same as `mu4e-compose-new', and are directly
|
||
|
|
passed to it."
|
||
|
|
(interactive)
|
||
|
|
;; Save local variables set by `mu4e-compose-new'
|
||
|
|
(let ((org-mu4e--internal-message-mode-function
|
||
|
|
(symbol-function 'mu4e-compose-mode)))
|
||
|
|
(cl-letf (((symbol-function 'mu4e-compose-mode) 'org-mu4e-compose-mode))
|
||
|
|
(apply 'mu4e-compose-new r))))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defvar-keymap org-mu4e-compose-mode-map
|
||
|
|
:parent org-mode-map
|
||
|
|
;; These come straight from `message-mode-map' and override `org-mode-map'
|
||
|
|
"C-c C-f C-t" #'message-goto-to
|
||
|
|
"C-c C-f C-o" #'message-goto-from
|
||
|
|
"C-c C-f C-b" #'message-goto-bcc
|
||
|
|
"C-c C-f C-w" #'message-goto-fcc
|
||
|
|
"C-c C-f C-c" #'message-goto-cc
|
||
|
|
"C-c C-f C-s" #'message-goto-subject
|
||
|
|
"C-c C-f C-r" #'message-goto-reply-to
|
||
|
|
"C-c C-f C-d" #'message-goto-distribution
|
||
|
|
"C-c C-f C-f" #'message-goto-followup-to
|
||
|
|
"C-c C-f C-m" #'message-goto-mail-followup-to
|
||
|
|
"C-c C-f C-k" #'message-goto-keywords
|
||
|
|
"C-c C-f C-u" #'message-goto-summary
|
||
|
|
"C-c C-f C-i" #'message-insert-or-toggle-importance
|
||
|
|
"C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to
|
||
|
|
|
||
|
|
;; modify headers (and insert notes in body)
|
||
|
|
"C-c C-f s" #'message-change-subject
|
||
|
|
;;
|
||
|
|
"C-c C-f x" #'message-cross-post-followup-to
|
||
|
|
;; prefix+message-cross-post-followup-to = same without cross-post
|
||
|
|
"C-c C-f t" #'message-reduce-to-to-cc
|
||
|
|
"C-c C-f a" #'message-add-archive-header
|
||
|
|
;; mark inserted text
|
||
|
|
"C-c M-m" #'message-mark-inserted-region
|
||
|
|
"C-c M-f" #'message-mark-insert-file
|
||
|
|
|
||
|
|
"C-c C-b" #'message-goto-body
|
||
|
|
"C-c C-i" #'message-goto-signature
|
||
|
|
|
||
|
|
"C-c C-t" #'message-insert-to
|
||
|
|
"C-c C-f w" #'message-insert-wide-reply
|
||
|
|
"C-c C-f C-e" #'message-insert-expires
|
||
|
|
"C-c M-u" #'message-insert-or-toggle-importance
|
||
|
|
"C-c M-n" #'message-insert-disposition-notification-to
|
||
|
|
|
||
|
|
"C-c C-y" #'message-yank-original
|
||
|
|
"C-c C-M-y" #'message-yank-buffer
|
||
|
|
"C-c C-S-q" #'message-fill-yanked-message
|
||
|
|
"C-c M-s" #'message-insert-signature
|
||
|
|
"C-c M-h" #'message-insert-headers
|
||
|
|
"C-c M-o" #'message-sort-headers
|
||
|
|
|
||
|
|
;; C-c C-c to send and exit is handled by `org-ctrl-c-ctrl-c-hook'
|
||
|
|
"C-c C-s" #'org-mu4e-send
|
||
|
|
"C-c C-k" #'message-kill-buffer
|
||
|
|
"C-c C-d" #'message-dont-send
|
||
|
|
|
||
|
|
"C-c M-k" #'message-kill-address
|
||
|
|
"C-c M-e" #'message-elide-region
|
||
|
|
"C-c M-v" #'message-delete-not-region
|
||
|
|
"C-c M-z" #'message-kill-to-signature
|
||
|
|
"<remap> <split-line>" #'message-split-line
|
||
|
|
"<remap> <beginning-of-buffer>" #'mu4e-compose-goto-top
|
||
|
|
"<remap> <end-of-buffer>" #'mu4e-compose-goto-bottom
|
||
|
|
|
||
|
|
"C-c M-r" #'message-insert-screenshot
|
||
|
|
|
||
|
|
"M-n" #'message-display-abbrev
|
||
|
|
|
||
|
|
"C-c M-t" #'org-mu4e-toggle-htmlize-mssage
|
||
|
|
"C-c M-p C-p" #'org-mu4e-preview-html
|
||
|
|
"C-c M-p C-w" #'org-mu4e-render-preview
|
||
|
|
"C-c C-;" #'mu4e-compose-context-switch)
|
||
|
|
|
||
|
|
(defun org-mu4e--compose-mode-command-predicate (symbol buffer)
|
||
|
|
"`org-mu4e-compose-mode' local value for command completion predicate.
|
||
|
|
This will defer to the user's global value for the same, except that it allows
|
||
|
|
for commands who are designed for `message-mode' and `mu4e-mode' as well.
|
||
|
|
SYMBOL is the command to check. BUFFER is the buffer in which checking
|
||
|
|
happens. BUFFER is ignored."
|
||
|
|
(let ((real-fun (default-value 'read-extended-command-predicate))
|
||
|
|
(modes (command-modes symbol)))
|
||
|
|
(or (not real-fun)
|
||
|
|
(member 'message-mode modes)
|
||
|
|
(member 'mu4e-compose-mode modes)
|
||
|
|
(funcall real-fun symbol buffer))))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(define-derived-mode org-mu4e-compose-mode org-mode "mu4e:org-compose"
|
||
|
|
"Major mode for editing mu4e messages with `org-mode' syntax.
|
||
|
|
This is derived from `org-mode', but it also essentially runs
|
||
|
|
`mu4e-compose-mode' and `message-mode'. Therefore, it runs their hooks too."
|
||
|
|
;; Enable all the things from `mu4e-compose-mode' (which derives from
|
||
|
|
;; `message-mode'), but don't let it change the major mode (or other things we
|
||
|
|
;; care about).
|
||
|
|
(when org-mu4e--internal-message-mode-function
|
||
|
|
(let ((major-mode major-mode)
|
||
|
|
(mode-name mode-name)
|
||
|
|
(local-abbrev-table local-abbrev-table)
|
||
|
|
(font-lock-defaults font-lock-defaults)
|
||
|
|
;; some of these are not actually changed, but they are here just in
|
||
|
|
;; case they change in the future...
|
||
|
|
(comment-start comment-start)
|
||
|
|
(comment-end comment-end)
|
||
|
|
(comment-start-skip comment-start-skip)
|
||
|
|
(comment-add comment-add)
|
||
|
|
(comment-style comment-style))
|
||
|
|
(cl-letf (((symbol-function 'kill-all-local-variables) 'ignore)
|
||
|
|
((symbol-function 'use-local-map) 'ignore)
|
||
|
|
((symbol-function 'set-syntax-table) 'ignore))
|
||
|
|
(funcall org-mu4e--internal-message-mode-function))))
|
||
|
|
;; Add `message-mode' keyword and quote highlighting on top of the org syntax
|
||
|
|
;; highlighting
|
||
|
|
(font-lock-add-keywords nil message-font-lock-keywords)
|
||
|
|
(setq-local org-mu4e--override-org-mode-check t
|
||
|
|
;; This does not work, but I am leaving it here to figure out later
|
||
|
|
read-extended-command-predicate
|
||
|
|
'org-mu4e--compose-mode-command-predicate)
|
||
|
|
(add-to-list (make-local-variable 'org-ctrl-c-ctrl-c-final-hook)
|
||
|
|
'org-mu4e-send-and-exit)
|
||
|
|
(add-to-list (make-local-variable 'mode-line-misc-info)
|
||
|
|
'(:eval (if org-mu4e--html-message-p
|
||
|
|
"Text/HTML "
|
||
|
|
"Text Only "))))
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(define-mail-user-agent 'org-mu4e-user-agent
|
||
|
|
#'org-mu4e-compose-new
|
||
|
|
#'org-mu4e-send-and-exit
|
||
|
|
#'message-kill-buffer
|
||
|
|
'message-send-hook)
|
||
|
|
|
||
|
|
;;;###autoload
|
||
|
|
(defun org-mu4e-user-agent ()
|
||
|
|
"Return `org-mu4e-user-agent'."
|
||
|
|
'org-mu4e-user-agent)
|
||
|
|
|
||
|
|
(provide 'org-mu4e-compose)
|
||
|
|
;;; org-mu4e-compose.el ends here
|