gansito05/lime
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Lime window manager

Browse Source
This commit is contained in:
Adan
2026-10-02 14:14:47 -05:00
commit 785c2e8968
103 changed files with 27259 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

233
test/x11-attention-smoke.lisp Normal file
View File

@@ -0,0 +1,233 @@
;;;; 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)))