;;;; Real pointer events on an owned Xvfb: never moves the desktop's pointer. (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) (checks 0)) (unwind-protect (let ((number (parse-integer (read-line (uiop:process-info-output server))))) (setf backend (lime.x11:start-lime :display-name (format nil ":~D" number) :head-discovery :none)) (let* ((display (lime.x11::x11-backend-display backend)) (root (lime.x11::x11-backend-root backend))) (labels ((check (truth label) (assert truth () "Pointer UI: ~A" label) (incf checks)) (session () (lime.x11::x11-backend-ui-session backend)) (overlay () (lime.x11::x11-backend-ui-overlay backend)) (hand (window label) (check (and (= 1 (xlib/xtest:compare-cursor display window (xlib:cursor-id (lime.x11::x11-backend-hand-cursor backend)))) (= 1 (xlib/xtest:compare-cursor display window))) label)) (arrow (label) (check (= 1 (xlib/xtest:compare-cursor display root)) label)) (pump () ;; Exercise the production dispatch, not duplicate routing ;; in the test. Stop once all generated events are drained. (let ((turns 0)) (lime.x11:run-event-loop backend :timeout 0.005 :before-event (lambda (backend) (assert (< (incf turns) 100) () "Event queue did not settle.") (xlib:display-finish-output display) (unless (xlib:event-listen display) (setf (lime.x11::x11-backend-running-p backend) nil)))))) (move (x y) (xlib/xtest:fake-motion-event display x y) (pump)) (button (code) (xlib/xtest:fake-button-event display code t) (xlib/xtest:fake-button-event display code nil) (pump)) (click (x y) (move x y) (button 1)) (hit (action) (or (find action (lime.x11::x11-ui-overlay-hit-regions (overlay)) :key #'lime.x11::ui-hit-region-action :test #'equal) (error "No hit region for ~S" action))) (point-at (action) (let ((hit (hit action)) (window (lime.x11::x11-ui-overlay-window (overlay)))) (move (+ (xlib:drawable-x window) (lime.x11::ui-hit-region-x hit) (floor (lime.x11::ui-hit-region-width hit) 2)) (+ (xlib:drawable-y window) (lime.x11::ui-hit-region-y hit) (floor (lime.x11::ui-hit-region-height hit) 2))))) (activate (action) (point-at action) (button 1)) (key (key) (activate (list :key key)))) (pump) (check (= 1 (xlib/xtest:compare-cursor display root (xlib:cursor-id (lime.x11::x11-backend-root-cursor backend)))) "root owns the left pointer") (move 800 600) (check (= 1 (xlib/xtest:compare-cursor display root)) "desktop displays that cursor") ;; A client-specific cursor must still override the root default. (let ((font (xlib:open-font display "cursor")) (cursor nil) (window nil)) (unwind-protect (progn (setf cursor (xlib:create-glyph-cursor :source-font font :source-char 0 :mask-font font :mask-char 1 :foreground (xlib:make-color :red 0 :green 0 :blue 0) :background (xlib:make-color :red 1 :green 1 :blue 1)) window (xlib:create-window :parent root :x 600 :y 450 :width 100 :height 100 :override-redirect :on :cursor cursor)) (xlib:map-window window) (move 650 500) (check (= 1 (xlib/xtest:compare-cursor display window)) "application cursor wins") (check (= 0 (xlib/xtest:compare-cursor display root)) "not forcibly the root cursor")) (when window (xlib:destroy-window window)) (when cursor (xlib:free-cursor cursor)) (xlib:close-font font))) (let* ((bar (gethash (first (lime.x11:backend-head-ids backend)) (lime.x11::x11-backend-head-bars backend))) (window (lime.x11::x11-head-bar-window bar)) (regions (lime.x11::x11-head-bar-hit-regions bar))) (move 15 10) (hand window "logo uses the hand") (move (lime.x11::x11-head-bar-hit-region-right (first regions)) 10) (arrow "logo delimiter uses the arrow") (move (lime.x11::x11-head-bar-hit-region-left (second regions)) 10) (hand window "activity tab uses the hand") (move (lime.x11::x11-head-bar-hit-region-left (third regions)) 10) (hand window "layout control uses the hand") (move 500 10) (arrow "inert title uses the arrow") ;; A widget's action may change while its text stays the same. (let ((clickable-p t) (action (lambda (&rest args) (declare (ignore args))))) (lime.x11:backend-set-head-bar-status-providers backend (list (lambda (backend head-id) (declare (ignore backend head-id)) (lime.x11:make-head-bar-segment :text "Music" :click-action (and clickable-p action))))) (let* ((region (car (last (lime.x11::x11-head-bar-hit-regions bar)))) (x (floor (+ (lime.x11::x11-head-bar-hit-region-left region) (lime.x11::x11-head-bar-hit-region-right region)) 2))) (move x 10) (hand window "clickable status uses the hand") (setf clickable-p nil) (lime.x11::render-head-bars backend) (pump) (arrow "inert widget restores arrow without pointer movement") (setf clickable-p t) (lime.x11::render-head-bars backend) (pump) (hand window "new widget action restores hand without movement")) (lime.x11:backend-set-head-bar-status-providers backend nil) (pump) (arrow "removed widget restores arrow")) (move 15 10) (hand window "hand restored on bar re-entry") (move 800 600) (arrow "leaving the bar restores desktop arrow")) ;; Start at the actual bar button, then navigate entirely by mouse. (click 15 10) (check (and (session) (eq :key-path (lime.ui:ui-session-mode (session)))) "logo opens menu") (point-at '(:key #\w)) (check (equal '(:key #\w) (lime.x11::x11-ui-overlay-hovered-action (overlay))) "entry hovers") (hand (lime.x11::x11-ui-overlay-window (overlay)) "menu entry uses the hand") (button 1) (check (string= "Lime › w Windows" (lime.x11::%ui-menu-heading (session))) "click enters submenu") (key :backspace) (check (null (lime.ui:ui-session-key-path (session))) "Back goes up") (key :tab) (check (eq :search (lime.ui:ui-session-mode (session))) "Search button works") (key :tab) (check (eq :key-path (lime.ui:ui-session-mode (session))) "Menu returns to root") (let ((mode (lime.ui:ui-session-mode (session)))) (click 1 23) (check (eq mode (lime.ui:ui-session-mode (session))) "blank overlay space is inert") (arrow "blank menu space uses the arrow")) (key #\v) (key #\s) (check (eq :prompt (lime.ui:ui-session-mode (session))) "click opens prompt") (key :return) (check (string= "Input is required." (lime.ui:ui-session-status (session))) "Confirm validates input") (lime.ui:ui-session-handle-key (session) #\M) (lime.x11::%render-command-palette backend) (key :return) (check (not (session)) "Confirm saves and closes") (check (getf (lime.x11:backend-status backend) :source-view-id) "checkpoint was saved") (click 15 10) (key #\v) (key #\o) (check (eq :search (lime.ui:ui-session-mode (session))) "click opens scoped picker") (activate (list :candidate (first (lime.ui:ui-session-candidates (session))))) (check (not (session)) "click picks saved View") ;; Result replacement, wheel selection, stale regions, and errors. (let* ((runs 0) (choice (lime.ui:make-ui-candidate :label "Take this choice" :action (lambda () (incf runs) (lime.ui:ui-close-result)))) (bad (lime.ui:make-ui-candidate :label "Fail safely" :action (lambda () (error "Test failure")))) (picker (lime.ui:make-ui-candidate :label "Choices" :action (lambda () (lime.ui:ui-replace-result (list choice bad)))))) (lime.x11::%open-ui-session backend (lime.ui:make-ui-session (list picker))) (point-at (list :candidate picker)) (hand (lime.x11::x11-ui-overlay-window (overlay)) "search result uses the hand") (lime.ui:ui-session-handle-key (session) #\z) (lime.x11::%render-command-palette backend) (pump) (arrow "no matches restores arrow without movement") (check (null (lime.x11::x11-ui-overlay-hovered-action (overlay))) "no stale result highlight") (lime.ui:ui-session-handle-key (session) :backspace) (lime.x11::%render-command-palette backend) (pump) (hand (lime.x11::x11-ui-overlay-window (overlay)) "restored results restore hand without movement") (activate (list :candidate picker)) (check (equal (list choice bad) (lime.ui:ui-session-candidates (session))) "picker replaces choices") (check (not (find (list :candidate picker) (lime.x11::x11-ui-overlay-hit-regions (overlay)) :key #'lime.x11::ui-hit-region-action :test #'equal)) "old hit discarded") (button 5) (check (= 1 (lime.ui:ui-session-selected-index (session))) "wheel moves selection") (activate (list :candidate bad)) (check (search "Test failure" (lime.ui:ui-session-status (session))) "click errors stay in menu") (activate (list :candidate choice)) (check (= 1 runs) "correct clicked action ran once") (check (not (session)) "mouse choice closes")) (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 "Command ~D" i))))) ;; A non-zero Head origin checks root-to-overlay coordinate conversion. (setf (lime.x11:x11-head-x head) 110 (lime.x11:x11-head-y head) 80 (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)) (key :page-down) (check (= 1 (lime.ui:ui-session-key-page (session))) "next-page button") (button 5) (check (= 2 (lime.ui:ui-session-key-page (session))) "wheel pages grid") (key :page-up) (check (= 1 (lime.ui:ui-session-key-page (session))) "previous-page button") (dolist (hit (lime.x11::x11-ui-overlay-hit-regions (overlay))) (check (and (<= 0 (lime.x11::ui-hit-region-x hit) (+ (lime.x11::ui-hit-region-x hit) (lime.x11::ui-hit-region-width hit)) 320) (<= 0 (lime.x11::ui-hit-region-y hit) (+ (lime.x11::ui-hit-region-y hit) (lime.x11::ui-hit-region-height hit)) (lime.x11::x11-ui-overlay-height (overlay)))) "clipped hit bounds")) (point-at '(:key :escape)) (hand (lime.x11::x11-ui-overlay-window (overlay)) "offset Head's Close button uses hand") (move 900 600) (check (null (lime.x11::x11-ui-overlay-hovered-action (overlay))) "leaving clears hover") (arrow "leaving menu restores arrow") (key :escape) (check (not (session)) "Close button works on offset Head")) (let ((other (xlib:open-default-display (format nil ":~D" number)))) (unwind-protect (let ((other-root (xlib:screen-root (xlib:display-default-screen other)))) (lime.x11:backend-open-command-palette backend) (check (eq :already-grabbed (xlib:grab-keyboard other-root)) "open menu holds keyboard") (key :escape) (check (eq :success (xlib:grab-keyboard other-root)) "closing releases keyboard")) (xlib:close-display other))) (lime.x11:stop-backend backend) (check (null (lime.x11::x11-backend-root-cursor backend)) "cursor resource released") (check (null (lime.x11::x11-backend-hand-cursor backend)) "hand cursor released") (format t "~&Live X11 pointer/menu: ~D checks passed.~%" checks)))) (when backend (lime.x11:stop-backend backend)) (uiop:terminate-process server) (uiop:wait-process server)))