;;;; Physical key grabs and clickable confirmation on our own Xvfb only. (require :asdf) (asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*))) (asdf:load-system "lime/x11") (lime.config:defconfiguration head-send-smoke-config (:command send-window :label "Send window" :action (lambda (backend) (lime.x11:backend-send-focused-client-relatively backend :next))) (:bind #\e send-window :modifiers '(:mod-4 :shift))) (let ((server (uiop:launch-program '("Xvfb" "-displayfd" "1" "-screen" "0" "1200x622x24" "-nolisten" "tcp") :output :stream :error-output :interactive)) (backend nil) (clients nil) (checks 0)) (unwind-protect (let* ((number (parse-integer (read-line (uiop:process-info-output server)))) (display-name (format nil ":~D" number)) (heads (list (lime.x11:make-x11-head :head-id "left" :x 0 :y 0 :width 600 :height 622) (lime.x11:make-x11-head :head-id "right" :x 600 :y 0 :width 600 :height 622)))) (setf backend (lime.x11:start-lime :display-name display-name :heads heads :install-default-keybindings-p nil) clients (xlib:open-default-display display-name)) (lime.x11:apply-lime-configuration backend head-send-smoke-config) (labels ((check (truth label) (assert truth () "Head send: ~A" label) (incf checks)) (world () (lime.x11:x11-backend-world backend)) (current (head) (lime.core:current-presentation (world) head)) (session () (lime.x11::x11-backend-ui-session backend)) (pump () (xlib:display-finish-output clients) (let ((turns 0) (display (lime.x11::x11-backend-display backend))) (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 &optional modified-p) (let* ((display (lime.x11::x11-backend-display backend)) (super (first (nth-value 6 (xlib:modifier-mapping display)))) (shift (first (nth-value 0 (xlib:modifier-mapping display)))) (key (xlib:keysym->keycodes display keysym))) (assert key) (when modified-p (xlib/xtest:fake-key-event clients super t) (xlib/xtest:fake-key-event clients shift t)) (xlib/xtest:fake-key-event clients key t) (xlib/xtest:fake-key-event clients key nil) (when modified-p (xlib/xtest:fake-key-event clients shift nil) (xlib/xtest:fake-key-event clients super nil)) (pump))) (spawn () (let ((window (xlib:create-window :parent (xlib:screen-root (xlib:display-default-screen clients)) :x 30 :y 30 :width 120 :height 120))) (xlib:map-window window) (pump) (values window (lime.x11::%backend-client-id backend window)))) (lease-head (id) (lime.x11::ewmh-active-head-id-for-client backend id)) (choose (id) (let ((candidate (find id (lime.ui:ui-session-candidates (session)) :key #'lime.ui:ui-candidate-id :test #'equal))) (check candidate "choice present") (lime.x11::%perform-ui-action backend (list :candidate candidate)) (pump)))) (lime.x11:backend-start-activity backend "work" "Work") (lime.x11:backend-start-activity backend "chill" "Chill" :head-id "right") (lime.x11:backend-select-head backend "left") (multiple-value-bind (a aid) (spawn) (multiple-value-bind (b bid) (spawn) (lime.x11:backend-save-view backend "code" "Code") (lime.x11:backend-select-head backend "right") (multiple-value-bind (c cid) (spawn) (lime.x11:backend-use-monocle-layout backend) (lime.x11:backend-save-view backend "chat" "Chat") (lime.x11:backend-select-head backend "left") (pump) (let ((before (lime.persistence:snapshot-world (world)))) (tap (char-code #\e) t) (check (session) "Super-Shift-e opens confirmation") (check (equal "left" (lime.x11::x11-ui-overlay-head-id (lime.x11::x11-backend-ui-overlay backend))) "confirmation is on source Head") (check (< (lime.x11::x11-ui-overlay-height (lime.x11::x11-backend-ui-overlay backend)) 220) "two-choice dropdown stays compact") (check (eq :cancel (lime.ui:ui-candidate-id (lime.ui:ui-session-selected-candidate (session)))) "default is Cancel") (check (search "saved views" (lime.ui:ui-candidate-detail (lime.ui:ui-session-selected-candidate (session)))) "warning visible on default choice") (check (equalp before (lime.persistence:snapshot-world (world))) "opening is read-only") (tap #xFF0D) (check (not (session)) "Enter cancels by default") (check (equalp before (lime.persistence:snapshot-world (world))) "cancel leaves desk untouched") (check (equal "left" (lime.x11:x11-backend-focused-head-id backend)) "cancel keeps source Head selected") (check (= (xlib:window-id b) (xlib:window-id (xlib:input-focus clients))) "cancel preserves real focus")) ;; Configured command search returns a transition into the ;; existing overlay, rather than opening then closing itself. (lime.x11:backend-open-command-palette backend) (tap (char-code #\Space)) (choose '(:configured-command send-window)) (check (session) "configured search action keeps confirmation open") (tap #xFF1B) ;; The which-key path shares the same action and click regions. (lime.x11:backend-open-command-palette backend) (tap (char-code #\h)) (tap (char-code #\s)) (check (session) "h s opens confirmation") (let* ((overlay (lime.x11::x11-backend-ui-overlay backend)) (candidate (second (lime.ui:ui-session-candidates (session)))) (region (find (list :candidate candidate) (lime.x11::x11-ui-overlay-hit-regions overlay) :key #'lime.x11::ui-hit-region-action :test #'equal))) (check region "Move is clickable") (xlib/xtest:fake-motion-event clients (+ (xlib:drawable-x (lime.x11::x11-ui-overlay-window overlay)) (lime.x11::ui-hit-region-x region) 10) (+ (xlib:drawable-y (lime.x11::x11-ui-overlay-window overlay)) (lime.x11::ui-hit-region-y region) 5)) (pump) (xlib/xtest:fake-button-event clients 1 t) (xlib/xtest:fake-button-event clients 1 nil) (pump)) (check (not (session)) "click confirms and closes dropdown") (check (equal "chill" (lime.core:client-activity-id (lime.core:find-client (world) bid))) "home changed") (check (equal "right" (lease-head bid)) "one destination lease") (check (equal "work" (lime.core:presentation-activity-id (current "left"))) "source Activity unchanged") (check (equal "chill" (lime.core:presentation-activity-id (current "right"))) "destination Activity unchanged") (check (equal "right" (lime.x11:x11-backend-focused-head-id backend)) "keyboard Head follows confirmed move") (check (= (xlib:window-id b) (xlib:window-id (xlib:input-focus clients))) "sent client gets actual X focus") (check (equal aid (lime.core:presentation-focus-client-id (current "left"))) "source remembers survivor") (check (eq :viewable (xlib:window-map-state b)) "sent window visible in monocle") (check (eq :unmapped (xlib:window-map-state c)) "previous monocle client stays in cycle but is not shown") (check (>= (xlib:drawable-x b) 600) "real window moved right") (check (equal (list aid) (mapcar #'lime.core:placement-client-id (lime.core:view-placements (lime.core:find-view (world) "code")))) "old checkpoint pruned") (check (equal (list cid) (mapcar #'lime.core:placement-client-id (lime.core:view-placements (lime.core:find-view (world) "chat")))) "destination checkpoint not overwritten") ;; Same Activity: immediate transfer, no confirmation. (lime.x11:backend-extend-activity-to-head backend "chill" "left") (lime.x11:backend-select-head backend "right") (tap (char-code #\e) t) (check (not (session)) "same Activity sends immediately") (check (equal "left" (lease-head bid)) "same-Activity transfer moves lease") (check (equal "left" (lime.x11:x11-backend-focused-head-id backend)) "same-Activity focus follows") (check (= (xlib:window-id b) (xlib:window-id (xlib:input-focus clients))) "same-Activity real focus follows") ;; Repeat the binding directly: no separate Head focus command. (tap (char-code #\e) t) (check (equal "right" (lease-head bid)) "repeated shortcut sends same client back") (check (equal "right" (lime.x11:x11-backend-focused-head-id backend)) "repeated shortcut follows back") (check (= (xlib:window-id b) (xlib:window-id (xlib:input-focus clients))) "repeated shortcut keeps real focus") (tap (char-code #\e) t) (check (equal "left" (lease-head bid)) "third shortcut still targets same client") ;; Shared float crosses back to Work without rehoming. (lime.x11:backend-switch-to-activity backend "work" :head-id "right") (lime.x11:backend-select-head backend "left") (lime.x11:backend-set-client-shared backend bid t) (lime.x11:backend-toggle-focused-client-floating backend) (let ((data (copy-tree (lime.core:placement-data (find bid (lime.core:presentation-placements (current "left")) :key #'lime.core:placement-client-id :test #'equal))))) (tap (char-code #\e) t) (check (not (session)) "shared cross-Activity send is immediate") (check (equal "right" (lease-head bid)) "shared lease moved") (check (equal "right" (lime.x11:x11-backend-focused-head-id backend)) "shared floating move follows") (check (= (xlib:window-id b) (xlib:window-id (xlib:input-focus clients))) "shared float gets real focus") (check (equal "chill" (lime.core:client-activity-id (lime.core:find-client (world) bid))) "shared home unchanged") (check (equal data (lime.core:placement-data (find bid (lime.core:presentation-placements (current "right")) :key #'lime.core:placement-client-id :test #'equal))) "normalized floating geometry retained")) (multiple-value-bind (d did) (spawn) (check (equal "right" (lease-head did)) "new window routes to followed Head") (check (equal "work" (lime.core:client-activity-id (lime.core:find-client (world) did))) "new window belongs to followed Activity") (check (= (xlib:window-id d) (xlib:window-id (xlib:input-focus clients))) "new window focuses on destination")) (check (lime.core:validate-world (world)) "world valid after all moves") (check (null (lime.x11::x11-backend-last-command-error backend)) "no command errors") (format t "~&Live X11 Head-send smoke: ~D checks passed.~%" checks)))))) (when backend (lime.x11:stop-backend backend)) (when clients (xlib:close-display clients)) (uiop:terminate-process server) (uiop:wait-process server)))