150 lines
8.9 KiB
Common Lisp
150 lines
8.9 KiB
Common Lisp
(in-package #:lime.x11.test)
|
|
(in-suite lime-x11-suite)
|
|
|
|
(test attention-sources-are-independent-live-metadata
|
|
(let* ((backend (make-head-bar-fixture))
|
|
(world (x11-backend-world backend))
|
|
(snapshot (lime.persistence:snapshot-world world)))
|
|
(is-false (backend-attention-client-ids backend))
|
|
(lime.x11::%attention-set-source backend "browser" 1 t)
|
|
(lime.x11::%attention-set-source backend "browser" 2 t)
|
|
(is (equal '("browser") (backend-attention-client-ids backend)))
|
|
(lime.x11::%attention-set-source backend "browser" 2 nil)
|
|
(is-true (backend-client-needs-attention-p backend "browser"))
|
|
(lime.x11::%attention-set-source backend "terminal" 2 t)
|
|
(is (equal '("browser" "terminal") (backend-attention-client-ids backend)))
|
|
(is (equal '("browser" "terminal")
|
|
(backend-attention-client-ids backend :activity-id "development")))
|
|
(is-false (backend-attention-client-ids backend :activity-id "other"))
|
|
(is (equal snapshot (lime.persistence:snapshot-world world)))
|
|
(lime.x11::%attention-set-source backend "browser" 1 nil)
|
|
(is-false (backend-client-needs-attention-p backend "browser"))
|
|
(is-false (gethash "browser" (lime.x11::x11-backend-attention-clients backend)))))
|
|
|
|
(test attention-bar-and-picker-use-cached-data
|
|
(let* ((backend (make-head-bar-fixture))
|
|
(info (lime.x11::make-icccm-client-info :title "日本語 browser")))
|
|
(is-false (lime.x11::%bar-attention-segment backend))
|
|
(setf (gethash "browser" (lime.x11::x11-backend-icccm-clients backend)) info)
|
|
(lime.x11::%attention-set-source backend "browser" 1 t)
|
|
(let ((segment (lime.x11::%bar-attention-segment backend))
|
|
(candidate (first (lime.x11::%ui-attention-candidates backend))))
|
|
(is (eq :attention (head-bar-segment-id segment)))
|
|
(is (string= "! 1" (head-bar-segment-text segment)))
|
|
(is (functionp (head-bar-segment-click-action segment)))
|
|
(is (string= "Development: 日本語 browser" (ui-candidate-label candidate)))
|
|
(is (equal '(:attend-client "browser") (ui-candidate-id candidate)))
|
|
(is (string= "! Show: 日本語 browser"
|
|
(ui-candidate-label (first (lime.x11::%ui-hidden-client-candidates backend)))))
|
|
(is (search "! 1" (ui-candidate-detail (first (lime.x11::%ui-activity-candidates backend)))))
|
|
;; A cancelled request leaves a stale menu entry safe and non-mutating.
|
|
(lime.x11::%attention-set-source backend "browser" 1 nil)
|
|
(is (eq :keep-open (ui-result-kind (funcall (ui-candidate-action candidate))))))
|
|
(let* ((window (find :window (lime.x11::%ui-key-path backend) :key #'ui-key-node-id))
|
|
(attention (find :attention (ui-key-node-children window) :key #'ui-key-node-id)))
|
|
(is (char= #\a (ui-key-node-key attention))))))
|
|
|
|
(test attention-acknowledgement-requires-selected-visible-input-target
|
|
(let* ((backend (make-head-bar-fixture))
|
|
(info (lime.x11::make-icccm-client-info :wm-state :normal)))
|
|
(setf (gethash "editor" (lime.x11::x11-backend-icccm-clients backend)) info)
|
|
(is-true (lime.x11::%attention-selected-client-p backend "editor"))
|
|
(is-false (lime.x11::%attention-selected-client-p backend "terminal"))
|
|
(setf (lime.x11::x11-backend-focus-root-override-p backend) t)
|
|
(is-false (lime.x11::%attention-selected-client-p backend "editor"))
|
|
(setf (lime.x11::x11-backend-focus-root-override-p backend) nil
|
|
(lime.x11::x11-backend-ui-session backend) (make-ui-session nil))
|
|
(is-false (lime.x11::%attention-selected-client-p backend "editor"))
|
|
(setf (lime.x11::x11-backend-ui-session backend) nil
|
|
(lime.x11::icccm-client-info-wm-state info) :iconic)
|
|
(is-false (lime.x11::%attention-selected-client-p backend "editor"))
|
|
(setf (lime.x11::icccm-client-info-wm-state info) :normal
|
|
(icccm-client-info-accepts-input-p info) nil)
|
|
(is-false (lime.x11::%attention-selected-client-p backend "editor"))))
|
|
|
|
(test attention-style-is-user-owned-and-validated
|
|
(let* ((configuration (symbol-value (eval '(lime.config:defconfiguration attention-test-config
|
|
(:options :default-keybindings nil)
|
|
(:bar :attention-color "#abcdef" :attention-marker "*"
|
|
:attention-indicator-p nil)))))
|
|
(style (lime-configuration-bar-style configuration))
|
|
(backend (make-head-bar-fixture)))
|
|
(is (string= "#abcdef" (head-bar-style-attention-color style)))
|
|
(is (string= "*" (head-bar-style-attention-marker style)))
|
|
(is-false (head-bar-style-attention-indicator-p style))
|
|
(setf (lime.x11::x11-backend-configuration backend) configuration)
|
|
(lime.x11::%attention-set-source backend "browser" 1 t)
|
|
(is-false (lime.x11::%bar-attention-segment backend))
|
|
(is (= 1 (length (backend-attention-client-ids backend))))
|
|
(setf (head-bar-style-attention-indicator-p style) t)
|
|
(is (string= "* 1" (head-bar-segment-text (lime.x11::%bar-attention-segment backend))))
|
|
(dolist (bad (list (make-head-bar-style :attention-color "bad")
|
|
(make-head-bar-style :attention-marker "")
|
|
(make-head-bar-style :attention-marker (string #\Newline))
|
|
(make-head-bar-style :attention-indicator-p 1)))
|
|
(signals invalid-transition (lime.x11::%validate-head-bar-style bad)))))
|
|
|
|
(test attention-visits-respect-collisions-and-stale-choices
|
|
(dolist (policy '(:partial :take))
|
|
(declare (ignorable policy))
|
|
(let* ((backend (make-head-bar-fixture))
|
|
(world (x11-backend-world backend))
|
|
(render 'lime.x11:apply-active-presentation)
|
|
(old-render (symbol-function render)))
|
|
(setf (gethash "other" (lime.x11::x11-backend-heads backend))
|
|
(make-x11-head :head-id "other" :x 840 :y 30 :width 800 :height 600)
|
|
(lime.x11::x11-backend-head-ids backend) '("main" "other"))
|
|
(create-head world "other")
|
|
(open-activity-draft world "other" "development")
|
|
(unwind-protect
|
|
(progn
|
|
(setf (symbol-function render) (lambda (b) b))
|
|
(backend-activate-activity backend "development")
|
|
(backend-start-activity backend "chill" "Chill")
|
|
(backend-show-client backend "terminal" :head-id "other")
|
|
(backend-select-head backend "main")
|
|
(lime.x11::%attention-set-source backend "browser" 1 t)
|
|
(let* ((revision (world-revision world))
|
|
(candidate (find (list :attend-client "browser")
|
|
(lime.x11::%ui-attention-candidates backend)
|
|
:key #'ui-candidate-id :test #'equal)))
|
|
(is-true candidate)
|
|
(is (= revision (world-revision world)))
|
|
;; Request cancelled while choosing: no incidental task switch.
|
|
(lime.x11::%attention-set-source backend "browser" 1 nil)
|
|
(is (eq :keep-open (ui-result-kind (funcall (ui-candidate-action candidate)))))
|
|
(is (= revision (world-revision world)))
|
|
(lime.x11::%attention-set-source backend "browser" 1 t)
|
|
(is (eq :close (ui-result-kind (funcall (ui-candidate-action candidate)))))
|
|
(is (equal "browser" (presentation-focus-client-id (current-presentation world "main"))))
|
|
(is (equal "other"
|
|
(lime.x11::ewmh-active-head-id-for-client backend "terminal")))
|
|
(is (equal '("editor" "terminal")
|
|
(mapcar #'placement-client-id (view-placements (find-view world "development/code")))))))
|
|
(setf (symbol-function render) old-render)))))
|
|
|
|
(test attention-reclaims-only-the-requested-available-slot
|
|
(let* ((backend (make-head-bar-fixture))
|
|
(world (x11-backend-world backend))
|
|
(source (current-presentation world "main"))
|
|
(render 'lime.x11:apply-active-presentation)
|
|
(old-render (symbol-function render)))
|
|
(setf (gethash "other" (lime.x11::x11-backend-heads backend))
|
|
(make-x11-head :head-id "other" :x 840 :y 30 :width 800 :height 600)
|
|
(lime.x11::x11-backend-head-ids backend) '("main" "other"))
|
|
(create-head world "other")
|
|
(let ((other (open-activity-draft world "other" "development")))
|
|
(unwind-protect
|
|
(progn
|
|
(setf (symbol-function render) (lambda (b) b))
|
|
(dolist (id '("editor" "terminal"))
|
|
(backend-show-client-taking backend id :head-id "other")
|
|
(hide-client-from-presentation world id (presentation-id other)))
|
|
(is-false (presentation-client-ids source))
|
|
(backend-select-head backend "main")
|
|
(backend-attend-client backend "editor")
|
|
(is (equal '("editor") (presentation-client-ids source)))
|
|
(is-false (lease-for-client world "terminal"))
|
|
(is (equal "editor" (presentation-focus-client-id source))))
|
|
(setf (symbol-function render) old-render)))))
|