85 lines
3.5 KiB
EmacsLisp
85 lines
3.5 KiB
EmacsLisp
;;; capture-lib.el --- Deterministic frame capture for the QA runner -*- lexical-binding: t; -*-
|
|
;;
|
|
;; Loaded BEFORE a category's test.el:
|
|
;; QA_OUT=/path/out QA_SIDE=gpu emacs -Q -l runner/capture-lib.el -l NN-cat/test.el
|
|
;;
|
|
;; Environment:
|
|
;; QA_OUT directory where <side>.png is written (required)
|
|
;; QA_SIDE "gpu" or "vanilla" (file name; required)
|
|
;; QA_SETTLE seconds to wait after the scenario is ready (default 1.0)
|
|
;; QA_ACTION optional elisp form evaluated before capturing (e.g. a
|
|
;; function the category's test.el defines)
|
|
;;
|
|
;; The capture is taken BY THIS EMACS PROCESS (shell-command to
|
|
;; screencapture on macOS / ImageMagick import on X11): on macOS the
|
|
;; Screen Recording permission belongs to the app bundle, so an outer
|
|
;; script cannot capture, but the installed Emacs GPU app can.
|
|
;;
|
|
;; Determinism rules baked in: fixed frame size and position, no
|
|
;; blinking cursor, no tool bar, (message nil) before the shot, and
|
|
;; sleep-for rather than sit-for (sit-for returns instantly inside
|
|
;; window-setup-hook when input is pending).
|
|
|
|
(setq inhibit-startup-screen t)
|
|
(blink-cursor-mode -1)
|
|
|
|
(defun qa-capture--region ()
|
|
"Inner frame rectangle as (X Y W H) in native units."
|
|
(let* ((edges (frame-edges nil 'inner-edges))
|
|
(x (nth 0 edges)) (y (nth 1 edges)))
|
|
(list x y (- (nth 2 edges) x) (- (nth 3 edges) y))))
|
|
|
|
(defun qa-capture--shot (file)
|
|
"Capture the frame region into FILE. Return t on success."
|
|
(pcase-let* ((`(,x ,y ,w ,h) (qa-capture--region))
|
|
(code (cond
|
|
((eq system-type 'darwin)
|
|
(call-process "screencapture" nil nil nil
|
|
"-x" "-R" (format "%d,%d,%d,%d" x y w h)
|
|
file))
|
|
(t
|
|
(call-process "import" nil nil nil
|
|
"-window" "root" "-silent"
|
|
"-crop" (format "%dx%d+%d+%d" w h x y)
|
|
file)))))
|
|
(with-temp-file (concat file ".log")
|
|
(insert (format "region=%d,%d,%d,%d exit=%S\n" x y w h code)))
|
|
(eql code 0)))
|
|
|
|
(defun qa-capture-run ()
|
|
(let* ((out (getenv "QA_OUT"))
|
|
(side (getenv "QA_SIDE"))
|
|
(settle (string-to-number (or (getenv "QA_SETTLE") "1.0")))
|
|
(action (getenv "QA_ACTION"))
|
|
(file (expand-file-name (concat side ".png") out))
|
|
(ok nil))
|
|
(condition-case err
|
|
(progn
|
|
(sleep-for 0.5)
|
|
(when (fboundp 'tool-bar-mode) (tool-bar-mode -1))
|
|
(set-frame-size nil 100 35)
|
|
(set-frame-position nil 60 60)
|
|
;; Float above everything: the shot is a screen region, so any
|
|
;; overlapping window (even a video overlay) would pollute it.
|
|
(set-frame-parameter nil 'z-group 'above)
|
|
(raise-frame)
|
|
(when (and action (not (string-empty-p action)))
|
|
(eval (car (read-from-string action)) t))
|
|
(message nil)
|
|
(redisplay t)
|
|
(sleep-for settle)
|
|
(message nil)
|
|
(redisplay t)
|
|
(setq ok (qa-capture--shot file)))
|
|
(error
|
|
(ignore-errors
|
|
(with-temp-file (expand-file-name (concat side ".error") out)
|
|
(insert (format "%S" err))))))
|
|
(kill-emacs (if (and ok (file-exists-p file)) 0 1))))
|
|
|
|
;; Depth 99: the GPU auto-enable hook is prepended to window-setup-hook,
|
|
;; and the capture must run after it.
|
|
(add-hook 'window-setup-hook #'qa-capture-run 99)
|
|
|
|
;;; capture-lib.el ends here
|