178 lines
13 KiB
Common Lisp
178 lines
13 KiB
Common Lisp
;;;; 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)))
|