gansito05/lime
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Lime window manager

Browse Source
This commit is contained in:
Adan
2026-10-02 14:14:47 -05:00
commit 785c2e8968
103 changed files with 27259 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

261
test/x11-navigation-smoke.lisp Normal file
View File

@@ -0,0 +1,261 @@
;;;; 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)))