tec/emacs-config
tec
/
emacs-config
1
0
Fork 0
Code Issues 4 Pull Requests Releases Activity

Config publishing: Refactor async stuff into file

This commit is contained in:
TEC 2021-01-31 03:11:54 +08:00
parent 08d4c02c53
commit a60df127a5
Signed by: tec
GPG Key ID: 779591AFDB81F06C
3 changed files with 142 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
misc/config-publishing/async-proc-management.el Normal file
View File

@ -0,0 +1,133 @@
;;; misc/config-publishing/async-proc-management.el -*- lexical-binding: t; -*-
(require 'cl-lib)
(defvar start-time (float-time))
(defvar exit-code 0)
(defvar apm-timeout 300
"Give up after this many seconds")
(defvar apm-dependent-processes nil)
(cl-defmacro apm-exec (files &key then)
(if then
(if (listp then)
`(apm--exec ,files :then ',then)
`(apm--exec ,files :then ,then))
`(apm--exec ,files)))
(cl-defun apm--exec (files &key then announce)
(dolist (file (if (listp files) files (list files)))
(let ((proc-name (intern (format "%s-process" (file-name-base file))))
proc-info)
(when announce
(message "[0;32] Starting %s%s" file
(apm-space-fill-line (+ 9 (length file)))))
(set proc-name
(start-process (file-name-base file) nil
(if (file-exists-p file)
(expand-file-name file)
file)))
(setq proc-info (list :proc (symbol-value proc-name)
:file file
:name (file-name-base file)
:padded-name (format "%-8s" (file-name-base file)) ; max len Active/Complete
:then (if (listp then) then (list then))))
(push proc-info apm-dependent-processes)
(apm-watch-process proc-info))))
(defun apm-watch-process (proc-info)
(let ((file (plist-get proc-info :file)))
(set-process-sentinel
(plist-get proc-info :proc)
`(lambda (process _signal)
(when (eq (process-status process) 'exit)
(if (= 0 (process-exit-status process))
(progn
(message (format "[1;35] %s finished%s"
,(file-name-base file)
(apm-space-fill-line ,(length (file-name-base file)))))
;; start dependent processes
(when ',(car (plist-get proc-info :then))
(mapcar (lambda (then)
(apply #'apm--exec
(append
(pcase (if (and (listp then)
(symbolp (car then)))
(eval then) then)
((and n (pred stringp)) (list n))
((and n (pred listp)) n)
(n (user-error "unrecognised :then form %s" n)))
'(:announce t))))
',(list (plist-get proc-info :then)))))
;; non-zero exit code
(message (format "[31] %s process failed!%s"
,(file-name-base (eval file))
(apm-space-fill-line ,(+ 16 (length (file-name-base file))))))
(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))))
(message "[1;31] Config publishing aborted%s" (apm-space-fill-line 23))
(kill-emacs 1)))))))
(defun apm-space-fill-line (base-length)
"Return whitespace such that the line will be filled to overwrite the status line."
(make-string (max 0
(- (apply #'+ (* 2 (1- (length apm-dependent-processes)))
(mapcar (lambda (dep) (length (plist-get dep :padded-name))) apm-dependent-processes))
base-length))
? ))
;;; Status info
(defun apm-process-status-table ()
(message (concat
"\033[1m[%4.1fs] \033[0;1m"
(mapconcat (lambda (dep) (plist-get dep :padded-name)) apm-dependent-processes " ")
"\n\033[0m "
(mapconcat (lambda (dep)
(apply #'format (format "%%s%%-%ds" (length (plist-get dep :padded-name)))
(pcase (process-status (plist-get dep :proc))
('run '("\033[0;33m" "Active"))
('exit '("\033[0;32m" "Complete")))))
apm-dependent-processes
" ")
"\033[0;90m")
'unmodified
(- (float-time) start-time)))
;;; Await completion
(defun apm-wait-and-monitor ()
(setq apm-all-proc-finished nil)
(sleep-for 0.1) ; let processes start
(while (not apm-all-proc-finished)
(apm-process-status-table)
(setq apm-all-proc-finished t)
(dolist (dep apm-dependent-processes)
(when (not (eq (process-status (plist-get dep :proc)) 'exit))
(setq apm-all-proc-finished nil)))
(when (< apm-timeout (- (float-time) start-time))
(message "[0;31] Timout exceeded. Killing slow processes%s" (apm-space-fill-line 37))
(dolist (dep apm-dependent-processes)
(let ((proc (plist-get dep :proc)))
(when (not (eq (process-status proc) 'exit))
(message "[1;31] Killing %s%s" proc (apm-space-fill-line (+ 6 (length (format "%s" proc)))))
(signal-process proc 'SIGUSR2)
(sleep-for 0.2)
(delete-process proc)
(message "\n\033[0;31m %s\033[0m"
'unmodified
(with-temp-buffer
(insert-file-contents-literally (expand-file-name (format "%s-log.txt" (file-name-base (plist-get dep :file)))
(file-name-directory load-file-name)))
(buffer-substring-no-properties (point-min) (point-max)))))))
(setq apm-all-proc-finished t)
(setq exit-code 1))
(unless apm-all-proc-finished
(sleep-for 0.5))))

2
misc/config-publishing/initialise.el
View File

@ -1,4 +1,4 @@
;; Common initilisiation procedure for config publishing scripts
;;; misc/config-publishing/initialise.el --- common initialisation procudure -*- lexical-binding: t; -*-
(setq start-time (float-time)
exit-code 0)

120
misc/config-publishing/publish.sh
View File

@ -9,125 +9,21 @@
(message "Starting publish process")
(setq timeout 300) ; give up after this many seconds
;; Do the things
;;; Associated processes
(load (expand-file-name "async-proc-management.el") nil t)
(defvar dependent-processes nil)
(defvar dependent-process-names nil)
(require 'cl-lib)
(cl-defun wait-for-script (file &key then)
(let ((proc-name (intern (format "%s-process" (file-name-base file))))
proc-info)
(set proc-name (start-process (file-name-base file) nil (expand-file-name file)))
(setq proc-info (list :proc (symbol-value proc-name)
:file file
:name (file-name-base file)
:padded-name (format "%-8s" (file-name-base file)) ; max len Active/Complete
:then (if (listp then) then (list then))))
(push proc-info dependent-processes)
(watch-process proc-info)))
(defun watch-process (proc-info)
(let ((file (plist-get proc-info :file)))
(set-process-sentinel
(plist-get proc-info :proc)
`(lambda (process _signal)
(when (eq (process-status process) 'exit)
(if (= 0 (process-exit-status process))
(progn
(message (format "[1;35] %s finished%s"
,(file-name-base file)
(space-fill-line ,(length (file-name-base file)))))
;; start dependent processes
(when ,(car (plist-get proc-info :then))
(mapcar (lambda (then) (apply #'wait-for-script (if (listp then) then (list then))))
',(plist-get proc-info :then))))
;; non-zero exit code
(message (format "[31] %s process failed!%s"
,(file-name-base (eval file))
(space-fill-line ,(+ 16 (length (file-name-base file))))))
(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))))
(message "[1;31] Config publishing aborted%s" (space-fill-line 23))
(kill-emacs 1)))))))
(defun space-fill-line (base-length)
"Return whitespace such that the line will be filled to overwrite the status line."
(make-string (max 0
(- (apply #'+ (* 2 (1- (length dependent-processes)))
(mapcar (lambda (dep) (length (plist-get dep :padded-name))) dependent-processes))
base-length))
? ))
;;; Start dependent processes
(wait-for-script "check-package-updates.sh")
(wait-for-script "htmlize.sh")
(apm-exec '("htmlize.sh" "check-package-updates.sh"))
(if (not (file-exists-p (concat user-emacs-directory "xkcd/")))
(wait-for-script "org-html.sh" :then "org-pdf.sh")
(wait-for-script "org-html.sh")
(wait-for-script "org-pdf.sh"))
(apm-exec "org-html.sh" :then "org-pdf.sh")
(apm-exec '("org-html.sh" "org-pdf.sh")))
;;; Status info
(defun process-status-table ()
(message (concat
"\033[1m[%4.1fs] \033[0;1m"
(mapconcat (lambda (dep) (plist-get dep :padded-name)) dependent-processes " ")
"\n\033[0m "
(mapconcat (lambda (dep)
(apply #'format (format "%%s%%-%ds" (length (plist-get dep :padded-name)))
(pcase (process-status (plist-get dep :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 (dep dependent-processes)
(when (not (eq (process-status (plist-get dep :proc)) 'exit))
(setq all-proc-finished nil)))
(when (< timeout (- (float-time) start-time))
(message "[0;31] Timout exceeded. Killing slow processes%s" (space-fill-line 37))
(dolist (dep dependent-processes)
(let ((proc (plist-get dep :proc)))
(when (not (eq (process-status proc) 'exit))
(message "[1;31] Killing %s%s" proc (space-fill-line (+ 6 (length (format "%s" proc)))))
(signal-process proc 'SIGUSR2)
(sleep-for 0.2)
(delete-process proc)
(message "\n\033[0;31m %s\033[0m"
'unmodified
(with-temp-buffer
(insert-file-contents-literally (expand-file-name (format "%s-log.txt" (file-name-base (plist-get dep :file)))
(file-name-directory load-file-name)))
(buffer-substring-no-properties (point-min) (point-max)))))))
(setq all-proc-finished t)
(setq exit-code 1))
(unless all-proc-finished
(sleep-for 0.5)))
(apm-wait-and-monitor)
(if (= 0 exit-code)
(message "[1;32] Config publish content generated!%s" (space-fill-line 33))
(message "[1;31] Config publishing aborted%s" (space-fill-line 25)))
(message "[1;32] Config publish content generated!%s" (apm-space-fill-line 33))
(message "[1;31] Config publishing aborted%s" (apm-space-fill-line 25)))
(setq inhibit-message t)
(kill-emacs exit-code)