;;;; Real numeric key grabs, lease prompts, and restart persistence on OWN Xvfb. (require :asdf) (asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*))) (asdf:load-system "lime/x11") (lime.config:defconfiguration navigation-smoke-config (:navigation-keys)) (handler-case (let* ((directory (uiop:ensure-directory-pathname (string-trim '(#\Newline) (uiop:run-program '("mktemp" "-d" "/tmp/lime-navigation-XXXXXX") :output :string)))) (path (merge-pathnames "session.sexp" directory)) (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 clients (xlib:open-default-display display-name)) (labels ((check (truth label) (assert truth () "Navigation: ~A" label) (incf checks)) (world () (lime.x11:x11-backend-world backend)) (current (&optional (head "left")) (lime.core:current-presentation (world) head)) (activity () (lime.core:presentation-activity-id (current))) (view () (lime.core:presentation-source-view-id (current))) (session () (lime.x11::x11-backend-ui-session backend)) (start () (setf backend (lime.x11:start-lime :display-name display-name :heads heads :install-default-keybindings-p nil :session-file path)) (lime.x11:apply-lime-configuration backend navigation-smoke-config)) (stop () (lime.x11:stop-backend backend) (setf backend nil)) (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) () "Navigation 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 (number &optional shift-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 (+ (char-code #\0) (mod number 10))))) (check (and super shift key) "physical modifier and digit keycodes found") (xlib/xtest:fake-key-event clients super t) (when shift-p (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 shift-p (xlib/xtest:fake-key-event clients shift nil)) (xlib/xtest:fake-key-event clients super nil) (pump))) (choose (id) (let ((candidate (find id (lime.ui:ui-session-candidates (session)) :key #'lime.ui:ui-candidate-id :test #'equal))) (check candidate (format nil "collision choice ~S exists" id)) (lime.x11::%perform-ui-action backend (list :candidate candidate))) (pump)) (click-region (head region) (let* ((bar (gethash head (lime.x11::x11-backend-head-bars backend))) (window (lime.x11::x11-head-bar-window bar))) (xlib/xtest:fake-motion-event clients (+ (xlib:drawable-x window) (floor (+ (lime.x11::x11-head-bar-hit-region-left region) (lime.x11::x11-head-bar-hit-region-right region)) 2)) (+ (xlib:drawable-y window) 10)) (pump) (check (lime.x11::x11-head-bar-pointer-hand-p bar) "activity target has hand cursor") (xlib/xtest:fake-button-event clients 1 t) (xlib/xtest:fake-button-event clients 1 nil) (pump))) (click-activity (head id) (let* ((bar (gethash head (lime.x11::x11-backend-head-bars backend))) (entries (lime.x11::%bar-activity-entries backend head)) (index (position id entries :key (lambda (e) (getf e :id)) :test #'equal)) (region (nth (1+ index) (lime.x11::x11-head-bar-hit-regions bar)))) ;; This fixture has only two entries at this point; no ;; clipping/overflow is allowed to hide a wrong target. (check (= (- (lime.x11::x11-head-bar-hit-region-right region) (lime.x11::x11-head-bar-hit-region-left region)) (lime.x11::%text-width (lime.x11::x11-head-bar-font bar) (getf (nth index entries) :text))) "click region matches entire measured Activity label") (click-region head region))) (spawn () (let ((window (xlib:create-window :parent (xlib:screen-root (xlib:display-default-screen clients)) :x 0 :y 0 :width 100 :height 100))) (xlib:map-window window) (pump) (lime.x11::%backend-client-id backend window)))) (start) (lime.x11:backend-select-head backend "left") (let ((right-id (lime.core:presentation-id (current "right")))) (check (= 1 (lime.x11:backend-activity-slot backend "scratch")) "Scratch starts at 1") (lime.x11:backend-start-activity backend "work" "Work") (let* ((a (spawn)) (code (lime.x11:backend-save-named-view backend "Code")) (code-id (lime.core:presentation-source-view-id code)) (b (spawn)) (dirty-id (lime.core:presentation-id (current)))) (lime.core:create-view (world) "work/docs" "work" "Docs" (list (lime.core:make-placement :client-id b))) (lime.x11:backend-set-view-slot backend "work/docs" 3) (check (lime.core:presentation-dirty-p (current)) "Code has unsaved new window") (lime.x11:backend-start-activity backend "chill" "Chill") (lime.x11:backend-save-named-view backend "Play") (tap 2) (check (equal "work" (activity)) "Super-2 selects Work") (check (equal dirty-id (lime.core:presentation-id (current))) "returns to identical dirty presentation") (check (equal code-id (view)) "Activity return preserves selected View") (check (member b (lime.core:presentation-client-ids (current)) :test #'equal) "unsaved window retained") (check (equal right-id (lime.core:presentation-id (current "right"))) "other Head unchanged") (check (not (session)) "successful switch has no menu") (let ((before (lime.persistence:snapshot-world (world)))) (tap 2) (tap 1 t) (check (equalp before (lime.persistence:snapshot-world (world))) "current Activity/View keys do not reset edits")) (tap 3 t) (check (equal "work/docs" (view)) "Super-Shift-3 recalls local Docs") (check (equal (list b) (lime.core:presentation-client-ids (current))) "checkpoint contents recalled") (tap 3) (tap 1 t) (check (equal "chill" (activity)) "same shifted number stays in Chill") (check (equal "Play" (lime.core:view-name (lime.core:find-view (world) (view)))) "local 1 means Chill's Play") (lime.x11:backend-set-activity-slot backend "work" 3) (lime.x11:backend-set-view-slot backend code-id 10) (tap 3) (tap 10 t) (check (equal code-id (view)) "Super-3 follows Activity order; Super-Shift-0 uses stable View slot 10") ;; A distinct View containing A may hold the lease on right. (lime.core:create-view (world) "work/right" "work" "Right" (list (lime.core:make-placement :client-id a))) (lime.x11:backend-extend-activity-to-head backend "work" "right") (lime.x11:backend-activate-view backend "work/right" :head-id "right" :policy :take) (tap 3 t) (let ((before (lime.persistence:snapshot-world (world)))) (tap 10 t) (check (session) "contested checkpoint opens conflict picker") (check (equalp before (lime.persistence:snapshot-world (world))) "conflict does not steal or mutate") (choose :cancel) (check (equalp before (lime.persistence:snapshot-world (world))) "cancel leaves both Heads alone")) (tap 10 t) (choose (list :activate-partially code-id)) (check (member a (lime.core:presentation-unavailable-client-ids (current)) :test #'equal) "partial recall leaves leased window elsewhere") ;; Activity return keeps current locations, not omitted View requests. (tap 2) (tap 3) (check (not (session)) "Activity resume needs no conflict menu") (check (null (lime.core:presentation-client-ids (current))) "partial arrangement stays empty") (check (equal "right" (lime.x11::ewmh-active-head-id-for-client backend a)) "Activity resume leaves other Head's window alone") ;; Recalling the saved checkpoint is a distinct, explicit restore. (tap 3 t) (tap 10 t) (choose (list :activate-taking code-id)) (check (equal "left" (lime.x11::ewmh-active-head-id-for-client backend a)) "explicit take moves one lease") (check (null (lime.core:presentation-client-ids (current "right"))) "source no longer retains a claim") (lime.core:set-presentation-layout-mode (world) (lime.core:presentation-id (current)) :monocle) (lime.x11:apply-active-presentation backend) ;; Never mount the SAME View on two Heads, even empty/partial. (lime.x11:backend-select-head backend "right") (lime.x11:backend-select-view-slot backend 10) (check (session) "already-mounted View gives visible explanation") (check (search "already open" (lime.ui:ui-session-status (session))) "mount conflict explained") (lime.x11:backend-close-command-palette backend) (lime.x11:backend-select-head backend "left") (check (equal "Work" (lime.x11::%bar-presentation-label backend "left")) "bar shows Activity without checkpoint suffix") (check (lime.core:presentation-dirty-p (current)) "bar does not clear dirty edits") (let ((slots (lime.x11:backend-navigation-slots backend))) (lime.x11:backend-save-session backend) (stop) (start) (pump) (check (not (getf (lime.x11:backend-session-status backend) :blocked-p)) "new session schema restores") (check (equal slots (lime.x11:backend-navigation-slots backend)) "slot assignments survive restart") (tap 2) (tap 3) (check (equal code-id (view)) "last View resumes after restart") (check (equal "Work" (lime.x11::%bar-presentation-label backend "left")) "Activity-only bar survives persistence") (check (lime.core:presentation-dirty-p (current)) "dirty edits survive navigation and persistence")) (lime.x11:backend-switch-to-activity backend "scratch") (lime.x11:backend-delete-activity backend "chill") (check (= 2 (lime.x11:backend-activity-slot backend "work")) "deleting the middle Activity shifts Work to position 2") (tap 2) (check (equal "work" (activity)) "Super-2 now selects the second Activity") (check (= 10 (lime.x11:backend-view-slot backend code-id)) "Activity compaction leaves View slots alone") (let ((slots (lime.x11:backend-navigation-slots backend))) (lime.x11:backend-save-session backend) (stop) (start) (pump) (check (equal slots (lime.x11:backend-navigation-slots backend)) "compacted order survives restart")) (lime.x11:backend-start-activity backend "game" "A new Game") (check (= 3 (lime.x11:backend-activity-slot backend "game")) "new Activity appends even with an earlier alphabetical name") (tap 2) (tap 3) (check (equal "game" (activity)) "Super-3 selects newly appended Activity") (tap 2) (lime.x11:backend-delete-activity backend "game") (check (null (lime.x11::x11-backend-last-command-error backend)) "no key dispatch errors") (check (lime.core:validate-world (world)) "world invariants hold") ;; Actual pointer events use the clicked Head, restore its ;; dirty arrangement, and preserve the other Head's state. (let ((right-id (lime.core:presentation-id (current "right")))) (click-activity "left" "work") (check (equal "work" (activity)) "bar click resumes Work") (check (equal code-id (view)) "bar click restores dirty Code") (check (equal right-id (lime.core:presentation-id (current "right"))) "bar does not switch other Head") (let ((before (lime.persistence:snapshot-world (world)))) (click-activity "left" "work") (check (equalp before (lime.persistence:snapshot-world (world))) "active tab click does not reset checkpoint") (check (not (eq :pointer-root (xlib:input-focus clients))) "active tab restores client input focus"))) (click-activity "right" "scratch") (check (equal "right" (lime.x11:x11-backend-focused-head-id backend)) "offset right bar selects right Head") (check (equal "scratch" (lime.core:presentation-activity-id (current "right"))) "right tab switches only right Activity") (let ((left-id (lime.core:presentation-id (current)))) (click-activity "right" "work") (check (not (session)) "bar return has no stale lease conflict") (check (null (lime.core:presentation-client-ids (current "right"))) "moved window is absent from old layout") (check (equal left-id (lime.core:presentation-id (current))) "bar return leaves other activity unchanged") (check (equal "left" (lime.x11::ewmh-active-head-id-for-client backend a)) "bar return does not reclaim moved window")) (lime.x11:backend-select-head backend "left") ;; Simulate a session produced before navigation existed. (stop) (let ((store (lime.persistence:open-session-store path))) (unwind-protect (let ((data (lime.persistence:read-session-store store))) (remf data :navigation) (remf data :activity-navigation) (setf (getf data :version) 1) (lime.persistence:write-session-store store data)) (lime.persistence:close-session-store store))) (start) (pump) (check (not (getf (lime.x11:backend-session-status backend) :blocked-p)) "legacy session migrates") (check (= 1 (lime.x11:backend-activity-slot backend "scratch")) "legacy Scratch gets first slot") (check (= 2 (lime.x11:backend-activity-slot backend "work")) "legacy remaining Activity gets second position") (check (= 2 (hash-table-count (lime.x11::x11-backend-client-windows backend))) "migration reconnects real windows") ;; Many long names must not push the active tab off the bar. (dotimes (n 15) (lime.core:create-activity (world) (format nil "extra~D" n) (format nil "Long extra activity ~D" n))) (lime.x11::apply-active-presentation backend) (pump) (let ((tenth (first (nth 9 (getf (lime.x11:backend-navigation-slots backend) :activities))))) (tap 10) (check (equal tenth (activity)) "Super-0 still selects position 10 with many Activities") (tap 2)) (let* ((bar (gethash "left" (lime.x11::x11-backend-head-bars backend))) (regions (lime.x11::x11-head-bar-hit-regions bar)) (overflow (nth (- (length regions) 2) regions))) (check (= (lime.x11::%text-width (lime.x11::x11-head-bar-font bar) "…") (- (lime.x11::x11-head-bar-hit-region-right overflow) (lime.x11::x11-head-bar-hit-region-left overflow))) "overflow gets its own measured target") (click-region "left" overflow) (check (every (lambda (c) (eq :activity (first (lime.ui:ui-candidate-id c)))) (lime.ui:ui-session-candidates (session))) "overflow shows only Activities") (check (= 17 (length (lime.ui:ui-session-candidates (session)))) "overflow retains all Activities") (choose '(:activity "extra14")) (check (equal "extra14" (activity)) "overflow can reach clipped Activity")) (check (null (lime.x11::x11-backend-last-command-error backend)) "bar navigation has no errors") (format t "~&Navigation smoke: ~D checks passed.~%" checks))))) (when backend (ignore-errors (lime.x11:stop-backend backend))) (when clients (ignore-errors (xlib:close-display clients :abort t))) (uiop:terminate-process server) (uiop:wait-process server))) (error (condition) (format *error-output* "~&Navigation smoke failed: ~A~%" condition) (uiop:quit 1)))