Initial Lime window manager
This commit is contained in:
196
test/x11-membership-smoke.lisp
Normal file
196
test/x11-membership-smoke.lisp
Normal file
@@ -0,0 +1,196 @@
|
||||
;;;; Owned Xvfb only: real windows, menu actions, leases, and session restore.
|
||||
(require :asdf)
|
||||
(asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*)))
|
||||
(asdf:load-system "lime/x11")
|
||||
|
||||
(handler-case
|
||||
(let* ((directory (uiop:ensure-directory-pathname
|
||||
(string-trim '(#\Newline)
|
||||
(uiop:run-program '("mktemp" "-d" "/tmp/lime-membership-XXXXXX") :output :string))))
|
||||
(path (merge-pathnames "session.sexp" directory))
|
||||
(server (uiop:launch-program '("Xvfb" "-displayfd" "1" "-screen" "0" "1200x600x24" "-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 600)
|
||||
(lime.x11:make-x11-head :head-id "right" :x 600 :y 0 :width 600 :height 600))))
|
||||
(setf clients (xlib:open-default-display display-name))
|
||||
(let* ((root (xlib:screen-root (xlib:display-default-screen clients)))
|
||||
(a (xlib:create-window :parent root :x 0 :y 0 :width 100 :height 100))
|
||||
(b (xlib:create-window :parent root :x 0 :y 0 :width 100 :height 100))
|
||||
(aid nil) (bid nil))
|
||||
(labels ((check (truth label) (assert truth () "Membership: ~A" label) (incf checks))
|
||||
(world () (lime.x11:x11-backend-world backend))
|
||||
(current (head) (lime.core:current-presentation (world) head))
|
||||
(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)))
|
||||
(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) 400) () "Membership event queue did not settle.")
|
||||
(xlib:display-finish-output display)
|
||||
(unless (xlib:event-listen display)
|
||||
(setf (lime.x11::x11-backend-running-p b) nil))))))
|
||||
(key (key) (lime.x11::%perform-ui-action backend (list :key key)) (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 "candidate ~S" id))
|
||||
(lime.x11::%perform-ui-action backend (list :candidate candidate)))
|
||||
(pump))
|
||||
(adopt (window)
|
||||
(xlib:display-finish-output clients)
|
||||
(prog1 (lime.x11:manage-window backend
|
||||
(xlib::lookup-window (lime.x11::x11-backend-display backend)
|
||||
(xlib:window-id window)))
|
||||
(pump))))
|
||||
(start)
|
||||
(lime.x11:backend-start-activity backend "work" "Work")
|
||||
(lime.x11:backend-start-activity backend "chill" "Chill" :head-id "right")
|
||||
(lime.x11:backend-select-head backend "left")
|
||||
(setf aid (adopt a) bid (adopt b))
|
||||
(lime.x11:backend-save-view backend "code" "Code")
|
||||
(check (eq :viewable (xlib:window-map-state a)) "A initially shown")
|
||||
(check (eq :viewable (xlib:window-map-state b)) "B initially shown")
|
||||
(lime.x11:backend-open-command-palette backend)
|
||||
(key #\w) (key #\m)
|
||||
(check (eq :search (lime.ui:ui-session-mode (session))) "w m opens destination picker")
|
||||
(choose (list :move-client-to-activity bid "chill"))
|
||||
(check (not (session)) "move closes menu")
|
||||
(check (eq :viewable (xlib:window-map-state b)) "portable destination receives window without closing it")
|
||||
(check (= 2 (hash-table-count (lime.x11::x11-backend-client-windows backend))) "unmap did not withdraw client")
|
||||
(check (equal "work" (lime.core:presentation-activity-id (current "left"))) "move stays in source Activity")
|
||||
(check (equal (list bid) (lime.core:presentation-client-ids (current "right"))) "window joins actual portable arrangement")
|
||||
(check (equal aid (lime.core:presentation-focus-client-id (current "left"))) "source focuses surviving client")
|
||||
(check (equal (list aid) (mapcar #'lime.core:placement-client-id
|
||||
(lime.core:view-placements (lime.core:find-view (world) "code")))) "checkpoint pruned")
|
||||
(lime.x11:backend-activate-activity backend "chill" :head-id "left")
|
||||
(pump)
|
||||
(check (eq :viewable (xlib:window-map-state b)) "destination draft shows moved window")
|
||||
(check (= (xlib:window-id b) (xlib:window-id (xlib:input-focus clients))) "moved window receives real focus")
|
||||
(lime.x11:backend-activate-activity backend "work" :head-id "left")
|
||||
(pump)
|
||||
(lime.x11:backend-open-command-palette backend)
|
||||
(key #\w) (key #\s)
|
||||
(check (not (session)) "share action closes menu")
|
||||
(check (lime.core:client-shared-p (lime.core:find-client (world) aid)) "shared flag enabled")
|
||||
(check (< (xlib:drawable-x a) 600) "sharing alone does not move window")
|
||||
(lime.x11:backend-select-head backend "right")
|
||||
(lime.x11:backend-open-hidden-client-picker backend)
|
||||
(let ((before (lime.persistence:snapshot-world (world))))
|
||||
(choose (list :show-hidden-client aid))
|
||||
(check (equalp before (lime.persistence:snapshot-world (world))) "collision prompt changes no model state"))
|
||||
(choose (list :take-hidden-client aid))
|
||||
(check (not (session)) "explicit take closes menu")
|
||||
(check (>= (xlib:drawable-x a) 600) "same real window now on right Head")
|
||||
(check (= (xlib:window-id a) (xlib:window-id (xlib:input-focus clients))) "borrowed window focused")
|
||||
(check (equal "work" (lime.core:client-activity-id (lime.core:find-client (world) aid))) "home unchanged")
|
||||
(check (equal "right" (lime.x11::ewmh-active-head-id-for-client backend aid)) "one lease on right")
|
||||
(check (lime.core:validate-world (world)) "borrowed desk valid")
|
||||
(lime.x11:backend-hide-client backend bid :head-id "right")
|
||||
(lime.x11:backend-save-view backend "music" "Music")
|
||||
;; Persist shared guest plus moved private client, then reconnect
|
||||
;; to both existing XIDs, including the currently hidden one.
|
||||
(lime.x11:backend-save-session backend)
|
||||
(lime.x11:stop-backend backend)
|
||||
(setf backend nil)
|
||||
(start) (pump)
|
||||
(check (= 2 (getf (getf (lime.x11:backend-session-status backend) :restore) :matched)) "restart matches both clients")
|
||||
(check (lime.core:client-shared-p (lime.core:find-client (world) aid)) "sharing restored")
|
||||
(check (equal "right" (lime.x11::ewmh-active-head-id-for-client backend aid)) "borrowed lease restored")
|
||||
(check (eq :unmapped (xlib:window-map-state b)) "moved private window remains parked")
|
||||
(check (>= (xlib:drawable-x a) 600) "borrowed real placement restored")
|
||||
;; Left still has an unavailable slot, not an omitted placement;
|
||||
;; the same Super-i workflow must be able to take it back.
|
||||
(lime.x11:backend-select-head backend "left")
|
||||
(lime.x11:backend-open-hidden-client-picker backend)
|
||||
(choose (list :show-hidden-client aid))
|
||||
(choose (list :take-hidden-client aid))
|
||||
(check (< (xlib:drawable-x a) 600) "shared slot summoned back")
|
||||
(lime.x11:backend-show-client-taking backend aid :head-id "right")
|
||||
(pump)
|
||||
(let ((before (lime.persistence:snapshot-world (world)))
|
||||
(lease (lime.core:lease-for-client (world) aid))
|
||||
(target (current "right"))
|
||||
(geometry (list (xlib:drawable-x a) (xlib:drawable-y a)
|
||||
(xlib:drawable-width a) (xlib:drawable-height a))))
|
||||
(lime.x11:backend-open-command-palette backend)
|
||||
(key #\w) (key #\s)
|
||||
(check (lime.core:client-shared-p (lime.core:find-client (world) aid)) "private action waits for confirmation")
|
||||
(check (find "Make private to Chill" (lime.ui:ui-session-candidates (session))
|
||||
:key #'lime.ui:ui-candidate-label :test #'equal) "confirmation names current Activity")
|
||||
(key :return)
|
||||
(check (not (session)) "private confirmation defaults to Cancel")
|
||||
(check (equalp before (lime.persistence:snapshot-world (world))) "Cancel leaves world untouched")
|
||||
(lime.x11:backend-open-command-palette backend)
|
||||
(key #\w) (key #\s)
|
||||
(choose (list :make-client-private aid))
|
||||
(check (eq :viewable (xlib:window-map-state a)) "private window stays mapped")
|
||||
(check (equal geometry (list (xlib:drawable-x a) (xlib:drawable-y a)
|
||||
(xlib:drawable-width a) (xlib:drawable-height a))) "geometry unchanged")
|
||||
(check (= (xlib:window-id a) (xlib:window-id (xlib:input-focus clients))) "real focus unchanged")
|
||||
(check (eq lease (lime.core:lease-for-client (world) aid)) "same lease object retained")
|
||||
(check (eq target (current "right")) "same arrangement retained"))
|
||||
(check (not (lime.core:client-shared-p (lime.core:find-client (world) aid))) "sharing revoked")
|
||||
(check (equal "chill" (lime.core:client-activity-id (lime.core:find-client (world) aid))) "current Activity becomes home")
|
||||
(check (null (lime.core:view-placements (lime.core:find-view (world) "code"))) "old home checkpoint cleaned")
|
||||
(check (equal (list aid) (mapcar #'lime.core:placement-client-id
|
||||
(lime.core:view-placements (lime.core:find-view (world) "music")))) "current Activity checkpoint retained")
|
||||
(check (handler-case (progn (lime.x11:backend-show-client backend aid :head-id "left") nil)
|
||||
(lime.core:invalid-transition () t)) "old home cannot reclaim private client")
|
||||
(check (null (lime.x11::x11-backend-last-command-error backend)) "no command errors")
|
||||
(check (lime.core:validate-world (world)) "final world valid")
|
||||
;; Deletion uses a picker and explicit confirmation, never an
|
||||
;; application close. Exercise actual key/menu dispatch and X.
|
||||
(lime.x11:backend-start-activity backend "old" "Old task" :head-id "left")
|
||||
(lime.x11:backend-save-view backend "old/checkpoint" "Checkpoint" :head-id "left")
|
||||
(lime.x11:backend-activate-activity backend "work" :head-id "left")
|
||||
(pump)
|
||||
(let ((snapshot (lime.persistence:snapshot-world (world))))
|
||||
(lime.x11:backend-open-command-palette backend)
|
||||
(key #\a) (key #\d)
|
||||
(check (eq :search (lime.ui:ui-session-mode (session))) "a d opens deletion picker")
|
||||
(choose '(:delete-activity "old"))
|
||||
(check (equalp snapshot (lime.persistence:snapshot-world (world))) "deletion prompt does not mutate")
|
||||
(key :return)
|
||||
(check (not (session)) "Enter defaults to Cancel")
|
||||
(check (equalp snapshot (lime.persistence:snapshot-world (world))) "cancel retains Activity and arrangements"))
|
||||
(lime.x11:backend-open-command-palette backend)
|
||||
(key #\a) (key #\d)
|
||||
(choose '(:delete-activity "old"))
|
||||
(choose '(:confirm-delete-activity "old"))
|
||||
(check (not (session)) "confirmed deletion closes menu")
|
||||
(check (not (find "old" (lime.core:list-activities (world)) :key #'lime.core:activity-id :test #'equal)) "Activity removed")
|
||||
(check (equal "work" (lime.core:presentation-activity-id (current "left"))) "left Head unchanged")
|
||||
(check (equal "chill" (lime.core:presentation-activity-id (current "right"))) "right Head unchanged")
|
||||
(check (= 2 (hash-table-count (lime.x11::x11-backend-client-windows backend))) "all real windows retained")
|
||||
(check (eq :viewable (xlib:window-map-state a)) "visible client stays visible")
|
||||
(check (eq :unmapped (xlib:window-map-state b)) "hidden client stays hidden")
|
||||
(lime.x11:backend-save-session backend)
|
||||
(lime.x11:stop-backend backend)
|
||||
(setf backend nil)
|
||||
(start) (pump)
|
||||
(check (not (find "old" (lime.core:list-activities (world)) :key #'lime.core:activity-id :test #'equal)) "deleted Activity stays deleted after restart")
|
||||
(check (equal "chill" (lime.core:client-activity-id (lime.core:find-client (world) aid))) "new home survives restart")
|
||||
(check (not (lime.core:client-shared-p (lime.core:find-client (world) aid))) "private flag survives restart")
|
||||
(check (equal "right" (lime.x11::ewmh-active-head-id-for-client backend aid)) "private lease restored on right")
|
||||
(check (and (eq :viewable (xlib:window-map-state a)) (>= (xlib:drawable-x a) 600)) "private window restored in place")
|
||||
(check (null (lime.core:view-placements (lime.core:find-view (world) "code"))) "old checkpoint pruning persists")
|
||||
(check (equal (list aid) (mapcar #'lime.core:placement-client-id
|
||||
(lime.core:view-placements (lime.core:find-view (world) "music")))) "kept checkpoint persists")
|
||||
(check (null (lime.x11::x11-backend-last-command-error backend)) "no deletion menu errors")
|
||||
(check (lime.core:validate-world (world)) "post-deletion restored world valid")
|
||||
(format t "~&Membership 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* "~&Membership smoke failed: ~A~%" condition)
|
||||
(uiop:quit 1)))
|
||||
Reference in New Issue
Block a user