lime/test/ui.lisp

(in-package #:lime.ui.test)

(def-suite lime-ui-suite
  :description "Renderer-neutral palette session tests.")

(in-suite lime-ui-suite)

(defun candidate (id label &optional detail result)
  (make-ui-candidate :id id :label label :detail detail
                     :action (lambda () (or result (ui-close-result)))))

(test direct-search-filters-and-wraps-selection
  (let ((session (make-ui-session
                  (list (candidate "code" "Code" "Lime development")
                        (candidate "play" "Play" "Game")))))
    (ui-session-handle-key session #\g)
    (is (equal (mapcar #'ui-candidate-id (ui-session-candidates session))
               '("play")))
    (is (= (ui-session-selected-index session) 0))
    (ui-session-handle-key session :backspace)
    (ui-session-handle-key session :up)
    (is (= (ui-session-selected-index session) 1))))

(test direct-search-supports-ordered-fuzzy-program-input
  (let ((session (make-ui-session
                  (list (candidate "waterfox" "waterfox")
                        (candidate "web-browser" "web-browser")
                        (candidate "terminal" "terminal")))))
    (dolist (character '(#\w #\t #\f))
      (ui-session-handle-key session character))
    (is (equal (mapcar #'ui-candidate-id (ui-session-candidates session))
               '("waterfox")))))

(test a-candidate-can-replace-the-palette-with-an-explicit-next-step
  (let* ((follow-up (candidate "take" "Move windows here" nil (ui-close-result)))
         (session (make-ui-session
                   (list (candidate "docs" "Docs" "Lime development"
                                    (ui-replace-result
                                     (list follow-up)
                                     "Docs has windows leased on another Head."))))))
    (let ((result (ui-session-handle-key session :return)))
      (is (eq (ui-result-kind result) :replace))
      (is (equal (ui-session-status session)
                 "Docs has windows leased on another Head."))
      (is (equal (mapcar #'ui-candidate-id (ui-session-candidates session))
                 '("take"))))))

(test escape-closes-a-session-without-running-an-action
  (let ((session (make-ui-session (list (candidate "code" "Code")))))
    (is (eq (ui-result-kind (ui-session-handle-key session :escape)) :close))))

(test a-candidate-can-collect-a-name-through-a-renderer-neutral-prompt
  (let ((submitted-name nil))
    (let ((session
            (make-ui-session
             (list
              (make-ui-candidate
               :id :new-activity :label "New named Activity..."
               :action
               (lambda ()
                 (ui-prompt-result
                  "New Activity"
                  (lambda (name)
                    (setf submitted-name name)
                    (ui-close-result "Activity created.")))))))))
      (is (eq (ui-result-kind (ui-session-handle-key session :return)) :prompt))
      (is (eq (ui-session-mode session) :prompt))
      (is (equal (ui-session-prompt session) "New Activity"))
      (is (eq (ui-result-kind (ui-session-handle-key session :return)) :keep-open))
    (is (equal (ui-session-status session) "Input is required."))
      (dolist (character '(#\L #\i #\m #\e))
        (ui-session-handle-key session character))
      (is (eq (ui-result-kind (ui-session-handle-key session :return)) :close))
      (is (equal submitted-name "Lime")))))

(test key-path-mode-navigates-a-tree-and-can-return-to-search
  (let ((ran-p nil))
    (let* ((run-node (make-ui-key-node :id :run :key #\r :label "Run"
                                       :action (lambda ()
                                                 (setf ran-p t)
                                                 (ui-close-result))))
           (tools-node (make-ui-key-node :id :tools :key #\t :label "Tools"
                                         :children (list run-node)))
           (session (make-ui-session (list (candidate "search" "Search"))
                                     :key-path (list tools-node))))
      (is (eq (ui-result-kind (ui-session-handle-key session :tab)) :keep-open))
      (is (eq (ui-session-mode session) :key-path))
      (is (equal (mapcar #'ui-key-node-id (ui-session-key-nodes session))
                 '(:tools)))
      (ui-session-handle-key session #\t)
      (is (equal (mapcar #'ui-key-node-id (ui-session-key-path session))
                 '(:tools)))
      (is (equal (mapcar #'ui-key-node-id (ui-session-key-nodes session))
                 '(:run)))
      (ui-session-handle-key session :backspace)
      (is-false (ui-session-key-path session))
      (is (eq (ui-result-kind (ui-session-handle-key session #\t)) :keep-open))
      (is (eq (ui-result-kind (ui-session-handle-key session #\r)) :close))
      (is-true ran-p)
      (ui-session-handle-key session :tab)
      (is (eq (ui-session-mode session) :search)))))

(test command-map-can-open-without-a-search-list-or-running-an-action
  (let* ((runs 0)
         (leaf (make-ui-key-node :key #\h :label "Hide"
                                 :action (lambda () (incf runs) (ui-close-result))))
         (root (make-ui-key-node :key #\w :label "Windows" :children (list leaf)))
         (session (make-ui-session (list (candidate :all "All commands"))
                                   :key-path (list root) :mode :key-path)))
    (is (eq :key-path (ui-session-mode session)))
    (is (equal (list root) (ui-session-key-nodes session)))
    (is-false (ui-session-candidates session))
    (is (eq :keep-open (ui-result-kind (ui-session-handle-key session :return))))
    (is (= 0 runs))
    (ui-session-handle-key session #\z)
    (is (search "not available" (ui-session-status session)))
    (is (string= "" (ui-session-query session)))
    (ui-session-handle-key session #\w)
    (is (equal (list root) (ui-session-key-path session)))
    (is (equal (list leaf) (ui-session-key-nodes session)))
    (ui-session-handle-key session :page-down)
    (is (= 1 (ui-session-key-page session)))
    (ui-session-handle-key session :backspace)
    (is (= 0 (ui-session-key-page session)))
    (is-false (ui-session-key-path session))
    (ui-session-handle-key session #\w)
    (is (eq :close (ui-result-kind (ui-session-handle-key session #\h))))
    (is (= 1 runs))))

(test search-from-the-menu-restores-the-root-catalog-after-a-temporary-picker
  (let* ((all (candidate :all "All commands"))
         (choice (candidate :partial "Open partial view"))
         (leaf (make-ui-key-node :key #\v :label "Views"
                                :action (lambda () (ui-replace-result (list choice)))))
         (session (make-ui-session (list all) :key-path (list leaf) :mode :key-path)))
    (ui-session-handle-key session #\v)
    (is (eq :search (ui-session-mode session)))
    (is (string= "Type to filter; Enter to choose; Esc to cancel." (ui-session-status session)))
    (is (equal (list choice) (ui-session-candidates session)))
    (ui-session-handle-key session :tab)
    (is (eq :key-path (ui-session-mode session)))
    (ui-session-handle-key session #\Space)
    (is (eq :search (ui-session-mode session)))
    (is (equal (list all) (ui-session-candidates session)))
    (ui-session-handle-key session :tab)
    (ui-session-handle-key session :tab)
    (is (equal (list all) (ui-session-candidates session)))))

(test a-bound-space-in-a-custom-menu-wins-over-the-search-shortcut
  (let* ((ran nil)
         (node (make-ui-key-node :key #\Space :label "Custom command"
                                 :action (lambda () (setf ran t) (ui-close-result))))
         (session (make-ui-session nil :key-path (list node) :mode :key-path)))
    (is (eq :close (ui-result-kind (ui-session-handle-key session #\Space))))
    (is-true ran)))

(test menu-name-prompts-keep-spaces-and-dont-let-tab-run-a-command
  (let* ((name nil)
         (node (make-ui-key-node :key #\n :label "New activity"
                                 :action (lambda ()
                                           (ui-prompt-result "Name"
                                             (lambda (input) (setf name input) (ui-close-result))))))
         (session (make-ui-session nil :key-path (list node) :mode :key-path)))
    (ui-session-handle-key session #\n)
    (is (eq :prompt (ui-session-mode session)))
    (is (string= "Enter to confirm; Esc to cancel." (ui-session-status session)))
    (dolist (key '(#\M #\y #\Space #\W #\M)) (ui-session-handle-key session key))
    (ui-session-handle-key session :tab)
    (is (eq :prompt (ui-session-mode session)))
    (is-false name)
    (is (eq :close (ui-result-kind (ui-session-handle-key session :return))))
    (is (string= "My WM" name))))

(test search-and-keyless-launcher-sessions-keep-their-old-entry-behavior
  (let ((session (make-ui-session (list (candidate :terminal "st terminal")))))
    (is (eq :search (ui-session-mode session)))
    (ui-session-handle-key session #\s)
    (ui-session-handle-key session #\Space)
    (is (string= "s " (ui-session-query session)))
    (ui-session-handle-key session :tab)
    (is (eq :search (ui-session-mode session)))
    (is (eq :close (ui-result-kind (ui-session-handle-key session :escape))))))

(test pointer-candidate-activation-shares-transitions-and-rejects-stale-hits
  (let* ((runs 0)
         (choice (make-ui-candidate :label "Choice"
                                   :action (lambda () (incf runs) (ui-close-result))))
         (picker (make-ui-candidate :label "Picker"
                                   :action (lambda () (ui-replace-result (list choice)))))
         (session (make-ui-session (list picker))))
    (is (eq :keep-open (ui-result-kind (ui-session-activate-candidate session choice))))
    (is (= 0 runs))
    (is (eq :replace (ui-result-kind (ui-session-activate-candidate session picker))))
    (is (equal (list choice) (ui-session-candidates session)))
    (is (eq :keep-open (ui-result-kind (ui-session-activate-candidate session picker))))
    (is (eq :close (ui-result-kind (ui-session-activate-candidate session choice))))
    (is (= 1 runs))
    (ui-session-handle-key session #\z)
    (is-false (ui-session-candidates session))
    (is (eq :keep-open (ui-result-kind (ui-session-activate-candidate session choice))))
    (is (= 1 runs))
    (ui-session-apply-result session (ui-prompt-result "Name" (lambda (name)
                                                               (declare (ignore name))
                                                               (ui-close-result))))
    (is (eq :keep-open (ui-result-kind (ui-session-activate-candidate session choice))))
    (is (eq :prompt (ui-session-mode session)))))

(defun run-tests ()
  (run! 'lime-ui-suite))