Initial Lime window manager
This commit is contained in:
175
test/x11-head-send-smoke.lisp
Normal file
175
test/x11-head-send-smoke.lisp
Normal file
@@ -0,0 +1,175 @@
|
||||
;;;; 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)))
|
||||
Reference in New Issue
Block a user