;;;; 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)))