Initial Lime window manager
This commit is contained in:
281
test/x11-membership.lisp
Normal file
281
test/x11-membership.lisp
Normal file
@@ -0,0 +1,281 @@
|
||||
(in-package #:lime.x11.test)
|
||||
(in-suite lime-x11-suite)
|
||||
|
||||
(defmacro with-membership-backend ((backend world) &body body)
|
||||
`(let* ((,backend (make-head-bar-fixture)) (,world (x11-backend-world ,backend))
|
||||
(original (symbol-function 'apply-active-presentation)))
|
||||
(create-activity ,world "chill" "Chill")
|
||||
(create-head ,world "other")
|
||||
(setf (gethash "other" (lime.x11::x11-backend-heads ,backend))
|
||||
(make-x11-head :head-id "other" :x 840 :y 30 :width 800 :height 600)
|
||||
(lime.x11::x11-backend-head-ids ,backend) '("main" "other"))
|
||||
(open-activity-draft ,world "other" "chill")
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setf (symbol-function 'apply-active-presentation) (lambda (b) b))
|
||||
,@body)
|
||||
(setf (symbol-function 'apply-active-presentation) original))))
|
||||
|
||||
(test cross-activity-head-send-needs-explicit-confirmation
|
||||
(with-membership-backend (backend world)
|
||||
(let* ((before (lime.persistence:snapshot-world world))
|
||||
(source (current-presentation world "main"))
|
||||
(target (current-presentation world "other"))
|
||||
(result (lime.x11::%ui-request-client-send backend "other")))
|
||||
(is (eq :replace (ui-result-kind result)))
|
||||
(is (eq :cancel (ui-candidate-id (first (ui-result-candidates result)))))
|
||||
(is (search "Development to Chill" (lime.ui:ui-result-message result)))
|
||||
(is (search "saved views" (ui-candidate-detail (first (ui-result-candidates result)))))
|
||||
(is (equalp before (lime.persistence:snapshot-world world)))
|
||||
(is (eq :close (ui-result-kind (funcall (ui-candidate-action (first (ui-result-candidates result)))))))
|
||||
(is (equalp before (lime.persistence:snapshot-world world)))
|
||||
(is (equal "main" (x11-backend-focused-head-id backend)))
|
||||
(is (eq :close (ui-result-kind (funcall (ui-candidate-action (second (ui-result-candidates result)))))))
|
||||
(is (equal "chill" (client-activity-id (find-client world "editor"))))
|
||||
(is (equal "other" (lime.x11::ewmh-active-head-id-for-client backend "editor")))
|
||||
(is (equal "other" (lime.x11:x11-backend-focused-head-id backend)))
|
||||
(is (equal "chill" (lime.x11::x11-backend-activity-id backend)))
|
||||
(is (eq source (current-presentation world "main")))
|
||||
(is (eq target (current-presentation world "other")))
|
||||
(is (equal "terminal" (presentation-focus-client-id source)))
|
||||
(is (equal '("terminal") (mapcar #'placement-client-id (view-placements (find-view world "development/code")))))
|
||||
(is (validate-world world))
|
||||
(let ((snapshot (lime.persistence:snapshot-world world)))
|
||||
(is (equalp snapshot (lime.persistence:snapshot-world (lime.persistence:restore-world snapshot))))))))
|
||||
|
||||
(test head-send-confirmations-reject-stale-context-without-retargeting
|
||||
(dolist (change '(:head :focus :target :hide :retire :shared :new-client))
|
||||
(with-membership-backend (backend world)
|
||||
(let* ((result (lime.x11::%ui-request-client-send backend "other"))
|
||||
(action (ui-candidate-action (second (ui-result-candidates result)))))
|
||||
(ecase change
|
||||
(:head (setf (lime.x11:x11-backend-focused-head-id backend) "other"))
|
||||
(:focus (focus-client-on-presentation world "terminal" (presentation-id (current-presentation world "main"))))
|
||||
(:target (open-activity-draft world "other" "development"))
|
||||
(:hide (backend-hide-client backend "editor"))
|
||||
(:retire (retire-client world "editor"))
|
||||
(:shared (set-client-shared world "editor" t))
|
||||
(:new-client (create-client world "new" "chill")))
|
||||
(let ((before (lime.persistence:snapshot-world world))
|
||||
(head (x11-backend-focused-head-id backend)))
|
||||
(is (eq :keep-open (ui-result-kind (funcall action))))
|
||||
(is (equal head (x11-backend-focused-head-id backend)))
|
||||
(is (equalp before (lime.persistence:snapshot-world world))))))))
|
||||
|
||||
(test same-activity-and-shared-head-sends-stay-immediate-and-do-not-rehome
|
||||
(dolist (shared-p '(nil t))
|
||||
(with-membership-backend (backend world)
|
||||
(if shared-p (set-client-shared world "editor" t)
|
||||
(open-activity-draft world "other" "development"))
|
||||
(set-presentation-layout-mode world (presentation-id (current-presentation world "other")) :monocle)
|
||||
(setf (lime.x11::x11-backend-focus-root-override-p backend) t)
|
||||
(is (eq :close (ui-result-kind (lime.x11::%ui-request-client-send backend "other"))))
|
||||
(is (equal "development" (client-activity-id (find-client world "editor"))))
|
||||
(is (equal "other" (lime.x11::ewmh-active-head-id-for-client backend "editor")))
|
||||
(is (equal "editor" (presentation-focus-client-id (current-presentation world "other"))))
|
||||
(is (equal "other" (lime.x11:x11-backend-focused-head-id backend)))
|
||||
(is (equal (if shared-p "chill" "development") (lime.x11::x11-backend-activity-id backend)))
|
||||
(is-false (lime.x11::x11-backend-focus-root-override-p backend))
|
||||
(is (equal "terminal" (presentation-focus-client-id (current-presentation world "main"))))
|
||||
(is (equal '("editor" "terminal") (mapcar #'placement-client-id (view-placements (find-view world "development/code")))))
|
||||
(is (validate-world world)))))
|
||||
|
||||
(test head-send-to-self-or-empty-source-is-a-no-op
|
||||
(with-membership-backend (backend world)
|
||||
(let ((before (lime.persistence:snapshot-world world)))
|
||||
(is (eq :close (ui-result-kind (lime.x11::%ui-request-client-send backend "main"))))
|
||||
(is (equal "main" (x11-backend-focused-head-id backend)))
|
||||
(is (equalp before (lime.persistence:snapshot-world world))))
|
||||
(setf (lime.x11:x11-backend-focused-head-id backend) "other")
|
||||
(let ((before (lime.persistence:snapshot-world world)))
|
||||
(is (eq :close (ui-result-kind (lime.x11::%ui-request-client-send backend "main"))))
|
||||
(is (equal "other" (x11-backend-focused-head-id backend)))
|
||||
(is (equalp before (lime.persistence:snapshot-world world))))))
|
||||
|
||||
(test membership-commands-live-under-windows-and-move-stays-on-current-activity
|
||||
(with-membership-backend (backend world)
|
||||
(let* ((window (find :window (lime.x11::%ui-key-path backend) :key #'ui-key-node-id))
|
||||
(move (find :move-client-to-activity (ui-key-node-children window) :key #'ui-key-node-id))
|
||||
(share (find :set-client-shared (ui-key-node-children window) :key #'ui-key-node-id))
|
||||
(result (funcall (ui-key-node-action move))))
|
||||
(is (char= #\m (ui-key-node-key move)))
|
||||
(is (char= #\s (ui-key-node-key share)))
|
||||
(is (eq :replace (ui-result-kind result)))
|
||||
(is (eq :close (ui-result-kind (funcall (ui-candidate-action (first (ui-result-candidates result)))))))
|
||||
(is (equal "development" (presentation-activity-id (current-presentation world "main"))))
|
||||
(is (equal "chill" (client-activity-id (find-client world "editor"))))
|
||||
;; Portable destinations receive the window in their real arrangement,
|
||||
;; not in a second, hidden draft tied to the sending monitor.
|
||||
(is-true (lease-for-client world "editor"))
|
||||
(is (equal '("editor") (presentation-client-ids (current-presentation world "other"))))
|
||||
(backend-activate-activity backend "chill" :head-id "main")
|
||||
(is (equal '("editor") (presentation-leased-client-ids world (current-presentation world "main"))))
|
||||
(is-true (validate-world world)))))
|
||||
|
||||
(test stale-move-picker-does-not-act-on-another-window
|
||||
(with-membership-backend (backend world)
|
||||
(let* ((result (lime.x11::%ui-move-client-result backend "editor" "main"))
|
||||
(choice (first (ui-result-candidates result))))
|
||||
(backend-hide-client backend "editor")
|
||||
(let ((snapshot (lime.persistence:snapshot-world world)))
|
||||
(signals invalid-transition (funcall (ui-candidate-action choice)))
|
||||
(is (equalp snapshot (lime.persistence:snapshot-world world)))))))
|
||||
|
||||
(test shared-picker-takes-only-explicitly-and-can-summon-an-unavailable-slot-back
|
||||
(with-membership-backend (backend world)
|
||||
(backend-set-client-shared backend "terminal" t)
|
||||
(backend-select-head backend "other")
|
||||
(let* ((candidate (find '(:show-hidden-client "terminal") (lime.x11::%ui-hidden-client-candidates backend)
|
||||
:key #'ui-candidate-id :test #'equal))
|
||||
(snapshot (lime.persistence:snapshot-world world))
|
||||
(result (funcall (ui-candidate-action candidate))))
|
||||
(is (search "Shared" (ui-candidate-label candidate)))
|
||||
(is (eq :replace (ui-result-kind result)))
|
||||
(is (equalp snapshot (lime.persistence:snapshot-world world)))
|
||||
(signals invalid-transition (backend-show-client backend "terminal"))
|
||||
(is (equalp snapshot (lime.persistence:snapshot-world world)))
|
||||
(funcall (ui-candidate-action (first (ui-result-candidates result))))
|
||||
(is (equal "other" (lime.x11::ewmh-active-head-id-for-client backend "terminal"))))
|
||||
(backend-select-head backend "main")
|
||||
(is (find '(:show-hidden-client "terminal") (lime.x11::%ui-hidden-client-candidates backend)
|
||||
:key #'ui-candidate-id :test #'equal))
|
||||
(backend-show-client-taking backend "terminal")
|
||||
(is (equal "main" (lime.x11::ewmh-active-head-id-for-client backend "terminal")))
|
||||
(backend-hide-client backend "terminal")
|
||||
(backend-select-head backend "other")
|
||||
(backend-show-client backend "terminal")
|
||||
(is (equal "other" (lime.x11::ewmh-active-head-id-for-client backend "terminal")))
|
||||
(is-true (validate-world world))))
|
||||
|
||||
(test shared-head-transfer-and-attention-respect-the-existing-foreign-lease
|
||||
(with-membership-backend (backend world)
|
||||
(signals invalid-activity-membership (backend-transfer-focused-client-to-head backend "other"))
|
||||
(is (equal "main" (x11-backend-focused-head-id backend)))
|
||||
(backend-set-client-shared backend "editor" t)
|
||||
(backend-transfer-focused-client-to-head backend "other")
|
||||
(is (equal "other" (lime.x11::ewmh-active-head-id-for-client backend "editor")))
|
||||
(lime.x11::%attention-set-source backend "editor" 1 t)
|
||||
(is (equal '("editor") (backend-attention-client-ids backend :activity-id "chill")))
|
||||
(backend-attend-client backend "editor")
|
||||
(is (equal "other" (lime.x11::x11-backend-focused-head-id backend)))
|
||||
(is (equal "chill" (presentation-activity-id (current-presentation world "other"))))
|
||||
(is (equal "editor" (presentation-focus-client-id (current-presentation world "other"))))
|
||||
(is-true (validate-world world))))
|
||||
|
||||
(test making-private-is-confirmed-and-keeps-the-current-activity
|
||||
(with-membership-backend (backend world)
|
||||
(backend-set-client-shared backend "editor" t)
|
||||
(backend-show-client-taking backend "editor" :head-id "other")
|
||||
(backend-save-view backend "chill/music" "Music" :head-id "other")
|
||||
(let* ((snapshot (lime.persistence:snapshot-world world))
|
||||
(source (current-presentation world "main"))
|
||||
(target (current-presentation world "other"))
|
||||
(placements (presentation-placements target))
|
||||
(lease (lease-for-client world "editor"))
|
||||
(result (lime.x11::%ui-set-client-sharing-result backend "editor" "other" nil)))
|
||||
(is (eq :replace (ui-result-kind result)))
|
||||
(is (search "Make private to Chill?" (lime.ui:ui-result-message result)))
|
||||
(is (eq :cancel (ui-candidate-id (first (ui-result-candidates result)))))
|
||||
(is (search "other Activities and their saved views" (ui-candidate-detail (second (ui-result-candidates result)))))
|
||||
(is (equalp snapshot (lime.persistence:snapshot-world world)))
|
||||
(funcall (ui-candidate-action (first (ui-result-candidates result))))
|
||||
(is (equalp snapshot (lime.persistence:snapshot-world world)))
|
||||
(is (eq :close (ui-result-kind (funcall (ui-candidate-action (second (ui-result-candidates result)))))))
|
||||
(is-false (client-shared-p (find-client world "editor")))
|
||||
(is (equal "chill" (client-activity-id (find-client world "editor"))))
|
||||
(is (eq lease (lease-for-client world "editor")))
|
||||
(is (eq source (current-presentation world "main")))
|
||||
(is (eq target (current-presentation world "other")))
|
||||
(is (eq placements (presentation-placements target)))
|
||||
(is (equal "editor" (presentation-focus-client-id target)))
|
||||
(is (equal "other" (x11-backend-focused-head-id backend)))
|
||||
(is (equal '("terminal") (mapcar #'placement-client-id (view-placements (find-view world "development/code")))))
|
||||
(is (equal '("editor") (mapcar #'placement-client-id (view-placements (find-view world "chill/music")))))
|
||||
(is-false (lime.x11::%ui-hidden-client-candidates backend))
|
||||
(backend-select-head backend "main")
|
||||
(is-false (find '(:show-hidden-client "editor") (lime.x11::%ui-hidden-client-candidates backend)
|
||||
:key #'ui-candidate-id :test #'equal))
|
||||
(signals invalid-transition (backend-show-client backend "editor"))
|
||||
(is-true (validate-world world))
|
||||
(let ((saved (lime.persistence:snapshot-world world)))
|
||||
(is (equalp saved (lime.persistence:snapshot-world (lime.persistence:restore-world saved))))))))
|
||||
|
||||
(test make-private-confirmation-rejects-changed-context
|
||||
(dolist (change '(:head :focus :activity :hide :transfer :retire :shared :home))
|
||||
(with-membership-backend (backend world)
|
||||
(backend-set-client-shared backend "editor" t)
|
||||
(backend-show-client-taking backend "editor" :head-id "other")
|
||||
(let* ((result (lime.x11::%ui-set-client-sharing-result backend "editor" "other" nil))
|
||||
(action (ui-candidate-action (second (ui-result-candidates result)))))
|
||||
(ecase change
|
||||
(:head (setf (x11-backend-focused-head-id backend) "main"))
|
||||
;; Even an adapter-only focus change without a model revision is stale.
|
||||
(:focus (setf (presentation-focus-client-id (current-presentation world "other")) nil))
|
||||
(:activity (open-activity-draft world "other" "development"))
|
||||
(:hide (backend-hide-client backend "editor"))
|
||||
(:transfer (backend-show-client-taking backend "editor" :head-id "main"))
|
||||
(:retire (retire-client world "editor"))
|
||||
(:shared (set-client-shared world "editor" nil))
|
||||
(:home (move-client-to-activity world "editor" "chill")))
|
||||
(let ((before (lime.persistence:snapshot-world world)))
|
||||
(is (eq :keep-open (ui-result-kind (funcall action))))
|
||||
(is (equalp before (lime.persistence:snapshot-world world))))))))
|
||||
|
||||
(test non-prompting-private-command-and-sharing-alias-keep-the-current-home
|
||||
(dolist (explicit-head-p '(nil t))
|
||||
(with-membership-backend (backend world)
|
||||
(backend-set-client-shared backend "editor" t)
|
||||
(backend-show-client-taking backend "editor" :head-id "other")
|
||||
(when explicit-head-p (backend-select-head backend "main"))
|
||||
(let ((before (lime.persistence:snapshot-world world)))
|
||||
(signals stale-transition-plan
|
||||
(backend-make-client-private backend "editor" :head-id "other" :expected-revision -1))
|
||||
(is (equalp before (lime.persistence:snapshot-world world)))
|
||||
(when explicit-head-p
|
||||
(signals invalid-transition (backend-set-client-shared backend "editor" nil))
|
||||
(is (equalp before (lime.persistence:snapshot-world world)))))
|
||||
(if explicit-head-p (backend-make-client-private backend "editor" :head-id "other")
|
||||
(backend-set-client-shared backend "editor" nil))
|
||||
(is (equal "chill" (client-activity-id (find-client world "editor"))))
|
||||
(is (equal (if explicit-head-p "main" "other") (x11-backend-focused-head-id backend)))
|
||||
(is-false (client-shared-p (find-client world "editor")))
|
||||
(is (validate-world world)))))
|
||||
|
||||
(test delete-activity-is-discoverable-confirmed-and-non-mutating-until-approved
|
||||
(with-membership-backend (backend world)
|
||||
(create-activity world "old" "Old")
|
||||
(let* ((node (find :activity (lime.x11::%ui-key-path backend) :key #'ui-key-node-id))
|
||||
(delete-node (find :delete-activity (ui-key-node-children node) :key #'ui-key-node-id))
|
||||
(snapshot (lime.persistence:snapshot-world world))
|
||||
(picker (funcall (ui-key-node-action delete-node))))
|
||||
(is (char= #\d (ui-key-node-key delete-node)))
|
||||
(is (find :delete-activity (lime.x11::%command-palette-candidates backend) :key #'ui-candidate-id))
|
||||
(let* ((candidate (find '(:delete-activity "old") (ui-result-candidates picker) :key #'ui-candidate-id :test #'equal))
|
||||
(confirmation (funcall (ui-candidate-action candidate))))
|
||||
(is (eq :replace (ui-result-kind confirmation)))
|
||||
(is (eq :cancel (ui-candidate-id (first (ui-result-candidates confirmation)))))
|
||||
(funcall (ui-candidate-action (first (ui-result-candidates confirmation))))
|
||||
(is (equalp snapshot (lime.persistence:snapshot-world world)))
|
||||
(is (eq :close (ui-result-kind (funcall (ui-candidate-action (second (ui-result-candidates confirmation)))))))
|
||||
(signals unknown-entity (find-activity world "old"))
|
||||
(is (equal "development" (presentation-activity-id (current-presentation world "main"))))
|
||||
(is (equal "chill" (presentation-activity-id (current-presentation world "other"))))))))
|
||||
|
||||
(test activity-delete-menu-explains-blockers-and-rejects-stale-confirmations
|
||||
(with-membership-backend (backend world)
|
||||
(let ((snapshot (lime.persistence:snapshot-world world)))
|
||||
(is (eq :keep-open (ui-result-kind (lime.x11::%ui-delete-activity-result backend "development"))))
|
||||
(is (eq :keep-open (ui-result-kind (lime.x11::%ui-delete-activity-result backend "chill"))))
|
||||
(is (equalp snapshot (lime.persistence:snapshot-world world))))
|
||||
(create-activity world "old" "Old")
|
||||
(let* ((confirmation (lime.x11::%ui-delete-activity-result backend "old"))
|
||||
(action (ui-candidate-action (second (ui-result-candidates confirmation)))))
|
||||
(create-client world "new" "old")
|
||||
(let ((snapshot (lime.persistence:snapshot-world world)))
|
||||
(is (eq :keep-open (ui-result-kind (funcall action))))
|
||||
(is (equalp snapshot (lime.persistence:snapshot-world world))))
|
||||
(retire-client world "new")
|
||||
(delete-activity world "old")
|
||||
(create-activity world "old" "New activity, reused id")
|
||||
(is (eq :keep-open (ui-result-kind (funcall action))))
|
||||
(is (equal "New activity, reused id" (activity-name (find-activity world "old")))))))
|
||||
Reference in New Issue
Block a user