83352c4571
Replace the physical ekp-region renderer with ekp-buffer text-property projection backed by shared semantic layout plans and stable live-edit transactions. Optimize the C-backed resize hot path, and add deterministic performance, ERT, GUI, fuzz, release, and documentation coverage for task017 through task032. BREAKING CHANGE: require ekp-buffer instead of ekp-region and rename module-owned ekp-region-* settings to ekp-buffer-*.
1202 lines
50 KiB
EmacsLisp
1202 lines
50 KiB
EmacsLisp
;;; ekp-gui-verify.el --- GUI pixel-fit verification for ekp -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2024-2026 Kinney Zhang
|
||
|
||
;; Author: Kinney Zhang <kinneyzhang666@gmail.com>
|
||
|
||
;; This file is NOT part of GNU Emacs.
|
||
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Ground-truth verification that justified text really fits the
|
||
;; window, measured with `window-text-pixel-size' on the live display
|
||
;; — the one thing batch tests cannot check.
|
||
;;
|
||
;; Two ways to run:
|
||
;;
|
||
;; M-x ekp-gui-verify in ANY running GUI Emacs — including your
|
||
;; fully customized session. Use this when
|
||
;; justified text looks truncated: it tells
|
||
;; you whether measurement matches rendering
|
||
;; under your fonts/remappings.
|
||
;;
|
||
;; ${EMACS} -Q -L . -L tests -l tests/ekp-gui-verify.el \
|
||
;; -f ekp-gui-verify-matrix
|
||
;; runs the full matrix (plain, text-scale
|
||
;; up/down, face remap, narrow+scale) and
|
||
;; prints a PASS/FAIL table.
|
||
;;
|
||
;; Criterion: every justified line's rendered width equals the target
|
||
;; width (± `ekp-buffer-margin-pixel'). Verbatim paragraphs
|
||
;; (`ekp-verbatim') are exempt — code blocks pass through unwrapped by
|
||
;; design and may exceed a narrow window, like any code line.
|
||
|
||
;;; Code:
|
||
|
||
(require 'ekp)
|
||
(require 'ekp-buffer)
|
||
(require 'ekp-showcase)
|
||
|
||
(defun ekp-gui-verify--line-width (window base line)
|
||
"Measure planned LINE in WINDOW at paragraph BASE."
|
||
(car (window-text-pixel-size
|
||
window
|
||
(+ base (ekp-layout-line-source-start line))
|
||
(+ base (ekp-layout-line-source-end line))
|
||
t)))
|
||
|
||
(defun ekp-gui-verify--scan-span (window span margin)
|
||
"Return measurement counters for SPAN in WINDOW using MARGIN."
|
||
(let* ((plan (ekp-buffer--span-plan span))
|
||
(records (ekp-buffer--span-lines span))
|
||
(target (ekp-buffer--span-width span))
|
||
(widest 0) (over 0) (wrong 0))
|
||
(dolist (record records)
|
||
(let* ((line (ekp-buffer--projected-line-line record))
|
||
(base (marker-position
|
||
(ekp-buffer--projected-line-base record)))
|
||
(pixel (ekp-gui-verify--line-width window base line)))
|
||
(setq widest (max widest pixel))
|
||
(when (> pixel (+ target margin))
|
||
(setq over (1+ over)))
|
||
(when (and (> (length (ekp-layout-line-gaps line)) 0)
|
||
(ekp-layout-line-break-kind line)
|
||
(> (abs (- pixel target)) margin))
|
||
(setq wrong (1+ wrong)))))
|
||
(list :widest widest :over over :wrong wrong
|
||
:lines (length records)
|
||
:static (and plan t))))
|
||
|
||
(defun ekp-gui-verify--scan (buffer &optional skip-predicate)
|
||
"Measure every projected display line of BUFFER.
|
||
When SKIP-PREDICATE is non-nil, omit spans for which it returns non-nil."
|
||
(with-current-buffer buffer
|
||
(let* ((window (get-buffer-window buffer))
|
||
(body (window-body-width window t))
|
||
(target ekp-buffer--auto-width)
|
||
(margin (max 2 ekp-buffer-margin-pixel))
|
||
(widest 0) (over 0) (wrong 0) (lines 0))
|
||
(dolist (span ekp-buffer--spans)
|
||
(unless (and skip-predicate (funcall skip-predicate span))
|
||
(let ((result (ekp-gui-verify--scan-span window span margin)))
|
||
(setq widest (max widest (plist-get result :widest))
|
||
over (+ over (plist-get result :over))
|
||
wrong (+ wrong (plist-get result :wrong))
|
||
lines (+ lines (plist-get result :lines))))))
|
||
(list :body body :target target :widest widest :over over
|
||
:wrong wrong :lines lines :exempt 0
|
||
:source-clean
|
||
(and (not (text-property-not-all
|
||
(point-min) (point-max) 'ekp-soft-break nil))
|
||
(not (text-property-not-all
|
||
(point-min) (point-max) 'ekp-glue nil))
|
||
(null (overlays-in (point-min) (point-max))))
|
||
:pass (and (= over 0) (= wrong 0) (> lines 0))))))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify ()
|
||
"Verify pixel-exact justification against this session's display.
|
||
Opens the ekp showcase, enables follow-window justification, and
|
||
checks with `window-text-pixel-size' that every justified line
|
||
renders at exactly the window's text width — under YOUR fonts,
|
||
themes, remappings and text-scale. Reports PASS or FAIL."
|
||
(interactive)
|
||
(unless (display-graphic-p)
|
||
(user-error "GUI verification needs a graphical frame"))
|
||
(ekp-showcase)
|
||
(redisplay t)
|
||
(with-current-buffer "*ekp-showcase*"
|
||
(ekp-auto-justify-mode 1)
|
||
(when (timerp ekp-buffer--resize-timer)
|
||
(cancel-timer ekp-buffer--resize-timer))
|
||
(ekp-buffer--reflow (current-buffer) (ekp-buffer--effective-width))
|
||
(redisplay t)
|
||
(let* ((r (ekp-gui-verify--scan (current-buffer)))
|
||
(msg (format
|
||
"ekp-gui-verify: %s — %d lines, widest %dpx vs target %dpx (window %dpx)%s"
|
||
(if (plist-get r :pass) "PASS" "FAIL")
|
||
(plist-get r :lines) (plist-get r :widest)
|
||
(plist-get r :target) (plist-get r :body)
|
||
(if (> (plist-get r :exempt) 0)
|
||
(format ", %d verbatim lines exempt"
|
||
(plist-get r :exempt))
|
||
""))))
|
||
(message "%s" msg)
|
||
r)))
|
||
|
||
(defun ekp-gui-verify--case (name setup)
|
||
"Run one matrix case NAME with buffer SETUP; return its result plist."
|
||
;; Leftover debounce timers from the previous case must not fire
|
||
;; into this case's fresh buffer.
|
||
(dolist (fn (list #'ekp-buffer--reflow
|
||
#'ekp-buffer--process-chunk))
|
||
(cancel-function-timers fn))
|
||
(when (get-buffer "*ekp-showcase*")
|
||
(kill-buffer "*ekp-showcase*"))
|
||
(ekp-showcase)
|
||
(redisplay t)
|
||
(with-current-buffer "*ekp-showcase*"
|
||
(funcall setup)
|
||
(redisplay t)
|
||
(ekp-auto-justify-mode 1)
|
||
(when (timerp ekp-buffer--resize-timer)
|
||
(cancel-timer ekp-buffer--resize-timer))
|
||
(ekp-buffer--reflow (current-buffer) (ekp-buffer--effective-width))
|
||
(redisplay t)
|
||
(let ((r (ekp-gui-verify--scan (current-buffer))))
|
||
(prog1 (append (list :name name) r)
|
||
(ekp-auto-justify-mode -1)))))
|
||
|
||
(defun ekp-gui-verify--format-result (result)
|
||
"Format one matrix RESULT plist as a report line."
|
||
(format "%-22s body=%4d target=%4d widest=%4d over=%d/%d %s"
|
||
(plist-get result :name)
|
||
(plist-get result :body)
|
||
(plist-get result :target)
|
||
(plist-get result :widest)
|
||
(plist-get result :over)
|
||
(plist-get result :lines)
|
||
(if (plist-get result :pass) "PASS" "FAIL")))
|
||
|
||
(defun ekp-gui-verify--report (results)
|
||
"Report matrix RESULTS and return their formatted table.
|
||
In batch mode, terminate with status 1 when any result fails."
|
||
(let ((table (mapconcat #'ekp-gui-verify--format-result results "\n"))
|
||
(passed t))
|
||
(dolist (result results)
|
||
(unless (plist-get result :pass)
|
||
(setq passed nil)))
|
||
(if noninteractive
|
||
(princ (concat table "\n"))
|
||
(with-current-buffer (get-buffer-create "*ekp-gui-verify*")
|
||
(erase-buffer)
|
||
(insert table "\n")
|
||
(display-buffer (current-buffer))))
|
||
(when (and noninteractive (not passed))
|
||
(kill-emacs 1))
|
||
table))
|
||
|
||
(defun ekp-gui-verify--pixel-width (window beg end)
|
||
"Return displayed width from BEG to END in WINDOW."
|
||
(car (window-text-pixel-size window beg end t)))
|
||
|
||
(defun ekp-gui-verify--exact-ascii-glue (window)
|
||
"Return failed 1–64px ASCII glue targets in WINDOW."
|
||
(let ((natural (ekp-gui-verify--pixel-width window 2 3))
|
||
failures)
|
||
(dotimes (index 64)
|
||
(let ((target (1+ index)))
|
||
(with-silent-modifications
|
||
(ekp-buffer--remove-properties 1 4)
|
||
(ekp-buffer--put-display
|
||
2 3 (ekp-buffer--space-display natural target)))
|
||
(redisplay t)
|
||
(let ((actual (- (ekp-gui-verify--pixel-width window 1 4)
|
||
(ekp-gui-verify--pixel-width window 1 2)
|
||
(ekp-gui-verify--pixel-width window 3 4))))
|
||
(unless (= actual target)
|
||
(push (cons target actual) failures)))))
|
||
(nreverse failures)))
|
||
|
||
(defun ekp-gui-verify--exact-cjk-glue (window)
|
||
"Return failed 1–64px zero-source CJK glue targets in WINDOW."
|
||
(let ((first (ekp-gui-verify--pixel-width window 1 2))
|
||
(second (ekp-gui-verify--pixel-width window 2 3))
|
||
failures)
|
||
(dotimes (index 64)
|
||
(let ((target (1+ index)))
|
||
(with-silent-modifications
|
||
(ekp-buffer--remove-properties 1 3)
|
||
(ekp-buffer--put-display
|
||
1 2 (ekp-buffer--min-width (+ first target))))
|
||
(redisplay t)
|
||
(let ((actual (- (ekp-gui-verify--pixel-width window 1 3)
|
||
first second)))
|
||
(unless (= actual target)
|
||
(push (cons target actual) failures)))))
|
||
(nreverse failures)))
|
||
|
||
(defun ekp-gui-verify--hyphen-width (text)
|
||
"Return a width that chooses a discretionary hyphen in TEXT."
|
||
(seq-find
|
||
(lambda (width)
|
||
(seq-some
|
||
(lambda (line) (ekp-layout-line-hyphen-p line))
|
||
(append (ekp-layout-plan-lines
|
||
(ekp-layout-plan text width))
|
||
nil)))
|
||
(number-sequence 60 220 4)))
|
||
|
||
(defun ekp-gui-verify--hyphen-owner ()
|
||
"Return the source position owning the displayed discretionary hyphen."
|
||
(seq-find
|
||
(lambda (position)
|
||
(let ((display (get-text-property position 'display)))
|
||
(and (stringp display)
|
||
(string-match-p "-\n"
|
||
(substring-no-properties display)))))
|
||
(number-sequence (point-min) (1- (point-max)))))
|
||
|
||
(defun ekp-gui-verify--editor-semantics (window owner text)
|
||
"Verify point, region, and mouse semantics in WINDOW at OWNER for TEXT."
|
||
(let ((point-visible
|
||
(cl-loop
|
||
for position from (point-min) to (point-max)
|
||
always
|
||
(progn
|
||
(goto-char position)
|
||
(redisplay t)
|
||
(pos-visible-in-window-p position window t)))))
|
||
(goto-char (point-min))
|
||
(let ((vertical (vertical-motion 1 window)))
|
||
(set-mark (point-min))
|
||
(goto-char (point-max))
|
||
(activate-mark)
|
||
(redisplay t)
|
||
(let* ((xy (pos-visible-in-window-p owner window t))
|
||
(posn (and xy
|
||
(posn-at-x-y (car xy) (cadr xy) window)))
|
||
(mouse (and posn (posn-point posn))))
|
||
(list
|
||
:point-visible point-visible
|
||
:vertical-motion vertical
|
||
:vertical-source-position (point)
|
||
:region-source
|
||
(and (use-region-p)
|
||
(equal (buffer-substring-no-properties
|
||
(region-beginning) (region-end))
|
||
text))
|
||
:mouse-source-position
|
||
(and (integer-or-marker-p mouse)
|
||
(<= (point-min) mouse (point-max))))))))
|
||
|
||
(defun ekp-gui-verify--hyphen-case (window text)
|
||
"Return verification data for display-only hyphenation of TEXT in WINDOW."
|
||
(let ((width (ekp-gui-verify--hyphen-width text)))
|
||
(ekp-justify-region (point-min) (point-max) width)
|
||
(redisplay t)
|
||
(let ((owner (ekp-gui-verify--hyphen-owner)))
|
||
(append
|
||
(list
|
||
:width width
|
||
:source-clean
|
||
(equal (substring-no-properties (buffer-string)) text)
|
||
:source-lines (cl-count ?\n (buffer-string))
|
||
:screen-lines (count-screen-lines (point-min) (point-max))
|
||
:hyphen-display (and owner t)
|
||
:overlays (length (overlays-in (point-min) (point-max)))
|
||
:scan (ekp-gui-verify--scan (current-buffer))
|
||
:window-width (window-body-width window t))
|
||
(ekp-gui-verify--editor-semantics window owner text)))))
|
||
|
||
(defun ekp-gui-verify--display-properties-pass-p (result)
|
||
"Return non-nil when display-property verification RESULT passes."
|
||
(let ((hyphen (plist-get result :hyphen)))
|
||
(and (null (plist-get result :ascii-failures))
|
||
(null (plist-get result :cjk-failures))
|
||
(plist-get hyphen :source-clean)
|
||
(= (plist-get hyphen :source-lines) 0)
|
||
(> (plist-get hyphen :screen-lines) 1)
|
||
(plist-get hyphen :hyphen-display)
|
||
(= (plist-get hyphen :overlays) 0)
|
||
(plist-get hyphen :point-visible)
|
||
(> (plist-get hyphen :vertical-motion) 0)
|
||
(plist-get hyphen :region-source)
|
||
(plist-get hyphen :mouse-source-position)
|
||
(plist-get (plist-get hyphen :scan) :pass))))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-display-properties ()
|
||
"Verify exact text-property glue and display-only hyphenation."
|
||
(interactive)
|
||
(unless (display-graphic-p)
|
||
(user-error "GUI verification needs a graphical frame"))
|
||
(let ((buffer (generate-new-buffer "*ekp-display-properties*"))
|
||
result)
|
||
(unwind-protect
|
||
(progn
|
||
(switch-to-buffer buffer)
|
||
(delete-other-windows)
|
||
(insert "a b")
|
||
(redisplay t)
|
||
(let ((ascii (ekp-gui-verify--exact-ascii-glue
|
||
(selected-window))))
|
||
(erase-buffer)
|
||
(insert "中文")
|
||
(redisplay t)
|
||
(let ((cjk (ekp-gui-verify--exact-cjk-glue
|
||
(selected-window))))
|
||
(erase-buffer)
|
||
(let ((text
|
||
"extraordinary hyphenation demonstration paragraph"))
|
||
(insert text)
|
||
(setq result
|
||
(list :ascii-failures ascii
|
||
:cjk-failures cjk
|
||
:hyphen
|
||
(ekp-gui-verify--hyphen-case
|
||
(selected-window) text)))
|
||
(setq result
|
||
(plist-put
|
||
result :pass
|
||
(ekp-gui-verify--display-properties-pass-p
|
||
result)))))))
|
||
(when (buffer-live-p buffer)
|
||
(kill-buffer buffer)))
|
||
(when (called-interactively-p 'interactive)
|
||
(message "ekp display-property verification: %s"
|
||
(if (plist-get result :pass) "PASS" "FAIL")))
|
||
result))
|
||
|
||
(defvar-local ekp-gui-verify--live-original nil)
|
||
(defvar-local ekp-gui-verify--live-expected nil)
|
||
(defvar-local ekp-gui-verify--live-suffix " overflow")
|
||
(defvar-local ekp-gui-verify--live-yank " pasted 中文 semantic prefix")
|
||
(defvar-local ekp-gui-verify--live-original-signatures nil)
|
||
(defvar-local ekp-gui-verify--live-original-projection-hash nil)
|
||
(defvar-local ekp-gui-verify--live-original-active-index nil)
|
||
(defvar-local ekp-gui-verify--live-original-prefix-end nil)
|
||
(defvar-local ekp-gui-verify--live-original-width nil)
|
||
(defvar-local ekp-gui-verify--live-original-screen-lines nil)
|
||
(defvar-local ekp-gui-verify--live-post-crossing-state nil)
|
||
(defvar-local ekp-gui-verify--live-motion-generation nil)
|
||
(defvar-local ekp-gui-verify--live-motion-cache-size nil)
|
||
(defvar-local ekp-gui-verify--live-motion-state nil)
|
||
(defvar-local ekp-gui-verify--live-middle-position nil)
|
||
(defvar-local ekp-gui-verify--live-middle-later-beg nil)
|
||
(defvar-local ekp-gui-verify--live-middle-later-end nil)
|
||
(defvar-local ekp-gui-verify--live-middle-later-hash nil)
|
||
(defvar-local ekp-gui-verify--live-middle-plan nil)
|
||
(defvar-local ekp-gui-verify--live-middle-spans nil)
|
||
(defvar-local ekp-gui-verify--live-stage "setup")
|
||
|
||
(defun ekp-gui-verify--near-overflow-text (target)
|
||
"Return prose whose natural final line is nearly full at TARGET."
|
||
(let ((words ["alpha" "中文" "beta" "排版" "gamma" "编辑"])
|
||
(text "")
|
||
(index 0)
|
||
found)
|
||
(while (and (< index 300) (not found))
|
||
(setq text
|
||
(concat text
|
||
(if (string-empty-p text) "" " ")
|
||
(aref words (% index (length words)))))
|
||
(let* ((plan (ekp-layout-plan text target))
|
||
(lines (ekp-layout-plan-lines plan)))
|
||
(when (> (length lines) 2)
|
||
(let* ((line (aref lines (1- (length lines))))
|
||
(tail (substring
|
||
text
|
||
(ekp-layout-line-source-start line)
|
||
(ekp-layout-line-source-end line)))
|
||
(remaining (- target (ekp--measured-width tail))))
|
||
(setq found
|
||
(and (> remaining 0)
|
||
(< remaining
|
||
(ekp--measured-width
|
||
ekp-gui-verify--live-suffix)))))))
|
||
(setq index (1+ index)))
|
||
text))
|
||
|
||
(defun ekp-gui-verify--range-property-hash (beg end)
|
||
"Return an exact text-property hash for BEG through END."
|
||
(secure-hash
|
||
'sha256
|
||
(prin1-to-string (buffer-substring beg end))))
|
||
|
||
(defun ekp-gui-verify--configure-middle-edit ()
|
||
"Record one projected space and a later stable anchor range."
|
||
(let* ((spans (ekp-buffer--live-state-spans ekp-buffer--live-state))
|
||
(dirty (car spans))
|
||
(later (cadr spans))
|
||
(dirty-beg (marker-position (ekp-buffer--span-beg dirty)))
|
||
(dirty-end (marker-position (ekp-buffer--span-end dirty)))
|
||
(space
|
||
(save-excursion
|
||
(goto-char dirty-beg)
|
||
(search-forward " " dirty-end t))))
|
||
(unless (and space later)
|
||
(error "Live GUI setup needs one dirty row and one later anchor"))
|
||
(setq ekp-gui-verify--live-middle-position (copy-marker (1- space))
|
||
ekp-gui-verify--live-middle-later-beg
|
||
(copy-marker (marker-position (ekp-buffer--span-beg later)))
|
||
ekp-gui-verify--live-middle-later-end
|
||
(copy-marker
|
||
(marker-position (ekp-buffer--span-end (car (last spans)))) t)
|
||
ekp-gui-verify--live-middle-later-hash
|
||
(ekp-gui-verify--range-property-hash
|
||
ekp-gui-verify--live-middle-later-beg
|
||
ekp-gui-verify--live-middle-later-end)
|
||
ekp-gui-verify--live-middle-plan
|
||
(ekp-buffer--live-state-plan ekp-buffer--live-state)
|
||
ekp-gui-verify--live-middle-spans spans)))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-setup ()
|
||
"Create a deterministic GUI buffer for live typing verification."
|
||
(interactive)
|
||
(unless (display-graphic-p)
|
||
(user-error "GUI verification needs a graphical frame"))
|
||
(set-frame-parameter (selected-frame) 'fullscreen 'fullboth)
|
||
(delete-other-windows)
|
||
(let ((buffer (get-buffer-create "*EKP Live Layout*")))
|
||
(switch-to-buffer buffer)
|
||
(when ekp-auto-justify-mode
|
||
(ekp-auto-justify-mode -1))
|
||
(let ((inhibit-read-only t))
|
||
(erase-buffer)
|
||
(text-mode)
|
||
(setq-local truncate-lines nil)
|
||
(redisplay t)
|
||
(insert (ekp-gui-verify--near-overflow-text
|
||
(ekp-buffer--effective-width)))
|
||
(setq ekp-gui-verify--live-original
|
||
(substring-no-properties (buffer-string))
|
||
ekp-gui-verify--live-expected
|
||
ekp-gui-verify--live-original
|
||
ekp-gui-verify--live-post-crossing-state nil
|
||
ekp-gui-verify--live-motion-generation nil
|
||
ekp-gui-verify--live-motion-cache-size nil
|
||
ekp-gui-verify--live-motion-state nil
|
||
ekp-gui-verify--live-stage "setup")
|
||
(ekp-auto-justify-mode 1)
|
||
(goto-char (point-max))
|
||
(run-hooks 'post-command-hook)
|
||
(redisplay t)
|
||
(setq ekp-gui-verify--live-original-signatures
|
||
(copy-tree
|
||
(ekp-buffer--live-state-signatures ekp-buffer--live-state))
|
||
ekp-gui-verify--live-original-projection-hash
|
||
(ekp-gui-verify--projection-hash)
|
||
ekp-gui-verify--live-original-active-index
|
||
(ekp-buffer--live-state-active-index ekp-buffer--live-state)
|
||
ekp-gui-verify--live-original-prefix-end
|
||
(marker-position
|
||
(ekp-buffer--live-state-prefix-end ekp-buffer--live-state))
|
||
ekp-gui-verify--live-original-width
|
||
ekp-buffer--auto-width
|
||
ekp-gui-verify--live-original-screen-lines
|
||
(count-screen-lines (point-min) (point-max)))
|
||
(ekp-gui-verify--configure-middle-edit))
|
||
(ekp-gui-verify-live-adapter)))
|
||
|
||
(defun ekp-gui-verify--owned-break-positions (&optional beg end)
|
||
"Return EKP-owned replacing-display newline positions from BEG to END."
|
||
(let ((position (or beg (point-min)))
|
||
(limit (or end (point-max)))
|
||
positions)
|
||
(while (< position limit)
|
||
(let* ((display (get-text-property
|
||
position 'ekp-buffer--display))
|
||
(next (or (next-single-property-change
|
||
position 'ekp-buffer--display nil limit)
|
||
limit)))
|
||
(when (and (stringp display)
|
||
(string-match-p
|
||
"\n" (substring-no-properties display)))
|
||
(push position positions))
|
||
(setq position next)))
|
||
(nreverse positions)))
|
||
|
||
(defun ekp-gui-verify--owned-property-runs ()
|
||
"Return stable descriptions of all EKP-owned projection runs."
|
||
(let ((position (point-min))
|
||
runs)
|
||
(while (< position (point-max))
|
||
(let* ((next (or (next-property-change
|
||
position nil (point-max))
|
||
(point-max)))
|
||
(display (get-text-property
|
||
position 'ekp-buffer--display))
|
||
(prefix (get-text-property
|
||
position 'ekp-buffer--line-prefix))
|
||
(justified (get-text-property position 'ekp-justified)))
|
||
(when (or display prefix justified)
|
||
(push (list position next display prefix justified) runs))
|
||
(setq position next)))
|
||
(nreverse runs)))
|
||
|
||
(defun ekp-gui-verify--projection-hash ()
|
||
"Return a stable hash of the current EKP projection."
|
||
(secure-hash
|
||
'sha256 (prin1-to-string (ekp-gui-verify--owned-property-runs))))
|
||
|
||
(defun ekp-gui-verify--stable-live-state ()
|
||
"Return the committed live projection state relevant to stability."
|
||
(let ((state ekp-buffer--live-state))
|
||
(list
|
||
:active (ekp-buffer--live-state-active-index state)
|
||
:prefix-end
|
||
(marker-position (ekp-buffer--live-state-prefix-end state))
|
||
:signatures (ekp-buffer--live-state-signatures state)
|
||
:projection (ekp-gui-verify--projection-hash)
|
||
:plan (ekp-buffer--live-state-plan state)
|
||
:spans (ekp-buffer--live-state-spans state))))
|
||
|
||
(defun ekp-gui-verify--stable-live-state-matches-p (snapshot)
|
||
"Return non-nil when the committed projection matches SNAPSHOT exactly."
|
||
(let ((current (ekp-gui-verify--stable-live-state)))
|
||
(and (eql (plist-get current :active)
|
||
(plist-get snapshot :active))
|
||
(eql (plist-get current :prefix-end)
|
||
(plist-get snapshot :prefix-end))
|
||
(eq (plist-get current :signatures)
|
||
(plist-get snapshot :signatures))
|
||
(equal (plist-get current :projection)
|
||
(plist-get snapshot :projection))
|
||
(eq (plist-get current :plan)
|
||
(plist-get snapshot :plan))
|
||
(eq (plist-get current :spans)
|
||
(plist-get snapshot :spans)))))
|
||
|
||
(defun ekp-gui-verify--dirty-live-span-p (span)
|
||
"Return non-nil when SPAN belongs to the current natural dirty island."
|
||
(when-let* ((edit ekp-buffer--live-edit)
|
||
(beg (marker-position
|
||
(ekp-buffer--live-edit-dirty-beg edit)))
|
||
(end (marker-position
|
||
(ekp-buffer--live-edit-dirty-end edit))))
|
||
(ekp-buffer--span-overlaps-p span beg end)))
|
||
|
||
(defun ekp-gui-verify--live-active-bounds ()
|
||
"Return the active semantic source range, or nil."
|
||
(if ekp-buffer--live-edit
|
||
(let ((beg (marker-position
|
||
(ekp-buffer--live-edit-dirty-beg ekp-buffer--live-edit)))
|
||
(end (marker-position
|
||
(ekp-buffer--live-edit-dirty-end ekp-buffer--live-edit))))
|
||
(and beg end (<= beg end) (cons beg end)))
|
||
(when-let* ((state ekp-buffer--live-state)
|
||
(plan (ekp-buffer--live-state-plan state))
|
||
(active (ekp-buffer--live-state-active-index state))
|
||
(beg (marker-position (ekp-buffer--live-state-beg state)))
|
||
(end (marker-position (ekp-buffer--live-state-end state))))
|
||
(let ((lines (ekp-layout-plan-lines plan)))
|
||
(when (< active (length lines))
|
||
(let ((line (aref lines active)))
|
||
(cons (+ beg (ekp-layout-line-source-start line)) end)))))))
|
||
|
||
(defun ekp-gui-verify--owned-layout-p (beg end)
|
||
"Return non-nil when BEG through END carries EKP layout."
|
||
(or (text-property-not-all beg end 'ekp-buffer--display nil)
|
||
(text-property-not-all beg end 'ekp-buffer--line-prefix nil)
|
||
(text-property-not-all beg end 'ekp-justified nil)))
|
||
|
||
(defun ekp-gui-verify--active-line-natural-p ()
|
||
"Return non-nil when the active semantic line has no EKP layout."
|
||
(when-let* ((bounds (ekp-gui-verify--live-active-bounds)))
|
||
(not (ekp-gui-verify--owned-layout-p
|
||
(car bounds) (cdr bounds)))))
|
||
|
||
(defun ekp-gui-verify--current-live-signatures ()
|
||
"Return the current semantic prefix signatures."
|
||
(and ekp-buffer--live-state
|
||
(ekp-buffer--live-state-signatures ekp-buffer--live-state)))
|
||
|
||
(defun ekp-gui-verify--stage-check (stage predicate)
|
||
"Return PREDICATE for STAGE, and true for every other stage."
|
||
(if (equal ekp-gui-verify--live-stage stage)
|
||
(if predicate t :false)
|
||
t))
|
||
|
||
(defun ekp-gui-verify-live-adapter ()
|
||
"Return JSON-compatible state for the live verification buffer."
|
||
(let* ((live-beg
|
||
(and ekp-buffer--live-state
|
||
(marker-position
|
||
(ekp-buffer--live-state-beg ekp-buffer--live-state))))
|
||
(live-end
|
||
(and ekp-buffer--live-state
|
||
(marker-position
|
||
(ekp-buffer--live-state-end ekp-buffer--live-state))))
|
||
(scan (ekp-gui-verify--scan
|
||
(current-buffer) #'ekp-gui-verify--dirty-live-span-p))
|
||
(logical (substring-no-properties (buffer-string)))
|
||
(breaks (ekp-gui-verify--owned-break-positions))
|
||
(live-breaks
|
||
(and live-beg live-end
|
||
(ekp-gui-verify--owned-break-positions live-beg live-end)))
|
||
(active (and ekp-buffer--live-state
|
||
(ekp-buffer--live-state-active-index
|
||
ekp-buffer--live-state)))
|
||
(prefix-end
|
||
(and ekp-buffer--live-state
|
||
(marker-position
|
||
(ekp-buffer--live-state-prefix-end
|
||
ekp-buffer--live-state))))
|
||
(signatures (ekp-gui-verify--current-live-signatures))
|
||
(projection-hash (ekp-gui-verify--projection-hash))
|
||
(later-hash
|
||
(and (markerp ekp-gui-verify--live-middle-later-beg)
|
||
(marker-position ekp-gui-verify--live-middle-later-beg)
|
||
(ekp-gui-verify--range-property-hash
|
||
ekp-gui-verify--live-middle-later-beg
|
||
ekp-gui-verify--live-middle-later-end)))
|
||
(original-p
|
||
(equal ekp-gui-verify--live-expected
|
||
ekp-gui-verify--live-original)))
|
||
`((logical_length . ,(length logical))
|
||
(logical_sha256 . ,(secure-hash 'sha256 logical))
|
||
(expected_source . ,(if (equal logical
|
||
ekp-gui-verify--live-expected)
|
||
t :false))
|
||
(source_newlines . ,(cl-count ?\n logical))
|
||
(owned_breaks . ,(length breaks))
|
||
(live_owned_breaks . ,(length live-breaks))
|
||
(stage . ,ekp-gui-verify--live-stage)
|
||
(projection_sha256 . ,projection-hash)
|
||
(active_index . ,(or active -1))
|
||
(stable_boundary_position . ,(or prefix-end -1))
|
||
(prefix_lines . ,(length signatures))
|
||
(plan_lines
|
||
. ,(if-let* ((plan (and ekp-buffer--live-state
|
||
(ekp-buffer--live-state-plan
|
||
ekp-buffer--live-state))))
|
||
(length (ekp-layout-plan-lines plan))
|
||
0))
|
||
(middle_anchor_preserved
|
||
. ,(ekp-gui-verify--stage-check
|
||
"middle-dirty"
|
||
(and ekp-buffer--live-edit
|
||
(equal later-hash
|
||
ekp-gui-verify--live-middle-later-hash)
|
||
(eq (ekp-buffer--live-state-plan ekp-buffer--live-state)
|
||
ekp-gui-verify--live-middle-plan)
|
||
(eq (ekp-buffer--live-state-spans ekp-buffer--live-state)
|
||
ekp-gui-verify--live-middle-spans))))
|
||
(middle_exact_restored
|
||
. ,(ekp-gui-verify--stage-check
|
||
"middle-restored"
|
||
(and original-p
|
||
(not ekp-buffer--live-edit)
|
||
(equal projection-hash
|
||
ekp-gui-verify--live-original-projection-hash)
|
||
(equal later-hash
|
||
ekp-gui-verify--live-middle-later-hash)
|
||
(eq (ekp-buffer--live-state-plan ekp-buffer--live-state)
|
||
ekp-gui-verify--live-middle-plan)
|
||
(eq (ekp-buffer--live-state-spans ekp-buffer--live-state)
|
||
ekp-gui-verify--live-middle-spans))))
|
||
(prefix_replanned
|
||
. ,(ekp-gui-verify--stage-check
|
||
"typed"
|
||
(and ekp-gui-verify--live-post-crossing-state
|
||
(ekp-gui-verify--stable-live-state-matches-p
|
||
ekp-gui-verify--live-post-crossing-state)
|
||
(not (equal signatures
|
||
ekp-gui-verify--live-original-signatures)))))
|
||
(delete_preserved_committed_projection
|
||
. ,(ekp-gui-verify--stage-check
|
||
"suffix-deleted"
|
||
(and original-p
|
||
ekp-gui-verify--live-post-crossing-state
|
||
(ekp-gui-verify--stable-live-state-matches-p
|
||
ekp-gui-verify--live-post-crossing-state))))
|
||
(point_move_back_preserved_projection
|
||
. ,(ekp-gui-verify--stage-check
|
||
"moved-back"
|
||
(and ekp-gui-verify--live-motion-generation
|
||
(= ekp-buffer--generation
|
||
ekp-gui-verify--live-motion-generation)
|
||
(= (length ekp-buffer--live-plan-cache)
|
||
ekp-gui-verify--live-motion-cache-size)
|
||
(ekp-gui-verify--stable-live-state-matches-p
|
||
ekp-gui-verify--live-motion-state))))
|
||
(point_move_forward_preserved_projection
|
||
. ,(ekp-gui-verify--stage-check
|
||
"moved-forward"
|
||
(and ekp-gui-verify--live-motion-generation
|
||
(= ekp-buffer--generation
|
||
ekp-gui-verify--live-motion-generation)
|
||
(= (length ekp-buffer--live-plan-cache)
|
||
ekp-gui-verify--live-motion-cache-size)
|
||
(ekp-gui-verify--stable-live-state-matches-p
|
||
ekp-gui-verify--live-motion-state))))
|
||
(yank_kept_current_row_natural
|
||
. ,(ekp-gui-verify--stage-check
|
||
"yanked"
|
||
(and ekp-buffer--live-edit
|
||
ekp-gui-verify--live-motion-state
|
||
(ekp-gui-verify--stable-live-state-matches-p
|
||
ekp-gui-verify--live-motion-state))))
|
||
(undo_preserved_committed_projection
|
||
. ,(ekp-gui-verify--stage-check
|
||
"undone"
|
||
(and original-p
|
||
ekp-buffer--live-edit
|
||
ekp-gui-verify--live-motion-state
|
||
(ekp-gui-verify--stable-live-state-matches-p
|
||
ekp-gui-verify--live-motion-state))))
|
||
(resize_reflowed
|
||
. ,(ekp-gui-verify--stage-check
|
||
"resized"
|
||
(< ekp-buffer--auto-width
|
||
ekp-gui-verify--live-original-width)))
|
||
(resize_restored
|
||
. ,(ekp-gui-verify--stage-check
|
||
"resize-restored"
|
||
(= ekp-buffer--auto-width
|
||
ekp-gui-verify--live-original-width)))
|
||
(completed_paragraph
|
||
. ,(if (or (not (equal ekp-gui-verify--live-stage "completed"))
|
||
(and (= (cl-count ?\n logical) 1)
|
||
(get-text-property (point-min) 'ekp-justified)
|
||
live-beg live-end
|
||
(= live-beg live-end (point-max))))
|
||
t :false))
|
||
(screen_lines . ,(count-screen-lines (point-min) (point-max)))
|
||
(overlays . ,(length (overlays-in (point-min) (point-max))))
|
||
(hscroll . ,(window-hscroll))
|
||
(active_paragraph . ,(if ekp-buffer--live-state t :false))
|
||
(authoritative_width . ,(or ekp-buffer--auto-width 0))
|
||
(active_line_natural
|
||
. ,(if (or (member ekp-gui-verify--live-stage
|
||
'("completed" "resized" "resize-restored"))
|
||
(ekp-gui-verify--active-line-natural-p))
|
||
t :false))
|
||
(generation . ,ekp-buffer--generation)
|
||
(pending_edit . ,(if ekp-buffer--live-edit t :false))
|
||
(live_cache_size . ,(length ekp-buffer--live-plan-cache))
|
||
(pixel_scan_pass
|
||
. ,(if (or (= (or active 0) 0)
|
||
(plist-get scan :pass))
|
||
t :false))
|
||
(pixel_overflow_lines . ,(plist-get scan :over)))))
|
||
|
||
(defun ekp-gui-verify-live-assertions ()
|
||
"Return adapter assertions for the live verification buffer."
|
||
(let* ((adapter (ekp-gui-verify-live-adapter))
|
||
(value (lambda (key) (cdr (assq key adapter)))))
|
||
`(((name . "logical-source-exact")
|
||
(passed . ,(funcall value 'expected_source)))
|
||
((name . "zero-overlays")
|
||
(passed . ,(if (= (funcall value 'overlays) 0) t :false)))
|
||
((name . "zero-horizontal-scroll")
|
||
(passed . ,(if (= (funcall value 'hscroll) 0) t :false)))
|
||
((name . "middle-edit-preserves-later-anchor")
|
||
(passed . ,(funcall value 'middle_anchor_preserved)))
|
||
((name . "middle-reversal-restores-exact-projection")
|
||
(passed . ,(funcall value 'middle_exact_restored)))
|
||
((name . "visual-row-crossing-commits-prefix")
|
||
(passed . ,(funcall value 'prefix_replanned)))
|
||
((name . "delete-keeps-last-committed-projection")
|
||
(passed . ,(funcall value
|
||
'delete_preserved_committed_projection)))
|
||
((name . "point-back-preserves-projection")
|
||
(passed . ,(funcall value
|
||
'point_move_back_preserved_projection)))
|
||
((name . "point-forward-preserves-projection")
|
||
(passed . ,(funcall value
|
||
'point_move_forward_preserved_projection)))
|
||
((name . "same-row-yank-keeps-projection")
|
||
(passed . ,(funcall value 'yank_kept_current_row_natural)))
|
||
((name . "real-undo-keeps-committed-projection")
|
||
(passed . ,(funcall value
|
||
'undo_preserved_committed_projection)))
|
||
((name . "window-resize-reflows-prefix")
|
||
(passed . ,(funcall value 'resize_reflowed)))
|
||
((name . "window-width-restore-reflows-prefix")
|
||
(passed . ,(funcall value 'resize_restored)))
|
||
((name . "hard-newline-completes-previous-paragraph")
|
||
(passed . ,(funcall value 'completed_paragraph)))
|
||
((name . "active-semantic-line-natural")
|
||
(passed . ,(funcall value 'active_line_natural)))
|
||
((name . "live-cache-bounded")
|
||
(passed . ,(if (<= (funcall value 'live_cache_size) 16) t :false)))
|
||
((name . "no-pixel-overflow")
|
||
(passed . ,(if (= (funcall value 'pixel_overflow_lines) 0)
|
||
t :false))))))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-delete-middle-space ()
|
||
"Delete one projected middle-row space through the public command path."
|
||
(interactive)
|
||
(goto-char (1+ (marker-position
|
||
ekp-gui-verify--live-middle-position)))
|
||
(call-interactively #'delete-backward-char)
|
||
(let ((offset (- (marker-position
|
||
ekp-gui-verify--live-middle-position)
|
||
(point-min))))
|
||
(setq ekp-gui-verify--live-expected
|
||
(concat (substring ekp-gui-verify--live-original 0 offset)
|
||
(substring ekp-gui-verify--live-original (1+ offset)))
|
||
ekp-gui-verify--live-stage "middle-dirty"))
|
||
(redisplay t)
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-restore-middle-space ()
|
||
"Reinsert the deleted middle-row space and restore the exact baseline."
|
||
(interactive)
|
||
(goto-char ekp-gui-verify--live-middle-position)
|
||
(let ((last-command-event ?\s))
|
||
(call-interactively #'self-insert-command))
|
||
(setq ekp-gui-verify--live-expected ekp-gui-verify--live-original
|
||
ekp-gui-verify--live-stage "middle-restored")
|
||
(goto-char (point-max))
|
||
(redisplay t)
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-type-suffix ()
|
||
"Type the deterministic suffix through the command loop."
|
||
(interactive)
|
||
(setq ekp-gui-verify--live-stage "typed")
|
||
(setq ekp-gui-verify--live-expected
|
||
(concat ekp-gui-verify--live-original
|
||
ekp-gui-verify--live-suffix))
|
||
(execute-kbd-macro ekp-gui-verify--live-suffix)
|
||
(redisplay t)
|
||
(setq ekp-gui-verify--live-post-crossing-state
|
||
(ekp-gui-verify--stable-live-state))
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-delete-suffix ()
|
||
"Delete the suffix while retaining the last committed projection."
|
||
(interactive)
|
||
(execute-kbd-macro
|
||
(vconcat
|
||
(make-list (length ekp-gui-verify--live-suffix) 'backspace)))
|
||
(setq ekp-gui-verify--live-expected
|
||
ekp-gui-verify--live-original
|
||
ekp-gui-verify--live-stage "suffix-deleted")
|
||
(redisplay t)
|
||
(setq ekp-gui-verify--live-motion-generation ekp-buffer--generation
|
||
ekp-gui-verify--live-motion-cache-size
|
||
(length ekp-buffer--live-plan-cache)
|
||
ekp-gui-verify--live-motion-state
|
||
(ekp-gui-verify--stable-live-state))
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-move-back ()
|
||
"Move point into the first semantic line through the command loop."
|
||
(interactive)
|
||
(execute-kbd-macro (kbd "M-<"))
|
||
(setq ekp-gui-verify--live-stage "moved-back")
|
||
(redisplay t)
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-move-forward ()
|
||
"Move point back to the final semantic line through the command loop."
|
||
(interactive)
|
||
(execute-kbd-macro (kbd "M->"))
|
||
(setq ekp-gui-verify--live-stage "moved-forward")
|
||
(redisplay t)
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-yank ()
|
||
"Yank a multi-script suffix through the public command path."
|
||
(interactive)
|
||
(undo-boundary)
|
||
(kill-new ekp-gui-verify--live-yank)
|
||
(execute-kbd-macro (kbd "C-y"))
|
||
(setq ekp-gui-verify--live-expected
|
||
(concat ekp-gui-verify--live-original
|
||
ekp-gui-verify--live-yank)
|
||
ekp-gui-verify--live-stage "yanked")
|
||
(redisplay t)
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-undo-yank ()
|
||
"Undo the verification yank through the public command path."
|
||
(interactive)
|
||
(execute-kbd-macro (kbd "C-/"))
|
||
(setq ekp-gui-verify--live-expected
|
||
ekp-gui-verify--live-original
|
||
ekp-gui-verify--live-stage "undone")
|
||
(redisplay t)
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
(defun ekp-gui-verify--live-change-margin (columns stage)
|
||
"Set the right margin to COLUMNS and record verification STAGE."
|
||
(set-window-margins (selected-window) 0 columns)
|
||
(run-hooks 'window-configuration-change-hook)
|
||
(sit-for (+ ekp-auto-justify-resize-delay 0.2))
|
||
(setq ekp-gui-verify--live-stage stage)
|
||
(redisplay t)
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-resize-narrower ()
|
||
"Narrow the live text area and wait for the real resize debounce."
|
||
(interactive)
|
||
(ekp-gui-verify--live-change-margin 24 "resized"))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-resize-restore ()
|
||
"Restore the live text area and wait for the real resize debounce."
|
||
(interactive)
|
||
(ekp-gui-verify--live-change-margin nil "resize-restored"))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-live-complete-paragraph ()
|
||
"Insert a hard newline and complete the previous paragraph."
|
||
(interactive)
|
||
(execute-kbd-macro "\n")
|
||
(setq ekp-gui-verify--live-expected
|
||
(concat ekp-gui-verify--live-original "\n")
|
||
ekp-gui-verify--live-stage "completed")
|
||
(redisplay t)
|
||
(ekp-gui-verify-live-adapter))
|
||
|
||
(defconst ekp-gui-verify--split-text
|
||
"soft wrap 中文 mixed editing stays natural across narrow side by side windows"
|
||
"Text typed by the split-window soft-wrap verification.")
|
||
|
||
(defvar-local ekp-gui-verify--split-expected "")
|
||
(defvar-local ekp-gui-verify--split-stage "setup")
|
||
(defvar-local ekp-gui-verify--split-original-wrap nil)
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-split-wrap-setup ()
|
||
"Create an intentional narrow split for native soft-wrap verification."
|
||
(interactive)
|
||
(unless (display-graphic-p)
|
||
(user-error "GUI verification needs a graphical frame"))
|
||
(set-frame-parameter (selected-frame) 'fullscreen 'fullboth)
|
||
(delete-other-windows)
|
||
(redisplay t)
|
||
(sit-for 0.2)
|
||
(let* ((target (get-buffer-create "*EKP Split Soft Wrap*"))
|
||
(control (get-buffer-create "*EKP Split Control*"))
|
||
(left (selected-window))
|
||
(right (split-window-right)))
|
||
(set-window-buffer left target)
|
||
(set-window-buffer right control)
|
||
(window-resize left (- 44 (window-total-width left)) t)
|
||
(select-window left)
|
||
(with-current-buffer control
|
||
(erase-buffer)
|
||
(insert "Intentional control window for partial-width verification."))
|
||
(with-current-buffer target
|
||
(when ekp-auto-justify-mode
|
||
(ekp-auto-justify-mode -1))
|
||
(erase-buffer)
|
||
(text-mode)
|
||
(kill-local-variable 'truncate-lines)
|
||
(kill-local-variable 'truncate-partial-width-windows)
|
||
(setq ekp-gui-verify--split-expected ""
|
||
ekp-gui-verify--split-stage "setup"
|
||
ekp-gui-verify--split-original-wrap
|
||
(list (local-variable-p 'truncate-lines)
|
||
truncate-lines
|
||
(local-variable-p 'truncate-partial-width-windows)
|
||
truncate-partial-width-windows))
|
||
(ekp-auto-justify-mode 1)
|
||
(goto-char (point-max)))
|
||
(redisplay t)
|
||
(ekp-gui-verify-split-wrap-adapter)))
|
||
|
||
(defun ekp-gui-verify--split-row-start ()
|
||
"Return point's native visual-row start in the selected window."
|
||
(save-excursion
|
||
(vertical-motion 0 (selected-window))
|
||
(point)))
|
||
|
||
(defun ekp-gui-verify--split-display-state-restored-p ()
|
||
"Return non-nil when split verification restored its display state."
|
||
(pcase-let ((`(,lines-local ,lines ,partial-local ,partial)
|
||
ekp-gui-verify--split-original-wrap))
|
||
(and (eq (local-variable-p 'truncate-lines) lines-local)
|
||
(equal truncate-lines lines)
|
||
(eq (local-variable-p 'truncate-partial-width-windows)
|
||
partial-local)
|
||
(equal truncate-partial-width-windows partial))))
|
||
|
||
(defun ekp-gui-verify-split-wrap-adapter ()
|
||
"Return JSON-compatible state for split-window soft-wrap verification."
|
||
(let* ((logical (substring-no-properties (buffer-string)))
|
||
(typed-p (equal ekp-gui-verify--split-stage "typed"))
|
||
(disabled-p (equal ekp-gui-verify--split-stage "disabled"))
|
||
(breaks (ekp-gui-verify--owned-break-positions)))
|
||
`((stage . ,ekp-gui-verify--split-stage)
|
||
(expected_source
|
||
. ,(if (equal logical ekp-gui-verify--split-expected) t :false))
|
||
(logical_sha256 . ,(secure-hash 'sha256 logical))
|
||
(window_count . ,(length (window-list nil 'no-minibuf)))
|
||
(target_columns . ,(window-total-width))
|
||
(auto_mode . ,(if ekp-auto-justify-mode t :false))
|
||
(truncate_lines . ,(if truncate-lines t :false))
|
||
(partial_truncation
|
||
. ,(if truncate-partial-width-windows t :false))
|
||
(wrap_bindings_local
|
||
. ,(if (and (local-variable-p 'truncate-lines)
|
||
(local-variable-p 'truncate-partial-width-windows))
|
||
t :false))
|
||
(screen_lines . ,(count-screen-lines (point-min) (point-max)))
|
||
(visual_row_advanced
|
||
. ,(if (or (not typed-p)
|
||
(> (ekp-gui-verify--split-row-start) (point-min)))
|
||
t :false))
|
||
(semantic_prefix_lines
|
||
. ,(if ekp-buffer--live-state
|
||
(length
|
||
(ekp-buffer--live-state-signatures
|
||
ekp-buffer--live-state))
|
||
0))
|
||
(active_line_natural
|
||
. ,(if (or (not typed-p)
|
||
disabled-p
|
||
(ekp-gui-verify--active-line-natural-p))
|
||
t :false))
|
||
(hscroll . ,(window-hscroll))
|
||
(live_owned_breaks . ,(length breaks))
|
||
(overlays . ,(length (overlays-in (point-min) (point-max))))
|
||
(pending_edit . ,(if ekp-buffer--live-edit t :false))
|
||
(display_state_restored
|
||
. ,(if (or (not disabled-p)
|
||
(ekp-gui-verify--split-display-state-restored-p))
|
||
t :false)))))
|
||
|
||
(defun ekp-gui-verify-split-wrap-assertions ()
|
||
"Return assertions for split-window soft-wrap verification."
|
||
(let* ((adapter (ekp-gui-verify-split-wrap-adapter))
|
||
(value (lambda (key) (cdr (assq key adapter))))
|
||
(disabled-p
|
||
(equal (funcall value 'stage) "disabled")))
|
||
`(((name . "logical-source-exact")
|
||
(passed . ,(funcall value 'expected_source)))
|
||
((name . "intentional-two-window-layout")
|
||
(passed . ,(if (= (funcall value 'window_count) 2) t :false)))
|
||
((name . "target-window-below-default-truncation-threshold")
|
||
(passed . ,(if (< (funcall value 'target_columns) 50) t :false)))
|
||
((name . "auto-mode-owns-soft-wrap")
|
||
(passed . ,(if (or disabled-p
|
||
(and (funcall value 'auto_mode)
|
||
(eq (funcall value 'truncate_lines) :false)
|
||
(eq (funcall value 'partial_truncation) :false)
|
||
(funcall value 'wrap_bindings_local)))
|
||
t :false)))
|
||
((name . "typing-crosses-visual-boundary")
|
||
(passed . ,(funcall value 'visual_row_advanced)))
|
||
((name . "no-horizontal-scroll")
|
||
(passed . ,(if (or disabled-p
|
||
(= (funcall value 'hscroll) 0))
|
||
t :false)))
|
||
((name . "semantic-prefix-publishes-complete-lines")
|
||
(passed . ,(if (or (not (equal (funcall value 'stage) "typed"))
|
||
(and (> (funcall value 'semantic_prefix_lines) 0)
|
||
(> (funcall value 'live_owned_breaks) 0)))
|
||
t :false)))
|
||
((name . "active-semantic-line-natural")
|
||
(passed . ,(funcall value 'active_line_natural)))
|
||
((name . "zero-overlays")
|
||
(passed . ,(if (= (funcall value 'overlays) 0) t :false)))
|
||
((name . "no-pending-live-transaction")
|
||
(passed . ,(if (eq (funcall value 'pending_edit) :false)
|
||
t :false)))
|
||
((name . "mode-disable-restores-display-state")
|
||
(passed . ,(funcall value 'display_state_restored))))))
|
||
|
||
(defun ekp-gui-verify-split-generic-assertions
|
||
(window buffer start end)
|
||
"Return generic capture assertions for an intentional split layout."
|
||
(list
|
||
`((name . "selected-target-window-live")
|
||
(passed . ,(if (and (window-live-p window)
|
||
(eq (window-buffer window) buffer))
|
||
t :false)))
|
||
`((name . "intentional-two-window-capture")
|
||
(passed . ,(if (= (length (window-list nil 'no-minibuf)) 2)
|
||
t :false)))
|
||
`((name . "visible-range-valid")
|
||
(passed . ,(if (and (integer-or-marker-p start)
|
||
(integer-or-marker-p end)
|
||
(<= start end)
|
||
(<= end (with-current-buffer buffer (point-max))))
|
||
t :false)))))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-split-wrap-type ()
|
||
"Type across the native wrap boundary in the narrow target window."
|
||
(interactive)
|
||
(mapc
|
||
(lambda (character)
|
||
(let ((last-command-event character))
|
||
(call-interactively #'self-insert-command))
|
||
(redisplay t)
|
||
(sit-for 0.02))
|
||
(string-to-list ekp-gui-verify--split-text))
|
||
(setq ekp-gui-verify--split-expected ekp-gui-verify--split-text
|
||
ekp-gui-verify--split-stage "typed")
|
||
(redisplay t)
|
||
(ekp-gui-verify-split-wrap-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-split-wrap-disable ()
|
||
"Disable auto mode and expose restored truncation ownership."
|
||
(interactive)
|
||
(ekp-auto-justify-mode -1)
|
||
(setq ekp-gui-verify--split-stage "disabled")
|
||
(redisplay t)
|
||
(ekp-gui-verify-split-wrap-adapter))
|
||
|
||
;;;###autoload
|
||
(defun ekp-gui-verify-matrix ()
|
||
"Run the display-context matrix and print a PASS/FAIL table.
|
||
Covers: plain, text-scale up/down, family+height face remap, and a
|
||
narrow frame with scaling. Intended for `emacs -Q'; in a customized
|
||
session prefer `ekp-gui-verify'."
|
||
(interactive)
|
||
(unless (display-graphic-p)
|
||
(user-error "GUI verification needs a graphical frame"))
|
||
(save-current-buffer
|
||
(ekp-gui-verify--matrix-1)))
|
||
|
||
(defun ekp-gui-verify--matrix-1 ()
|
||
"Run the matrix cases; caller guards the current buffer."
|
||
(let (results)
|
||
(set-frame-size (selected-frame) 190 40)
|
||
(push (ekp-gui-verify--case "base" #'ignore) results)
|
||
(push (ekp-gui-verify--case "text-scale +3"
|
||
(lambda () (text-scale-set 3)))
|
||
results)
|
||
(push (ekp-gui-verify--case "text-scale -2"
|
||
(lambda () (text-scale-set -2)))
|
||
results)
|
||
(push (ekp-gui-verify--case "remap family+height"
|
||
(lambda ()
|
||
(face-remap-add-relative
|
||
'default :height 1.15)))
|
||
results)
|
||
(push (ekp-gui-verify--case "no fringes"
|
||
(lambda ()
|
||
(set-window-fringes
|
||
(get-buffer-window (current-buffer))
|
||
0 0)))
|
||
results)
|
||
(push (ekp-gui-verify--case "no fringes + scale +2"
|
||
(lambda ()
|
||
(set-window-fringes
|
||
(get-buffer-window (current-buffer))
|
||
0 0)
|
||
(text-scale-set 2)))
|
||
results)
|
||
(set-frame-size (selected-frame) 70 40)
|
||
(push (ekp-gui-verify--case "narrow + scale +2"
|
||
(lambda () (text-scale-set 2)))
|
||
results)
|
||
(ekp-gui-verify--report (nreverse results))))
|
||
|
||
(provide 'ekp-gui-verify)
|
||
|
||
;;; ekp-gui-verify.el ends here
|