Fix previews in elisp/org-mu4e-compose.el
This commit is contained in:
@ -9,17 +9,42 @@
|
||||
(require 'mu4e)
|
||||
(require 'org-mime)
|
||||
(require 'shr)
|
||||
(require 'dom)
|
||||
(require 'sgml-mode)
|
||||
(require 'cl-lib)
|
||||
(require 'rx)
|
||||
|
||||
(defcustom org-mu4e-preview-html-images t
|
||||
"If non-nil, render images in rendered HTML preview buffers.
|
||||
This can be toggled locally with `org-mu4e-toggle-preview-images'."
|
||||
:type 'boolean)
|
||||
|
||||
(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'.")
|
||||
|
||||
(defvar-local org-mu4e--preview-message-buffer nil
|
||||
"The message buffer that backs this preview buffer.")
|
||||
|
||||
(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,
|
||||
@ -63,11 +88,13 @@ about this change."
|
||||
(let ((content
|
||||
(with-temp-buffer
|
||||
(insert-buffer-substring real-buf (car bounds) (cdr bounds))
|
||||
(make-local-variable 'delay-mode-hooks) ;; prevent warnings
|
||||
(let ((delay-mode-hooks t)
|
||||
delayed-mode-hooks)
|
||||
(html-mode))
|
||||
(sgml-pretty-print (point-min) (point-max))
|
||||
(indent-region (point-min) (point-max))
|
||||
(let ((inhibit-message t))
|
||||
(indent-region (point-min) (point-max)))
|
||||
(put-text-property (point-min) (point-max) 'fontified nil)
|
||||
(font-lock-ensure)
|
||||
(buffer-string))))
|
||||
@ -88,74 +115,211 @@ This moves point, wrap it in `save-excursion' if that is a problem."
|
||||
(font-lock-ensure)
|
||||
(org-mu4e--pretty-print-fontify-html-part))
|
||||
|
||||
(defvar-keymap org-mu4e--code-preview-mode-map
|
||||
:doc "Keymap for `org-mu4e--code-preview-mode'."
|
||||
"r" #'revert-buffer-quick)
|
||||
|
||||
(with-eval-after-load 'evil
|
||||
(evil-define-key* 'normal org-mu4e--code-preview-mode-map
|
||||
"r" #'revert-buffer-quick))
|
||||
|
||||
(define-derived-mode org-mu4e--code-preview-mode special-mode
|
||||
"Org-Mu4e-Code-Preview"
|
||||
"Major mode used in the buffere created by `org-mu4e-preview-html'."
|
||||
(setq-local org-mu4e--override-org-mode-check t
|
||||
revert-buffer-function #'org-mu4e--html-code-revert-function)
|
||||
(font-lock-mode -1)
|
||||
;; 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))
|
||||
|
||||
(cl-defun org-mu4e--get-preview-buffer (name mode)
|
||||
"Get the preview buffer for the current message buffer, possibly creating it.
|
||||
NAME is a template name to pass to `generate-new-buffer'. MODE is the major
|
||||
mode of the buffer. Only buffers of this MODE will be returned."
|
||||
(let ((msg-buf (current-buffer)))
|
||||
;; first try to find an existing byffer
|
||||
(dolist (buffer (buffer-list))
|
||||
(when (and (eq (buffer-local-value
|
||||
'org-mu4e--preview-message-buffer buffer)
|
||||
msg-buf)
|
||||
(eq (buffer-local-value 'major-mode buffer) mode))
|
||||
(cl-return-from org-mu4e--get-preview-buffer buffer)))
|
||||
;; create a new buffer
|
||||
(with-current-buffer (generate-new-buffer name)
|
||||
(funcall mode)
|
||||
(setq-local org-mu4e--preview-message-buffer msg-buf)
|
||||
(current-buffer))))
|
||||
|
||||
(defun org-mu4e--render-html-code-preview ()
|
||||
"Render the HTML preview for the current preview buffer.
|
||||
This must be called from an HTML preview buffer (as created by
|
||||
`org-mu4e--get-preview-buffer'."
|
||||
(let ((start (point))
|
||||
(inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring org-mu4e--preview-message-buffer)
|
||||
(org-mu4e--htmlize-and-cleanup)
|
||||
(goto-char start)))
|
||||
|
||||
(defun org-mu4e--html-code-revert-function (&rest _r)
|
||||
"Revert an `org-mu4e--code-preview-mode' buffer."
|
||||
(org-mu4e--render-html-code-preview)
|
||||
(message "Re-rendering..."))
|
||||
|
||||
(cl-defmacro org-mu4e--with-preview-buffer ((name mode) &rest body)
|
||||
"Execute BODY within a preview buffer and return that buffer.
|
||||
The preview buffer is created with `org-mu4e--get-code-preview-buffer' with NAME
|
||||
and MODE."
|
||||
(declare (indent 1))
|
||||
(let ((buffer (make-symbol "buffer")))
|
||||
`(let ((,buffer (org-mu4e--get-preview-buffer ,name ,mode)))
|
||||
(with-current-buffer ,buffer
|
||||
,@body
|
||||
(unless (get-buffer-window ,buffer (selected-frame))
|
||||
(switch-to-buffer-other-window ,buffer))
|
||||
,buffer))))
|
||||
|
||||
(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)
|
||||
(org-mu4e--with-preview-buffer
|
||||
("*Org-Mu4e HTML Preview*" 'org-mu4e--code-preview-mode)
|
||||
(org-mu4e--render-html-code-preview)))
|
||||
|
||||
(defun org-mu4e-toggle-preview-images ()
|
||||
"Toggle whether image previews should be shown in the current buffer."
|
||||
(interactive)
|
||||
(cl-callf not shr-inhibit-images)
|
||||
(org-mu4e--render-message-html))
|
||||
|
||||
(defvar-keymap org-mu4e--rendered-preview-mode-map
|
||||
:doc "Keymap for `org-mu4e--rendered-preview-mode'."
|
||||
"r" #'revert-buffer-quick
|
||||
"t" #'org-mu4e-toggle-preview-images)
|
||||
|
||||
(with-eval-after-load 'evil
|
||||
(evil-define-key* 'normal org-mu4e--rendered-preview-mode-map
|
||||
"r" #'revert-buffer-quick
|
||||
"t" #'org-mu4e-toggle-preview-images))
|
||||
|
||||
(define-derived-mode org-mu4e--rendered-preview-mode special-mode
|
||||
'("Org-Mu4e-Rendered-Preview" (shr-inhibit-images "" "/i"))
|
||||
(setq-local revert-buffer-function
|
||||
#'org-mu4e--rendered-preview-revert-function
|
||||
org-export-with-latex org-mime-org-html-with-latex-default
|
||||
org-html-preamble nil
|
||||
shr-inhibit-images (not org-mu4e-preview-html-images)))
|
||||
|
||||
(defconst org-mu4e--allowed-part-properties
|
||||
'("type" "filename" "id" "disposition")
|
||||
"List of allowed properties for `org-mu4e--read-part-properties'.")
|
||||
|
||||
(cl-defun org-mu4e--read-part-properties ()
|
||||
"Read the <#part> statement at point, moving poing to the end.
|
||||
This returns a plist of the properties of the statement."
|
||||
(when (looking-at (regexp-quote "<#part "))
|
||||
(forward-char (length "<#part "))
|
||||
(let (out)
|
||||
(while (looking-at
|
||||
(rx (* (or " " "\t" "\n"))
|
||||
(group (+ (any "a-z" "A-Z"))) "=" (? (group "\""))))
|
||||
(let ((name (match-string 1))
|
||||
(is-string (match-string 2))
|
||||
val)
|
||||
(goto-char (1+ (match-end 1)))
|
||||
(setq val (if is-string
|
||||
(prog1
|
||||
(read (current-buffer))
|
||||
(forward-char))
|
||||
(let ((start (point)))
|
||||
(re-search-forward (rx (or " " "\t" eol ">")))
|
||||
(buffer-substring-no-properties
|
||||
start (match-beginning 0)))))
|
||||
(unless (stringp val)
|
||||
(cl-return-from org-mu4e--read-part-properties))
|
||||
(when (member name org-mu4e--allowed-part-properties)
|
||||
(push val out)
|
||||
(push (intern (concat ":" name)) out))))
|
||||
(unless (eql (char-before) ?>)
|
||||
(cl-return-from org-mu4e--read-part-properties))
|
||||
(re-search-forward (rx (or "<#/part>" (group "<#part"))))
|
||||
(when-let* ((end (match-beginning 1)))
|
||||
(goto-char end))
|
||||
out)))
|
||||
|
||||
(cl-defun org-mu4e--extract-inline-html-file-parts ()
|
||||
"Search through the buffer and find all parts that point to external images.
|
||||
This returns a hash table of cid -> path."
|
||||
(let (is-html-part out)
|
||||
(while (re-search-forward
|
||||
(rx "<#multipart" (+ (any blank))
|
||||
"type=" (or "related" "\"related\"")
|
||||
(* (any blank)) ">")
|
||||
nil t)
|
||||
(setq is-html-part nil
|
||||
out (make-hash-table :test 'equal))
|
||||
(let ((start (match-end 0)))
|
||||
(search-forward "<#/multipart>")
|
||||
(with-restriction start (match-beginning 0)
|
||||
(goto-char (point-min))
|
||||
(while-let ((props (org-mu4e--read-part-properties))
|
||||
(type (plist-get props :type)))
|
||||
(cond
|
||||
((equal type "text/html")
|
||||
(setq is-html-part t))
|
||||
((string-prefix-p "image/" type)
|
||||
(when-let* ((id (plist-get props :id))
|
||||
(filename (plist-get props :filename)))
|
||||
;; remove the < > from the id
|
||||
(puthash (substring id 1 (1- (length id))) filename out)))))))
|
||||
(when is-html-part
|
||||
(cl-return-from org-mu4e--extract-inline-html-file-parts out)))))
|
||||
|
||||
(defun org-mu4e--replace-cid-images ()
|
||||
"Replace the src property of all <img> tags that have a protocol of cid."
|
||||
(let ((bounds (org-mu4e--bounds-of-mime-part "text/html"))
|
||||
(cid-map (save-excursion
|
||||
(goto-char (point-min))
|
||||
(org-mu4e--extract-inline-html-file-parts))))
|
||||
(save-excursion
|
||||
(with-restriction (car bounds) (cdr bounds)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward (rx "src=" (group "\"cid:")) nil t)
|
||||
(goto-char (match-beginning 1))
|
||||
(let ((start (point))
|
||||
(src (read (current-buffer))))
|
||||
(when-let ((file (gethash (substring src 4) cid-map)))
|
||||
(delete-region start (point))
|
||||
(insert (prin1-to-string (concat "file://" file))))))))))
|
||||
|
||||
(defun org-mu4e--render-message-html ()
|
||||
"Render the HTMLized message buffer for the current preview buffer."
|
||||
(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))
|
||||
(insert-buffer-substring org-mu4e--preview-message-buffer)
|
||||
(org-mime-htmlize)
|
||||
(org-mu4e--replace-cid-images)
|
||||
(let ((bounds (org-mu4e--bounds-of-mime-part "text/html")))
|
||||
(delete-region (cdr bounds) (point-max))
|
||||
(delete-region (point-min) (car bounds)))
|
||||
(shr-render-region (point-min) (point-max))))
|
||||
|
||||
(defun org-mu4e--rendered-preview-revert-function (&rest _r)
|
||||
"Revert function for `org-mu4e--rendered-preview-mode."
|
||||
(message "Re-rendering...")
|
||||
(org-mu4e--render-message-html))
|
||||
|
||||
(defun org-mu4e-render-preview ()
|
||||
"Render a preview of the HTML message."
|
||||
(interactive)
|
||||
(let ((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"))))))
|
||||
(with-current-buffer
|
||||
(org-mu4e--with-preview-buffer
|
||||
("*Org-Mu4e Render Preview*" 'org-mu4e--rendered-preview-mode))
|
||||
;; make sure the buffer is shown when wo do this so the image's width is
|
||||
;; correct
|
||||
(org-mu4e--render-message-html)))
|
||||
|
||||
(defun org-mu4e-send (&optional arg)
|
||||
"HTMLize and send the message in the current buffer.
|
||||
|
||||
Reference in New Issue
Block a user