;;;; Real XSETTINGS clients, Xresources, configuration rollback, and ownership. ;;;; Own Xvfb only; requires Python 3 with PyGObject/GTK 3 for the client probe. (require :asdf) (asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*))) (asdf:load-system "lime/x11") (defun run-cursor-session-smoke () (let ((server nil) (probe nil) (client nil) (backend nil) (checks 0)) (unwind-protect (progn (setf server (uiop:launch-program '("Xvfb" "-displayfd" "1" "-screen" "0" "800x600x24" "-screen" "1" "640x480x24" "-nolisten" "tcp") :output :stream :error-output :interactive)) (let* ((number (parse-integer (read-line (uiop:process-info-output server)))) (name (format nil ":~D" number)) (original (format nil "! Keep my resources~%Xft.dpi: 96~%Xcursor.theme: Adwaita~%Xcursor.size: 20~%Other.value: original~%")) (config (lime.x11:make-lime-configuration :cursor (lime.x11:make-ui-cursor-style :theme "Bibata-Original-Ice" :size 24))) (environment-theme (uiop:getenv "XCURSOR_THEME")) (environment-size (uiop:getenv "XCURSOR_SIZE"))) (setf client (xlib:open-default-display name)) (let* ((root (xlib:screen-root (xlib:display-default-screen client))) (other-root (xlib:screen-root (second (xlib:display-roots client)))) (baseline nil)) (labels ((check (truth label) (assert truth () "Cursor session: ~A" label) (incf checks)) (sync () (xlib:display-finish-output client)) (resources () (lime.x11::%read-session-resources root)) (owner () (xlib:selection-owner client :_XSETTINGS_S0)) (state () (gethash backend lime.x11::*cursor-session-settings*)) (start-probe () (setf probe (uiop:launch-program (list "env" "GDK_BACKEND=x11" "GTK_USE_PORTAL=0" (format nil "DISPLAY=~A" name) "python3" "test/gtk-cursor-probe.py") :input :stream :output :stream :error-output :interactive)) (uiop:split-string (read-line (uiop:process-info-output probe)) :separator "|")) (query () (write-line "query" (uiop:process-info-input probe)) (finish-output (uiop:process-info-input probe)) (uiop:split-string (read-line (uiop:process-info-output probe)) :separator "|")) (expect-gtk (theme size) (let ((answer (loop repeat 50 for answer = (query) when (and (equal theme (first answer)) (equal (princ-to-string size) (second answer))) return answer))) (check answer (format nil "GTK sees ~A / ~A (now ~S)" theme size (unless answer (query)))) (check (equal (cddr answer) (cddr baseline)) "GTK font/icon/application theme unchanged"))) (apply-style (theme size) (let ((next (lime.x11::copy-lime-configuration config))) (setf (lime.x11:lime-configuration-cursor next) (lime.x11:make-ui-cursor-style :theme theme :size size)) (lime.x11:apply-lime-configuration backend next))) (pump () (loop repeat 200 while (lime.x11::%dispatch-next-event backend 0)))) (lime.x11::%write-session-resources root original) (sync) ;; The GTK process predates the manager: exercise MANAGER discovery. (setf baseline (start-probe)) (setf backend (lime.x11:start-backend :display-name name :head-discovery :none :install-default-keybindings-p nil)) (check (null (owner)) "no implicit settings manager with system defaults") (xlib:send-event root :client-message '(:substructure-notify) :window root :type :_LIME_CURSOR_TEST :format 32 :data #(0 0 0 0 0)) (sync) (lime.x11:apply-lime-configuration backend config) (check (xlib:event-case ((lime.x11::x11-backend-display backend) :timeout 0 :discard-p nil) (:client-message (type) (eq type :_LIME_CURSOR_TEST))) "timestamp acquisition preserves unrelated queued events") (check (owner) "manager selection acquired") (check (zerop (hash-table-count (lime.core::world-clients (lime.x11:x11-backend-world backend)))) "settings window is not a managed client") (check (search "Xcursor.theme: Bibata-Original-Ice" (resources)) "theme resource") (check (search "Xcursor.size: 24" (resources)) "size resource") (check (search "Other.value: original" (resources)) "unrelated resources preserved") (check (null (xlib:get-property other-root :RESOURCE_MANAGER)) "other X screen resources untouched") (check (null (xlib:selection-owner client :_XSETTINGS_S1)) "other X screen selection untouched") (expect-gtk "Bibata-Original-Ice" 24) (check (equal "Bibata-Original-Ice|24" (string-trim '(#\Newline) (uiop:run-program (list "env" "-u" "XCURSOR_THEME" "-u" "XCURSOR_SIZE" (format nil "DISPLAY=~A" name) "python3" "-c" "import ctypes as c; x=c.CDLL('libX11.so.6'); u=c.CDLL('libXcursor.so.1'); x.XOpenDisplay.restype=c.c_void_p; d=x.XOpenDisplay(None); u.XcursorGetTheme.argtypes=[c.c_void_p]; u.XcursorGetTheme.restype=c.c_char_p; u.XcursorGetDefaultSize.argtypes=[c.c_void_p]; print(u.XcursorGetTheme(d).decode()+'|'+str(u.XcursorGetDefaultSize(d))); x.XCloseDisplay.argtypes=[c.c_void_p]; x.XCloseDisplay(d)") :output :string))) "new non-GTK Xcursor client reads session resources") (multiple-value-bind (data type format) (xlib:get-property (owner) :_XSETTINGS_SETTINGS) (check (eq type :_XSETTINGS_SETTINGS) "settings property type") (check (= format 8) "settings property format") (check (equalp (coerce data 'vector) (lime.x11::%xsettings-cursor-bytes "Bibata-Original-Ice" 24 1)) "independent client reads complete initial publication")) (let ((first-owner (owner))) (apply-style "Bibata-Original-Classic" 32) (check (xlib:window-equal first-owner (owner)) "reload keeps selection window stable") (expect-gtk "Bibata-Original-Classic" 32)) ;; A child sees the cursor environment; the WM process does not. (let ((output (uiop:run-program (lime.x11::%cursor-session-launch-argv backend '("python3" "-c" "import os; print(os.environ['XCURSOR_THEME']); print(os.environ['XCURSOR_SIZE'])")) :output :string))) (check (equal output (format nil "Bibata-Original-Classic~%32~%")) "real child inherits configured cursor settings") (check (equal environment-theme (uiop:getenv "XCURSOR_THEME")) "parent theme environment unchanged") (check (equal environment-size (uiop:getenv "XCURSOR_SIZE")) "parent size environment unchanged")) ;; New settings are visible to hooks, but failing hooks roll back. (let ((bad (lime.x11::copy-lime-configuration config)) (caught nil)) (setf (lime.x11:lime-configuration-startup-hooks bad) (list (lambda (backend) (check (equal "Bibata-Original-Ice" (lime.x11::cursor-session-settings-theme (gethash backend lime.x11::*cursor-session-settings*))) "startup hook sees new settings") (error "Rollback fixture")))) (handler-case (lime.x11:apply-lime-configuration backend bad :run-startup-hooks-p t) (error () (setf caught t))) (check caught "failed config reported") (expect-gtk "Bibata-Original-Classic" 32) (check (search "Xcursor.size: 32" (resources)) "failed config resources rolled back")) ;; Returning to defaults must not read Lime's own last theme. (apply-style nil nil) (check (null (owner)) "system defaults release manager") (check (equal original (resources)) "exact original resource bytes restored") ;; GTK 3 caches a removed XSETTING in GtkSettings even though ;; GDK removes it. A fresh process must use its own defaults. (uiop:terminate-process probe) (uiop:wait-process probe) (check (equal baseline (start-probe)) "new GTK client returns to its own defaults") (check (equal (getf (lime.x11:backend-cursor-report backend) :theme) (or environment-theme "Adwaita")) "NIL theme avoids publication feedback") (apply-style nil 48) (expect-gtk (first baseline) 48) (check (search "Xcursor.theme: Adwaita" (resources)) "size-only config retains original theme resource") (apply-style :core 32) (check (null (owner)) "core mode does not impose core on applications") (check (equal original (resources)) "core mode restores resources") ;; Never steal a manager started before us or taking over later. (let ((external (xlib:create-window :parent root :x -1 :y -1 :width 1 :height 1))) (unwind-protect (progn (setf (xlib:selection-owner client :_XSETTINGS_S0) external) (sync) (apply-style "Bibata-Original-Ice" 24) (check (xlib:window-equal external (owner)) "existing manager never stolen") (check (eq :external-manager (lime.x11::cursor-session-settings-manager-status (state))) "existing manager is reported") (setf (xlib:selection-owner client :_XSETTINGS_S0) nil) (sync) (apply-style "Bibata-Original-Ice" 24) (let ((old-window (lime.x11::cursor-session-settings-window (state)))) (setf (xlib:selection-owner client :_XSETTINGS_S0) external) (sync) (pump) (check (null (lime.x11::cursor-session-settings-window (state))) "SelectionClear destroys our manager") (check (xlib:window-equal external (owner)) "takeover is respected") (check (not (member (xlib:window-id old-window) (mapcar #'xlib:window-id (xlib:query-tree root)))) "retired manager window actually destroyed"))) (xlib:destroy-window external) (sync))) ;; External xrdb edits must not be lost at shutdown. (apply-style "Bibata-Original-Ice" 24) (lime.x11::%write-session-resources root (lime.x11::%replace-cursor-resource (concatenate 'string (resources) (format nil "Other.added: later~%")) "Xcursor.size" (list (format nil "Xcursor.size: 64~%")))) (sync) (lime.x11:stop-backend backend :save-session-p nil) (check (null (owner)) "shutdown releases selection") (check (search "Other.added: later" (resources)) "external unrelated edit retained") (check (search "Xcursor.size: 64" (resources)) "externally replaced cursor size retained") (check (search "Xcursor.theme: Adwaita" (resources)) "still-owned theme restored") (check (null (gethash backend lime.x11::*cursor-session-settings*)) "shutdown forgets backend state") (format t "~&Live X11 cursor session: ~D checks passed.~%" checks))))) (when backend (lime.x11:stop-backend backend :save-session-p nil)) (when probe (uiop:terminate-process probe) (uiop:wait-process probe)) (when client (xlib:close-display client :abort t)) (when server (uiop:terminate-process server) (uiop:wait-process server))))) (handler-case (run-cursor-session-smoke) (error (condition) (format *error-output* "~&Cursor session smoke failed: ~A~%" condition) (uiop:quit 1)))