956 lines
49 KiB
Common Lisp
956 lines
49 KiB
Common Lisp
(in-package #:lime.test)
|
|
|
|
(def-suite lime-suite
|
|
:description "Lime's Activity/View/Head/Lease model.")
|
|
|
|
(in-suite lime-suite)
|
|
|
|
(defun placements (&rest client-ids)
|
|
(mapcar (lambda (client-id)
|
|
(make-placement :client-id client-id))
|
|
client-ids))
|
|
|
|
(defun make-fixture ()
|
|
(let ((world (make-world)))
|
|
(create-head world "left")
|
|
(create-head world "right")
|
|
(create-activity world "lime" "Lime development")
|
|
(create-activity world "game" "Game")
|
|
(create-client world "emacs" "lime" :name "Emacs")
|
|
(create-client world "terminal" "lime" :name "Terminal")
|
|
(create-client world "firefox" "lime" :name "Firefox")
|
|
(create-client world "game-client" "game" :name "Game")
|
|
(create-view world "code" "lime" "Code"
|
|
(placements "emacs" "terminal")
|
|
:focus-client-id "emacs")
|
|
(create-view world "docs" "lime" "Docs"
|
|
(placements "firefox" "emacs")
|
|
:focus-client-id "firefox")
|
|
(create-view world "browser" "lime" "Browser"
|
|
(placements "firefox")
|
|
:focus-client-id "firefox")
|
|
(create-view world "play" "game" "Play"
|
|
(placements "game-client"))
|
|
world))
|
|
|
|
(defun lease-head-id (world client-id)
|
|
(let ((lease (lease-for-client world client-id)))
|
|
(and lease
|
|
(presentation-head-id
|
|
(find-presentation world (lease-presentation-id lease))))))
|
|
|
|
(test views-respect-activity-ownership
|
|
(let ((world (make-fixture)))
|
|
(signals invalid-activity-membership
|
|
(create-view world "bad" "lime" "Bad"
|
|
(placements "game-client")))))
|
|
|
|
(test an-activity-needs-no-saved-view-to-own-live-head-local-drafts
|
|
(let ((world (make-world)))
|
|
(create-head world "left")
|
|
(create-head world "right")
|
|
(create-activity world "scratch" "Scratch")
|
|
(let ((left (open-activity-draft world "left" "scratch"))
|
|
(right (open-activity-draft world "right" "scratch")))
|
|
(is-false (presentation-source-view-id left))
|
|
(is-false (presentation-source-view-id right))
|
|
(is (eq left (activity-draft-for-head world "scratch" "left")))
|
|
(is (eq right (activity-draft-for-head world "scratch" "right")))
|
|
;; Reopening an Activity resumes its one draft on that Head rather than
|
|
;; inventing a blank checkpoint or a second draft.
|
|
(is (eq left (open-activity-draft world "left" "scratch")))
|
|
(is-false (activity-view-ids (find-activity world "scratch")))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test a-default-layout-only-initializes-new-drafts
|
|
(dolist (mode '(:manual :master-stack :monocle))
|
|
(let ((world (make-world)))
|
|
(create-head world "left")
|
|
(create-head world "right")
|
|
(create-activity world "work" "Work")
|
|
(let* ((revision (world-revision world))
|
|
(report (preflight-activity-draft world "left" "work" :default-layout mode)))
|
|
(is (eq mode (activation-report-desired-layout-mode report)))
|
|
(is (= revision (world-revision world)))
|
|
(is-false (activity-draft-for-head world "work" "left")))
|
|
(let ((draft (open-activity-draft world "left" "work" :default-layout mode)))
|
|
(is (eq mode (presentation-layout-mode draft)))
|
|
(when (eq mode :master-stack)
|
|
(is (equal '(:master-count 1 :master-ratio 3/5 :orientation :horizontal)
|
|
(presentation-layout-options draft))))
|
|
(is-false (presentation-dirty-p draft))
|
|
(set-presentation-monocle-layout world (presentation-id draft))
|
|
(is (eq draft (open-activity-draft world "left" "work" :default-layout :master-stack)))
|
|
(is (eq :monocle (presentation-layout-mode draft)))
|
|
(is (eq :monocle
|
|
(activation-report-desired-layout-mode
|
|
(preflight-activity-draft world "left" "work" :default-layout :manual))))
|
|
(is (eq mode (presentation-layout-mode
|
|
(open-activity-draft world "right" "work" :default-layout mode))))
|
|
(is-true (validate-world world))
|
|
(let ((revision (world-revision world)))
|
|
(signals invalid-transition
|
|
(open-activity-draft world "left" "work" :default-layout :bogus))
|
|
(is (= revision (world-revision world))))))))
|
|
|
|
(test hiding-is-a-head-local-draft-edit-and-showing-restores-the-activity-client
|
|
(let ((world (make-fixture)))
|
|
(let ((presentation (activate-view-strictly world "left" "code")))
|
|
;; A saved View is a checkpoint, not the mutable list of every client
|
|
;; owned by its Activity. Firefox begins parked for this Code draft.
|
|
(is (equal (presentation-hidden-client-ids world presentation)
|
|
'("firefox")))
|
|
(hide-focused-client-in-presentation world (presentation-id presentation))
|
|
;; Hiding Emacs edits only this draft. It releases the real lease and
|
|
;; moves focus to Terminal, while the Activity and original Code View
|
|
;; remain intact for later recall.
|
|
(is (equal (presentation-client-ids presentation) '("terminal")))
|
|
(is (equal (presentation-hidden-client-ids world presentation)
|
|
'("emacs" "firefox")))
|
|
(is-false (lease-for-client world "emacs"))
|
|
(is (equal (presentation-focus-client-id presentation) "terminal"))
|
|
(is (equal (mapcar #'placement-client-id
|
|
(view-placements (find-view world "code")))
|
|
'("emacs" "terminal")))
|
|
(is-true (presentation-dirty-p presentation))
|
|
;; Revealing puts the client back in the live draft and acquires a
|
|
;; lease. It never changes the older saved checkpoint implicitly.
|
|
(show-client-on-presentation world "emacs" (presentation-id presentation))
|
|
(focus-client-on-presentation world "emacs" (presentation-id presentation))
|
|
(is (equal (presentation-client-ids presentation) '("terminal" "emacs")))
|
|
(is (equal (presentation-hidden-client-ids world presentation)
|
|
'("firefox")))
|
|
(is (equal (lease-head-id world "emacs") "left"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test view-names-are-unique-within-an-activity-but-not-globally
|
|
(let ((world (make-world)))
|
|
(create-activity world "work" "Work")
|
|
(create-activity world "chill" "Chill")
|
|
(create-view world "work/code" "work" "Code" '())
|
|
(signals invalid-transition
|
|
(create-view world "work/code-2" "work" "code" '()))
|
|
(create-view world "chill/code" "chill" "Code" '())
|
|
(is-true (validate-world world))))
|
|
|
|
(test distinct-views-of-one-activity-can-share-the-desktop
|
|
(let ((world (make-fixture)))
|
|
(activate-view-strictly world "left" "code")
|
|
(let ((right (activate-view-strictly world "right" "browser")))
|
|
(is (equal (presentation-source-view-id right) "browser"))
|
|
(is (equal (lease-head-id world "emacs") "left"))
|
|
(is (equal (lease-head-id world "firefox") "right"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test strict-preflight-is-read-only-and-reports-a-client-collision
|
|
(let ((world (make-fixture)))
|
|
(activate-view-strictly world "left" "code")
|
|
(let ((report (preflight-view-activation world "right" "docs")))
|
|
(is-false (activation-report-ready-p report))
|
|
(is (find :client-leased
|
|
(activation-report-conflicts report)
|
|
:key #'activation-conflict-kind))
|
|
(signals activation-blocked
|
|
(build-strict-activation-plan report))
|
|
(is (equal (lease-head-id world "emacs") "left"))
|
|
(is-false (current-presentation world "right")))))
|
|
|
|
(test partial-activation-preserves-the-incumbent-lease
|
|
(let ((world (make-fixture)))
|
|
(activate-view-strictly world "left" "code")
|
|
(let ((right (activate-view-partially world "right" "docs")))
|
|
(is (equal (presentation-leased-client-ids world right)
|
|
'("firefox")))
|
|
(is (member "emacs" (presentation-unavailable-client-ids right)
|
|
:test #'equal))
|
|
(is (equal (lease-head-id world "emacs") "left"))
|
|
(is (equal (lease-head-id world "firefox") "right"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test taking-a-client-relocates-only-the-live-placement
|
|
(let ((world (make-fixture)))
|
|
(let ((left (activate-view-strictly world "left" "code")))
|
|
(activate-view-taking world "right" "docs")
|
|
(is (equal (lease-head-id world "emacs") "right"))
|
|
(is-false (presentation-unavailable-client-ids left))
|
|
(is (equal (presentation-client-ids left) '("terminal")))
|
|
(is (equal (mapcar #'placement-client-id
|
|
(view-placements (find-view world "code")))
|
|
'("emacs" "terminal")))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test an-explicit-lease-transfer-is-a-general-command
|
|
(let ((world (make-fixture)))
|
|
(let ((left (activate-view-strictly world "left" "code"))
|
|
(right (activate-view-partially world "right" "docs")))
|
|
(transfer-client-lease world "emacs" (presentation-id right))
|
|
(is (equal (lease-head-id world "emacs") "right"))
|
|
(is-false (member "emacs" (presentation-client-ids left) :test #'equal))
|
|
(is-false (member "emacs" (presentation-unavailable-client-ids right)
|
|
:test #'equal))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test reclaiming-is-explicit-after-a-lease-becomes-free
|
|
(let ((world (make-fixture)))
|
|
(activate-view-strictly world "left" "code")
|
|
(let ((right (activate-view-partially world "right" "docs")))
|
|
;; Switching the left Head away releases Emacs. It does not
|
|
;; spontaneously appear on the right until the user asks to reclaim it.
|
|
(activate-view-strictly world "left" "play")
|
|
(is-false (lease-for-client world "emacs"))
|
|
(is (equal (reclaim-available-slots world (presentation-id right))
|
|
'("emacs")))
|
|
(is (equal (lease-head-id world "emacs") "right"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test a-named-view-cannot-be-mounted-twice
|
|
(let ((world (make-fixture)))
|
|
(activate-view-strictly world "left" "code")
|
|
(let ((report (preflight-view-activation world "right" "code")))
|
|
(is (find :view-mounted
|
|
(activation-report-conflicts report)
|
|
:key #'activation-conflict-kind))
|
|
(signals activation-blocked
|
|
(build-partial-activation-plan report)))))
|
|
|
|
(test viewsets-swap-heads-as-one-atomic-activation
|
|
(let ((world (make-fixture)))
|
|
(activate-view-strictly world "left" "code")
|
|
(activate-view-strictly world "right" "play")
|
|
(create-viewset
|
|
world "after-work" "After work"
|
|
(list (make-viewset-entry :head-id "left" :view-id "play")
|
|
(make-viewset-entry :head-id "right" :view-id "code")))
|
|
;; Each incoming View is currently mounted on the other target Head. A
|
|
;; pair of ordinary one-Head commands would reject that intermediate state;
|
|
;; a Viewset recognizes both old Presentations as one outgoing group.
|
|
(let* ((report (preflight-viewset-activation world "after-work"))
|
|
(result (commit-viewset-plan world (build-strict-viewset-plan report))))
|
|
(is-true (viewset-report-ready-p report))
|
|
(is (equal (presentation-source-view-id
|
|
(current-presentation world "left"))
|
|
"play"))
|
|
(is (equal (presentation-source-view-id
|
|
(current-presentation world "right"))
|
|
"code"))
|
|
(is (equal (lease-head-id world "game-client") "left"))
|
|
(is (equal (lease-head-id world "emacs") "right"))
|
|
(is (equal (mapcar #'car (viewset-result-presentation-ids result))
|
|
'("left" "right")))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test viewsets-reuse-the-explicit-partial-and-take-lease-policies
|
|
(let ((world (make-fixture)))
|
|
(activate-view-strictly world "left" "browser")
|
|
(let ((right (activate-view-strictly world "right" "code")))
|
|
(create-viewset
|
|
world "docs-left" "Docs on left"
|
|
(list (make-viewset-entry :head-id "left" :view-id "docs")))
|
|
(let ((report (preflight-viewset-activation world "docs-left")))
|
|
(is-false (viewset-report-ready-p report))
|
|
(is (find :client-leased (viewset-report-conflicts report)
|
|
:key #'viewset-conflict-kind))
|
|
(let ((result (commit-viewset-plan world
|
|
(build-partial-viewset-plan report))))
|
|
(declare (ignore result))
|
|
(is (equal (presentation-leased-client-ids
|
|
world (current-presentation world "left"))
|
|
'("firefox")))
|
|
(is (member "emacs"
|
|
(presentation-unavailable-client-ids
|
|
(current-presentation world "left"))
|
|
:test #'equal))
|
|
(is (equal (lease-head-id world "emacs") "right"))))
|
|
;; Recalling the same Viewset with :TAKE is a second deliberate command:
|
|
;; it moves only the contested Emacs lease and degrades the incumbent.
|
|
(commit-viewset-plan
|
|
world (build-taking-viewset-plan
|
|
(preflight-viewset-activation world "docs-left")))
|
|
(is (equal (lease-head-id world "emacs") "left"))
|
|
(is-false (member "emacs" (presentation-client-ids right) :test #'equal))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test viewset-plans-reject-internal-window-duplication-and-staleness
|
|
(let ((world (make-fixture)))
|
|
(create-viewset
|
|
world "bad-combination" "Bad combination"
|
|
(list (make-viewset-entry :head-id "left" :view-id "code")
|
|
;; Code and Docs both request Emacs. A Viewset cannot pick one
|
|
;; merely because its entry happened to come first.
|
|
(make-viewset-entry :head-id "right" :view-id "docs")))
|
|
(let ((report (preflight-viewset-activation world "bad-combination")))
|
|
(is (find :client-requested (viewset-report-conflicts report)
|
|
:key #'viewset-conflict-kind))
|
|
(signals activation-blocked (build-partial-viewset-plan report))
|
|
(is-false (current-presentation world "left"))
|
|
(is-false (current-presentation world "right")))
|
|
(create-viewset world "valid" "Valid"
|
|
(list (make-viewset-entry :head-id "left" :view-id "browser")))
|
|
(let ((plan (build-strict-viewset-plan
|
|
(preflight-viewset-activation world "valid"))))
|
|
;; Any intervening model transition invalidates a prepared whole-desk
|
|
;; plan; a stale command cannot replace a newly changed Head.
|
|
(create-client world "later" "lime")
|
|
(signals stale-transition-plan (commit-viewset-plan world plan))
|
|
(is-false (current-presentation world "left"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test new-windows-change-only-the-live-draft
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(create-client world "terminal-2" "lime" :name "Second terminal")
|
|
(show-client-on-presentation world "terminal-2" (presentation-id code))
|
|
(is (member "terminal-2" (presentation-client-ids code) :test #'equal))
|
|
(is-false (member "terminal-2"
|
|
(mapcar #'placement-client-id
|
|
(view-placements (find-view world "code")))
|
|
:test #'equal))
|
|
;; Recalling the historical checkpoint releases the new client's lease.
|
|
(activate-view-strictly world "left" "code")
|
|
(is-false (lease-for-client world "terminal-2"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test focus-is-an-explicit-active-lease-command
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(focus-client-on-presentation world "terminal" (presentation-id code))
|
|
(is (equal (presentation-focus-client-id code) "terminal"))
|
|
(is-true (presentation-dirty-p code))
|
|
;; Firefox belongs to the Activity but is not visible in this
|
|
;; Presentation, so selecting it must not create an implicit lease.
|
|
(signals invalid-transition
|
|
(focus-client-on-presentation world "firefox" (presentation-id code)))
|
|
(is (equal (presentation-focus-client-id code) "terminal"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test retiring-a-destroyed-client-removes-phantom-slots-everywhere
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(retire-client world "emacs")
|
|
(signals unknown-entity (find-client world "emacs"))
|
|
(is-false (member "emacs" (activity-client-ids (find-activity world "lime"))
|
|
:test #'equal))
|
|
(is (equal (presentation-client-ids code) '("terminal")))
|
|
;; This Presentation began with the fallback layout, so its tree remains
|
|
;; implicit. Resolving it must still have no ghost slot.
|
|
(is (equal (mapcar #'car (resolve-presentation-layout code 800 600))
|
|
'("terminal")))
|
|
(is (equal (mapcar #'placement-client-id
|
|
(view-placements (find-view world "code")))
|
|
'("terminal")))
|
|
(is-false (lease-for-client world "emacs"))
|
|
(is (equal (lease-head-id world "terminal") "left"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test head-local-layouts-are-copied-and-explicitly-saved
|
|
(let ((world (make-fixture)))
|
|
(let ((saved-layout
|
|
(make-layout-split
|
|
:orientation :vertical
|
|
:ratio 2/3
|
|
:first (make-layout-leaf :client-id "emacs")
|
|
:second (make-layout-leaf :client-id "terminal"))))
|
|
(create-view world "layout" "lime" "Layout"
|
|
(placements "emacs" "terminal")
|
|
:layout-root saved-layout)
|
|
(let ((presentation (activate-view-strictly world "left" "layout")))
|
|
(is (equal (layout-node-client-ids
|
|
(presentation-layout-root presentation))
|
|
'("emacs" "terminal")))
|
|
(is-false (eq saved-layout (presentation-layout-root presentation)))
|
|
(set-presentation-layout-root
|
|
world
|
|
(presentation-id presentation)
|
|
(make-layout-split
|
|
:orientation :horizontal
|
|
:ratio 1/2
|
|
:first (make-layout-leaf :client-id "emacs")
|
|
:second (make-layout-leaf :client-id "terminal")))
|
|
(is (eq (layout-split-orientation
|
|
(presentation-layout-root presentation))
|
|
:horizontal))
|
|
;; The checkpoint remains vertical until the user explicitly updates it.
|
|
(is (eq (layout-split-orientation
|
|
(view-layout-root (find-view world "layout")))
|
|
:vertical))
|
|
(update-view-from-presentation world "layout" (presentation-id presentation))
|
|
(is (eq (layout-split-orientation
|
|
(view-layout-root (find-view world "layout")))
|
|
:horizontal))
|
|
(is-true (validate-world world))))))
|
|
|
|
(test master-stack-is-a-head-local-saved-layout-policy
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(show-client-on-presentation world "firefox" (presentation-id code))
|
|
(set-presentation-master-stack-layout
|
|
world (presentation-id code) :master-count 1 :master-ratio 3/5)
|
|
(is (eq (presentation-layout-mode code) :master-stack))
|
|
(is (equal (presentation-layout-options code)
|
|
'(:master-count 1 :master-ratio 3/5 :orientation :horizontal)))
|
|
(is (equal (layout-node-client-ids (presentation-layout-root code))
|
|
'("emacs" "terminal" "firefox")))
|
|
(let ((layout (resolve-presentation-layout code 1000 600)))
|
|
(let ((master (cdr (assoc "emacs" layout :test #'equal)))
|
|
(first-stack (cdr (assoc "terminal" layout :test #'equal)))
|
|
(second-stack (cdr (assoc "firefox" layout :test #'equal))))
|
|
(is (= (geometry-width master) 600))
|
|
(is (= (geometry-width first-stack) 400))
|
|
(is (= (geometry-y first-stack) 0))
|
|
(is (= (geometry-y second-stack) 300))))
|
|
;; The policy follows the live draft as clients arrive and persists only
|
|
;; when explicitly checkpointed.
|
|
(create-client world "terminal-2" "lime")
|
|
(show-client-on-presentation world "terminal-2" (presentation-id code))
|
|
(is (equal (layout-node-client-ids (presentation-layout-root code))
|
|
'("emacs" "terminal" "firefox" "terminal-2")))
|
|
(update-view-from-presentation world "code" (presentation-id code))
|
|
(is (eq (view-layout-mode (find-view world "code")) :master-stack))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test master-stack-weights-resize-each-column-independently-on-both-axes
|
|
(let* ((world (make-fixture))
|
|
(code (activate-view-strictly world "left" "code"))
|
|
(id (presentation-id code)))
|
|
(show-client-on-presentation world "firefox" id)
|
|
(dolist (client '("extra-1" "extra-2"))
|
|
(create-client world client "lime")
|
|
(show-client-on-presentation world client id))
|
|
(set-presentation-master-stack-layout world id :master-count 2 :master-ratio 3/5)
|
|
(set-client-tile-weight world id "terminal" 2)
|
|
(set-client-tile-weight world id "firefox" 2)
|
|
(flet ((geometry (client layout) (cdr (assoc client layout :test #'equal))))
|
|
(let ((layout (resolve-presentation-layout code 1000 600)))
|
|
;; Master weights 1:2; stack weights 2:1:1. Neither changes column width.
|
|
(is (= 200 (geometry-height (geometry "emacs" layout))))
|
|
(is (= 400 (geometry-height (geometry "terminal" layout))))
|
|
(is (= 300 (geometry-height (geometry "firefox" layout))))
|
|
(is (= 150 (geometry-height (geometry "extra-1" layout))))
|
|
(is (= 150 (geometry-height (geometry "extra-2" layout))))
|
|
(is (= 600 (geometry-width (geometry "terminal" layout))))
|
|
(is (= 400 (geometry-width (geometry "firefox" layout)))))
|
|
(set-presentation-master-stack-layout world id :master-count 2
|
|
:master-ratio 1/2 :orientation :vertical)
|
|
(let ((layout (resolve-presentation-layout code 600 1000)))
|
|
(is (= 200 (geometry-width (geometry "emacs" layout))))
|
|
(is (= 400 (geometry-width (geometry "terminal" layout))))
|
|
(is (= 300 (geometry-width (geometry "firefox" layout))))
|
|
(is (= 150 (geometry-width (geometry "extra-1" layout))))
|
|
(is (= 150 (geometry-width (geometry "extra-2" layout))))
|
|
(is (= 500 (geometry-height (geometry "firefox" layout))))))
|
|
(is (equal "emacs" (presentation-focus-client-id code)))
|
|
(is-true (validate-world world))))
|
|
|
|
(test tile-weights-follow-the-window-through-reordering-and-reflow
|
|
(let* ((world (make-fixture))
|
|
(code (activate-view-strictly world "left" "code"))
|
|
(id (presentation-id code)))
|
|
(show-client-on-presentation world "firefox" id)
|
|
(set-presentation-master-stack-layout world id :master-ratio 3/5)
|
|
(set-client-tile-weight world id "terminal" 2)
|
|
(focus-client-on-presentation world "terminal" id)
|
|
(swap-focused-layout-client world id)
|
|
(is (eq :master-stack (presentation-layout-mode code)))
|
|
(is (equal '("emacs" "firefox" "terminal") (presentation-client-ids code)))
|
|
(let ((tile (cdr (assoc "terminal" (resolve-presentation-layout code 1000 600)
|
|
:test #'equal))))
|
|
(is (= 200 (geometry-y tile)))
|
|
(is (= 400 (geometry-height tile))))
|
|
(create-client world "extra" "lime")
|
|
(show-client-on-presentation world "extra" id)
|
|
(is (= 300 (geometry-height
|
|
(cdr (assoc "terminal" (resolve-presentation-layout code 1000 600)
|
|
:test #'equal)))))
|
|
(retire-client world "extra")
|
|
(is (= 400 (geometry-height
|
|
(cdr (assoc "terminal" (resolve-presentation-layout code 1000 600)
|
|
:test #'equal)))))
|
|
(hide-client-from-presentation world "firefox" id)
|
|
;; A sole window fills its column, with its weight retained for future peers.
|
|
(is (= 600 (geometry-height
|
|
(cdr (assoc "terminal" (resolve-presentation-layout code 1000 600)
|
|
:test #'equal)))))
|
|
(show-client-on-presentation world "firefox" id)
|
|
(is (= 400 (geometry-height
|
|
(cdr (assoc "terminal" (resolve-presentation-layout code 1000 600)
|
|
:test #'equal)))))
|
|
(is-true (validate-world world))))
|
|
|
|
(test tile-weights-survive-floating-resizing-and-layout-changes
|
|
(let* ((world (make-fixture))
|
|
(code (activate-view-strictly world "left" "code"))
|
|
(id (presentation-id code)))
|
|
(show-client-on-presentation world "firefox" id)
|
|
(set-presentation-master-stack-layout world id)
|
|
(set-client-tile-weight world id "terminal" 2)
|
|
(toggle-client-floating world id "terminal")
|
|
(set-client-floating-geometry world id "terminal" :width 1/2)
|
|
(update-view-from-presentation world "code" id)
|
|
;; Float checkpoint copies must preserve the dormant tiling weight too.
|
|
(setf code (activate-view-strictly world "left" "code")
|
|
id (presentation-id code))
|
|
(toggle-client-floating world id "terminal")
|
|
(set-presentation-monocle-layout world id)
|
|
(set-presentation-manual-layout world id)
|
|
(set-presentation-master-stack-layout world id)
|
|
(is (= 400 (geometry-height
|
|
(cdr (assoc "terminal" (resolve-presentation-layout code 1000 600)
|
|
:test #'equal)))))
|
|
(is-true (validate-world world))))
|
|
|
|
(test tile-weights-are-independent-view-checkpoints-and-head-local-edits
|
|
(let* ((world (make-fixture))
|
|
(code (activate-view-strictly world "left" "code"))
|
|
(id (presentation-id code))
|
|
(right (activate-view-strictly world "right" "browser")))
|
|
(set-presentation-master-stack-layout world id :master-count 2)
|
|
(set-client-tile-weight world id "terminal" 2)
|
|
(let ((saved (find "terminal" (view-placements (find-view world "code"))
|
|
:key #'placement-client-id :test #'equal)))
|
|
(is (= 1 (placement-tile-weight saved))))
|
|
(update-view-from-presentation world "code" id)
|
|
(set-client-tile-weight world id "terminal" 1)
|
|
(is-true (presentation-dirty-p code))
|
|
(is (= 300 (geometry-height
|
|
(cdr (assoc "terminal" (resolve-presentation-layout code 1000 600)
|
|
:test #'equal)))))
|
|
(setf code (activate-view-strictly world "left" "code"))
|
|
(is (= 400 (geometry-height
|
|
(cdr (assoc "terminal" (resolve-presentation-layout code 1000 600)
|
|
:test #'equal)))))
|
|
(is-false (presentation-dirty-p code))
|
|
(is (eq right (current-presentation world "right")))
|
|
(is-false (presentation-dirty-p right))
|
|
(is (equal "right" (lease-head-id world "firefox")))
|
|
(is-true (validate-world world))))
|
|
|
|
(test invalid-tile-weight-edits-leave-the-draft-intact
|
|
(let* ((world (make-fixture))
|
|
(code (activate-view-strictly world "left" "code"))
|
|
(id (presentation-id code)))
|
|
(set-presentation-master-stack-layout world id)
|
|
(let ((revision (world-revision world))
|
|
(root (presentation-layout-root code)))
|
|
(dolist (weight '(0 -1 nope))
|
|
(signals invalid-transition (set-client-tile-weight world id "terminal" weight)))
|
|
(signals invalid-transition (set-client-tile-weight world id "firefox" 2))
|
|
(is (= revision (world-revision world)))
|
|
(is (eq root (presentation-layout-root code))))
|
|
(toggle-client-floating world id "terminal")
|
|
(let ((revision (world-revision world)))
|
|
(signals invalid-transition (set-client-tile-weight world id "terminal" 2))
|
|
(is (= revision (world-revision world))))
|
|
(set-presentation-monocle-layout world id)
|
|
(let ((revision (world-revision world)))
|
|
(signals invalid-transition (set-client-tile-weight world id "emacs" 2))
|
|
(is (= revision (world-revision world))))
|
|
(signals invalid-transition
|
|
(create-view world "bad-weight" "lime" "Bad weight"
|
|
(list (make-placement :client-id "firefox" :data '(:tile-weight 0)))))
|
|
(signals invalid-transition
|
|
(master-stack-layout-root '("a" "b") :weights '(1)))
|
|
(signals invalid-transition
|
|
(master-stack-layout-root '("a" "b") :weights '(1 -1)))
|
|
(is-true (validate-world world))))
|
|
|
|
(test master-stack-client-flow-honors-insertion-and-focus-policy
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(set-presentation-master-stack-layout world (presentation-id code)
|
|
:master-count 1 :master-ratio 3/5)
|
|
;; :BACK is the familiar dwm-like behavior: the newcomer is focused but
|
|
;; every existing master/stack slot stays put and it joins at the
|
|
;; visual bottom of the stack.
|
|
(show-client-on-presentation world "firefox" (presentation-id code)
|
|
:tiled-insertion-position :back :focus-p t)
|
|
(is (equal (presentation-client-ids code)
|
|
'("emacs" "terminal" "firefox")))
|
|
(is (equal (presentation-focus-client-id code) "firefox"))
|
|
(let ((layout (resolve-presentation-layout code 1000 600)))
|
|
(is (= (geometry-y (cdr (assoc "firefox" layout :test #'equal))) 300)))
|
|
;; Placement order points from master toward the bottom of the stack,
|
|
;; so closing the focused lowest client with :PREVIOUS focuses Terminal.
|
|
(retire-client world "firefox" :focus-direction :previous)
|
|
(is (equal (presentation-focus-client-id code) "terminal"))
|
|
;; The same engine also admits a different user policy without changing
|
|
;; the master/stack implementation itself: :FRONT creates a new master.
|
|
(create-client world "browser-2" "lime")
|
|
(show-client-on-presentation world "browser-2" (presentation-id code)
|
|
:tiled-insertion-position :front :focus-p t)
|
|
(is (equal (presentation-client-ids code)
|
|
'("browser-2" "emacs" "terminal")))
|
|
(is (equal (presentation-focus-client-id code) "browser-2"))
|
|
(retire-client world "browser-2" :focus-direction :previous)
|
|
;; There is nothing before master, so the opposite direction is the
|
|
;; graceful edge fallback.
|
|
(is (equal (presentation-focus-client-id code) "emacs"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test monocle-client-flow-makes-new-clients-the-current-cycle-entry
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(set-presentation-monocle-layout world (presentation-id code))
|
|
;; In monocle placement order is the cycle below the visible client. A
|
|
;; newcomer therefore goes first and becomes the one full-screen tile.
|
|
(show-client-on-presentation world "firefox" (presentation-id code)
|
|
:tiled-insertion-position :front :focus-p t)
|
|
(is (equal (presentation-client-ids code)
|
|
'("firefox" "emacs" "terminal")))
|
|
(is (equal (presentation-focus-client-id code) "firefox"))
|
|
(is (equal (mapcar #'car (resolve-presentation-layout code 800 600))
|
|
'("firefox")))
|
|
;; The next client in that order is the natural close target. Exercise
|
|
;; RETIRE-CLIENT's per-container policy hook, used by the X11 adapter.
|
|
(retire-client world "firefox"
|
|
:focus-direction (lambda (container)
|
|
(declare (ignore container))
|
|
:next))
|
|
(is (equal (presentation-focus-client-id code) "emacs"))
|
|
(is (equal (mapcar #'car (resolve-presentation-layout code 800 600))
|
|
'("emacs")))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test monocle-renders-only-the-focused-tiled-client
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(set-presentation-monocle-layout world (presentation-id code))
|
|
(is (eq (presentation-layout-mode code) :monocle))
|
|
(let ((layout (resolve-presentation-layout code 800 600)))
|
|
(is (equal (mapcar #'car layout) '("emacs")))
|
|
(is (= (geometry-width (cdar layout)) 800)))
|
|
(focus-client-on-presentation world "terminal" (presentation-id code))
|
|
(is (equal (mapcar #'car (resolve-presentation-layout code 800 600))
|
|
'("terminal")))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test floating-placements-have-normalized-geometry-and-rejoin-tiling
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(toggle-focused-client-floating world (presentation-id code))
|
|
(let ((placement (find "emacs" (presentation-placements code)
|
|
:key #'placement-client-id :test #'equal)))
|
|
(is (eq (placement-kind placement) :float))
|
|
(is (equal (placement-data placement)
|
|
'(:x 1/8 :y 1/8 :width 3/4 :height 3/4))))
|
|
;; The float is independent of the tiled fallback tree and is resolved
|
|
;; after tiled content so a renderer may keep it above the tiles.
|
|
(let ((layout (resolve-presentation-layout code 800 600)))
|
|
(is (equal (mapcar #'car layout) '("terminal" "emacs")))
|
|
(let ((float (cdr (assoc "emacs" layout :test #'equal)))
|
|
(tile (cdr (assoc "terminal" layout :test #'equal))))
|
|
(is (= (geometry-x float) 100))
|
|
(is (= (geometry-y float) 75))
|
|
(is (= (geometry-width float) 600))
|
|
(is (= (geometry-height float) 450))
|
|
(is (= (geometry-width tile) 800))))
|
|
(set-client-floating-geometry world (presentation-id code) "emacs"
|
|
:x 1/4 :y 1/5 :width 1/2 :height 2/5)
|
|
(let ((float (cdr (assoc "emacs"
|
|
(resolve-presentation-layout code 800 600)
|
|
:test #'equal))))
|
|
(is (= (geometry-x float) 200))
|
|
(is (= (geometry-y float) 120))
|
|
(is (= (geometry-width float) 400))
|
|
(is (= (geometry-height float) 240)))
|
|
(toggle-client-floating world (presentation-id code) "emacs")
|
|
(let ((placement (find "emacs" (presentation-placements code)
|
|
:key #'placement-client-id :test #'equal)))
|
|
(is (eq (placement-kind placement) :tile))
|
|
(is-false (placement-data placement)))
|
|
(is (equal (mapcar #'car (resolve-presentation-layout code 800 600))
|
|
'("emacs" "terminal")))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test floating-geometry-is-an-explicitly-saved-head-local-checkpoint-change
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(toggle-client-floating world (presentation-id code) "terminal"
|
|
:data '(:x 1/5 :y 1/6 :width 1/2 :height 1/2))
|
|
;; The named checkpoint remains tiled until the user asks to update it.
|
|
(is (eq (placement-kind
|
|
(find "terminal" (view-placements (find-view world "code"))
|
|
:key #'placement-client-id :test #'equal))
|
|
:tile))
|
|
(update-view-from-presentation world "code" (presentation-id code))
|
|
(let ((saved (find "terminal" (view-placements (find-view world "code"))
|
|
:key #'placement-client-id :test #'equal)))
|
|
(is (eq (placement-kind saved) :float))
|
|
(is (equal (placement-data saved)
|
|
'(:x 1/5 :y 1/6 :width 1/2 :height 1/2))))
|
|
(set-client-floating-geometry world (presentation-id code) "terminal"
|
|
:x 1/4)
|
|
(is (equal (placement-data
|
|
(find "terminal" (view-placements (find-view world "code"))
|
|
:key #'placement-client-id :test #'equal))
|
|
'(:x 1/5 :y 1/6 :width 1/2 :height 1/2)))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test master-stack-reflows-when-a-client-enters-or-leaves-floating
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(show-client-on-presentation world "firefox" (presentation-id code))
|
|
(set-presentation-master-stack-layout world (presentation-id code)
|
|
:master-count 1 :master-ratio 3/5)
|
|
(toggle-client-floating world (presentation-id code) "terminal")
|
|
(is (eq (presentation-layout-mode code) :master-stack))
|
|
(is (equal (layout-node-client-ids (presentation-layout-root code))
|
|
'("emacs" "firefox")))
|
|
(let ((layout (resolve-presentation-layout code 1000 600)))
|
|
(is (= (geometry-width (cdr (assoc "emacs" layout :test #'equal))) 600))
|
|
(is (= (geometry-width (cdr (assoc "firefox" layout :test #'equal))) 400))
|
|
(is (= (geometry-width (cdr (assoc "terminal" layout :test #'equal)))
|
|
750)))
|
|
(toggle-client-floating world (presentation-id code) "terminal")
|
|
(is (equal (layout-node-client-ids (presentation-layout-root code))
|
|
'("emacs" "terminal" "firefox")))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test manual-layout-commands-edit-the-focused-nearest-split
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(adjust-focused-layout-split-ratio world (presentation-id code) 1/10)
|
|
(is (eq (presentation-layout-mode code) :manual))
|
|
(is (= (layout-split-ratio (presentation-layout-root code)) 3/5))
|
|
(set-focused-layout-split-orientation world (presentation-id code)
|
|
:vertical)
|
|
(is (eq (layout-split-orientation (presentation-layout-root code))
|
|
:vertical))
|
|
(swap-focused-layout-client world (presentation-id code))
|
|
(is (equal (layout-node-client-ids (presentation-layout-root code))
|
|
'("terminal" "emacs")))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test promoting-a-client-creates-a-master-stack-draft
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(show-client-on-presentation world "firefox" (presentation-id code))
|
|
(focus-client-on-presentation world "terminal" (presentation-id code))
|
|
(promote-client-to-master world (presentation-id code) "terminal")
|
|
(is (eq (presentation-layout-mode code) :master-stack))
|
|
(is (equal (layout-node-client-ids (presentation-layout-root code))
|
|
'("terminal" "emacs" "firefox")))
|
|
(is (equal (mapcar #'placement-client-id
|
|
(presentation-placements code))
|
|
'("terminal" "emacs" "firefox")))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test resuming-a-cached-presentation-preserves-its-draft
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(create-client world "terminal-2" "lime")
|
|
(show-client-on-presentation world "terminal-2" (presentation-id code))
|
|
(activate-view-strictly world "left" "play")
|
|
(let ((resumed (resume-presentation-strictly world "left"
|
|
(presentation-id code))))
|
|
(is (eq code resumed))
|
|
(is (member "terminal-2" (presentation-client-ids resumed)
|
|
:test #'equal))
|
|
(is (equal (lease-head-id world "terminal-2") "left"))
|
|
(is-true (presentation-dirty-p resumed))
|
|
(is-true (validate-world world))))))
|
|
|
|
(test resume-keeps-current-locations-instead-of-recalling-checkpoint-requests
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(activate-view-strictly world "left" "play")
|
|
(activate-view-strictly world "right" "docs")
|
|
(let ((report (preflight-presentation-resume world "left"
|
|
(presentation-id code))))
|
|
(is (activation-report-ready-p report))
|
|
(is (equal '("terminal") (mapcar #'placement-client-id (activation-report-desired-placements report)))))
|
|
(let ((resumed (resume-presentation-strictly world "left"
|
|
(presentation-id code))))
|
|
(is (eq code resumed))
|
|
(is-false (presentation-unavailable-client-ids resumed))
|
|
(is (equal (lease-head-id world "terminal") "left"))
|
|
(is (equal (lease-head-id world "emacs") "right"))
|
|
(is-true (validate-world world))))))
|
|
|
|
(test updating-a-view-is-explicit
|
|
(let ((world (make-fixture)))
|
|
(let ((code (activate-view-strictly world "left" "code")))
|
|
(create-client world "terminal-2" "lime")
|
|
(show-client-on-presentation world "terminal-2" (presentation-id code))
|
|
(update-view-from-presentation world "code" (presentation-id code))
|
|
(is (member "terminal-2"
|
|
(mapcar #'placement-client-id
|
|
(view-placements (find-view world "code")))
|
|
:test #'equal))
|
|
(is-false (presentation-dirty-p code)))))
|
|
|
|
(test a-degraded-presentation-cannot-silently-overwrite-a-view
|
|
(let ((world (make-fixture)))
|
|
(activate-view-strictly world "left" "code")
|
|
(let ((right (activate-view-partially world "right" "docs")))
|
|
(signals degraded-presentation-update
|
|
(update-view-from-presentation world "docs" (presentation-id right))))))
|
|
|
|
(test topology-reconciliation-moves-a-removed-heads-live-draft-intact
|
|
(let ((world (make-fixture)))
|
|
(let* ((code (activate-view-strictly world "left" "code"))
|
|
(browser (activate-view-strictly world "right" "browser"))
|
|
(report (preflight-head-topology-reconciliation world
|
|
'("left" "dock"))))
|
|
(is (equal (head-topology-report-added-head-ids report) '("dock")))
|
|
(is (equal (head-topology-report-removed-head-ids report) '("right")))
|
|
(is (equal (mapcar #'head-topology-source-presentation-id
|
|
(head-topology-report-removed-active-sources report))
|
|
(list (presentation-id browser))))
|
|
(let ((result
|
|
(commit-head-topology-reconciliation-plan
|
|
world
|
|
(build-head-topology-reconciliation-plan
|
|
report
|
|
:moves (list (make-head-topology-move
|
|
:from-head-id "right" :to-head-id "dock"))))))
|
|
(is (equal (head-topology-result-moved-presentation-ids result)
|
|
(list (presentation-id browser))))
|
|
(is (eq (current-presentation world "left") code))
|
|
(is (eq (current-presentation world "dock") browser))
|
|
(is (equal (presentation-head-id browser) "dock"))
|
|
(is (equal (lease-head-id world "firefox") "dock"))
|
|
(signals unknown-entity (find-head world "right"))
|
|
(is-true (validate-world world))))))
|
|
|
|
(test topology-reconciliation-suspends-an-unmoved-draft-and-allows-rehoming
|
|
(let ((world (make-fixture)))
|
|
(activate-view-strictly world "left" "code")
|
|
(let* ((browser (activate-view-strictly world "right" "browser"))
|
|
(remove-report (preflight-head-topology-reconciliation world '("left")))
|
|
(result
|
|
(commit-head-topology-reconciliation-plan
|
|
world (build-head-topology-reconciliation-plan remove-report))))
|
|
(is (equal (head-topology-result-suspended-presentation-ids result)
|
|
(list (presentation-id browser))))
|
|
(is-false (presentation-head-id browser))
|
|
(is-false (lease-for-client world "firefox"))
|
|
(let ((add-report
|
|
(preflight-head-topology-reconciliation world '("left" "laptop"))))
|
|
(commit-head-topology-reconciliation-plan
|
|
world (build-head-topology-reconciliation-plan add-report)))
|
|
(let ((resumed (resume-presentation-strictly world "laptop"
|
|
(presentation-id browser))))
|
|
(is (eq resumed browser))
|
|
(is (equal (presentation-head-id browser) "laptop"))
|
|
(is (equal (lease-head-id world "firefox") "laptop"))
|
|
(is-true (validate-world world))))))
|
|
|
|
(test topology-reconciliation-rejects-ambiguous-destinations-without-mutation
|
|
(let ((world (make-fixture)))
|
|
(create-head world "third")
|
|
(activate-view-strictly world "left" "code")
|
|
(activate-view-strictly world "right" "browser")
|
|
(activate-view-strictly world "third" "play")
|
|
(let ((report (preflight-head-topology-reconciliation world '("left"))))
|
|
(signals invalid-transition
|
|
(build-head-topology-reconciliation-plan
|
|
report
|
|
:moves (list (make-head-topology-move :from-head-id "right"
|
|
:to-head-id "left")
|
|
(make-head-topology-move :from-head-id "third"
|
|
:to-head-id "left"))))
|
|
(is (current-presentation world "right"))
|
|
(is (current-presentation world "third"))
|
|
(is-true (validate-world world)))))
|
|
|
|
(test stale-plans-cannot-overwrite-newer-state
|
|
(let ((world (make-fixture)))
|
|
(let* ((report (preflight-view-activation world "left" "code"))
|
|
(plan (build-strict-activation-plan report)))
|
|
(create-client world "terminal-2" "lime")
|
|
(signals stale-transition-plan
|
|
(commit-activation-plan world plan))
|
|
(is-false (current-presentation world "left")))))
|
|
|
|
(test activity-is-one-live-arrangement-across-independently-selected-heads
|
|
(let* ((world (make-fixture))
|
|
(left (open-activity-draft world "left" "lime" :default-layout :master-stack))
|
|
(right (open-activity-draft world "right" "lime" :default-layout :monocle)))
|
|
(show-client-on-presentation world "emacs" (presentation-id left))
|
|
(show-client-on-presentation world "firefox" (presentation-id right))
|
|
(set-presentation-layout-mode world (presentation-id left) :master-stack :layout-options '(:master-ratio 2/3))
|
|
(dotimes (i 3)
|
|
(open-activity-draft world "right" "game")
|
|
(is (equal "left" (lease-head-id world "emacs")))
|
|
(is-false (lease-for-client world "firefox"))
|
|
(open-activity-draft world "left" "game")
|
|
(is-false (lease-for-client world "emacs"))
|
|
;; Return in either order, independently. No save/recall or policy choice.
|
|
(dolist (head (if (evenp i) '("right" "left") '("left" "right")))
|
|
(is (activation-report-ready-p (preflight-activity-draft world head "lime")))
|
|
(open-activity-draft world head "lime"))
|
|
(is (eq left (current-presentation world "left")))
|
|
(is (eq right (current-presentation world "right")))
|
|
(is (equal "left" (lease-head-id world "emacs")))
|
|
(is (equal "right" (lease-head-id world "firefox"))))
|
|
(is (= 2/3 (getf (presentation-layout-options left) :master-ratio)))
|
|
(is (eq :monocle (presentation-layout-mode right)))
|
|
;; Explicit relocation changes the source even after another round trip.
|
|
(show-client-on-presentation world "firefox" (presentation-id left))
|
|
(transfer-client-lease world "firefox" (presentation-id left))
|
|
(is-false (presentation-client-ids right))
|
|
(open-activity-draft world "right" "game")
|
|
(open-activity-draft world "right" "lime")
|
|
(is-false (presentation-client-ids right))
|
|
(is (equal "left" (lease-head-id world "firefox")))
|
|
;; Hiding does not resurface through another arrangement or a return.
|
|
(hide-client-from-presentation world "firefox" (presentation-id left))
|
|
(open-activity-draft world "left" "game")
|
|
(open-activity-draft world "left" "lime")
|
|
(is-false (lease-for-client world "firefox"))
|
|
(is (equal '("emacs") (presentation-client-ids left)))
|
|
(is-true (validate-world world))))
|
|
|
|
(test first-visit-to-inactive-activity-does-not-gather-other-heads-windows
|
|
(let* ((world (make-fixture)) (left (open-activity-draft world "left" "lime")))
|
|
(show-client-on-presentation world "emacs" (presentation-id left))
|
|
(open-activity-draft world "left" "game")
|
|
(is-false (presentation-client-ids (open-activity-draft world "right" "lime")))
|
|
(is-false (lease-for-client world "emacs"))
|
|
;; Summoning a not-currently-visible client also updates its old location.
|
|
(show-client-on-presentation world "emacs" (presentation-id (current-presentation world "right")))
|
|
(is-false (presentation-client-ids left))
|
|
(open-activity-draft world "left" "lime")
|
|
(is (equal "right" (lease-head-id world "emacs")))
|
|
(is-true (validate-world world))))
|
|
|
|
(test checkpoints-edit-one-working-arrangement-without-creating-hidden-workspaces
|
|
(let* ((world (make-fixture)) (left (open-activity-draft world "left" "lime")))
|
|
(activate-view-strictly world "left" "code")
|
|
(is (eq left (current-presentation world "left")))
|
|
(hide-client-from-presentation world "emacs" (presentation-id left))
|
|
(open-activity-draft world "left" "game")
|
|
(is (eq left (open-activity-draft world "left" "lime")))
|
|
(is (equal '("terminal") (presentation-client-ids left)))
|
|
(activate-view-strictly world "left" "code")
|
|
(is (equal '("emacs" "terminal") (presentation-client-ids left)))
|
|
(is-false (presentation-dirty-p left))
|
|
;; Recalling the checkpoint elsewhere while the old side is inactive
|
|
;; changes live locations and detaches its old source label, not the View.
|
|
(open-activity-draft world "left" "game")
|
|
(activate-view-strictly world "right" "code")
|
|
(is-false (presentation-source-view-id left))
|
|
(is-false (presentation-client-ids left))
|
|
(open-activity-draft world "left" "lime")
|
|
(is (equal "right" (lease-head-id world "emacs")))
|
|
(is (= 2 (length (view-placements (find-view world "code")))))
|
|
(is-true (validate-world world))))
|
|
|
|
(test partially-recalled-view-does-not-retry-missing-windows-on-activity-return
|
|
(let* ((world (make-fixture))
|
|
(left (activate-view-strictly world "left" "code"))
|
|
(right (activate-view-partially world "right" "docs")))
|
|
(is (equal '("emacs") (presentation-unavailable-client-ids right)))
|
|
(open-activity-draft world "right" "game")
|
|
(open-activity-draft world "left" "game")
|
|
(open-activity-draft world "right" "lime")
|
|
(is-false (lease-for-client world "emacs"))
|
|
(is (equal '("firefox") (presentation-client-ids right)))
|
|
(open-activity-draft world "left" "lime")
|
|
(is (eq left (current-presentation world "left")))
|
|
(is (equal "left" (lease-head-id world "emacs")))
|
|
(is-true (validate-world world))))
|
|
|
|
(defun run-tests ()
|
|
(run! 'lime-suite))
|