Refactor config publishing scripts

This commit is contained in:
TEC 2021-01-23 05:01:45 +08:00
parent c158b6d6e0
commit 1c8514fa79
Signed by: tec
GPG Key ID: 779591AFDB81F06C
6 changed files with 247 additions and 164 deletions

View File

@ -55,7 +55,7 @@ jobs:
- name: Export config
run: |
cd ~/.config/doom/misc
./config-exporter.sh
./config-publishing/publish.sh
cp ../config.html ../index.html
- name: Move files of interest to the publish subdir

View File

@ -1,163 +0,0 @@
#!/usr/bin/env sh
":"; exec emacs --quick --script "$0" -- "$@" # -*- mode: emacs-lisp; lexical-binding: t; -*-
(setq start-time (float-time)
exit-code 0)
(defvar files-to-htmlize '("init.el" "config.el" "packages.el"))
(defvar htmlize-theme 'doom-one-light)
(defvar file-root (file-name-directory ; parent dir
(directory-file-name
(file-name-directory load-file-name))))
;;; Report errors
(setq debug-on-error t
doom-debug-p t)
(setq log-file (expand-file-name "exporter-log.txt" (file-name-directory load-file-name)))
(defun initialise ()
(advice-add 'theme-magic-from-emacs :override #'ignore)
(advice-add 'format-all-buffer :override #'ignore)
;; Avoid error: file-missing "Opening directory" "No such file or directory" "~/org/roam"
(setq org-roam-directory "~")
(load (expand-file-name "~/.emacs.d/init.el"))
(when (and (featurep 'undo-tree) global-undo-tree-mode)
(global-undo-tree-mode -1)
(advice-add 'undo-tree-save-history :override #'ignore)))
;;; If running just to to htmlization (i.e., in a terminal)
(unless noninteractive
(write-region "" nil log-file)
(defun logged-message (orig-fn &rest args)
(unless inhibit-message
(let ((inhibit-message t)
(msg (apply orig-fn args)))
(princ msg #'external-debugging-output)
(append-to-file msg nil log-file)
(append-to-file "\n" nil log-file))))
(advice-add 'message :around #'logged-message)
(initialise)
(require 'htmlize)
(defun my-htmlize-file (file)
(message "Htmlizing %s" file)
(let ((output-file (expand-file-name
(htmlize-make-file-name (file-name-nondirectory file))
(file-name-directory file))))
(with-current-buffer (find-file-literally file)
(normal-mode)
(font-lock-ensure)
(set-buffer-modified-p nil)
(with-current-buffer (htmlize-buffer-1)
(goto-char (point-min))
(replace-string "</title>\n"
"</title>
<style>
body > pre {
font-size: 1rem;
max-width: min(100rem, 100%);
width: max-content;
white-space: pre-wrap;
margin: auto;
}
</style>\n")
(let ((inhibit-message t))
(write-file output-file)
(kill-buffer (current-buffer))))
(kill-buffer (current-buffer)))))
(load-theme htmlize-theme t)
(dolist (file files-to-htmlize)
(my-htmlize-file (expand-file-name file file-root)))
(kill-emacs exit-code))
;;; Running 'normally' (batch mode) from now on
;;; Colourful messaging and errors
(defun timed-coloured-message (orig-fn format-str &rest args)
(cond
((eq (car args) 'unmodified)
(apply orig-fn format-str (cdr args)))
((or (not format-str) (string-match-p "\\[%\\.1fs\\]" format-str))
(apply orig-fn format-str args))
(t
(apply orig-fn
(concat (if (string-match-p "^\\[[0-9;]+\\]" format-str)
(replace-regexp-in-string
"^\\(?:\\[\\([0-9;]+\\)\\] ?\\)?"
"\033[\\1m[%.1fs] "
format-str)
(concat "[%.1fs] " format-str))
"\033[0;90m")
(append (list (- (float-time) start-time))
args)))))
(advice-add 'message :around #'timed-coloured-message)
(defun red-error (orig-fn &rest args)
(message "\033[0;31m" 'unmodified)
(apply orig-fn args)
(message "\033[0m" 'unmodified)
(setq exit-code 1))
(advice-add 'debug :around #'red-error)
;;; Htmlization
(message "[0;1] Starting htmlization process for %s" files-to-htmlize)
(setq htmlization-process
(start-process "htmlize" nil
"script" "-eqfc"
(format "TERM=xterm-direct emacs --quick -nw --eval '(load (expand-file-name \"%s\"))'" load-file-name)))
(set-process-sentinel
htmlization-process
(lambda (process _signal)
(when (eq (process-status process) 'exit)
(if (= 0 (process-exit-status process))
(message "[1;35] Htmlization finished sucessfully")
(message "[31] Htmlization process failed!")
(message "\033[0;31m %s\033[0m"
'unmodified
(with-temp-buffer
(insert-file-contents-literally log-file)
(buffer-substring-no-properties (point-min) (point-max))))))))
(message "[0;1] Building config file export")
;;; Setup
(initialise)
;;; Actually do the exporting now
(message "[34] Opening config file: %s"
(expand-file-name "config.org" file-root))
(require 'vc) ; need this for modification-time macro
(with-current-buffer (find-file (expand-file-name "config.org" file-root))
(message "[33] Exporting %s" (buffer-file-name))
(org-html-export-to-html))
(message "[1;32] Config export complete!")
(while (not (eq (process-status htmlization-process) 'exit))
(message "Waiting for Htmlization process to finish")
(sleep-for 1))
(setq inhibit-message t)
(kill-emacs exit-code)

View File

@ -0,0 +1,60 @@
#!/usr/bin/env sh
":"; exec script -eqfc "TERM=xterm-direct emacs --quick -nw --eval '(load (expand-file-name \"$0\"))'" 1>/dev/null # -*- mode: emacs-lisp; lexical-binding: t; -*-
(defvar files-to-htmlize '("init.el" "config.el" "packages.el"))
(defvar htmlize-theme 'doom-one-light)
;; Setup
(setq log-file "htmlize-log.txt")
(load (expand-file-name "initialise.el" (file-name-directory load-file-name)))
(initialise)
(defun my-debugger (err &rest debugger-args)
(message "\033[0;31mERROR: %s\nBACKTRACE: %s\033[0m"
debugger-args
(with-temp-buffer
(let ((standard-output (current-buffer)))
(backtrace)
(buffer-string))))
(kill-emacs 1))
(setq debugger #'my-debugger)
;; Start htmlizing
(require 'htmlize)
(defun my-htmlize-file (file)
(message "Htmlizing %s" file)
(let ((output-file (expand-file-name
(htmlize-make-file-name (file-name-nondirectory file))
(file-name-directory file))))
(with-current-buffer (find-file-literally file)
(normal-mode)
(font-lock-ensure)
(set-buffer-modified-p nil)
(with-current-buffer (htmlize-buffer-1)
(goto-char (point-min))
(replace-string "</title>\n"
"</title>
<style>
body > pre {
font-size: 1rem;
max-width: min(100rem, 100%);
width: max-content;
white-space: pre-wrap;
margin: auto;
}
</style>\n")
(let ((inhibit-message t))
(write-file output-file)
(kill-buffer (current-buffer))))
(kill-buffer (current-buffer)))))
(load-theme htmlize-theme t)
(dolist (file files-to-htmlize)
(my-htmlize-file (expand-file-name file config-root)))
(setq inhibit-message t)
(kill-emacs exit-code)

View File

@ -0,0 +1,72 @@
;; Common initilisiation procedure for config publishing scripts
(setq start-time (float-time)
exit-code 0)
(defvar config-root (file-name-directory ; $DOOM_DIR/
(directory-file-name
(file-name-directory ; $DOOM_DIR/misc
(directory-file-name
(file-name-directory load-file-name))))))
;;; Report errors
(setq debug-on-error t
doom-debug-p t)
(defvar log-file (format "%s-log.txt" (file-name-sans-extension load-file-name)))
(write-region "" nil log-file)
(defvar message-colour nil)
(defun logged-message (msg)
(unless inhibit-message
(let ((inhibit-message t))
(princ #'external-debugging-output #'ignore)
(append-to-file msg nil log-file)
(append-to-file "\n" nil log-file)))
msg)
(advice-add 'message :filter-return #'logged-message)
(defun red-error (orig-fn &rest args)
(message "\033[0;31m" 'unmodified)
(apply orig-fn args)
(message "\033[0m" 'unmodified)
(setq exit-code 1))
(defun timed-coloured-message (orig-fn format-str &rest args)
(cond
((eq (car args) 'unmodified)
(apply orig-fn format-str (cdr args)))
((or (not format-str) (string-match-p "\\[%\\\\4.1fs\\]" format-str))
(apply orig-fn format-str args))
(t
(apply orig-fn
(concat (if (string-match-p "^\\[[0-9;]+\\]" format-str)
(replace-regexp-in-string
"^\\(?:\\[\\([0-9;]+\\)\\] ?\\)?"
"\033[\\1m[%4.1fs] "
format-str)
(concat "[%4.1fs] " format-str))
"\033[0;90m")
(append (list (- (float-time) start-time))
args)))))
(when message-colour
(advice-add 'debug :around #'red-error)
(advice-add 'message :around #'timed-coloured-message))
(defun initialise ()
(advice-add 'theme-magic-from-emacs :override #'ignore)
(advice-add 'format-all-buffer :override #'ignore)
;; Avoid error: file-missing "Opening directory" "No such file or directory" "~/org/roam"
(setq org-roam-directory "~")
(load (expand-file-name "~/.emacs.d/init.el"))
(when (and (featurep 'undo-tree) global-undo-tree-mode)
(global-undo-tree-mode -1)
(advice-add 'undo-tree-save-history :override #'ignore)))

View File

@ -0,0 +1,22 @@
#!/usr/bin/env sh
":"; exec emacs --quick --script "$0" -- "$@" # -*- mode: emacs-lisp; lexical-binding: t; -*-
(setq message-colour t)
(load (expand-file-name "initialise.el" (file-name-directory load-file-name)) nil t)
(initialise)
;;; Actually do the exporting now
(message "[34] Opening config file: %s"
(expand-file-name "config.org" config-root))
(require 'vc) ; need this for modification-time macro
(with-current-buffer (find-file (expand-file-name "config.org" config-root))
(message "[33] Exporting %s" (buffer-file-name))
(org-html-export-to-html))
(message "[1;32] Config export complete!")
(setq inhibit-message t)
(kill-emacs exit-code)

View File

@ -0,0 +1,92 @@
#!/usr/bin/env sh
":"; exec emacs --quick --script "$0" -- "$@" # -*- mode: emacs-lisp; lexical-binding: t; -*-
(setq default-directory (file-name-directory load-file-name))
(setq message-colour t)
(load (expand-file-name "initialise.el") nil t)
(message "[0;1] Starting publish process")
;;; Associated processes
(defvar dependent-processes nil)
(defvar dependent-process-names nil)
(defmacro wait-for-script (file)
`(progn
(setq ,(intern (format "%s-process" (file-name-base file)))
(start-process ,(file-name-base file) nil
"sh" (expand-file-name ,file)))
(push ,(intern (format "%s-process" (file-name-base file))) dependent-processes)
(push ,(file-name-base file) dependent-process-names)
(set-process-sentinel
,(intern (format "%s-process" (file-name-base file)))
(lambda (process _signal)
(when (eq (process-status process) 'exit)
(if (= 0 (process-exit-status process))
(message (format "[1;35] %s finished%s"
,file
(make-string (- (length file)
(* (1+ max-name-length) (length dependent-process-names))
-6)
? )))
(message (format "[31] %s process failed!%s"
,file
(make-string (- (length file)
(* (1+ max-name-length) (length dependent-process-names))
-6)
? )))
(message "\033[0;31m %s\033[0m"
'unmodified
(with-temp-buffer
(insert-file-contents-literally ,(expand-file-name (format "%s-log.txt" (file-name-base file) (file-name-directory load-file-name))))
(buffer-substring-no-properties (point-min) (point-max))))
(setq exit-code 1)))))))
;;; Start dependent processes
(wait-for-script "htmlize.sh")
(wait-for-script "org-exporter.sh")
;;; Status info
(defvar max-name-length (apply #'max (cons 8 (mapcar #'length dependent-process-names))))
(defun process-status-table ()
(message (concat
"\033[1m[%4.1fs] \033[0;1m"
(mapconcat (lambda (name)
(format (format "%%%ds" max-name-length) name))
dependent-process-names " ")
"\n\033[0m "
(mapconcat (lambda (proc)
(apply #'format (format "%%s%%%ds" max-name-length)
(pcase (process-status proc)
('run '("\033[0;33m" "Active"))
('exit '("\033[0;32m" "Complete")))))
dependent-processes " ")
"\033[0;90m")
'unmodified
(- (float-time) start-time)))
;;; Await completion
(setq all-proc-finished nil)
(while (not all-proc-finished)
(process-status-table)
(setq all-proc-finished t)
(dolist (proc dependent-processes)
(let ((status (process-status proc)))
(when (not (eq (process-status proc) 'exit))
(setq all-proc-finished nil))))
(unless all-proc-finished
(sleep-for 0.5)))
(delete-file "typescript")
(message "[1;32] Config publish content generated!")
(setq inhibit-message t)
(kill-emacs exit-code)