;;;; Real ICCCM/EWMH events on an owned Xvfb; never touches the user's DISPLAY. (require :asdf) (asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*))) (asdf:load-system "lime/x11") (handler-case (let ((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))) (setf backend (lime.x11:start-lime :display-name display-name :install-default-keybindings-p nil :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))) clients (xlib:open-default-display display-name)) (let* ((display (lime.x11::x11-backend-display backend)) (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 () "Attention: ~A" label) (incf checks)) (world () (lime.x11:x11-backend-world backend)) (current (head) (lime.core:current-presentation (world) head)) (needs (id) (lime.x11:backend-client-needs-attention-p backend id)) (focused () (xlib:window-id (xlib:input-focus clients))) (pump () (xlib:display-finish-output clients) (let ((turns 0)) (lime.x11:run-event-loop backend :timeout 0.005 :before-event (lambda (b) (assert (< (incf turns) 400) () "Attention event queue did not settle.") (xlib:display-finish-output display) (unless (xlib:event-listen display) (setf (lime.x11::x11-backend-running-p b) nil)))))) (hints (w urgent &optional (input 1)) (xlib:change-property w :WM_HINTS (list (+ 3 (if urgent 256 0)) input 1 0 0 0 0 0 0) :WM_HINTS 32) (pump)) (state (w action &optional (first :_NET_WM_STATE_DEMANDS_ATTENTION) second) (xlib:send-event root :client-message '(:substructure-redirect :substructure-notify) :window w :type :_NET_WM_STATE :format 32 :data (list action (xlib:intern-atom clients first) (if second (xlib:intern-atom clients second) 0) 1 0)) (pump)) (atoms (w) (xlib:get-property w :_NET_WM_STATE :type :ATOM)) (has-atom (w name) (member (xlib:intern-atom clients name) (atoms w))) (key (key) (lime.x11::%perform-ui-action backend (list :key key)) (pump)) (visit (id) (lime.x11:backend-open-attention-picker backend) (let ((candidate (find (list :attend-client id) (lime.ui:ui-session-candidates (lime.x11::x11-backend-ui-session backend)) :key #'lime.ui:ui-candidate-id :test #'equal))) (check candidate "visit target appears in picker") (lime.x11::%perform-ui-action backend (list :candidate candidate))) (pump)) (adopt (w) (xlib:display-finish-output clients) (prog1 (lime.x11:manage-window backend (xlib::lookup-window display (xlib:window-id w))) (pump)))) (lime.x11:backend-start-activity backend "work" "Work") (xlib:change-property a :_NET_WM_NAME (babel:string-to-octets "Urgent 日本語" :encoding :utf-8) :UTF8_STRING 8) (setf aid (adopt a) bid (adopt b)) (check (= (focused) (xlib:window-id b)) "new client B focused") (check (member (xlib:intern-atom clients :_NET_WM_STATE_DEMANDS_ATTENTION) (xlib:get-property root :_NET_SUPPORTED)) "EWMH support advertised") (let ((snapshot (lime.persistence:snapshot-world (world)))) (hints a t) (check (needs aid) "ICCCM urgency noticed") (check (= (focused) (xlib:window-id b)) "urgency never steals focus") (check (equal snapshot (lime.persistence:snapshot-world (world))) "hint does not dirty or persist model state")) (check (string= "! 1" (lime.x11:head-bar-segment-text (lime.x11::%bar-attention-segment backend))) "bar counts urgent window") (hints b t) (check (not (needs bid)) "already attended client acknowledged") (check (= 3 (first (xlib:get-property b :WM_HINTS))) "only urgency bit cleared") (check (= 1 (second (xlib:get-property b :WM_HINTS))) "InputHint preserved") ;; Two independent sources must not clear one another. (state a 1) (check (equal (list aid) (lime.x11:backend-attention-client-ids backend)) "deduplicated two-source count") (state a 0) (check (needs aid) "removing EWMH request leaves ICCCM urgency") (hints a nil) (check (not (needs aid)) "client cancellation clears last source") (state a 2) (check (needs aid) "EWMH toggle adds") (state a 2) (check (not (needs aid)) "EWMH toggle removes") (state a 9) (check (not (needs aid)) "invalid action ignored") (state a 1 :_NET_WM_STATE_ABOVE :_NET_WM_STATE_DEMANDS_ATTENTION) (check (needs aid) "second atom in message supported") (state a 0) (state a 2 :_NET_WM_STATE_DEMANDS_ATTENTION :_NET_WM_STATE_DEMANDS_ATTENTION) (check (needs aid) "duplicate toggle applied once") (lime.x11:backend-use-monocle-layout backend) (pump) (check (eq :unmapped (xlib:window-map-state a)) "non-selected monocle member stays hidden") (check (needs aid) "monocle hiding does not acknowledge") (visit aid) (check (= (focused) (xlib:window-id a)) "attention visit selects monocle member") (check (not (needs aid)) "visible monocle member acknowledged") (lime.x11:backend-use-master-stack-layout backend) (lime.x11:backend-focus-client backend bid :head-id "left") (state a 1) ;; Hidden, then inactive Activity: no automatic reveal. (lime.x11:backend-hide-client backend aid) (pump) (check (eq :unmapped (xlib:window-map-state a)) "urgent window can stay hidden") (lime.x11:backend-start-activity backend "chill" "Chill") (pump) (check (needs aid) "inactive Activity remains discoverable") (check (string= "Work: Urgent 日本語" (lime.ui:ui-candidate-label (first (lime.x11::%ui-attention-candidates backend)))) "picker identifies task and live title") ;; The real bar event path opens the picker without dismissing it. (let* ((bar (gethash "left" (lime.x11::x11-backend-head-bars backend))) (region (car (last (lime.x11::x11-head-bar-hit-regions bar)))) (x (floor (+ (lime.x11::x11-head-bar-hit-region-left region) (lime.x11::x11-head-bar-hit-region-right region)) 2))) (xlib/xtest:fake-motion-event display x 10) (xlib/xtest:fake-button-event display 1 t) (xlib/xtest:fake-button-event display 1 nil) (pump) (check (lime.x11:backend-command-palette-open-p backend) "clickable badge opens picker") (check (needs aid) "opening picker does not acknowledge") (key :escape) (check (needs aid) "cancelling picker leaves parked request")) (lime.x11:backend-open-command-palette backend) (key #\w) (key #\a) (check (eq :search (lime.ui:ui-session-mode (lime.x11::x11-backend-ui-session backend))) "w a enters attention search") (key :return) (check (not (lime.x11:backend-command-palette-open-p backend)) "visit closes picker") (check (equal "work" (lime.core:presentation-activity-id (current "left"))) "visit returns to owning Activity") (check (= (focused) (xlib:window-id a)) "hidden target revealed and focused") (check (not (needs aid)) "visit acknowledges after menu grab ends") (lime.x11:backend-set-client-fullscreen backend bid t) (state a 1) (visit aid) (check (= (focused) (xlib:window-id a)) "explicit visit escapes a different fullscreen window") (check (not (has-atom b :_NET_WM_STATE_FULLSCREEN)) "masking fullscreen exited only on user visit") ;; Actual focus matters: root background and another Head's saved ;; focus are not acknowledgement. (lime.x11:backend-focus-head-background backend "left") (hints a t) (check (needs aid) "root focus does not acknowledge saved focus") (lime.x11:backend-focus-client backend bid :head-id "left") (lime.x11:backend-activate-activity backend "work" :head-id "right") (lime.x11:backend-show-client-taking backend aid :head-id "right") (lime.x11:backend-select-head backend "left") (hints a t) (check (needs aid) "other Head's current client stays urgent") (let ((lease (lime.core:lease-presentation-id (lime.core:lease-for-client (world) aid)))) (visit aid) (check (equal "right" (lime.x11::x11-backend-focused-head-id backend)) "visit follows existing Head") (check (equal lease (lime.core:lease-presentation-id (lime.core:lease-for-client (world) aid))) "visit never transfers existing lease") (check (not (needs aid)) "other Head visit acknowledges")) ;; Preserve unknown state and fullscreen on acknowledgement. (lime.x11:backend-select-head backend "left") (xlib:change-property a :_NET_WM_STATE (list (xlib:intern-atom clients :_TEST_CUSTOM_STATE)) :ATOM 32) (state a 1 :_NET_WM_STATE_FULLSCREEN :_NET_WM_STATE_DEMANDS_ATTENTION) ;; Existing fullscreen command may select the requested Head. ;; Move back, set attention anew, then visit the fullscreen target. (lime.x11:backend-select-head backend "left") (state a 1) (visit aid) (check (has-atom a :_TEST_CUSTOM_STATE) "unknown state preserved") (check (has-atom a :_NET_WM_STATE_FULLSCREEN) "fullscreen preserved") (check (not (has-atom a :_NET_WM_STATE_DEMANDS_ATTENTION)) "only attention state removed") (lime.x11:backend-set-client-fullscreen backend aid nil) ;; Globally active clients must actually answer TAKE_FOCUS. (lime.x11:backend-select-head backend "left") (hints a nil 0) (setf (xlib:wm-protocols a) '(:WM_TAKE_FOCUS)) (pump) (state a 1) (lime.x11:backend-attend-client backend aid) (pump) (check (needs aid) "unanswered TAKE_FOCUS does not clear attention") (let ((child (xlib:create-window :parent a :x 0 :y 0 :width 20 :height 20))) (xlib:map-window child) (xlib:set-input-focus clients child :pointer-root) (pump) (check (not (needs aid)) "async focus to child acknowledges owning client")) ;; Initial hints, NoInput clients, property deletion and withdrawal. (let ((c (xlib:create-window :parent root :x 0 :y 0 :width 100 :height 100))) (xlib:change-property c :WM_HINTS '(259 0 1 0 0 0 0 0 0) :WM_HINTS 32) (xlib:change-property c :_NET_WM_STATE (list (xlib:intern-atom clients :_NET_WM_STATE_DEMANDS_ATTENTION)) :ATOM 32) (let ((cid (adopt c))) (check (needs cid) "initial hints adopted; NoInput client not acknowledged") (check (= 3 (gethash cid (lime.x11::x11-backend-attention-clients backend))) "both initial sources retained") (xlib:delete-property c :WM_HINTS) (pump) (check (= 2 (gethash cid (lime.x11::x11-backend-attention-clients backend))) "deleted WM_HINTS clears only urgency") (xlib:delete-property c :_NET_WM_STATE) (pump) (check (not (needs cid)) "deleted state clears demand") (xlib:change-property c :_NET_WM_STATE (list (xlib:intern-atom clients :_NET_WM_STATE_DEMANDS_ATTENTION)) :ATOM 32) (pump) (check (needs cid) "direct property change observed without focus") (xlib:unmap-window c) (pump) (check (not (needs cid)) "withdrawal clears attention cache") (check (null (gethash cid (lime.x11::x11-backend-client-windows backend))) "withdrawal really retires client") (xlib:destroy-window c) (pump))) ;; Hidden _NET_ACTIVE_WINDOW stays hidden but creates attention. (lime.x11:backend-hide-client backend aid :head-id "right") (xlib:send-event root :client-message '(:substructure-redirect :substructure-notify) :window a :type :_NET_ACTIVE_WINDOW :format 32 :data '(1 0 0 0 0)) (pump) (check (needs aid) "denied hidden activation becomes attention") (check (eq :unmapped (xlib:window-map-state a)) "denied activation never reveals window") ;; Destroy cleans cache and an already-open stale picker stays safe. (lime.x11:backend-open-attention-picker backend) (xlib:destroy-window a) (pump) (check (not (needs aid)) "destroy clears attention") (key :return) (check (lime.x11:backend-command-palette-open-p backend) "stale picker stays open with explanation") (check (null (lime.x11::x11-backend-last-command-error backend)) "no UI error after stale selection") (key :escape) (check (null (lime.x11:backend-attention-client-ids backend)) "no phantom attention remains") (format t "~&Attention 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* "~&Attention smoke failed: ~A~%" condition) (uiop:quit 1)))