170 lines
12 KiB
Common Lisp
170 lines
12 KiB
Common Lisp
;;;; Real-X command-map checks. Own Xvfb server, never the current DISPLAY.
|
||
;;;; Optionally bind *UI-SMOKE-IMAGE-DIRECTORY* before loading to save PNGs.
|
||
(require :asdf)
|
||
(asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*)))
|
||
(asdf:load-system "lime/x11")
|
||
(defvar *ui-smoke-image-directory* nil)
|
||
|
||
(let ((server (uiop:launch-program '("Xvfb" "-displayfd" "1" "-screen" "0" "1000x622x24" "-nolisten" "tcp")
|
||
:output :stream :error-output :interactive))
|
||
(backend nil) (checks 0))
|
||
(unwind-protect
|
||
(let* ((number (parse-integer (read-line (uiop:process-info-output server))))
|
||
(config (lime.x11:make-lime-configuration
|
||
:default-keybindings-p nil
|
||
:font (lime.x11:make-ui-font-style
|
||
:family "Dina, Fira Code Nerd Font, Noto Color Emoji" :size 12 :weight :bold)
|
||
:bar-style (lime.x11:make-head-bar-style
|
||
:background "#191919" :foreground "#d8c9ad"
|
||
:focused-background "#252525" :focused-foreground "#c49a62"
|
||
:separator-color "#8c9b7a" :title-edge-color "#444444"))))
|
||
(setf backend (lime.x11:start-lime :display-name (format nil ":~D" number) :head-discovery :none))
|
||
(lime.x11:apply-lime-configuration backend config)
|
||
(let* ((display (lime.x11::x11-backend-display backend))
|
||
(world (lime.x11:x11-backend-world backend))
|
||
(revision (lime.core:world-revision world)))
|
||
(labels ((check (truth label) (assert truth () "Command menu: ~A" label) (incf checks))
|
||
(session () (lime.x11::x11-backend-ui-session backend))
|
||
(overlay () (lime.x11::x11-backend-ui-overlay backend))
|
||
(press (key)
|
||
(let* ((keysym (if (characterp key) (char-code key) key))
|
||
(code (xlib:keysym->keycodes display keysym)))
|
||
(check code (format nil "keycode for ~S" key))
|
||
(lime.x11::%handle-ui-key-press backend code 0)
|
||
(xlib:display-finish-output display)))
|
||
(frame (&optional name)
|
||
(let* ((overlay (overlay))
|
||
(canvas (lime.x11::x11-ui-overlay-canvas overlay))
|
||
(window (lime.x11::x11-ui-overlay-window overlay)))
|
||
(xlib:display-finish-output display)
|
||
(check (equalp (lime.x11::ui-canvas-pixels canvas)
|
||
(xlib:image-z-pixarray
|
||
(xlib:get-image window :x 0 :y 0
|
||
:width (lime.x11::ui-canvas-width canvas)
|
||
:height (lime.x11::ui-canvas-height canvas)
|
||
:format :z-pixmap))) "actual painted frame")
|
||
(when (and name *ui-smoke-image-directory*)
|
||
(check (zerop (lime.x11::%cairo-write-png
|
||
(lime.x11::ui-canvas-surface canvas)
|
||
(namestring (merge-pathnames name *ui-smoke-image-directory*))))
|
||
"snapshot")))))
|
||
(lime.x11:backend-open-command-palette backend)
|
||
(check (eq :key-path (lime.ui:ui-session-mode (session))) "Super-y starts at the key root")
|
||
(check (< (lime.x11::x11-ui-overlay-height (overlay)) 200) "root is compact")
|
||
(frame "menu-root.png")
|
||
(press #\w)
|
||
(check (string= "Lime › w Windows" (lime.x11::%ui-menu-heading (session))) "breadcrumb")
|
||
(frame "menu-windows.png")
|
||
(press #xFF08) ; Backspace
|
||
(check (null (lime.ui:ui-session-key-path (session))) "Backspace returns to root")
|
||
(press #\Space)
|
||
(check (eq :search (lime.ui:ui-session-mode (session))) "Space opens search")
|
||
(press #\v)
|
||
(check (string= "v" (lime.ui:ui-session-query (session))) "search types rather than navigates")
|
||
(frame "menu-search.png")
|
||
(press #xFF09) ; Tab
|
||
(check (eq :key-path (lime.ui:ui-session-mode (session))) "Tab returns to root")
|
||
(check (= revision (lime.core:world-revision world)) "browsing does not change the model")
|
||
(press #\v)
|
||
(press #\s)
|
||
(check (eq :prompt (lime.ui:ui-session-mode (session))) "v s is a name prompt")
|
||
(check (string= "Enter to confirm; Esc to cancel." (lime.ui:ui-session-status (session)))
|
||
"prompt footer describes prompt keys, not menu keys")
|
||
(frame "menu-prompt.png")
|
||
(dolist (key '(#\c #\o #\d #\e #\Space #\v #\i #\e #\w)) (press key))
|
||
(press #xFF0D)
|
||
(check (not (lime.x11:backend-command-palette-open-p backend)) "successful command closes")
|
||
(check (getf (lime.x11:backend-status backend) :source-view-id) "checkpoint actually saved")
|
||
(lime.x11:backend-open-command-palette backend)
|
||
(press #\v)
|
||
(press #\o)
|
||
(check (eq :search (lime.ui:ui-session-mode (session))) "v o opens the View picker")
|
||
(check (every (lambda (candidate) (eq :view (first (lime.ui:ui-candidate-id candidate))))
|
||
(lime.ui:ui-session-candidates (session))) "View picker is scoped")
|
||
(press #xFF09)
|
||
(press #\Space)
|
||
(check (find :quit-lime (lime.ui:ui-session-candidates (session)) :key #'lime.ui:ui-candidate-id)
|
||
"global search restored after a scoped picker")
|
||
(press #xFF1B)
|
||
(check (not (lime.x11:backend-command-palette-open-p backend)) "Escape closes")
|
||
;; Explicit recall restores even the last-used checkpoint. It
|
||
;; is intentionally different from reselecting a numbered slot.
|
||
(let* ((head-id (lime.x11:x11-backend-focused-head-id backend))
|
||
(p (lime.core:current-presentation world head-id))
|
||
(view-id (lime.core:presentation-source-view-id p))
|
||
(saved-mode (lime.core:view-layout-mode (lime.core:find-view world view-id))))
|
||
(lime.core:set-presentation-layout-mode world (lime.core:presentation-id p) :monocle)
|
||
(lime.x11:apply-active-presentation backend)
|
||
(lime.x11:backend-open-command-palette backend)
|
||
(press #\v) (press #\o)
|
||
(check (search "Recall view" (lime.ui:ui-candidate-label
|
||
(first (lime.ui:ui-session-candidates (session)))))
|
||
"saved arrangements use recall language")
|
||
(press #xFF0D)
|
||
(check (eq saved-mode (lime.core:presentation-layout-mode p)) "explicit recall restores saved layout")
|
||
(check (not (lime.core:presentation-dirty-p p)) "explicit recall clears live edits")
|
||
;; Direct shortcut opens a picker; opening/choosing does not
|
||
;; modify a checkpoint, and Enter defaults to Cancel.
|
||
(lime.core:set-presentation-layout-mode world (lime.core:presentation-id p) :monocle)
|
||
(lime.x11:apply-active-presentation backend)
|
||
(let ((before (lime.persistence:snapshot-world world)))
|
||
(lime.x11:backend-open-view-update-picker backend)
|
||
(frame)
|
||
(press #xFF0D)
|
||
(check (eq :cancel (lime.ui:ui-candidate-id
|
||
(lime.ui:ui-session-selected-candidate (session)))) "replacement defaults to cancel")
|
||
(frame)
|
||
(press #xFF0D)
|
||
(check (not (session)) "cancel closes picker")
|
||
(check (equalp before (lime.persistence:snapshot-world world)) "cancel preserves checkpoint and live desk"))
|
||
;; Menu update uses the same picker and named confirmation.
|
||
(lime.x11:backend-open-command-palette backend)
|
||
(press #\v) (press #\u) (press #xFF0D) (press #xFF54) (press #xFF0D)
|
||
(check (not (session)) "confirmed replacement closes picker")
|
||
(check (eq :monocle (lime.core:view-layout-mode (lime.core:find-view world view-id))) "only confirmed update replaces checkpoint")
|
||
;; A configured-command wrapper must not close its own picker.
|
||
(lime.x11:apply-lime-configuration
|
||
backend (lime.x11:make-lime-configuration
|
||
:default-keybindings-p nil
|
||
:commands (list (lime.x11:make-lime-command
|
||
:id :update :label "Update saved view"
|
||
:action #'lime.x11:backend-open-view-update-picker))))
|
||
(lime.x11:backend-open-command-palette backend)
|
||
(press #\Space)
|
||
(let ((candidate (find '(:configured-command :update)
|
||
(lime.ui:ui-session-candidates (session))
|
||
:key #'lime.ui:ui-candidate-id :test #'equal)))
|
||
(check candidate "configured command is available in search")
|
||
(lime.x11::%perform-ui-action backend (list :candidate candidate)))
|
||
(check (eq :search (lime.ui:ui-session-mode (session))) "configured update enters picker without closing")
|
||
(press #xFF1B))
|
||
;; Program launch remains the independent direct-search surface.
|
||
(lime.x11:backend-open-run-prompt backend)
|
||
(check (eq :search (lime.ui:ui-session-mode (session))) "Super-p still searches programs")
|
||
(check (null (lime.ui:ui-session-key-root (session))) "launcher has no command tree")
|
||
(press #xFF1B)
|
||
;; Small Heads / large user maps page instead of dropping entries.
|
||
(let* ((head (gethash (first (lime.x11:backend-head-ids backend))
|
||
(lime.x11::x11-backend-heads backend)))
|
||
(nodes (loop for i below 40 collect
|
||
(lime.ui:make-ui-key-node :key (code-char (+ 256 i))
|
||
:label (format nil "Custom command ~D" i)))))
|
||
(setf (lime.x11:x11-head-width head) 320 (lime.x11:x11-head-height head) 260)
|
||
(lime.x11::%open-ui-session backend (lime.ui:make-ui-session nil :key-path nodes :mode :key-path))
|
||
(check (<= (lime.x11::x11-ui-overlay-height (overlay)) 238) "bounded to small Head")
|
||
(press #xFF56) ; PageDown
|
||
(check (= 1 (lime.ui:ui-session-key-page (session))) "PageDown navigates grid")
|
||
(frame "menu-narrow.png")
|
||
(press #xFF55)
|
||
(check (= 0 (lime.ui:ui-session-key-page (session))) "PageUp navigates grid")
|
||
(setf (lime.ui:ui-session-key-page (session)) 999)
|
||
(lime.x11::%render-command-palette backend)
|
||
(check (< (lime.ui:ui-session-key-page (session)) 999) "last page clamps")
|
||
(press #xFF55)
|
||
(check (>= (lime.ui:ui-session-key-page (session)) 0) "paging back remains available")
|
||
(press #xFF1B))
|
||
(format t "~&Live X11 command menu: ~D checks passed.~%" checks))))
|
||
(when backend (lime.x11:stop-backend backend))
|
||
(uiop:terminate-process server)
|
||
(uiop:wait-process server)))
|