;;;; 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)))