6cd5a67a35
Load same-basename Elisp companions through the generic preview runner. Demonstrate size semantics and native help, pointer, hover and keymap behavior with isolated example state. Update Flex and Grid examples and extend reusable comparison and interaction evaluators with publication, allocation and fresh-render parity checks. Validation: make check passed, including all 72 Playground tests.
526 lines
27 KiB
EmacsLisp
526 lines
27 KiB
EmacsLisp
;;; ebox-playground-interaction-tests.el --- Native interaction example tests -*- lexical-binding: t; -*-
|
|
|
|
;;; Commentary:
|
|
;; Exercise the actual example through the generic public file runner. Native
|
|
;; properties and commands are observed on rendered text; lexical closures and
|
|
;; keymap graphs are intentionally treated as opaque application values.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'cl-lib)
|
|
(require 'ebox-playground)
|
|
(require 'ebox-playground-flex-resize-evaluator
|
|
(expand-file-name "scripts/ebox-playground-flex-resize-evaluator.el"
|
|
ebox-playground-directory))
|
|
|
|
(defconst ebox-playground-interaction-test--file
|
|
(expand-file-name "examples/interaction-reference.ebox"
|
|
ebox-playground-directory)
|
|
"Interaction example checked through the ordinary file runner.")
|
|
|
|
(cl-defmacro ebox-playground-interaction-test--with-preview
|
|
((buffer &optional (width 720) (height 200)) &rest body)
|
|
"Run BODY in a fresh BUFFER preview at WIDTH and HEIGHT, then close it."
|
|
(declare (indent 1) (debug ((symbolp &optional form form) body)))
|
|
`(let ((,buffer (generate-new-buffer " *ebox-interaction-test*"))
|
|
(ebox-viewport-width ,width)
|
|
(ebox-viewport-height ,height)
|
|
(ebox-runtime-idle-prewarm nil)
|
|
(ebox-runtime-idle-reflow-cache-prewarm nil))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-playground-open-file
|
|
ebox-playground-interaction-test--file (buffer-name ,buffer))
|
|
(with-current-buffer ,buffer ,@body))
|
|
(when (buffer-live-p ,buffer)
|
|
(ebox-playground-close (buffer-name ,buffer))))))
|
|
|
|
(defun ebox-playground-interaction-test--position (label)
|
|
"Return the first rendered character position of LABEL in this preview."
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(unless (search-forward label nil t)
|
|
(ert-fail (format "Missing rendered interaction label: %s" label)))
|
|
(- (point) (length label))))
|
|
|
|
(defun ebox-playground-interaction-test--property (label property)
|
|
"Return native PROPERTY at the rendered LABEL."
|
|
(get-text-property
|
|
(ebox-playground-interaction-test--position label) property))
|
|
|
|
(defun ebox-playground-interaction-test--activate (label &optional key)
|
|
"Look up KEY at rendered LABEL and invoke its native interactive command."
|
|
(let* ((keys (or key (kbd "RET")))
|
|
(position (ebox-playground-interaction-test--position label))
|
|
(map (get-text-property position 'keymap)))
|
|
(goto-char position)
|
|
(should (keymapp map))
|
|
(let ((command (key-binding keys))
|
|
(last-input-event (aref (vconcat keys) (1- (length keys)))))
|
|
(should (commandp command))
|
|
(should (eq command (lookup-key map keys)))
|
|
(call-interactively command)
|
|
command)))
|
|
|
|
(defun ebox-playground-interaction-test--click (label &optional offset)
|
|
"Click rendered LABEL at OFFSET through native event lookup in another buffer."
|
|
(let* ((buffer (current-buffer))
|
|
(position (+ (ebox-playground-interaction-test--position label)
|
|
(or offset 0)))
|
|
(map (get-text-property position 'keymap))
|
|
command)
|
|
(should (keymapp map))
|
|
(save-window-excursion
|
|
(set-window-buffer (selected-window) buffer)
|
|
(let* ((event (list 'mouse-1 (list (selected-window) position '(0 . 0) 0)))
|
|
(keys (vector event))
|
|
(last-input-event event))
|
|
(setq command (key-binding [mouse-1] nil nil position))
|
|
(should (commandp command))
|
|
(should (eq command (lookup-key map [mouse-1])))
|
|
(with-temp-buffer
|
|
(call-interactively command nil keys)
|
|
(should (zerop (buffer-size))))))
|
|
command))
|
|
|
|
(defun ebox-playground-interaction-test--count (expected)
|
|
"Assert that the preview displays the independent count EXPECTED."
|
|
(should (integerp
|
|
(ebox-playground-interaction-test--position
|
|
(format "COUNT %02d" expected)))))
|
|
|
|
(defun ebox-playground-interaction-test--help ()
|
|
"Invoke the live action's native help callback with Emacs's arguments."
|
|
(let* ((position (ebox-playground-interaction-test--position "ADD "))
|
|
(callback (get-text-property position 'help-echo)))
|
|
(should (functionp callback))
|
|
(funcall callback (selected-window) (current-buffer) position)))
|
|
|
|
(defun ebox-playground-interaction-test--padding-position (label)
|
|
"Find LABEL's command on the otherwise blank Box padding line above it."
|
|
(let* ((position (ebox-playground-interaction-test--position label))
|
|
(command (lookup-key (get-text-property position 'keymap) (kbd "RET")))
|
|
(background
|
|
(plist-get (ebox-playground-flex-resize-evaluator--effective-face
|
|
(get-text-property position 'face))
|
|
:background)))
|
|
(save-excursion
|
|
(goto-char position)
|
|
(forward-line -1)
|
|
(should (string-match-p
|
|
"\\`[[:space:]]*\\'"
|
|
(buffer-substring-no-properties
|
|
(line-beginning-position) (line-end-position))))
|
|
(or (cl-loop for at from (line-beginning-position)
|
|
below (line-end-position)
|
|
for map = (get-text-property at 'keymap)
|
|
when (and (keymapp map)
|
|
(eq (lookup-key map (kbd "RET")) command)
|
|
;; Border glyphs share the Box map but retain
|
|
;; their stroke color when the interior hovers.
|
|
(equal
|
|
(plist-get
|
|
(ebox-playground-flex-resize-evaluator--effective-face
|
|
(get-text-property at 'face))
|
|
:background)
|
|
background))
|
|
return at)
|
|
(ert-fail (format "Box padding lost the command for %s" label))))))
|
|
|
|
(ert-deftest ebox-playground-interaction-static-help-pointer-and-hover-samples ()
|
|
"The isolated examples publish native properties on the intended content."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(dolist (sample '(("ARROW" arrow) ("Text-only hint" text)
|
|
("HORIZONTAL DRAG" hdrag)))
|
|
(should (eq (ebox-playground-interaction-test--property
|
|
(car sample) 'pointer)
|
|
(cadr sample)))
|
|
(should (stringp (ebox-playground-interaction-test--property
|
|
(car sample) 'help-echo)))
|
|
(should-not (ebox-playground-interaction-test--property
|
|
(car sample) 'keymap)))
|
|
(should-not (ebox-playground-interaction-test--property
|
|
"TEXT POINTER" 'pointer))
|
|
(should-not (ebox-playground-interaction-test--property
|
|
"TEXT POINTER" 'help-echo))
|
|
(let ((cool (ebox-playground-flex-resize-evaluator--effective-face
|
|
(ebox-playground-interaction-test--property
|
|
"COOL FILL" 'mouse-face)))
|
|
(warm (ebox-playground-flex-resize-evaluator--effective-face
|
|
(ebox-playground-interaction-test--property
|
|
"WARM + UNDERLINE" 'mouse-face))))
|
|
(should (equal (plist-get cool :foreground) "#FFFFFF"))
|
|
(should (equal (plist-get cool :background) "#286477"))
|
|
(should (equal (plist-get warm :foreground) "#683D16"))
|
|
(should (equal (plist-get warm :background) "#F6D6AB"))
|
|
(should (plist-get warm :underline)))
|
|
(should-not (ebox-playground-interaction-test--property
|
|
"NO HOVER STYLE" 'mouse-face))))
|
|
|
|
(ert-deftest ebox-playground-interaction-native-keys-replace-step-and-read-live-help ()
|
|
"Real key lookup uses a replaced +5 map and callbacks see current state."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(ebox-playground-interaction-test--count 0)
|
|
(should (string-match-p "count = 0; this action adds 1"
|
|
(ebox-playground-interaction-test--help)))
|
|
(let ((first-command
|
|
(ebox-playground-interaction-test--activate "ADD 1")))
|
|
(ebox-playground-interaction-test--count 1)
|
|
(should (string-match-p "count = 1; this action adds 1"
|
|
(ebox-playground-interaction-test--help)))
|
|
(ebox-playground-interaction-test--activate "SWITCH STEP" (kbd "SPC"))
|
|
(should (string-match-p "count = 1; this action adds 5"
|
|
(ebox-playground-interaction-test--help)))
|
|
(should-not
|
|
(eq first-command
|
|
(ebox-playground-interaction-test--activate "ADD 5" [return])))
|
|
(ebox-playground-interaction-test--count 6))
|
|
(ebox-playground-interaction-test--activate "ADD 5" (kbd "+"))
|
|
(ebox-playground-interaction-test--count 11)
|
|
(ebox-playground-interaction-test--activate "ADD 5" (kbd "-"))
|
|
(ebox-playground-interaction-test--count 6)
|
|
(should (string-match-p "count = 6; this action adds 5"
|
|
(ebox-playground-interaction-test--help)))
|
|
(should (integerp (ebox-playground-interaction-test--position
|
|
"-5 → count 6")))
|
|
(should (ebox-buffer-update-report buffer))))
|
|
|
|
(ert-deftest ebox-playground-interaction-minus-click-captures-step-and-restores ()
|
|
"Clicking the minus glyph subtracts, while the enclosing ADD surface adds."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(let ((minus-one (ebox-playground-interaction-test--click "[-]" 1)))
|
|
(ebox-playground-interaction-test--count -1)
|
|
(let ((add-one (ebox-playground-interaction-test--click "ADD 1")))
|
|
(should-not (eq minus-one add-one))
|
|
(should (eq add-one
|
|
(lookup-key
|
|
(get-text-property
|
|
(ebox-playground-interaction-test--padding-position "ADD 1")
|
|
'keymap)
|
|
[mouse-1]))))
|
|
(ebox-playground-interaction-test--count 0)
|
|
(ebox-playground-interaction-test--activate "[-]" (kbd "+"))
|
|
(ebox-playground-interaction-test--count 1)
|
|
(ebox-playground-interaction-test--activate "[-]" (kbd "-"))
|
|
(ebox-playground-interaction-test--count 0)
|
|
(ebox-playground-interaction-test--activate "SWITCH STEP")
|
|
(should (integerp (ebox-playground-interaction-test--position
|
|
"ADD 5 [+] [-]")))
|
|
(let ((minus-five (ebox-playground-interaction-test--click "[-]" 1)))
|
|
(should-not (eq minus-one minus-five))
|
|
(ebox-playground-interaction-test--count -5)
|
|
(let ((position (1+ (ebox-playground-interaction-test--position "[-]"))))
|
|
(should (string-match-p
|
|
"count = -5; this action subtracts 5"
|
|
(funcall (get-text-property position 'help-echo)
|
|
(selected-window) buffer position))))
|
|
(let ((add-five (ebox-playground-interaction-test--click "ADD 5")))
|
|
(should-not (eq add-five minus-five))
|
|
(ebox-playground-interaction-test--count 0)
|
|
(ebox-playground-interaction-test--activate "[-]" (kbd "+"))
|
|
(ebox-playground-interaction-test--count 5)
|
|
(ebox-playground-interaction-test--activate "[-]" (kbd "-"))
|
|
(ebox-playground-interaction-test--count 0)
|
|
(ebox-playground-interaction-test--activate "REMOVE / RESTORE")
|
|
(should (integerp (ebox-playground-interaction-test--position
|
|
"BINDING REMOVED [-]")))
|
|
(let ((position (1+ (ebox-playground-interaction-test--position "[-]"))))
|
|
(dolist (property '(keymap help-echo mouse-face pointer))
|
|
(should-not (get-text-property position property)))
|
|
(save-window-excursion
|
|
(set-window-buffer (selected-window) buffer)
|
|
(let* ((event (list 'mouse-1
|
|
(list (selected-window) position '(0 . 0) 0)))
|
|
(binding (key-binding [mouse-1] nil nil
|
|
(posn-point (event-start event)))))
|
|
(should-not (memq binding (list minus-five add-five))))))
|
|
(ebox-playground-interaction-test--count 0)
|
|
(ebox-playground-interaction-test--activate "REMOVE / RESTORE")
|
|
(should (integerp (ebox-playground-interaction-test--position
|
|
"ADD 5 [+] [-]")))
|
|
(dolist (property '(keymap help-echo mouse-face pointer))
|
|
(should (ebox-playground-interaction-test--property "[-]" property)))
|
|
(ebox-playground-interaction-test--click "[-]" 1)
|
|
(ebox-playground-interaction-test--count -5)
|
|
(ebox-playground-interaction-test--click "ADD 5")
|
|
(ebox-playground-interaction-test--count 0))))))
|
|
|
|
(ert-deftest ebox-playground-interaction-class-control-updates-all-statuses-in-one-batch ()
|
|
"One native command updates three class targets and preserves other controls."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(should (= (length (ebox-selector-query-buffer buffer ".demo-status")) 3))
|
|
(dolist (label '("WAIT A" "WAIT B" "WAIT C"))
|
|
(should (equal
|
|
(plist-get
|
|
(ebox-playground-flex-resize-evaluator--effective-face
|
|
(ebox-playground-interaction-test--property label 'face))
|
|
:foreground)
|
|
"#85652F"))
|
|
(should-not (ebox-playground-interaction-test--property label 'help-echo)))
|
|
(let* ((count-command
|
|
(ebox-playground-interaction-test--activate "ADD 1"))
|
|
(revision (plist-get (ebox-buffer-update-report buffer)
|
|
:runtime-revision)))
|
|
(should (integerp revision))
|
|
(ebox-playground-interaction-test--activate "UPDATE STATUS GROUP" (kbd "SPC"))
|
|
;; The selector batch publishes once; recording the event publishes once.
|
|
(should (= (plist-get (ebox-buffer-update-report buffer) :runtime-revision)
|
|
(+ revision 2)))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(let ((ready-count 0))
|
|
(while (search-forward "READY" nil t)
|
|
(cl-incf ready-count)
|
|
(let ((position (- (point) (length "READY"))))
|
|
(should (equal (get-text-property position 'help-echo)
|
|
"This status was updated with its class group."))
|
|
(should (equal
|
|
(plist-get
|
|
(ebox-playground-flex-resize-evaluator--effective-face
|
|
(get-text-property position 'face))
|
|
:foreground)
|
|
"#287A52"))))
|
|
(should (= ready-count 3)))
|
|
(goto-char (point-min))
|
|
(should-not (re-search-forward "WAIT [ABC]" nil t)))
|
|
(should (integerp (ebox-playground-interaction-test--position
|
|
"Updated three .demo-status regions in one batch")))
|
|
(ebox-playground-interaction-test--count 1)
|
|
(should (eq count-command
|
|
(ebox-playground-interaction-test--activate "ADD 1")))
|
|
(ebox-playground-interaction-test--count 2)
|
|
(ebox-playground-interaction-test--activate "[ RESET COUNT ]")
|
|
(ebox-playground-interaction-test--count 0))))
|
|
|
|
(ert-deftest ebox-playground-interaction-removes-and-restores-all-four-properties ()
|
|
"Removing bindings clears every native property on content and padding."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(ebox-playground-interaction-test--activate "SWITCH STEP")
|
|
(let ((before (mapcar
|
|
(lambda (property)
|
|
(cons property
|
|
(ebox-playground-interaction-test--property
|
|
"ADD 5" property)))
|
|
'(help-echo pointer mouse-face keymap)))
|
|
(padding (ebox-playground-interaction-test--padding-position "ADD 5")))
|
|
(dolist (property '(help-echo pointer mouse-face keymap))
|
|
(should (get-text-property padding property)))
|
|
(let ((padding-offset (save-excursion
|
|
(goto-char padding)
|
|
(- padding (line-beginning-position)))))
|
|
(ebox-playground-interaction-test--activate "REMOVE / RESTORE")
|
|
;; The status above this row changes length, so find the new padding
|
|
;; position instead of accidentally testing an old buffer offset.
|
|
(setq padding
|
|
(save-excursion
|
|
(goto-char (ebox-playground-interaction-test--position
|
|
"BINDING REMOVED"))
|
|
(forward-line -1)
|
|
(+ (line-beginning-position) padding-offset))))
|
|
(let ((position (ebox-playground-interaction-test--position
|
|
"BINDING REMOVED")))
|
|
(goto-char position)
|
|
(dolist (property '(help-echo pointer mouse-face keymap))
|
|
(should-not (get-text-property position property))
|
|
(should-not (get-text-property padding property)))
|
|
(should-not
|
|
(eq (key-binding (kbd "RET"))
|
|
(lookup-key (cdr (assq 'keymap before)) (kbd "RET")))))
|
|
(ebox-playground-interaction-test--count 0)
|
|
(ebox-playground-interaction-test--activate "REMOVE / RESTORE")
|
|
(dolist (property '(help-echo pointer mouse-face keymap))
|
|
(should (ebox-playground-interaction-test--property "ADD 5" property)))
|
|
(should (string-match-p "count = 0; this action adds 5"
|
|
(ebox-playground-interaction-test--help)))
|
|
(should (equal (ebox-playground-interaction-test--property
|
|
"ADD 5" 'mouse-face)
|
|
(cdr (assq 'mouse-face before))))
|
|
(ebox-playground-interaction-test--activate "ADD 5")
|
|
(ebox-playground-interaction-test--count 5))))
|
|
|
|
(ert-deftest ebox-playground-interaction-palette-update-preserves-geometry-and-command ()
|
|
"Hover replacement publishes native faces without moving the live control."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(let* ((position (ebox-playground-interaction-test--position "ADD 1"))
|
|
(padding (ebox-playground-interaction-test--padding-position "ADD 1"))
|
|
(map (get-text-property position 'keymap))
|
|
(command (lookup-key map (kbd "RET")))
|
|
(line-width (save-excursion
|
|
(goto-char position)
|
|
(ebox-string-pixel-width
|
|
(buffer-substring (line-beginning-position)
|
|
(line-end-position))))))
|
|
(should (equal (plist-get
|
|
(ebox-playground-flex-resize-evaluator--effective-face
|
|
(get-text-property position 'mouse-face))
|
|
:background)
|
|
"#BCDDE5"))
|
|
(ebox-playground-interaction-test--activate "SWITCH HOVER")
|
|
(should (= position (ebox-playground-interaction-test--position "ADD 1")))
|
|
(dolist (at (list position padding))
|
|
(let ((face (ebox-playground-flex-resize-evaluator--effective-face
|
|
(get-text-property at 'mouse-face))))
|
|
(should (equal (plist-get face :background) "#F6D6AB"))
|
|
(should (equal (plist-get face :foreground) "#683D16"))
|
|
(should (plist-get face :underline))))
|
|
(save-excursion
|
|
(goto-char position)
|
|
(should (= line-width
|
|
(ebox-string-pixel-width
|
|
(buffer-substring (line-beginning-position)
|
|
(line-end-position))))))
|
|
(should (eq command
|
|
(ebox-playground-interaction-test--activate "ADD 1")))
|
|
(ebox-playground-interaction-test--count 1)
|
|
(ebox-playground-interaction-test--activate "SWITCH HOVER")
|
|
(should (equal
|
|
(plist-get
|
|
(ebox-playground-flex-resize-evaluator--effective-face
|
|
(ebox-playground-interaction-test--property "ADD 1" 'mouse-face))
|
|
:background)
|
|
"#BCDDE5")))))
|
|
|
|
(ert-deftest ebox-playground-interaction-text-keymap-resets-count ()
|
|
"A Text node dispatches its own native command inside ordinary prose."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(ebox-playground-interaction-test--activate "ADD 1")
|
|
(ebox-playground-interaction-test--activate "ADD 1" (kbd "SPC"))
|
|
(ebox-playground-interaction-test--count 2)
|
|
(should-not (ebox-playground-interaction-test--property
|
|
"Text can be interactive too:" 'keymap))
|
|
(should (eq (ebox-playground-interaction-test--property
|
|
"[ RESET COUNT ]" 'pointer) 'hand))
|
|
(ebox-playground-interaction-test--activate "[ RESET COUNT ]" (kbd "SPC"))
|
|
(ebox-playground-interaction-test--count 0)
|
|
(should (integerp (ebox-playground-interaction-test--position "Reset count")))
|
|
(should (string-match-p "count = 0; this action adds 1"
|
|
(ebox-playground-interaction-test--help)))))
|
|
|
|
(ert-deftest ebox-playground-interaction-nested-owner-and-explicit-nil ()
|
|
"Parent padding works, child bindings win, and explicit nil blocks all four."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(let ((parent-command
|
|
(ebox-playground-interaction-test--activate "PARENT SURFACE —")))
|
|
(should (integerp (ebox-playground-interaction-test--position
|
|
"01 PARENT surface activated")))
|
|
(let* ((padding (ebox-playground-interaction-test--padding-position
|
|
"PARENT SURFACE —"))
|
|
(last-input-event ?\r))
|
|
(goto-char padding)
|
|
(should (eq (key-binding (kbd "RET")) parent-command))
|
|
(call-interactively (key-binding (kbd "RET"))))
|
|
(should (integerp (ebox-playground-interaction-test--position
|
|
"02 PARENT surface activated")))
|
|
(let ((child-command
|
|
(ebox-playground-interaction-test--activate "[ CHILD ACTION ]")))
|
|
;; Activation starts on the child's first character, including the
|
|
;; key-binding check against its own map in the shared helper.
|
|
(should-not (eq parent-command child-command))
|
|
(should (integerp (ebox-playground-interaction-test--position
|
|
"03 CHILD text activated")))
|
|
(goto-char (+ (ebox-playground-interaction-test--position
|
|
"[ CHILD ACTION ]")
|
|
(length "[ CHILD ACTION ]")))
|
|
(should (eq (key-binding (kbd "RET")) parent-command))
|
|
(let* ((label "[ EXPLICIT NIL: no inherited interaction ]")
|
|
(quiet (ebox-playground-interaction-test--position label)))
|
|
(dolist (at (list quiet (1+ quiet) (+ quiet (1- (length label)))))
|
|
(dolist (property '(help-echo pointer mouse-face keymap))
|
|
(should-not (get-text-property at property)))
|
|
(goto-char at)
|
|
(should-not (eq (key-binding (kbd "RET")) parent-command))
|
|
(should-not (eq (key-binding (kbd "RET")) child-command)))
|
|
(goto-char (+ quiet (length label)))
|
|
(should (eq (key-binding (kbd "RET")) parent-command)))))))
|
|
|
|
(ert-deftest ebox-playground-interaction-box-end-boundaries-exclude-margins ()
|
|
"A real example's Box command stops before both outside margin characters."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(ebox-region-update (ebox-region-resolve buffer "parent-surface")
|
|
:margin-inline '(ch 2))
|
|
(let* ((position (ebox-playground-interaction-test--position
|
|
"PARENT SURFACE —"))
|
|
(command (lookup-key (get-text-property position 'keymap)
|
|
(kbd "RET")))
|
|
(start (previous-single-property-change
|
|
(1+ position) 'keymap nil
|
|
(save-excursion (goto-char position)
|
|
(line-beginning-position))))
|
|
(end (next-single-property-change
|
|
position 'keymap nil
|
|
(save-excursion (goto-char position) (line-end-position)))))
|
|
(should (> start (save-excursion
|
|
(goto-char position) (line-beginning-position))))
|
|
(dolist (at (list start (1- end)))
|
|
(goto-char at)
|
|
(should (eq (key-binding (kbd "RET")) command)))
|
|
(dolist (at (list (1- start) end))
|
|
(goto-char at)
|
|
(dolist (property '(help-echo pointer mouse-face keymap))
|
|
(should-not (get-text-property at property)))
|
|
(should-not (eq (key-binding (kbd "RET")) command))))))
|
|
|
|
(ert-deftest ebox-playground-interaction-mouse-command-uses-event-buffer ()
|
|
"A native click targets its window even when another buffer is current."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(ebox-playground-interaction-test--click "ADD 1")
|
|
(ebox-playground-interaction-test--count 1)))
|
|
|
|
(ert-deftest ebox-playground-interaction-previews-have-independent-state ()
|
|
"Separate evaluations own independent counts, maps, help, and event logs."
|
|
(ebox-playground-interaction-test--with-preview (first)
|
|
(ebox-playground-interaction-test--with-preview (second)
|
|
(with-current-buffer first
|
|
(ebox-playground-interaction-test--activate "SWITCH STEP")
|
|
(ebox-playground-interaction-test--activate "ADD 5")
|
|
(ebox-playground-interaction-test--count 5))
|
|
(ebox-playground-interaction-test--count 0)
|
|
(should (string-match-p "count = 0; this action adds 1"
|
|
(ebox-playground-interaction-test--help)))
|
|
(should (integerp (ebox-playground-interaction-test--position
|
|
"No actions yet.")))
|
|
(ebox-playground-interaction-test--activate "ADD 1")
|
|
(ebox-playground-interaction-test--count 1)
|
|
(with-current-buffer first
|
|
(ebox-playground-interaction-test--count 5)
|
|
(should (string-match-p "count = 5; this action adds 5"
|
|
(ebox-playground-interaction-test--help)))
|
|
(ebox-playground-interaction-test--activate "[ RESET COUNT ]")
|
|
(ebox-playground-interaction-test--count 0))
|
|
(ebox-playground-interaction-test--count 1))))
|
|
|
|
(ert-deftest ebox-playground-interaction-viewport-resize-retains-updated-binding ()
|
|
"Both viewport axes change while retained command state remains usable."
|
|
(ebox-playground-interaction-test--with-preview (buffer)
|
|
(ebox-playground-interaction-test--activate "SWITCH STEP")
|
|
(ebox-playground-interaction-test--activate "SWITCH HOVER")
|
|
(let ((command (ebox-playground-interaction-test--activate "ADD 5"))
|
|
(expected 5)
|
|
(original-lines (count-lines (point-min) (point-max))))
|
|
(dolist (size '((480 220) (1000 180) (720 200)))
|
|
(ebox-rerender-buffer-with-context buffer (car size) (cadr size))
|
|
(let ((widths (mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines (buffer-string)))))
|
|
(should (= (apply #'max widths) (car size))))
|
|
(if (= (cadr size) 200)
|
|
(should (= (count-lines (point-min) (point-max)) original-lines))
|
|
(should-not (= (count-lines (point-min) (point-max)) original-lines)))
|
|
(should (eq command
|
|
(ebox-playground-interaction-test--activate "ADD 5")))
|
|
(cl-incf expected 5)
|
|
(ebox-playground-interaction-test--count expected)
|
|
(should (string-match-p
|
|
(format "count = %d; this action adds 5" expected)
|
|
(ebox-playground-interaction-test--help)))
|
|
(should (equal
|
|
(plist-get
|
|
(ebox-playground-flex-resize-evaluator--effective-face
|
|
(ebox-playground-interaction-test--property "ADD 5" 'mouse-face))
|
|
:background)
|
|
"#F6D6AB"))
|
|
(should (ebox-buffer-update-report buffer))))))
|
|
|
|
(provide 'ebox-playground-interaction-tests)
|
|
;;; ebox-playground-interaction-tests.el ends here
|