;;;; Opt-in real-X regression test; requires Xvfb and local Lisp dependencies. ;;;; Run from any directory: sbcl --non-interactive --load /path/to/this/file ;;;; Uses a fresh server selected by -displayfd, never the current DISPLAY. (require :asdf) (asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*))) (asdf:load-system "lime/x11") (let ((server (uiop:launch-program '("Xvfb" "-displayfd" "1" "-screen" "0" "1000x622x24" "-nolisten" "tcp") :output :stream :error-output :interactive)) (backend nil) (client-display 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 :head-discovery :none :config-file (asdf:system-relative-pathname "lime" "test/x11-appearance-config.lisp")) client-display (xlib:open-default-display display-name)) (let* ((display (lime.x11::x11-backend-display backend)) (root (lime.x11::x11-backend-root backend)) (client-root (xlib:screen-root (xlib:display-default-screen client-display))) (windows (loop repeat 3 collect (xlib:create-window :parent client-root :x 0 :y 0 :width 100 :height 100 :border-width 7 :background 0))) (ids nil)) (labels ((check (truth label) (assert truth () "Failed: ~A" label) (incf checks)) (sync () (xlib:display-finish-output display)) (check-single-tile (window) (sync) (check (= 0 (xlib:drawable-border-width window)) "single tile border") (check (= 0 (xlib:drawable-x window)) "single tile x") (check (= 22 (xlib:drawable-y window)) "single tile keeps bar") (check (= 1000 (xlib:drawable-width window)) "single tile width") (check (= 600 (xlib:drawable-height window)) "single tile height")) (drain-unmap-events () ;; This fixture calls commands directly, without the ;; event loop. Consume real hides from monocle cycling ;; before testing a later application withdrawal. (sync) (loop while (xlib:event-case (display :timeout 0 :discard-p t) (:unmap-notify (event-window window configure-p) (lime.x11::%handle-unmap-notify backend event-window window configure-p) t) (otherwise () t)))) (pixel-at-border (window) (sync) (aref (xlib:image-z-pixarray (xlib:get-image root :x (xlib:drawable-x window) :y (+ 10 (xlib:drawable-y window)) :width 1 :height 1 :format :z-pixmap)) 0 0)) (border-is (window color) (check (= (pixel-at-border window) (lime.x11::%border-pixel backend color)) color))) (xlib:display-finish-output client-display) (xlib:change-property (first windows) :_NET_WM_NAME (babel:string-to-octets "Already named" :encoding :utf-8) :UTF8_STRING 8) (xlib:display-finish-output client-display) (dolist (window windows) (push (lime.x11:manage-window backend (find (xlib:window-id window) (xlib:query-tree root) :key #'xlib:window-id)) ids) (when (= 1 (length ids)) (check (string= "Already named" (lime.x11:icccm-client-info-title (lime.x11:backend-client-icccm-info backend (first ids)))) "adoption reads an existing modern title") ;; First MapRequest in the initial manual draft, then in ;; master/stack, must already be undecorated. (check-single-tile window) (lime.x11:backend-use-master-stack-layout backend) (check-single-tile window) (lime.x11:backend-use-manual-layout backend)) (when (= 2 (length ids)) (sync) (check (= 3 (xlib:drawable-border-width (first windows))) "second MapRequest restores first tile border") (check (= 3 (xlib:drawable-border-width window)) "second MapRequest decorates new tile"))) (setf ids (nreverse ids)) (dolist (layout-command (list #'lime.x11:backend-use-manual-layout #'lime.x11:backend-use-master-stack-layout)) (funcall layout-command backend) (lime.x11:backend-hide-client backend (second ids)) (lime.x11:backend-hide-client backend (third ids)) (check-single-tile (first windows)) (lime.x11:backend-show-client backend (third ids) :kind :float :data '(:x 1/4 :y 1/4 :width 1/2 :height 1/2)) (check-single-tile (first windows)) (check (= 3 (xlib:drawable-border-width (third windows))) "floating overlay keeps border above sole tile") (lime.x11:backend-toggle-client-floating backend (third ids)) (sync) (check (= 3 (xlib:drawable-border-width (first windows))) "unfloating restores tiled border") (check (= 5 (xlib:drawable-x (first windows))) "unfloating restores outer gap") (lime.x11:backend-hide-client backend (third ids)) (lime.x11:backend-show-client backend (second ids)) (lime.x11:backend-show-client backend (third ids))) (lime.x11:backend-use-master-stack-layout backend) (sync) ;; Real-font metrics, not an assumed number of pixels per glyph, ;; must position both painted controls and their click regions. (let* ((head-id (first (lime.x11:backend-head-ids backend))) (bar (gethash head-id (lime.x11::x11-backend-head-bars backend))) (font (lime.x11::x11-head-bar-font bar)) (bar-window (lime.x11::x11-head-bar-window bar)) (regions (lime.x11::x11-head-bar-hit-regions bar)) (logo-right (+ 10 (lime.x11::%text-width font "Lime"))) (layout-left (+ logo-right (lime.x11::%text-width font " | ") (lime.x11::%text-width font (lime.x11::%bar-presentation-label backend head-id)) (lime.x11::%text-width font " | "))) (layout-right (+ layout-left (lime.x11::%text-width font "[]="))) (clicks 0)) (check (= logo-right (lime.x11::x11-head-bar-hit-region-right (first regions))) "logo uses actual font width") (check (= layout-left (lime.x11::x11-head-bar-hit-region-left (third regions))) "layout follows measured label and separator") (check (= layout-right (lime.x11::x11-head-bar-hit-region-right (third regions))) "layout click width equals rendered token width") (let* ((activity-region (second regions)) (left (lime.x11::x11-head-bar-hit-region-left activity-region)) (pixels (xlib:image-z-pixarray (xlib:get-image bar-window :x left :y 0 :width (- (lime.x11::x11-head-bar-hit-region-right activity-region) left) :height 22 :format :z-pixmap)))) (check (loop for i below (array-total-size pixels) thereis (= (lime.x11::%bar-pixel bar "#ffac54") (row-major-aref pixels i))) "active Activity text is painted in the accent color")) (let ((pixels (xlib:image-z-pixarray (xlib:get-image bar-window :x layout-left :y 0 :width (- layout-right layout-left) :height 18 :format :z-pixmap)))) (check (loop for i below (array-total-size pixels) thereis (= (lime.x11::%bar-pixel bar "#ffdbb0") (row-major-aref pixels i))) "layout text is painted within measured region")) ;; Inspect actual pixels, not only computed drawing positions. (labels ((bar-pixel-at (x) (sync) (aref (xlib:image-z-pixarray (xlib:get-image bar-window :x x :y 0 :width 1 :height 1 :format :z-pixmap)) 0 0)) (bar-image () (sync) (xlib:image-z-pixarray (xlib:get-image bar-window :x 0 :y 0 :width 1000 :height 22 :format :z-pixmap))) (drain-properties () (xlib:display-finish-output client-display) (sync) (loop while (xlib:event-case (display :timeout 0 :discard-p t) (:property-notify (window atom) (lime.x11::%handle-property-notify backend window atom) t) (:unmap-notify (event-window window configure-p) (lime.x11::%handle-unmap-notify backend event-window window configure-p) t) (otherwise () t))))) (let* ((title-left (+ layout-right 8)) (saved-config (lime.x11:x11-backend-configuration backend)) (alternative (lime.x11::copy-lime-configuration saved-config))) (check (= (bar-pixel-at title-left) (lime.x11::%bar-pixel bar "#40535d")) "left title edge is the muted color") (check (= (bar-pixel-at 999) (bar-pixel-at title-left)) "right title edge matches the left") (check (= (bar-pixel-at (1+ title-left)) (lime.x11::%bar-pixel bar "#121f25")) "title edge is exactly one pixel") (check (= (bar-pixel-at 998) (lime.x11::%bar-pixel bar "#121f25")) "focused title has its own background") (setf (lime.x11::x11-backend-focused-head-id backend) nil) (lime.x11::render-head-bars backend) (check (= (bar-pixel-at 998) (lime.x11::%bar-pixel bar "#0b1216")) "unfocused title background is quieter") (check (= (bar-pixel-at 0) (lime.x11::%bar-pixel bar "#060a0c")) "head focus does not recolor the side sections") (setf (lime.x11::x11-backend-focused-head-id backend) head-id) (setf (lime.x11:lime-configuration-bar-style alternative) (lime.x11:make-head-bar-style :title-edge-color nil)) (lime.x11:apply-lime-configuration backend alternative) (check (= (bar-pixel-at title-left) (lime.x11::%bar-pixel bar "#121f25")) "configuration can remove title edges live") (lime.x11:apply-lime-configuration backend saved-config :source (namestring (asdf:system-relative-pathname "lime" "test/x11-appearance-config.lisp")) :name 'cl-user::appearance-smoke-config) (check (= (bar-pixel-at title-left) (lime.x11::%bar-pixel bar "#40535d")) "restoring configuration repaints title edges")) (let* ((client (third windows)) (client-id (third ids)) (presentation (lime.core:current-presentation (lime.x11::x11-backend-world backend) head-id)) (dirty-before (lime.core:presentation-dirty-p presentation))) (setf (xlib:wm-name client) "Legacy title") (drain-properties) (check (string= "Legacy title" (lime.x11::%bar-focused-title backend head-id)) "legacy title notification refreshes the cache") (let ((before (bar-image))) (xlib:change-property client :_NET_WM_NAME (babel:string-to-octets "café — Editor" :encoding :utf-8) :UTF8_STRING 8) (drain-properties) (check (string= "café — Editor" (lime.x11::%bar-focused-title backend head-id)) "modern UTF-8 title wins over legacy title") (check (not (equalp before (bar-image))) "title notification repaints actual bar pixels")) (xlib:change-property client :_NET_WM_NAME '(255 65) :UTF8_STRING 8) (drain-properties) (check (find #\A (lime.x11::%bar-focused-title backend head-id)) "malformed UTF-8 does not lose the remaining title") (xlib:change-property client :_NET_WM_NAME '(1000) :UTF8_STRING 32) (drain-properties) (check (string= "Legacy title" (lime.x11::%bar-focused-title backend head-id)) "wrong-format modern title falls back safely") (xlib:change-property client :_NET_WM_NAME '(65) :STRING 8) (drain-properties) (check (string= "Legacy title" (lime.x11::%bar-focused-title backend head-id)) "wrong-type modern title falls back safely") (xlib:change-property client :WM_NAME '(99 97 102 233) :STRING 8) (xlib:change-property client :_NET_WM_NAME '() :UTF8_STRING 8) (drain-properties) (check (string= "café" (lime.x11::%bar-focused-title backend head-id)) "empty modern title falls back to Latin-1 legacy title") (xlib:delete-property client :_NET_WM_NAME) (drain-properties) (check (string= "café" (lime.x11::%bar-focused-title backend head-id)) "deleting modern title immediately restores legacy title") (xlib:delete-property client :_NET_WM_NAME) (xlib:delete-property client :WM_NAME) (xlib:set-wm-class client "editor" "ExampleEditor") (drain-properties) (check (string= "ExampleEditor" (lime.x11::%bar-focused-title backend head-id)) "title deletion falls back to class, not XID") (check (eq :normal (lime.x11:icccm-client-info-wm-state (lime.x11:backend-client-icccm-info backend client-id))) "title updates preserve renderer WM_STATE") (check (eql dirty-before (lime.core:presentation-dirty-p presentation)) "title refresh never dirties the draft"))) ;; Check right alignment and real dispatch of segment hits. (lime.x11:backend-set-head-bar-status-providers backend (list (lambda (ignored-backend ignored-head) (declare (ignore ignored-backend ignored-head)) (list (lime.x11:make-head-bar-segment :text "Music" :click-action (lambda (&rest ignored) (declare (ignore ignored)) (incf clicks))) (lime.x11:make-head-bar-segment :text "20:00"))))) (sync) (let* ((status-left (- 1000 10 (lime.x11::%text-width font "Music | 20:00"))) (status-right (+ status-left (lime.x11::%text-width font "Music"))) (region (car (last (lime.x11::x11-head-bar-hit-regions bar))))) (check (= status-left (lime.x11::x11-head-bar-hit-region-left region)) "status right alignment uses actual font") (check (= status-right (lime.x11::x11-head-bar-hit-region-right region)) "status click excludes separator") (let* ((separator-width (lime.x11::%text-width font " | ")) (expected (lime.x11::%make-ui-canvas separator-width 22)) (pixels (xlib:image-z-pixarray (xlib:get-image bar-window :x status-right :y 0 :width separator-width :height 22 :format :z-pixmap)))) ;; Thin antialiased strokes need not contain a fully opaque ;; foreground pixel. Compare the whole expected paint instead. (unwind-protect (progn (lime.x11::%canvas-rectangle expected 0 0 separator-width 22 "#060a0c") (lime.x11::%canvas-text expected font " | " 0 0 separator-width 22 "#b88755" :baseline (lime.x11::%font-centered-baseline font 22)) (lime.x11::%cairo-flush (lime.x11::ui-canvas-surface expected)) (let ((data (lime.x11::%cairo-data (lime.x11::ui-canvas-surface expected))) (stride (lime.x11::%cairo-stride (lime.x11::ui-canvas-surface expected)))) (check (loop for y below 22 always (loop for x below separator-width always (= (aref pixels y x) (logand #xffffff (cffi:mem-ref data :uint32 (+ (* y stride) (* x 4))))))) "status delimiter has its own antialiased color"))) (lime.x11::%free-ui-canvas expected))) (lime.x11::%handle-head-bar-button-press backend bar-window status-left 5 1 0 0) (check (= 1 clicks) "status text dispatches click") (lime.x11::%handle-head-bar-button-press backend bar-window status-right 5 1 0 0) (check (= 1 clicks) "separator does not dispatch click")) (lime.x11:backend-set-head-bar-status-providers backend nil) (lime.x11:backend-focus-client backend (third ids))) (check (= 3 (xlib:drawable-border-width (first windows))) "actual border width") (check (= 5 (xlib:drawable-x (first windows))) "left gap") (check (= 27 (xlib:drawable-y (first windows))) "bar and top gap") (check (= 5 (- (xlib:drawable-x (second windows)) (+ (xlib:drawable-x (first windows)) (xlib:drawable-width (first windows)) 6))) "column gap") (check (= 5 (- (xlib:drawable-y (third windows)) (+ (xlib:drawable-y (second windows)) (xlib:drawable-height (second windows)) 6))) "row gap") (border-is (first windows) "#121f25") (border-is (third windows) "#ffac54") (lime.x11:backend-focus-client backend (first ids)) (lime.x11:backend-use-monocle-layout backend) (sync) (check (= 0 (xlib:drawable-border-width (first windows))) "monocle border") (check (= 0 (xlib:drawable-x (first windows))) "monocle x") (check (= 22 (xlib:drawable-y (first windows))) "monocle keeps bar") (check (= 1000 (xlib:drawable-width (first windows))) "monocle width") (check (= 600 (xlib:drawable-height (first windows))) "monocle height") (lime.x11:backend-focus-client backend (second ids)) (sync) (check (= 0 (xlib:drawable-border-width (second windows))) "cycled monocle border") (lime.x11:backend-focus-client backend (first ids)) (lime.x11:backend-use-master-stack-layout backend) (sync) (check (= 3 (xlib:drawable-border-width (first windows))) "restore tiled border") (check (= 5 (xlib:drawable-x (first windows))) "restore tiled gap") (border-is (first windows) "#ffac54") (border-is (third windows) "#121f25") (lime.x11:backend-focus-head-background backend (first (lime.x11:backend-head-ids backend))) (border-is (first windows) "#121f25") (lime.x11:backend-focus-client backend (first ids)) (lime.x11:backend-set-client-fullscreen backend (first ids) t) (sync) (check (= 0 (xlib:drawable-border-width (first windows))) "fullscreen border") (check (= 0 (xlib:drawable-x (first windows))) "fullscreen x") (check (= 0 (xlib:drawable-y (first windows))) "fullscreen y") (check (= 1000 (xlib:drawable-width (first windows))) "fullscreen width") (check (= 622 (xlib:drawable-height (first windows))) "fullscreen height") (lime.x11:backend-set-client-fullscreen backend (first ids) nil) (sync) (check (= 3 (xlib:drawable-border-width (first windows))) "restore border") (border-is (first windows) "#ffac54") ;; Exercise a failed install after it already repainted windows. (let* ((old (lime.x11:x11-backend-configuration backend)) (bad (lime.x11::copy-lime-configuration old)) (failed nil)) (setf (lime.x11:lime-configuration-bar-style bad) (lime.x11:make-head-bar-style :focused-background "#112233" :title-edge-color "#abcdef") (lime.x11:lime-configuration-appearance bad) (lime.x11:make-window-appearance :border-width 9 :focused-border "#123456" :unfocused-border "#abcdef") (lime.x11:lime-configuration-startup-hooks bad) (list (lambda (ignored) (declare (ignore ignored)) (error "Deliberate rollback test")))) (handler-case (lime.x11:apply-lime-configuration backend bad :run-startup-hooks-p t) (error () (setf failed t))) (check failed "rollback condition") (check (eq old (lime.x11:x11-backend-configuration backend)) "old config restored") (sync) (let* ((head-id (first (lime.x11:backend-head-ids backend))) (bar (gethash head-id (lime.x11::x11-backend-head-bars backend))) (window (lime.x11::x11-head-bar-window bar)) (pixels (xlib:image-z-pixarray (xlib:get-image window :x 998 :y 0 :width 2 :height 1 :format :z-pixmap)))) (check (= (aref pixels 0 0) (lime.x11::%bar-pixel bar "#121f25")) "failed config restores previous title background") (check (= (aref pixels 0 1) (lime.x11::%bar-pixel bar "#40535d")) "failed config restores previous title edge") (check (null (gethash "#112233" (lime.x11::x11-head-bar-colors bar))) "rollback releases unused bar colors")) (check (= 3 (xlib:drawable-border-width (first windows))) "rollback geometry") (border-is (first windows) "#ffac54") (check (= 2 (hash-table-count (lime.x11::x11-backend-border-colors backend))) "unused colors released")) ;; A successful install and a file reload repaint existing clients. (let ((new (lime.x11::copy-lime-configuration (lime.x11:x11-backend-configuration backend)))) (setf (lime.x11:lime-configuration-appearance new) (lime.x11:make-window-appearance :border-width 2 :outer-gap 10 :inner-gap 8 :focused-border "#00ff00")) (lime.x11:apply-lime-configuration backend new :source (lime.x11:x11-backend-configuration-source backend) :name (lime.x11:x11-backend-configuration-name backend)) (sync) (check (= 2 (xlib:drawable-border-width (first windows))) "live width update") (check (= 10 (xlib:drawable-x (first windows))) "live gap update") (border-is (first windows) "#00ff00")) (lime.x11:reload-backend-configuration backend) (sync) (check (= 3 (xlib:drawable-border-width (first windows))) "file reload border") (check (= 5 (xlib:drawable-x (first windows))) "file reload gap") (border-is (first windows) "#ffac54") (lime.x11:backend-toggle-focused-client-floating backend :data '(:x 0 :y 0 :width 1/3 :height 1/3)) (sync) (check (= 3 (xlib:drawable-border-width (first windows))) "float border") (check (= 0 (xlib:drawable-x (first windows))) "float no gap") (check (= 22 (xlib:drawable-y (first windows))) "float work area") ;; Withdrawal restores app-owned width before forgetting it. (drain-unmap-events) (xlib:unmap-window (first windows)) (xlib:display-finish-output client-display) (lime.x11::%handle-unmap-notify backend root (gethash (first ids) (lime.x11::x11-backend-client-windows backend)) nil) (sync) (check (= 7 (xlib:drawable-border-width (first windows))) "withdrawal original width") (lime.x11:stop-backend backend) (setf backend nil) ;; Roundtrip on the other connection after WM disconnect. (xlib:display-finish-output client-display) (dolist (window (rest windows)) (check (= 7 (xlib:drawable-border-width window)) "shutdown original width")) (format t "~&Live X11 appearance smoke: ~D checks passed.~%" checks)))) (when backend (lime.x11:stop-backend backend)) (when client-display (xlib:close-display client-display)) (uiop:terminate-process server) (uiop:wait-process server)))