125 lines
8.2 KiB
Common Lisp
125 lines
8.2 KiB
Common Lisp
;;;; Burst typing and grab cleanup on an owned Xvfb, never the live DISPLAY.
|
||
(require :asdf)
|
||
(asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*)))
|
||
(asdf:load-system "lime/x11")
|
||
|
||
(handler-case
|
||
(let ((server (uiop:launch-program '("Xvfb" "-displayfd" "1" "-screen" "0" "1000x622x24" "-nolisten" "tcp")
|
||
:output :stream :error-output :interactive))
|
||
(backend nil) (clients nil) (checks 0)
|
||
(original-launch (symbol-function 'lime.x11:backend-launch-program))
|
||
(original-scan (symbol-function 'lime.x11::%scan-path-program-names))
|
||
(original-overlay (symbol-function 'lime.x11::%make-ui-overlay))
|
||
(lime.x11::*path-program-cache* nil))
|
||
(unwind-protect
|
||
(let* ((number (parse-integer (read-line (uiop:process-info-output server))))
|
||
(display-name (format nil ":~D" number))
|
||
(launched nil) (queries nil) (scans 0) (typed nil) (ordinary 0))
|
||
(setf backend (lime.x11:start-lime :display-name display-name :head-discovery :none
|
||
:install-default-keybindings-p nil)
|
||
clients (xlib:open-default-display display-name))
|
||
(let* ((display (lime.x11::x11-backend-display backend))
|
||
(super (first (nth-value 6 (xlib:modifier-mapping display))))
|
||
(window (xlib:create-window :parent (xlib:screen-root (xlib:display-default-screen clients))
|
||
:x 20 :y 20 :width 100 :height 100 :event-mask '(:key-press))))
|
||
(labels ((check (truth label) (assert truth () "Launcher: ~A" label) (incf checks))
|
||
(pump ()
|
||
(xlib:display-finish-output clients)
|
||
(let ((turns 0))
|
||
(lime.x11:run-event-loop
|
||
backend :timeout 0.005
|
||
:before-event (lambda (b)
|
||
(assert (< (incf turns) 500) () "Event queue did not settle.")
|
||
(xlib:display-finish-output display)
|
||
(unless (xlib:event-listen display)
|
||
(setf (lime.x11::x11-backend-running-p b) nil))))))
|
||
(tap (keysym)
|
||
(let ((code (xlib:keysym->keycodes display keysym)))
|
||
(assert code)
|
||
(xlib/xtest:fake-key-event clients code t)
|
||
(xlib/xtest:fake-key-event clients code nil)))
|
||
(shortcut (char)
|
||
(xlib/xtest:fake-key-event clients super t)
|
||
(tap (char-code char))
|
||
(xlib/xtest:fake-key-event clients super nil))
|
||
(text-burst (text)
|
||
(loop for char across text do (tap (char-code char))))
|
||
(read-client-keys ()
|
||
(xlib:display-finish-output clients)
|
||
(loop while (xlib:event-listen clients)
|
||
do (xlib:event-case (clients :timeout 0)
|
||
(:key-press (code state)
|
||
(let ((char (xlib:keysym->character clients (xlib:keycode->keysym clients code 0) state)))
|
||
(when (and (characterp char) (graphic-char-p char)) (push char typed))) t)
|
||
(otherwise () t)))))
|
||
(xlib:map-window window) (pump)
|
||
(check (= (xlib:window-id window) (xlib:window-id (xlib:input-focus clients))) "application has real focus")
|
||
;; Measure actual cold/warm opening with the real PATH catalog.
|
||
(dotimes (i 3)
|
||
(let ((start (get-internal-real-time)))
|
||
(lime.x11:backend-open-run-prompt backend)
|
||
(xlib:display-finish-output display)
|
||
(format t "~&Launcher ~A open: ~,2F ms~%" (if (zerop i) "cold" "warm")
|
||
(* 1000.0 (/ (- (get-internal-real-time) start) internal-time-units-per-second))))
|
||
(lime.x11:backend-close-command-palette backend) (pump))
|
||
;; Stub only process creation and catalog discovery, not X grabs,
|
||
;; filtering, menu creation, event dispatch, or key delivery.
|
||
(setf lime.x11::*path-program-cache* nil
|
||
(symbol-function 'lime.x11::%scan-path-program-names)
|
||
(lambda () (incf scans) (sleep 0.05) '("emoji-menu" "st"))
|
||
(symbol-function 'lime.x11:backend-launch-program)
|
||
(lambda (b argv)
|
||
(push argv launched)
|
||
(push (lime.ui:ui-session-query (lime.x11::x11-backend-ui-session b)) queries)))
|
||
(lime.x11:bind-key backend #\p '(:mod-4) #'lime.x11:backend-open-run-prompt)
|
||
(xlib:display-finish-output display)
|
||
(dotimes (i 3)
|
||
;; No event pumping between the trigger and the following keys.
|
||
(shortcut #\p) (text-burst "emo") (tap #xFF0D)
|
||
(pump) (read-client-keys)
|
||
(check (not (lime.x11:backend-command-palette-open-p backend)) "burst Enter launches and closes")
|
||
(check (= (1+ i) (length launched)) "exactly one program launched per burst")
|
||
(check (equal '("emoji-menu") (first launched)) "correct executable selected")
|
||
(check (equal "emo" (first queries)) "first letter and complete query retained")
|
||
(check (null typed) "no characters leaked into old application"))
|
||
(check (= 1 scans) "subsequent opens reuse executable catalog")
|
||
;; Prefix menus use the same safe handoff.
|
||
(lime.x11:bind-key backend #\y '(:mod-4) #'lime.x11:backend-open-command-palette)
|
||
(xlib:display-finish-output display)
|
||
(shortcut #\y) (tap (char-code #\w)) (pump) (read-client-keys)
|
||
(check (equal "Lime › w Windows" (lime.x11::%ui-menu-heading (lime.x11::x11-backend-ui-session backend)))
|
||
"fast which-key prefix retained")
|
||
(check (null typed) "prefix did not reach application")
|
||
(tap #xFF1B) (pump)
|
||
;; Ordinary commands and failures must not leave input frozen.
|
||
(lime.x11:bind-key backend #\n '(:mod-4) (lambda (b) (declare (ignore b)) (incf ordinary)))
|
||
(lime.x11:bind-key backend #\f '(:mod-4) (lambda (b) (declare (ignore b)) (error "expected test failure")))
|
||
(xlib:display-finish-output display)
|
||
(shortcut #\n) (text-burst "a") (pump) (read-client-keys)
|
||
(check (= 1 ordinary) "ordinary shortcut ran")
|
||
(check (equal '(#\a) typed) "ordinary command thawed keyboard")
|
||
(setf typed nil)
|
||
(shortcut #\f) (text-burst "b") (pump) (read-client-keys)
|
||
(check (lime.x11:backend-last-command-error backend) "handler error contained")
|
||
(check (equal '(#\b) typed) "failed command thawed keyboard")
|
||
(setf typed nil (symbol-function 'lime.x11::%make-ui-overlay)
|
||
(lambda (&rest args) (declare (ignore args)) (error "expected overlay failure")))
|
||
(shortcut #\p) (text-burst "c") (pump) (read-client-keys)
|
||
(check (not (lime.x11:backend-command-palette-open-p backend)) "failed opening leaves no session")
|
||
(check (equal '(#\c) typed) "failed opening thawed keyboard")
|
||
(setf (symbol-function 'lime.x11::%make-ui-overlay) original-overlay)
|
||
;; Release/ungrab remains correct after all success/error paths.
|
||
(check (eq :success (xlib:grab-keyboard window)) "another client can grab after cleanup")
|
||
(xlib:ungrab-keyboard clients) (xlib:display-finish-output clients)
|
||
(format t "~&Live X11 launcher smoke: ~D checks passed.~%" checks))))
|
||
(setf (symbol-function 'lime.x11:backend-launch-program) original-launch
|
||
(symbol-function 'lime.x11::%scan-path-program-names) original-scan
|
||
(symbol-function 'lime.x11::%make-ui-overlay) original-overlay)
|
||
(when backend (lime.x11:stop-backend backend))
|
||
(when clients (xlib:close-display clients))
|
||
(uiop:terminate-process server)
|
||
(uiop:wait-process server)))
|
||
(error (condition)
|
||
(format *error-output* "~&Launcher smoke failed: ~A~%" condition)
|
||
(uiop:quit 1)))
|