Skip to content

Instantly share code, notes, and snippets.

@ivan
Last active October 7, 2018 11:17
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ivan/dd631077d1112b2933c1041ed24d84e5 to your computer and use it in GitHub Desktop.
Save ivan/dd631077d1112b2933c1041ed24d84e5 to your computer and use it in GitHub Desktop.
Export org-mode files to a usable HTML format that looks just like the buffer
(setq load-path (cons "~/opt/htmlize" load-path))
(require 'htmlize)
;;; fonts and colors - copy from your emacs configuration
; Needed for the org-headline-done below to work
(setq org-fontify-done-headline t)
(setq org-todo-keyword-faces
'(("CANCELED" :foreground "#686868" :weight bold)
("WAIT" :foreground "#B26818" :weight bold)
("DONE" :foreground "#686868" :weight bold)
("TODO" :foreground "#3F9E1D" :weight bold)))
(set-face-attribute 'default nil :font "Sans-9.5")
(custom-set-faces
'(default ((t (:background "#E8E2D9"))))
'(org-agenda-done ((t (:foreground "LavenderBlush4"))))
'(org-ellipsis ((t (:foreground "#666666"))))
'(org-headline-done ((t (:foreground "LavenderBlush4"))))
'(org-hide ((t (:foreground "#E8E2D9"))))
'(outline-1 ((t (:foreground "#000000"))))
'(outline-2 ((t (:foreground "#000000"))))
'(outline-3 ((t (:foreground "#000000"))))
'(outline-4 ((t (:foreground "#000000"))))
'(outline-5 ((t (:foreground "#000000"))))
'(outline-6 ((t (:foreground "#000000"))))
'(outline-7 ((t (:foreground "#000000"))))
'(outline-8 ((t (:foreground "#000000"))))
'(region ((t (:background "#FFCC33")))))
;;; necessary to get colors while operating in batch mode
;;; copied from https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting/38515
(require 'font-lock)
(require 'subr-x) ;; for `when-let'
(unless (boundp 'maximal-integer)
(defconst maximal-integer (lsh -1 -1)
"Maximal integer value representable natively in emacs lisp."))
(defun face-spec-default (spec)
"Get list containing at most the default entry of face SPEC.
Return nil if SPEC has no default entry."
(let* ((first (car-safe spec))
(display (car-safe first)))
(when (eq display 'default)
(list (car-safe spec)))))
(defun face-spec-min-color (display-atts)
"Get min-color entry of DISPLAY-ATTS pair from face spec."
(let* ((display (car-safe display-atts)))
(or (car-safe (cdr (assoc 'min-colors display)))
maximal-integer)))
(defun face-spec-highest-color (spec)
"Search face SPEC for highest color.
That means the DISPLAY entry of SPEC
with class 'color and highest min-color value."
(let ((color-list (cl-remove-if-not
(lambda (display-atts)
(when-let ((display (car-safe display-atts))
(class (and (listp display)
(assoc 'class display)))
(background (assoc 'background display)))
(and (member 'light (cdr background))
(member 'color (cdr class)))))
spec)))
(cl-reduce (lambda (display-atts1 display-atts2)
(if (> (face-spec-min-color display-atts1)
(face-spec-min-color display-atts2))
display-atts1
display-atts2))
(cdr color-list)
:initial-value (car color-list))))
(defun face-spec-t (spec)
"Search face SPEC for fall back."
(cl-find-if (lambda (display-atts)
(eq (car-safe display-atts) t))
spec))
(defun my-face-attribute (face attribute &optional frame inherit)
"Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'."
(let* ((face-spec (face-user-default-spec face))
(display-attr (or (face-spec-highest-color face-spec)
(face-spec-t face-spec)))
(attr (cdr display-attr))
(val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr))))))
;; (message "attribute: %S" attribute) ;; for debugging
(when (and (null (eq attribute :inherit))
(null val))
(let ((inherited-face (my-face-attribute face :inherit)))
(when (and inherited-face
(null (eq inherited-face 'unspecified)))
(setq val (my-face-attribute inherited-face attribute)))))
;; (message "face: %S attribute: %S display-attr: %S, val: %S" face attribute display-attr val) ;; for debugging
(or val 'unspecified)))
(advice-add 'face-attribute :override #'my-face-attribute)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Debugging:
(defmacro print-args-and-ret (fun)
"Prepare FUN for printing args and return value."
`(advice-add (quote ,fun) :around
(lambda (oldfun &rest args)
(let ((ret (apply oldfun args)))
(message ,(concat "Calling " (symbol-name fun) " with args %S returns %S.") args ret)
ret))
'((name "print-args-and-ret"))))
; (print-args-and-ret htmlize-faces-in-buffer)
; (print-args-and-ret htmlize-get-override-fstruct)
; (print-args-and-ret htmlize-face-to-fstruct)
; (print-args-and-ret htmlize-attrlist-to-fstruct)
; (print-args-and-ret face-foreground)
; (print-args-and-ret face-background)
; (print-args-and-ret face-attribute)
#!/bin/bash
set -eu -o pipefail
code="(progn (font-lock-flush) (font-lock-fontify-buffer) (with-current-buffer (htmlize-buffer) (write-region (point-min) (point-max)"
for i in reading.org; do
emacs --batch --load ~/bin/emacs-htmlize-exporter.el ~/wiki/$i --eval "$code \"~/htdocs/$i.html\")))"
sed -i -r 's/<style type="text\/css">/<style>\n* { font-family: system-ui, sans-serif }\n/g' ~/htdocs/$i.html
sed -i -r 's/<head>/<head>\n<meta name="referrer" content="no-referrer">\n<meta http-equiv="x-dns-prefetch-control" content="off">\n/g' ~/htdocs/$i.html
done
@ivan
Copy link
Author

ivan commented Oct 7, 2018

Add (outline-show-all) to code if you wish to the expand the trees, mentioned in https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting/38515#38515

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment