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

85
test/presentation-navigation.lisp Normal file
View File

@@ -0,0 +1,85 @@
(in-package #:lime.test)
(in-suite lime-suite)
(defun make-presentation-navigation-fixture ()
(let ((w (make-world)))
(dolist (id '("left" "right" "third")) (create-head w id))
(dolist (id '("work" "chat" "other")) (create-activity w id id))
(dolist (row '(("browser" "work") ("terminal" "work") ("discord" "chat")
("hidden" "chat") ("shared" "chat")))
(create-client w (first row) (second row)))
(set-client-shared w "shared" t)
(create-view w "work/code" "work" "Code" (placements "browser"))
(create-view w "chat/chat" "chat" "Chat" (placements "discord" "shared"))
(activate-view-strictly w "left" "work/code")
(activate-view-strictly w "right" "chat/chat")
w))
(test portable-arrangement-swaps-preserve-state-and-lease-identity
(let* ((w (make-presentation-navigation-fixture))
(work (current-presentation w "left")) (chat (current-presentation w "right"))
(leases (mapcar (lambda (id) (lease-for-client w id)) '("browser" "discord" "shared")))
(view-before (lime.core::%copy-placements (view-placements (find-view w "chat/chat")))))
(set-presentation-layout-mode w (presentation-id chat) :monocle)
(let ((report (preflight-presentation-bring w "left" (presentation-id chat)))
(before (world-revision w)))
(is (activation-report-ready-p report))
(is (= before (world-revision w))))
(bring-presentation-to-head w (presentation-id chat) "left")
(is (eq chat (current-presentation w "left")))
(is (eq work (current-presentation w "right")))
(is (equal "left" (presentation-head-id chat)))
(is (equal "right" (presentation-head-id work)))
(is (eq :monocle (presentation-layout-mode chat)))
(is (presentation-dirty-p chat))
(is (equalp view-before (view-placements (find-view w "chat/chat"))))
(is (null (lease-for-client w "hidden")))
(loop for id in '("browser" "discord" "shared") for old in leases
do (is (eq old (lease-for-client w id))))
(dotimes (i 20)
(bring-presentation-to-head w (presentation-id chat) (if (evenp i) "right" "left"))
(is (validate-world w)))
(let ((revision (world-revision w)))
(bring-presentation-to-head w (presentation-id chat) "left")
(is (= revision (world-revision w))))))
(test swaps-transpose-cached-extended-portions-without-erasing-them
(let* ((w (make-presentation-navigation-fixture)) (chat (current-presentation w "right"))
(work-left (current-presentation w "left")))
(create-view w "work/logs" "work" "Logs" (placements "terminal"))
(let ((work-right (activate-view-strictly w "right" "work/logs")))
(resume-presentation-strictly w "right" (presentation-id chat))
(bring-presentation-to-head w (presentation-id chat) "left")
(is (eq work-left (current-presentation w "right")))
(is (eq work-right (activity-draft-for-head w "work" "left")))
(is (equal '("terminal") (presentation-client-ids work-right)))
(is (equal "work/logs" (presentation-source-view-id work-right)))
(is (null (lease-for-client w "terminal")))
(is (validate-world w))
(open-activity-draft w "left" "work")
(is (eq work-right (current-presentation w "left")))
(is (validate-world w)))))
(test inactive-portable-return-does-not-change-other-displays-or-recall-missing-slots
(let* ((w (make-presentation-navigation-fixture)) (chat (current-presentation w "right")))
(open-activity-draft w "right" "other")
(let ((other (current-presentation w "right")))
(bring-presentation-to-head w (presentation-id chat) "left")
(is (eq other (current-presentation w "right")))
(is (eq chat (current-presentation w "left")))
(is (null (lease-for-client w "browser")))
(is (null (lease-for-client w "hidden")))
(is (validate-world w)))
(let ((before (world-revision w)))
(signals stale-transition-plan
(bring-presentation-to-head w (presentation-id chat) "third" :expected-revision (1- before)))
(signals unknown-entity (bring-presentation-to-head w (presentation-id chat) "missing"))
(is (= before (world-revision w))))
;; A topology-suspended arrangement is still portable.
(commit-head-topology-reconciliation-plan w
(build-head-topology-reconciliation-plan
(preflight-head-topology-reconciliation w '("right" "third"))))
(is (null (presentation-head-id chat)))
(bring-presentation-to-head w (presentation-id chat) "third")
(is (eq chat (current-presentation w "third")))
(is (validate-world w))))