;;;; Fixed-size adoption via real MapRequest/PropertyNotify on an owned Xvfb. ;;;; Run with sbcl --non-interactive --load test/x11-fixed-size-smoke.lisp. ;;;; Never connects to the user's DISPLAY or launches Discord itself. (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" "2000x622x24" "-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 1000 :height 622) (lime.x11:make-x11-head :head-id "right" :x 1000 :y 0 :width 1000 :height 622)))) (setf clients (xlib:open-default-display display-name) backend (lime.x11:start-lime :display-name display-name :heads heads :install-default-keybindings-p nil)) (setf (lime.x11::x11-backend-window-appearance backend) (lime.x11:make-window-appearance :border-width 3 :inner-gap 5 :outer-gap 5)) (let ((root (xlib:screen-root (xlib:display-default-screen clients))) (fixed (xlib:make-wm-size-hints :min-width 300 :max-width 300 :min-height 200 :max-height 200))) (labels ((check (truth label) (assert truth () "Fixed-size: ~A" label) (incf checks)) (world () (lime.x11:x11-backend-world backend)) (current (head) (lime.core:current-presentation (world) head)) (id (window) (lime.x11::%backend-client-id backend window)) (kind (window &optional (head "left")) (lime.core:placement-kind (find (id window) (lime.core:presentation-placements (current head)) :key #'lime.core:placement-client-id :test #'equal))) (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) () "Fixed-size event queue did not settle.") (xlib:display-finish-output display) (unless (xlib:event-listen display) (setf (lime.x11::x11-backend-running-p b) nil)))))) (spawn (&key hints (class "discord") type parent) (let ((window (xlib:create-window :parent root :x 17 :y 37 :width 300 :height 200 :background 0))) (xlib:set-wm-class window class class) (when hints (setf (xlib:wm-normal-hints window) hints)) (when type (xlib:change-property window :_NET_WM_WINDOW_TYPE (list (xlib:intern-atom clients type)) :ATOM 32)) (when parent (xlib:change-property window :WM_TRANSIENT_FOR (list (xlib:window-id parent)) :WINDOW 32)) (xlib:map-window window) (pump) (check (id window) "MapRequest adopted client") (check (eq :viewable (xlib:window-map-state window)) "client is visible") window)) (destroy (window) (xlib:destroy-window window) (pump)) (check-full-tile (window) (check (equal '(0 22 1000 600 0) (list (xlib:drawable-x window) (xlib:drawable-y window) (xlib:drawable-width window) (xlib:drawable-height window) (xlib:drawable-border-width window))) "sole browser tile retains entire work area without gaps/borders"))) (lime.x11:backend-select-head backend "left") (let* ((browser (spawn :class "Browser")) (popup (spawn :hints fixed))) (check (eq :tile (kind browser)) "ordinary browser is tiled") (check (eq :float (kind popup)) "untyped fixed-size startup window floats") (check (equal '(:normal) (lime.x11::ewmh-client-window-types backend (id popup))) "float does not depend on an EWMH splash type") (check-full-tile browser) (check (equal '(350 222 300 200 3) (list (xlib:drawable-x popup) (xlib:drawable-y popup) (xlib:drawable-width popup) (xlib:drawable-height popup) (xlib:drawable-border-width popup))) "popup preserves fixed content size, centers in work area, and keeps border") (check (= (xlib:window-id popup) (xlib:window-id (xlib:input-focus clients))) "new popup receives real X focus") ;; The focused Head, not the global root center, owns the popup. (lime.x11:backend-select-head backend "right") (let ((other (spawn :hints fixed))) (check (eq :float (kind other "right")) "popup follows selected Head") (check (= 1350 (xlib:drawable-x other)) "right popup centers in right work area") (check (equal "right" (lime.x11::ewmh-active-head-id-for-client backend (id other))) "popup has one lease on right Head") (check-full-tile browser) (destroy other)) (lime.x11:backend-select-head backend "left") ;; A user can retile it. Subsequent hints must not undo that. (lime.x11:backend-toggle-client-floating backend (id popup)) (setf (xlib:wm-normal-hints popup) (xlib:make-wm-size-hints :min-width 100 :min-height 100)) (pump) (check (eq :tile (kind popup)) "manual retile survives resizable hints") (setf (xlib:wm-normal-hints popup) fixed) (pump) (check (eq :tile (kind popup)) "later fixed hints do not reclassify existing client") (destroy popup) (check-full-tile browser) ;; Discord's main window uses the same class but only minima. (let ((main (spawn :hints (xlib:make-wm-size-hints :min-width 800 :min-height 500)))) (check (eq :tile (kind main)) "resizable Discord main window remains tiled") (check (< (xlib:drawable-width browser) 1000) "main window participates in master/stack") (destroy main)) (check-full-tile browser) ;; A fixed width alone is not a fixed-size client. (let ((one-axis (spawn :hints (xlib:make-wm-size-hints :min-width 300 :max-width 300)))) (check (eq :tile (kind one-axis)) "one fixed axis stays tiled") (destroy one-axis)) (setf (lime.x11::x11-backend-configuration backend) (lime.x11:make-lime-configuration :new-client-focus-p nil)) (let ((quiet (spawn :hints fixed))) (check (eq :float (kind quiet)) "no-focus configuration still floats fixed window") (check (= (xlib:window-id browser) (xlib:window-id (xlib:input-focus clients))) "configured no-focus-on-new-client respected") (destroy quiet)) (setf (lime.x11::x11-backend-configuration backend) (lime.x11:make-lime-configuration :rules (list (lime.x11:make-window-rule :resource-class "discord" :float-p nil)))) (let ((forced (spawn :hints fixed)) (splash (spawn :type :_NET_WM_WINDOW_TYPE_SPLASH))) (check (eq :tile (kind forced)) "explicit tiling rule overrides fixed-size default") (check (eq :float (kind splash)) "EWMH splash policy still wins over ordinary rules") (lime.x11:backend-select-head backend "right") (let ((transient (spawn :hints fixed :parent browser))) (check (eq :float (kind transient)) "transient parent policy still wins") (check (equal "left" (lime.x11::ewmh-active-head-id-for-client backend (id transient))) "transient follows parent onto left Head") (destroy transient)) (destroy forced) (destroy splash)) (check-full-tile browser) (check (null (lime.x11::x11-backend-last-command-error backend)) "no command errors") (check (lime.core:validate-world (world)) "final world and leases valid") (format t "~&Fixed-size 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* "~&Fixed-size smoke failed: ~A~%" condition) (uiop:quit 1)))