Skip to content

Changes to the final HTML document #196

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Changes to the final HTML document #196

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
e8c7bb3
Change `org-msg-build-style` to also accept ids
Ndot Sep 25, 2024
33d9539
Improve the final HTML document
Ndot Sep 25, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
70 changes: 47 additions & 23 deletions org-msg.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -245,10 +245,11 @@ Can be either `top-posting' or nil."
,@inline-src
(margin . "0px")
(font-size . "9pt")
(font-family . "monospace")))
(font-family . "monospace")
(padding . "1.2em")
(border-radius . "3px")))
(div org-src-container ((margin-top . "10px")))
(nil figure-number ,ftl-number)
(nil table-number)
(caption nil ((text-align . "left")
(background . ,theme-color)
(color . "white")
Expand All @@ -259,7 +260,7 @@ Can be either `top-posting' or nil."
(nil figure ,ftl-number)
(nil org-src-name ,ftl-number)

(table nil (,@table ,line-height (border-collapse . "collapse")))
(table nil (,@table ,line-height (border-collapse . "collapse") (margin . "1em 0")))
(th nil ((border . "1px solid white")
(background-color . ,theme-color)
(color . "white")
Expand All @@ -286,7 +287,11 @@ Can be either `top-posting' or nil."
(p nil ((text-decoration . "none") (margin-bottom . "0px")
(margin-top . "10px") (line-height . "11pt") ,font-size
,font-family))
(div nil (,@font (line-height . "11pt"))))))
(div nil (,@font (line-height . "11pt") (overflow . "auto")))
(nil nil content ((max-width . "69ch")
(margin . "0 auto")))
(img nil nil ((width . "100%")
(border-radius . "3px"))))))

(defcustom org-msg-enforce-css org-msg-default-style
"Define how to handle CSS style:
Expand Down Expand Up @@ -542,18 +547,37 @@ expression into multi-level quote blocks."
(forward-char 1))
(org-msg-ascii-blockquote (1+ level) new-begin new-end))))))))

(defun org-msg-build-style (tag class css)
"Given a TAG and CLASS selector, it builds a CSS style string.
This string can be used as a HTML style attribute value."
(cl-flet ((css-match-p (css)
(or (and (eq tag (car css))
(eq class (cadr css)))
(and (not (car css))
(eq class (cadr css)))
(and (not (cadr css))
(eq tag (car css))))))
(defun org-msg-build-style (css &optional tag class id)
"Given a TAG, CLASS or ID selector, it builds a css style string.
This string can be used as a HTML style attribute value.
CSS is a list of type `org-msg-default-style'."

;; This let block grabs every rule in the "CSS" variable and puts the
;; last element (which is the list of css rules) in the "car". The final
;; format is ((css-rules) tag class id).
;; This is done to avoid changing the format of `org-msg-default-style'
;; to prevent breaking past user configurations.
(let ((res nil))
(dolist (elem css res)
(setq res (append res `(,(cons (car (last elem)) (butlast elem) )))))
(setq css res))

(cl-flet ((css-match-p (css-rule)
;; ID's are unique in css, so if we match an ID and the
;; ID is not nil we apply immediately.
(or (and id
(eq id (cadddr css-rule)))
(and (or (and (eq tag (cadr css-rule))
(eq class (caddr css-rule))
(not (cadddr css-rule)))
(and (not (cadr css-rule))
(eq class (caddr css-rule))
(not (cadddr css-rule)))
(and (eq tag (cadr css-rule))
(not (caddr css-rule))
(not (cadddr css-rule))))))))
(when-let ((sel (cl-remove-if-not #'css-match-p css))
(props (apply 'append (mapcar 'caddr sel))))
(props (apply 'append (mapcar 'car sel))))
(org-msg-props-to-style props))))

(defun org-msg-str-to-mailto (str css)
Expand All @@ -567,7 +591,7 @@ style mailto anchor link style appropriately."
(let ((name-regexp "\\([[:alpha:]\"][[:alnum:] ,\"()@./-]+\\)")
(mail-regexp "<\\([[email protected]]+\\)>")
(cursor (goto-char (point-min)))
(style (org-msg-build-style 'a org-msg-reply-header-class css))
(style (org-msg-build-style css 'a org-msg-reply-header-class))
(res))
(while (re-search-forward (concat name-regexp " " mail-regexp) nil t)
(unless (= (match-beginning 0) cursor)
Expand Down Expand Up @@ -636,9 +660,8 @@ is the XML tree and CSS the style."
(assq-delete-all 'hr (assq 'body xml))
(assq-delete-all 'align (cadr div))
(setf (cadr div) (assq-delete-all 'style (cadr div)))
(let ((div-style (org-msg-build-style 'div
org-msg-reply-header-class css))
(p-style (org-msg-build-style 'p org-msg-reply-header-class css)))
(let ((div-style (org-msg-build-style css 'div org-msg-reply-header-class))
(p-style (org-msg-build-style css 'p org-msg-reply-header-class)))
(when div-style
(push `(style . ,div-style) (cadr div)))
(when p-style
Expand Down Expand Up @@ -798,10 +821,11 @@ absolute paths."
(let ((css (org-msg-load-css)))
(cl-flet ((enforce (xml)
(let* ((tag (car xml))
(tmp (assq 'class (cadr xml)))
(class (when tmp
(intern (cdr tmp))))
(style (org-msg-build-style tag class css)))
(class-alist (assq 'class (cadr xml)))
(class (when class-alist (intern (cdr class-alist))))
(id-alist (assq 'id (cadr xml)))
(id (when id-alist (intern (cdr id-alist))))
(style (org-msg-build-style css tag class id)))
(when style
(setf (cadr xml) (assq-delete-all 'style (cadr xml)))
(setf (cadr xml) (assq-delete-all 'class (cadr xml)))
Expand Down