diff --git a/.phrase/docs/CHANGE.md b/.phrase/docs/CHANGE.md index c2dbdbb..0328cc2 100644 --- a/.phrase/docs/CHANGE.md +++ b/.phrase/docs/CHANGE.md @@ -2,6 +2,10 @@ ## phase-kp-overhaul-20260726 +- 2026-08-02 complete fixed final-pass emergency stretch and TeX-style + active-path preservation (`task036`; `issue021` closed after user visual + confirmation): + `.phrase/phases/phase-kp-overhaul-20260726/change_final_pass_emergency_stretch_20260802.md` - 2026-07-28 repository system audit: `.phrase/phases/phase-kp-overhaul-20260726/change_repository_audit_20260728.md` - 2026-07-28 complete DP cache signature (`task002`): @@ -82,6 +86,18 @@ projection reuse (`task030` implementation verified; locked source-instrumented 16 ms gate and `issue018` remain open): `.phrase/phases/phase-kp-overhaul-20260726/change_narrow_live_append_latency_20260730.md` +- 2026-08-01 implement and developer-verify the rigid-inline-atom + emergency-break correction (`task033` complete; `issue021` awaits user + confirmation): + `.phrase/phases/phase-kp-overhaul-20260726/change_overlong_no_break_atom_20260801.md` +- 2026-08-01 implement configurable break policies, record G002-G008 + implementation/GUI/performance/repository/cleanup/review-blocker evidence, + and close developer work for `task034` (`issue021` still awaits user visual + confirmation; final independent code review APPROVE and architecture CLEAR): + `.phrase/phases/phase-kp-overhaul-20260726/change_configurable_break_policies_20260801.md` +- 2026-08-02 record the failed line-width emergency-stretch attempt + (`task035` closed as falsified; superseded by completed `task036` above): + `.phrase/phases/phase-kp-overhaul-20260726/change_final_pass_emergency_stretch_20260802.md` ## phase-doc-improvement-20260125 - See `.phrase/phases/phase-doc-improvement-20260125/change_log.md` diff --git a/.phrase/docs/ISSUES.md b/.phrase/docs/ISSUES.md index bef4c79..b8dba88 100644 --- a/.phrase/docs/ISSUES.md +++ b/.phrase/docs/ISSUES.md @@ -20,3 +20,4 @@ - issue018 [ ] [Unique live appends miss the frame budget at very narrow widths.](../phases/phase-kp-overhaul-20260726/issue_narrow_live_append_latency_20260729.md) - issue019 [ ] [Per-edit frontier replanning destabilizes live projection and cannot restore reversible edits exactly.](../phases/phase-kp-overhaul-20260726/issue_stable_live_edit_transaction_20260729.md) - issue020 [ ] [C-backed resize reflow still takes roughly 60–70 ms.](../phases/phase-kp-overhaul-20260726/issue_c_resize_latency_20260729.md) +- issue021 [x] [Final-pass emergency layout can isolate CJK source lines at narrow widths.](../phases/phase-kp-overhaul-20260726/issue_overlong_no_break_atom_20260801.md) diff --git a/.phrase/phases/phase-kp-overhaul-20260726/change_configurable_break_policies_20260801.md b/.phrase/phases/phase-kp-overhaul-20260726/change_configurable_break_policies_20260801.md new file mode 100644 index 0000000..20e2bfe --- /dev/null +++ b/.phrase/phases/phase-kp-overhaul-20260726/change_configurable_break_policies_20260801.md @@ -0,0 +1,175 @@ +# Change: Configurable Break Policies 2026-08-01 + +Superseded note: the historical hard-atom adjacency rule recorded below was +removed by `task036`. Explicit atoms forbid only interior breaks; current +final-pass reachability semantics are recorded in +`change_final_pass_emergency_stretch_20260802.md`. + +## 2026-08-01 — Plan task034 and record the red baseline + +- **Add** `task034` for configurable break policies and the remaining + orphan-glyph quality failure in the 280px showcase paragraph. +- **Modify** the text-property layout spec to make inline code wrapping, + token policies, kinsoku profiles, overlong-token behavior, buffer measure, + and region break-policy precedence explicit. +- **Modify** the text-property layout plan with M13, preserving the approved + architecture: resolve policy intervals before tokenization, compile to the + existing hyphen/break vectors before DP, and keep the C boundary at 15 + arguments and 15 batch fields. +- **Red baseline:** the latest screenshot shows the previous atom cascade is + gone, but the crafted inline-code paragraph still permits pathological + single-CJK source lines around the atom, including `行`, `内`, and `永`. + The implementation oracle must reject any such single-CJK source line when + a legal non-emergency alternative exists. +- **Verification contract:** focused RED/GREEN ERT for core, buffer, command, + cache, and diagnostics; C/Elisp parity; 300-case property fuzz; + warning-as-error Elisp compilation; C builds/tests; checkdoc/package/static + release gates; and reviewed fullscreen GUI evidence for inline wrapping, + no orphan glyph, explicit no-break, block verbatim, measure modes, and + overlong-token modes. +- **Behavior/Risk:** Planning records only. Runtime behavior is unchanged. + This entry opened `task034`; later entries record its implementation and + closure. + +## 2026-08-01 — Record task034 implementation and G004 GUI evidence + +- **Modify** `task034`, M13, and the text-property layout spec with verified + implementation facts from G002/G003/G004. At this point `task034` was still + open pending later gates; G006 closure is recorded below. +- **Implementation evidence recorded:** core policy compilation preserves the + existing C boundary; buffer policy ownership separates block skip faces from + inline faces; public local/profile/region controls and diagnostics exist; + showcase verification distinguishes automatic inline code from explicit + `ekp-no-break` and verbatim block code. +- **GUI evidence recorded:** G004 passed GUI verifier ERT 7/7 and the clean + single-window evidence run at `/tmp/ekp-g004-evidence.Tp77dW` reports 12/12 + checkpoints with no failed assertions, 25.75s/206-frame recording, no black + segments, automatic inline wrapping 3→2→3 lines across 280→340→280, every + internal inline split as source whitespace, exact source, zero overlays, C + active, and a settled no-hyphen→normal policy transition with stale + nil-plan spans at zero. +- **Verification status:** G005 repository-wide gates and G006 cleanup are + recorded below. +- **Behavior/Risk:** Documentation synchronization only in this entry. Do not + close `task034` or any user-confirmation issue from this G004-only evidence + at this point in the sequence. + +## 2026-08-01 — Record G005 final performance and repository gate evidence + +- **Modify** `task034` and the policy-boundary postmortem with the confirmed + G005 root causes and final gate evidence. At this point `task034` was still + open pending G006 cleanup; G006 closure is recorded below. +- **Root causes recorded:** paragraph identity included unconditional policy + measure, causing paragraph rebuilds; volatile property clearing fragmented + equal property runs; policy analysis ran before paragraph-cache hits; and + repeated same-paragraph/same-width requests duplicated semantic plan + assembly. +- **Fix evidence recorded:** policy measure was removed from the semantic + signature; adjacent equal filtered intervals are canonicalized; policy full + analysis now uses a bounded two-tier cache keyed by clean source, canonical + layout and raw face policy intervals, policy signature, and width context, + with a measure tier only for actual width-sensitive no-break/overflow + candidates; and semantic plans use a bounded per-paragraph plan cache. G007 + later strengthened the consumer boundary from shallow copies to + consumer-owned copies of plan-owned mutable payloads; see the G008 entry + below. +- **Performance evidence recorded:** formal four-interleaved evaluator reports + layout parity true. Core baseline p50/p95 was 38.6679/51.6782ms and + candidate p50/p95 was 21.7102/33.0040ms, for 43.8549%/36.1354% gains. + Resize baseline p50/p95 was 43.3831/55.6250ms and candidate p50/p95 was + 22.0919/32.8202ms, for 49.0773%/40.9973% gains. Both candidate p95 values + are under 50ms and both gain sets exceed 20%. +- **Live evaluator recorded:** the source-instrumented locked goal remains the + known `validation_failed` debt; parity, zero-work, GC, conflict, and + all-width-nonregression checks are true. Current C p95/p99 is + 26.449/26.740ms, a 76.65%/77.23% improvement. Current Elisp p95/p99 is + 49.940/52.017ms, a 91.64%/91.35% improvement. This is consistent with + historical open `issue018` and is not a regression. +- **Production public-path evidence recorded:** three byte-compiled runs + passed with zero GC. C append p99 was 1.361-1.368ms and hard p99 was + 1.876-1.891ms. Elisp append p99 was 1.692-1.775ms and hard p99 was + 2.100-2.230ms. +- **Verification recorded:** default ERT passed 262/262; seeded permuted ERT + seed 20260728 passed 255/255; isolated per-test process suite exited 0; + the subsequently added alias guard passed targeted verification; property + fuzz passed 300/300; warning-as-error byte compilation passed; pinned + package-lint at `35996f478d81e51dae4fa30d051f741895d07399` exited 0 with + only an external obsolete warning from the local names dependency; checkdoc + was empty; release, 49-entry dictionary manifest, pinned dictionary update, + shell syntax, CI YAML, and diff-check passed; portable, native, debug, and + sanitize C builds were warning-clean; module 1.6/4-thread smoke passed; and + focused C verification passed 19/19 including the 15-argument/15-field + boundary. +- **Verification status:** G005 gates are complete. G006 cleanup is recorded + below. + +## 2026-08-01 — Close task034 with G006 cleanup evidence + +- **Modify** `task034`, M13, the global change index, and the policy-boundary + postmortem with G006 cleanup evidence. +- **Cleanup evidence recorded:** G006 edited only `ekp.el` and + `ekp-buffer.el`, removing redundant policy/cache code without changing the + locked behavior. +- **Verification recorded:** targeted cleanup suites passed 6/6 and 3/3; full + core ERT passed 125/125; full buffer ERT passed 120/120; warning-as-error + byte compilation passed; diff-check passed; and the C build gate passed. +- **Behavior/Risk:** `task034` is closed for developer implementation, + repository gates, performance gates, and cleanup gates. `issue021` remains + open pending user visual confirmation. Independent final code/architecture + review has not yet been claimed. + +## 2026-08-01 — Resolve G006/G007 review blockers with G008 ownership fixes + +- **Modify** `task034`, M13, developer documentation, changelog, and + postmortems with the G007/G008 ownership and backend-contract corrections. +- **Review blockers resolved:** G006 cleanup's independent review found that + shallow semantic-plan copies left nested line/gap/glue payloads mutable + through cache hits, and that malformed non-nil C results could still be + treated too softly. G007 changed the semantic-plan cache boundary to return + consumer-owned copies of every plan-owned mutable payload: source string, + context, boxes, offsets, lines, glues, gaps, and signatures. `para` remains + intentionally shared because paragraph-cache ownership and append identity + rely on that object. G007 final review then found one remaining alias: + `copy-tree` did not copy strings inside the returned context, so mutating a + dynamic policy suffix from the returned plan could poison the cached context. + G008 resolves that final blocker by using the recursive context copier for + cons/vector/string payloads both when the context snapshot/cache key is + created and when a plan is returned. +- **Backend contract recorded:** only a nil whole C result or nil per-item + breaks may fall back to Elisp. Any malformed non-nil single or batch output + signals `ekp-backend-contract-error`. The C entry remains 15 arguments and + the batch payload remains 15 fields. +- **Hard-atom boundary recorded:** the ordinary boundary immediately before a + following explicit `ekp-no-break` atom is forbidden before DP. This direct + pre-DP adjacency rule is separate from the final-pass emergency-stretch + model and is locked by a focused regression. +- **Verification recorded:** formal resize parity is true; core baseline + p50/p95 is 36.595/48.357ms and candidate p50/p95 is 23.266/36.363ms, for + 36.42%/24.80% gains. Resize baseline p50/p95 is 41.443/53.541ms and + candidate p50/p95 is 23.761/36.889ms, for 42.67%/31.10% gains. ERT passes + 268/268; property fuzz passes 300/300; release gates pass; byte-compiled + current public path records zero GC with C append/hard p99 + 1.440-1.464/2.022-2.050ms and Elisp append/hard p99 + 1.648-1.687/2.136-2.335ms, all below 16ms. +- **Behavior/Risk:** G007 resolved the first recorded G006 review blockers, + and G008 resolves the final string-leaf context blocker, but this change + record does not claim final independent APPROVE/CLEAR. `issue021` remains + open pending user visual confirmation, and historical `issue018` remains + open. + +## 2026-08-02 — Record final independent review clearance + +- **Review remediation:** the first final code-review pass found warning-only + defects in changed test fixtures and a stale C README setter example. The + fixtures now byte-compile with warnings as errors, and the README documents + the optional eighth `EMERGENCY-STRETCH` argument. +- **Verification:** the remediation-focused ERT passes 5/5, full ERT passes + 288/288, every changed test file compiles warning-clean, and diff-check + passes. +- **Independent verdicts:** the code-reviewer re-review returns `APPROVE` with + zero findings; the subsequent architect review returns `CLEAR` and confirms + core K-P ownership, content-independent final-pass reachability, Elisp/C + parity, stable ABI, cache ownership, and complete nonempty GUI oracles. +- **Behavior/Risk:** `task034` and its independent developer gate are + complete. `issue021` closed after the user's 2026-08-02 visual + confirmation, and historical `issue018` remains open. diff --git a/.phrase/phases/phase-kp-overhaul-20260726/change_final_pass_emergency_stretch_20260802.md b/.phrase/phases/phase-kp-overhaul-20260726/change_final_pass_emergency_stretch_20260802.md new file mode 100644 index 0000000..15f4285 --- /dev/null +++ b/.phrase/phases/phase-kp-overhaul-20260726/change_final_pass_emergency_stretch_20260802.md @@ -0,0 +1,91 @@ +# Change: Final-Pass Emergency Stretch 2026-08-02 + +## 2026-08-02 — Close issue021 after user visual confirmation + +- **Modify** the global issue index and issue detail to close `issue021`. +- **User confirmation:** the user accepted the visible result with “可以了， + 提交吧” and requested the commit. +- **Behavior/Risk:** no runtime change; this closes the required user-visible + acceptance gate after the developer, dynamic GUI, and independent review + gates had already passed. + +## 2026-08-02 — Complete task036 with TeX active-path preservation + +- **Modify** `ekp.el` and `ekp_c/ekp_kp.c`: keep strict K-P unchanged; use + fixed `ekp-emergency-stretch-pixel` for ordinary final-pass underfull + candidates; and, only when an overfull candidate would otherwise extinguish + the final active path to a breakpoint, install the best provisional path + with tight fitness and zero incremental demerits. +- **Delete** the wrong-layer rule that forbade an otherwise legal boundary + immediately before an explicit hard atom. Hard atoms forbid only their + interior breaks; an overwide atom remains intact but need not stand alone. +- **Modify** the renderer to distribute the chosen line's actual rest using + its actual TeX glue-set proportions. Elisp 1D, looseness/parshape, and C + behavior match; the public 15-field/15-argument C contract is unchanged. +- **Strengthen tests** so isolated-CJK oracles require a nonempty plan that + exactly covers the source, preventing an empty result from false-greening. +- **Review remediation:** make the changed test fixtures warning-clean under + `byte-compile-error-on-warn` and document the optional eighth + `EMERGENCY-STRETCH` argument in the C README API example. +- **Verification:** focused root regressions 8/8, emergency selector 10/10, + core/buffer/GUI oracle 8/8, full ERT 288/288, seeded and isolated suites + 279/279, fuzz 300/300, warning-clean portable/native/debug/sanitize C + builds, warning-as-error production and changed-test Elisp compilation, + checkdoc/package/static/release gates, formal performance gates, and + reviewed 42.78-second dynamic GUI evidence at + `/tmp/ekp-g009-evidence-retry.UOpPNp` with `VERDICT=PASS`. Final independent + code review returns `APPROVE` and architecture review returns `CLEAR`. +- **Behavior/Risk:** no CJK-orphan, unit, atom-adjacency, or screenshot + heuristic exists. `task036` is complete; `issue021` closed after the + user's 2026-08-02 visual confirmation. + +The entries below are historical steps. Their hard/atomic fixed-cost wording +was superseded by the completed task036 semantics above. + +## 2026-08-02 — Open task036 after task035 full-regression failure + +- **Modify** `task035` to record the line-width-sized emergency stretch as a + falsified attempt, not accepted current behavior. +- **Add** `task036` for TeX-style fixed-dimension final-pass emergency + stretch. The implementation must expose `ekp-emergency-stretch-pixel` + where nil auto-resolves to roughly three display-font `M` widths and a + non-negative integer fixes the pixel value. +- **Preserve** the constraints: strict pass unchanged, 15-field C paragraph + ABI unchanged, renderer semantics synchronized, fixed artificial emergency + transition only for truly overfull first permitted hard/atomic runs, and no + CJK-orphan/unit/screenshot-specific penalty. +- **Verification planned:** five new RED cases for fixed dimension behavior, + nil auto, integer override, C parity without ABI growth, and renderer + width/glue consistency; the three regressions broken by task035; focused + G009 GUI/core/public-buffer/C parity; final fullscreen dynamic GUI evidence; + full ERT/fuzz/build/static/release gates. +- **Behavior/Risk:** Documentation records the next atom of work only. + Runtime behavior is not claimed fixed by this entry. + +## 2026-08-02 — Close task035 as falsified + +- **Modify** core K-P documentation to state the attempted final-pass model: + strict pass unchanged; final pass gives ordinary underfull candidates a + line-width-sized finite background emergency stretch; those candidates + still use adjustment ratio, badness, fitness, and demerits. +- **Modify** user-facing hard-atom documentation to avoid claiming a + hard-coded fullest-prefix fallback. A hard atom may occupy one overflow + line, while the ordinary prefix remains a normal K-P decision with finite + emergency stretch. +- **Modify** `issue021`, `task035`, the spec, plan, changelog, developer + docs, C README, and global change/issue indexes to record the corrected + owner and current acceptance boundary. +- **Add** `postmortem/20260802-final-pass-emergency-stretch.md` to explain + why the ordinary-underfull fixed fallback was the wrong layer, why the + TeX-style emergency-stretch model is used, and why the earlier 84px oracle + was invalid. +- **Verification:** Focused core single-CJK regressions pass 2/2. The + implementation lane reports focused G009 core/C/hard-atom/buffer/GUI-oracle + coverage 18/18, warning-as-error byte compilation pass, and C build pass. + Full regression then falsified the line-width stretch detail and forced the + `task036` fixed-dimension follow-up. This documentation pass ran stale-text + search and `git diff --check`. +- **Behavior/Risk:** `task035` is not current truth. No public configuration, + C ABI, or renderer ownership change is accepted by this record. `issue021` + remains open until task036 and the final user-visible visual acceptance gate + pass. diff --git a/.phrase/phases/phase-kp-overhaul-20260726/change_overlong_no_break_atom_20260801.md b/.phrase/phases/phase-kp-overhaul-20260726/change_overlong_no_break_atom_20260801.md new file mode 100644 index 0000000..924451f --- /dev/null +++ b/.phrase/phases/phase-kp-overhaul-20260726/change_overlong_no_break_atom_20260801.md @@ -0,0 +1,44 @@ +# Change: Rigid Inline Atom Break Cascade 2026-08-01 + +Superseded note: this file records the earlier task033 repair. The current +ordinary-underfull final-pass model is recorded in +`change_final_pass_emergency_stretch_20260802.md`; an overwide atom remains +intact but is not guaranteed a standalone line, and atom adjacency has no +special break rule. + +## 2026-08-01 — Implement and developer-verify task033 + +- **Modify** `ekp.el` so the emergency pass preserves its established first + transition but adds a fullest-underfull prefix fallback only when a + forbidden break run jumps directly to an overfull permitted candidate. +- **Modify** `ekp_c/ekp_kp.c` with the same state transition and keep the + looseness/parshape Elisp path in parity. +- **Add** core, public-buffer, and GUI regressions covering diverse CJK + prefixes, exact source boundaries, atom integrity, Elisp/C parity, and + repeated 480→280→340→280 reflow. +- **Modify** user/developer documentation and add + `postmortem/20260801-forbidden-run-emergency-boundary.md` to record why the + broader fullest-prefix replacement was rejected. +- **Verification:** RED reproduced boundary 1 instead of 11. GREEN passes + normal, random-order, and isolated 201-test runs; 300 C/Elisp fuzz cases; + warning-as-error Elisp compilation; package-lint; checkdoc; release and + dictionary gates; warning-clean debug/sanitize/portable C builds; and + reviewed dynamic GUI evidence at + `/private/tmp/ekp-atom-gui-final-Beg8hb` with verdict PASS. +- **Behavior/Risk:** Strict K-P, ordinary emergency layouts, buffer + projection, source text, and public APIs are unchanged. The additional + relaxation is limited to emergency scans that cross forbidden break + positions before an overfull candidate. + +## 2026-08-01 — Plan issue021 and task033 + +- **Add** `issue021` with the 280px showcase reproduction and deterministic + width-40 batch analogue. +- **Add** `task033` and M12 acceptance gates for the core emergency-break + correction, Elisp/C parity, and real GUI verification. +- **Modify** the text-property layout spec to require a full ordinary prefix + line and one intact rigid atom line rather than one-glyph emergency + fragmentation. +- **Behavior/Risk:** Planning records only. Runtime behavior is unchanged. + The change will affect only the second pass used after strict K-P has + already proved the paragraph unreachable. diff --git a/.phrase/phases/phase-kp-overhaul-20260726/issue_overlong_no_break_atom_20260801.md b/.phrase/phases/phase-kp-overhaul-20260726/issue_overlong_no_break_atom_20260801.md new file mode 100644 index 0000000..f0dd4ad --- /dev/null +++ b/.phrase/phases/phase-kp-overhaul-20260726/issue_overlong_no_break_atom_20260801.md @@ -0,0 +1,69 @@ +# Issue: Final-Pass CJK Isolation 2026-08-01 + +## issue021 [x] Final-pass emergency layout can isolate CJK source lines at narrow widths + +- **Status:** Resolved. Developer verification and independent review passed; + the user accepted the visible result and requested the commit. +- **Summary:** At narrow measures, the final K-P pass can choose one-glyph CJK + source lines in the mixed showcase paragraph. The visible symptom was first + found around an explicit hard atom, then reproduced after automatic inline + policy was split from hard atoms. +- **Environment:** Graphical Emacs 30.2 on macOS, narrow showcase widths, + justify alignment, C module active for 1D layout. The same core problem is + visible through the public buffer path, so this is not a renderer-only + issue. +- **Repro:** Run `M-x ekp-showcase`, set a narrow width such as 168px or + 280px, and inspect the mixed Chinese/Latin inline paragraph. The failure + appears when a CJK glyph becomes a complete source line even though the + paragraph has legal non-emergency alternatives. +- **Expected vs Actual:** Ordinary underfull candidates in the final pass + should remain normal K-P candidates: adjustment ratio, badness, fitness, + and demerits decide the global path. Separately, the final pass must not + lose all reachability when a legal candidate is overfull. The previous + model confused that reachability safeguard with a hard/atomic fixed-cost + scoring shortcut, and an empty-plan oracle could hide the failure. +- **Investigation:** The strict pass is not the bug. The buffer projector + reproduces the semantic plan exactly and owns no line-choice compensation. + The root is in core DP final-pass modeling: ordinary underfull candidates + must receive finite emergency stretch and stay inside normal K-P scoring. + TeX's `artificial_demerits` instead preserves the last active path in the + final pass independent of content class; it is not owned by CJK, units, + hard atoms, or their adjacency. +- **Required Outcome:** Eliminate unintended isolated CJK source lines at the + checked narrow showcase widths without adding CJK-orphan, number-unit, or + screenshot-specific penalties. Preserve source text, zero overlays, + strict-pass behavior, Elisp/C parity, and the public C ABI. +- **Fix Plan:** Keep strict K-P unchanged. In the final pass, add a + TeX-style fixed emergency-stretch dimension to ordinary underfull + candidates and score them through normal badness, fitness, and demerits. + Expose the dimension as `ekp-emergency-stretch-pixel`: nil auto-resolves to + roughly three display-font `M` widths, while a non-negative integer fixes + the pixel value. If an overfull candidate would otherwise remove the final + active path to a breakpoint and no non-overfull candidate survives there, + install the best provisional path with tight fitness and zero incremental + demerits. The Elisp 1D path, looseness/parshape path, renderer semantics, + and C engine share this rule without changing the 15-field C paragraph ABI. +- **Verification:** + - Focused core single-CJK regressions pass 2/2. + - The implementation lane's focused G009 suite covering core, C parity, + hard atoms, public buffer projection, and GUI oracle passes 18/18. + - Warning-as-error Elisp byte compilation and the C build pass. + - Full regression falsified task035's line-width-sized emergency stretch: + the stretch must be a fixed dimension, not derived from each candidate + measure. + - Task036's fixed-dimension RED cases pass and the three regressions broken + by task035 remain green. Direct regression proves artificial lines add + zero demerits and preserve a complete nonempty source-covering plan. + - Focused root regressions pass 8/8, emergency selection passes 10/10, + core/buffer/GUI oracle passes 8/8, full ERT passes 288/288, seeded and + isolated suites pass 279/279, fuzz passes 300/300, and all build/static/ + release/performance gates pass. + - Reviewed 42.78-second fullscreen single-window evidence at + `/tmp/ekp-g009-evidence-retry.UOpPNp` covers 480→168→280→168 and + no-hyphen→normal policy change, reports no isolated CJK source lines, + exact source, zero overlays/stale spans, active C, and `VERDICT=PASS`. +- **User Confirmation:** On 2026-08-02, the user replied “可以了，提交吧”, + accepting the visible result and requesting submission. +- **Resolved At:** 2026-08-02. +- **Resolved By:** `task036`; final-pass active-path preservation in core K-P. +- **Commit:** This commit (`fix: restore TeX final-pass reachability`). diff --git a/.phrase/phases/phase-kp-overhaul-20260726/plan_text_property_layout_engine_20260729.md b/.phrase/phases/phase-kp-overhaul-20260726/plan_text_property_layout_engine_20260729.md index f18810c..83d9222 100644 --- a/.phrase/phases/phase-kp-overhaul-20260726/plan_text_property_layout_engine_20260729.md +++ b/.phrase/phases/phase-kp-overhaul-20260726/plan_text_property_layout_engine_20260729.md @@ -38,6 +38,12 @@ hyphens. No buffer path may use overlays. character-modified tick, point, mark, or external modification hooks. - Turning the mode off removes only EKP-owned projection properties and restores every pre-existing property exactly. +- Final-pass emergency layout remains owned by core K-P. Ordinary underfull + candidates use finite emergency stretch and normal badness/demerits; the + final active path is preserved with TeX-style zero-increment artificial + demerits only when an overfull candidate would otherwise extinguish it. + The buffer renderer and policy compiler must not add CJK-orphan, unit, + hard-atom-adjacency, or screenshot-specific compensation. ## Architecture @@ -260,6 +266,128 @@ rows are not the durable planning unit. complete resize improved by 43.51%/41.03% to 15.900/27.487 ms. Exact frozen-C/Elisp parity and all automated, static, and GUI gates pass. +### M12 — Rigid inline atom emergency breaking + +- Status: `task033` implemented and developer-verified as the earlier + rigid-atom repair. `task036` supersedes its ordinary-underfull emergency + model; `issue021` was closed after user-visible confirmation. +- Reproduce the showcase's narrow CJK prefix plus `ekp-no-break` atom through + the public string and semantic-plan paths before changing the algorithm. +- Historical task033 design: keep the strict K-P pass and the established + first-candidate emergency transition unchanged, then add a narrow + forbidden-run prefix fallback. The current task036 model replaces that + fallback with fixed final-pass emergency stretch plus content-independent + active-path preservation. +- Preserve atom integrity, source text, Elisp/C parity, looseness/parshape + semantics, append correctness, and the buffer projection contract. +- Gate: focused RED/GREEN core and buffer regressions, complete ERT in normal + and random order, isolated tests, C/Elisp fuzz, warning-as-error builds, + static/release checks, and clean static plus dynamic 280px GUI evidence. +- Result: the failing boundary moved from 1 to the full prefix boundary 11 in + Elisp, C, and public buffer paths. Normal/random/isolated ERT pass 201/201, + fuzz passes 300/300, static and build gates pass, and reviewed + 480→280→340→280 GUI evidence returns PASS. + +### M13 — Configurable break policies and orphan-glyph closure + +- Status: `task034` implementation, focused automated evidence, and G004 GUI + evidence are recorded. G005 repository-wide gates and G006 cleanup are + complete. `task034` is closed for developer work, `issue021` is closed + after user visual confirmation, and independent final code review returned + APPROVE with architecture status CLEAR. +- Implement the locked A2/B2/C2/D1/E1/F1/G2/H1/I1/J1/K1/M1 contract: + inline code defaults to no-hyphen rather than no-break, known inline faces + are recognized through mode profiles, region policy outranks explicit + local values which outrank mode profiles and globals, block faces remain + verbatim, explicit no-break never downgrades, automatic no-break downgrades + to no-hyphen when overwide, inline and block faces use separate paths, + manual properties stay session-only, hyphenation defaults to auto, + URL/path/identifier default to no-hyphen, compact number-unit defaults to + no-break, kinsoku defaults to common, overlong tokens default to emergency, + and buffer measure defaults to the narrowest live window. +- Keep the chosen architecture: resolve private structural policy intervals + before tokenization, compile them into existing hyphen positions and + forbidden-break vectors before DP, preserve the original source in the + semantic plan, and keep the C boundary at the current 15 arguments and + 15-field batch payload unless architecture review is reopened. +- Split block and inline ownership in `ekp-buffer`: `ekp-buffer-skip-faces` + remains paragraph-level verbatim, `ekp-buffer-inline-faces` annotates only + exact inline intervals, and `ekp-buffer-mode-policy-alist` is consulted + without auto-copying profile values into buffer locals. +- Add public region controls for `ekp-break-policy`: normal, enable + hyphenation, disable hyphenation, and clear. Existing no-break/verbatim + commands remain the only hard-atom and paragraph-bypass controls. +- Fix the remaining visible quality bug from the user's latest screenshot: + the 280px showcase path must not isolate any pathological single-CJK source + line around inline code, including `行`, `内`, or `永`, when a legal + non-emergency alternative exists. +- Gate: follow the RALPLAN test specification R1-R8 plus GUI verification. + Required evidence includes focused RED/GREEN ERT, full normal/permuted/ + isolated ERT, 300-case property fuzz, C/Elisp parity, warning-as-error + Elisp compilation, C builds/tests, checkdoc/package/static/release gates, + and reviewed fullscreen single-window screenshots for inline wrapping, + no orphan glyph, explicit no-break, block verbatim, measure modes, and + overlong-token modes. +- Current evidence: G002 records core policy compilation, C parity, 300-case + fuzz, byte compilation, checkdoc, C build, and focused policy/cache gates. + G003 records buffer/profile/local/region controls, diagnostics, generation + reflow, source/editor invariants, focused core/buffer suites, byte + compilation, and checkdoc. G004 records GUI verifier ERT 7/7 and a clean + single-window run at `/tmp/ekp-g004-evidence.Tp77dW` with 12/12 checkpoints, + no failed assertions, 25.75s/206-frame recording, no black segments, + automatic inline wrapping 3→2→3 lines across 280→340→280, source-space + internal inline breaks, explicit hard atom, block verbatim, C active, and + no stale policy projection after the no-hyphen→normal transition. +- Final evidence: G005 recorded repository-wide default/seeded/isolated ERT, + property fuzz, warning-clean Elisp/C builds, checkdoc/package/release/ + dictionary/static gates, performance checks, and full diff review. G006 + cleanup touched only `ekp.el` and `ekp-buffer.el`; targeted cleanup suites + passed 6/6 and 3/3, full core ERT passed 125/125, full buffer ERT passed + 120/120, and byte compilation, diff-check, and C build gates passed. G006 + was then review-blocked on nested semantic-plan cache aliasing and malformed + non-nil C fallback semantics. G007 resolved those first blockers: cached + semantic plans return consumer-owned copies of plan-owned mutable payloads + while intentionally sharing `para`; malformed non-nil C single/batch output + signals `ekp-backend-contract-error`, with nil-result Elisp fallback and + the 15-argument/15-field ABI unchanged. G007 final review found one + remaining string-leaf context alias; G008 resolves it by recursively + copying cons/vector/string context payloads both for snapshot/cache-key + creation and returned plans. Fresh G008 gates record formal resize parity + true, ERT 268/268, fuzz 300/300, release pass, core p50/p95 + 23.266/36.363ms, resize p50/p95 23.761/36.889ms, and byte-compiled current + public path p99 below 16ms with zero GC. After review remediation made all + changed tests warning-clean and synchronized the eighth C setter parameter, + final independent code review returned APPROVE and architecture review + returned CLEAR. + +### M14 — Final-pass emergency stretch + +- Status: `task035` was falsified; `task036` is implemented and its developer + gates pass. `issue021` is closed after user-visible confirmation. +- Correct the core K-P owner, not the renderer or policy compiler. Strict + pass behavior remains unchanged. +- In the final pass, ordinary underfull candidates receive finite background + emergency stretch and still compute adjustment ratio, badness, fitness, and + demerits. Separately, when an overfull candidate would otherwise eliminate + the final active path to a breakpoint and no non-overfull candidate survives + there, install the best provisional path with tight fitness and zero + incremental demerits, matching TeX's `artificial_demerits` purpose. +- Do not add CJK-orphan, unit, or screenshot-specific penalties. Unit suffix + configuration remains only a token-classification input, not a layout + scoring rule. +- Gate: focused core/public-buffer/C parity tests and GUI-oracle checks must + reject any isolated CJK source line in the showcase paragraph at checked + widths. Final fullscreen visual review remains required before closing + `issue021`. +- Result: the Elisp 1D, looseness/parshape, and C paths share the same rule; + explicit atom interiors remain unbreakable but adjacent legal boundaries + remain legal; the public 15-field/15-argument C contract is unchanged. + Focused regressions pass 8/8, the emergency selector passes 10/10, the + core/buffer/GUI oracle passes 8/8, full ERT passes 288/288, seeded and + isolated core suites pass 279/279, fuzz passes 300/300, all build/static/ + release gates pass, performance gates pass, and reviewed dynamic GUI + evidence at `/tmp/ekp-g009-evidence-retry.UOpPNp` returns PASS. + ## Stop Gates - Stop the affected paragraph instead of stealing a foreign replacing diff --git a/.phrase/phases/phase-kp-overhaul-20260726/spec_text_property_layout_engine_20260729.md b/.phrase/phases/phase-kp-overhaul-20260726/spec_text_property_layout_engine_20260729.md index b5c9976..bdb30ab 100644 --- a/.phrase/phases/phase-kp-overhaul-20260726/spec_text_property_layout_engine_20260729.md +++ b/.phrase/phases/phase-kp-overhaul-20260726/spec_text_property_layout_engine_20260729.md @@ -141,6 +141,42 @@ overlay and inserts no layout character. state. - Major-mode changes and mode disable leave the logical text and prior integrations intact. +- A rigid inline atom that jumps a candidate line from underfull to overfull + stays intact without forcing the preceding prose through one-box emergency + lines. In the final pass, ordinary underfull candidates receive finite + emergency stretch and remain normal K-P cost candidates. An atom wider than + the measure stays intact but may share an overflow line with preceding + ordinary content when TeX-style artificial demerits must preserve the last + active path. Atom adjacency has no special break or scoring rule. +- Inline code is not rigid by default. Known Org/Markdown inline faces use + the inline policy path, not the paragraph verbatim path. The default policy + permits legal wrapping at existing boundaries, suppresses discretionary + dictionary hyphenation, and preserves source whitespace literally. Known + code-block faces remain paragraph-level verbatim. +- Manual `ekp-no-break` is the only explicit hard-atom owner and is never + downgraded. Automatic no-break spans, such as compact number-unit tokens, + downgrade to no-hyphen when wider than the effective measure. +- The previous narrow showcase orphan-glyph failure is now a permanent + acceptance invariant: the inline-code paragraph must not isolate CJK glyphs + such as `行`, `内`, or `永` as one-character source lines around automatic + inline code when a non-emergency legal alternative exists. Dynamic evidence + must distinguish automatic inline code from explicit hard atoms and block + verbatim spans. +- The GUI oracle rejects any isolated CJK source line in the showcase + paragraph at the checked widths. This is a core K-P invariant, not a + unit-suffix, screenshot-specific, or renderer compensation rule. +- Effective policy precedence is deterministic: region properties, then + explicit buffer/file/dir-local values, then major-mode profiles, then + global defaults. Manual text properties are session-local; persistence + comes from mode syntax/profiles and file/dir locals. +- URL, path, and identifier tokens default to no-hyphen. Compact number-unit + tokens default to no-break. Hyphenation defaults to `auto`, with `on` and + `off` overrides. Kinsoku defaults to `common`, with `zh`, `ja`, `off`, and + custom additions available. Ordinary overlong tokens default to the current + emergency output, with `overflow` and `natural` alternatives. +- The buffer measure defaults to the narrowest live window. A positive + integer fixed measure and `(max . PIXELS)` cap are configurable and must be + reported by diagnostics when they create overflow risk. - Reprojection preserves point, the mark marker, and `mark-active` independently. An inactive historical mark must never become a visible selection merely because width or layout options changed. @@ -190,3 +226,19 @@ overlay and inserts no layout character. 9. Default, permuted, and isolated ERT; C/Elisp fuzz; warning-as-error Elisp/C builds; checkdoc; package/static/release gates; full diff review; independent code review; and independent architecture review pass. +10. Elisp, C, semantic-plan, string-renderer, and real GUI paths keep an + `ekp-no-break` atom intact while proving that its preceding CJK prefix is + not fragmented into one-glyph lines at narrow measures. +11. Inline and token break policies are configurable at global, mode profile, + explicit local, and region scopes. The accepted defaults are: inline code + `no-hyphen`; block code verbatim; URL/path/identifier `no-hyphen`; + compact number-unit `no-break`; hyphenation `auto`; kinsoku `common`; + overlong token `emergency`; buffer measure `narrowest-window`. +12. Region `ekp-break-policy` supports `normal`, `hyphenate`, and + `no-hyphen`, and never creates a second hard-atom representation. + Overlapping explicit `ekp-no-break` wins over every new policy. +13. The showcase paragraph containing inline code, CJK prose, NBSP-backed + numbers, and units must have no pathological single-CJK source line in + the inspected 280px GUI path while retaining exact source text, zero + overlays, block-code verbatim display, internal source-space inline + breaks, and C/Elisp plan parity. diff --git a/.phrase/phases/phase-kp-overhaul-20260726/task_repository_audit_20260728.md b/.phrase/phases/phase-kp-overhaul-20260726/task_repository_audit_20260728.md index 9f7f78f..d290b8f 100644 --- a/.phrase/phases/phase-kp-overhaul-20260726/task_repository_audit_20260728.md +++ b/.phrase/phases/phase-kp-overhaul-20260726/task_repository_audit_20260728.md @@ -722,3 +722,205 @@ checkdoc, release checks, and reviewed dynamic GUI evidence pass. - Closure: developer verification is complete. `issue020` remains open only for the required user-visible confirmation. + +- task033 [x] Prevent rigid inline atoms from fragmenting preceding CJK. + - Source: `issue021`, the user's 2026-08-01 showcase screenshot, and + `plan_text_property_layout_engine_20260729.md` M12. + - Red tests: reproduce the deterministic batch underfull-to-overfull jump + and the real 280px showcase path; require the fullest permitted prefix + line, one intact atom line, and matching Elisp/C plans. + - Work: correct the emergency transition owner in core DP and its C/loose + equivalents without changing strict K-P results or buffer projection. + - Validation: focused RED/GREEN core and buffer ERT, normal/random/ + isolated full ERT, C/Elisp fuzz, warning-as-error compilation, checkdoc, + release/static gates, and inspected static/dynamic GUI evidence. + - Impact: core line breaking, C parity, regression tests, user/developer + documentation, issue/change records, and no new public API. + - Result: retain the original emergency transition and add a fallback only + for a forbidden-run underfull-to-overfull jump. This was later superseded + by the accepted `task036` final-pass model; strict K-P and buffer + projection remain unchanged. + - Verification: the RED boundary was 1 instead of 11. Normal, + seeded-random, and isolated ERT pass 201/201; property fuzz passes + 300/300; Elisp/static/release/dictionary and three C profile builds pass. + Reviewed 62.7-second GUI evidence at + `/private/tmp/ekp-atom-gui-final-Beg8hb` passes all nine checkpoints with + an intact atom, one-line full prefix, exact source, zero overlays, active + C engine, and no black or transient vertical frame. + - Closure: developer verification is complete. `issue021` remains open + only for the required user-visible confirmation. + +- task034 [x] Make break policy configurable and eliminate inline-code + induced orphan glyph lines. + - Source: the approved RALPLAN PRD + `.omx/plans/prd-ekp-configurable-break-policies.md`, test spec + `.omx/plans/test-spec-ekp-configurable-break-policies.md`, and the + user's 2026-08-01 follow-up screenshot showing the showcase no longer + collapses into the previous one-glyph cascade but still permits + pathological single-CJK source lines around the inline atom, including + `行`, `内`, and `永`. + - Work: implement the locked A2/B2/C2/D1/E1/F1/G2/H1/I1/J1/K1/M1 policy + contract. Inline code defaults to legal wrapping with no dictionary + hyphenation; block code remains verbatim; explicit `ekp-no-break` stays + rigid forever; automatic no-break downgrades to no-hyphen when wider than + the effective measure; URL/path/identifier default to no-hyphen; compact + number-unit tokens default to no-break; kinsoku defaults to `common`; + ordinary overlong tokens default to current emergency output; and buffer + measure defaults to the narrowest live window with fixed and max-cap + alternatives. + - Public configuration: add global, major-mode profile, buffer/file/dir + local, and region controls for inline code, hyphenation, token policies, + kinsoku profiles, overlong-token behavior, and buffer measure. Region + `ekp-break-policy` provides `normal`, `hyphenate`, and `no-hyphen`; the + existing `ekp-no-break` remains the only manual hard-atom owner. + - Red tests: prove inline faces no longer cause paragraph skipping; prove + region > explicit local > mode profile > global precedence; prove token + classification/downgrade behavior; prove `common`/`zh`/`ja`/`off`/custom + kinsoku; prove `emergency`/`overflow`/`natural` overlong modes; prove + `narrowest-window`, fixed, and `(max . PIXELS)` measure resolution; and + reproduce the current showcase orphan-glyph screenshot as a failing + public path before the fix, with an oracle that rejects any pathological + single-CJK source line in the crafted paragraph when a legal + non-emergency alternative exists. + - Verification: focused RED/GREEN ERT for core, buffer, command, cache, and + diagnostics; C/Elisp parity without changing the 15-argument C entry or + 15-field batch payload; 300-case property fuzz; warning-as-error Elisp + compilation; C builds/tests; checkdoc/package/static/release gates; and + clean fullscreen single-window GUI evidence for inline wrapping, + no-orphan showcase text, explicit no-break, block verbatim, measure + modes, and overlong-token modes. + - Impact: `ekp.el`, `ekp-buffer.el`, `ekp_c/ekp_kp.c` only if parity logic + requires a mirrored DP adjustment, tests, bilingual user/developer + documentation, spec/plan/tech reference, issue/change records, changelog, + and a postmortem explaining the policy boundary. + - Implementation evidence recorded: G002 completed core policy compilation + without changing the 15-argument/15-field C boundary; G003 completed + buffer ownership, consult-only mode profiles, local/region controls, + diagnostics, and generation reflow; G004 completed the showcase split + between automatic inline code, explicit no-break, and verbatim block; + G005 performance work removed unconditional policy measure from paragraph + semantic identity, canonicalized adjacent equal filtered property + intervals, moved repeated policy full analysis behind a bounded two-tier + cache, and added a bounded per-paragraph semantic plan cache; G006 + cleanup touched only `ekp.el` and `ekp-buffer.el`, removing redundant + policy/cache code while preserving behavior; G007 resolved the first G006 + review blockers by returning consumer-owned copies of all plan-owned + mutable payloads from semantic-plan cache hits, keeping `para` + intentionally shared for append identity, and by making malformed non-nil + C single/batch results signal `ekp-backend-contract-error` while + preserving nil-result Elisp fallback and the 15-argument/15-field C + boundary; G008 resolved the final string-leaf context alias by using the + recursive context copier for cons/vector/string payloads both when the + context snapshot/cache key is created and when a plan is returned. + - GUI evidence recorded: `/tmp/ekp-g004-evidence.Tp77dW` has 12/12 + checkpoints, a 25.75s/206-frame recording, no black segments, no failed + assertions, automatic inline wrapping 3→2→3 lines across 280→340→280, + every internal inline split as source whitespace, C active, exact source, + zero overlays, and policy no-hyphen→normal settling with generation_delta + 1, live nil-plan span 1, stale nil-plan span 0, and current projection. + - Verified so far: G002 focused core policy ERT 22/22, no-break 5/5, cache + 15/15, C parity 5/5, 300-case fuzz, warning-clean C build, byte + compilation, checkdoc, and diff-check; G003 core ERT 118/118, buffer ERT + 119/119, watcher invariants 2/2, byte compilation, checkdoc, and + diff-check; G004 GUI verifier ERT 7/7 and clean GUI evidence; G005 + formal four-interleaved evaluator layout parity true, core baseline + p50/p95 38.6679/51.6782ms versus candidate 21.7102/33.0040ms for + 43.8549%/36.1354% gains, resize baseline p50/p95 43.3831/55.6250ms + versus candidate 22.0919/32.8202ms for 49.0773%/40.9973% gains, both + candidate p95 values under 50ms and both gain sets at least 20%; live + evaluator source-instrumented locked goal remains the known + `validation_failed` debt, with parity, zero-work, GC, conflict, and + all-width-nonregression true, current C p95/p99 26.449/26.740ms + (76.65%/77.23% improvement), current Elisp p95/p99 49.940/52.017ms + (91.64%/91.35% improvement), consistent with historical open `issue018` + and not a regression; byte-compiled production public path passed three + runs with zero GC, C append p99 1.361-1.368ms, C hard p99 + 1.876-1.891ms, Elisp append p99 1.692-1.775ms, and Elisp hard p99 + 2.100-2.230ms; default ERT 262/262, seeded permuted ERT seed 20260728 + 255/255, isolated per-test process suite exit 0, targeted alias guard + passed, property fuzz 300/300, warning-as-error byte compilation, + package-lint pinned at `35996f478d81e51dae4fa30d051f741895d07399` exit + 0 with only an external obsolete warning from the local names dependency, + empty checkdoc, release, 49-entry dictionary manifest, pinned dictionary + update, shell syntax, CI YAML, diff-check, portable/native/debug/sanitize + warning-clean C builds, module 1.6/4-thread smoke, and focused C 19/19 + including the 15-argument/15-field boundary passed; G006 targeted + cleanup verification passed 6/6 and 3/3, full core ERT 125/125 and + buffer ERT 120/120 passed, and byte compilation, diff-check, and C build + gates passed; G008 formal resize parity true, core baseline/candidate + p50/p95 36.595/48.357ms versus 23.266/36.363ms for 36.42%/24.80% + gains, resize baseline/candidate p50/p95 41.443/53.541ms versus + 23.761/36.889ms for 42.67%/31.10% gains, ERT 268/268, fuzz 300/300, + release gates pass, and byte-compiled current public path records zero + GC with C append/hard p99 1.440-1.464/2.022-2.050ms and Elisp + append/hard p99 1.648-1.687/2.136-2.335ms, all below 16ms. + - Closure: task034 developer implementation, repository gates, performance + gates, cleanup gates, G007 first-blocker fixes, and the G008 final + string-leaf context fix are complete. + `issue021` is closed after user visual confirmation, historical `issue018` + remains open, and final independent review returned APPROVE with + architecture status CLEAR. + +- task035 [x] Falsify line-width-scaled final-pass emergency stretch. + - Source: `issue021`, the user's 2026-08-02 narrow-showcase screenshot, + and the G009 upstream K-P review. + - Red tests: reproduce the mixed showcase paragraph at narrow widths and + reject any isolated CJK source line through the core, public buffer path, + and GUI oracle. + - Work attempted: keep the strict pass unchanged; in the final pass add a + line-width-sized finite background emergency stretch to ordinary + underfull candidates and score them through adjustment ratio, badness, + fitness, and demerits. Keep the fixed artificial emergency transition + only for truly overfull first permitted hard/atomic runs. Do not add + CJK-orphan, unit, or screenshot-specific penalties. + - Validation: focused core single-CJK ERT passes 2/2; focused core, C, + hard-atom, buffer, and GUI-oracle G009 coverage passes 18/18 in the + implementation lane; warning-as-error byte compilation and the C build + pass. Full regression then falsified the line-width stretch detail: it + made emergency stretch scale with the candidate measure instead of a TeX + fixed dimension and regressed existing emergency behavior. + - Impact: `ekp.el`, `ekp_c/ekp_kp.c`, tests, bilingual documentation, + phase records, changelog, and postmortem. Public configuration and the C + ABI are unchanged. + - Closure: task035 is closed as a disproved implementation attempt, not as + the accepted current behavior. Continue with `task036`. + +- task036 [x] Implement fixed-dimension final-pass emergency stretch and + preserve the final active path. + - Source: task035 full-regression failure, `issue021`, and the G009 + original K-P correction. + - Work: replace the candidate-width/line-width emergency stretch detail + with a TeX-style fixed dimension exposed as + `ekp-emergency-stretch-pixel`. A nil value auto-resolves to roughly three + display-font `M` widths; a non-negative integer fixes the stretch in + pixels. Keep the strict pass unchanged and the 15-field C paragraph ABI + stable. In the final pass, preserve the best provisional overfull path + with tight fitness and zero incremental demerits only when no normal + active path survives to that breakpoint. Do not add CJK-orphan, unit, + atom-adjacency, or screenshot-specific penalties. + - Red tests: add five focused RED cases covering fixed dimension versus + measure scaling, nil auto resolution, non-negative integer override, + Elisp/C parity without C ABI growth, and renderer width/glue consistency. + - Regression gate: the original three regressions that task035 broke must + stay green alongside the new RED cases. + - Full gate: focused G009 core/public-buffer/C parity and GUI-oracle + coverage, final fullscreen dynamic GUI evidence, default/permuted/ + isolated ERT, 300-case fuzz, warning-as-error byte compilation, C builds, + checkdoc/package/static/release gates, and diff-check. + - Result: production Elisp 1D, looseness/parshape, and C implementations + match; renderer glue distribution uses the chosen line's actual rest; + explicit hard atoms forbid only interior breaks and may share an overflow + line with preceding ordinary content. The test oracle now requires a + nonempty source-covering plan so an empty result cannot false-green. + - Validation: focused root regressions pass 8/8, emergency selection passes + 10/10, core/buffer/GUI oracle passes 8/8, full ERT passes 288/288, seeded + and isolated suites pass 279/279, fuzz passes 300/300, portable/native/ + debug/sanitize C builds and warning-as-error production plus changed-test + byte compilation pass, checkdoc/package/static/release gates pass, formal + core/resize performance gates pass, and reviewed 42.78-second + single-window dynamic GUI evidence at + `/tmp/ekp-g009-evidence-retry.UOpPNp` returns PASS. + Final independent code review returns APPROVE and architecture review + returns CLEAR. + - Closure: developer implementation and full quality gate complete; + `issue021` closed after the user's 2026-08-02 visual confirmation. diff --git a/CHANGELOG.md b/CHANGELOG.md index 2da4f96..afe8c5d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,18 @@ project aims to follow [Semantic Versioning](https://semver.org/). ### Fixed +- Malformed non-nil C backend results no longer fall back to Elisp. Nil whole + results and nil per-item breaks remain soft failures; malformed single or + batch output now signals `ekp-backend-contract-error`, so a broken backend + cannot silently produce a different layout. +- An overwide `ekp-no-break` inline atom no longer collapses its preceding + CJK text into one-glyph emergency lines. The final pass now gives ordinary + underfull candidates finite background emergency stretch and lets normal + badness/fitness/demerits choose the layout. If an overfull candidate would + otherwise extinguish every active path, TeX-style artificial demerits + preserve the best provisional path with zero incremental cost. The rule is + content-independent and identical in the Elisp 1D, looseness/parshape, and + C engines. - C-backed core layout and complete resize/reflow now reuse prepared paragraph, DP, and gap geometry and avoid duplicate projection publication. The four-round same-machine gate records p95 values of @@ -148,6 +160,12 @@ project aims to follow [Semantic Versioning](https://semver.org/). ### Internal +- Cached semantic layout plans now return consumer-owned copies of all + plan-owned mutable payloads: strings, context, boxes, offsets, line/glue/ + gap records, and signatures. Layout context snapshots and returned contexts + recursively copy conses, vectors, and strings, so mutable policy inputs + cannot alias the cache key. The paragraph object remains intentionally + shared for stable append identity. - DP reuse identity, edge-space exclusion, and the lossless marker vocabulary now each have one directly tested rule owner. The consolidation removes formula/property-list drift without adding modules or hot-loop diff --git a/DEVELOPER.md b/DEVELOPER.md index e5979ea..8bd8abb 100644 --- a/DEVELOPER.md +++ b/DEVELOPER.md @@ -121,10 +121,12 @@ badness = min(10000, 100·|adjustment/flexibility|³) ``` Fitness classes (tight/decent/loose/very-loose) follow the TeX ratio -thresholds. Special cases: single-box lines use flexibility 1 and -fitness decent; the last line pays `(line-penalty + short-badness)²` -where `short-badness = last-line-short-penalty × (1 − fill)` when the -fill ratio is below `ekp-last-line-min-ratio`. +thresholds. Special cases: single-box lines use flexibility 1 in the +strict pass; the final pass uses the same finite emergency stretch as +ordinary underfull lines. The last line pays +`(line-penalty + short-badness)²` where +`short-badness = last-line-short-penalty × (1 − fill)` when the fill ratio +is below `ekp-last-line-min-ratio`. Deviations from the 1981 paper, by design: penalties are always added as `+p²` (no negative/flagged penalties), there is no `q`/looseness in @@ -135,12 +137,22 @@ the main pass (see §6), and adjacent-fitness is a flat constant. Some inputs admit no valid layout: an unbreakable box wider than the line, or a rigid (all-`nws`) region that cannot stretch to the target. A strict pass runs first; if the paragraph end is unreachable, a second -pass additionally allows **emergency breaks** — single-box lines with -demerits `(line-penalty + 10000)² + rest²`, at least as bad as any -regular line. This guarantees, by induction over positions, that every -input produces output (regression: narrow CJK used to return an empty -string), while the common case pays nothing and keeps pure K-P -optimality. Both engines implement the identical strategy. +pass adds a finite background emergency stretch to ordinary underfull +candidates and still scores them through the same adjustment ratio, +badness, fitness, and demerits used by the strict pass. That keeps +underfull final-pass choices inside the global K-P DP instead of forcing +them through a separate fixed-cost path. + +Separately, the final pass implements TeX's `artificial_demerits` safeguard. +When an overfull candidate would otherwise remove the last active path to a +breakpoint and no non-overfull candidate survives there, the best provisional +path is installed with tight fitness and zero incremental demerits. This is a +reachability rule, not a hard-atom scoring shortcut: it never competes while a +normal active path survives, and it does not inspect CJK, units, or token +classes. Thus every input still produces a complete plan (regression: narrow +CJK used to return an empty result), while ordinary underfull lines compete +by normal K-P cost. The Elisp 1D, looseness/parshape, and C engines implement +the identical strategy. ## 5. Rendering @@ -162,6 +174,16 @@ mechanism. `ekp-render-layout-string` consumes it for the public string API; the buffer integration can consume the same decisions without re-running or reinterpreting the KP algorithm. +Cached semantic plans are immutable to the cache owner. A cache hit returns +a consumer-owned copy of every plan-owned mutable payload: source string, +context tree, box vector and box strings, source offsets, line records, +line glues, gap records, and line signatures. `ekp-layout-plan-para` is the +intentional exception: paragraph-cache ownership predates the semantic-plan +cache, and append planning depends on stable paragraph identity. +Layout context snapshots and returned plan contexts use the same recursive +copier for conses, vectors, and strings, so mutable policy inputs cannot alias +the cache key or a later consumer plan. + The two consumers deliberately have different representation rights. #### String renderer @@ -281,9 +303,33 @@ the one authoritative width. own box; `ekp-para-breaks-allowed` forbids gaps per kinsoku (full- and halfwidth), `ekp-no-break' spans and NBSP-family joiners. Forbidden gaps carry no glue. The DP skips them as candidates while - the line keeps extending; the emergency fallback treats a run with - no permitted inner break as atomic. C receives the sparse - `forbidden-positions` vector. + the line keeps extending. In the final pass, legal underfull candidates + receive finite emergency stretch and are scored by normal + badness/demerits. If an overfull candidate would extinguish the last active + final-pass path, TeX-style artificial demerits preserve that path with zero + incremental cost. C receives the sparse `forbidden-positions` vector. + Explicit hard atoms forbid only breaks inside their interval; an otherwise + legal boundary immediately before or after an atom remains legal. Atom + adjacency therefore receives no special scoring or break prohibition. +- **Configurable policy compilation**: buffer and core policy variables are + resolved before tokenization into private structural intervals. Region + `ekp-break-policy` wins first, explicit buffer/file/dir locals win over + mode profiles, and profiles win over global defaults. Token policies are + the only merged category map; scalar and face-list options replace the + lower scope. The core may use private properties such as + `ekp--face-break-policy`, `ekp--no-hyphen`, and + `ekp--literal-spacing` on an analysis copy, but cache keys, plan strings, + boxes, rendered strings, and `ekp--last-para` must contain only public + source properties. Automatic face no-break is measured over the + contiguous private face-policy span and downgrades to no-hyphen when + overwide; explicit `ekp-no-break` never downgrades. +- **Literal inline spaces**: face-derived `no-hyphen` preserves source + spaces as literal boxes inside a line, forbids a break that would move a + literal source-space box to line start, and permits the complementary + break after a source-space box. When such whitespace is the selected + visual break, source ownership belongs to the break gap metadata, not to a + trailing visible line box. This rule is policy-derived and must not depend + on whether the source also carries a public `face` property. - **Alignment** (`ekp-alignment`): non-justify modes zero the glue stretch/shrink arrays and class params; the DP widens `max_w` by an extra per-line stretch R (`ekp-c-set-penalties` arg 7), so badness = @@ -306,7 +352,9 @@ the one authoritative width. C module 1.6: `ekp-c-break-with-arrays' takes 15 args (…, forbidden-positions, tail-protrudes, hyphen-protrude, first-line-width); batch vectors have 15 elements; -`ekp-c-set-penalties' takes 4–7. +`ekp-c-set-penalties' takes 4–8. Policy compilation feeds the existing +hyphen-position and forbidden-break vectors; it must not add a sixteenth C +argument or batch field without a new architecture decision. Performance after the feature wave (byte-compiled + C, Apple Silicon, batch): justify zh w=200 ≈ 54 ms, range zh ≈ 117 ms — @@ -349,19 +397,22 @@ the source of truth for all font-dependent data. pool is created lazily on the first multi-paragraph batch and sized to the machine's cores; a full queue blocks the submitter rather than dropping the task. -- `ekp-c-set-penalties` (4–7 args): called by `ekp--c-sync-params` +- `ekp-c-set-penalties` (4–8 args): called by `ekp--c-sync-params` before *every* C entry, so `ekp-line-penalty` & friends always take effect (regression: they were never synced before). - `ekp-c-module-load` refuses modules older than `ekp-c-module-required-version` and falls back to Elisp, preventing arity mismatches after upgrades. -An unavailable module, an allocation/no-result nil, or an incompatible -module version falls back to the Elisp engine. Invalid direct API input -signals `ekp-c-invalid-input`, and any signal from an enabled backend -propagates through the public formatter; the dispatcher does not catch and -hide it. The module never silently produces a different layout on partial -failure. The two engines are verified byte-identical by +An unavailable module, an incompatible module version, a nil whole C result, +or a nil per-item/break result falls back to the Elisp engine. Invalid +direct API input signals `ekp-c-invalid-input`. Any non-nil malformed +backend result signals `ekp-backend-contract-error`: malformed cons shape, +non-list breaks, non-integer/out-of-range/non-increasing/partial breaks, +nonnumeric cost, or malformed batch result shape. Any signal from an +enabled backend propagates through the public formatter; the dispatcher does +not catch and hide it. The module never silently produces a different +layout on partial failure. The two engines are verified byte-identical by `ekp-test-c-parity-simple` / `ekp-test-c-parity-files` and the 300-case property fuzz. diff --git a/DEVELOPER_ZH.md b/DEVELOPER_ZH.md index 1cec238..ae7e0e4 100644 --- a/DEVELOPER_ZH.md +++ b/DEVELOPER_ZH.md @@ -109,7 +109,8 @@ badness = min(10000, 100·|adjustment/flexibility|³) ``` 松紧等级(tight/decent/loose/very-loose)沿用 TeX 的比例阈值。特殊情 -况:单盒行 flexibility 固定为 1、fitness 为 decent;末行代价为 +况:严格遍的单盒行 flexibility 固定为 1;最终遍使用与普通欠宽行相同 +的有限 emergency stretch。末行代价为 `(line-penalty + 短行badness)²`,填充率低于 `ekp-last-line-min-ratio` 时 `短行badness = last-line-short-penalty × (1 − 填充率)`。 @@ -121,10 +122,17 @@ penalty/flagged 断点),主流程无 `q`/looseness(见 §6),相邻松紧惩 某些输入不存在合法排版:比行宽更宽的不可断盒子,或无法伸展到目标宽 的刚性(全 `nws`)区段。先跑严格遍;若段尾不可达,第二遍额外允许 -**紧急断行**——demerits 为 `(line-penalty + 10000)² + rest²` 的单盒行, -不低于任何常规行的代价。由位置归纳可证:任何输入必有输出(回归:窄 -栏 CJK 曾整段返回空串),常规输入不付任何代价、保持纯 K-P 最优。两个 -引擎实现完全相同的策略。 +为普通欠宽候选加入有限 background emergency stretch,并继续走同一套 +adjustment ratio、badness、fitness 和 demerits。这样最终遍的欠宽选择 +仍由全局 K-P DP 比较,不会被塞进另一条固定代价路径。 + +另外,最终遍实现 TeX 的 `artificial_demerits` 可达性保护。如果某个 +超宽候选将使一个断点的最后活动路径消失,且该断点没有任何未超宽候选 +存活,就以 tight fitness 和零增量 demerits 安装最佳暂存路径。这不是 +hard atom 专用的评分捷径:只要正常活动路径还在,它就不参与竞争,也不 +检查中文、单位或 token 类别。因此任何输入仍会得到覆盖完整源文本的 +plan(回归:窄栏 CJK 曾整段返回空结果),而普通欠宽行仍按正常 K-P 代价 +竞争。Elisp 1D、looseness/parshape 与 C 引擎实现相同语义。 ## 5. 渲染 @@ -143,6 +151,15 @@ penalty/flagged 断点),主流程无 `q`/looseness(见 §6),相邻松紧惩 `ekp-render-layout-string` 用它服务现有字符串 API;buffer 集成可复用 完全相同的决策,无需重新运行或重新解释 KP 算法。 +缓存的 semantic plan 对缓存 owner 不可变。缓存命中会返回 consumer +自有副本,覆盖所有 plan 自有的可变 payload:源字符串、context 树、盒 +向量与盒字符串、源 offset、line 记录、line glue、gap 记录和 line +signature。`ekp-layout-plan-para` 是有意例外:段落缓存所有权早于 +semantic-plan cache,append planning 依赖稳定的段落身份。 +layout context snapshot 与返回 plan context 使用同一个递归 copier, +覆盖 cons、vector 与 string,因此可变 policy 输入不会别名到 cache key +或后续 consumer plan。 + 两个消费方拥有不同且明确的表示权限。 #### 字符串渲染器 @@ -242,8 +259,27 @@ idle formatter。point 移动本身严格零副作用;之后若在别处发生 - **断行许可**:每个 CJK 字符(含标点)独立成盒; `ekp-para-breaks-allowed` 按禁则(全角与半角)、`ekp-no-break` 区间及 NBSP 族连接符禁止相应间隙,被禁间隙不携带 glue。DP 跳过 - 被禁候选但继续延伸行;紧急兜底把"内部无许可断点的连跑段"视为 - 原子。C 侧接收稀疏 `forbidden-positions` 向量。 + 被禁候选但继续延伸行。最终遍中的合法欠宽候选获得有限 emergency + stretch 并按正常 badness/demerits 评分;若超宽候选将消灭最后活动 + 路径,TeX 风格 artificial demerits 以零增量代价保留该路径。C 侧接收 + 稀疏 `forbidden-positions` 向量。显式 hard atom 只禁止其区间内部 + 断行;atom 前后本来合法的边界仍然合法。atom 邻接不获得特殊评分, + 也不会额外禁止断点。 +- **可配置 policy 编译**:buffer 与 core policy 变量在 tokenization + 之前解析为私有结构区间。区域 `ekp-break-policy` 优先,显式 + buffer/file/dir local 值优先于 mode profile,profile 优先于全局默认。 + 只有 token policy 是按类别合并的 map;标量与 face 列表都直接替换 + 低优先级值。core 可以在 analysis copy 上使用 + `ekp--face-break-policy`、`ekp--no-hyphen`、`ekp--literal-spacing` + 等私有属性,但 cache key、plan string、box、rendered string 与 + `ekp--last-para` 只能保留公开源属性。自动 face no-break 按连续的 + 私有 face-policy 区间整体测宽,超宽时降级为 no-hyphen;显式 + `ekp-no-break` 永不降级。 +- **行内字面空格**:face 派生的 `no-hyphen` 在行内保留源空格为字面 + box,禁止会把源空格 box 移到行首的断点,并允许互补的"空格后到内容" + 断点。当这些空白成为选中的视觉断点时,源归属属于 break gap metadata, + 而不是尾随可见行 box。该规则来自 policy,不能依赖源上是否另有公开 + `face` 属性。 - **对齐**(`ekp-alignment`):非两端对齐把 glue 伸缩数组与类参数 置零,DP 给 `max_w` 加每行额外伸展 R(`ekp-c-set-penalties` 第 7 参),badness = 100·(欠宽/R)³;渲染层按模式分派剩余(尾部/对半/ @@ -261,7 +297,8 @@ idle formatter。point 移动本身严格零副作用;之后若在别处发生 C 模块 1.6:`ekp-c-break-with-arrays` 15 参(…、forbidden-positions、 tail-protrudes、hyphen-protrude、first-line-width);batch 向量 15 元; -`ekp-c-set-penalties` 4–7 参。 +`ekp-c-set-penalties` 4–8 参。policy 编译只进入现有断词位置与禁断 +向量;没有新的架构决策时,不得增加第 16 个 C 参数或 batch 字段。 特性完成后的性能(字节编译 + C,Apple Silicon,batch):justify zh w=200 ≈ 54 ms、range zh ≈ 117 ms——justify 与特性前持平,range 因盒 @@ -296,16 +333,20 @@ C 模块(`ekp_c/`,版本 1.6)只执行阶段 ④。所有字体相关数据以 E ——每段一个任务(这是正确的并行粒度;DP 本身天然串行)。线程池在 首次多段落 batch 时惰性创建,按机器核心数定大小;队列满时提交方 阻塞等待而非丢弃任务。 -- `ekp-c-set-penalties`(4–7 参数):`ekp--c-sync-params` 在**每次** +- `ekp-c-set-penalties`(4–8 参数):`ekp--c-sync-params` 在**每次** 进入 C 之前调用,保证 `ekp-line-penalty` 等变量始终生效(回归:此 前从未同步)。 - `ekp-c-module-load` 拒绝低于 `ekp-c-module-required-version` 的模块 并回落到 Elisp,避免升级后的参数数量不匹配。 -模块不可用、分配/无结果返回 nil 或 ABI 版本不兼容时回落到 Elisp。 -直接 API 的非法输入 signal `ekp-c-invalid-input`;已启用后端发出的 -任何 signal 都会穿过公共 formatter,dispatcher 不捕获或隐藏。模块 -不会在部分失败时静默产出不同的排版。两引擎输出逐字节一致,由 +模块不可用、ABI 版本不兼容、整批 C 结果为 nil 或单项/断点结果为 +nil 时回落到 Elisp。直接 API 的非法输入 signal +`ekp-c-invalid-input`。任何非 nil 的畸形后端结果 signal +`ekp-backend-contract-error`:结果 cons 形状错误、breaks 不是 list、 +break 非整数/越界/非递增/未覆盖段尾、cost 非数字,或 batch 结果形状 +错误。已启用后端发出的任何 signal 都会穿过公共 formatter,dispatcher +不捕获或隐藏。模块不会在部分失败时静默产出不同的排版。两引擎输出 +逐字节一致,由 `ekp-test-c-parity-simple` / `ekp-test-c-parity-files` 及 300 例性质 fuzz 验证。 diff --git a/ekp-buffer.el b/ekp-buffer.el index b8ad7ec..12b8247 100644 --- a/ekp-buffer.el +++ b/ekp-buffer.el @@ -78,19 +78,110 @@ command and is not limited by this value." "Seconds of work allowed in one lazy reflow tick." :type 'number) -(defconst ekp-buffer-org-skip-faces - '(org-block org-block-begin-line org-block-end-line org-code - org-verbatim org-table org-meta-line) +(defconst ekp-buffer-org-block-faces + '(org-block org-block-begin-line org-block-end-line + org-table org-meta-line) + "Org block faces whose paragraphs stay verbatim.") + +(defconst ekp-buffer-org-inline-faces + '(org-code org-verbatim) + "Org inline faces that receive automatic inline break policy.") + +(defconst ekp-buffer-org-skip-faces ekp-buffer-org-block-faces "Reasonable `ekp-buffer-skip-faces' preset for Org buffers.") -(defconst ekp-buffer-markdown-skip-faces - '(markdown-code-face markdown-inline-code-face markdown-pre-face - markdown-table-face) +(defconst ekp-buffer-markdown-block-faces + '(markdown-code-face markdown-pre-face markdown-table-face) + "Markdown block faces whose paragraphs stay verbatim.") + +(defconst ekp-buffer-markdown-inline-faces + '(markdown-inline-code-face) + "Markdown inline faces that receive automatic inline break policy.") + +(defconst ekp-buffer-markdown-skip-faces ekp-buffer-markdown-block-faces "Reasonable `ekp-buffer-skip-faces' preset for Markdown buffers.") +(defun ekp-buffer--safe-symbol-list-p (value) + "Return non-nil when VALUE is a closed list of symbols." + (and (proper-list-p value) (seq-every-p #'symbolp value))) + +(defun ekp-buffer--safe-measure-p (value) + "Return non-nil when VALUE is a documented measure mode." + (or (eq value 'narrowest-window) + (and (integerp value) (> value 0)) + (and (consp value) (eq (car value) 'max) + (integerp (cdr value)) (> (cdr value) 0)))) + +(defun ekp-buffer--safe-mode-policy-entry-p (entry) + "Return non-nil when ENTRY is a closed mode profile entry." + (and (consp entry) + (symbolp (car entry)) + (proper-list-p (cdr entry)) + (seq-every-p + (lambda (setting) + (and (consp setting) + (pcase (car setting) + ('ekp-inline-code-policy + (ekp--safe-break-policy-value-p (cdr setting))) + ('ekp-hyphenation + (ekp--safe-hyphenation-value-p (cdr setting))) + ('ekp-overlong-token-policy + (memq (cdr setting) '(emergency overflow natural))) + ('ekp-emergency-stretch-pixel + (ekp--safe-emergency-stretch-pixel-p (cdr setting))) + ('ekp-kinsoku-profile + (memq (cdr setting) '(common zh ja off custom))) + ('ekp-cjk-no-line-start-extra + (stringp (cdr setting))) + ('ekp-cjk-no-line-end-extra + (stringp (cdr setting))) + ('ekp-number-unit-suffixes + (and (proper-list-p (cdr setting)) + (seq-every-p #'stringp (cdr setting)))) + ('ekp-token-break-policies + (ekp--safe-token-break-policies-p (cdr setting))) + ('ekp-buffer-skip-faces + (ekp-buffer--safe-symbol-list-p (cdr setting))) + ('ekp-buffer-inline-faces + (ekp-buffer--safe-symbol-list-p (cdr setting))) + ('ekp-buffer-measure + (ekp-buffer--safe-measure-p (cdr setting))) + (_ nil)))) + (cdr entry)))) + +(defun ekp-buffer--safe-mode-policy-alist-p (value) + "Return non-nil when VALUE is a safe mode policy alist." + (and (proper-list-p value) + (seq-every-p #'ekp-buffer--safe-mode-policy-entry-p value))) + (defcustom ekp-buffer-skip-faces nil "Faces whose paragraphs stay verbatim." - :type '(repeat face)) + :type '(repeat face) + :safe #'ekp-buffer--safe-symbol-list-p) + +(defcustom ekp-buffer-inline-faces nil + "Faces whose exact spans use `ekp-inline-code-policy'." + :type '(repeat face) + :safe #'ekp-buffer--safe-symbol-list-p) + +(defcustom ekp-buffer-mode-policy-alist + `((org-mode . ((ekp-buffer-skip-faces . ,ekp-buffer-org-block-faces) + (ekp-buffer-inline-faces . ,ekp-buffer-org-inline-faces))) + (markdown-mode + . ((ekp-buffer-skip-faces . ,ekp-buffer-markdown-block-faces) + (ekp-buffer-inline-faces . ,ekp-buffer-markdown-inline-faces)))) + "Mode profiles consulted by automatic and manual buffer layout." + :type '(alist :key-type symbol :value-type sexp) + :safe #'ekp-buffer--safe-mode-policy-alist-p) + +(defcustom ekp-buffer-measure 'narrowest-window + "Measure used for automatic and default manual buffer layout. +`narrowest-window' uses the narrowest live window displaying the +buffer. A positive integer is a fixed pixel width. `(max . N)' +caps the narrowest live window at N pixels." + :type '(choice (const narrowest-window) (integer :tag "Fixed pixels") + (cons (const max) (integer :tag "Maximum pixels"))) + :safe #'ekp-buffer--safe-measure-p) (defvar-local ekp-buffer-skip-predicate nil "Function called with a paragraph string that should stay verbatim.") @@ -110,6 +201,9 @@ command and is not limited by this value." (defvar-local ekp-buffer--auto-width nil) (defvar-local ekp-buffer--resize-timer nil) (defvar-local ekp-buffer--composition-timer nil) +(defvar-local ekp-buffer--policy-reflow-timer nil) +(defvar-local ekp-buffer--policy-reflow-context nil) +(defvar-local ekp-buffer--policy-context-snapshot nil) (defvar-local ekp-buffer--pending nil) (defvar-local ekp-buffer--chunk-timer nil) (defvar-local ekp-buffer--generation 0) @@ -155,15 +249,127 @@ command and is not limited by this value." ;;; Setup +(defconst ekp-buffer--policy-variables + '(ekp-inline-code-policy ekp-hyphenation ekp-token-break-policies + ekp-number-unit-suffixes + ekp-overlong-token-policy ekp-kinsoku-profile + ekp-emergency-stretch-pixel + ekp-cjk-no-line-start-extra ekp-cjk-no-line-end-extra + ekp-buffer-skip-faces ekp-buffer-inline-faces + ekp-buffer-mode-policy-alist ekp-buffer-measure) + "Variables that affect buffer layout policy or measure.") + +(defun ekp-buffer--matching-mode-profile () + "Return the first matching mode policy profile for the current buffer." + (seq-some + (lambda (entry) + (and (derived-mode-p (car entry)) + (cdr entry))) + ekp-buffer-mode-policy-alist)) + +(defun ekp-buffer--profile-value (profile variable) + "Return VARIABLE's value from PROFILE, or nil if absent." + (assq variable profile)) + +(defun ekp-buffer--effective-scalar (profile variable) + "Return VARIABLE for PROFILE after local, mode-profile, then global precedence." + (if (local-variable-p variable) + (symbol-value variable) + (let ((current (symbol-value variable)) + (default (default-value variable)) + (profile-value (ekp-buffer--profile-value profile variable))) + (cond + ((not (equal current default)) current) + (profile-value (cdr profile-value)) + (t default))))) + +(defun ekp-buffer--merge-token-policies (profile) + "Return effective token policies after merging global, PROFILE, and local." + (let ((merged (copy-tree (default-value 'ekp-token-break-policies))) + (current ekp-token-break-policies) + (default (default-value 'ekp-token-break-policies))) + (dolist (entry (cdr (ekp-buffer--profile-value + profile 'ekp-token-break-policies))) + (setf (alist-get (car entry) merged) (cdr entry))) + (when (or (local-variable-p 'ekp-token-break-policies) + (not (equal current default))) + (dolist (entry current) + (setf (alist-get (car entry) merged) (cdr entry)))) + merged)) + +(defun ekp-buffer--policy-context (&optional width) + "Return the effective policy context for the current buffer at WIDTH." + (let* ((profile (ekp-buffer--matching-mode-profile)) + (emergency-stretch + (ekp-buffer--effective-scalar + profile 'ekp-emergency-stretch-pixel)) + (resolved-emergency-stretch + (let ((ekp-emergency-stretch-pixel emergency-stretch)) + (ekp--resolved-emergency-stretch-pixel)))) + (ekp--copy-layout-context-value + (list :inline-code-policy + (ekp-buffer--effective-scalar profile 'ekp-inline-code-policy) + :hyphenation + (ekp-buffer--effective-scalar profile 'ekp-hyphenation) + :token-break-policies (ekp-buffer--merge-token-policies profile) + :number-unit-suffixes + (ekp-buffer--effective-scalar profile 'ekp-number-unit-suffixes) + :overlong-token-policy + (ekp-buffer--effective-scalar profile 'ekp-overlong-token-policy) + :emergency-stretch-pixel resolved-emergency-stretch + :kinsoku-profile + (ekp-buffer--effective-scalar profile 'ekp-kinsoku-profile) + :cjk-no-line-start-extra + (ekp-buffer--effective-scalar + profile 'ekp-cjk-no-line-start-extra) + :cjk-no-line-end-extra + (ekp-buffer--effective-scalar profile 'ekp-cjk-no-line-end-extra) + :block-faces + (ekp-buffer--effective-scalar profile 'ekp-buffer-skip-faces) + :inline-faces + (ekp-buffer--effective-scalar profile 'ekp-buffer-inline-faces) + :measure + (ekp-buffer--effective-scalar profile 'ekp-buffer-measure) + :width width)))) + +(defmacro ekp-buffer--with-policy-context (context &rest body) + "Run BODY with CONTEXT bound as EKP's core policy environment." + (declare (indent 1)) + `(let ((ekp-inline-code-policy + (plist-get ,context :inline-code-policy)) + (ekp-hyphenation (plist-get ,context :hyphenation)) + (ekp-token-break-policies + (plist-get ,context :token-break-policies)) + (ekp-number-unit-suffixes + (plist-get ,context :number-unit-suffixes)) + (ekp-overlong-token-policy + (plist-get ,context :overlong-token-policy)) + (ekp-emergency-stretch-pixel + (plist-get ,context :emergency-stretch-pixel)) + (ekp-kinsoku-profile (plist-get ,context :kinsoku-profile)) + (ekp-cjk-no-line-start-extra + (plist-get ,context :cjk-no-line-start-extra)) + (ekp-cjk-no-line-end-extra + (plist-get ,context :cjk-no-line-end-extra))) + ,@body)) + +(defun ekp-buffer--face-member-p (face faces) + "Return non-nil when FACE intersects FACES." + (if (listp face) + (seq-intersection face faces) + (memq face faces))) + ;;;###autoload (defun ekp-org-setup () "Protect common Org structural faces in the current buffer." - (setq-local ekp-buffer-skip-faces ekp-buffer-org-skip-faces)) + (setq-local ekp-buffer-skip-faces ekp-buffer-org-block-faces) + (setq-local ekp-buffer-inline-faces ekp-buffer-org-inline-faces)) ;;;###autoload (defun ekp-markdown-setup () "Protect common Markdown code faces in the current buffer." - (setq-local ekp-buffer-skip-faces ekp-buffer-markdown-skip-faces)) + (setq-local ekp-buffer-skip-faces ekp-buffer-markdown-block-faces) + (setq-local ekp-buffer-inline-faces ekp-buffer-markdown-inline-faces)) ;;; Width @@ -208,40 +414,66 @@ command and is not limited by this value." (point)))) (defun ekp-buffer--effective-width (&optional buffer) - "Return the authoritative width for BUFFER. -The narrowest live window wins because text properties are buffer-wide." - (let ((windows (get-buffer-window-list - (or buffer (current-buffer)) nil t))) - (if windows - (apply #'min (mapcar #'ekp-buffer--window-pixel windows)) - (ekp-buffer--window-pixel)))) + "Return BUFFER's effective `ekp-buffer-measure' width. +The default uses the narrowest live window; fixed widths and `(max . N)' +come from the active buffer policy." + (with-current-buffer (or buffer (current-buffer)) + (let* ((windows (get-buffer-window-list (current-buffer) nil t)) + (narrowest (if windows + (apply #'min + (mapcar #'ekp-buffer--window-pixel windows)) + (ekp-buffer--window-pixel))) + (measure (plist-get (ekp-buffer--policy-context) :measure))) + (cond + ((eq measure 'narrowest-window) narrowest) + ((and (integerp measure) (> measure 0)) measure) + ((and (consp measure) (eq (car measure) 'max) + (integerp (cdr measure)) (> (cdr measure) 0)) + (min narrowest (cdr measure))) + (t (error "Invalid ekp-buffer-measure: %S" measure)))))) + +(defun ekp-buffer--measure-report (&optional buffer) + "Return measure diagnostics for BUFFER." + (with-current-buffer (or buffer (current-buffer)) + (let* ((windows (get-buffer-window-list (current-buffer) nil t)) + (narrowest (if windows + (apply #'min + (mapcar #'ekp-buffer--window-pixel windows)) + (ekp-buffer--window-pixel))) + (context (ekp-buffer--policy-context)) + (requested (plist-get context :measure)) + (effective (ekp-buffer--effective-width))) + (list :requested requested + :narrowest narrowest + :effective effective + :overflow-risk (and (integerp effective) + (> effective narrowest)))))) ;;; Paragraphs and conflicts -(defun ekp-buffer--face-hit-p (string) - "Return non-nil when STRING carries a configured skip face." +(defun ekp-buffer--face-hit-p (string faces) + "Return non-nil when STRING carries one of FACES." (let ((pos 0) (length (length string)) hit) (while (and (< pos length) (not hit)) (let ((face (get-text-property pos 'face string))) - (setq hit (if (listp face) - (seq-intersection face ekp-buffer-skip-faces) - (memq face ekp-buffer-skip-faces))) + (setq hit (ekp-buffer--face-member-p face faces)) (setq pos (or (next-single-property-change pos 'face string length) length)))) hit)) -(defun ekp-buffer--skip-paragraph-p (paragraph) - "Return non-nil when PARAGRAPH must stay verbatim." - (or (string-blank-p paragraph) - (text-property-not-all 0 (length paragraph) - 'ekp-verbatim nil paragraph) - (text-property-not-all 0 (length paragraph) 'field nil paragraph) - (text-property-not-all 0 (length paragraph) 'read-only nil paragraph) - (and ekp-buffer-skip-faces - (ekp-buffer--face-hit-p paragraph)) - (and ekp-buffer-skip-predicate - (funcall ekp-buffer-skip-predicate paragraph)))) +(defun ekp-buffer--skip-paragraph-p (paragraph &optional context) + "Return non-nil when PARAGRAPH must stay verbatim under CONTEXT." + (let* ((context (or context (ekp-buffer--policy-context))) + (faces (plist-get context :block-faces))) + (or (string-blank-p paragraph) + (text-property-not-all 0 (length paragraph) + 'ekp-verbatim nil paragraph) + (text-property-not-all 0 (length paragraph) 'field nil paragraph) + (text-property-not-all 0 (length paragraph) 'read-only nil paragraph) + (and faces (ekp-buffer--face-hit-p paragraph faces)) + (and ekp-buffer-skip-predicate + (funcall ekp-buffer-skip-predicate paragraph))))) (defun ekp-buffer--foreign-property-at-p (position property) "Return non-nil when PROPERTY at POSITION is not owned by EKP." @@ -608,17 +840,53 @@ EFFECTIVE-END includes the source boundary owned by the line." (goto-char end))))) (nreverse ranges))) +(defun ekp-buffer--annotate-inline-faces (text context) + "Annotate inline face spans on TEXT using CONTEXT." + (let ((faces (plist-get context :inline-faces)) + (policy (plist-get context :inline-code-policy)) + (pos 0) + (length (length text)) + annotated) + (when (and faces (not (eq policy 'normal))) + (while (< pos length) + (let* ((face (get-text-property pos 'face text)) + (next (or (next-single-property-change pos 'face text length) + length))) + (when (ekp-buffer--face-member-p face faces) + (unless annotated + (setq annotated (copy-sequence text))) + (put-text-property + pos next 'ekp--face-break-policy policy annotated)) + (setq pos next)))) + (or annotated text))) + +(defun ekp-buffer--planning-text (text context) + "Return TEXT annotated with transient inline policy from CONTEXT." + (ekp-buffer--annotate-inline-faces text context)) + +(defun ekp-buffer--layout-plan (text pixel context) + "Return layout plan for TEXT at PIXEL under CONTEXT." + (let ((planning-text (ekp-buffer--planning-text text context))) + (ekp-buffer--with-policy-context context + (let ((plan (ekp-layout-plan planning-text pixel))) + (setf (ekp-layout-plan-string plan) text) + plan)))) + (defun ekp-buffer--layout-paragraph (beg end pixel) "Project one hard paragraph from BEG to END at PIXEL." (if (and ekp-buffer--automatic-pass (> (- end beg) ekp-auto-justify-paragraph-limit)) (ekp-buffer--record-conflict beg end "paragraph exceeds the automatic paragraph limit") - (let ((paragraph (buffer-substring beg end))) - (unless (ekp-buffer--skip-paragraph-p paragraph) - (let ((plan (ekp-layout-plan paragraph pixel))) - (when (ekp-buffer--projectable-p plan beg beg end) - (ekp-buffer--install-plan beg end pixel plan))))))) + (let* ((paragraph (buffer-substring beg end)) + (context (ekp-buffer--policy-context pixel))) + (unless (ekp-buffer--skip-paragraph-p paragraph context) + (let ((plan (ekp-buffer--layout-plan paragraph pixel context))) + (if (eq (ekp-layout-plan-state plan) 'natural) + (ekp-buffer--record-conflict + beg end "overlong-token-natural") + (when (ekp-buffer--projectable-p plan beg beg end) + (ekp-buffer--install-plan beg end pixel plan)))))))) (defun ekp-buffer--dwim-bounds () "Return active region bounds or the hard paragraph at point." @@ -636,13 +904,16 @@ EFFECTIVE-END includes the source boundary owned by the line." (list start finish (and current-prefix-arg (prefix-numeric-value current-prefix-arg)))))) - (setq pixel (or pixel (ekp-buffer--window-pixel))) + (setq pixel (or pixel (ekp-buffer--effective-width))) (let ((start (min beg end)) (finish (max beg end))) (setq beg start end finish)) (when (and font-lock-mode - (or ekp-buffer-skip-faces ekp-buffer-skip-predicate)) + (let ((context (ekp-buffer--policy-context pixel))) + (or (plist-get context :block-faces) + (plist-get context :inline-faces) + ekp-buffer-skip-predicate))) (font-lock-ensure beg end)) (let ((point-before (point)) (mark-before (and (mark t) (copy-marker (mark t)))) @@ -759,20 +1030,76 @@ EFFECTIVE-END includes the source boundary owned by the line." ;;; Protection commands +(defvar ekp-break-policy nil + "Text property controlling regional break policy. +`normal' clears automatic token or face restrictions, `hyphenate' +enables discretionary hyphenation, and `no-hyphen' suppresses it. +This property is not a hard no-break switch; rigid atoms remain +owned by the separate `ekp-no-break' text property.") + (defun ekp-buffer--interactive-protection-args () "Return region arguments for an interactive protection command." (barf-if-buffer-read-only) (list (region-beginning) (region-end) t)) +(defun ekp-buffer--after-region-policy-mutation (beg end) + "Refresh projections between BEG and END after a region policy mutation." + (if ekp-auto-justify-mode + (ekp-buffer--reflow-for-policy-change (current-buffer) t) + (ekp-buffer--clear-projection (min beg end) (max beg end)) + (unless ekp-buffer--spans + (ekp-buffer--remove-integrations)))) + (defun ekp-buffer--set-protection (beg end property enabled label announce) "Set PROPERTY to ENABLED from BEG to END and optionally ANNOUNCE LABEL." - (if enabled - (add-text-properties beg end (list property t)) - (remove-text-properties beg end (list property nil))) + (let ((ekp-buffer--inhibit t)) + (if enabled + (add-text-properties beg end (list property t)) + (remove-text-properties beg end (list property nil)))) + (ekp-buffer--after-region-policy-mutation beg end) (when announce (message "EKP: %s on %d characters; current buffer session only" label (- end beg)))) +(defun ekp-buffer--set-break-policy (beg end policy label announce) + "Set `ekp-break-policy' POLICY from BEG to END." + (let ((ekp-buffer--inhibit t)) + (if policy + (put-text-property beg end 'ekp-break-policy policy) + (remove-text-properties beg end '(ekp-break-policy nil)))) + (ekp-buffer--after-region-policy-mutation beg end) + (when announce + (message "EKP: %s on %d characters; current buffer session only" + label (- end beg)))) + +;;;###autoload +(defun ekp-normal-break-region (beg end &optional announce) + "Mark BEG through END as ordinary break policy; ANNOUNCE reports it." + (interactive (ekp-buffer--interactive-protection-args)) + (ekp-buffer--set-break-policy + beg end 'normal "Marked normal break policy" announce)) + +;;;###autoload +(defun ekp-enable-hyphenation-region (beg end &optional announce) + "Enable discretionary hyphenation in BEG through END; ANNOUNCE reports it." + (interactive (ekp-buffer--interactive-protection-args)) + (ekp-buffer--set-break-policy + beg end 'hyphenate "Enabled hyphenation" announce)) + +;;;###autoload +(defun ekp-disable-hyphenation-region (beg end &optional announce) + "Disable discretionary hyphenation in BEG through END; ANNOUNCE reports it." + (interactive (ekp-buffer--interactive-protection-args)) + (ekp-buffer--set-break-policy + beg end 'no-hyphen "Disabled hyphenation" announce)) + +;;;###autoload +(defun ekp-clear-break-policy-region (beg end &optional announce) + "Clear `ekp-break-policy' from BEG through END; ANNOUNCE reports it." + (interactive (ekp-buffer--interactive-protection-args)) + (ekp-buffer--set-break-policy + beg end nil "Cleared break policy" announce)) + ;;;###autoload (defun ekp-no-break-region (beg end &optional announce) "Mark BEG through END as an unbreakable session-local atom. @@ -990,10 +1317,12 @@ LINE-END lets insertion at the hard-line end belong to its last span." (defun ekp-buffer--live-marker-snapshot (base) "Return live marker offsets relative to BASE." - (mapcar + (delq nil + (mapcar (lambda (marker) - (cons marker (- (marker-position marker) base))) - (ekp-buffer--live-state-owned-markers))) + (when-let* ((position (marker-position marker))) + (cons marker (- position base)))) + (ekp-buffer--live-state-owned-markers)))) (defun ekp-buffer--start-live-edit (beg end bounds) "Start a stable edit transaction for BEG through END in BOUNDS." @@ -1098,21 +1427,26 @@ LINE-END lets insertion at the hard-line end belong to its last span." (buffer-substring dirty-beg dirty-end) (substring source finish)))) -(defun ekp-buffer--live-context (width) - "Return non-text layout context for a live plan at WIDTH." - (list (ekp--dp-key width) - (copy-tree (ekp--width-context)) - (mapcar (lambda (attribute) - (face-attribute 'default attribute nil t)) - '(:family :height :width :weight :slant)) - ekp-latin-lang - ekp-alignment - ekp-ragged-stretch-pixel - (and ekp-protrusion (copy-tree ekp-protrusion-ratios)) - (copy-tree ekp-parshape) - ekp-first-line-indent - ekp-cjk-no-line-start-extra - (ekp--spacing-signature))) +(defun ekp-buffer--live-context (width &optional context) + "Return non-text layout context for a live plan at WIDTH. +Optional CONTEXT supplies a precomputed policy context." + (let ((context (or context (ekp-buffer--policy-context width)))) + (ekp-buffer--with-policy-context context + (ekp--copy-layout-context-value + (list (ekp--dp-key width) + (ekp--width-context) + (mapcar (lambda (attribute) + (face-attribute 'default attribute nil t)) + '(:family :height :width :weight :slant)) + ekp-latin-lang + ekp-alignment + ekp-ragged-stretch-pixel + (and ekp-protrusion ekp-protrusion-ratios) + ekp-parshape + ekp-first-line-indent + context + (ekp--policy-signature) + (ekp--spacing-signature)))))) (defun ekp-buffer--live-key-equal-p (left right) "Return non-nil when live cache keys LEFT and RIGHT are equivalent." @@ -1151,16 +1485,26 @@ LINE-END lets insertion at the hard-line end belong to its last span." ekp-buffer--live-state)))) (when (and old-key old-plan (equal (cadr key) (cadr old-key))) - (ekp-layout-plan-append old-plan text width)))) + (let* ((context (ekp-buffer--policy-context width)) + (planning-text (ekp-buffer--planning-text text context)) + (plan (ekp-buffer--with-policy-context context + (ekp-layout-plan-append + old-plan planning-text width)))) + (when plan + (setf (ekp-layout-plan-string plan) text)) + plan)))) (defun ekp-buffer--live-plan-entry (text width) "Return the cache entry for TEXT at WIDTH." - (let ((key (list text (ekp-buffer--live-context width)))) + (let* ((context (ekp-buffer--policy-context width)) + (key (list (copy-sequence text) + (ekp-buffer--live-context width context)))) (cons key (or (ekp-buffer--live-cache-get key) (ekp-buffer--live-cache-put key (or (ekp-buffer--live-append-plan key text width) - (ekp-layout-plan text width))))))) + (ekp-buffer--layout-plan + text width context))))))) (defun ekp-buffer--single-line-live-p (text width) "Return non-nil if TEXT is conservatively known to fit WIDTH." @@ -1401,34 +1745,40 @@ When COMPLETE is non-nil, project every semantic line." (beg end width text boundary complete) "Publish TEXT's stable prefix from BEG to END at WIDTH. BOUNDARY identifies the native row left natural unless COMPLETE is non-nil." - (cond - ((or (>= beg end) (ekp-buffer--skip-paragraph-p text)) - (ekp-buffer--commit-natural-live-state beg end width text)) - ((> (- end beg) ekp-auto-justify-paragraph-limit) - (ekp-buffer--record-conflict - beg end "paragraph exceeds the automatic paragraph limit") - (ekp-buffer--commit-natural-live-state beg end width text)) - ((and (not complete) - (ekp-buffer--single-line-live-p text width)) - (ekp-buffer--commit-natural-live-state beg end width text)) - ((ekp-buffer--unsupported-live-text-p text) - (ekp-buffer--record-conflict - beg end "unsupported whitespace shrink") - (ekp-buffer--commit-natural-live-state beg end width text)) - ((ekp-buffer--foreign-property beg end) - (ekp-buffer--record-conflict beg end "foreign property in live line") - (ekp-buffer--commit-natural-live-state beg end width text)) - (t - (let* ((entry (ekp-buffer--live-plan-entry text width)) - (key (car entry)) - (plan (cdr entry))) - (if (ekp-buffer--unsupported-gap plan beg) - (progn - (ekp-buffer--record-conflict - beg end "unsupported live whitespace shrink") - (ekp-buffer--commit-natural-live-state beg end width text)) - (ekp-buffer--project-live-plan - key plan beg end width boundary complete)))))) + (let ((context (ekp-buffer--policy-context width))) + (cond + ((or (>= beg end) (ekp-buffer--skip-paragraph-p text context)) + (ekp-buffer--commit-natural-live-state beg end width text)) + ((> (- end beg) ekp-auto-justify-paragraph-limit) + (ekp-buffer--record-conflict + beg end "paragraph exceeds the automatic paragraph limit") + (ekp-buffer--commit-natural-live-state beg end width text)) + ((and (not complete) + (ekp-buffer--single-line-live-p text width)) + (ekp-buffer--commit-natural-live-state beg end width text)) + ((ekp-buffer--unsupported-live-text-p text) + (ekp-buffer--record-conflict + beg end "unsupported whitespace shrink") + (ekp-buffer--commit-natural-live-state beg end width text)) + ((ekp-buffer--foreign-property beg end) + (ekp-buffer--record-conflict beg end "foreign property in live line") + (ekp-buffer--commit-natural-live-state beg end width text)) + (t + (let* ((entry (ekp-buffer--live-plan-entry text width)) + (key (car entry)) + (plan (cdr entry))) + (cond + ((eq (ekp-layout-plan-state plan) 'natural) + (ekp-buffer--record-conflict beg end "overlong-token-natural") + (ekp-buffer--commit-natural-live-state beg end width text)) + ((ekp-buffer--unsupported-gap plan beg) + (progn + (ekp-buffer--record-conflict + beg end "unsupported live whitespace shrink") + (ekp-buffer--commit-natural-live-state beg end width text))) + (t + (ekp-buffer--project-live-plan + key plan beg end width boundary complete)))))))) (defun ekp-buffer--publish-live-prefix (&optional boundary complete) "Publish one stable live plan through BOUNDARY. @@ -1844,6 +2194,8 @@ ACTIVE-BEG through ACTIVE-END remains owned by the refreshed live state." (point-min) (point-max) width active-beg active-end) (ekp-buffer--lazy-reflow width active-beg active-end))))) + (setq ekp-buffer--policy-context-snapshot + (copy-tree (ekp-buffer--policy-context))) (ekp-buffer--refresh-live-prefix boundary complete)))))) (defun ekp-buffer--run-scheduled-reflow (buffer) @@ -1868,6 +2220,83 @@ ACTIVE-BEG through ACTIVE-END remains owned by the refreshed live state." #'ekp-buffer--run-scheduled-reflow (current-buffer))))))) +(defun ekp-buffer--reflow-for-policy-change (buffer &optional force) + "Bump BUFFER generation and reflow once after a policy change. +When FORCE is non-nil, reflow even if the global policy context is +unchanged; region text properties are paragraph policy too." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when ekp-auto-justify-mode + (when (timerp ekp-buffer--policy-reflow-timer) + (cancel-timer ekp-buffer--policy-reflow-timer)) + (let ((before-context ekp-buffer--policy-reflow-context) + (after-context (ekp-buffer--policy-context))) + (setq-local ekp-buffer--policy-reflow-timer nil) + (setq-local ekp-buffer--policy-reflow-context nil) + (if (and (not force) (equal before-context after-context)) + (setq-local ekp-buffer--policy-context-snapshot + (copy-tree after-context)) + (let ((point-before (point)) + (mark-before (and (mark t) (copy-marker (mark t)))) + (mark-active-before mark-active) + (modified-before (buffer-modified-p)) + (undo-before buffer-undo-list)) + (unwind-protect + (progn + (cl-incf ekp-buffer--generation) + (setq ekp-buffer--live-plan-cache nil) + (ekp-buffer--reflow + buffer (ekp-buffer--effective-width buffer)) + (goto-char (min point-before (point-max))) + (when mark-before + (set-marker (mark-marker) + (marker-position mark-before))) + (setq mark-active mark-active-before) + (set-buffer-modified-p modified-before) + (setq buffer-undo-list undo-before)) + (when mark-before (set-marker mark-before nil)))))))))) + +(defun ekp-buffer--schedule-policy-reflow (buffer before-context) + "Schedule one post-set policy reflow for BUFFER from BEFORE-CONTEXT." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when ekp-auto-justify-mode + (unless (timerp ekp-buffer--policy-reflow-timer) + (setq-local ekp-buffer--policy-reflow-context + (copy-tree before-context))) + (when (timerp ekp-buffer--policy-reflow-timer) + (cancel-timer ekp-buffer--policy-reflow-timer)) + (setq-local + ekp-buffer--policy-reflow-timer + (run-with-timer + 0 nil #'ekp-buffer--reflow-for-policy-change buffer)))))) + +(defun ekp-buffer--watched-raw-noop-p (symbol new-value where) + "Return non-nil when setting SYMBOL to NEW-VALUE in WHERE is a raw no-op." + (if (bufferp where) + nil + (equal (default-value symbol) new-value))) + +(defun ekp-buffer--policy-variable-changed (symbol new-value operation where) + "Schedule reflow after SYMBOL is set to NEW-VALUE by OPERATION in WHERE." + (when (memq operation '(set makunbound)) + (unless (ekp-buffer--watched-raw-noop-p symbol new-value where) + (if (bufferp where) + (with-current-buffer where + (ekp-buffer--schedule-policy-reflow + where (or ekp-buffer--policy-context-snapshot + (ekp-buffer--policy-context)))) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (ekp-buffer--schedule-policy-reflow + buffer (or ekp-buffer--policy-context-snapshot + (ekp-buffer--policy-context))))))))) + +(dolist (variable ekp-buffer--policy-variables) + (unless (memq #'ekp-buffer--policy-variable-changed + (get-variable-watchers variable)) + (add-variable-watcher variable #'ekp-buffer--policy-variable-changed))) + (defun ekp-buffer--on-resize (window-or-frame) "Schedule reflow for the buffer shown by WINDOW-OR-FRAME." (let ((window (cond @@ -1947,9 +2376,9 @@ ACTIVE-BEG through ACTIVE-END remains owned by the refreshed live state." (ekp-buffer--release-live-state) (pcase-let ((`(,beg . ,end) (ekp-buffer--para-bounds (cons (point) (point))))) - (ekp-justify-region - beg end (or ekp-buffer--auto-width - (ekp-buffer--window-pixel))))) + (ekp-justify-region + beg end (or ekp-buffer--auto-width + (ekp-buffer--effective-width))))) (defvar-keymap ekp-auto-justify-mode-map :doc "Keymap for `ekp-auto-justify-mode'." @@ -1963,6 +2392,11 @@ ACTIVE-BEG through ACTIVE-END remains owned by the refreshed live state." ["Justify Buffer" ekp-justify-buffer t] ["Unjustify Buffer" ekp-unjustify-buffer t] "--" + ["Mark Region Normal Break" ekp-normal-break-region (use-region-p)] + ["Enable Region Hyphenation" ekp-enable-hyphenation-region (use-region-p)] + ["Disable Region Hyphenation" ekp-disable-hyphenation-region (use-region-p)] + ["Clear Region Break Policy" ekp-clear-break-policy-region (use-region-p)] + "--" ["Mark Region No-Break" ekp-no-break-region (use-region-p)] ["Clear No-Break Region" ekp-allow-break-region (use-region-p)] ["Mark Region Verbatim" ekp-verbatim-region (use-region-p)] @@ -1993,10 +2427,6 @@ ACTIVE-BEG through ACTIVE-END remains owned by the refreshed live state." (let (enabled) (unwind-protect (progn - (unless (or ekp-buffer-skip-faces ekp-buffer-skip-predicate) - (cond - ((derived-mode-p 'org-mode) (ekp-org-setup)) - ((derived-mode-p 'markdown-mode) (ekp-markdown-setup)))) (ekp-buffer--enable-native-wrap) (setq ekp-buffer--auto-width (ekp-buffer--effective-width)) (ekp-buffer--reflow (current-buffer) ekp-buffer--auto-width) @@ -2010,7 +2440,8 @@ ACTIVE-BEG through ACTIVE-END remains owned by the refreshed live state." ;;;###autoload (define-minor-mode ekp-auto-justify-mode "Maintain a non-mutating KP display projection. -Completed paragraphs use the authoritative narrowest-window width. +Completed paragraphs use the effective `ekp-buffer-measure': narrowest +window by default, a fixed width, or a `(max . N)' cap. Manual no-break and verbatim properties last only for the current buffer session." :lighter " EKP" @@ -2025,11 +2456,16 @@ session." (cancel-timer ekp-buffer--resize-timer)) (when (timerp ekp-buffer--composition-timer) (cancel-timer ekp-buffer--composition-timer)) + (when (timerp ekp-buffer--policy-reflow-timer) + (cancel-timer ekp-buffer--policy-reflow-timer)) (ekp-buffer--cancel-pending) (ekp-buffer--release-live-edit) (ekp-buffer--release-live-state) (setq ekp-buffer--resize-timer nil ekp-buffer--composition-timer nil + ekp-buffer--policy-reflow-timer nil + ekp-buffer--policy-reflow-context nil + ekp-buffer--policy-context-snapshot nil ekp-buffer--auto-width nil ekp-buffer--live-plan-cache nil) (ekp-buffer--clear-all) @@ -2042,12 +2478,27 @@ session." (defun ekp-diagnose () "Report the authoritative width and any skipped projection conflicts." (interactive) - (let ((width (ekp-buffer--effective-width)) - (conflicts (length ekp-buffer--conflicts))) + (let* ((measure (ekp-buffer--measure-report)) + (width (plist-get measure :effective)) + (conflicts (length ekp-buffer--conflicts)) + (policy (ekp-buffer--policy-context width))) (message - "EKP: authoritative width %dpx (narrowest window), %d conflict%s" - width conflicts (if (= conflicts 1) "" "s")) - (list :width width :conflicts ekp-buffer--conflicts))) + (concat "EKP: requested %S, narrowest %d, effective %d, " + "overflow risk %s, %d conflict%s; " + "inline-code %S, hyphenation %S, kinsoku %S, overlong %S") + (plist-get measure :requested) + (plist-get measure :narrowest) + width + (if (plist-get measure :overflow-risk) "yes" "no") + conflicts (if (= conflicts 1) "" "s") + (plist-get policy :inline-code-policy) + (plist-get policy :hyphenation) + (plist-get policy :kinsoku-profile) + (plist-get policy :overlong-token-policy)) + (append measure + (list :width width + :policy policy + :conflicts ekp-buffer--conflicts)))) (provide 'ekp-buffer) diff --git a/ekp-utils.el b/ekp-utils.el index eed810d..c15d6ab 100644 --- a/ekp-utils.el +++ b/ekp-utils.el @@ -202,7 +202,10 @@ Rules: (setq boxes (cons spaces boxes))) ;; Inside a no-break span: spacing is literal, glue would ;; stretch — preserve the run as a rigid space box. - ((text-property-not-all 0 (length spaces) 'ekp-no-break nil spaces) + ((or (text-property-not-all + 0 (length spaces) 'ekp-no-break nil spaces) + (text-property-not-all + 0 (length spaces) 'ekp--literal-spacing nil spaces)) (setq boxes (cons spaces boxes))) ;; Latin-Latin with multiple spaces: preserve all but last ((> (length spaces) 1) diff --git a/ekp.el b/ekp.el index fc5bb0e..5a07f91 100644 --- a/ekp.el +++ b/ekp.el @@ -38,6 +38,7 @@ ;;; Code: (require 'cl-lib) +(require 'seq) (require 'ekp-utils) (require 'ekp-hyphen) @@ -55,6 +56,80 @@ :prefix "ekp-" :link '(url-link "https://github.com/Kinneyzhang/emacs-kp")) +(defcustom ekp-inline-code-policy 'no-hyphen + "Default break policy for automatic inline code spans. +`normal' uses ordinary breaks and hyphenation. `no-hyphen' keeps +ordinary legal breaks but suppresses discretionary dictionary +hyphens. `no-break' makes fitting automatic spans rigid; overwide +automatic spans downgrade to `no-hyphen'. This option does not +affect explicit `ekp-no-break' regions." + :type '(choice (const normal) (const no-hyphen) (const no-break)) + :safe #'ekp--safe-break-policy-value-p + :group 'ekp) + +(defcustom ekp-hyphenation 'auto + "Global discretionary hyphenation policy. +`auto' and `on' use the configured dictionary when available; +missing dictionaries disable hyphenation without signaling. +`off' disables discretionary hyphenation." + :type '(choice (const auto) (const on) (const off)) + :safe #'ekp--safe-hyphenation-value-p + :group 'ekp) + +(defcustom ekp-token-break-policies + '((url . no-hyphen) + (path . no-hyphen) + (identifier . no-hyphen) + (number-unit . no-break)) + "Break policies for bounded automatic token classifiers." + :type '(alist :key-type (choice (const url) (const path) + (const identifier) (const number-unit)) + :value-type (choice (const normal) (const no-hyphen) + (const no-break))) + :safe #'ekp--safe-token-break-policies-p + :group 'ekp) + +(defcustom ekp-number-unit-suffixes + '("%" "‰" "°C" "°F" "px" "pt" "pc" "em" "rem" "ms" "s" "min" "h" + "Hz" "kHz" "MHz" "GHz" "B" "KB" "MB" "GB" "TB" "KiB" "MiB" + "GiB" "TiB" "μm" "mm" "cm" "m" "km" "mg" "g" "kg") + "Exact suffixes recognized by the compact number-unit classifier." + :type '(repeat string) + :safe (lambda (value) + (and (proper-list-p value) (seq-every-p #'stringp value))) + :group 'ekp) + +(defcustom ekp-kinsoku-profile 'common + "Kinsoku profile used when compiling paragraph break permissions." + :type '(choice (const common) (const zh) (const ja) + (const off) (const custom)) + :safe (lambda (value) (memq value '(common zh ja off custom))) + :group 'ekp) + +(defcustom ekp-overlong-token-policy 'emergency + "Policy for ordinary non-CJK tokens wider than the measure." + :type '(choice (const emergency) (const overflow) (const natural)) + :safe (lambda (value) (memq value '(emergency overflow natural))) + :group 'ekp) + +(defun ekp--safe-break-policy-value-p (value) + "Return non-nil when VALUE is a documented break-policy value." + (memq value '(normal no-hyphen no-break))) + +(defun ekp--safe-hyphenation-value-p (value) + "Return non-nil when VALUE is a documented hyphenation value." + (memq value '(auto on off))) + +(defun ekp--safe-token-break-policies-p (value) + "Return non-nil when VALUE is a safe token-policy alist." + (and (proper-list-p value) + (seq-every-p + (lambda (entry) + (and (consp entry) + (memq (car entry) '(url path identifier number-unit)) + (ekp--safe-break-policy-value-p (cdr entry)))) + value))) + (defcustom ekp-latin-lang "en_US" "Language code for hyphenation (e.g., \"en_US\", \"de_DE\")." :type 'string @@ -152,6 +227,20 @@ stretch). nil derives 8× the Latin word-space ideal (≈2 em)." :type '(choice (const :tag "Auto (≈2 em)" nil) natnum) :group 'ekp) +(defun ekp--safe-emergency-stretch-pixel-p (value) + "Return non-nil when VALUE is a safe emergency-stretch setting." + (or (null value) (and (integerp value) (>= value 0)))) + +(defcustom ekp-emergency-stretch-pixel nil + "Fixed final-pass emergency stretch budget in pixels. +nil derives a display-context-local value from the current font metrics. +The value is a paragraph setting, not a fraction of the candidate line +width; the strict DP pass uses zero and the final pass uses this fixed +budget with ordinary badness, fitness, and demerits." + :type '(choice (const :tag "Auto (3 em)" nil) natnum) + :safe #'ekp--safe-emergency-stretch-pixel-p + :group 'ekp) + (defcustom ekp-protrusion nil "Non-nil enables right-edge character protrusion (hanging punctuation). A line ending in punctuation lets part of that glyph hang past the @@ -244,10 +333,17 @@ when non-zero the C module is bypassed automatically." ;; Natural pixel width of each source gap (indexed by right box). ;; Width-independent projection geometry is measured once per paragraph. (gap-naturals-memo nil) + ;; Structural policy intervals compiled into hyphenation and breaks. + (resolved-policies nil) ;; Glue params snapshot at para creation time (plist) glue-params + (layout-plan-cache nil :type hash-table) (dp-cache nil :type hash-table)) +(cl-defstruct (ekp--policy-interval (:constructor ekp--policy-interval-create)) + "Resolved private policy interval before DP compilation." + start end break-policy hyphenation literal-spacing provenance category) + (cl-defstruct (ekp-layout-gap (:constructor ekp-layout-gap--create)) "One planned glue between two source boxes." kind left-box right-box source-start source-end natural-pixel target-pixel) @@ -260,11 +356,72 @@ when non-zero the C module is bypassed automatically." (cl-defstruct (ekp-layout-plan (:constructor ekp-layout-plan--create)) "Semantic KP layout independent of any output representation." - string line-pixel context para boxes offsets lines) + string line-pixel context para boxes offsets lines + (state 'planned) reason) + +(define-error 'ekp-backend-contract-error + "Malformed C backend result") + +(defun ekp--copy-layout-context-value (value) + "Return a consumer-owned copy of layout context VALUE." + (cond + ((stringp value) + (copy-sequence value)) + ((vectorp value) + (let ((copy (copy-sequence value))) + (dotimes (i (length copy)) + (aset copy i (ekp--copy-layout-context-value (aref copy i)))) + copy)) + ((consp value) + (cons (ekp--copy-layout-context-value (car value)) + (ekp--copy-layout-context-value (cdr value)))) + (t value))) + +(defun ekp--copy-layout-line (line) + "Return a consumer-owned copy of LINE and its mutable children." + (let ((copy (copy-ekp-layout-line line))) + (setf (ekp-layout-line-glues copy) + (copy-sequence (ekp-layout-line-glues line))) + (setf (ekp-layout-line-gaps copy) + (vconcat (mapcar #'copy-ekp-layout-gap + (append (ekp-layout-line-gaps line) nil)))) + (setf (ekp-layout-line-signature copy) + (copy-tree (ekp-layout-line-signature line))) + copy)) + +(defun ekp--copy-layout-plan-for-consumer (plan) + "Return a consumer-owned copy of cached PLAN. +`ekp-layout-plan-para' is intentionally shared: paragraph-cache +ownership predates this semantic-plan cache, and append planning +relies on that stable paragraph identity. The plan and its mutable +plan-owned payloads are copied at this boundary." + (let ((copy (copy-ekp-layout-plan plan))) + (setf (ekp-layout-plan-string copy) + (copy-sequence (ekp-layout-plan-string plan))) + (setf (ekp-layout-plan-context copy) + (ekp--copy-layout-context-value + (ekp-layout-plan-context plan))) + (setf (ekp-layout-plan-boxes copy) + (vconcat (mapcar #'copy-sequence + (append (ekp-layout-plan-boxes plan) nil)))) + (setf (ekp-layout-plan-offsets copy) + (vconcat (mapcar (lambda (offset) + (cons (car offset) (cdr offset))) + (append (ekp-layout-plan-offsets plan) nil)))) + (setf (ekp-layout-plan-lines copy) + (vconcat (mapcar #'ekp--copy-layout-line + (append (ekp-layout-plan-lines plan) nil)))) + copy)) (defvar ekp--para-cache nil "Cache: equal-keyed table, content key → ekp-para struct.") +(defvar ekp--policy-analysis-cache nil + "Cache: base paragraph policy identity → width-tiered policy analysis.") + +(defvar ekp--policy-analysis-sensitive-p nil + "Non-nil when the most recent policy analysis depends on measure.") + (defvar ekp--last-para nil "Fast path for the most recently resolved paragraph. The value is (STRING KEY PARA), where KEY is the same complete @@ -391,11 +548,21 @@ Returns (boxes-vector . hyphen-positions-vector)." (hyphenator 'unset) (idx 0) new-boxes hyphen-idxs) (dolist (box (append boxes nil)) - (let ((parts nil)) - (when (and (string-match word-re box) + (let ((parts nil) + (hyphenated-p nil)) + (cond + ((and (text-property-not-all 0 (length box) 'ekp--no-hyphen nil box) + (setq parts (ekp--split-no-hyphen-box box))) + nil) + ((and (string-match word-re box) ;; Never hyphenate inside a no-break span (null (text-property-not-all 0 (length box) - 'ekp-no-break nil box))) + 'ekp-no-break nil box)) + (null (text-property-not-all 0 (length box) + 'ekp--no-hyphen nil box)) + (or (memq ekp-hyphenation '(auto on)) + (text-property-not-all + 0 (length box) 'ekp--hyphenation nil box))) ;; Extract the groups BEFORE resolving the hyphenator: ;; dictionary compilation runs regexps of its own and ;; clobbers the match data. @@ -408,18 +575,20 @@ Returns (boxes-vector . hyphen-positions-vector)." (ekp-hyphen-create ekp-latin-lang) (ekp-hyphen-dictionary-not-found nil)))) (when hyphenator + (setq hyphenated-p t) (setq parts (ekp-hyphen-boxes hyphenator word)) (when (> (length left) 0) (setcar parts (concat left (car parts)))) (when (> (length right) 0) (setcar (last parts) - (concat (car (last parts)) right)))))) + (concat (car (last parts)) right))))))) (if parts ;; Latin word: hyphenated into syllable boxes (let ((n (length parts))) (push parts new-boxes) (dotimes (i n) - (when (< i (1- n)) (push idx hyphen-idxs)) + (when (and hyphenated-p (< i (1- n))) + (push idx hyphen-idxs)) (cl-incf idx))) ;; Non-Latin box, or hyphenation unavailable (push (list box) new-boxes) @@ -510,6 +679,516 @@ the deprecated ZWNBSP. The zero-width ones attach to the preceding box; the visible ones are boxes of their own whose adjacent gaps are unbreakable and glue-free (the character supplies its own spacing).") +(defconst ekp--private-policy-properties + '(ekp--break-policy ekp--hyphenation ekp--literal-spacing + ekp--policy-provenance ekp--automatic-no-break ekp--resolved-policy + ekp--no-hyphen ekp--token-category ekp--downgraded-no-break + ekp--face-break-policy) + "Implementation-private properties used only during analysis.") + +(defvar ekp--policy-measure nil + "Current measure available to width-dependent policy compilation.") + +(defvar ekp-cjk-no-line-start-extra) +(defvar ekp-cjk-no-line-end-extra) + +(defun ekp--policy-signature () + "Return public policy inputs that affect paragraph construction." + (ekp--copy-layout-context-value + (list ekp-inline-code-policy ekp-hyphenation + ekp-token-break-policies ekp-number-unit-suffixes + ekp-kinsoku-profile ekp-cjk-no-line-start-extra + ekp-cjk-no-line-end-extra ekp-overlong-token-policy))) + +(defun ekp--strip-private-policy-properties (string) + "Remove implementation-private policy properties from STRING." + (remove-text-properties + 0 (length string) + (apply #'append (mapcar (lambda (prop) (list prop nil)) + ekp--private-policy-properties)) + string) + string) + +(defun ekp--private-policy-properties-p (string) + "Return non-nil when STRING carries implementation-private policy properties." + (catch 'found + (dolist (interval (object-intervals string)) + (let ((properties (nth 2 interval))) + (dolist (property ekp--private-policy-properties) + (when (plist-member properties property) + (throw 'found t))))) + nil)) + +(defun ekp--clean-private-policy-source (string) + "Return STRING without private policy properties, copying only when needed." + (if (ekp--private-policy-properties-p string) + (ekp--strip-private-policy-properties (copy-sequence string)) + string)) + +(defun ekp--latin-like-token-p (token) + "Return non-nil when TOKEN is a bounded non-whitespace Latin-like token." + (and (> (length token) 0) + (not (string-match-p "\\s-" token)) + (seq-every-p (lambda (char) (<= (char-width char) 1)) token))) + +(defun ekp--number-unit-token-p (token) + "Return non-nil when TOKEN is compact number plus configured unit." + (and (> (length token) 1) + (<= ?0 (aref token 0) ?9) + (seq-some + (lambda (unit) + (and (string-suffix-p unit token) + (string-match-p + "\\`[0-9]+\\(?:[.,][0-9]+\\)?\\'" + (substring token 0 (- (length token) (length unit)))))) + ekp-number-unit-suffixes))) + +(defun ekp--identifier-char-p (char) + "Return non-nil when CHAR is a bounded identifier constituent." + (or (and (<= ?A char) (<= char ?Z)) + (and (<= ?a char) (<= char ?z)) + (and (<= ?0 char) (<= char ?9)))) + +(defun ekp--identifier-start-char-p (char) + "Return non-nil when CHAR may start an automatic identifier token." + (or (and (<= ?A char) (<= char ?Z)) + (and (<= ?a char) (<= char ?z)))) + +(defun ekp--identifier-separator-end (token index) + "Return separator end index in TOKEN at INDEX, or nil." + (pcase (aref token index) + ((or ?_ ?.) (1+ index)) + (?: (and (< (1+ index) (length token)) + (= (aref token (1+ index)) ?:) (+ index 2))) + (?- (and (< (1+ index) (length token)) + (= (aref token (1+ index)) ?>) (+ index 2))))) + +(defun ekp--identifier-break-indexes (token) + "Return legal identifier break indexes for TOKEN, or nil if invalid." + (let ((i 0) breaks valid) + (when (and (> (length token) 1) + (ekp--identifier-start-char-p (aref token 0)) + (ekp--identifier-char-p (aref token (1- (length token))))) + (setq valid t) + (while (and valid (< i (length token))) + (let ((char (aref token i))) + (cond + ((ekp--identifier-char-p char) + (when (and (> i 0) + (let ((prev (aref token (1- i)))) + (or (and (<= ?a prev ?z) (<= ?A char ?Z)) + (and (or (<= ?A prev ?Z) (<= ?a prev ?z)) + (<= ?0 char ?9))))) + (push i breaks)) + (setq i (1+ i))) + ((let ((end (ekp--identifier-separator-end token i))) + (if (and end (> i 0) (< end (length token)) + (ekp--identifier-char-p (aref token (1- i))) + (ekp--identifier-char-p (aref token end))) + (setq breaks (cons end breaks) i end) + (setq valid nil))))))) + (and valid breaks (nreverse breaks))))) + +(defun ekp--identifier-token-p (token) + "Return non-nil when TOKEN matches the bounded identifier grammar." + (not (null (ekp--identifier-break-indexes token)))) + +(defun ekp--classify-token (token) + "Return TOKEN's automatic category, or nil." + (when (ekp--latin-like-token-p token) + (cond + ((or (string-prefix-p "www." token) + (string-match-p "\\`[[:alpha:]][[:alnum:].+-]*://" token)) + 'url) + ((or (string-match-p ".+/.+" token) + (string-match-p ".+\\\\.+" token)) 'path) + ((ekp--number-unit-token-p token) 'number-unit) + ((ekp--identifier-token-p token) 'identifier)))) + +(defun ekp--token-policy (category) + "Return configured policy for token CATEGORY." + (or (cdr (assq category ekp-token-break-policies)) 'normal)) + +(defun ekp--ordinary-overlong-token-p (string line-pixel) + "Return non-nil if STRING has an ordinary token over LINE-PIXEL." + (let ((pos 0) found) + (while (and (not found) (string-match "\\S-+" string pos)) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (token (match-string 0 string))) + (setq found + (and (ekp--latin-like-token-p token) + (not (text-property-not-all + start end 'ekp-no-break nil string)) + (> (ekp--measured-width (substring string start end)) + line-pixel)))) + (setq pos (match-end 0))) + found)) + +(defun ekp--natural-overlong-token-p (string line-pixel) + "Return non-nil when STRING should bypass KP at LINE-PIXEL." + (and (eq ekp-overlong-token-policy 'natural) + (ekp--ordinary-overlong-token-p string line-pixel))) + +(defun ekp--put-analysis-policy (string start end policy provenance) + "Attach POLICY with PROVENANCE to STRING from START to END." + (put-text-property start end 'ekp--break-policy policy string) + (put-text-property start end 'ekp--policy-provenance provenance string) + (pcase policy + ('no-hyphen (put-text-property start end 'ekp--no-hyphen t string)) + ('no-break (put-text-property start end 'ekp--automatic-no-break t string)))) + +(defun ekp--clear-automatic-policy-properties (string start end) + "Clear automatic private policy markers in STRING from START to END." + (remove-text-properties + start end + '(ekp--break-policy nil ekp--hyphenation nil ekp--literal-spacing nil + ekp--policy-provenance nil ekp--automatic-no-break nil + ekp--resolved-policy nil ekp--no-hyphen nil ekp--token-category nil + ekp--downgraded-no-break nil) + string)) + +(defun ekp--break-policy-rank (policy) + "Return restrictiveness rank for POLICY." + (pcase policy + ('no-break 3) + ('no-hyphen 2) + ('normal 1) + (_ 0))) + +(defun ekp--stricter-break-policy (left right) + "Return the stricter automatic policy from LEFT and RIGHT." + (if (> (ekp--break-policy-rank right) + (ekp--break-policy-rank left)) + right + left)) + +(defun ekp--token-width-if-needed (string start end token policy) + "Return TOKEN width in STRING from START to END when needed." + (when (and ekp--policy-measure + (ekp--latin-like-token-p token) + (not (text-property-not-all start end 'ekp-no-break nil string)) + (or (eq ekp-overlong-token-policy 'overflow) + (eq policy 'no-break))) + (ekp--measured-width (substring string start end)))) + +(defun ekp--token-policy-specs (string) + "Return automatic policy specs for STRING from a single token scan." + (let ((pos 0) specs no-break-token-p latin-token-p) + (while (string-match "\\S-+" string pos) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (token (match-string 0 string)) + (latin-p (and (ekp--latin-like-token-p token) + (not (text-property-not-all + start end 'ekp-no-break nil string)))) + (category (ekp--classify-token token)) + (policy (and category (ekp--token-policy category))) + (width (ekp--token-width-if-needed + string start end token policy)) + (overwide (and width (> width ekp--policy-measure))) + downgraded) + (when latin-p + (setq latin-token-p t)) + (when (eq policy 'no-break) + (setq no-break-token-p t)) + (when (and (eq ekp-overlong-token-policy 'overflow) overwide) + (setq policy 'no-break)) + (when (and policy (not (eq policy 'normal))) + (when (and (eq policy 'no-break) + (not (eq ekp-overlong-token-policy 'overflow)) + overwide) + (setq policy 'no-hyphen) + (setq downgraded t)) + (push (list start end policy category downgraded) specs))) + (setq pos (match-end 0))) + (list (nreverse specs) no-break-token-p latin-token-p))) + +(defun ekp--apply-token-spec (string spec) + "Apply automatic token SPEC to STRING and return its interval." + (pcase-let ((`(,start ,end ,policy ,category ,downgraded) spec)) + (ekp--put-analysis-policy string start end policy 'token) + (put-text-property start end 'ekp--token-category category string) + (when downgraded + (put-text-property start end 'ekp--downgraded-no-break t string)) + (ekp--policy-interval-create + :start start :end end :break-policy policy + :hyphenation (if (eq policy 'no-hyphen) 'off nil) + :literal-spacing nil :provenance 'token :category category))) + +(defun ekp--face-policy-ranges (string) + "Return automatic inline-face policy ranges in STRING." + (let ((pos 0) + (length (length string)) + raw-no-break-p + ranges) + (while (< pos length) + (let* ((end (or (next-single-property-change + pos 'ekp--face-break-policy string length) + length)) + (policy (get-text-property + pos 'ekp--face-break-policy string))) + (when (eq policy 'no-break) + (setq raw-no-break-p t)) + (when (and (eq policy 'no-break) ekp--policy-measure + (> (ekp--measured-width + (ekp--clean-private-policy-source + (substring string pos end))) + ekp--policy-measure)) + (setq policy 'no-hyphen)) + (when (and (ekp--safe-break-policy-value-p policy) + (not (eq policy 'normal))) + (push (list pos end policy) ranges)) + (setq pos end))) + (list (nreverse ranges) raw-no-break-p))) + +(defun ekp--region-policy-ranges (string) + "Return explicit break-policy ranges in STRING." + (seq-filter + #'identity + (mapcar + (lambda (iv) + (let ((policy (plist-get (nth 2 iv) 'ekp-break-policy))) + (and (memq policy '(normal hyphenate no-hyphen)) + (list (nth 0 iv) (nth 1 iv) policy)))) + (object-intervals string)))) + +(defun ekp--policy-boundaries (length token-intervals face-ranges region-ranges) + "Return sorted boundaries for LENGTH. +TOKEN-INTERVALS, FACE-RANGES, and REGION-RANGES supply policy spans." + (let ((points (list 0 length))) + (dolist (interval token-intervals) + (push (ekp--policy-interval-start interval) points) + (push (ekp--policy-interval-end interval) points)) + (dolist (range (append face-ranges region-ranges)) + (push (nth 0 range) points) + (push (nth 1 range) points)) + (sort (delete-dups points) #'<))) + +(defun ekp--policy-at (position ranges) + "Return policy in RANGES active at POSITION." + (seq-some + (lambda (range) + (and (<= (nth 0 range) position) + (< position (nth 1 range)) + (nth 2 range))) + ranges)) + +(defun ekp--token-interval-at (position intervals) + "Return token interval from INTERVALS active at POSITION." + (seq-find + (lambda (interval) + (and (<= (ekp--policy-interval-start interval) position) + (< position (ekp--policy-interval-end interval)))) + intervals)) + +(defun ekp--downgraded-ranges (string) + "Return ranges in STRING carrying downgraded automatic no-break markers." + (seq-filter + #'identity + (mapcar + (lambda (iv) + (and (plist-get (nth 2 iv) 'ekp--downgraded-no-break) + (list (nth 0 iv) (nth 1 iv)))) + (object-intervals string)))) + +(defun ekp--range-active-p (position ranges) + "Return non-nil when POSITION is inside one of RANGES." + (seq-some + (lambda (range) + (and (<= (car range) position) (< position (cadr range)))) + ranges)) + +(defun ekp--apply-effective-policy + (string start end policy provenance category &optional downgraded) + "Apply resolved POLICY to STRING from START to END." + (ekp--put-analysis-policy string start end policy provenance) + (when (eq provenance 'face) + (put-text-property start end 'ekp--literal-spacing t string)) + (when category + (put-text-property start end 'ekp--token-category category string)) + (when downgraded + (put-text-property start end 'ekp--downgraded-no-break t string)) + (ekp--policy-interval-create + :start start :end end :break-policy policy + :hyphenation (if (eq policy 'no-hyphen) 'off nil) + :literal-spacing (eq provenance 'face) + :provenance provenance :category category)) + +(defun ekp--apply-merged-policies + (string token-intervals face-ranges region-ranges downgraded-ranges) + "Apply TOKEN-INTERVALS, FACE-RANGES, and REGION-RANGES to STRING." + (let ((boundaries (ekp--policy-boundaries + (length string) token-intervals + face-ranges region-ranges)) + intervals + region-intervals) + (cl-loop for start in boundaries + for end in (cdr boundaries) + when (< start end) + do + (let* ((region (ekp--policy-at start region-ranges)) + (token (ekp--token-interval-at start token-intervals)) + (token-policy + (and token + (ekp--policy-interval-break-policy token))) + (face (ekp--policy-at start face-ranges)) + (policy (or region + (ekp--stricter-break-policy + token-policy face))) + (provenance + (cond (region 'region) + ((and face + (>= (ekp--break-policy-rank face) + (ekp--break-policy-rank token-policy))) + 'face) + (token 'token))) + (category (and (not region) token + (ekp--policy-interval-category token))) + (downgraded + (and token + (ekp--range-active-p start downgraded-ranges)))) + (if region + (progn + (put-text-property + start end 'ekp--policy-provenance 'region string) + (pcase region + ('hyphenate + (put-text-property + start end 'ekp--hyphenation 'on string) + (push (ekp--policy-interval-create + :start start :end end + :break-policy region :hyphenation 'on + :literal-spacing nil + :provenance 'region :category nil) + region-intervals)) + ('normal + (push (ekp--policy-interval-create + :start start :end end + :break-policy region :hyphenation nil + :literal-spacing nil + :provenance 'region :category nil) + region-intervals)) + ('no-hyphen + (push (ekp--apply-effective-policy + string start end region 'region nil) + region-intervals)))) + (when (and policy (not (eq policy 'normal))) + (push (ekp--apply-effective-policy + string start end policy provenance category + downgraded) + intervals))))) + (append (nreverse intervals) (nreverse region-intervals)))) + +(defun ekp--analyze-policies (string) + "Return (ANALYSIS . INTERVALS) for STRING." + (let* ((token-data (ekp--token-policy-specs string)) + (face-data (ekp--face-policy-ranges string)) + (token-specs (nth 0 token-data)) + (face-ranges (nth 0 face-data)) + (region-ranges (ekp--region-policy-ranges string))) + (setq ekp--policy-analysis-sensitive-p + (or (nth 1 face-data) + (nth 1 token-data) + (and (eq ekp-overlong-token-policy 'overflow) + (nth 2 token-data)))) + (if (and (null token-specs) (null face-ranges) (null region-ranges)) + (cons string nil) + (let* ((analysis (copy-sequence string)) + (token-intervals (mapcar + (lambda (spec) + (ekp--apply-token-spec analysis spec)) + token-specs)) + (downgraded-ranges (ekp--downgraded-ranges analysis)) + (intervals (ekp--apply-merged-policies + (progn + (ekp--clear-automatic-policy-properties + analysis 0 (length analysis)) + analysis) + token-intervals face-ranges region-ranges + downgraded-ranges))) + (cons analysis intervals))))) + +(defun ekp--policy-analysis-base-key (string) + "Return measure-independent policy-analysis cache key for STRING." + (let ((source (ekp--clean-private-policy-source string)) + key-source copied) + (setq key-source source) + (dolist (iv (object-intervals string)) + (let ((plist (nth 2 iv))) + (when (plist-member plist 'ekp--face-break-policy) + (unless copied + (setq key-source (copy-sequence source) + copied t)) + (put-text-property + (nth 0 iv) (nth 1 iv) 'ekp--face-break-policy + (plist-get plist 'ekp--face-break-policy) key-source)))) + (list key-source + (prin1-to-string (ekp--key-intervals key-source)) + (ekp--policy-signature) + (ekp--width-context)))) + +(defun ekp--cached-policy-analysis (string) + "Return cached full policy analysis for STRING at current measure." + (let* ((base-key (ekp--policy-analysis-base-key string)) + (entry (and ekp--policy-analysis-cache + (gethash base-key ekp--policy-analysis-cache))) + (measure ekp--policy-measure)) + (cond + ((and entry (not (car entry))) (cdr entry)) + ((and entry (gethash measure (cdr entry)))) + (t + (let* ((ekp--policy-analysis-sensitive-p nil) + (analysis (ekp--analyze-policies string)) + (sensitive ekp--policy-analysis-sensitive-p)) + (unless ekp--policy-analysis-cache + (setq ekp--policy-analysis-cache + (make-hash-table :test 'equal :size 100))) + (when (>= (hash-table-count ekp--policy-analysis-cache) + ekp-para-cache-limit) + (clrhash ekp--policy-analysis-cache)) + (if sensitive + (let ((table (if (and entry (car entry)) + (cdr entry) + (make-hash-table :test 'equal :size 4)))) + (puthash measure analysis table) + (puthash base-key (cons t table) ekp--policy-analysis-cache)) + (puthash base-key (cons nil analysis) ekp--policy-analysis-cache)) + analysis))))) + +(defun ekp--split-at-indexes (string indexes) + "Split STRING at sorted character INDEXES, preserving properties." + (let ((start 0) parts) + (dolist (end indexes) + (when (> end start) + (push (substring string start end) parts)) + (setq start end)) + (when (< start (length string)) + (push (substring string start) parts)) + (nreverse parts))) + +(defun ekp--path-break-indexes (string &optional skip-first) + "Return legal path break indexes for STRING. +When SKIP-FIRST is non-nil, do not break after the first separator." + (let (indexes seen) + (dotimes (i (length string)) + (when (memq (aref string i) '(?/ ?\\)) + (if (and skip-first (not seen)) + (setq seen t) + (push (1+ i) indexes)))) + (nreverse indexes))) + +(defun ekp--split-no-hyphen-box (box) + "Return no-hyphen BOX split at legal token boundaries, or nil." + (pcase (get-text-property 0 'ekp--token-category box) + ('path (ekp--split-at-indexes + box (ekp--path-break-indexes + box (get-text-property 0 'ekp--downgraded-no-break box)))) + ('url (ekp--split-at-indexes box (ekp--path-break-indexes box))) + ('identifier + (ekp--split-at-indexes box (ekp--identifier-break-indexes box))) + (_ nil))) + (defconst ekp--no-line-start-chars ".,;:!?)]}%’”»›…·" "Halfwidth/neutral punctuation that must not start a line. Applies to boxes consisting solely of these characters (a lone comma @@ -525,35 +1204,30 @@ are covered by the `cjk-open' class.") (defconst ekp--no-line-start-char-list (append ekp--no-line-start-chars nil)) (defconst ekp--no-line-end-char-list (append ekp--no-line-end-chars nil)) -(defcustom ekp-cjk-no-line-start-extra +(defconst ekp--ja-no-line-start-extra (concat "ぁぃぅぇぉっゃゅょゎゕゖァィゥェォッャュョヮヵヶ" "ㇰㇱㇲㇳㇴㇵㇶㇷㇸㇹㇺㇻㇼㇽㇾㇿ" "ーゝゞヽヾ々〻") - "CJK letters that must not start a line (JIS X 4051 kinsoku). -Small kana, the prolonged sound mark ー and iteration marks are -letters for spacing purposes but are line-start-prohibited in -Japanese typesetting. Stored as a string of characters." + "Immutable Japanese letters that must not start a line.") + +(defcustom ekp-cjk-no-line-start-extra "" + "Custom/Japanese CJK letters that must not start a line. +Used only by the `custom' kinsoku profile. The `ja' profile uses +an immutable built-in Japanese addition set." :type 'string + :safe #'stringp :group 'ekp) -(defvar ekp--extra-nls-table nil - "Char-table view of `ekp-cjk-no-line-start-extra' (fast lookup).") +(defcustom ekp-cjk-no-line-end-extra "" + "Custom CJK characters that must not end a line. +Used only by the `custom' kinsoku profile." + :type 'string + :safe #'stringp + :group 'ekp) -(defun ekp--extra-nls-rebuild (chars) - "Rebuild `ekp--extra-nls-table' from the string CHARS." - (let ((table (make-char-table 'ekp-extra-nls))) - (dolist (c (append (if (stringp chars) chars "") nil)) - (aset table c t)) - (setq ekp--extra-nls-table table))) - -(ekp--extra-nls-rebuild ekp-cjk-no-line-start-extra) - -(add-variable-watcher - 'ekp-cjk-no-line-start-extra - (lambda (_sym new op _where) - (when (memq op '(set let unlet makunbound)) - (ekp--extra-nls-rebuild new) - (setq ekp--last-para nil)))) +(defun ekp--char-in-string-p (char string) + "Return non-nil when CHAR occurs in STRING." + (and (stringp string) (memq char (append string nil)))) (defun ekp--box-pure-set-p (box chars) "Non-nil when BOX is non-empty and every char is a member of CHARS." @@ -568,16 +1242,29 @@ Japanese typesetting. Stored as a string of characters." (defun ekp--box-no-line-start-p (box box-type) "Non-nil if BOX must not appear at the start of a line. BOX-TYPE is BOX's (start . end) type pair from `ekp--box-type'." - (or (eq (car box-type) 'cjk-close) - (and (> (length box) 0) - (aref ekp--extra-nls-table (aref box 0))) - (ekp--box-pure-set-p box ekp--no-line-start-char-list))) + (and (not (eq ekp-kinsoku-profile 'off)) + (or (eq (car box-type) 'cjk-close) + (ekp--box-pure-set-p box ekp--no-line-start-char-list) + (and (> (length box) 0) + (eq ekp-kinsoku-profile 'ja) + (ekp--char-in-string-p + (aref box 0) ekp--ja-no-line-start-extra)) + (and (> (length box) 0) + (eq ekp-kinsoku-profile 'custom) + (ekp--char-in-string-p + (aref box 0) ekp-cjk-no-line-start-extra))))) (defun ekp--box-no-line-end-p (box box-type) "Non-nil if BOX must not appear at the end of a line. BOX-TYPE is BOX's (start . end) type pair from `ekp--box-type'." - (or (eq (cdr box-type) 'cjk-open) - (ekp--box-pure-set-p box ekp--no-line-end-char-list))) + (and (not (eq ekp-kinsoku-profile 'off)) + (or (eq (cdr box-type) 'cjk-open) + (ekp--box-pure-set-p box ekp--no-line-end-char-list) + (and (> (length box) 0) + (eq ekp-kinsoku-profile 'custom) + (ekp--char-in-string-p + (aref box (1- (length box))) + ekp-cjk-no-line-end-extra))))) (defun ekp--compute-glue-types (boxes boxes-types hyphen-positions) "Compute the glue-type vector for BOXES using BOXES-TYPES. @@ -659,7 +1346,13 @@ left with no properties are dropped entirely." (push (cadr plist) filtered)) (setq plist (cddr plist))) (when filtered - (push (list (nth 0 iv) (nth 1 iv) (nreverse filtered)) out)))) + (let ((start (nth 0 iv)) + (end (nth 1 iv)) + (props (nreverse filtered))) + (if (and out (= (nth 1 (car out)) start) + (equal (nth 2 (car out)) props)) + (setcar (cdr (car out)) end) + (push (list start end props) out)))))) (nreverse out))) (defvar ekp--box-width-cache (make-hash-table :test 'equal :size 4096) @@ -704,30 +1397,40 @@ therefore must key every measurement and paragraph cache entry." (defun ekp--measured-width (str) "Pixel width of STR in the current display context, cached." - (let* ((ivs (ekp--key-intervals str)) + (let* ((source (ekp--clean-private-policy-source str)) + (ivs (ekp--key-intervals source)) (ctx (ekp--width-context)) - (key (cond ((and (null ivs) (null ctx)) str) - ((null ctx) (cons str ivs)) - (t (list str ivs ctx))))) + (key (cond ((and (null ivs) (null ctx)) source) + ((null ctx) (cons source ivs)) + (t (list source ivs ctx))))) (or (gethash key ekp--box-width-cache) (progn (when (>= (hash-table-count ekp--box-width-cache) ekp--box-width-cache-limit) (clrhash ekp--box-width-cache)) - (puthash key (ekp--string-pixel-width str) + (puthash key (ekp--string-pixel-width source) ekp--box-width-cache))))) -(defun ekp--para-key (string) - "Compute cache key for STRING. +(defun ekp--resolved-emergency-stretch-pixel () + "Return the fixed final-pass emergency stretch budget in pixels." + (or ekp-emergency-stretch-pixel + (* 3 (max 1 (ekp--measured-width "M"))))) + +(defun ekp--para-key (string &optional policy-analysis) + "Compute cache key for STRING and optional POLICY-ANALYSIS. The key is a structure compared with `equal', so hash collisions cannot alias two different paragraphs. It covers: characters, text properties, detected fonts, the hyphenation language, and the -effective spacing signature \(nine explicit values or the auto CJK -stretch default when the other defaults are derived per string)." - (let ((latin-font (ekp-latin-font string)) - (cjk-font (ekp-cjk-font string))) - (list string - (prin1-to-string (ekp--key-intervals string)) +effective policy intervals, and the effective spacing signature \(nine +explicit values or the auto CJK stretch default when the other defaults +are derived per string)." + (let* ((source (ekp--clean-private-policy-source string)) + (latin-font (ekp-latin-font source)) + (cjk-font (ekp-cjk-font source)) + (policy-analysis (or policy-analysis + (ekp--analyze-policies string)))) + (list source + (prin1-to-string (ekp--key-intervals source)) latin-font cjk-font ;; Buffers with remapped faces (text-scale, themes) render ;; — and therefore measure — differently: never alias their @@ -739,7 +1442,8 @@ stretch default when the other defaults are derived per string)." (and ekp-protrusion ekp-protrusion-ratios) ekp-parshape ekp-first-line-indent - ekp-cjk-no-line-start-extra + (ekp--policy-signature) + (cdr policy-analysis) (ekp--spacing-signature)))) (defun ekp--measure-boxes (boxes uniform-props) @@ -849,27 +1553,33 @@ MEASURE is the paragraph measure passed to the justify call. :alignment ekp-alignment :extra-stretch (if justify 0 (ekp--ragged-extra-stretch))))) -(defun ekp--make-para (string) - "Create and fully initialize `ekp-para' for STRING." +(defun ekp--make-para (string &optional policy-analysis) + "Create and fully initialize `ekp-para' for STRING. +POLICY-ANALYSIS is a precomputed result from `ekp--analyze-policies'." ;; Ensure params: explicit params persist; otherwise derive defaults ;; from this string's font. (unless (and ekp--params-explicit (ekp--params-set-p)) (ekp-param-set-default string)) ;; Extract fonts - (let* ((latin-font (ekp-latin-font string)) - (cjk-font (ekp-cjk-font string)) + (let* ((source (ekp--clean-private-policy-source string)) + (policy-analysis (or policy-analysis + (ekp--analyze-policies string))) + (analysis-string (car policy-analysis)) + (resolved-policies (cdr policy-analysis)) + (latin-font (ekp-latin-font source)) + (cjk-font (ekp-cjk-font source)) ;; Split into boxes with hyphenation - (split-result (ekp--split-with-hyphen string)) + (split-result (ekp--split-with-hyphen analysis-string)) (boxes (car split-result)) (hyphen-positions (cdr split-result)) (n (length boxes)) ;; Compute box properties (boxes-widths (ekp--measure-boxes - boxes (null (cdr (object-intervals string))))) + boxes (null (cdr (object-intervals source))))) (boxes-types (vconcat (mapcar #'ekp--box-type boxes))) (glues-types (ekp--compute-glue-types boxes boxes-types hyphen-positions)) - (hyphen-pixel (ekp--hyphen-width-for string)) + (hyphen-pixel (ekp--hyphen-width-for source)) ;; Prefix arrays (ideal-prefixs (make-vector (1+ n) 0)) (min-prefixs (make-vector (1+ n) 0)) @@ -893,7 +1603,8 @@ MEASURE is the paragraph measure passed to the justify call. ;; Break permissions. A gap is unbreakable when: ;; - kinsoku: the line would end with an opener or start with a ;; closer (full- and halfwidth alike), - ;; - it lies strictly inside an `ekp-no-break' span, or + ;; - it lies strictly inside an `ekp-no-break' span, + ;; - it would move a literal source-space box to line start, or ;; - a no-break joiner character (NBSP & friends) touches it. ;; Unbreakable gaps carry no glue: punctuation hugs its content, ;; atoms stay rigid, NBSP supplies its own spacing. @@ -902,7 +1613,14 @@ MEASURE is the paragraph measure passed to the justify call. (let* ((prev-box (aref boxes (1- k))) (curr-box (aref boxes k)) (prev-last (aref prev-box (1- (length prev-box)))) - (curr-first (aref curr-box 0))) + (curr-first (aref curr-box 0)) + (literal-gap + (and (get-text-property (1- (length prev-box)) + 'ekp--literal-spacing prev-box) + (get-text-property 0 'ekp--literal-spacing + curr-box))) + (literal-line-start-space + (and literal-gap (ekp--box-space-p curr-box)))) (when (or (ekp--box-no-line-end-p prev-box (aref boxes-types (1- k))) (ekp--box-no-line-start-p curr-box @@ -910,13 +1628,23 @@ MEASURE is the paragraph measure passed to the justify call. (and (get-text-property (1- (length prev-box)) 'ekp-no-break prev-box) (get-text-property 0 'ekp-no-break curr-box)) + (and (get-text-property (1- (length prev-box)) + 'ekp--automatic-no-break prev-box) + (get-text-property 0 'ekp--automatic-no-break + curr-box)) + literal-line-start-space (memq prev-last ekp--no-break-joiner-chars) (memq curr-first ekp--no-break-joiner-chars)) (aset breaks-allowed k nil) (push k forbidden) - (unless (eq (aref glues-types k) 'nws) + (unless (or literal-gap (eq (aref glues-types k) 'nws)) (aset glues-types k 'nws)))) (setq k (1+ k)))) + ;; Remove private analysis markers after they have been compiled + ;; into hyphen positions and break permissions. + (dotimes (i n) + (aset boxes i (ekp--strip-private-policy-properties + (copy-sequence (aref boxes i))))) ;; Right-edge protrusion: tail-protrudes[k] = protrusion of the ;; last non-space box before gap k (renderer strips trailing ;; space boxes, so look through them). @@ -973,7 +1701,7 @@ MEASURE is the paragraph measure passed to the justify call. (setq i (1- i)))) (aset lead-spaces 0 0) (ekp-para--create - :string string + :string source :latin-font latin-font :cjk-font cjk-font :boxes boxes @@ -997,6 +1725,7 @@ MEASURE is the paragraph measure passed to the justify call. :forbidden-positions (vconcat (nreverse forbidden)) :tail-protrudes tail-protrudes :hyphen-protrude hyphen-protrude + :resolved-policies resolved-policies :glue-params (ekp--glue-params-snapshot) :dp-cache (make-hash-table :test 'equal :size 20)))) @@ -1280,9 +2009,11 @@ Return nil when the tokenizer prefix cannot be reused exactly." (defun ekp--get-para (string) "Get or create `ekp-para' struct for STRING. This is the main entry point for cached paragraph data." - (let ((key (ekp--para-key string))) + (let* ((policy-analysis (ekp--cached-policy-analysis string)) + (key (ekp--para-key string policy-analysis)) + (source (car key))) (if (and ekp--last-para - (eq (car ekp--last-para) string) + (eq (car ekp--last-para) source) (equal (nth 1 ekp--last-para) key)) (nth 2 ekp--last-para) (unless ekp--para-cache @@ -1292,10 +2023,11 @@ This is the main entry point for cached paragraph data." (when (>= (hash-table-count ekp--para-cache) ekp-para-cache-limit) (clrhash ekp--para-cache)) - (let ((new-para (ekp--make-para string))) + (let ((new-para + (ekp--make-para string policy-analysis))) (puthash key new-para ekp--para-cache) new-para))))) - (setq ekp--last-para (list string key para)) + (setq ekp--last-para (list source key para)) para)))) ;;;###autoload @@ -1304,6 +2036,7 @@ This is the main entry point for cached paragraph data." Run after font or theme changes that affect glyph widths." (interactive) (setq ekp--para-cache nil) + (setq ekp--policy-analysis-cache nil) (setq ekp--last-para nil) (clrhash ekp--box-width-cache)) @@ -1419,13 +2152,12 @@ space-box runs, and adds the hyphen width when the line hyphenates." ;; Design notes: ;; - All line metrics are O(1) via prefix arrays. ;; - Two-pass strategy: a strict Knuth-Plass pass runs first. If the -;; paragraph end is unreachable (some region admits no valid line, -;; e.g. an unbreakable box wider than the line, or a rigid run that -;; cannot stretch), a second pass permits "emergency" single-box -;; breaks with huge demerits, guaranteeing that every input yields -;; output. The C engine implements the identical strategy. -;; - Emergency demerits = (line-penalty + 10000)² + rest², i.e. at -;; least as bad as the worst regular line. +;; paragraph end is unreachable, the final pass adds finite background +;; emergency stretch to every underfull candidate and still scores it +;; through the normal badness/demerits path. If an overfull candidate +;; would otherwise remove the last surviving path, the final pass records +;; TeX's zero-increment artificial demerits break. The C engine implements +;; the identical strategy. (defsubst ekp--dp-key (line-pixel) "Return the complete DP cache signature for LINE-PIXEL. @@ -1438,7 +2170,8 @@ every remaining runtime input read by the Elisp and C DP engines." ekp-adjacent-fitness-penalty ekp-consecutive-hyphen-penalty ekp-last-line-short-penalty - ekp-last-line-min-ratio)) + ekp-last-line-min-ratio + (ekp--resolved-emergency-stretch-pixel))) (defun ekp--dp-cache-elisp (para line-pixel) "Return and cache the dp-result plist for PARA at LINE-PIXEL. @@ -1466,13 +2199,6 @@ pass, where line 0 starts at box 0." (aref previous index) length (1+ stable) initial) (make-vector length initial))) -(defun ekp--dp-last-allowed-break (breaks end) - "Return the last permitted break in BREAKS at or before END." - (let ((position end)) - (while (and (> position 0) (not (aref breaks position))) - (setq position (1- position))) - position)) - (defun ekp--dp-first-new-break (para stable) "Return PARA's first permitted break after STABLE." (let ((breaks (ekp-para-breaks-allowed para)) @@ -1552,8 +2278,6 @@ PREVIOUS-STATE may reuse exact states through STABLE-END." (lead-spaces (ekp-para-lead-spaces para)) (trail-spaces (ekp-para-trail-spaces para)) (breaks-ok (ekp-para-breaks-allowed para)) - (last-reused-break - (and reuse (ekp--dp-last-allowed-break breaks-ok stable))) (tail-protrudes (ekp-para-tail-protrudes para)) (hyphen-protrude (ekp-para-hyphen-protrude para)) ;; First-line indent shrinks line 0 only; a line starts at @@ -1568,6 +2292,10 @@ PREVIOUS-STATE may reuse exact states through STABLE-END." (mws-shrink (plist-get params :mws-shrink)) (cws-shrink (plist-get params :cws-shrink)) (extra-stretch (or (plist-get params :extra-stretch) 0)) + (emergency-stretch + (if allow-emergency + (ekp--resolved-emergency-stretch-pixel) + 0)) (reused-state (and reuse previous-state)) (backptrs (ekp--dp-state-array (1+ n) reused-state stable 0 nil)) @@ -1580,13 +2308,24 @@ PREVIOUS-STATE may reuse exact states through STABLE-END." (hyphen-counts (ekp--dp-state-array (1+ n) reused-state stable 4 0)) (fitness-classes (ekp--dp-state-array - (1+ n) reused-state stable 5 1))) + (1+ n) reused-state stable 5 1)) + (artificial-candidates + (and allow-emergency (make-vector (1+ n) nil))) + (surviving-candidates + (and allow-emergency (make-bool-vector (1+ n) nil)))) (aset demerits 0 0.0) (let ((iteration-start (if reuse (ekp--dp-reused-start para stable line-pixel) 0))) (cl-loop for i from iteration-start below n do + (when (and allow-emergency + (null (aref demerits i)) + (not (aref surviving-candidates i)) + (aref artificial-candidates i)) + (ekp--dp-install-artificial + (aref artificial-candidates i) i + demerits backptrs rests gaps hyphen-counts fitness-classes)) (when (aref demerits i) (let* ((prev-dem (aref demerits i)) (prev-hyphen-count (aref hyphen-counts i)) @@ -1597,9 +2336,6 @@ PREVIOUS-STATE may reuse exact states through STABLE-END." (lead-glue-ideal (aref glue-ideals i)) (lead-glue-min (- lead-glue-ideal (aref glue-shrinks i))) (lead-glue-max (+ lead-glue-ideal (aref glue-stretches i))) - (saw-allowed - (and reuse (< i stable) - (> last-reused-break i))) (k (if (and reuse (< i stable)) (1+ stable) (1+ i)))) @@ -1611,10 +2347,6 @@ PREVIOUS-STATE may reuse exact states through STABLE-END." (setq k (1+ k)) (let* ((is-last (= k n)) (single-box (= k (1+ i))) - ;; No permitted break strictly inside [i, k): the - ;; run is atomic and eligible for emergency - ;; handling, like a single box. - (atomic-run (not saw-allowed)) (end-with-hyphenp (aref hyph-flags (1- k))) (hyph-w (if end-with-hyphenp hyphen-pixel 0)) ;; right-edge protrusion releases width at this k @@ -1632,32 +2364,48 @@ PREVIOUS-STATE may reuse exact states through STABLE-END." hyph-w)) (maxw (+ (- (aref max-prefixs k) mx-i lead-glue-max space-w) - hyph-w extra-stretch))) + hyph-w extra-stretch)) + (effective-maxw (+ maxw emergency-stretch))) (cond - ;; Line already too long: emergency-record atomic run, - ;; then stop extending. + ;; Remember a TeX-style zero-increment break in case every + ;; active path would be lost at this overfull breakpoint. ((or (> minw lw) (and is-last (> ideal lw))) - (when (and atomic-run allow-emergency) - (ekp--dp-relax-emergency - demerits backptrs rests gaps hyphen-counts - fitness-classes i k prev-dem - (- lw ideal) end-with-hyphenp - prev-hyphen-count - (unless single-box (ekp--gaps-between para i k)))) + (when allow-emergency + (let ((current (aref artificial-candidates k))) + (when (or (null current) + (< prev-dem (aref current 0))) + (aset artificial-candidates k + (vector prev-dem i (- lw ideal) + (unless single-box + (ekp--gaps-between para i k)) + end-with-hyphenp + prev-hyphen-count))))) (throw 'break nil)) ;; Valid break point - ((or (<= minw lw maxw) + ((or (<= minw lw effective-maxw) (and is-last (<= ideal lw))) + (when allow-emergency + (aset surviving-candidates k t)) (let* ((adjustment (- lw ideal)) dem line-gaps fitness new-hyphen) (cond - ;; Single box line: fixed flexibility of 1 + ;; Single box line: fixed flexibility in the strict pass; + ;; final pass uses finite background emergency stretch. (single-box - (let* ((badness (ekp--compute-badness adjustment 1)) + (let* ((flexibility + (if (and allow-emergency (> adjustment 0)) + emergency-stretch + 1)) + (badness (ekp--compute-badness + adjustment flexibility)) (penalty (if end-with-hyphenp ekp-hyphen-penalty 0))) - (setq fitness 1 + (setq fitness + (if (and allow-emergency (> adjustment 0)) + (ekp--compute-fitness-class + adjustment flexibility) + 1) new-hyphen (if end-with-hyphenp (1+ prev-hyphen-count) 0) line-gaps nil @@ -1685,10 +2433,13 @@ PREVIOUS-STATE may reuse exact states through STABLE-END." (aref cws-prefixs j))) (flexibility (if (> adjustment 0) - (+ (* lcnt lws-stretch) - (* mcnt mws-stretch) - (* ccnt cws-stretch) - extra-stretch) + (let ((stretch (+ (* lcnt lws-stretch) + (* mcnt mws-stretch) + (* ccnt cws-stretch) + extra-stretch))) + (if allow-emergency + (+ stretch emergency-stretch) + stretch)) (+ (* lcnt lws-shrink) (* mcnt mws-shrink) (* ccnt cws-shrink)))) @@ -1712,18 +2463,20 @@ PREVIOUS-STATE may reuse exact states through STABLE-END." (aset rests k adjustment) (aset gaps k line-gaps) (aset fitness-classes k fitness) - (aset hyphen-counts k new-hyphen))))) - ;; Invalid atomic run (rigid underfull): emergency - ;; record so the DP cannot dead-end (2nd pass only). - ((and atomic-run allow-emergency) - (ekp--dp-relax-emergency - demerits backptrs rests gaps hyphen-counts - fitness-classes i k prev-dem - (- lw ideal) end-with-hyphenp - prev-hyphen-count - (unless single-box (ekp--gaps-between para i k))))) - (setq saw-allowed t) - (setq k (1+ k)))))))))) + (aset hyphen-counts k new-hyphen))) + nil)) + ;; Underfull candidates remain active even when their + ;; badness is above this pass's finite fit threshold. + (allow-emergency + (aset surviving-candidates k t))) + (setq k (1+ k)))))))))) + (when (and allow-emergency + (null (aref demerits n)) + (not (aref surviving-candidates n)) + (aref artificial-candidates n)) + (ekp--dp-install-artificial + (aref artificial-candidates n) n + demerits backptrs rests gaps hyphen-counts fitness-classes)) ;; Extract solution (nil when end unreachable in the strict pass) (when (aref demerits n) (let ((breaks (ekp--dp-trace-breaks backptrs n))) @@ -1736,31 +2489,21 @@ PREVIOUS-STATE may reuse exact states through STABLE-END." hyphen-counts fitness-classes allow-emergency)))))) -(defun ekp--dp-relax-emergency (demerits backptrs rests gaps hyphen-counts - fitness-classes i k prev-dem rest - end-with-hyphenp prev-hyphen-count - &optional line-gaps) - "Record an emergency (over/underfull atomic-run) break at K from I. -DEMERITS, BACKPTRS, RESTS, GAPS, HYPHEN-COUNTS and FITNESS-CLASSES are -the DP state arrays, updated at K when this break beats the stored -DEMERITS entry. PREV-DEM is the demerits accumulated up to I; REST is -line-pixel minus the line's ideal width (may be negative); -END-WITH-HYPHENP and PREV-HYPHEN-COUNT track the hyphen run. -LINE-GAPS is the (lws mws cws) gap-count list for multi-box runs -\(nil for single boxes, which render via the single-box path). -Only replaces an existing entry when strictly better." - (let ((total (+ prev-dem - (expt (+ ekp-line-penalty ekp--infinite-badness) 2) - (* (float rest) rest)))) - (when (or (null (aref demerits k)) - (< total (aref demerits k))) - (aset demerits k total) - (aset backptrs k i) - (aset rests k rest) - (aset gaps k line-gaps) - (aset fitness-classes k 3) - (aset hyphen-counts k - (if end-with-hyphenp (1+ prev-hyphen-count) 0))))) +(defun ekp--dp-install-artificial + (candidate k demerits backptrs rests gaps hyphen-counts fitness-classes) + "Install TeX final-pass CANDIDATE at break K. +CANDIDATE stores prior demerits, start, rest, gaps, hyphen flag, and +prior hyphen count. Artificial demerits add zero to the prior path; +the overfull line keeps the tight fitness class computed by TeX. +Update DEMERITS, BACKPTRS, RESTS, GAPS, HYPHEN-COUNTS, and +FITNESS-CLASSES in place." + (aset demerits k (aref candidate 0)) + (aset backptrs k (aref candidate 1)) + (aset rests k (aref candidate 2)) + (aset gaps k (aref candidate 3)) + (aset fitness-classes k 0) + (aset hyphen-counts k + (if (aref candidate 4) (1+ (aref candidate 5)) 0))) (defun ekp--dp-trace-breaks (backptrs n) "Trace optimal break points back from N using the BACKPTRS array." @@ -1819,12 +2562,26 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." (mws-shrink (plist-get params :mws-shrink)) (cws-shrink (plist-get params :cws-shrink)) (extra-stretch (or (plist-get params :extra-stretch) 0)) + (emergency-stretch + (if allow-emergency + (ekp--resolved-emergency-stretch-pixel) + 0)) ;; state: (pos . lines) -> [dem backptr fitness hyph rest gaps] (states (make-hash-table :test 'equal :size (* 4 (1+ n)))) - (counts-at (make-vector (1+ n) nil))) + (counts-at (make-vector (1+ n) nil)) + (artificial-candidates + (and allow-emergency (make-vector (1+ n) nil))) + (surviving-candidates + (and allow-emergency (make-bool-vector (1+ n) nil)))) (puthash (cons 0 0) (vector 0.0 nil 1 0 nil nil) states) (push 0 (aref counts-at 0)) (dotimes (i n) + (when (and allow-emergency + (null (aref counts-at i)) + (not (aref surviving-candidates i)) + (aref artificial-candidates i)) + (ekp--dp-loose-install-artificial + (aref artificial-candidates i) i states counts-at)) (dolist (lc (aref counts-at i)) (let* ((st (gethash (cons i lc) states)) ;; per-line layout: line LC (0-based) may have its own width @@ -1838,7 +2595,6 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." (lead-glue-ideal (aref glue-ideals i)) (lead-glue-min (- lead-glue-ideal (aref glue-shrinks i))) (lead-glue-max (+ lead-glue-ideal (aref glue-stretches i))) - (saw-allowed nil) (k (1+ i))) (catch 'break (while (<= k n) @@ -1847,7 +2603,6 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." (setq k (1+ k)) (let* ((is-last (= k n)) (single-box (= k (1+ i))) - (atomic-run (not saw-allowed)) (end-with-hyphenp (ekp--hyphenate-p hyphen-positions (1- k))) (hyph-w (if end-with-hyphenp hyphen-pixel 0)) @@ -1867,39 +2622,49 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." (maxw (+ (- (aref max-prefixs k) mx-i lead-glue-max space-w) hyph-w extra-stretch)) + (effective-maxw (+ maxw emergency-stretch)) (adjustment (- lw ideal)) candidate) (cond ((or (> minw lw) (and is-last (> ideal lw))) - (when (and atomic-run allow-emergency) - (setq candidate - (list (+ (expt (+ ekp-line-penalty - ekp--infinite-badness) 2) - (* (float adjustment) adjustment)) - adjustment - (unless single-box - (ekp--gaps-between para i k)) - 3 - (if end-with-hyphenp - (1+ prev-hyphen-count) 0))) - (ekp--dp-loose-relax states counts-at k (1+ lc) i - prev-dem candidate)) + (when allow-emergency + (let ((current (aref artificial-candidates k))) + (when (or (null current) + (< prev-dem (aref current 0))) + (aset artificial-candidates k + (vector prev-dem i lc adjustment + (unless single-box + (ekp--gaps-between para i k)) + end-with-hyphenp + prev-hyphen-count))))) (throw 'break nil)) - ((or (<= minw lw maxw) + ((or (<= minw lw effective-maxw) (and is-last (<= ideal lw))) + (when allow-emergency + (aset surviving-candidates k t)) (setq candidate (cond (single-box - (let* ((badness (ekp--compute-badness adjustment 1)) + (let* ((flexibility + (if (and allow-emergency (> adjustment 0)) + emergency-stretch + 1)) + (badness (ekp--compute-badness + adjustment flexibility)) (penalty (if end-with-hyphenp ekp-hyphen-penalty 0)) + (fitness + (if (and allow-emergency (> adjustment 0)) + (ekp--compute-fitness-class + adjustment flexibility) + 1)) (nh (if end-with-hyphenp (1+ prev-hyphen-count) 0))) (list (ekp--compute-demerits - badness penalty prev-fitness 1 + badness penalty prev-fitness fitness end-with-hyphenp prev-hyphen-count) - adjustment nil 1 nh))) + adjustment nil fitness nh))) (is-last (let* ((fill-ratio (/ (float ideal) lw)) (badness (if (< fill-ratio @@ -1916,10 +2681,13 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." (ccnt (nth 2 line-gaps)) (flexibility (if (> adjustment 0) - (+ (* lcnt lws-stretch) - (* mcnt mws-stretch) - (* ccnt cws-stretch) - extra-stretch) + (let ((stretch (+ (* lcnt lws-stretch) + (* mcnt mws-stretch) + (* ccnt cws-stretch) + extra-stretch))) + (if allow-emergency + (+ stretch emergency-stretch) + stretch)) (+ (* lcnt lws-shrink) (* mcnt mws-shrink) (* ccnt cws-shrink)))) @@ -1936,22 +2704,17 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." end-with-hyphenp prev-hyphen-count) adjustment line-gaps fitness nh))))) (ekp--dp-loose-relax states counts-at k (1+ lc) i - prev-dem candidate)) - ((and atomic-run allow-emergency) - (setq candidate - (list (+ (expt (+ ekp-line-penalty - ekp--infinite-badness) 2) - (* (float adjustment) adjustment)) - adjustment - (unless single-box - (ekp--gaps-between para i k)) - 3 - (if end-with-hyphenp - (1+ prev-hyphen-count) 0))) - (ekp--dp-loose-relax states counts-at k (1+ lc) i - prev-dem candidate))) - (setq saw-allowed t) + prev-dem candidate) + nil) + (allow-emergency + (aset surviving-candidates k t))) (setq k (1+ k))))))))) + (when (and allow-emergency + (null (aref counts-at n)) + (not (aref surviving-candidates n)) + (aref artificial-candidates n)) + (ekp--dp-loose-install-artificial + (aref artificial-candidates n) n states counts-at)) ;; Select final state: line count closest to (optimal + looseness). ;; nil when the end is unreachable (strict pass only). (when-let* ((end-counts (aref counts-at n))) @@ -1985,6 +2748,23 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." :cost best-dem :line-count (length breaks)))))))) +(defun ekp--dp-loose-install-artificial (candidate k states counts-at) + "Install TeX final-pass CANDIDATE at loose-DP break K. +Update the STATES table and COUNTS-AT index in place." + (let* ((lines (1+ (aref candidate 2))) + (key (cons k lines))) + (unless (gethash key states) + (push lines (aref counts-at k)) + (puthash key + (vector (aref candidate 0) + (aref candidate 1) + 0 + (if (aref candidate 5) + (1+ (aref candidate 6)) 0) + (aref candidate 3) + (aref candidate 4)) + states)))) + (defun ekp--dp-loose-relax (states counts-at k lines i prev-dem candidate) "Relax state (K . LINES) with CANDIDATE from position I. STATES maps each (position . line-count) to its best vector; COUNTS-AT @@ -2028,7 +2808,8 @@ HYPHEN-COUNT)." (float ekp-last-line-short-penalty) (if (eq ekp-alignment 'justify) 0 - (ekp--ragged-extra-stretch))))) + (ekp--ragged-extra-stretch)) + (ekp--resolved-emergency-stretch-pixel)))) (defun ekp--dp-cache-para (para line-pixel) "Return PARA's DP result at LINE-PIXEL, computing it when absent." @@ -2058,7 +2839,8 @@ HYPHEN-COUNT)." Uses Knuth-Plass dynamic programming with demerits. If `ekp-use-c-module' is non-nil and the C module is available (and `ekp-looseness' is 0), the C module computes the DP." - (ekp--dp-cache-para (ekp--get-para string) line-pixel)) + (let ((ekp--policy-measure line-pixel)) + (ekp--dp-cache-para (ekp--get-para string) line-pixel))) (defun ekp--lines-data-from-breaks (para line-pixel breaks) "Compute (RESTS . GAPS) lists for BREAKS of PARA at LINE-PIXEL. @@ -2090,6 +2872,39 @@ the reconstructed rests overfill the indented line." (puthash (ekp--dp-key line-pixel) dp-result (ekp-para-dp-cache para)) dp-result)) +(defun ekp--c-breaks-valid-p (para breaks) + "Return non-nil when BREAKS are in range and increasing for PARA." + (and (proper-list-p breaks) + (let ((limit (length (ekp-para-boxes para))) + (previous 0) + (valid t)) + (dolist (break breaks) + (unless (and (integerp break) (< previous break) (<= break limit)) + (setq valid nil)) + (when (integerp break) + (setq previous break))) + (and valid (= previous limit))))) + +(defun ekp--signal-backend-contract-error (detail result) + "Signal an explicit backend contract error for DETAIL and RESULT." + (signal 'ekp-backend-contract-error (list detail result))) + +(defun ekp--valid-c-result-or-signal (para result) + "Return (BREAKS . COST), :fallback, or signal for PARA C RESULT. +Nil RESULT and nil breaks are documented soft failures and keep the +Elisp fallback. Any non-nil malformed result is a backend contract +violation." + (cond + ((null result) :fallback) + ((not (consp result)) + (ekp--signal-backend-contract-error 'malformed-result result)) + ((null (car result)) :fallback) + ((not (numberp (cdr result))) + (ekp--signal-backend-contract-error 'nonnumeric-cost result)) + ((not (ekp--c-breaks-valid-p para (car result))) + (ekp--signal-backend-contract-error 'malformed-breaks result)) + (t result))) + (defun ekp--prepare-para-for-c (para line-pixel) "Prepare PARA at LINE-PIXEL as a 15-element vector for the C batch API." (vector (ekp-para-ideal-prefixs para) @@ -2130,17 +2945,17 @@ propagate because they indicate a broken backend contract." (ekp-para-tail-protrudes para) (ekp-para-hyphen-protrude para) (cdr (ekp--line-spec para 0 line-pixel)))) - (c-breaks (car result)) - (c-cost (cdr result))) - (if (null c-breaks) + (checked (ekp--valid-c-result-or-signal para result))) + (if (eq checked :fallback) (ekp--dp-cache-elisp para line-pixel) - (ekp--store-c-result para line-pixel c-breaks c-cost)))) + (ekp--store-c-result para line-pixel (car checked) (cdr checked))))) (defun ekp--dp-cache-batch (strings line-pixel) "Compute DP at LINE-PIXEL for multiple STRINGS via the C batch API. Returns list of dp-results in the same order as STRINGS. Only computes strings that aren't already cached." - (let* ((paras (mapcar #'ekp--get-para strings)) + (let* ((ekp--policy-measure line-pixel) + (paras (mapcar #'ekp--get-para strings)) (needs-compute '()) ; list of (index . para) (results (make-vector (length strings) nil))) (cl-loop for para in paras @@ -2160,18 +2975,25 @@ Only computes strings that aren't already cached." ;; A nil whole-batch result falls back per paragraph. ;; Signals propagate as broken backend contracts. (batch-results (ekp-c-break-batch batch-input))) + (when (and batch-results + (or (not (vectorp batch-results)) + (/= (length batch-results) + (length needs-compute)))) + (ekp--signal-backend-contract-error + 'malformed-batch-results batch-results)) (cl-loop for ip in needs-compute for j from 0 for idx = (car ip) for para = (cdr ip) for res = (and batch-results (aref batch-results j)) - for breaks = (car res) - for cost = (cdr res) + for checked = (ekp--valid-c-result-or-signal para res) do (aset results idx - (if breaks - (ekp--store-c-result para line-pixel breaks cost) + (if (eq checked :fallback) ;; C returned no result; fallback to Elisp. - (ekp--dp-cache-elisp para line-pixel))))) + (ekp--dp-cache-elisp para line-pixel) + (ekp--store-c-result para line-pixel + (car checked) + (cdr checked)))))) (append results nil)))) (defun ekp-dp-data (string line-pixel &optional key) @@ -2254,6 +3076,38 @@ Returns ((latin-adj . latin-extra) (mix-adj . mix-extra) (cjk-adj . cjk-extra)). (cons mix-adj mix-extra) (cons cjk-adj cjk-extra)))) +(defun ekp--distribute-emergency-stretch (para rest-pixel gaps-list) + "Distribute REST-PIXEL for PARA over stretchable GAPS-LIST. +Use TeX glue-set proportions from PARA's actual stretch capacities." + (let* ((params (ekp-para-glue-params para)) + (changes (mapcar (lambda (key) (plist-get params key)) + '(:lws-stretch :mws-stretch :cws-stretch))) + (weights (cl-mapcar #'* gaps-list changes)) + (total (apply #'+ weights)) + (amounts (make-vector 3 0))) + (when (> total 0) + (let ((remainders nil) (used 0) (index 0)) + (dolist (weight weights) + (let* ((numerator (* rest-pixel weight)) + (base (/ numerator total))) + (aset amounts index base) + (cl-incf used base) + (push (cons (% numerator total) index) remainders) + (cl-incf index))) + (dolist (entry (seq-take + (sort remainders + (lambda (a b) + (if (= (car a) (car b)) + (< (cdr a) (cdr b)) + (> (car a) (car b))))) + (- rest-pixel used))) + (cl-incf (aref amounts (cdr entry)))))) + (cl-loop for amount across amounts + for count in gaps-list + collect (if (> count 0) + (cons (/ amount count) (% amount count)) + (cons 0 0))))) + (defun ekp--fixed-line-glues (para types start end maximum trailing) "Return fixed glue pixels for PARA TYPES from START to END. Use maximum widths when MAXIMUM is non-nil and finish with TRAILING." @@ -2279,13 +3133,16 @@ Use maximum widths when MAXIMUM is non-nil and finish with TRAILING." pixels)) (defun ekp--adjusted-line-glues - (para types start end rest-pixel gaps-list) + (para types start end rest-pixel gaps-list &optional emergency-stretch) "Distribute REST-PIXEL over GAPS-LIST for PARA TYPES from START to END." (if (= rest-pixel 0) (ekp--fixed-line-glues para types start end nil 0) (let* ((stretch-p (> rest-pixel 0)) - (distribution (ekp--distribute-gap-adjustment - para (abs rest-pixel) gaps-list stretch-p)) + (distribution (if emergency-stretch + (ekp--distribute-emergency-stretch + para rest-pixel gaps-list) + (ekp--distribute-gap-adjustment + para (abs rest-pixel) gaps-list stretch-p))) (shares (vconcat distribution)) (params (ekp-para-glue-params para)) (pixels (make-vector (1+ (- end start)) 0)) @@ -2377,11 +3234,25 @@ Reuse COMMON entries from PREVIOUS-LINES when provided." para glues-types start end nil (max 0 (- eff-pixel ideal-pixel)))) ;; Emergency underfull line (can't stretch to width): - ;; set glues to max and pad with trailing filler. + ;; final pass may stretch real glue past nominal max. ((< max-pixel eff-pixel) - (ekp--fixed-line-glues - para glues-types start end t - (max 0 (- eff-pixel max-pixel)))) + (let* ((line-gaps (nth i lines-gaps)) + (params (ekp-para-glue-params para)) + (stretch-capacity + (and line-gaps + (+ (* (nth 0 line-gaps) + (plist-get params :lws-stretch)) + (* (nth 1 line-gaps) + (plist-get params :mws-stretch)) + (* (nth 2 line-gaps) + (plist-get params :cws-stretch)))))) + (if (and stretch-capacity (> stretch-capacity 0)) + (ekp--adjusted-line-glues + para glues-types start end + (nth i lines-rests) line-gaps t) + (ekp--fixed-line-glues + para glues-types start end t + (max 0 (- eff-pixel max-pixel)))))) ;; Normal justified line (t (ekp--adjusted-line-glues @@ -2597,16 +3468,17 @@ LAST-LINE-P suppresses a terminal discretionary hyphen." (defun ekp--layout-context-snapshot (line-pixel) "Return every non-text input to a plan at LINE-PIXEL." - (list (ekp--dp-key line-pixel) - (copy-tree (ekp--width-context)) - ekp-latin-lang - ekp-alignment - ekp-ragged-stretch-pixel - (and ekp-protrusion (copy-tree ekp-protrusion-ratios)) - (copy-tree ekp-parshape) - ekp-first-line-indent - ekp-cjk-no-line-start-extra - (ekp--spacing-signature))) + (ekp--copy-layout-context-value + (list (ekp--dp-key line-pixel) + (ekp--width-context) + ekp-latin-lang + ekp-alignment + ekp-ragged-stretch-pixel + (and ekp-protrusion ekp-protrusion-ratios) + ekp-parshape + ekp-first-line-indent + (ekp--policy-signature) + (ekp--spacing-signature)))) (defun ekp--layout-plan-from-para (string line-pixel para dp &optional previous stable) @@ -2646,15 +3518,37 @@ Reuse PREVIOUS lines that end before STABLE when both are non-nil." "Return a semantic KP layout plan for STRING at LINE-PIXEL. The plan records source offsets, glue targets, breaks, indentation, and discretionary hyphens without choosing a display representation." - (let ((para (ekp--get-para string))) - (ekp--layout-plan-from-para - string line-pixel para (ekp--dp-cache-para para line-pixel)))) + (let ((ekp--policy-measure line-pixel) + (source (ekp--clean-private-policy-source string))) + (if (ekp--natural-overlong-token-p string line-pixel) + (ekp-layout-plan--create + :string source :line-pixel line-pixel + :context (ekp--layout-context-snapshot line-pixel) + :para nil :boxes [] :offsets [] :lines [] + :state 'natural :reason 'overlong-token) + (let* ((para (ekp--get-para string)) + (dp (ekp--dp-cache-para para line-pixel)) + (key (ekp--layout-context-snapshot line-pixel)) + (cache (or (ekp-para-layout-plan-cache para) + (setf (ekp-para-layout-plan-cache para) + (make-hash-table :test 'equal :size 8)))) + (hit (gethash key cache))) + (if hit + (ekp--copy-layout-plan-for-consumer hit) + (when (>= (hash-table-count cache) 8) + (clrhash cache)) + (let ((plan (ekp--layout-plan-from-para + source line-pixel para dp))) + (puthash key plan cache) + (ekp--copy-layout-plan-for-consumer plan))))))) (defun ekp-layout-plan-append (previous string line-pixel) "Return STRING's exact append plan by extending PREVIOUS, or nil. Only property-free, context-stable 1D layouts take this fast path." - (let ((old-para (and previous (ekp-layout-plan-para previous)))) + (let ((old-para (and previous (ekp-layout-plan-para previous))) + (ekp--policy-measure line-pixel)) (when (and old-para + (null (ekp-para-resolved-policies old-para)) (equal (ekp-layout-plan-context previous) (ekp--layout-context-snapshot line-pixel)) (= ekp-looseness 0) @@ -2664,6 +3558,7 @@ Only property-free, context-stable 1D layouts take this fast path." (when-let* ((append (ekp--append-para old-para string)) (para (car append)) (stable (cdr append)) + (_ (null (ekp-para-resolved-policies para))) (dp (ekp--dp-cache-append para old-para stable line-pixel))) (ekp--layout-plan-from-para @@ -2750,7 +3645,9 @@ The `ekp-soft-hyphen' property marks it as synthesized, so "Render PLAN as the public reversible justified string." (let* ((string (ekp-layout-plan-string plan)) (lines (ekp-layout-plan-lines plan))) - (if (= (length lines) 0) + (if (eq (ekp-layout-plan-state plan) 'natural) + string + (if (= (length lines) 0) (ekp--hide-string string) (let ((parts (list (ekp--hide-string (substring string 0 @@ -2771,24 +3668,27 @@ The `ekp-soft-hyphen' property marks it as synthesized, so (push (ekp--hide-string (substring string (ekp-layout-line-source-end last))) parts)) - (apply #'concat (nreverse parts)))))) + (apply #'concat (nreverse parts))))))) (defun ekp--pixel-justify (string line-pixel) "Justify single-paragraph STRING to LINE-PIXEL, with render caching. The rendered string for a (paragraph, width) pair is deterministic, so it is stored in the paragraph's dp-cache entry and reused — resize sweeps that revisit a width pay nothing." - (let* ((para (ekp--get-para string)) - (dp (ekp-dp-data string line-pixel)) - (hit (plist-get dp :rendered))) - (or hit - (let ((rendered (ekp--pixel-justify-1 string line-pixel)) - (cache (ekp-para-dp-cache para))) - ;; keep memory bounded during long resize sessions - (when (<= (hash-table-count cache) 64) - (puthash (ekp--dp-key line-pixel) - (plist-put dp :rendered rendered) cache)) - rendered)))) + (if (ekp--natural-overlong-token-p string line-pixel) + string + (let* ((ekp--policy-measure line-pixel) + (para (ekp--get-para string)) + (dp (ekp-dp-data string line-pixel)) + (hit (plist-get dp :rendered))) + (or hit + (let ((rendered (ekp--pixel-justify-1 string line-pixel)) + (cache (ekp-para-dp-cache para))) + ;; keep memory bounded during long resize sessions + (when (<= (hash-table-count cache) 64) + (puthash (ekp--dp-key line-pixel) + (plist-put dp :rendered rendered) cache)) + rendered))))) (defun ekp--pixel-justify-1 (string line-pixel) "Justify single-paragraph STRING to LINE-PIXEL. diff --git a/ekp_c/README.md b/ekp_c/README.md index f2aca97..77300bb 100644 --- a/ekp_c/README.md +++ b/ekp_c/README.md @@ -67,7 +67,8 @@ metacharacters in the checkout path are not interpreted. ;; Synced automatically by ekp.el before every call: (ekp-c-set-penalties LINE HYPHEN FITNESS LAST-RATIO - &optional CONSEC-HYPHEN LAST-SHORT EXTRA-STRETCH) + &optional CONSEC-HYPHEN LAST-SHORT EXTRA-STRETCH + EMERGENCY-STRETCH) ;; Single paragraph (15 args): (ekp-c-break-with-arrays IDEAL-PREFIX MIN-PREFIX MAX-PREFIX @@ -93,9 +94,16 @@ when no indent is active). The DP uses the same two-pass strategy as the Elisp engine: a strict Knuth-Plass pass, then — only when the paragraph end is unreachable — -a second pass permitting emergency single-box breaks, so overlong -unbreakable tokens can never make the result empty. Badness saturates -at 10000 exactly like the Elisp side. +a final pass that adds finite background emergency stretch to ordinary +underfull candidates and still scores them through the same +badness/fitness/demerits path. Separately, if an overfull candidate would +extinguish the final active path to a breakpoint and no non-overfull +candidate survives there, TeX-style artificial demerits install the best +provisional path with tight fitness and zero incremental cost. This is a +content-independent reachability safeguard, not a hard-atom scoring rule. +Thus an overlong unbreakable token cannot make the result empty, while +ordinary underfull choices remain global K-P decisions. Badness saturates at +10000 exactly like the Elisp side. Failure behavior: the full schema is checked before extraction. Malformed direct API arguments signal `ekp-c-invalid-input`; allocation failure or an diff --git a/ekp_c/ekp.c b/ekp_c/ekp.c index 7d3d5d9..bb48572 100644 --- a/ekp_c/ekp.c +++ b/ekp_c/ekp.c @@ -183,6 +183,7 @@ typedef struct { int32_t consecutive; double last_short; int32_t extra_stretch; + int32_t emergency_stretch; } penalty_config_t; static const char *parse_penalties(emacs_env *env, ptrdiff_t nargs, @@ -192,7 +193,8 @@ static const char *parse_penalties(emacs_env *env, ptrdiff_t nargs, !i32_value_p(env, args[2]) || !finite_number_p(env, args[3]) || (nargs > 4 && !i32_value_p(env, args[4])) || (nargs > 5 && !finite_number_p(env, args[5])) || - (nargs > 6 && !i32_value_p(env, args[6]))) + (nargs > 6 && !i32_value_p(env, args[6])) || + (nargs > 7 && !i32_value_p(env, args[7]))) return "EKP C penalties require finite signed 32-bit numbers"; out->line = clamp32(env->extract_integer(env, args[0])); @@ -209,9 +211,12 @@ static const char *parse_penalties(emacs_env *env, ptrdiff_t nargs, : (double)env->extract_integer(env, args[5]); out->extra_stretch = nargs > 6 ? clamp32(env->extract_integer(env, args[6])) : 0; + out->emergency_stretch = nargs > 7 + ? clamp32(env->extract_integer(env, args[7])) : 0; if (out->last_ratio < 0.0 || out->last_ratio > 1.0 || - out->last_short < 0.0 || out->extra_stretch < 0) + out->last_short < 0.0 || out->extra_stretch < 0 || + out->emergency_stretch < 0) return "EKP C ratios and stretch values are outside valid ranges"; return NULL; } @@ -239,6 +244,7 @@ static emacs_value Fekp_c_set_penalties(emacs_env *env, ptrdiff_t nargs, ekp_global->consec_hyphen_penalty = config.consecutive; ekp_global->last_line_short_penalty = config.last_short; ekp_global->extra_stretch = config.extra_stretch; + ekp_global->emergency_stretch = config.emergency_stretch; return env->intern(env, "t"); } @@ -758,7 +764,7 @@ int emacs_module_init(struct emacs_runtime *runtime) defun(env, "ekp-c-cleanup", 0, 0, Fekp_c_cleanup, "Cleanup EKP C module resources."); - defun(env, "ekp-c-set-penalties", 4, 7, Fekp_c_set_penalties, + defun(env, "ekp-c-set-penalties", 4, 8, Fekp_c_set_penalties, "Set Knuth-Plass algorithm penalties.\n\n\ LINE-PENALTY: base penalty per line break (default 10)\n\ HYPHEN-PENALTY: penalty for hyphenated breaks (default 50)\n\ @@ -766,9 +772,11 @@ FITNESS-PENALTY: penalty for adjacent line tightness mismatch (default 100)\n\ LAST-LINE-RATIO: minimum fill ratio for last line (default 0.5)\n\ CONSEC-HYPHEN-PENALTY: multiplier for consecutive hyphen runs (default 100)\n\ LAST-LINE-SHORT-PENALTY: multiplier for short last lines (default 50.0)\n\ -EXTRA-STRETCH: per-line non-justify flexibility in pixels (default 0)\n\n\ +EXTRA-STRETCH: per-line non-justify flexibility in pixels (default 0)\n\ +EMERGENCY-STRETCH: fixed final-pass emergency stretch in pixels (default 0)\n\n\ (fn LINE-PENALTY HYPHEN-PENALTY FITNESS-PENALTY LAST-LINE-RATIO \ -&optional CONSEC-HYPHEN-PENALTY LAST-LINE-SHORT-PENALTY EXTRA-STRETCH)"); +&optional CONSEC-HYPHEN-PENALTY LAST-LINE-SHORT-PENALTY EXTRA-STRETCH \ +EMERGENCY-STRETCH)"); defun(env, "ekp-c-break-with-arrays", 15, 15, Fekp_c_break_with_arrays, "Break lines using Elisp's pre-computed prefix arrays (preferred API).\n\n\ diff --git a/ekp_c/ekp_kp.c b/ekp_c/ekp_kp.c index d1baf9a..0246aab 100644 --- a/ekp_c/ekp_kp.c +++ b/ekp_c/ekp_kp.c @@ -153,9 +153,11 @@ typedef struct { /* Per-line flexibility for non-justify alignment (0 = justify): * widens max_w, so flexibility = max_w - ideal includes it. */ int32_t extra_stretch; + /* Fixed final-pass emergency stretch, matching TeX's emergency pass. */ + int32_t emergency_stretch; - /* Two-pass strategy: strict K-P first; emergency single-box - * breaks only in the second pass (when no valid layout exists). */ + /* Two-pass strategy: strict K-P first; emergency transitions only + * in the second pass (when no valid layout exists). */ bool allow_emergency; } dp_input_t; @@ -209,31 +211,46 @@ static inline bool dp_is_forbidden(const dp_input_t *in, size_t pos) * Processes position i, trying all end positions k. * Updates output arrays when better solutions found. */ -/* - * Emergency break: record a single-box over/underfull line so that the - * DP can never dead-end (every reachable i can always record i+1). - * Demerits are at least as bad as the worst regular line, so these are - * only chosen when nothing better exists. Mirrors - * ekp--dp-relax-emergency in ekp.el. - */ -static inline void dp_relax_emergency( - const dp_input_t *in, size_t i, size_t k, - double prev_dem, int prev_hyph, int prev_lines, - int64_t rest, bool end_hyphen, +typedef struct { + bool present; + double previous_demerits; + size_t start; + int previous_hyphens; + int previous_lines; + int64_t rest; + bool end_hyphen; +} dp_artificial_candidate_t; + +static inline void dp_remember_artificial( + dp_artificial_candidate_t *candidate, size_t start, + double previous_demerits, int previous_hyphens, int previous_lines, + int64_t rest, bool end_hyphen) +{ + if (candidate->present && + candidate->previous_demerits <= previous_demerits) + return; + + candidate->present = true; + candidate->previous_demerits = previous_demerits; + candidate->start = start; + candidate->previous_hyphens = previous_hyphens; + candidate->previous_lines = previous_lines; + candidate->rest = rest; + candidate->end_hyphen = end_hyphen; +} + +static inline void dp_install_artificial( + const dp_artificial_candidate_t *candidate, size_t k, double *demerits, int32_t *backptrs, int64_t *rest_pixels, uint8_t *fitness, int32_t *hyphen_counts, int32_t *line_counts) { - double base = in->line_penalty + EKP_BADNESS_INF; - double dem = prev_dem + base * base + (double)rest * rest; - - if (dem < demerits[k]) { - demerits[k] = dem; - backptrs[k] = i; - rest_pixels[k] = rest; - fitness[k] = FITNESS_VERY_LOOSE; - hyphen_counts[k] = end_hyphen ? prev_hyph + 1 : 0; - line_counts[k] = prev_lines + 1; - } + demerits[k] = candidate->previous_demerits; + backptrs[k] = (int32_t)candidate->start; + rest_pixels[k] = candidate->rest; + fitness[k] = FITNESS_TIGHT; + hyphen_counts[k] = candidate->end_hyphen + ? candidate->previous_hyphens + 1 : 0; + line_counts[k] = candidate->previous_lines + 1; } static void dp_process_position( @@ -250,7 +267,9 @@ static void dp_process_position( int64_t *rest_pixels, uint8_t *fitness, int32_t *hyphen_counts, - int32_t *line_counts) + int32_t *line_counts, + uint8_t *surviving_candidates, + dp_artificial_candidate_t *artificial_candidates) { size_t n = in->n; /* Line 0 (i == 0) may have a different width: first-line indent */ @@ -265,20 +284,16 @@ static void dp_process_position( int64_t lead_space = in->lead_spaces ? in->lead_spaces[i] : 0; /* Try extending to each position k > i */ - bool saw_allowed = false; for (size_t k = i + 1; k <= n; k++) { bool is_last = (k == n); /* Break forbidden here (kinsoku, no-break span): not a * candidate; keep extending the line. */ - if (!is_last && dp_is_forbidden(in, k)) + if (!is_last && dp_is_forbidden(in, k)) { continue; + } bool is_single_box = (k == i + 1); - /* No permitted break strictly inside [i, k): the run is atomic - * and eligible for emergency handling, like a single box. */ - bool atomic_run = !saw_allowed; - saw_allowed = true; bool end_hyphen = dp_is_hyphen(in, k - 1); int64_t hyph_w = end_hyphen ? in->hyphen_width : 0; @@ -303,29 +318,28 @@ static void dp_process_position( int64_t max_w = (int64_t)in->max_prefix[k] - in->max_prefix[i] - (lead_ideal + lead_stretch) - space_w + hyph_w + in->extra_stretch; + int64_t emergency_stretch = in->allow_emergency + ? in->emergency_stretch : 0; + int64_t effective_max_w = max_w + emergency_stretch; /* Too long? (last line is never shrunk below its ideal) */ if (min_w > lw || (is_last && ideal > lw)) { - if (atomic_run && in->allow_emergency) - dp_relax_emergency(in, i, k, prev_dem, prev_hyph, prev_lines, - lw - ideal, end_hyphen, - demerits, backptrs, rest_pixels, - fitness, hyphen_counts, line_counts); + if (in->allow_emergency) + dp_remember_artificial(&artificial_candidates[k], i, + prev_dem, prev_hyph, prev_lines, + lw - ideal, end_hyphen); break; /* No point trying longer lines */ } + if (in->allow_emergency) + surviving_candidates[k] = 1; + /* Valid break? */ - bool valid = (min_w <= lw && max_w >= lw) || + bool valid = (min_w <= lw && effective_max_w >= lw) || (is_last && ideal <= lw); if (!valid) { - /* Rigid underfull atomic run: emergency-record so the - * position after it stays reachable (2nd pass only). */ - if (atomic_run && in->allow_emergency) - dp_relax_emergency(in, i, k, prev_dem, prev_hyph, prev_lines, - lw - ideal, end_hyphen, - demerits, backptrs, rest_pixels, - fitness, hyphen_counts, line_counts); + /* An underfull active path survives to later breakpoints. */ continue; } @@ -333,6 +347,8 @@ static void dp_process_position( int64_t adjustment = lw - ideal; int64_t flexibility = (adjustment > 0) ? (max_w - ideal) : (ideal - min_w); + if (adjustment > 0) + flexibility += emergency_stretch; double badness; uint8_t fit; @@ -341,8 +357,12 @@ static void dp_process_position( /* Single-box line: use fixed flexibility=1, fitness=decent. * This must come BEFORE is_last check to match Elisp behavior. */ if (is_single_box) { - badness = compute_badness(adjustment, 1); - fit = FITNESS_DECENT; + int64_t flexibility = + (in->allow_emergency && adjustment > 0) ? emergency_stretch : 1; + badness = compute_badness(adjustment, flexibility); + fit = (in->allow_emergency && adjustment > 0) + ? compute_fitness(adjustment, flexibility) + : FITNESS_DECENT; int penalty = end_hyphen ? in->hyphen_penalty : 0; dem = prev_dem + compute_demerits(badness, penalty, @@ -405,9 +425,8 @@ void ekp_result_destroy(ekp_result_t *r) * * All font-dependent calculations happen in Elisp. C module is pure algorithm. * - * Note: This function now uses dp_process_position() for the core DP logic, - * sharing the same algorithm with process_dp_range(). Any bug fix only needs - * to be made once in dp_process_position(). + * dp_process_position() owns the per-breakpoint transition logic used by + * both strict and final passes, including final-pass active-path preservation. */ ekp_result_t *ekp_break_with_prefixes( @@ -443,10 +462,15 @@ ekp_result_t *ekp_break_with_prefixes( uint8_t *fitness = malloc((n + 1) * sizeof(uint8_t)); int32_t *hyph_counts = malloc((n + 1) * sizeof(int32_t)); int32_t *line_counts = malloc((n + 1) * sizeof(int32_t)); + uint8_t *surviving_candidates = calloc(n + 1, sizeof(uint8_t)); + dp_artificial_candidate_t *artificial_candidates = + calloc(n + 1, sizeof(dp_artificial_candidate_t)); - if (!demerits || !backptrs || !rest_pixels || !fitness || !hyph_counts || !line_counts) { + if (!demerits || !backptrs || !rest_pixels || !fitness || !hyph_counts || + !line_counts || !surviving_candidates || !artificial_candidates) { free(demerits); free(backptrs); free(rest_pixels); free(fitness); free(hyph_counts); free(line_counts); + free(surviving_candidates); free(artificial_candidates); return NULL; } @@ -469,6 +493,7 @@ ekp_result_t *ekp_break_with_prefixes( int chp = ekp_global ? ekp_global->consec_hyphen_penalty : 100; double llsp = ekp_global ? ekp_global->last_line_short_penalty : 50.0; int32_t xstretch = ekp_global ? ekp_global->extra_stretch : 0; + int32_t estretch = ekp_global ? ekp_global->emergency_stretch : 0; /* Create unified input structure */ dp_input_t in = { @@ -497,11 +522,12 @@ ekp_result_t *ekp_break_with_prefixes( .consec_hyphen_penalty = chp, .last_line_short_penalty = llsp, .extra_stretch = xstretch, + .emergency_stretch = estretch, .allow_emergency = false }; /* Two passes: strict Knuth-Plass first; if the paragraph end is - * unreachable, rerun permitting emergency single-box breaks. + * unreachable, rerun permitting emergency transitions. * Mirrors ekp--dp-cache-elisp. */ for (int pass = 0; pass < 2; pass++) { in.allow_emergency = (pass == 1); @@ -514,10 +540,19 @@ ekp_result_t *ekp_break_with_prefixes( hyph_counts[i] = 0; line_counts[i] = 0; } + memset(surviving_candidates, 0, (n + 1) * sizeof(uint8_t)); + memset(artificial_candidates, 0, + (n + 1) * sizeof(dp_artificial_candidate_t)); demerits[0] = 0.0; /* DP: for each valid start, try all ends */ for (size_t i = 0; i < n; i++) { + if (in.allow_emergency && demerits[i] >= EKP_INFINITY && + !surviving_candidates[i] && artificial_candidates[i].present) + dp_install_artificial(&artificial_candidates[i], i, + demerits, backptrs, rest_pixels, + fitness, hyph_counts, line_counts); + if (demerits[i] >= EKP_INFINITY) continue; @@ -531,9 +566,17 @@ ekp_result_t *ekp_break_with_prefixes( rest_pixels, fitness, hyph_counts, - line_counts); + line_counts, + surviving_candidates, + artificial_candidates); } + if (in.allow_emergency && demerits[n] >= EKP_INFINITY && + !surviving_candidates[n] && artificial_candidates[n].present) + dp_install_artificial(&artificial_candidates[n], n, + demerits, backptrs, rest_pixels, + fitness, hyph_counts, line_counts); + if (demerits[n] < EKP_INFINITY) break; } @@ -542,6 +585,7 @@ ekp_result_t *ekp_break_with_prefixes( if (demerits[n] >= EKP_INFINITY) { free(demerits); free(backptrs); free(rest_pixels); free(fitness); free(hyph_counts); free(line_counts); + free(surviving_candidates); free(artificial_candidates); return NULL; } @@ -550,6 +594,7 @@ ekp_result_t *ekp_break_with_prefixes( if (!result) { free(demerits); free(backptrs); free(rest_pixels); free(fitness); free(hyph_counts); free(line_counts); + free(surviving_candidates); free(artificial_candidates); return NULL; } @@ -568,6 +613,7 @@ ekp_result_t *ekp_break_with_prefixes( ekp_result_destroy(result); free(demerits); free(backptrs); free(rest_pixels); free(fitness); free(hyph_counts); free(line_counts); + free(surviving_candidates); free(artificial_candidates); return NULL; } @@ -584,6 +630,7 @@ ekp_result_t *ekp_break_with_prefixes( free(demerits); free(backptrs); free(rest_pixels); free(fitness); free(hyph_counts); free(line_counts); + free(surviving_candidates); free(artificial_candidates); return result; } @@ -709,6 +756,8 @@ int ekp_init(void) ekp_global->last_line_ratio = 0.5; ekp_global->consec_hyphen_penalty = 100; ekp_global->last_line_short_penalty = 50.0; + ekp_global->extra_stretch = 0; + ekp_global->emergency_stretch = 0; /* The thread pool is created lazily by the first batch call: * plain single-paragraph use never starts worker threads. */ diff --git a/ekp_c/ekp_module.h b/ekp_c/ekp_module.h index c72900d..d9e4147 100644 --- a/ekp_c/ekp_module.h +++ b/ekp_c/ekp_module.h @@ -82,6 +82,7 @@ typedef struct { double last_line_short_penalty; /* multiplier for short last lines */ int32_t extra_stretch; /* per-line flexibility for non-justify * alignment (0 = justify) */ + int32_t emergency_stretch; /* fixed final-pass emergency stretch */ } ekp_state_t; /* Global state instance */ diff --git a/postmortem/20260801-forbidden-run-emergency-boundary.md b/postmortem/20260801-forbidden-run-emergency-boundary.md new file mode 100644 index 0000000..80fd213 --- /dev/null +++ b/postmortem/20260801-forbidden-run-emergency-boundary.md @@ -0,0 +1,80 @@ +# Forbidden-Run Emergency Boundary + +Superseded note: this record explains the earlier rigid-atom repair. Neither +the fullest-prefix fallback nor the later atom-adjacency prohibition is +current. The accepted final-pass model is recorded in +`postmortem/20260802-final-pass-active-path-preservation.md`. + +## Context + +At 280px, the showcase paragraph before an overwide `ekp-no-break` atom +collapsed into one-glyph CJK lines. The buffer projector reproduced the +semantic plan exactly, so the visible failure was owned by core line breaking, +not redisplay, overlays, resize timing, or projection. + +## What the trace showed + +The strict pass correctly found no valid candidate where widths jumped from +an underfull CJK prefix to an overfull rigid atom. The emergency pass retained +only the first permitted candidate from each state. That rule guarantees +reachability for arbitrary hard input, but here it made the atom boundary +reachable only through repeated one-glyph emergency transitions. + +Replacing that rule globally with the latest underfull candidate was also +wrong. It fixed the screenshot but changed emergency layouts for ordinary +Latin text: discretionary hyphens disappeared and existing DP-parameter +sensitivity changed. Three established regressions failed independently, +while the unmodified baseline passed them. + +## Decision + +Keep the original first-candidate emergency transition. In the emergency pass +only, remember the latest permitted underfull candidate. Use that additional +candidate only when one or more forbidden break positions are crossed and the +next permitted candidate is already overfull. + +This assigns the exception to the event that creates it: a rigid or otherwise +forbidden run skipping the valid width range. The Elisp 1D path, looseness/ +parshape path, and C engine implement the same state transition. + +## Rejected alternatives + +- Compensate in `ekp-buffer.el`: projection would diverge from the semantic + plan and the public string renderer would remain wrong. +- Break the protected atom: this violates the `ekp-no-break` contract. +- Replace every first-candidate emergency with the fullest underfull one: this + changes unrelated emergency layout, hyphenation, and cost sensitivity. +- Add resize debounce or cache invalidation: the failure is deterministic in + a fresh batch plan and is unrelated to time or stale state. + +## Consequences + +Rigid atoms remain intact, their ordinary prefix uses the fullest permitted +line, and source-clean projection is unchanged. Ordinary emergency behavior, +strict Knuth-Plass results, discretionary hyphenation, and DP parameter +sensitivity retain their previous semantics. The only additional DP state is +three fallback values plus a flag local to one candidate scan. + +Automatic inline no-hyphen and explicit hard atoms are different contracts. +The later policy work keeps automatic inline code breakable at source spaces. +For explicit `ekp-no-break`, the ordinary boundary immediately before the +following hard atom is forbidden before DP; that adjacency rule prevents a +manual hard atom from stranding the preceding ordinary box. It is separate +from this postmortem's emergency forbidden-run fallback, which applies only +after a forbidden run skips the valid width range. + +## Verification and rollback + +The focused regression failed before the fix and passes in Elisp, C, and the +public buffer path. Normal, seeded-random, and per-test isolated 201-test +suites pass, as do 300 C/Elisp fuzz cases, warning-as-error Elisp compilation, +pinned package-lint, checkdoc, release/dictionary gates, and warning-clean +debug, ASan/UBSan, and portable C builds. + +Reviewed 62.7-second evidence at +`/private/tmp/ekp-atom-gui-final-Beg8hb` covers nine checkpoints across +480→280→340→280 and returns PASS: the prefix stays on one screen line, the +atom remains intact, source is exact, overlays remain zero, the C engine is +active, and no black or transient vertical frame appears. Rollback is a +direct revert of the forbidden-run fallback and its tests; no API, schema, +cache, or stored-data migration is involved. diff --git a/postmortem/20260801-policy-compilation-boundary.md b/postmortem/20260801-policy-compilation-boundary.md new file mode 100644 index 0000000..9b5f9c3 --- /dev/null +++ b/postmortem/20260801-policy-compilation-boundary.md @@ -0,0 +1,162 @@ +# Policy Compilation Boundary + +Superseded note: the historical hard-atom adjacency prohibition below was +removed by `task036`. Explicit atoms forbid only interior breaks; final-pass +reachability is owned by core K-P as recorded in +`20260802-final-pass-active-path-preservation.md`. + +## Context + +Configurable break policy could have been implemented by teaching every +planning caller about inline code, tokens, mode profiles, and local +overrides. That would have spread policy precedence across core DP, +buffer projection, C marshalling, showcase code, and diagnostics. + +The accepted task034 contract required inline code to default to legal +wrapping without dictionary hyphenation, explicit `ekp-no-break` to remain +the only manual hard atom, token categories to have independent defaults, +and the existing 15-argument / 15-field C boundary to stay stable unless +architecture review was reopened. + +## Decision + +Compile policy before dynamic programming. The buffer layer resolves public +configuration and annotates exact structural intervals; the core turns those +intervals into the existing hyphenation, no-hyphen, and forbidden-break +vectors before DP. The semantic plan still preserves the original source +string and source properties for renderers and diagnostics. + +This keeps policy as input classification, not a second DP algorithm or a +post-projection correction. + +## Rejected alternatives + +- Make inline code a hard atom by default. This caused the visible orphan + glyph failure and made ordinary code-like prose too rigid. +- Add a broader C schema for policy objects. The current vectors already + express the required break permissions, and expanding the ABI would add + release risk without a new semantic capability. +- Handle inline faces in the buffer projector after planning. Projection + would disagree with the semantic plan and C parity evidence. +- Copy mode profiles into buffer locals automatically. That makes consulted + defaults look like user overrides and hides precedence bugs. + +## Consequences + +Policy precedence is explicit: region properties, then explicit local values, +then mode profiles, then global defaults. Block faces stay paragraph-level +verbatim; inline faces affect only their exact spans. Manual `ekp-no-break` +remains session-local and strictly stronger than automatic policies. + +The C boundary remains stable, but every new policy that affects break +legality must be reflected in the compiled paragraph inputs before DP. GUI +verification must keep separate examples for automatic inline wrapping, +manual hard atoms, and verbatim blocks so later regressions cannot pass by +collapsing all three concepts into one rendering path. + +## Performance root causes + +The first performance boundary was paragraph identity. The semantic signature +included policy measure unconditionally, so width-only policy context rebuilt +paragraphs even when no break rule actually depended on measure. The fix +removed measure from paragraph semantic identity and confined measure-sensitive +work to the policy analysis tier. + +The second boundary was property-run identity. Clearing volatile properties +could split otherwise equal filtered property runs, making equivalent source +look different to the cache. Canonicalizing adjacent equal filtered intervals +restores the intended stable identity. + +The third boundary was policy analysis order. Full policy analysis ran before +paragraph-cache hits, so repeated layout requests paid the analysis cost even +when the paragraph itself was reusable. The implementation now uses a bounded +two-tier full-analysis cache keyed by clean source, canonical layout and raw +face policy intervals, policy signature, and width context. The measure tier +is used only for actual width-sensitive no-break or overflow candidates. + +The fourth boundary was semantic plan assembly. Repeated same-paragraph and +same-width requests duplicated plan construction. A bounded per-paragraph plan +cache stores the reusable plan and returns consumer-owned copies of every +plan-owned mutable payload so later renderer or buffer mutations cannot poison +the cached plan. The paragraph pointer remains intentionally shared because +the older paragraph cache owns that lifetime and append planning uses stable +paragraph identity. + +G006 cleanup exposed two ownership boundaries during independent review. +First, shallow semantic-plan copies were not enough: nested line/gap/glue +payloads could still alias the cached plan. Second, malformed non-nil C +results were too soft if they reached Elisp fallback. G007 resolved those +first blockers by deep-copying plan-owned mutable payloads at the consumer +boundary and by making `ekp-backend-contract-error` the contract for malformed +non-nil single or batch backend results. Nil whole results and nil per-item +break results remain the only C soft-failure path that may fall back to Elisp. + +G007 final review then found one remaining string-leaf alias: `copy-tree` +does not copy strings inside the layout context, so a returned context could +mutate a dynamic policy suffix and poison the cached context. G008 resolves +that final blocker with the same recursive context copier at both context +snapshot/cache-key creation and returned-plan copying. The copier owns conses, +vectors, and strings; `para` remains the only deliberate shared exception. + +The explicit hard-atom adjacency rule is also documented here because it is +part of policy compilation, not the emergency fallback. Before DP runs, the +ordinary boundary immediately before a following explicit `ekp-no-break` atom +is forbidden. The later G009 line-breaking correction is narrower and belongs +to core K-P: ordinary underfull final-pass candidates receive finite +emergency stretch and remain normal badness/demerits candidates, while fixed +emergency transitions are reserved for truly overfull hard/atomic runs. + +## Verification and remaining gate + +Recorded evidence so far: G002 focused core policy and C parity gates pass; +G003 buffer policy ownership and public controls pass; G004 GUI verifier ERT +7/7 and clean single-window evidence at `/tmp/ekp-g004-evidence.Tp77dW` +passes 12/12 checkpoints with automatic inline wrapping, source-space +internal breaks, explicit hard atom, block verbatim, exact source, zero +overlays, C active, and no stale policy projection. G005 records layout +parity true in the formal four-interleaved evaluator; core baseline p50/p95 +38.6679/51.6782ms versus candidate 21.7102/33.0040ms for +43.8549%/36.1354% gains; resize baseline p50/p95 43.3831/55.6250ms versus +candidate 22.0919/32.8202ms for 49.0773%/40.9973% gains; both candidate p95 +values under 50ms and both gain sets at least 20%. + +The live evaluator records the source-instrumented locked goal as the known +`validation_failed` debt, with parity, zero-work, GC, conflict, and +all-width-nonregression checks true. Current C p95/p99 is 26.449/26.740ms, +a 76.65%/77.23% improvement. Current Elisp p95/p99 is 49.940/52.017ms, a +91.64%/91.35% improvement. This is consistent with historical open +`issue018` and is not a regression. The byte-compiled production public path +passed three runs with zero GC: C append p99 1.361-1.368ms, C hard p99 +1.876-1.891ms, Elisp append p99 1.692-1.775ms, and Elisp hard p99 +2.100-2.230ms. + +G005 repository gates are complete: default ERT 262/262; seeded permuted ERT +seed 20260728 255/255; isolated per-test process suite exit 0; targeted +alias guard passed; property fuzz 300/300; warning-as-error byte +compilation; pinned package-lint at +`35996f478d81e51dae4fa30d051f741895d07399` exit 0 with only an external +obsolete warning from the local names dependency; empty checkdoc; release, +49-entry dictionary manifest, pinned dictionary update, shell syntax, CI +YAML, and diff-check passed; portable/native/debug/sanitize C builds were +warning-clean; module 1.6/4-thread smoke passed; and focused C passed 19/19 +including the 15-argument/15-field boundary. + +G006 cleanup edited only `ekp.el` and `ekp-buffer.el`, removing redundant +policy/cache code without changing the locked behavior. Its first independent +review found the shallow-copy and C-boundary blockers recorded above, so G006 +is review-blocked historically rather than final-clean. + +G007 resolved the first review blockers, then G008 resolved the final +string-leaf context blocker. Fresh G008 gates: formal resize parity true; +core baseline p50/p95 36.595/48.357ms versus candidate 23.266/36.363ms for +36.42%/24.80% gains; resize baseline p50/p95 41.443/53.541ms versus +candidate 23.761/36.889ms for 42.67%/31.10% gains; ERT 268/268; property +fuzz 300/300; release gate pass; and the byte-compiled current public path +reports zero GC with C append/hard p99 1.440-1.464/2.022-2.050ms and Elisp +append/hard p99 1.648-1.687/2.136-2.335ms, all below 16ms. After the final +warning-clean test-fixture and C README remediation, independent code review +returned APPROVE and the subsequent architecture review returned CLEAR. + +This record explains the implementation boundary. `task034` is closed for +developer work and independent review. `issue021` closed after the user's +2026-08-02 visual confirmation. diff --git a/postmortem/20260802-final-pass-active-path-preservation.md b/postmortem/20260802-final-pass-active-path-preservation.md new file mode 100644 index 0000000..61c309b --- /dev/null +++ b/postmortem/20260802-final-pass-active-path-preservation.md @@ -0,0 +1,92 @@ +# Final-Pass Active-Path Preservation + +## Context + +The narrow showcase could still isolate a CJK glyph after ordinary underfull +final-pass lines were moved onto fixed emergency stretch and normal K-P +badness. The strict pass, renderer, policy compiler, units, and source +projection were not choosing those lines. The failure remained in the core +final-pass transition model shared by the Elisp and C implementations. + +Two compensations had accumulated around the symptom: a high fixed-cost +transition described as hard/atomic-specific, and a rule forbidding the +otherwise legal boundary immediately before a manual hard atom. Both encoded +content and adjacency into a reachability problem. + +## Root Cause + +Fixed emergency stretch solves one problem: it gives ordinary underfull +candidates finite flexibility so adjustment ratio, badness, fitness, and +demerits can compare them globally. It does not solve the separate case where +an overfull candidate would remove the last active final-pass path. + +The implementation treated that second case as a special hard-atom line with +a large invented cost. That is not the role of TeX's +`artificial_demerits`. In the final pass TeX preserves reachability when the +active list would otherwise lose the remaining path; the artificial break +adds no demerits. It is a control-flow safeguard, not another line-quality +score and not a token-class rule. + +The upstream reference is the pinned TeX Live `tex.web` at commit +`1a25c04b49317750330b4cf95994ea0d08f9d5ec`: +https://raw.githubusercontent.com/TeX-Live/texlive-source/1a25c04b49317750330b4cf95994ea0d08f9d5ec/texk/web2c/tex.web + +## Decision + +Keep the strict pass unchanged. + +In the final pass: + +1. Ordinary underfull candidates receive the resolved fixed + `ekp-emergency-stretch-pixel` and use the normal adjustment-ratio, + badness, fitness, and demerits pipeline. +2. Remember the best provisional overfull candidate for each breakpoint. +3. If no normal state exists at that breakpoint and no non-overfull active + candidate survives to it, install the provisional path with tight fitness + and zero incremental demerits. + +The artificial path therefore cannot beat a surviving normal path. It exists +only at the path-extinction boundary. The Elisp 1D, Elisp +looseness/parshape, and C paths implement the same state transition. + +Delete the atom-adjacency prohibition. An explicit `ekp-no-break` interval +forbids only its interior breaks; otherwise legal boundaries immediately +before and after it remain legal. An overwide atom stays intact but may share +an overflow line with preceding ordinary content. + +## Test-Oracle Failure + +The isolated-CJK oracle originally checked only the lines returned by the +planner. An empty plan contained no isolated line, so the assertion could +pass while the core had failed to cover any source. The oracle now first +requires a nonempty, contiguous plan whose ranges cover the entire source, +then checks for isolated CJK lines. A direct regression also proves that an +artificial line adds zero demerits to the preceding path. + +## Rejected Alternatives + +- A CJK orphan penalty would encode a visible sample instead of the K-P + invariant. +- Unit suffix or hard-atom scoring would make content classification affect a + content-independent final-pass safeguard. +- Forbidding the boundary before an atom would delete a legitimate K-P choice + and compensate in policy compilation for a core DP bug. +- Renderer reshaping would make display diverge from the semantic plan. +- A large artificial cost would turn reachability into a competing heuristic + and differ from TeX's zero-increment behavior. + +## Consequences + +The public configuration remains the fixed emergency-stretch dimension; no +new orphan, unit, or atom-adjacency option exists. The public C contract stays +at 15 paragraph fields and 15 entry arguments. Renderer glue distribution +uses the selected line's actual rest and actual glue-set proportions. + +Focused regressions pass 8/8, emergency selection passes 10/10, the +core/buffer/GUI oracle passes 8/8, full ERT passes 288/288, seeded and isolated +suites pass 279/279, fuzz passes 300/300, and all Elisp/C build, static, +release, and performance gates pass. Reviewed 42.78-second dynamic GUI +evidence at `/tmp/ekp-g009-evidence-retry.UOpPNp` covers +480→168→280→168 plus a no-hyphen→normal policy transition and returns +`VERDICT=PASS` with one window, exact source, zero overlays/stale spans, +active C, and no isolated CJK source line. diff --git a/postmortem/20260802-final-pass-emergency-stretch.md b/postmortem/20260802-final-pass-emergency-stretch.md new file mode 100644 index 0000000..39e84fc --- /dev/null +++ b/postmortem/20260802-final-pass-emergency-stretch.md @@ -0,0 +1,65 @@ +# Final-Pass Emergency Stretch + +Superseded note: the fixed-dimension emergency-stretch decision remains +current, but the historical hard/atomic fixed-cost exception below does not. +The accepted TeX active-path semantics are recorded in +`20260802-final-pass-active-path-preservation.md`. + +## Context + +The narrow showcase still produced isolated CJK source lines after the +policy work split automatic inline code from explicit hard atoms. That made +the earlier forbidden-run explanation too narrow: the visible failure was not +owned by unit suffix policy, buffer projection, or a screenshot-specific CJK +penalty. It was the final K-P pass assigning ordinary underfull candidates to +a fixed-cost emergency path outside the normal badness and demerits model. + +## Decision + +Keep the strict pass unchanged. When strict K-P cannot reach the paragraph +end, rerun with a finite background emergency stretch available to ordinary +underfull candidates. Those candidates still compute adjustment ratio, +badness, fitness, and demerits, so the global DP chooses between them by the +same model as ordinary K-P. + +Task035 tried making that stretch scale with the line/candidate width. Full +regression falsified that detail. Task036 must use a TeX-style fixed +dimension instead: `ekp-emergency-stretch-pixel` is nil for an automatic +value around three display-font `M` widths, or a non-negative integer for a +fixed pixel value. + +Keep the artificial fixed-cost emergency transition only for a truly overfull +first permitted hard or atomic run. That case has no ordinary candidate to +score. The Elisp 1D path, Elisp looseness/parshape path, and C engine use the +same rule. + +## Why the old fallback was wrong + +The earlier repair treated the symptom as a forbidden-run boundary problem +and remembered a fuller prefix. That explained one rigid-atom screenshot, but +it left the deeper model split in place: some ordinary underfull lines were +still not compared by normal badness, fitness, and demerits. At narrow widths +that flattened costs enough for one-glyph lines to remain competitive. + +The accepted direction matches TeX's emergency-pass shape more closely: +emergency stretch is background flexibility for badness calculation, not a +separate shortcut that bypasses the line-quality model. It must be a fixed +dimension for the paragraph context, not a value derived from each line +measure. + +## Test lesson + +The first 84px/168px CJK oracle was invalid because it assumed two CJK glyphs +always fit when the width is twice one glyph. It ignored glue, kinsoku, and +attached punctuation. The replacement tests use the real mixed showcase text +and reject isolated CJK source lines through the core, public buffer path, and +GUI oracle. + +## Consequences + +There is no CJK-orphan penalty, no number-unit special case, and no renderer +compensation. Policy compilation still decides which gaps are legal before +DP. Core K-P owns the final line choices, the renderer must agree with the +chosen fixed stretch dimension, and both engines must stay in parity whenever +emergency stretch behavior changes. The 15-field C paragraph ABI remains a +constraint for task036. diff --git a/readme.md b/readme.md index 9930263..71f638e 100644 --- a/readme.md +++ b/readme.md @@ -26,7 +26,7 @@ typesetting, entirely inside Emacs. - **Text properties preserved** — faces, colors and other properties survive justification; inserted hyphens inherit the face of the word they break. -- **Robust on hard input** — unbreakable overlong tokens (URLs, long +- **Robust on hard input** — unprotected overlong tokens (URLs, long words at narrow widths) degrade to emergency breaks instead of losing text; every input produces output. - **Optional C module** — a dynamic module runs the DP in C with a @@ -173,15 +173,17 @@ blocking input in an unbounded Knuth-Plass pass; `M-x ekp-diagnose` reports the reason. Run `M-x ekp-refill-paragraph` when you explicitly want the unbounded full-quality pass for that paragraph. -Mode presets for verbatim protection — one call each: +Mode presets for explicit local protection — one call each: ```elisp (add-hook 'org-mode-hook #'ekp-org-setup) (add-hook 'markdown-mode-hook #'ekp-markdown-setup) ``` -`ekp-auto-justify-mode` also applies the matching preset automatically -in Org and Markdown buffers when you have not configured your own. +`ekp-auto-justify-mode` consults `ekp-buffer-mode-policy-alist` +automatically in Org and Markdown buffers. It does not copy profile +values into buffer-local variables unless you explicitly call the setup +functions above. ### Protecting code and other verbatim text @@ -190,10 +192,22 @@ in Org and Markdown buffers when you have not configured your own. `ekp-buffer-skip-faces` (e.g. `org-block`, `markdown-code-face`), or matched by the buffer-local function `ekp-buffer-skip-predicate` pass through completely untouched. -- Inline level: spans carrying `ekp-no-break` +- Automatic inline level: faces listed in `ekp-buffer-inline-faces` + (Org `org-code`/`org-verbatim`, Markdown inline code by default through + mode profiles) use `ekp-inline-code-policy`. The default `no-hyphen` + keeps source spaces literal and suppresses dictionary hyphenation, but it + may still wrap at legal source boundaries. Automatic `no-break` spans + downgrade to `no-hyphen` when wider than the effective measure. +- Explicit hard atom level: spans carrying `ekp-no-break` (`M-x ekp-no-break-region`) become rigid atoms — never broken, never hyphenated, spacing kept literal — ideal for inline code, - product names, or numbers with units. + product names, or numbers with units. An atom wider than the measure stays + intact but is not guaranteed a line of its own: the final pass may place it + on one overflow line with preceding ordinary content. Ordinary underfull + candidates use fixed emergency stretch and normal K-P costs. If an + overfull candidate would otherwise extinguish every active final-pass path, + the core preserves the last path with TeX-style artificial demerits. There + is no CJK-orphan, unit, or screenshot-specific rule. Manual properties are deliberately **current-buffer-session only**: plain-text saving and reopening do not persist them. Use @@ -235,6 +249,40 @@ not renderable (text cannot start before the line origin). ## Configuration +### Break policy and measure + +The break-policy defaults are intended to make code readable without making +every code-looking span a hard atom: + +| Option | Default | Scope | Effect | +|:-------|:--------|:------|:-------| +| `ekp-inline-code-policy` | `no-hyphen` | global, profile, local | `normal`, `no-hyphen`, or automatic fitting `no-break` for inline-face spans | +| `ekp-hyphenation` | `auto` | global, profile, local, region via command | `auto`/`on` use dictionaries when available; `off` suppresses discretionary hyphens | +| `ekp-token-break-policies` | URL/path/identifier `no-hyphen`, number-unit `no-break` | global, profile, local | per-token automatic policies; local/profile values merge by token category | +| `ekp-number-unit-suffixes` | common CSS, time, data, frequency, and metric units | global, profile, local | suffixes recognized by the compact number-unit classifier | +| `ekp-kinsoku-profile` | `common` | global, profile, local | `common`, `zh`, `ja`, `off`, or `custom` CJK line-start/end prohibitions | +| `ekp-cjk-no-line-start-extra` / `ekp-cjk-no-line-end-extra` | `""` | global, profile, local | additions used by the `custom` profile | +| `ekp-overlong-token-policy` | `emergency` | global, profile, local | `emergency`, `overflow`, or `natural` for ordinary overlong Latin-like tokens | +| `ekp-buffer-measure` | `narrowest-window` | global, profile, local | `narrowest-window`, fixed pixel integer, or `(max . PIXELS)` | +| `ekp-buffer-skip-faces` | profile-dependent | global, profile, local | paragraph-level verbatim faces | +| `ekp-buffer-inline-faces` | profile-dependent | global, profile, local | exact inline spans using `ekp-inline-code-policy` | +| `ekp-buffer-mode-policy-alist` | Org and Markdown profiles | global/local safe value | mode profiles consulted by automatic and manual buffer layout | + +Effective precedence is deterministic: explicit region text properties +first, then explicit buffer/file/dir-local values, then the first matching +major-mode profile, then global defaults. `ekp-break-policy` region values +are `normal`, `hyphenate`, and `no-hyphen`; they override automatic token +or inline policies for the exact region but never create a hard atom. +`ekp-no-break` remains the only explicit hard-atom property and wins over +every automatic policy. + +All listed variables have closed safe-local predicates where file/dir local +configuration is supported. `ekp-diagnose` reports the requested measure, +the narrowest live window, the effective measure, overflow risk, conflict +count, and the active inline/hyphenation/kinsoku/overlong policy summary. +The EKP menu exposes diagnose plus region commands for normal break, +hyphenation on, hyphenation off, clear break policy, no-break, and verbatim. + ### Hyphenation language ```elisp diff --git a/readme_zh.md b/readme_zh.md index df658d7..76ab645 100644 --- a/readme_zh.md +++ b/readme_zh.md @@ -22,7 +22,7 @@ Emacs-kp 在 Emacs 内部完整实现了 Knuth-Plass 最优断行算法,支持 搜索、语法、保存及普通 Elisp 文本 API 看到的都是源字符。 - **文本属性保留** — face、颜色等属性完整保留;断词插入的连字符继承所 在单词的样式。 -- **困难输入不丢内容** — 超长不可断 token(URL、窄栏长词)退化为紧急 +- **困难输入不丢内容** — 未受保护的超长 token(URL、窄栏长词)退化为紧急 断行而不是吞掉文本;任何输入都有输出。 - **可选 C 模块** — 动态模块用 C 执行 DP,线程池并行处理多个段落(见 性能数据)。 @@ -145,7 +145,7 @@ Elisp。已启用模块若 signal,则作为后端契约错误直接呈现。若 Knuth-Plass 计算阻塞输入;`M-x ekp-diagnose` 会报告这一原因。确实需要 对该段执行无上限完整质量排版时,显式运行 `M-x ekp-refill-paragraph`。 -各 mode 的 verbatim 保护预设——各一行: +各 mode 的显式本地保护预设——各一行: ```elisp (add-hook 'org-mode-hook #'ekp-org-setup) @@ -153,7 +153,9 @@ Knuth-Plass 计算阻塞输入;`M-x ekp-diagnose` 会报告这一原因。确实 ``` 在 Org 与 Markdown buffer 里,若你没有自定义配置, -`ekp-auto-justify-mode` 会自动套用对应预设。 +`ekp-auto-justify-mode` 会自动查询 `ekp-buffer-mode-policy-alist`。 +它不会把 profile 值复制成 buffer-local 变量;只有显式调用上面的 +setup 函数时才会写入本地 face 列表。 ### 保护代码块与 verbatim 文本 @@ -161,9 +163,18 @@ Knuth-Plass 计算阻塞输入;`M-x ekp-diagnose` 会报告这一原因。确实 face 在 `ekp-buffer-skip-faces` 列表中(如 `org-block`、 `markdown-code-face`)、或被 buffer-local 的 `ekp-buffer-skip-predicate` 判定的段落**原样跳过**,一个字节都不动。 -- 行内级:带 `ekp-no-break` 属性的区间(`M-x ekp-no-break-region`) +- 自动行内级:face 在 `ekp-buffer-inline-faces` 中的精确区间 + (Org 的 `org-code`/`org-verbatim`,Markdown 行内代码默认由 mode + profile 提供)使用 `ekp-inline-code-policy`。默认 `no-hyphen` + 保留源空格字面宽度并禁止词典断词,但仍可在合法源边界换行。自动 + `no-break` 区间若宽于有效栏宽,会降级为 `no-hyphen`。 +- 显式硬原子级:带 `ekp-no-break` 属性的区间(`M-x ekp-no-break-region`) 成为刚性原子——不断行、不断词、空格保持字面宽度——适合行内代码、 - 产品名、数字加单位。 + 产品名、数字加单位。原子宽于栏宽时仍保持完整,但不保证独占一行: + 最终遍可能把它与前面的普通内容放在同一条溢出行。普通欠宽候选使用 + 固定的 emergency stretch 并按正常 K-P 代价评分;若超宽候选会让最终遍 + 的活动路径全部消失,核心按 TeX 的 artificial demerits 语义保留最后 + 路径。这里没有中文孤字、单位或截图专用规则。 手动属性明确只在**当前 buffer 会话**有效:普通文本保存与重新打开不会 恢复它们。使用 `M-x ekp-allow-break-region` / @@ -197,6 +208,37 @@ mode face 或 buffer-local 的 `ekp-buffer-skip-predicate`(Org/Markdown ## 配置 +### 断行策略与测量宽度 + +默认策略的目标是让代码可读,但不把所有"看起来像代码"的片段都变成 +硬原子: + +| 选项 | 默认值 | 作用域 | 含义 | +|:-----|:-------|:-------|:-----| +| `ekp-inline-code-policy` | `no-hyphen` | 全局、profile、本地 | 行内 face 的 `normal`、`no-hyphen` 或自动适配 `no-break` | +| `ekp-hyphenation` | `auto` | 全局、profile、本地、区域命令 | `auto`/`on` 在词典可用时断词;`off` 禁止词典断词 | +| `ekp-token-break-policies` | URL/path/identifier `no-hyphen`,number-unit `no-break` | 全局、profile、本地 | 按 token 类别合并的自动策略 | +| `ekp-number-unit-suffixes` | 常见 CSS、时间、数据、频率、度量单位 | 全局、profile、本地 | 紧凑数字单位识别的后缀 | +| `ekp-kinsoku-profile` | `common` | 全局、profile、本地 | `common`、`zh`、`ja`、`off` 或 `custom` 禁则 | +| `ekp-cjk-no-line-start-extra` / `ekp-cjk-no-line-end-extra` | `""` | 全局、profile、本地 | `custom` profile 使用的附加禁则字符 | +| `ekp-overlong-token-policy` | `emergency` | 全局、profile、本地 | 普通超宽 Latin-like token 的 `emergency`、`overflow` 或 `natural` | +| `ekp-buffer-measure` | `narrowest-window` | 全局、profile、本地 | `narrowest-window`、固定像素整数或 `(max . PIXELS)` | +| `ekp-buffer-skip-faces` | 由 profile 提供 | 全局、profile、本地 | 段落级 verbatim face | +| `ekp-buffer-inline-faces` | 由 profile 提供 | 全局、profile、本地 | 使用行内策略的精确 face 区间 | +| `ekp-buffer-mode-policy-alist` | Org 与 Markdown profile | 全局/安全本地值 | 自动与手动 buffer 排版查询的 mode profile | + +有效优先级固定为:显式区域文本属性 > 显式 buffer/file/dir-local 值 > +第一个匹配的 major-mode profile > 全局默认值。区域 `ekp-break-policy` +可取 `normal`、`hyphenate`、`no-hyphen`;它只覆盖精确区间内的自动 +token/行内策略,不会创建硬原子。`ekp-no-break` 仍是唯一显式硬原子 +属性,并且胜过所有自动策略。 + +支持 file/dir local 的上述变量都有封闭的 safe-local 谓词。 +`M-x ekp-diagnose` 会报告请求宽度、最窄活动窗口、有效宽度、溢出风险、 +冲突数量,以及当前行内/断词/禁则/超宽策略摘要。EKP 菜单提供诊断与 +区域命令:普通断行、开启区域断词、关闭区域断词、清除区域断行策略、 +no-break 与 verbatim。 + ### 断词语言 ```elisp diff --git a/tests/ekp-buffer-tests.el b/tests/ekp-buffer-tests.el index c501bf0..9a76088 100644 --- a/tests/ekp-buffer-tests.el +++ b/tests/ekp-buffer-tests.el @@ -9,6 +9,7 @@ (require 'ert) (require 'ekp-buffer) +(require 'ekp-showcase) (defconst ekp-buffer-test--samples (list "简单的中文段落测试内容,排版效果应当良好稳定。" @@ -39,6 +40,21 @@ (and (consp item) (eq (car item) name))) value)))) +(defun ekp-buffer-test--strings-in-tree (tree) + "Return all strings contained anywhere in TREE." + (let (strings) + (cl-labels ((walk (value) + (cond + ((stringp value) (push value strings)) + ((consp value) + (walk (car value)) + (walk (cdr value))) + ((vectorp value) + (dotimes (i (length value)) + (walk (aref value i))))))) + (walk tree)) + (nreverse strings))) + (ert-deftest ekp-buffer-test-layout-never-changes-source-characters () "Layout changes display properties, never the logical character stream." (let ((text "中文排版 mixed words with spaces and extraordinary wrapping")) @@ -60,6 +76,28 @@ (should-not (buffer-modified-p)) (should-not (overlays-in (point-min) (point-max))))))) +(ert-deftest ekp-buffer-test-overlong-no-break-preserves-atom () + "A rigid overflow atom remains intact in the public projection." + (let* ((prefix "行内原子演示:代码片段 ") + (atom (propertize + (concat (make-string 48 ?a) " b") 'ekp-no-break t)) + (text (concat prefix atom " 后文继续。")) + (ekp-use-c-module nil)) + (ekp-buffer-test--with-text text + (ekp-justify-region (point-min) (point-max) 40) + (let* ((breaks (ekp-buffer-test--display-newline-positions)) + (atom-beg (+ (point-min) (length prefix))) + (atom-end (+ atom-beg (length atom)))) + (should breaks) + (should-not + (seq-some (lambda (position) + (and (> position atom-beg) (< position atom-end))) + breaks))) + (should (equal (substring-no-properties (buffer-string)) + (substring-no-properties text))) + (should (get-text-property (+ (point-min) (length prefix)) + 'ekp-no-break))))) + (ert-deftest ekp-buffer-test-projection-fires-no-external-change-hooks () "Projection installation and removal are silent to external change hooks." (ekp-buffer-test--with-text @@ -160,7 +198,7 @@ "A discretionary hyphen and newline live in `display', not source text." (let ((text "extraordinary hyphenation demonstration paragraph")) (ekp-buffer-test--with-text text - (ekp-justify-region (point-min) (point-max) 15) + (ekp-justify-region (point-min) (point-max) 16) (should (equal (substring-no-properties (buffer-string)) text)) (should (= (cl-count ?\n (buffer-string)) 0)) (should-not (string-match-p "-" (substring-no-properties @@ -349,6 +387,44 @@ (setq pos next))) (nreverse positions))) +(defun ekp-buffer-test--display-lines () + "Return source slices separated by EKP-owned display newlines." + (let ((beg (point-min)) + (pos (point-min)) + lines) + (while (< pos (point-max)) + (let ((display (get-text-property pos 'ekp-buffer--display))) + (when (and (stringp display) + (string-match-p "\n" + (substring-no-properties display))) + (push (buffer-substring-no-properties beg (1+ pos)) lines) + (setq beg (1+ pos)))) + (setq pos (1+ pos))) + (push (buffer-substring-no-properties beg (point-max)) lines) + (nreverse lines))) + +(defun ekp-buffer-test--single-cjk-line-p (line) + "Return non-nil when LINE is exactly one CJK source character." + (let ((trimmed (replace-regexp-in-string + "\\`[[:space:]\n\r\t]+\\|[[:space:]\n\r\t]+\\'" + "" line))) + (and (= (length trimmed) 1) + (let ((char (aref trimmed 0))) + (and (<= #x4E00 char) (<= char #x9FFF)))))) + +(defun ekp-buffer-test--display-hyphen-p () + "Return non-nil when an EKP-owned display break publishes a hyphen." + (let ((pos (point-min)) + hit) + (while (and (< pos (point-max)) (not hit)) + (let ((display (get-text-property pos 'ekp-buffer--display))) + (setq hit + (and (stringp display) + (string-match-p "-\n" + (substring-no-properties display))))) + (setq pos (1+ pos))) + hit)) + (defun ekp-buffer-test--type-string (string) "Insert STRING through the public self-insert command path." (mapc @@ -1220,7 +1296,7 @@ "An ordinary live edit must not dispatch through `ekp-justify-region'." (ekp-buffer-test--with-mode "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda" - 15 + 20 (let ((called nil) (original (symbol-function 'ekp-justify-region))) (cl-letf (((symbol-function 'ekp-justify-region) @@ -1592,6 +1668,253 @@ (ekp-unjustify-region (point-min) (point-max)) (should (equal-including-properties (buffer-string) text))))) +(ert-deftest ekp-buffer-test-org-inline-code-face-does-not-skip-paragraph () + "An Org inline-code face must not make prose stay native-wrapped." + (let* ((code (propertize "(ekp-pixel-justify STR W)" 'face 'org-code)) + (text (concat "行内原子演示: 代码片段 " code + " 之后的正文仍然需要由 EKP 负责断行。"))) + (ekp-buffer-test--with-text text + (ekp-org-setup) + (buffer-enable-undo) + (setq buffer-undo-list nil) + (set-buffer-modified-p nil) + (goto-char (+ (point-min) 7)) + (set-mark (+ (point-min) 2)) + (let ((point-before (point)) + (mark-before (mark t)) + (chars-tick (buffer-chars-modified-tick)) + (undo-before buffer-undo-list) + (overlays-before (length (overlays-in (point-min) (point-max))))) + (ekp-justify-region (point-min) (point-max) 20) + (should (get-text-property (point-min) 'ekp-justified)) + (should (equal (substring-no-properties (buffer-string)) + (substring-no-properties text))) + (should (= (point) point-before)) + (should (= (mark t) mark-before)) + (should (= (buffer-chars-modified-tick) chars-tick)) + (should (eq buffer-undo-list undo-before)) + (should-not (buffer-modified-p)) + (should (= (length (overlays-in (point-min) (point-max))) + overlays-before)) + (save-excursion + (goto-char (point-min)) + (should (search-forward "(ekp-pixel-justify STR W)" nil t)) + (should (eq (get-text-property (match-beginning 0) 'face) + 'org-code))) + (ekp-unjustify-region (point-min) (point-max)) + (should (equal-including-properties (buffer-string) text)))))) + +(ert-deftest ekp-buffer-test-org-block-face-stays-verbatim () + "An Org block face still protects its own paragraph verbatim." + (let* ((block (propertize "#+begin_src emacs-lisp\n(+ 1 2)\n#+end_src" + 'face 'org-block)) + (text (concat "prose before wraps with EKP projection\n" + block + "\nprose after wraps with EKP projection"))) + (ekp-buffer-test--with-text text + (ekp-org-setup) + (ekp-justify-region (point-min) (point-max) 20) + (goto-char (point-min)) + (should (get-text-property (point) 'ekp-justified)) + (search-forward "(+ 1 2)") + (should-not (get-text-property (match-beginning 0) 'ekp-justified)) + (ekp-unjustify-region (point-min) (point-max)) + (should (equal-including-properties (buffer-string) text))))) + +(ert-deftest ekp-buffer-test-inline-protection-has-no-single-cjk-lines () + "A narrow public layout must not publish isolated CJK rows near inline code." + (let* ((atom (propertize "(ekp-pixel-justify STR W)" + 'face 'org-code + 'ekp-no-break t)) + (text (concat "行内原子演示: 代码片段 " atom + " 永不拆散、空格保持字面宽度；不间断空格让 " + "100_000 与 3.14 MB 这类数字单位锁在同一行。"))) + (ekp-buffer-test--with-text text + (ekp-justify-region (point-min) (point-max) 11) + (let ((lines (ekp-buffer-test--display-lines))) + (should (> (length lines) 1)) + (should-not + (seq-find #'ekp-buffer-test--single-cjk-line-p lines))) + (should (equal (substring-no-properties (buffer-string)) + (substring-no-properties text))) + (should-not (overlays-in (point-min) (point-max))) + (ekp-unjustify-region (point-min) (point-max)) + (should (equal-including-properties (buffer-string) text))))) + +(ert-deftest ekp-buffer-test-showcase-1d-publishes-no-single-cjk-lines () + "The exact public 168px showcase sample must not publish isolated CJK rows." + (let ((text (ekp-showcase--sample)) + (ekp-use-c-module nil)) + (ekp-buffer-test--with-text text + (ekp-showcase-mode) + (ekp-justify-region (point-min) (point-max) 168) + (let* ((lines (ekp-buffer-test--display-lines)) + (single-cjk-lines + (seq-filter #'ekp-buffer-test--single-cjk-line-p lines))) + (should (> (length lines) 1)) + (should-not single-cjk-lines)) + (should (equal (substring-no-properties (buffer-string)) + (substring-no-properties text))) + (should-not (overlays-in (point-min) (point-max)))))) + +(ert-deftest ekp-buffer-test-showcase-parshape-publishes-no-single-cjk-lines () + "The exact parshape 280px showcase must not publish isolated CJK rows." + (let ((text (ekp-showcase--sample)) + (ekp-use-c-module nil) + (ekp-looseness 1)) + (ekp-buffer-test--with-text text + (ekp-showcase-mode) + (setq-local ekp-showcase--width 280 + ekp-showcase--parshape-on t) + (ekp-showcase--apply-parshape) + (ekp-justify-region (point-min) (point-max) 280) + (let* ((lines (ekp-buffer-test--display-lines)) + (single-cjk-lines + (seq-filter #'ekp-buffer-test--single-cjk-line-p lines))) + (should (> (length lines) 1)) + (should-not single-cjk-lines)) + (should (equal (substring-no-properties (buffer-string)) + (substring-no-properties text))) + (should-not (overlays-in (point-min) (point-max)))))) + +(ert-deftest ekp-buffer-test-break-policy-precedence-public-path () + "Public policy resolution is region, local, mode, then global." + (dolist (option '(ekp-hyphenation + ekp-inline-code-policy + ekp-buffer-mode-policy-alist + ekp-buffer-inline-faces + ekp-overlong-token-policy)) + (should (boundp option))) + (let ((original-hyphenation (default-value 'ekp-hyphenation)) + (original-inline-policy (default-value 'ekp-inline-code-policy)) + (original-inline-faces (default-value 'ekp-buffer-inline-faces)) + (original-mode-policy + (default-value 'ekp-buffer-mode-policy-alist)) + (original-overlong (default-value 'ekp-overlong-token-policy))) + (unwind-protect + (let* ((word "internationalization") + (auto-atom (propertize "auto inline atom" 'face 'org-code)) + (explicit-atom + (propertize "manual no break atom with spaces" + 'face 'org-code 'ekp-no-break t)) + (text (concat word " " word " " auto-atom " " explicit-atom)) + captures + (original-layout (symbol-function 'ekp-buffer--layout-plan))) + (set-default-toplevel-value 'ekp-hyphenation 'off) + (set-default-toplevel-value 'ekp-inline-code-policy 'normal) + (set-default-toplevel-value 'ekp-buffer-inline-faces nil) + (set-default-toplevel-value + 'ekp-overlong-token-policy 'emergency) + (set-default-toplevel-value + 'ekp-buffer-mode-policy-alist + '((text-mode . ((ekp-hyphenation . on) + (ekp-inline-code-policy . no-break) + (ekp-buffer-inline-faces . (org-code)) + (ekp-overlong-token-policy . natural))))) + (ekp-buffer-test--with-text text + (text-mode) + (let ((region-beg (save-excursion + (goto-char (point-min)) + (search-forward word) + (search-forward word) + (match-beginning 0))) + (explicit-beg (save-excursion + (goto-char (point-min)) + (search-forward explicit-atom) + (match-beginning 0))) + (explicit-end (save-excursion + (goto-char (point-min)) + (search-forward explicit-atom) + (match-end 0)))) + (cl-letf (((symbol-function 'ekp-buffer--layout-plan) + (lambda (source width context) + (push (list :source (copy-sequence source) + :width width + :context (copy-tree context)) + captures) + (funcall original-layout source width context)))) + ;; Mode profile beats real global defaults; no profile value is + ;; copied into a buffer-local variable. + (ekp-justify-region (point-min) (point-max) 80) + (let ((context (plist-get (car captures) :context))) + (should (eq (plist-get context :hyphenation) 'on)) + (should (eq (plist-get context :inline-code-policy) + 'no-break)) + (should (equal (plist-get context :inline-faces) + '(org-code))) + (should (eq (plist-get context :overlong-token-policy) + 'natural))) + (should-not (local-variable-p 'ekp-hyphenation)) + (should-not (local-variable-p 'ekp-inline-code-policy)) + (should-not (local-variable-p 'ekp-buffer-inline-faces)) + (ekp-unjustify-region (point-min) (point-max)) + (setq captures nil) + + ;; Explicit buffer/file/dir-local values use the same public + ;; variables and outrank the matching mode profile. + (setq-local ekp-hyphenation 'off) + (setq-local ekp-inline-code-policy 'normal) + (setq-local ekp-buffer-inline-faces nil) + (ekp-justify-region (point-min) (point-max) 80) + (let ((context (plist-get (car captures) :context))) + (should (eq (plist-get context :hyphenation) 'off)) + (should (eq (plist-get context :inline-code-policy) + 'normal)) + (should-not (plist-get context :inline-faces))) + (ekp-unjustify-region (point-min) (point-max)) + (setq captures nil) + + ;; Exact region policy is passed only on the annotated source + ;; range and outranks explicit locals in the core planner. + (setq-local ekp-overlong-token-policy 'emergency) + (put-text-property region-beg (+ region-beg (length word)) + 'ekp-break-policy 'hyphenate) + (put-text-property explicit-beg explicit-end + 'ekp-break-policy 'hyphenate) + (ekp-justify-region (point-min) (point-max) 40) + (should (get-text-property (point-min) 'ekp-justified)) + (let* ((source (plist-get (car captures) :source)) + (region-offset (- region-beg (point-min))) + (region-end (+ region-offset (length word))) + (before-explicit (- explicit-beg (point-min))) + (explicit-offset before-explicit) + (explicit-finish (- explicit-end (point-min)))) + (should + (eq (get-text-property region-offset 'ekp-break-policy + source) + 'hyphenate)) + (should-not + (get-text-property (1- region-offset) 'ekp-break-policy + source)) + (should-not + (get-text-property region-end 'ekp-break-policy source)) + (should + (eq (get-text-property explicit-offset 'ekp-break-policy + source) + 'hyphenate)) + (should + (get-text-property explicit-offset 'ekp-no-break source)) + (should-not + (seq-some + (lambda (pos) + (and (>= pos explicit-beg) (< pos explicit-end))) + (ekp-buffer-test--display-newline-positions))) + (should (< before-explicit explicit-finish))) + (should (equal (substring-no-properties (buffer-string)) + (substring-no-properties text))) + (ekp-unjustify-region (point-min) (point-max)) + (should (equal (substring-no-properties (buffer-string)) + (substring-no-properties text))))))) + (set-default-toplevel-value 'ekp-hyphenation original-hyphenation) + (set-default-toplevel-value + 'ekp-inline-code-policy original-inline-policy) + (set-default-toplevel-value + 'ekp-buffer-inline-faces original-inline-faces) + (set-default-toplevel-value + 'ekp-buffer-mode-policy-alist original-mode-policy) + (set-default-toplevel-value + 'ekp-overlong-token-policy original-overlong)))) + (ert-deftest ekp-buffer-test-skip-predicate () "The paragraph predicate is the general escape hatch." (let ((text "keepme raw spacing\nnormal prose that wraps around")) @@ -2224,10 +2547,14 @@ keeps the buffer justified, and leaves it unmodified." (ekp-markdown-setup) (should (equal font-lock-extra-managed-props '(display composition))) - (should (equal ekp-buffer-skip-faces ekp-buffer-markdown-skip-faces)))) + (should (local-variable-p 'ekp-buffer-skip-faces)) + (should (local-variable-p 'ekp-buffer-inline-faces)) + (should (equal ekp-buffer-skip-faces ekp-buffer-markdown-block-faces)) + (should (equal ekp-buffer-inline-faces + ekp-buffer-markdown-inline-faces)))) (ert-deftest ekp-buffer-test-org-auto-preset () - "Enabling the mode in an Org buffer applies the Org skip preset." + "Auto mode consults the Org profile without copying preset locals." (with-temp-buffer (org-mode) (insert "普通正文段落内容足够长断行几次的样子") @@ -2235,7 +2562,13 @@ keeps the buffer justified, and leaves it unmodified." (lambda (&optional _) 100))) (ekp-auto-justify-mode 1) (unwind-protect - (should (equal ekp-buffer-skip-faces ekp-buffer-org-skip-faces)) + (let ((context (ekp-buffer--policy-context))) + (should-not (local-variable-p 'ekp-buffer-skip-faces)) + (should-not (local-variable-p 'ekp-buffer-inline-faces)) + (should (equal (plist-get context :block-faces) + ekp-buffer-org-block-faces)) + (should (equal (plist-get context :inline-faces) + ekp-buffer-org-inline-faces))) (ekp-auto-justify-mode -1))))) ;;;; Lazy re-flow scheduling @@ -2337,6 +2670,785 @@ a zero budget still makes progress (exactly one chunk)." (ekp-buffer--process-chunk (current-buffer))))) (should-not ekp-buffer--pending)))) +;;;; G003 configurable buffer policy contracts + +(defun ekp-buffer-test--private-policy-property-present-p () + "Return non-nil when any private policy property leaked to the buffer." + (let ((properties '(ekp--break-policy ekp--hyphenation ekp--literal-spacing + ekp--policy-provenance ekp--automatic-no-break + ekp--resolved-policy ekp--no-hyphen + ekp--token-category ekp--downgraded-no-break)) + (pos (point-min)) + hit) + (while (and (< pos (point-max)) (not hit)) + (setq hit + (seq-some + (lambda (property) + (get-text-property pos property)) + properties) + pos (1+ pos))) + hit)) + +(defun ekp-buffer-test--drain-policy-reflow () + "Run the scheduled zero-delay policy reflow for the current buffer." + (let* ((timer ekp-buffer--policy-reflow-timer) + (callback (timer--function timer)) + (arguments (timer--args timer))) + (should (timerp timer)) + (should (eq callback #'ekp-buffer--reflow-for-policy-change)) + (apply callback arguments) + (when (timerp ekp-buffer--policy-reflow-timer) + (cancel-timer ekp-buffer--policy-reflow-timer) + (setq ekp-buffer--policy-reflow-timer nil))) + (should-not (timerp ekp-buffer--policy-reflow-timer))) + +(ert-deftest ekp-buffer-test-g003-inline-profile-is-exact-span-only () + "Inline face lists affect exact spans; outside gaps remain breakable." + (let* ((inline-text "aa bb cc") + (inline (propertize inline-text 'face '(org-code bold))) + (block (propertize "#+begin_src\n(+ 1 2)\n#+end_src" + 'face 'org-block)) + (text (concat "prefix prose wraps before " inline + " after wraps more words with trailing prose\n" + block "\n" + "tail prose wraps normally"))) + (ekp-buffer-test--with-text text + (ekp-org-setup) + (let ((before (buffer-string)) + inline-beg inline-end) + (goto-char (point-min)) + (search-forward inline-text) + (setq inline-beg (match-beginning 0) + inline-end (match-end 0)) + (ekp-justify-region (point-min) (point-max) 160) + (should (get-text-property (point-min) 'ekp-justified)) + (should (equal (buffer-substring-no-properties inline-beg inline-end) + inline-text)) + (let* ((span (seq-find + (lambda (candidate) + (and (= (marker-position + (ekp-buffer--span-beg candidate)) + (point-min)) + (< inline-end + (marker-position + (ekp-buffer--span-end candidate))))) + ekp-buffer--spans)) + (plan (and span (ekp-buffer--span-plan span))) + (source (and plan (ekp-layout-plan-string plan))) + (base (and span + (marker-position (ekp-buffer--span-beg span)))) + (inline-start (- inline-beg base)) + (inline-finish (- inline-end base)) + literal-space-runs + outside-gap-seen) + (should span) + (should (equal (substring source inline-start inline-finish) + inline-text)) + (cl-loop for box across (ekp-layout-plan-boxes plan) + for offset across (ekp-layout-plan-offsets plan) + when (and (<= inline-start (car offset)) + (<= (cdr offset) inline-finish) + (string-match-p + "\\` +\\'" (substring-no-properties box))) + do (push (substring-no-properties box) + literal-space-runs)) + (cl-loop for line across (ekp-layout-plan-lines plan) + do (cl-loop + for gap across (ekp-layout-line-gaps line) + for start = (ekp-layout-gap-source-start gap) + for finish = (ekp-layout-gap-source-end gap) + when (and (or (<= finish inline-start) + (<= inline-finish start)) + (string-match-p + "\\` +\\'" (substring source start finish))) + do (setq outside-gap-seen t) + when (and (<= inline-start start) + (<= finish inline-finish) + (string-match-p + "\\` +\\'" (substring source start finish))) + do + (should (= (ekp-layout-gap-target-pixel gap) + (ekp-layout-gap-natural-pixel gap))))) + (should (member " " literal-space-runs)) + (should (member " " literal-space-runs)) + (should outside-gap-seen)) + (should-not + (cl-loop for pos from inline-beg below inline-end + thereis + (let ((display (get-text-property pos 'ekp-buffer--display))) + (and (stringp display) + (string-match-p "-\n" + (substring-no-properties display)))))) + (should-not (ekp-buffer-test--private-policy-property-present-p)) + (goto-char (point-min)) + (search-forward "(+ 1 2)") + (should-not (get-text-property (match-beginning 0) 'ekp-justified)) + (ekp-unjustify-region (point-min) (point-max)) + (should (equal-including-properties (buffer-string) before)))))) + +(ert-deftest ekp-buffer-test-g004-inline-face-breaks-at-source-spaces () + "Inline faces use the public policy path without becoming hard atoms." + (let* ((face 'ekp-buffer-test-inline-code-face) + (inline-text + "(ekp pixel justify STR W) alpha beta gamma delta epsilon zeta") + (text (propertize inline-text 'face face)) + (ekp-buffer-inline-faces (list face)) + (ekp-inline-code-policy 'no-hyphen) + (ekp-hyphenation 'off) + (ekp-use-c-module nil)) + (ekp-buffer-test--with-text text + (let ((before (buffer-string)) + (inline-beg (point-min)) + (inline-end (point-max))) + (ekp-justify-region (point-min) (point-max) 20) + (should-not (text-property-not-all + inline-beg inline-end 'ekp-no-break nil)) + (let* ((span (seq-find + (lambda (candidate) + (and (<= (marker-position + (ekp-buffer--span-beg candidate)) + inline-beg) + (<= inline-end + (marker-position + (ekp-buffer--span-end candidate))))) + ekp-buffer--spans)) + (plan (and span (ekp-buffer--span-plan span))) + (source (and plan (ekp-layout-plan-string plan))) + (breaks-inside + (and plan + (cl-loop + for line across (ekp-layout-plan-lines plan) + for start = (ekp-layout-line-break-source-start line) + for end = (ekp-layout-line-break-source-end line) + when (and start end (< start end) + (<= start (length inline-text)) + (<= end (length inline-text))) + collect (substring source start end)))) + (hyphen-inside + (and plan + (seq-some #'ekp-layout-line-hyphen-p + (append (ekp-layout-plan-lines plan) nil))))) + (should span) + (should plan) + (should (> (length (ekp-layout-plan-lines plan)) 1)) + (should breaks-inside) + (dolist (break breaks-inside) + (should (string-match-p "\\`[[:space:]\n\r\t]+\\'" + break))) + (should-not hyphen-inside) + (should (equal (substring-no-properties source) + inline-text)) + (should (equal (get-text-property 0 'face source) face))) + (should (equal (substring-no-properties (buffer-string)) + (substring-no-properties before))) + (should (eq (get-text-property inline-beg 'face) face)) + (should-not (overlays-in (point-min) (point-max))))))) + +(ert-deftest ekp-buffer-test-g003-profile-precedence-and-auto-consult-only () + "Auto profiles are consult-only; explicit locals and region policy win." + (should (boundp 'ekp-buffer-mode-policy-alist)) + (let ((original-hyphenation (default-value 'ekp-hyphenation)) + (original-inline-policy (default-value 'ekp-inline-code-policy)) + (original-mode-policy + (default-value 'ekp-buffer-mode-policy-alist))) + (unwind-protect + (progn + (set-default-toplevel-value 'ekp-hyphenation 'off) + (set-default-toplevel-value 'ekp-inline-code-policy 'normal) + (set-default-toplevel-value + 'ekp-buffer-mode-policy-alist + '((org-mode . ((ekp-hyphenation . on) + (ekp-inline-code-policy . no-hyphen) + (ekp-buffer-measure . 12))))) + (with-temp-buffer + (org-mode) + (insert "internationalization internationalization internationalization") + (cl-letf (((symbol-function 'ekp-buffer--window-pixel) + (lambda (&optional _) 100))) + (ekp-auto-justify-mode 1) + (unwind-protect + (progn + ;; Mode profiles must be consulted without copying values + ;; into locals. File and dir locals use these same public + ;; variables; no separate file/directory policy alists. + (should-not (local-variable-p 'ekp-buffer-skip-faces)) + (should-not (local-variable-p 'ekp-inline-code-policy)) + (should-not (local-variable-p 'ekp-hyphenation)) + (should-not (local-variable-p 'ekp-buffer-measure)) + (should (ekp-buffer-test--display-hyphen-p)) + (ekp-unjustify-region (point-min) (point-max)) + ;; Explicit locals are the public file/dir/buffer-local + ;; owner and outrank the mode profile without manual cache + ;; clearing. + (setq-local ekp-hyphenation 'off) + (ekp-justify-region (point-min) (point-max) 12) + (should-not (ekp-buffer-test--display-hyphen-p)) + (ekp-unjustify-region (point-min) (point-max)) + ;; Region policy is the final override over explicit + ;; locals. + (put-text-property (point-min) (+ (point-min) 20) + 'ekp-break-policy 'hyphenate) + (ekp-justify-region (point-min) (point-max) 12) + (should (ekp-buffer-test--display-hyphen-p))) + (ekp-auto-justify-mode -1))))) + (set-default-toplevel-value 'ekp-hyphenation original-hyphenation) + (set-default-toplevel-value + 'ekp-inline-code-policy original-inline-policy) + (set-default-toplevel-value + 'ekp-buffer-mode-policy-alist original-mode-policy)))) + +(ert-deftest ekp-buffer-test-g003-safe-local-values-are-closed () + "Documented locals are safe; malformed and executable values are rejected." + (dolist (case '((ekp-inline-code-policy . normal) + (ekp-inline-code-policy . no-hyphen) + (ekp-inline-code-policy . no-break) + (ekp-hyphenation . auto) + (ekp-hyphenation . on) + (ekp-hyphenation . off) + (ekp-overlong-token-policy . emergency) + (ekp-overlong-token-policy . overflow) + (ekp-overlong-token-policy . natural) + (ekp-buffer-measure . narrowest-window) + (ekp-buffer-measure . (max . 24)) + (ekp-buffer-measure . 30) + (ekp-emergency-stretch-pixel . nil) + (ekp-emergency-stretch-pixel . 0) + (ekp-emergency-stretch-pixel . 7) + (ekp-buffer-mode-policy-alist + . ((text-mode . ((ekp-emergency-stretch-pixel . 7))))) + (ekp-token-break-policies + . ((identifier . normal) (path . no-hyphen))))) + (should (safe-local-variable-p (car case) (cdr case)))) + (dolist (case '((ekp-inline-code-policy . maybe) + (ekp-buffer-measure . window) + (ekp-buffer-measure . (max . "wide")) + (ekp-buffer-measure . 0) + (ekp-emergency-stretch-pixel . -1) + (ekp-emergency-stretch-pixel . 1.5) + (ekp-buffer-mode-policy-alist + . ((text-mode . ((ekp-emergency-stretch-pixel . -1))))) + (ekp-token-break-policies . ((identifier . execute))) + (ekp-buffer-skip-faces . ((lambda () t))) + (ekp-buffer-skip-predicate . ignore) + (ekp-buffer-skip-predicate . (lambda (_) t)))) + (should-not (safe-local-variable-p (car case) (cdr case))))) + +(ert-deftest ekp-buffer-test-emergency-stretch-policy-context-and-reflow () + "Emergency stretch follows global/profile/local precedence and reflows once." + (let ((original-stretch (default-value 'ekp-emergency-stretch-pixel)) + (original-profile (default-value 'ekp-buffer-mode-policy-alist))) + (unwind-protect + (progn + (should (memq #'ekp-buffer--policy-variable-changed + (get-variable-watchers + 'ekp-emergency-stretch-pixel))) + (set-default-toplevel-value 'ekp-emergency-stretch-pixel 3) + (set-default-toplevel-value + 'ekp-buffer-mode-policy-alist + '((text-mode . ((ekp-emergency-stretch-pixel . 7))))) + (ekp-buffer-test--with-text "emergency stretch context alpha beta" + (text-mode) + (should (= (plist-get (ekp-buffer--policy-context) + :emergency-stretch-pixel) + 7)) + (setq-local ekp-emergency-stretch-pixel 11) + (should (= (plist-get (ekp-buffer--policy-context) + :emergency-stretch-pixel) + 11)) + (kill-local-variable 'ekp-emergency-stretch-pixel) + (should (= (plist-get (ekp-buffer--policy-context) + :emergency-stretch-pixel) + 7)) + (setq-default ekp-buffer-mode-policy-alist nil) + (should (= (plist-get (ekp-buffer--policy-context) + :emergency-stretch-pixel) + 3))) + (ekp-buffer-test--with-text "emergency stretch watcher alpha beta" + (text-mode) + (cl-letf (((symbol-function 'ekp-buffer--window-pixel) + (lambda (&optional _) 30))) + (ekp-auto-justify-mode 1) + (unwind-protect + (let ((calls 0) + contexts + (original-layout + (symbol-function 'ekp-buffer--layout-plan)) + (original-reflow + (symbol-function 'ekp-buffer--reflow))) + (cl-letf (((symbol-function 'ekp-buffer--layout-plan) + (lambda (source width context) + (push (copy-tree context) contexts) + (funcall original-layout + source width context))) + ((symbol-function 'ekp-buffer--reflow) + (lambda (&rest args) + (setq calls (1+ calls)) + (apply original-reflow args)))) + (setq-default ekp-emergency-stretch-pixel 9) + (should (= calls 0)) + (ekp-buffer-test--drain-policy-reflow) + (should (= calls 1)) + (should (= (plist-get (car contexts) + :emergency-stretch-pixel) + 9)))) + (ekp-auto-justify-mode -1))))) + (set-default-toplevel-value 'ekp-emergency-stretch-pixel original-stretch) + (set-default-toplevel-value + 'ekp-buffer-mode-policy-alist original-profile)))) + +(ert-deftest ekp-buffer-test-g003-break-policy-region-commands () + "Region commands write exact break-policy values and fail read-only first." + (dolist (command '(ekp-normal-break-region + ekp-enable-hyphenation-region + ekp-disable-hyphenation-region + ekp-clear-break-policy-region)) + (should (fboundp command))) + (ekp-buffer-test--with-text "alpha beta gamma" + (let ((commands '((ekp-normal-break-region . normal) + (ekp-enable-hyphenation-region . hyphenate) + (ekp-disable-hyphenation-region . no-hyphen) + (ekp-clear-break-policy-region . nil))) + messages) + (dolist (entry commands) + (set-mark (point-min)) + (goto-char (+ (point-min) 5)) + (activate-mark) + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (push (apply #'format format-string args) messages)))) + (call-interactively (car entry))) + (should (eq (get-text-property (point-min) 'ekp-break-policy) + (cdr entry)))) + (should (cl-every + (lambda (text) (string-match-p "current buffer session" text)) + messages)))) + (ekp-buffer-test--with-text "read only" + (set-mark (point-min)) + (goto-char (point-max)) + (activate-mark) + (read-only-mode 1) + (should-error (call-interactively #'ekp-enable-hyphenation-region) + :type 'buffer-read-only))) + +(defun ekp-buffer-test--manual-policy-command-clears-projection + (command property expected) + "Assert COMMAND invalidates a manual projection for PROPERTY." + (ekp-buffer-test--with-text + "alpha beta gamma delta epsilon zeta eta theta" + (let ((region-beg (+ (point-min) 6)) + (region-end (+ (point-min) 16))) + (ekp-justify-region (point-min) (point-max) 20) + (should (= (length ekp-buffer--spans) 1)) + (should ekp-buffer--filter-installed) + (let* ((span (car ekp-buffer--spans)) + (source (ekp-layout-plan-string (ekp-buffer--span-plan span))) + (offset (- region-beg + (marker-position (ekp-buffer--span-beg span))))) + (should-not (get-text-property offset property source))) + (set-mark region-beg) + (goto-char region-end) + (activate-mark) + (cl-letf (((symbol-function 'message) #'ignore)) + (call-interactively command)) + (should (eq (get-text-property region-beg property) expected)) + (when ekp-buffer--spans + (let* ((span (car ekp-buffer--spans)) + (source (ekp-layout-plan-string (ekp-buffer--span-plan span))) + (offset (- region-beg + (marker-position (ekp-buffer--span-beg span))))) + (should (eq (get-text-property offset property source) + expected)))) + (should-not ekp-buffer--spans) + (should-not ekp-buffer--filter-installed) + (should-not (eq filter-buffer-substring-function + #'ekp-buffer--filter-buffer-substring))))) + +(ert-deftest ekp-buffer-test-g003-manual-break-policy-invalidates-projection () + "Manual break-policy changes clear intersecting stale projections." + (ekp-buffer-test--manual-policy-command-clears-projection + #'ekp-enable-hyphenation-region 'ekp-break-policy 'hyphenate)) + +(ert-deftest ekp-buffer-test-g003-manual-no-break-invalidates-projection () + "Manual no-break changes clear intersecting stale projections." + (ekp-buffer-test--manual-policy-command-clears-projection + #'ekp-no-break-region 'ekp-no-break t)) + +(ert-deftest ekp-buffer-test-g003-measure-and-diagnose-contract () + "Measure modes use mocked windows and diagnose exposes effective policy." + (with-temp-buffer + (let ((widths '((w1 . 16) (w2 . 40)))) + (cl-letf (((symbol-function 'get-buffer-window-list) + (lambda (&rest _) '(w1 w2))) + ((symbol-function 'ekp-buffer--window-pixel) + (lambda (&optional window) + (alist-get window widths)))) + (dolist (case '((narrowest-window . 16) + ((max . 12) . 12) + ((max . 24) . 16) + (30 . 30))) + (let ((ekp-buffer-measure (car case))) + (should (= (ekp-buffer--effective-width) (cdr case))))) + (let* ((ekp-buffer-measure 30) + (ekp-inline-code-policy 'no-hyphen) + (ekp-hyphenation 'auto) + (ekp-kinsoku-profile 'common) + (ekp-overlong-token-policy 'emergency) + diagnostic-message + (report + (cl-letf (((symbol-function 'message) + (lambda (format-string &rest args) + (setq diagnostic-message + (apply #'format format-string args))))) + (ekp-diagnose)))) + (dolist (key '(:requested :narrowest :effective :policy + :conflicts :overflow-risk)) + (should (plist-member report key))) + (should (equal (plist-get report :requested) 30)) + (should (= (plist-get report :narrowest) 16)) + (should (= (plist-get report :effective) 30)) + (should (plist-get report :overflow-risk)) + (should-not (plist-get report :conflicts)) + (let ((policy (plist-get report :policy))) + (should (eq (plist-get policy :inline-code-policy) + 'no-hyphen)) + (should (eq (plist-get policy :hyphenation) 'auto)) + (should (eq (plist-get policy :kinsoku-profile) 'common)) + (should (eq (plist-get policy :overlong-token-policy) + 'emergency))) + (dolist (fragment '("requested 30" + "narrowest 16" + "effective 30" + "overflow risk" + "0 conflicts" + "inline-code no-hyphen" + "hyphenation auto" + "kinsoku common" + "overlong emergency")) + (should (string-match-p (regexp-quote fragment) + diagnostic-message)))))))) + +(ert-deftest ekp-buffer-test-g003-policy-watchers-schedule-one-reflow () + "Global and local policy changes trigger one reflow; let bindings do not." + (let ((original-default (default-value 'ekp-inline-code-policy)) + (original-profile (default-value 'ekp-buffer-mode-policy-alist))) + (unwind-protect + (progn + (ekp-buffer-test--with-text "alpha beta gamma delta" + (text-mode) + (cl-letf (((symbol-function 'ekp-buffer--window-pixel) + (lambda (&optional _) 30))) + (ekp-auto-justify-mode 1) + (unwind-protect + (let ((calls 0) + contexts + (original-layout + (symbol-function 'ekp-buffer--layout-plan)) + (original-reflow + (symbol-function 'ekp-buffer--reflow))) + (goto-char (+ (point-min) 5)) + (set-marker (mark-marker) (+ (point-min) 11)) + (setq mark-active nil) + (cl-letf (((symbol-function 'ekp-buffer--layout-plan) + (lambda (source width context) + (push (copy-tree context) contexts) + (funcall original-layout + source width context))) + ((symbol-function 'ekp-buffer--reflow) + (lambda (&rest args) + (setq calls (1+ calls)) + (apply original-reflow args)))) + (let ((source-before + (substring-no-properties (buffer-string))) + (modified-before (buffer-modified-p)) + (undo-before buffer-undo-list) + (tick-before + (buffer-chars-modified-tick)) + (overlay-count-before + (length (overlays-in (point-min) + (point-max)))) + (point-before (point)) + (mark-before (marker-position (mark-marker))) + (mark-active-before mark-active) + (generation-before ekp-buffer--generation)) + (setq-default ekp-inline-code-policy 'normal) + (should (= calls 0)) + (ekp-buffer-test--drain-policy-reflow) + (should (= calls 1)) + (should (> ekp-buffer--generation generation-before)) + (should (equal (substring-no-properties + (buffer-string)) + source-before)) + (should (eq (buffer-modified-p) modified-before)) + (should (eq buffer-undo-list undo-before)) + (should (equal buffer-undo-list undo-before)) + (should (= (buffer-chars-modified-tick) + tick-before)) + (should (= (length (overlays-in (point-min) + (point-max))) + overlay-count-before)) + (should (= (point) point-before)) + (should (= (marker-position (mark-marker)) + mark-before)) + (should (eq mark-active mark-active-before)) + (should (eq (plist-get (car contexts) + :inline-code-policy) + 'normal))) + (let ((same-generation ekp-buffer--generation)) + (setq-default ekp-inline-code-policy 'normal) + (should-not (timerp ekp-buffer--policy-reflow-timer)) + (should (= calls 1)) + (should (= ekp-buffer--generation same-generation))) + (setq contexts nil) + (let ((local-generation ekp-buffer--generation)) + (setq-local ekp-inline-code-policy 'no-hyphen) + (should (= calls 1)) + (ekp-buffer-test--drain-policy-reflow) + (should (= calls 2)) + (should (> ekp-buffer--generation local-generation)) + (should (eq (plist-get (car contexts) + :inline-code-policy) + 'no-hyphen))) + (let ((same-local-generation ekp-buffer--generation)) + (setq-local ekp-inline-code-policy 'no-hyphen) + (when (timerp ekp-buffer--policy-reflow-timer) + (ekp-buffer-test--drain-policy-reflow)) + (should-not (timerp ekp-buffer--policy-reflow-timer)) + (should (= calls 2)) + (should (= ekp-buffer--generation + same-local-generation))) + (setq contexts nil) + (let ((local-shield-generation + ekp-buffer--generation) + (local-shield-cache + ekp-buffer--live-plan-cache) + (local-shield-context + (copy-tree (ekp-buffer--policy-context)))) + (setq-default ekp-inline-code-policy 'no-break) + (when (timerp ekp-buffer--policy-reflow-timer) + (ekp-buffer-test--drain-policy-reflow)) + (should-not (timerp ekp-buffer--policy-reflow-timer)) + (should (= calls 2)) + (should (= ekp-buffer--generation + local-shield-generation)) + (should (eq ekp-buffer--live-plan-cache + local-shield-cache)) + (should (equal (ekp-buffer--policy-context) + local-shield-context)) + (should (eq (plist-get local-shield-context + :inline-code-policy) + 'no-hyphen))) + (let ((let-generation ekp-buffer--generation)) + (let ((ekp-inline-code-policy 'normal)) + (ignore ekp-inline-code-policy)) + (should-not (timerp ekp-buffer--policy-reflow-timer)) + (should (= calls 2)) + (should (= ekp-buffer--generation let-generation))))) + (ekp-auto-justify-mode -1))))) + (setq-default ekp-inline-code-policy 'normal) + (setq-default + ekp-buffer-mode-policy-alist + '((text-mode . ((ekp-inline-code-policy . no-hyphen))))) + (ekp-buffer-test--with-text "profile alpha beta gamma" + (text-mode) + (cl-letf (((symbol-function 'ekp-buffer--window-pixel) + (lambda (&optional _) 30))) + (ekp-auto-justify-mode 1) + (unwind-protect + (let ((calls 0) + contexts + (original-layout + (symbol-function 'ekp-buffer--layout-plan)) + (original-reflow + (symbol-function 'ekp-buffer--reflow))) + (cl-letf (((symbol-function 'ekp-buffer--layout-plan) + (lambda (source width context) + (push (copy-tree context) contexts) + (funcall original-layout + source width context))) + ((symbol-function 'ekp-buffer--reflow) + (lambda (&rest args) + (setq calls (1+ calls)) + (apply original-reflow args)))) + (let ((generation-before ekp-buffer--generation) + (cache-before ekp-buffer--live-plan-cache) + (context-before + (copy-tree (ekp-buffer--policy-context)))) + (setq-default ekp-inline-code-policy 'no-break) + (when (timerp ekp-buffer--policy-reflow-timer) + (ekp-buffer-test--drain-policy-reflow)) + (should-not (timerp ekp-buffer--policy-reflow-timer)) + (should (= calls 0)) + (should (= ekp-buffer--generation + generation-before)) + (should (eq ekp-buffer--live-plan-cache + cache-before)) + (should (equal (ekp-buffer--policy-context) + context-before)) + (should (eq (plist-get context-before + :inline-code-policy) + 'no-hyphen))))) + (ekp-auto-justify-mode -1))))) + (set-default-toplevel-value 'ekp-inline-code-policy original-default) + (set-default-toplevel-value + 'ekp-buffer-mode-policy-alist original-profile))) + +(ert-deftest ekp-buffer-test-g003-policy-watchers-local-profile-transitions () + "Local/profile effective policy transitions schedule post-set reflow." + (let ((original-default (default-value 'ekp-inline-code-policy)) + (original-profile (default-value 'ekp-buffer-mode-policy-alist))) + (unwind-protect + (progn + (setq-default ekp-inline-code-policy 'normal) + (setq-default + ekp-buffer-mode-policy-alist + '((text-mode . ((ekp-inline-code-policy . no-hyphen))))) + (ekp-buffer-test--with-text "profile transition alpha beta" + (text-mode) + (cl-letf (((symbol-function 'ekp-buffer--window-pixel) + (lambda (&optional _) 30))) + (ekp-auto-justify-mode 1) + (unwind-protect + (let ((calls 0) + contexts + (original-layout + (symbol-function 'ekp-buffer--layout-plan)) + (original-reflow + (symbol-function 'ekp-buffer--reflow))) + (cl-letf (((symbol-function 'ekp-buffer--layout-plan) + (lambda (source width context) + (push (copy-tree context) contexts) + (funcall original-layout + source width context))) + ((symbol-function 'ekp-buffer--reflow) + (lambda (&rest args) + (setq calls (1+ calls)) + (apply original-reflow args)))) + (setq-local ekp-inline-code-policy 'normal) + (should (timerp ekp-buffer--policy-reflow-timer)) + (ekp-buffer-test--drain-policy-reflow) + (should (= calls 1)) + (should (eq (plist-get (car contexts) + :inline-code-policy) + 'normal)) + (setq contexts nil) + (kill-local-variable 'ekp-inline-code-policy) + (should (timerp ekp-buffer--policy-reflow-timer)) + (ekp-buffer-test--drain-policy-reflow) + (should (= calls 2)) + (should (eq (plist-get (car contexts) + :inline-code-policy) + 'no-hyphen)))) + (ekp-auto-justify-mode -1))))) + (set-default-toplevel-value 'ekp-inline-code-policy original-default) + (set-default-toplevel-value + 'ekp-buffer-mode-policy-alist original-profile)))) + +(ert-deftest ekp-buffer-test-g003-natural-overlong-conflict-is-paragraph-local () + "Natural overlong paragraphs stay unprojected and clear after fitting." + (let* ((ekp-overlong-token-policy 'natural) + (long-token "supercalifragilisticexpialidocious") + (text (concat long-token "\n汉字段落可以规划")) + (original (symbol-function 'ekp--measured-width))) + (cl-letf (((symbol-function 'ekp--measured-width) + (lambda (string) + (let ((plain (substring-no-properties string))) + (if (equal plain long-token) + 40 + (funcall original string)))))) + (ekp-buffer-test--with-text text + (ekp-justify-region (point-min) (point-max) 8) + (should-not (get-text-property (point-min) 'ekp-justified)) + (should (seq-some + (lambda (conflict) + (string-match-p "overlong-token-natural" (caddr conflict))) + ekp-buffer--conflicts)) + (goto-char (point-max)) + (should (get-text-property (1- (point)) 'ekp-justified)) + (ekp-unjustify-region (point-min) (point-max)) + (setq ekp-buffer--conflicts nil) + (ekp-justify-region (point-min) (point-max) 80) + (should-not ekp-buffer--conflicts) + (should (equal (substring-no-properties (buffer-string)) text)))))) + +(ert-deftest ekp-buffer-test-g003-live-identity-includes-policy-and-properties () + "Live history keys include policy, measure, profile, and source props." + (dolist (symbol '(ekp-buffer-measure ekp-buffer-mode-policy-alist + ekp-buffer-inline-faces)) + (should (boundp symbol))) + (ekp-buffer-test--with-text "" + (text-mode) + (let ((ekp-inline-code-policy 'normal) + (ekp-buffer-measure 'narrowest-window) + (ekp-buffer-mode-policy-alist nil)) + (setq ekp-buffer--live-plan-cache nil) + (let ((first (cdr (ekp-buffer--live-plan-entry + "alpha beta gamma" 20)))) + (should (eq first + (cdr (ekp-buffer--live-plan-entry + "alpha beta gamma" 20)))) + (let ((ekp-inline-code-policy 'no-break)) + (should-not + (eq first + (cdr (ekp-buffer--live-plan-entry + "alpha beta gamma" 20))))) + (let ((ekp-buffer-measure 24)) + (should-not + (eq first + (cdr (ekp-buffer--live-plan-entry + "alpha beta gamma" 20))))) + (let ((ekp-buffer-mode-policy-alist + '((text-mode . ((ekp-buffer-inline-faces . (font-lock-string-face))))))) + (should-not + (eq first + (cdr (ekp-buffer--live-plan-entry + "alpha beta gamma" 20))))) + (let ((annotated (copy-sequence "alpha beta gamma"))) + (put-text-property 6 10 'ekp-break-policy 'no-hyphen annotated) + (should-not + (eq first + (cdr (ekp-buffer--live-plan-entry annotated 20))))) + (dotimes (index 20) + (ekp-buffer--live-plan-entry + (format "history %02d alpha beta" index) 20)) + (should (= (length ekp-buffer--live-plan-cache) 16)))))) + +(ert-deftest ekp-buffer-test-live-plan-key-owns-policy-strings () + "Live plan keys must not retain mutable public policy strings." + (ekp-buffer-test--with-text "" + (text-mode) + (let* ((ekp-use-c-module nil) + (suffix (copy-sequence "uX")) + (line-start-extra (copy-sequence "《")) + (ekp-number-unit-suffixes (list suffix)) + (ekp-token-break-policies '((number-unit . no-break))) + (ekp-kinsoku-profile 'custom) + (ekp-cjk-no-line-start-extra line-start-extra) + (text (copy-sequence "100uX alpha beta gamma delta")) + (width 16) + (calls 0) + (original (symbol-function 'ekp-buffer--layout-plan)) + first key) + (setq ekp-buffer--live-plan-cache nil) + (cl-letf (((symbol-function 'ekp-buffer--layout-plan) + (lambda (&rest arguments) + (setq calls (1+ calls)) + (apply original arguments)))) + (setq first (cdr (ekp-buffer--live-plan-entry text width))) + (setq key (caar ekp-buffer--live-plan-cache)) + (should (seq-some (lambda (string) (equal string "uX")) + (ekp-buffer-test--strings-in-tree key))) + (should (seq-some (lambda (string) (equal string "《")) + (ekp-buffer-test--strings-in-tree key))) + (store-substring suffix 1 "Y") + (store-substring line-start-extra 0 "》") + (let ((changed (cdr (ekp-buffer--live-plan-entry text width)))) + (should-not (eq changed first)) + (should (= calls 2))) + (should (seq-some (lambda (string) (equal string "uX")) + (ekp-buffer-test--strings-in-tree key))) + (should (seq-some (lambda (string) (equal string "《")) + (ekp-buffer-test--strings-in-tree key))))))) + (provide 'ekp-buffer-tests) ;;; ekp-buffer-tests.el ends here diff --git a/tests/ekp-c-tests.el b/tests/ekp-c-tests.el index b1dda54..97e4f54 100644 --- a/tests/ekp-c-tests.el +++ b/tests/ekp-c-tests.el @@ -86,6 +86,24 @@ (should-error (ekp-c-set-penalties "10" 50 100 0.5) :type 'ekp-c-invalid-input)) +(ert-deftest ekp-c-test-penalties-accept-emergency-stretch-eighth-param () + "The direct C setter accepts a non-negative emergency stretch parameter." + (skip-unless (ekp-c-tests--available)) + (should (ekp-c-set-penalties 10 50 100 0.5 100 50 0 7))) + +(ert-deftest ekp-c-test-penalties-reject-invalid-emergency-stretch () + "Invalid emergency stretch inputs use the module input condition." + (skip-unless (ekp-c-tests--available)) + (should-error (ekp-c-set-penalties 10 50 100 0.5 100 50 0 -1) + :type 'ekp-c-invalid-input) + (should-error (ekp-c-set-penalties 10 50 100 0.5 100 50 0 "wide") + :type 'ekp-c-invalid-input)) + +(ert-deftest ekp-c-test-penalties-keep-legacy-four-arg-call () + "The direct C setter remains compatible with the legacy 4-arg call." + (skip-unless (ekp-c-tests--available)) + (should (ekp-c-set-penalties 10 50 100 0.5))) + (ert-deftest ekp-c-test-module-build-uses-argv-in-directory () "Interactive builds must not interpolate a module path into a shell." (let (process-arguments process-directory) diff --git a/tests/ekp-fuzz.el b/tests/ekp-fuzz.el index 0a805a0..969f5eb 100644 --- a/tests/ekp-fuzz.el +++ b/tests/ekp-fuzz.el @@ -17,15 +17,31 @@ "bcdfghjklmnpqrstvwxz" "word!" "(paren)" "don't" "test," "end." "«quoted»" "naïve" "Ｆｕｌｌ" "１２３")) (defconst fuzz--puncts '("，" "。" "、" "《" "》" "「" "」" "！" "？")) +(defconst fuzz--policy-tokens + '("https://example.test/a_b" "src/core/file_name.el" + "processKeyword42" "3.14MB" "100px")) + +(defun fuzz--maybe-policy-propertize (token) + "Return TOKEN with deterministic public policy annotations sometimes." + (pcase (fuzz--rand 8) + (0 (propertize token 'ekp-break-policy 'normal)) + (1 (propertize token 'ekp-break-policy 'hyphenate)) + (2 (propertize token 'ekp-break-policy 'no-hyphen)) + (3 (propertize token 'ekp-no-break t)) + (4 (propertize token 'face 'ekp-fuzz-inline-code)) + (_ token))) (defun fuzz--gen-string () "Random mixed paragraph of 5-60 tokens." (let ((n (+ 5 (fuzz--rand 56))) (parts nil)) (dotimes (_ n) - (pcase (fuzz--rand 10) + (pcase (fuzz--rand 11) ;; latin word - ((or 0 1 2 3) (push (nth (fuzz--rand (length fuzz--words)) fuzz--words) parts) - (push " " parts)) + ((or 0 1 2 3) + (push (fuzz--maybe-policy-propertize + (nth (fuzz--rand (length fuzz--words)) fuzz--words)) + parts) + (push " " parts)) ;; CJK run ((or 4 5 6 7) (let ((len (1+ (fuzz--rand 6))) (start (fuzz--rand (- (length fuzz--cjk) 7)))) @@ -33,7 +49,13 @@ ;; CJK punct (8 (push (nth (fuzz--rand (length fuzz--puncts)) fuzz--puncts) parts)) ;; spaces / zwsp - (9 (push (if (= 0 (fuzz--rand 3)) "​" " ") parts)))) + (9 (push (if (= 0 (fuzz--rand 3)) "​" " ") parts)) + ;; built-in policy token categories + (10 (push (fuzz--maybe-policy-propertize + (nth (fuzz--rand (length fuzz--policy-tokens)) + fuzz--policy-tokens)) + parts) + (push " " parts)))) (string-trim (apply #'concat (nreverse parts))))) (defun fuzz--content (s) diff --git a/tests/ekp-gui-verify.el b/tests/ekp-gui-verify.el index 4390ed8..e9c85e9 100644 --- a/tests/ekp-gui-verify.el +++ b/tests/ekp-gui-verify.el @@ -49,6 +49,8 @@ (require 'ekp) (require 'ekp-buffer) (require 'ekp-showcase) +(require 'ert) +(require 'subr-x) (defun ekp-gui-verify--line-width (window base line) "Measure planned LINE in WINDOW at paragraph BASE." @@ -106,6 +108,500 @@ When SKIP-PREDICATE is non-nil, omit spans for which it returns non-nil." (null (overlays-in (point-min) (point-max)))) :pass (and (= over 0) (= wrong 0) (> lines 0)))))) +(defun ekp-gui-verify--atom-context () + "Return the protected showcase atom and its projected plan context." + (let* ((atom-beg (text-property-any + (point-min) (point-max) 'ekp-no-break t)) + (atom-end (and atom-beg + (next-single-property-change + atom-beg 'ekp-no-break nil (point-max)))) + (span (and atom-beg + (seq-find + (lambda (candidate) + (and (<= (marker-position + (ekp-buffer--span-beg candidate)) + atom-beg) + (< atom-beg + (marker-position + (ekp-buffer--span-end candidate))))) + ekp-buffer--spans)))) + (unless (and atom-beg atom-end span) + (error "Showcase atom projection is unavailable")) + (list atom-beg atom-end span (ekp-buffer--span-plan span)))) + +(defun ekp-gui-verify-atom-adapter () + "Return primitive evidence for the showcase rigid-atom regression." + (pcase-let* ((`(,atom-beg ,atom-end ,span ,plan) + (ekp-gui-verify--atom-context)) + (base (marker-position (ekp-buffer--span-beg span))) + (atom-start (- atom-beg base)) + (atom-finish (- atom-end base)) + (prefix-end (1- atom-start)) + (lines (ekp-layout-plan-lines plan)) + (first (aref lines 0)) + (atom-line + (seq-find + (lambda (line) + (and (<= (ekp-layout-line-source-start line) atom-start) + (>= (ekp-layout-line-source-end line) atom-finish))) + (append lines nil)))) + `((width . ,ekp-showcase--width) + (first_line_end . ,(ekp-layout-line-source-end first)) + (prefix_end . ,prefix-end) + (prefix_screen_lines + . ,(count-screen-lines base (+ base prefix-end))) + (atom_intact . ,(if atom-line t :false)) + (source_exact + . ,(if (equal (buffer-substring-no-properties + (point-min) (point-max)) + (substring-no-properties (ekp-showcase--sample))) + t :false)) + (overlays . ,(length (overlays-in (point-min) (point-max)))) + (engine_c . ,(if (and ekp-use-c-module (ekp--c-available-p)) + t :false)) + (reflow_ms . ,(or ekp-showcase--last-ms 0))))) + +(defun ekp-gui-verify-atom-assertions () + "Return assertions for `ekp-gui-verify-atom-adapter'." + (let* ((adapter (ekp-gui-verify-atom-adapter)) + (value (lambda (key) (cdr (assq key adapter))))) + `(((name . "full-prefix-before-atom") + (passed . ,(if (>= (funcall value 'first_line_end) + (funcall value 'prefix_end)) t :false))) + ((name . "prefix-not-vertical") + (passed . ,(if (<= (funcall value 'prefix_screen_lines) 2) + t :false))) + ((name . "atom-stays-on-one-plan-line") + (passed . ,(funcall value 'atom_intact))) + ((name . "logical-source-exact") + (passed . ,(funcall value 'source_exact))) + ((name . "zero-overlays") + (passed . ,(if (= (funcall value 'overlays) 0) t :false))) + ((name . "c-engine-active") + (passed . ,(funcall value 'engine_c)))))) + +(defun ekp-gui-verify--source-text (beg end) + "Return source text from BEG through END without properties." + (buffer-substring-no-properties beg end)) + +(defun ekp-gui-verify--range-end (beg property) + "Return the end of PROPERTY's run starting at BEG." + (next-single-property-change beg property nil (point-max))) + +(defun ekp-gui-verify--face-has-showcase-inline-role-p (face) + "Return non-nil when FACE carries the dedicated showcase inline role." + (cond + ((memq face '(ekp-showcase-inline-code + ekp-showcase-inline-code-face)) + t) + ((consp face) + (seq-some #'ekp-gui-verify--face-has-showcase-inline-role-p face)))) + +(defun ekp-gui-verify--inline-role-at-p (pos) + "Return non-nil when POS is the automatic showcase inline role." + (or (get-text-property pos 'ekp-showcase-inline-code) + (ekp-gui-verify--face-has-showcase-inline-role-p + (get-text-property pos 'face)))) + +(defun ekp-gui-verify--face-code-range () + "Return the automatic showcase inline-code role range." + (let ((pos (point-min)) + hit) + (while (and (< pos (point-max)) (not hit)) + (if (and (ekp-gui-verify--inline-role-at-p pos) + (not (get-text-property pos 'ekp-verbatim)) + (not (get-text-property pos 'ekp-no-break))) + (setq hit + (cons pos + (min (or (next-single-property-change + pos 'ekp-showcase-inline-code + nil (point-max)) + (point-max)) + (ekp-gui-verify--range-end pos 'face) + (or (next-single-property-change + pos 'ekp-no-break nil (point-max)) + (point-max)) + (or (next-single-property-change + pos 'ekp-verbatim nil (point-max)) + (point-max))))) + (setq pos (1+ pos)))) + hit)) + +(defun ekp-gui-verify--projected-property-free-p (beg end) + "Return non-nil when BEG through END has no EKP projection props." + (seq-every-p + (lambda (property) + (not (text-property-not-all beg end property nil))) + '(ekp-justified ekp-buffer--display ekp-buffer--line-prefix + display line-prefix))) + +(defun ekp-gui-verify--unplanned-span-count () + "Return the number of installed spans that have no layout plan yet." + (let ((count 0)) + (dolist (span ekp-buffer--spans count) + (unless (ekp-buffer--span-plan span) + (setq count (1+ count)))))) + +(defun ekp-gui-verify--current-live-prefix-p () + "Return non-nil when the committed live prefix still matches the buffer." + (if-let* ((state ekp-buffer--live-state) + (beg (marker-position (ekp-buffer--live-state-beg state)))) + (ekp-buffer--live-prefix-current-p + beg + (ekp-buffer--live-state-plan state) + (or (ekp-buffer--live-state-active-index state) 0) + (ekp-buffer--live-state-signatures state)) + t)) + +(defun ekp-gui-verify--unplanned-span-counts () + "Return raw, live, and stale nil-plan span counts." + (let ((raw 0) + (live 0) + (stale 0) + (live-spans (and ekp-buffer--live-state + (ekp-buffer--live-state-spans + ekp-buffer--live-state))) + (live-current (ekp-gui-verify--current-live-prefix-p))) + (dolist (span ekp-buffer--spans) + (unless (ekp-buffer--span-plan span) + (setq raw (1+ raw)) + (if (and live-current (memq span live-spans)) + (setq live (1+ live)) + (setq stale (1+ stale))))) + `((raw . ,raw) + (live . ,live) + (stale . ,stale) + (live_state_current . ,(if live-current t :false))))) + +(defun ekp-gui-verify--isolated-cjk-cascades () + "Return runs of three or more consecutive isolated CJK source lines." + (let (hits) + (dolist (span ekp-buffer--spans) + (when-let* ((plan (ekp-buffer--span-plan span)) + (source (ekp-layout-plan-string plan))) + (let (run) + (dolist (line (append (ekp-layout-plan-lines plan) nil)) + (if (ekp-gui-verify--isolated-cjk-line-p line source) + (push (substring source + (ekp-layout-line-source-start line) + (ekp-layout-line-source-end line)) + run) + (when (>= (length run) 3) + (push (nreverse run) hits)) + (setq run nil))) + (when (>= (length run) 3) + (push (nreverse run) hits))))) + (nreverse hits))) + +(defun ekp-gui-verify--hard-atom-range () + "Return the explicit hard no-break range in the showcase." + (when-let* ((beg (text-property-any + (point-min) (point-max) 'ekp-no-break t))) + (cons beg (ekp-gui-verify--range-end beg 'ekp-no-break)))) + +(defun ekp-gui-verify--verbatim-range () + "Return the explicit verbatim block range in the showcase." + (when-let* ((beg (text-property-any + (point-min) (point-max) 'ekp-verbatim t))) + (cons beg (ekp-gui-verify--range-end beg 'ekp-verbatim)))) + +(defun ekp-gui-verify--span-for-position (position) + "Return the projected span containing POSITION." + (seq-find + (lambda (span) + (and (<= (marker-position (ekp-buffer--span-beg span)) position) + (< position (marker-position (ekp-buffer--span-end span))))) + ekp-buffer--spans)) + +(defun ekp-gui-verify--range-lines (range) + "Return layout lines intersecting RANGE." + (when-let* ((span (and range + (ekp-gui-verify--span-for-position (car range)))) + (plan (ekp-buffer--span-plan span))) + (let* ((base (marker-position (ekp-buffer--span-beg span))) + (start (- (car range) base)) + (finish (- (cdr range) base))) + (seq-filter + (lambda (line) + (and (< (ekp-layout-line-source-start line) finish) + (< start (ekp-layout-line-source-end line)))) + (append (ekp-layout-plan-lines plan) nil))))) + +(defun ekp-gui-verify--range-plan-complete-p (range) + "Return non-nil when RANGE's plan is nonempty and covers its source." + (when-let* ((span (and range + (ekp-gui-verify--span-for-position (car range)))) + (plan (ekp-buffer--span-plan span)) + (lines (append (ekp-layout-plan-lines plan) nil))) + (and (= (ekp-layout-line-source-start (car lines)) 0) + (= (ekp-layout-line-source-end (car (last lines))) + (length (ekp-layout-plan-string plan)))))) + +(defun ekp-gui-verify--range-intact-p (range) + "Return non-nil when RANGE is contained in one planned line." + (seq-some + (lambda (line) + (let* ((span (ekp-gui-verify--span-for-position (car range))) + (base (marker-position (ekp-buffer--span-beg span))) + (start (- (car range) base)) + (finish (- (cdr range) base))) + (and (<= (ekp-layout-line-source-start line) start) + (>= (ekp-layout-line-source-end line) finish)))) + (ekp-gui-verify--range-lines range))) + +(defun ekp-gui-verify--range-break-text (range line) + "Return LINE's break source inside RANGE, or nil when outside." + (let ((start (ekp-layout-line-break-source-start line)) + (end (ekp-layout-line-break-source-end line))) + (when-let* ((span (and start end (< start end) + (ekp-gui-verify--span-for-position + (car range))))) + (let* ((base (marker-position (ekp-buffer--span-beg span))) + (range-start (- (car range) base)) + (range-end (- (cdr range) base))) + (when (and (<= range-start start) (<= end range-end)) + (substring (ekp-gui-verify--source-text (car range) (cdr range)) + (- start range-start) + (- end range-start))))))) + +(defun ekp-gui-verify--inline-legal-breaks-p (range) + "Return non-nil when RANGE uses only source-space breaks." + (and range + (seq-every-p + (lambda (line) + (or (not (ekp-layout-line-break-kind line)) + (let ((break-text + (ekp-gui-verify--range-break-text range line))) + (or (not break-text) + (string-match-p + "\\`[[:space:]\n\r\t]+\\'" break-text))))) + (ekp-gui-verify--range-lines range)))) + +(defun ekp-gui-verify--inline-hyphenated-p (range) + "Return non-nil when RANGE has a discretionary hyphenated line." + (seq-some #'ekp-layout-line-hyphen-p + (or (ekp-gui-verify--range-lines range) nil))) + +(defun ekp-gui-verify--inline-line-evidence (range) + "Return planned line evidence for inline RANGE." + (let* ((span (and range (ekp-gui-verify--span-for-position (car range)))) + (plan (and span (ekp-buffer--span-plan span))) + (source (and plan (ekp-layout-plan-string plan))) + (base (and span (marker-position (ekp-buffer--span-beg span)))) + (range-start (and base (- (car range) base))) + (range-end (and base (- (cdr range) base))) + (lines (or (ekp-gui-verify--range-lines range) nil)) + (line-count (length lines)) + break-map internal-breaks) + (dolist (line lines) + (let* ((start (ekp-layout-line-break-source-start line)) + (end (ekp-layout-line-break-source-end line)) + (kind (ekp-layout-line-break-kind line)) + (internal (and source start end (< start end) + range-start range-end + (< range-start start) + (<= end range-end))) + (source-space + (and source start end (< start end) + (string-match-p + "\\`[[:space:]\n\r\t]+\\'" + (substring source start end)))) + (hyphen (and internal (ekp-layout-line-hyphen-p line))) + (entry + `((start . ,(or start 0)) + (end . ,(or end 0)) + (kind . ,(ekp-gui-verify--json-policy-value kind)) + (internal . ,(if internal t :false)) + (source_space . ,(if source-space t :false)) + (hyphen . ,(if hyphen t :false))))) + (when (or kind start end) + (push entry break-map)) + (when internal + (push entry internal-breaks)))) + `((automatic_inline_line_count . ,line-count) + (automatic_inline_wrapped . ,(if (> line-count 1) t :false)) + (automatic_inline_breaks_source_spaces + . ,(if (and (> line-count 1) + internal-breaks + (seq-every-p + (lambda (entry) + (and (eq (cdr (assq 'source_space entry)) t) + (eq (cdr (assq 'hyphen entry)) :false))) + internal-breaks)) + t :false)) + (automatic_inline_break_map . ,(nreverse break-map))))) + +(defun ekp-gui-verify--isolated-cjk-line-p (line source) + "Return non-nil when LINE projects a single CJK character from SOURCE." + (let ((text (string-trim + (substring source + (ekp-layout-line-source-start line) + (ekp-layout-line-source-end line))))) + (and (= (length text) 1) + (let ((char (aref text 0))) + (and (<= #x4E00 char) (<= char #x9FFF)))))) + +(defun ekp-gui-verify--isolated-cjk-lines () + "Return isolated CJK planned lines in projected showcase spans." + (let (hits) + (dolist (span ekp-buffer--spans) + (when-let* ((plan (ekp-buffer--span-plan span)) + (source (ekp-layout-plan-string plan))) + (dolist (line (append (ekp-layout-plan-lines plan) nil)) + (when (ekp-gui-verify--isolated-cjk-line-p line source) + (push (substring source + (ekp-layout-line-source-start line) + (ekp-layout-line-source-end line)) + hits))))) + (nreverse hits))) + +(defun ekp-gui-verify--refresh-showcase-width (width) + "Open the showcase and refresh it at WIDTH." + (when (get-buffer "*ekp-showcase*") + (kill-buffer "*ekp-showcase*")) + (ekp-showcase) + (with-current-buffer "*ekp-showcase*" + (ekp-showcase-set-width width) + (redisplay t) + (current-buffer))) + +(defun ekp-gui-verify--showcase-policy-evidence () + "Return G004 policy evidence for the current showcase buffer." + (let* ((auto (ekp-gui-verify--face-code-range)) + (manual (ekp-gui-verify--hard-atom-range)) + (block (ekp-gui-verify--verbatim-range)) + (auto-lines (ekp-gui-verify--inline-line-evidence auto)) + (sample (substring-no-properties (ekp-showcase--sample)))) + `((width . ,ekp-showcase--width) + (automatic_inline_present . ,(if auto t :false)) + (automatic_inline_plan_complete + . ,(if (ekp-gui-verify--range-plan-complete-p auto) t :false)) + (automatic_inline_explicit_no_break + . ,(if (and auto (text-property-not-all + (car auto) (cdr auto) 'ekp-no-break nil)) + t :false)) + (automatic_inline_literal_source + . ,(if (and auto + (string-match-p "[[:space:]][^[:space:]]+[[:space:]]" + (ekp-gui-verify--source-text + (car auto) (cdr auto)))) + t :false)) + (automatic_inline_legal_breaks + . ,(if (and auto + (ekp-gui-verify--inline-legal-breaks-p auto)) + t :false)) + (automatic_inline_no_hyphen + . ,(if (and auto + (not (ekp-gui-verify--inline-hyphenated-p auto))) + t :false)) + ,@auto-lines + (manual_hard_atom_present . ,(if manual t :false)) + (manual_hard_atom_distinct + . ,(if (and auto manual (not (equal auto manual))) t :false)) + (manual_hard_atom_explicit + . ,(if (and manual + (not (text-property-not-all + (car manual) (cdr manual) 'ekp-no-break t))) + t :false)) + (manual_hard_atom_intact + . ,(if (and manual + (ekp-gui-verify--range-intact-p manual)) + t :false)) + (block_verbatim_present . ,(if block t :false)) + (block_verbatim_intact + . ,(if (and block + (ekp-gui-verify--projected-property-free-p + (car block) (cdr block))) + t :false)) + (isolated_cjk_cascades . ,(ekp-gui-verify--isolated-cjk-cascades)) + (isolated_cjk_lines . ,(ekp-gui-verify--isolated-cjk-lines)) + (source_exact + . ,(if (equal (buffer-substring-no-properties + (point-min) (point-max)) + sample) + t :false)) + (overlays . ,(length (overlays-in (point-min) (point-max)))) + (engine_c . ,(if (and ekp-use-c-module (ekp--c-available-p)) + t :false))))) + +(defun ekp-gui-verify-showcase-policy-adapter (&optional width) + "Return G004 machine evidence for the showcase policy contract." + (with-current-buffer (ekp-gui-verify--refresh-showcase-width + (or width 280)) + (ekp-gui-verify--showcase-policy-evidence))) + +(defun ekp-gui-verify-showcase-parshape-policy-adapter (&optional width) + "Return showcase policy evidence with parshape enabled at WIDTH." + (with-current-buffer (ekp-gui-verify--refresh-showcase-width + (or width 280)) + (setq-local ekp-showcase--parshape-on t) + (ekp-showcase--refresh) + (redisplay t) + (ekp-gui-verify--showcase-policy-evidence))) + +(defun ekp-gui-verify-showcase-policy-assertions () + "Return G004 assertions for `ekp-gui-verify-showcase-policy-adapter'." + (let* ((adapter (ekp-gui-verify-showcase-policy-adapter 280)) + (value (lambda (key) (cdr (assq key adapter))))) + `(((name . "automatic-inline-face-present") + (passed . ,(funcall value 'automatic_inline_present))) + ((name . "automatic-inline-plan-complete") + (passed . ,(funcall value 'automatic_inline_plan_complete))) + ((name . "automatic-inline-has-no-explicit-no-break") + (passed . ,(if (eq (funcall value + 'automatic_inline_explicit_no_break) + :false) + t :false))) + ((name . "automatic-inline-keeps-literal-source") + (passed . ,(funcall value 'automatic_inline_literal_source))) + ((name . "automatic-inline-breaks-only-legally") + (passed . ,(funcall value 'automatic_inline_legal_breaks))) + ((name . "automatic-inline-never-discretionary-hyphenates") + (passed . ,(funcall value 'automatic_inline_no_hyphen))) + ((name . "manual-hard-atom-is-distinct") + (passed . ,(funcall value 'manual_hard_atom_distinct))) + ((name . "manual-hard-atom-remains-explicit") + (passed . ,(funcall value 'manual_hard_atom_explicit))) + ((name . "manual-hard-atom-remains-intact") + (passed . ,(funcall value 'manual_hard_atom_intact))) + ((name . "block-code-stays-verbatim") + (passed . ,(if (and (funcall value 'block_verbatim_present) + (funcall value 'block_verbatim_intact)) + t :false))) + ((name . "narrow-rendering-has-no-isolated-cjk-cascade") + (passed . ,(if (null (funcall value 'isolated_cjk_cascades)) + t :false))) + ((name . "narrow-rendering-has-no-isolated-cjk-lines") + (passed . ,(if (null (funcall value 'isolated_cjk_lines)) + t :false))) + ((name . "logical-source-exact") + (passed . ,(funcall value 'source_exact))) + ((name . "zero-overlays") + (passed . ,(if (= (funcall value 'overlays) 0) t :false))) + ((name . "c-engine-active") + (passed . ,(funcall value 'engine_c)))))) + +(ert-deftest ekp-gui-verify-g004-showcase-policy-contract () + "The showcase separates automatic inline code from manual hard atoms." + (let ((assertions (ekp-gui-verify-showcase-policy-assertions))) + (dolist (assertion assertions) + (ert-info ((cdr (assq 'name assertion))) + (should (eq (cdr (assq 'passed assertion)) t)))))) + +(ert-deftest ekp-gui-verify-showcase-1d-rejects-isolated-cjk-lines () + "The default 168px showcase oracle rejects isolated CJK rows." + (let* ((adapter (ekp-gui-verify-showcase-policy-adapter 168)) + (isolated (cdr (assq 'isolated_cjk_lines adapter)))) + (should (eq (cdr (assq 'automatic_inline_plan_complete adapter)) t)) + (should-not isolated))) + +(ert-deftest ekp-gui-verify-showcase-parshape-rejects-isolated-cjk-lines () + "The parshape-on 280px showcase oracle rejects isolated CJK rows." + (let* ((adapter (ekp-gui-verify-showcase-parshape-policy-adapter 280)) + (isolated (cdr (assq 'isolated_cjk_lines adapter)))) + (should (eq (cdr (assq 'automatic_inline_plan_complete adapter)) t)) + (should-not isolated))) + ;;;###autoload (defun ekp-gui-verify () "Verify pixel-exact justification against this session's display. @@ -382,6 +878,558 @@ In batch mode, terminate with status 1 when any result fails." (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") +(defvar-local ekp-gui-verify--showcase-temporal-source nil) +(defvar-local ekp-gui-verify--showcase-temporal-before-generation nil) +(defvar-local ekp-gui-verify--showcase-temporal-before-projection nil) + +(defun ekp-gui-verify--timer-state (timer) + "Return a JSON-compatible state for TIMER." + (if (timerp timer) t :false)) + +(defun ekp-gui-verify--current-source-hash () + "Return the current buffer's logical source hash." + (secure-hash 'sha256 + (buffer-substring-no-properties + (point-min) (point-max)))) + +(defun ekp-gui-verify--json-policy-value (value) + "Return VALUE as a JSON-compatible policy primitive." + (if (symbolp value) + (and value (symbol-name value)) + value)) + +(defun ekp-gui-verify--current-policy-context () + "Return a compact JSON-compatible policy context summary." + (let ((context (ekp-buffer--policy-context ekp-buffer--auto-width))) + `((inline_code . ,(ekp-gui-verify--json-policy-value + (plist-get context :inline-code-policy))) + (hyphenation . ,(ekp-gui-verify--json-policy-value + (plist-get context :hyphenation))) + (kinsoku . ,(ekp-gui-verify--json-policy-value + (plist-get context :kinsoku-profile))) + (overlong . ,(ekp-gui-verify--json-policy-value + (plist-get context :overlong-token-policy))) + (width . ,(or (plist-get context :width) 0))))) + +(defun ekp-gui-verify-showcase-temporal-adapter + (&optional stage completed) + "Return current G004 temporal showcase state for STAGE." + (let* ((policy (ekp-gui-verify--showcase-policy-evidence)) + (source-hash (ekp-gui-verify--current-source-hash)) + (unplanned (ekp-gui-verify--unplanned-span-counts)) + (raw-unplanned (cdr (assq 'raw unplanned))) + (live-unplanned (cdr (assq 'live unplanned))) + (stale-unplanned (cdr (assq 'stale unplanned))) + (live-state-current (cdr (assq 'live_state_current unplanned))) + (generation-delta + (and ekp-gui-verify--showcase-temporal-before-generation + (- ekp-buffer--generation + ekp-gui-verify--showcase-temporal-before-generation)))) + `((stage . ,(or stage "current")) + (width . ,ekp-showcase--width) + (selected_target_window + . ,(if (and (= (length (seq-remove #'window-minibuffer-p + (window-list))) + 1) + (eq (window-buffer (selected-window)) + (current-buffer))) + t :false)) + (source_hash . ,source-hash) + (source_unchanged + . ,(if (or (not ekp-gui-verify--showcase-temporal-source) + (equal source-hash + ekp-gui-verify--showcase-temporal-source)) + t :false)) + (projection_hash . ,(ekp-gui-verify--projection-hash)) + (projection_published . ,(if ekp-buffer--spans t :false)) + (current_projection + . ,(if (and ekp-buffer--spans + (= stale-unplanned 0) + (eq live-state-current t)) + t :false)) + (projection_changed + . ,(if (and ekp-gui-verify--showcase-temporal-before-projection + (not (equal (ekp-gui-verify--projection-hash) + ekp-gui-verify--showcase-temporal-before-projection))) + t :false)) + (generation . ,ekp-buffer--generation) + (generation_delta . ,(or generation-delta 0)) + (resize_timer . ,(ekp-gui-verify--timer-state + ekp-buffer--resize-timer)) + (policy_timer . ,(ekp-gui-verify--timer-state + ekp-buffer--policy-reflow-timer)) + (unplanned_spans . ,raw-unplanned) + (live_unplanned_spans . ,live-unplanned) + (stale_unplanned_spans . ,stale-unplanned) + (live_state_current . ,live-state-current) + (timers_settled + . ,(if (and (not (timerp ekp-buffer--resize-timer)) + (not (timerp ekp-buffer--policy-reflow-timer))) + t :false)) + (pending_chunks . ,(if ekp-buffer--pending t :false)) + (overlays . ,(cdr (assq 'overlays policy))) + (engine_c . ,(cdr (assq 'engine_c policy))) + (automatic_inline_plan_complete + . ,(cdr (assq 'automatic_inline_plan_complete policy))) + (automatic_inline_line_count + . ,(cdr (assq 'automatic_inline_line_count policy))) + (automatic_inline_wrapped + . ,(cdr (assq 'automatic_inline_wrapped policy))) + (automatic_inline_breaks_source_spaces + . ,(cdr (assq 'automatic_inline_breaks_source_spaces policy))) + (automatic_inline_break_map + . ,(cdr (assq 'automatic_inline_break_map policy))) + (isolated_cjk_cascades + . ,(cdr (assq 'isolated_cjk_cascades policy))) + (isolated_cjk_lines + . ,(cdr (assq 'isolated_cjk_lines policy))) + (policy . ,(ekp-gui-verify--current-policy-context)) + (completed . ,(if completed t :false))))) + +;;;###autoload +(defun ekp-gui-verify-showcase-temporal-setup () + "Create a clean single-window showcase temporal verification buffer." + (interactive) + (unless (display-graphic-p) + (user-error "GUI verification needs a graphical frame")) + (cancel-function-timers #'ekp-buffer--reflow) + (cancel-function-timers #'ekp-buffer--process-chunk) + (cancel-function-timers #'ekp-buffer--reflow-for-policy-change) + (when (get-buffer "*ekp-showcase*") + (kill-buffer "*ekp-showcase*")) + (delete-other-windows) + (ekp-showcase) + (delete-other-windows) + (with-current-buffer "*ekp-showcase*" + (when ekp-auto-justify-mode + (ekp-auto-justify-mode -1)) + (setq ekp-gui-verify--showcase-temporal-source nil + ekp-gui-verify--showcase-temporal-before-generation nil + ekp-gui-verify--showcase-temporal-before-projection nil) + (kill-local-variable 'ekp-inline-code-policy) + (ekp-showcase-set-width 480) + (redisplay t) + (ekp-gui-verify-showcase-temporal-adapter "setup" nil))) + +(defun ekp-gui-verify--temporal-set-width (width stage) + "Set showcase WIDTH and record temporal STAGE." + (with-current-buffer "*ekp-showcase*" + (ekp-showcase-set-width width) + (redisplay t) + (ekp-gui-verify-showcase-temporal-adapter stage nil))) + +;;;###autoload +(defun ekp-gui-verify-showcase-temporal-width-480 () + "Record manual showcase width 480 in the temporal scenario." + (interactive) + (ekp-gui-verify--temporal-set-width 480 "width-480")) + +;;;###autoload +(defun ekp-gui-verify-showcase-temporal-width-280 () + "Record manual showcase width 280 in the temporal scenario." + (interactive) + (ekp-gui-verify--temporal-set-width 280 "width-280")) + +;;;###autoload +(defun ekp-gui-verify-showcase-temporal-width-340 () + "Record manual showcase width 340 in the temporal scenario." + (interactive) + (ekp-gui-verify--temporal-set-width 340 "width-340")) + +;;;###autoload +(defun ekp-gui-verify-showcase-temporal-policy-before () + "Enable auto layout and capture the policy-change before checkpoint." + (interactive) + (with-current-buffer "*ekp-showcase*" + (ekp-auto-justify-mode 1) + (let ((deadline (+ (float-time) 2.0))) + (while (and (or (timerp ekp-buffer--resize-timer) + ekp-buffer--pending) + (< (float-time) deadline)) + (sit-for 0.05))) + (setq ekp-gui-verify--showcase-temporal-source + (ekp-gui-verify--current-source-hash) + ekp-gui-verify--showcase-temporal-before-generation + ekp-buffer--generation + ekp-gui-verify--showcase-temporal-before-projection + (ekp-gui-verify--projection-hash)) + (redisplay t) + (ekp-gui-verify-showcase-temporal-adapter "policy-before" nil))) + +;;;###autoload +(defun ekp-gui-verify-showcase-temporal-policy-immediate () + "Apply a local inline-code policy change and capture pending timer state." + (interactive) + (with-current-buffer "*ekp-showcase*" + (setq-local ekp-inline-code-policy 'normal) + (ekp-gui-verify-showcase-temporal-adapter "policy-immediate" nil))) + +;;;###autoload +(defun ekp-gui-verify-showcase-temporal-policy-settled () + "Wait for the real policy timer and capture the settled checkpoint." + (interactive) + (with-current-buffer "*ekp-showcase*" + (let ((deadline (+ (float-time) 2.0))) + (while (and (or (timerp ekp-buffer--policy-reflow-timer) + (timerp ekp-buffer--resize-timer) + ekp-buffer--pending) + (< (float-time) deadline)) + (sit-for 0.05))) + (redisplay t) + (ekp-gui-verify-showcase-temporal-adapter "policy-settled" t))) + +(defun ekp-gui-verify-showcase-temporal-assertions (state) + "Return assertions for temporal showcase adapter STATE." + (let* ((stage (cdr (assq 'stage state))) + (immediate-p (equal stage "policy-immediate")) + (manual-wrap-stage-p (member stage '("width-280" "width-340"))) + (completed-p (eq (cdr (assq 'completed state)) t)) + (policy-timer (cdr (assq 'policy_timer state))) + (unplanned-spans (cdr (assq 'unplanned_spans state))) + (stale-unplanned-spans + (cdr (assq 'stale_unplanned_spans state))) + (generation-delta (cdr (assq 'generation_delta state))) + (immediate-observed-p + (or (eq policy-timer t) + (and (eq policy-timer :false) + (= (or generation-delta 0) 1)))) + (policy (cdr (assq 'policy state)))) + `(((name . "policy-timer-state-valid") + (passed . ,(if (memq policy-timer '(t :false)) + t :false))) + ((name . "automatic-inline-plan-complete") + (passed . ,(if (eq (cdr (assq 'automatic_inline_plan_complete state)) t) + t :false))) + ((name . "immediate-policy-timer-pending") + (passed . ,(if (or (not immediate-p) + immediate-observed-p) + t :false))) + ((name . "immediate-unplanned-spans-only-while-policy-pending") + (passed . ,(if (or (not immediate-p) + (= (or unplanned-spans 0) 0) + immediate-observed-p) + t :false))) + ((name . "manual-width-automatic-inline-wrapped") + (passed . ,(if (or (not manual-wrap-stage-p) + (eq (cdr (assq 'automatic_inline_wrapped state)) t)) + t :false))) + ((name . "manual-width-inline-breaks-use-source-spaces") + (passed . ,(if (or (not manual-wrap-stage-p) + (eq (cdr (assq 'automatic_inline_breaks_source_spaces + state)) + t)) + t :false))) + ((name . "settled-policy-timer-cleared") + (passed . ,(if (or (not completed-p) + (eq policy-timer :false)) + t :false))) + ((name . "settled-resize-timer-cleared") + (passed . ,(if (or (not completed-p) + (eq (cdr (assq 'resize_timer state)) :false)) + t :false))) + ((name . "settled-no-stale-resize-or-policy-timers") + (passed . ,(if (or (not completed-p) + (eq (cdr (assq 'timers_settled state)) t)) + t :false))) + ((name . "settled-exactly-one-generation-reflow") + (passed . ,(if (or (not completed-p) + (= (or generation-delta 0) 1)) + t :false))) + ((name . "settled-source-hash-unchanged") + (passed . ,(if (or (not completed-p) + (eq (cdr (assq 'source_unchanged state)) t)) + t :false))) + ((name . "settled-effective-inline-policy-normal") + (passed . ,(if (or (not completed-p) + (equal (cdr (assq 'inline_code policy)) "normal")) + t :false))) + ((name . "settled-zero-stale-unplanned-spans") + (passed . ,(if (or (not completed-p) + (and (numberp stale-unplanned-spans) + (= stale-unplanned-spans 0))) + t :false))) + ((name . "settled-current-projection") + (passed . ,(if (or (not completed-p) + (eq (cdr (assq 'current_projection state)) t)) + t :false))) + ((name . "settled-zero-overlays") + (passed . ,(if (= (cdr (assq 'overlays state)) 0) t :false))) + ((name . "settled-projection-published") + (passed . ,(if (eq (cdr (assq 'projection_published state)) t) + t :false))) + ((name . "settled-c-engine-active") + (passed . ,(if (eq (cdr (assq 'engine_c state)) t) + t :false))) + ((name . "settled-no-isolated-cjk-cascade") + (passed . ,(if (null (cdr (assq 'isolated_cjk_cascades state))) + t :false))) + ((name . "settled-no-isolated-cjk-lines") + (passed . ,(if (null (cdr (assq 'isolated_cjk_lines state))) + t :false))) + ((name . "settled-one-selected-target-window") + (passed . ,(if (eq (cdr (assq 'selected_target_window state)) t) + t :false))) + ((name . "settled-no-pending-chunks") + (passed . ,(if (or (not completed-p) + (eq (cdr (assq 'pending_chunks state)) :false)) + t :false)))))) + +(ert-deftest ekp-gui-verify-g004-temporal-skips-unplanned-spans () + "Treat pending nil-plan spans as observable state, not verifier failure." + (with-temp-buffer + (insert "中文 abc") + (let ((ekp-buffer--spans + (list (ekp-buffer--span-create + :beg (copy-marker (point-min)) + :end (copy-marker (point-max)) + :width 10 + :plan nil + :lines nil)))) + (should (= (ekp-gui-verify--unplanned-span-count) 1)) + (should (null (ekp-gui-verify--isolated-cjk-cascades))) + (should (null (ekp-gui-verify--isolated-cjk-lines))) + (should (null (ekp-gui-verify--range-lines + (cons (point-min) (point-max)))))))) + +(defun ekp-gui-verify--json-primitive-tree-p (value) + "Return non-nil when VALUE contains only JSON-compatible primitives." + (cond + ((or (null value) (eq value t) (eq value :false) + (stringp value) (numberp value)) + t) + ((and (consp value) (symbolp (car value))) + (and (symbolp (car value)) + (ekp-gui-verify--json-primitive-tree-p (cdr value)))) + ((listp value) + (seq-every-p #'ekp-gui-verify--json-primitive-tree-p value)))) + +(ert-deftest ekp-gui-verify-g004-policy-context-is-json-primitive () + "Policy context exposes stable JSON primitive values." + (let ((ekp-buffer--auto-width 280) + (ekp-inline-code-policy 'no-hyphen) + (ekp-hyphenation 'auto) + (ekp-kinsoku-profile 'liang) + (ekp-overlong-token-policy 'emergency)) + (let ((policy (ekp-gui-verify--current-policy-context))) + (should (equal (cdr (assq 'inline_code policy)) "no-hyphen")) + (should (equal (cdr (assq 'hyphenation policy)) "auto")) + (should (equal (cdr (assq 'kinsoku policy)) "liang")) + (should (equal (cdr (assq 'overlong policy)) "emergency")) + (should (ekp-gui-verify--json-primitive-tree-p policy))))) + +(ert-deftest ekp-gui-verify-g004-inline-break-map-ignores-external-break () + "Final external line breaks do not invalidate internal inline break proof." + (with-temp-buffer + (let* ((source (make-string 220 ?x)) + (range (cons (+ (point-min) 108) (+ (point-min) 198))) + (lines + (vector + (ekp-layout-line--create + :source-start 108 :source-end 136 + :break-kind 'space + :break-source-start 136 :break-source-end 137) + (ekp-layout-line--create + :source-start 137 :source-end 173 + :break-kind 'space + :break-source-start 173 :break-source-end 174) + (ekp-layout-line--create + :source-start 174 :source-end 198 + :break-kind 'space + :break-source-start 198 :break-source-end 199))) + (plan (ekp-layout-plan--create + :string source + :lines lines)) + ekp-buffer--spans) + (insert source) + (aset source 136 ?\s) + (aset source 173 ?\s) + (aset source 198 ?\s) + (setq ekp-buffer--spans + (list (ekp-buffer--span-create + :beg (copy-marker (point-min)) + :end (copy-marker (point-max)) + :width 280 + :plan plan))) + (let ((evidence (ekp-gui-verify--inline-line-evidence range))) + (should (eq (cdr (assq 'automatic_inline_wrapped evidence)) t)) + (should (eq (cdr (assq 'automatic_inline_breaks_source_spaces + evidence)) + t)) + (should (ekp-gui-verify--json-primitive-tree-p + (cdr (assq 'automatic_inline_break_map evidence)))) + (should (equal + (cdr (assq 'kind + (car (cdr (assq 'automatic_inline_break_map + evidence))))) + "space")))))) + +(ert-deftest ekp-gui-verify-g004-temporal-live-nil-plan-is-current () + "Settled temporal assertions allow current live nil-plan spans." + (let* ((state '((stage . "policy-settled") + (width . 280) + (selected_target_window . t) + (source_unchanged . t) + (projection_published . t) + (generation_delta . 1) + (resize_timer . :false) + (policy_timer . :false) + (unplanned_spans . 1) + (live_unplanned_spans . 1) + (stale_unplanned_spans . 0) + (current_projection . t) + (timers_settled . t) + (pending_chunks . :false) + (overlays . 0) + (engine_c . t) + (automatic_inline_plan_complete . t) + (automatic_inline_line_count . 2) + (automatic_inline_wrapped . t) + (automatic_inline_breaks_source_spaces . t) + (isolated_cjk_cascades) + (isolated_cjk_lines) + (policy . ((inline_code . "normal"))) + (completed . t))) + (assertions (ekp-gui-verify-showcase-temporal-assertions state))) + (dolist (name '("settled-zero-stale-unplanned-spans" + "settled-current-projection")) + (let ((assertion + (seq-find + (lambda (candidate) + (equal (cdr (assq 'name candidate)) name)) + assertions))) + (should assertion) + (should (eq (cdr (assq 'passed assertion)) t)))))) + +(ert-deftest ekp-gui-verify-g004-temporal-unplanned-span-policy () + "Allow unplanned spans only during the immediate pending policy stage." + (let* ((base '((width . 280) + (selected_target_window . t) + (source_unchanged . t) + (projection_published . t) + (generation_delta . 1) + (resize_timer . :false) + (pending_chunks . :false) + (overlays . 0) + (engine_c . t) + (automatic_inline_plan_complete . t) + (live_unplanned_spans . 0) + (stale_unplanned_spans . 0) + (live_state_current . t) + (automatic_inline_line_count . 2) + (automatic_inline_wrapped . t) + (automatic_inline_breaks_source_spaces . t) + (automatic_inline_break_map) + (isolated_cjk_cascades) + (isolated_cjk_lines) + (policy . ((inline_code . "normal"))))) + (assertion-passed + (lambda (state name) + (let ((assertion + (seq-find + (lambda (candidate) + (equal (cdr (assq 'name candidate)) name)) + (ekp-gui-verify-showcase-temporal-assertions state)))) + (cdr (assq 'passed assertion)))))) + (should + (eq (funcall assertion-passed + (append '((stage . "policy-immediate") + (policy_timer . t) + (unplanned_spans . 2) + (current_projection . :false) + (timers_settled . :false) + (completed . :false)) + base) + "immediate-unplanned-spans-only-while-policy-pending") + t)) + (should + (eq (funcall assertion-passed + (append '((stage . "policy-immediate") + (policy_timer . :false) + (unplanned_spans . 2) + (current_projection . :false) + (timers_settled . t) + (completed . :false)) + base) + "immediate-unplanned-spans-only-while-policy-pending") + t)) + (should + (eq (funcall assertion-passed + (append '((stage . "policy-settled") + (policy_timer . :false) + (unplanned_spans . 0) + (live_unplanned_spans . 0) + (stale_unplanned_spans . 0) + (current_projection . t) + (timers_settled . t) + (completed . t)) + base) + "settled-zero-stale-unplanned-spans") + t)) + (should + (eq (funcall assertion-passed + (append '((stage . "policy-settled") + (policy_timer . :false) + (unplanned_spans . 1) + (live_unplanned_spans . 0) + (stale_unplanned_spans . 1) + (current_projection . :false) + (timers_settled . t) + (completed . t)) + base) + "settled-zero-stale-unplanned-spans") + :false)) + (should + (eq (funcall assertion-passed + (append '((stage . "policy-settled") + (policy_timer . :false) + (unplanned_spans . 1) + (live_unplanned_spans . 0) + (stale_unplanned_spans . 1) + (current_projection . :false) + (timers_settled . t) + (completed . t)) + base) + "settled-current-projection") + :false)))) + +(ert-deftest ekp-gui-verify-g004-temporal-width-requires-inline-wrap () + "Manual narrow checkpoints fail when automatic inline evidence is unwrapped." + (let* ((state '((stage . "width-280") + (width . 280) + (selected_target_window . t) + (source_unchanged . t) + (projection_published . t) + (generation_delta . 0) + (resize_timer . :false) + (policy_timer . :false) + (unplanned_spans . 0) + (live_unplanned_spans . 0) + (stale_unplanned_spans . 0) + (live_state_current . t) + (current_projection . t) + (timers_settled . t) + (pending_chunks . :false) + (overlays . 0) + (engine_c . t) + (automatic_inline_plan_complete . t) + (automatic_inline_line_count . 1) + (automatic_inline_wrapped . :false) + (automatic_inline_breaks_source_spaces . :false) + (automatic_inline_break_map) + (isolated_cjk_cascades) + (isolated_cjk_lines) + (policy . ((inline_code . "no-hyphen"))) + (completed . :false))) + (assertions (ekp-gui-verify-showcase-temporal-assertions state))) + (dolist (name '("manual-width-automatic-inline-wrapped" + "manual-width-inline-breaks-use-source-spaces")) + (let ((assertion + (seq-find + (lambda (candidate) + (equal (cdr (assq 'name candidate)) name)) + assertions))) + (should assertion) + (should (eq (cdr (assq 'passed assertion)) :false)))))) (defun ekp-gui-verify--near-overflow-text (target) "Return prose whose natural final line is nearly full at TARGET." diff --git a/tests/ekp-showcase.el b/tests/ekp-showcase.el index c8d9372..884959e 100644 --- a/tests/ekp-showcase.el +++ b/tests/ekp-showcase.el @@ -31,15 +31,29 @@ (defvar-local ekp-showcase--last-ms nil) (defvar-local ekp-showcase--parshape-on nil) +(defface ekp-showcase-inline-code + '((t :inherit fixed-pitch + :background "#3a3f4b" + :foreground "#98c379")) + "Face for automatic inline-code policy spans in the showcase." + :group 'ekp) + (defconst ekp-showcase--alignments '(justify ragged-right center ragged-left)) (defun ekp-showcase--sample () "Build the demo text: prose, punctuation, atoms, NBSP, a code block." (let ((zh1 "汉字排版的质感藏在细节里:开启标点悬挂之后,行尾的句号。逗号,和问号?都会把墨迹之外的空白悬出齐边,右边缘因此在视觉上更加平直。避头尾规则保证「引号」与《书名号》永远紧贴内容,连续闭合标点如此。」也绝不拆行。") - (mixed "中英混排是 Emacs 里最常见的场景:The quick brown fox jumps over the lazy dog, 而 internationalization 这样的长词在窄栏会按 Liang 模式断词,连字符同样参与悬挂。") - (atoms (concat "行内原子演示:代码片段 " - (propertize "(ekp-pixel-justify STR W)" + (mixed (concat "中英混排是 Emacs 里最常见的场景: The quick brown fox " + "jumps over the lazy dog, 而 internationalization " + "这样的长词在窄栏会按 Liang 模式断词。自动行内代码 " + (propertize + "(ekp-pixel-justify paragraph-text target-width 'justify nil)" + 'face 'ekp-showcase-inline-code) + " 可以在合法空白边界附近换行,但不会插入" + " discretionary hyphen。")) + (atoms (concat "行内原子演示:手动硬原子 " + (propertize "M-x ekp-demo" 'ekp-no-break t 'face '(:inherit fixed-pitch :background "#3a3f4b" @@ -230,6 +244,7 @@ "Interactive showcase for ekp typesetting features." (setq-local truncate-lines t) (setq-local cursor-type 'bar) + (setq-local ekp-buffer-inline-faces '(ekp-showcase-inline-code)) ;; keys stay pinned in the header line; live state lives in the ;; mode line (both always visible) (setq header-line-format (ekp-showcase--keys-line))) diff --git a/tests/ekp-tests.el b/tests/ekp-tests.el index 7a6a973..83d80bf 100644 --- a/tests/ekp-tests.el +++ b/tests/ekp-tests.el @@ -50,6 +50,7 @@ ekp-consecutive-hyphen-penalty ekp-last-line-short-penalty ekp-last-line-min-ratio + ekp-emergency-stretch-pixel ekp-alignment ekp-ragged-stretch-pixel ekp-protrusion @@ -59,9 +60,25 @@ ekp-looseness ekp-para-cache-limit ekp-cjk-no-line-start-extra + ekp-cjk-no-line-end-extra + ekp-inline-code-policy + ekp-hyphenation + ekp-token-break-policies + ekp-number-unit-suffixes + ekp-kinsoku-profile + ekp-overlong-token-policy ekp--params-explicit) "Dynamically scoped EKP state restored by the clean-state fixture.") +(defvar ekp-cjk-no-line-end-extra nil) +(defvar ekp-inline-code-policy nil) +(defvar ekp-hyphenation nil) +(defvar ekp-token-break-policies nil) +(defvar ekp-number-unit-suffixes nil) +(defvar ekp-kinsoku-profile nil) +(defvar ekp-overlong-token-policy nil) +(defvar ekp-emergency-stretch-pixel nil) + (defmacro ekp-tests--with-clean-state (&rest body) "Run BODY with fresh caches and restore all tunables afterwards." `(cl-progv ekp-tests--isolated-variables @@ -114,6 +131,123 @@ Used to verify no content is lost by justification." (insert-file-contents (ekp-tests--file name)) (buffer-string))) +(defun ekp-tests--rendered-lines (string width) + "Return rendered STRING lines at WIDTH without text properties." + (mapcar #'substring-no-properties + (split-string (ekp-pixel-justify string width) "\n"))) + +(defun ekp-tests--layout-source-lines (string width) + "Return source substrings selected by `ekp-layout-plan' at WIDTH." + (let ((plan (ekp-layout-plan string width))) + (mapcar (lambda (line) + (substring-no-properties + string + (ekp-layout-line-source-start line) + (ekp-layout-line-source-end line))) + (append (ekp-layout-plan-lines plan) nil)))) + +(defun ekp-tests--assert-complete-plan (plan) + "Assert that planned PLAN contains lines spanning its source." + (let ((lines (append (ekp-layout-plan-lines plan) nil)) + (source (ekp-layout-plan-string plan))) + (should (eq (ekp-layout-plan-state plan) 'planned)) + (should lines) + (should (= (ekp-layout-line-source-start (car lines)) 0)) + (should (= (ekp-layout-line-source-end (car (last lines))) + (length source))))) + +(defun ekp-tests--layout-hyphen-lines (string width) + "Return source lines whose rendered break uses a discretionary hyphen." + (let ((plan (ekp-layout-plan string width))) + (seq-filter #'ekp-layout-line-hyphen-p + (append (ekp-layout-plan-lines plan) nil)))) + +(defun ekp-tests--line-start-chars (string width) + "Return first chars of rendered non-empty STRING lines at WIDTH." + (delq nil + (mapcar (lambda (line) + (and (> (length line) 0) (aref line 0))) + (ekp-tests--rendered-lines string width)))) + +(defun ekp-tests--plan-state (plan) + "Return PLAN state, failing clearly until the public slot exists." + (if (fboundp 'ekp-layout-plan-state) + (ekp-layout-plan-state plan) + (ert-fail "missing ekp-layout-plan-state accessor"))) + +(defun ekp-tests--plan-reason (plan) + "Return PLAN reason, failing clearly until the public slot exists." + (if (fboundp 'ekp-layout-plan-reason) + (ekp-layout-plan-reason plan) + (ert-fail "missing ekp-layout-plan-reason accessor"))) + +(defun ekp-tests--assert-no-private-policy-properties (string) + "Assert STRING has no implementation-private policy properties." + (let ((private '(ekp--break-policy ekp--hyphenation ekp--literal-spacing + ekp--policy-provenance ekp--automatic-no-break + ekp--resolved-policy ekp--no-hyphen + ekp--token-category ekp--downgraded-no-break + ekp--face-break-policy))) + (dotimes (i (length string)) + (dolist (prop private) + (should-not (get-text-property i prop string)))))) + +(defun ekp-tests--text-property-not-any (start end prop string) + "Return non-nil when PROP is nil on every character in STRING interval." + (eq (text-property-not-all start end prop nil string) nil)) + +(defun ekp-tests--policy-interval-signatures (intervals) + "Return compact structural signatures for policy INTERVALS." + (mapcar (lambda (interval) + (list (ekp--policy-interval-start interval) + (ekp--policy-interval-end interval) + (ekp--policy-interval-break-policy interval) + (ekp--policy-interval-provenance interval) + (ekp--policy-interval-category interval))) + intervals)) + +(defun ekp-tests--strings-in-tree (tree) + "Return all strings contained anywhere in TREE." + (let (strings) + (cl-labels ((walk (value) + (cond + ((stringp value) (push value strings)) + ((consp value) + (walk (car value)) + (walk (cdr value))) + ((vectorp value) + (dotimes (i (length value)) + (walk (aref value i))))))) + (walk tree)) + (nreverse strings))) + +(defun ekp-tests--line-source-strings (plan) + "Return source substrings selected by PLAN." + (let ((source (ekp-layout-plan-string plan))) + (mapcar + (lambda (line) + (substring-no-properties + source + (ekp-layout-line-source-start line) + (ekp-layout-line-source-end line))) + (append (ekp-layout-plan-lines plan) nil)))) + +(defun ekp-tests--single-cjk-source-line-p (line) + "Return non-nil when LINE is exactly one CJK source character." + (let ((trimmed (string-trim (substring-no-properties line)))) + (and (= (length trimmed) 1) + (let ((char (aref trimmed 0))) + (and (<= #x4E00 char) (<= char #x9FFF)))))) + +(defun ekp-tests--isolated-cjk-lines-in-source-lines (lines target) + "Return single-CJK LINES whose char occurs in TARGET." + (seq-filter + (lambda (line) + (let ((trimmed (string-trim (substring-no-properties line)))) + (and (ekp-tests--single-cjk-source-line-p line) + (string-match-p (regexp-quote trimmed) target)))) + lines)) + ;;;; Hyphenation (Liang's algorithm) (ert-deftest ekp-test-hyphen-en () @@ -412,6 +546,155 @@ DP represents break-specific replacement widths." (let ((out (ekp-pixel-justify (concat "x " atom " y") 30))) (should (string-match-p "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbb" out))))) +(ert-deftest ekp-test-no-break-overlong-atom-preserves-reachability () + "An overlong atom stays intact without making the plan unreachable." + (dolist (case '(("行内原子演示:代码片段 " 40) + ("甲乙丙丁戊己庚辛 " 35) + ("短前缀 " 28))) + (let* ((prefix (car case)) + (width (cadr case)) + (atom (propertize + (concat (make-string (+ width 8) ?a) " b") + 'ekp-no-break t)) + (text (concat prefix atom " 后文继续。")) + (atom-start (length prefix)) + (atom-end (+ atom-start (length atom)))) + (dolist (use-c (if (ekp-tests--c-available) '(nil t) '(nil))) + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module use-c) + (plan (ekp-layout-plan text width)) + (lines (ekp-layout-plan-lines plan)) + (atom-line + (seq-find + (lambda (line) + (and (<= (ekp-layout-line-source-start line) atom-start) + (>= (ekp-layout-line-source-end line) atom-end))) + (append lines nil))) + (rendered (ekp-pixel-justify text width))) + (ekp-tests--assert-complete-plan plan) + (should atom-line) + (should (string-match-p + (regexp-quote (substring-no-properties atom)) + (substring-no-properties rendered))) + (should (equal (ekp-tests--content rendered) + (ekp-tests--content text))))))))) + +(ert-deftest ekp-test-no-break-overlong-atom-avoids-isolated-cjk-lines () + "An overlong no-break atom must not strand one CJK source char." + (let* ((atom (propertize + (concat "原子演示: 代码片段 " (make-string 20 ?a)) + 'ekp-no-break t)) + (atom-text (substring-no-properties atom)) + (text (concat + "行内" atom + " 永不折散、空格保持字面宽度；不间断空格让 " + "100_000 与 3.14_MB 这类数字单位锁在同一行。")) + (width 41)) + (cl-labels + ((run (use-c) + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module use-c) + (plan (ekp-layout-plan text width)) + (rendered (substring-no-properties + (ekp-render-layout-string plan))) + (lines (append (ekp-layout-plan-lines plan) nil)) + (source-lines + (mapcar + (lambda (line) + (substring-no-properties + text + (ekp-layout-line-source-start line) + (ekp-layout-line-source-end line))) + lines)) + (single-cjk-lines + (seq-filter + (lambda (line) + (and (= (length line) 1) + (> (aref line 0) 127))) + source-lines))) + (ekp-tests--assert-complete-plan plan) + (list :rendered rendered + :signatures (mapcar #'ekp-layout-line-signature lines) + :single-cjk-lines single-cjk-lines))))) + (let* ((elisp (run nil)) + (c-available (ekp-tests--c-available)) + (c-result (and c-available (run t)))) + (dolist (result (delq nil (list elisp c-result))) + (should (string-match-p (regexp-quote atom-text) + (plist-get result :rendered))) + (should-not (plist-get result :single-cjk-lines))) + (when c-result + (should (equal (plist-get c-result :signatures) + (plist-get elisp :signatures))) + (should (equal (plist-get c-result :rendered) + (plist-get elisp :rendered)))))))) + +(ert-deftest ekp-test-core-1d-avoids-avoidable-single-cjk-lines () + "The 168px 1D DP keeps screenshot mixed source from orphaning CJK." + (let* ((inline "(ekp-pixel-justify paragraph-text target-width 'justify nil)") + (target "最常见的场景") + (text (concat + "中英混排是 Emacs 里" target + ": The quick brown fox jumps over the lazy dog, 而 " + "internationalization 这样的长词在窄栏会按 Liang 模式断词。" + "自动行内代码 " inline + " 可以在合法空白边界附近换行,但不会插入 " + "discretionary hyphen。"))) + (cl-labels + ((run (use-c) + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module use-c) + (ekp-hyphenation 'on) + (plan (ekp-layout-plan text 168)) + (source-lines (ekp-tests--line-source-strings plan)) + (two-cjk-with-glue (string-pixel-width "场景"))) + (ekp-tests--assert-complete-plan plan) + (should (<= two-cjk-with-glue 168)) + (list :rendered (substring-no-properties + (ekp-render-layout-string plan)) + :signatures + (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines plan) nil)) + :single-cjk-lines + (ekp-tests--isolated-cjk-lines-in-source-lines + source-lines target)))))) + (let* ((elisp (run nil)) + (c-result (and (ekp-tests--c-available) (run t)))) + (when c-result + (should (equal (plist-get c-result :signatures) + (plist-get elisp :signatures))) + (should (equal (plist-get c-result :rendered) + (plist-get elisp :rendered)))) + (should-not (plist-get elisp :single-cjk-lines)) + (when c-result + (should-not (plist-get c-result :single-cjk-lines))))))) + +(ert-deftest ekp-test-core-parshape-loose-avoids-single-cjk-lines () + "Parshape plus looseness preserves the screenshot mixed source oracle." + (let* ((inline "(ekp-pixel-justify paragraph-text target-width 'justify nil)") + (target "最常见的场景") + (text (concat + "中英混排是 Emacs 里" target + ": The quick brown fox jumps over the lazy dog, 而 " + "internationalization 这样的长词在窄栏会按 Liang 模式断词。" + "自动行内代码 " inline + " 可以在合法空白边界附近换行,但不会插入 " + "discretionary hyphen。")) + (ekp-use-c-module nil) + (ekp-hyphenation 'on) + (ekp-looseness 1) + (ekp-parshape '((0 . 280) (40 . 200) (80 . 120) + (40 . 200) (0 . 280)))) + (ekp-tests--with-clean-state + (let* ((plan (ekp-layout-plan text 280)) + (source-lines (ekp-tests--line-source-strings plan)) + (two-cjk-with-glue (string-pixel-width "场景"))) + (ekp-tests--assert-complete-plan plan) + (should (<= two-cjk-with-glue 120)) + (should-not + (ekp-tests--isolated-cjk-lines-in-source-lines + source-lines target)))))) + (ert-deftest ekp-test-no-break-suppresses-hyphenation () "No soft hyphen appears inside a no-break span." (let ((word "internationalization")) @@ -444,6 +727,973 @@ DP represents break-specific replacement widths." (should-not (string-match-p "\\`[。、,;:」』)》!?]" line)) (should-not (string-match-p "[「『(《]\\'" line)))))) +;;;; Configurable break policy contracts + +(ert-deftest ekp-test-break-policy-public-defaults () + "The selected policy variables expose the approved public defaults." + (should (eq ekp-inline-code-policy 'no-hyphen)) + (should (eq ekp-hyphenation 'auto)) + (should (eq ekp-kinsoku-profile 'common)) + (should (eq ekp-overlong-token-policy 'emergency)) + (should (equal ekp-token-break-policies + '((url . no-hyphen) + (path . no-hyphen) + (identifier . no-hyphen) + (number-unit . no-break)))) + (dolist (unit '("px" "MB" "°C" "μm")) + (should (member unit ekp-number-unit-suffixes)))) + +(ert-deftest ekp-test-break-policy-region-hyphenation-public-path () + "Region `ekp-break-policy' controls hyphenation without becoming rigid." + (ekp-tests--with-clean-state + (let* ((word "internationalization") + (width 12) + (hyphenated (copy-sequence word)) + (normal (copy-sequence word)) + (blocked (copy-sequence word))) + (put-text-property 0 (length word) 'ekp-break-policy 'hyphenate + hyphenated) + (put-text-property 0 (length word) 'ekp-break-policy 'normal normal) + (put-text-property 0 (length word) 'ekp-break-policy 'no-hyphen blocked) + (let ((ekp-hyphenation 'off)) + (should (ekp-tests--layout-hyphen-lines hyphenated width)) + (should-not (ekp-tests--layout-hyphen-lines normal width))) + (let ((ekp-hyphenation 'on)) + (should-not (ekp-tests--layout-hyphen-lines blocked width)) + (should (member word + (ekp-tests--layout-source-lines blocked width))))))) + +(ert-deftest ekp-test-break-policy-normal-clears-automatic-token-restrictions () + "Region `normal' overrides automatic token no-hyphen/no-break restrictions." + (ekp-tests--with-clean-state + (dolist (case '(("processInternationalization42" identifier no-hyphen) + ("100000MB" number-unit no-break))) + (pcase-let ((`(,token ,category ,policy) case)) + (let ((text (copy-sequence token)) + (ekp-token-break-policies (list (cons category policy)))) + (put-text-property 0 (length text) 'ekp-break-policy 'normal text) + (let ((analysis (car (ekp--analyze-policies text)))) + (should (ekp-tests--text-property-not-any + 0 (length text) 'ekp--no-hyphen analysis)) + (should (ekp-tests--text-property-not-any + 0 (length text) 'ekp--automatic-no-break analysis)) + (should-not (get-text-property 0 'ekp--hyphenation analysis)) + (should (eq (get-text-property 0 'ekp--policy-provenance analysis) + 'region)))))))) + +(ert-deftest ekp-test-break-policy-hyphenate-clears-automatic-token-restrictions () + "Region `hyphenate' enables hyphenation and clears automatic restrictions." + (ekp-tests--with-clean-state + (dolist (case '(("processInternationalization42" identifier no-hyphen) + ("100000MB" number-unit no-break))) + (pcase-let ((`(,token ,category ,policy) case)) + (let ((text (copy-sequence token)) + (ekp-token-break-policies (list (cons category policy)))) + (put-text-property 0 (length text) 'ekp-break-policy 'hyphenate text) + (let ((analysis (car (ekp--analyze-policies text)))) + (should (ekp-tests--text-property-not-any + 0 (length text) 'ekp--no-hyphen analysis)) + (should (ekp-tests--text-property-not-any + 0 (length text) 'ekp--automatic-no-break analysis)) + (should (eq (get-text-property 0 'ekp--hyphenation analysis) 'on)) + (should (eq (get-text-property 0 'ekp--policy-provenance analysis) + 'region)))))))) + +(ert-deftest ekp-test-break-policy-no-hyphen-keeps-ordinary-word-atomic () + "Region `no-hyphen' suppresses hyphenation without inventing word breaks." + (ekp-tests--with-clean-state + (let* ((word (copy-sequence "internationalization")) + (width 12)) + (put-text-property 0 (length word) 'ekp-break-policy 'no-hyphen word) + (should-not (ekp-tests--layout-hyphen-lines word width)) + (should (member (substring-no-properties word) + (ekp-tests--layout-source-lines word width)))))) + +(ert-deftest ekp-test-break-policy-region-suppresses-token-only-in-subrange () + "A middle region override must leave outer automatic token policy intact." + (ekp-tests--with-clean-state + (let* ((text (copy-sequence "processInternationalization42")) + (start 7) + (end 27) + (ekp-token-break-policies '((identifier . no-hyphen)))) + (put-text-property start end 'ekp-break-policy 'normal text) + (pcase-let ((`(,analysis . ,intervals) (ekp--analyze-policies text))) + (should (ekp-tests--text-property-not-any + start end 'ekp--no-hyphen analysis)) + (should (eq (get-text-property (1- start) 'ekp--no-hyphen analysis) + t)) + (should (eq (get-text-property end 'ekp--no-hyphen analysis) t)) + (should (equal (ekp-tests--policy-interval-signatures intervals) + `((0 ,start no-hyphen token identifier) + (,end ,(length text) no-hyphen token identifier) + (,start ,end normal region nil)))))))) + +(ert-deftest ekp-test-break-policy-explicit-no-break-wins () + "Explicit `ekp-no-break' stays rigid under every region policy value." + (ekp-tests--with-clean-state + (dolist (policy '(normal hyphenate no-hyphen)) + (let* ((atom (copy-sequence "internationalization atom"))) + (put-text-property 0 (length atom) 'ekp-no-break t atom) + (put-text-property 0 (length atom) 'ekp-break-policy policy atom) + (let* ((text (concat "x " atom " y")) + (start 2) + (end (+ start (length atom)))) + (let ((source-lines (ekp-tests--layout-source-lines text 12))) + (should (seq-some + (lambda (line) + (string-match-p + (regexp-quote (substring-no-properties atom)) line)) + source-lines)) + (should-not (ekp-tests--layout-hyphen-lines text 12)) + (let ((line (seq-find + (lambda (candidate) + (string-match-p + (regexp-quote (substring-no-properties atom)) + candidate)) + source-lines))) + (should line))) + (should (eq (get-text-property start 'ekp-no-break text) t)) + (should (eq (get-text-property start 'ekp-break-policy text) + policy)) + (should (= end (+ start (length atom))))))))) + +(ert-deftest ekp-test-token-break-policies-positive-negative-controls () + "Token policies classify only bounded URL/path/identifier/number-unit atoms." + (ekp-tests--with-clean-state + (let ((ekp-hyphenation 'on) + (ekp-token-break-policies + '((url . no-hyphen) (path . no-hyphen) + (identifier . no-hyphen) (number-unit . no-break))) + (cases '(("url" "https://example.test/internationalization" + "https prose internationalization") + ("path" "src/core/internationalization_file.el" + "/ internationalization") + ("identifier" "processInternationalization42" + "ordinary internationalization") + ("number-unit" "3.14MB" "2026August")))) + (dolist (case cases) + (pcase-let ((`(,_label ,positive ,negative) case)) + (should-not + (ekp-tests--layout-hyphen-lines + (concat "aa " positive " zz") 14)) + (when (string-match-p "internationalization" negative) + (should + (ekp-tests--layout-hyphen-lines + (concat "aa " negative " zz") 14)))))) + (let ((normal (let ((ekp-token-break-policies + '((identifier . normal)))) + (ekp-pixel-justify + "aa processInternationalization42 zz" 14))) + (restricted (ekp-pixel-justify + "aa processInternationalization42 zz" 14))) + (should-not (equal normal restricted))))) + +(ert-deftest ekp-test-automatic-no-break-downgrades-when-overwide () + "Automatic no-break may downgrade; explicit no-break may not." + (ekp-tests--with-clean-state + (let* ((token "src/internationalization/configuration/file.el") + (text (concat "前缀 " token " 后缀")) + (explicit-token (propertize token 'ekp-no-break t)) + (explicit (concat "前缀 " explicit-token " 后缀")) + (width 24) + (ekp-token-break-policies '((path . no-break))) + (automatic-lines (ekp-tests--layout-source-lines text width)) + (explicit-lines (ekp-tests--layout-source-lines explicit width))) + (should (seq-some (lambda (line) (string-prefix-p "前缀" line)) + automatic-lines)) + (should-not (member token automatic-lines)) + (should (seq-some (lambda (line) (string-match-p "src/" line)) + automatic-lines)) + (should (seq-some + (lambda (line) (string-match-p (regexp-quote token) line)) + explicit-lines))))) + +(ert-deftest ekp-test-automatic-overwide-no-break-measures-token-once () + "Automatic overwide no-break analysis measures the matched token once." + (ekp-tests--with-clean-state + (let* ((token "supercalifragilisticexpialidocious") + (text (concat "aa " token " zz")) + (ekp-overlong-token-policy 'overflow) + (ekp--policy-measure 8) + (measure-count 0) + (measure-fn (symbol-function 'ekp--measured-width))) + (cl-letf (((symbol-function 'ekp--measured-width) + (lambda (string) + (when (string= string token) + (setq measure-count (1+ measure-count))) + (funcall measure-fn string)))) + (ekp--analyze-policies text)) + (should (= measure-count 1))))) + +(ert-deftest ekp-test-token-break-policies-negative-classification-controls () + "Approved token negatives stay unclassified; namespace identifiers classify." + (ekp-tests--with-clean-state + (let ((ekp-token-break-policies + '((url . no-hyphen) (path . no-hyphen) + (identifier . no-hyphen) (number-unit . no-break)))) + (let (classified) + (dolist (token '("word." "/" "\\" "well-known" "3.14" + "纯中文" "name@example.test" "foo:bar")) + (let ((analysis (ekp--analyze-policies token))) + (unless (and (eq (car analysis) token) + (null (cdr analysis))) + (push (cons token + (ekp-tests--policy-interval-signatures + (cdr analysis))) + classified)))) + (should (equal (nreverse classified) nil))) + (pcase-let ((`(,analysis . ,intervals) + (ekp--analyze-policies "ns::value"))) + (should (eq (get-text-property 0 'ekp--no-hyphen analysis) t)) + (should (equal (ekp-tests--policy-interval-signatures intervals) + '((0 9 no-hyphen token identifier)))))))) + +(ert-deftest ekp-test-face-no-break-overrides-token-no-hyphen-by-span () + "Face no-break overrides token no-hyphen only on the annotated span." + (ekp-tests--with-clean-state + (let* ((text (copy-sequence "processInternationalization42")) + (start 7) + (end (length text)) + (ekp-token-break-policies '((identifier . no-hyphen)))) + (put-text-property start end 'ekp--face-break-policy 'no-break text) + (pcase-let ((`(,analysis . ,intervals) (ekp--analyze-policies text))) + (should (eq (get-text-property 0 'ekp--no-hyphen analysis) t)) + (should (eq (get-text-property start 'ekp--automatic-no-break + analysis) + t)) + (should (equal (ekp-tests--policy-interval-signatures intervals) + `((0 ,start no-hyphen token identifier) + (,start ,end no-break face identifier)))))))) + +(ert-deftest ekp-test-token-no-break-outranks-face-no-hyphen () + "Token no-break remains stricter than face no-hyphen." + (ekp-tests--with-clean-state + (let* ((text (copy-sequence "100000MB")) + (ekp-token-break-policies '((number-unit . no-break)))) + (put-text-property 0 (length text) + 'ekp--face-break-policy 'no-hyphen text) + (pcase-let ((`(,analysis . ,intervals) (ekp--analyze-policies text))) + (should (eq (get-text-property 0 'ekp--automatic-no-break analysis) + t)) + (should (equal (ekp-tests--policy-interval-signatures intervals) + '((0 8 no-break token number-unit)))))))) + +(ert-deftest ekp-test-region-policy-clears-face-and-token-markers-on-overlap () + "Explicit region policy clears automatic face/token markers in its span." + (ekp-tests--with-clean-state + (dolist (policy '(normal hyphenate no-hyphen)) + (let* ((text (copy-sequence "processInternationalization42")) + (start 7) + (end 20) + (ekp-token-break-policies '((identifier . no-hyphen)))) + (put-text-property 0 (length text) + 'ekp--face-break-policy 'no-break text) + (put-text-property start end 'ekp-break-policy policy text) + (let ((analysis (car (ekp--analyze-policies text)))) + (should (eq (get-text-property start 'ekp--policy-provenance + analysis) + 'region)) + (should (ekp-tests--text-property-not-any + start end 'ekp--automatic-no-break analysis)) + (should (ekp-tests--text-property-not-any + start end 'ekp--literal-spacing analysis)) + (pcase policy + ('hyphenate + (should (eq (get-text-property start 'ekp--hyphenation + analysis) + 'on))) + ('normal + (should (ekp-tests--text-property-not-any + start end 'ekp--no-hyphen analysis)) + (should-not (get-text-property start 'ekp--hyphenation + analysis))) + ('no-hyphen + (should (eq (get-text-property start 'ekp--no-hyphen + analysis) + t))))))))) + +(ert-deftest ekp-test-face-no-break-fits-as-rigid-span () + "Fitting face no-break forbids breaks inside the annotated span." + (ekp-tests--with-clean-state + (let* ((text (copy-sequence "aa bb cc")) + (ekp--policy-measure 100)) + (put-text-property 0 5 'ekp--face-break-policy 'no-break text) + (let* ((policy-analysis (ekp--analyze-policies text)) + (para (ekp--make-para text policy-analysis)) + (boxes (append (ekp-para-boxes para) nil)) + (breaks (ekp-para-breaks-allowed para))) + (should (equal boxes '("aa" " " "bb" "cc"))) + (should-not (aref breaks 1)) + (should-not (aref breaks 2)) + (should (aref breaks 3)))))) + +(ert-deftest ekp-test-overwide-face-no-break-measures-once-and-downgrades () + "Overwide automatic face no-break measures once and downgrades to no-hyphen." + (ekp-tests--with-clean-state + (let* ((token "supercalifragilisticexpialidocious") + (text (copy-sequence token)) + (ekp--policy-measure 8) + (measure-count 0) + (measure-fn (symbol-function 'ekp--measured-width))) + (put-text-property 0 (length text) + 'ekp--face-break-policy 'no-break text) + (cl-letf (((symbol-function 'ekp--measured-width) + (lambda (string) + (when (string= string token) + (setq measure-count (1+ measure-count))) + (funcall measure-fn string)))) + (pcase-let ((`(,analysis . ,intervals) (ekp--analyze-policies text))) + (should (= measure-count 1)) + (should (eq (get-text-property 0 'ekp--no-hyphen analysis) t)) + (should-not (get-text-property 0 'ekp--automatic-no-break analysis)) + (should (equal (ekp-tests--policy-interval-signatures intervals) + `((0 ,(length text) no-hyphen face nil))))))))) + +(ert-deftest ekp-test-face-no-break-measures-contiguous-span-across-public-props () + "Face no-break width analysis ignores unrelated public property splits." + (ekp-tests--with-clean-state + (let* ((span "abcdef") + (text (copy-sequence (concat span " zz"))) + (ekp--policy-measure 40) + measured + measured-string) + (put-text-property 0 (length span) + 'ekp--face-break-policy 'no-break text) + (put-text-property 1 3 'face 'ekp-test-inline text) + (put-text-property 3 5 'ekp-custom-property 'kept text) + (cl-letf (((symbol-function 'ekp--string-pixel-width) + (lambda (string) + (push (substring-no-properties string) measured) + (setq measured-string string) + (* 10 (length string))))) + (pcase-let ((`(,analysis . ,intervals) (ekp--analyze-policies text))) + (maphash + (lambda (key _) + (dolist (cached-string (ekp-tests--strings-in-tree key)) + (ekp-tests--assert-no-private-policy-properties + cached-string))) + ekp--box-width-cache) + (should (equal (nreverse measured) (list span))) + (should (eq (get-text-property 1 'face measured-string) + 'ekp-test-inline)) + (should (eq (get-text-property 3 'ekp-custom-property + measured-string) + 'kept)) + (should (seq-every-p + (lambda (interval) + (eq (ekp--policy-interval-break-policy interval) + 'no-hyphen)) + intervals)) + (should-not + (seq-some + (lambda (interval) + (eq (ekp--policy-interval-break-policy interval) 'no-break)) + intervals)) + (should (equal (ekp-tests--policy-interval-signatures intervals) + `((0 ,(length span) no-hyphen face nil)))) + (should (eq (get-text-property 1 'face analysis) + 'ekp-test-inline)) + (should (eq (get-text-property 3 'ekp-custom-property analysis) + 'kept)) + (let* ((para (ekp--make-para text (cons analysis intervals))) + (boxes (append (ekp-para-boxes para) nil))) + (dolist (box boxes) + (ekp-tests--assert-no-private-policy-properties box)))))))) + +(ert-deftest ekp-test-explicit-no-break-with-face-policy-never-downgrades () + "Explicit ekp-no-break stays rigid even with overwide face no-break." + (ekp-tests--with-clean-state + (let* ((atom (copy-sequence "foo bar baz")) + (text (concat "x " atom " y")) + (start 2) + (end (+ start (length atom)))) + (put-text-property start end 'ekp-no-break t text) + (put-text-property start end 'ekp--face-break-policy 'no-break text) + (let ((lines (let ((ekp--policy-measure 4)) + (ekp-tests--layout-source-lines text 4)))) + (should (seq-find + (lambda (line) + (string-match-p (regexp-quote atom) line)) + lines)))))) + +(ert-deftest ekp-test-face-policy-makes-spacing-literal-only-for-face () + "Face policy uses literal spacing; token and region policy do not." + (ekp-tests--with-clean-state + (let ((face (copy-sequence "aa bb")) + (region (copy-sequence "aa bb")) + (token (copy-sequence "src/foo"))) + (put-text-property 0 (length face) + 'ekp--face-break-policy 'no-hyphen face) + (put-text-property 0 (length region) + 'ekp-break-policy 'no-hyphen region) + (let ((ekp-token-break-policies '((path . no-hyphen)))) + (should (eq (get-text-property 2 'ekp--literal-spacing + (car (ekp--analyze-policies face))) + t)) + (should-not (get-text-property 2 'ekp--literal-spacing + (car (ekp--analyze-policies region)))) + (should-not (get-text-property 3 'ekp--literal-spacing + (car (ekp--analyze-policies token)))))))) + +(ert-deftest ekp-test-face-literal-spaces-stay-boxes-with-outer-breaks () + "Face literal spaces remain boxes while the following boundary can break." + (ekp-tests--with-clean-state + (let* ((text (copy-sequence "aa bb cc")) + (ekp--policy-measure 100)) + (put-text-property 0 6 'ekp--face-break-policy 'no-hyphen text) + (let* ((policy-analysis (ekp--analyze-policies text)) + (para (ekp--make-para text policy-analysis)) + (boxes (append (ekp-para-boxes para) nil)) + (breaks (ekp-para-breaks-allowed para))) + (should (equal boxes '("aa" " " "bb" "cc"))) + (should (equal (append breaks nil) '(t nil t t t))) + (should-not (aref breaks 1)) + (should (aref breaks 2)) + (should (aref breaks 3)))))) + +(ert-deftest ekp-test-face-literal-space-layout-breaks-after-space-boxes () + "Face literal-space breaks own source spaces, independent of style." + (ekp-tests--with-clean-state + (dolist (styled '(nil t)) + (let* ((text (copy-sequence "aa bb cc dd")) + (ekp--policy-measure 100)) + (put-text-property 0 (length text) + 'ekp--face-break-policy 'no-hyphen text) + (when styled + (put-text-property 1 13 'face 'ekp-test-inline text)) + (cl-letf (((symbol-function 'ekp--string-pixel-width) + (lambda (string) (length string)))) + (let* ((policy-analysis (ekp--analyze-policies text)) + (para (ekp--make-para text policy-analysis)) + (breaks (append (ekp-para-breaks-allowed para) nil)) + (plan (ekp-layout-plan text 4)) + (lines (append (ekp-layout-plan-lines plan) nil)) + (source-lines + (mapcar + (lambda (line) + (substring-no-properties + text + (ekp-layout-line-source-start line) + (ekp-layout-line-source-end line))) + lines)) + (source-maps + (mapcar + (lambda (line) + (list (ekp-layout-line-source-start line) + (ekp-layout-line-source-end line) + (ekp-layout-line-break-source-start line) + (ekp-layout-line-break-source-end line))) + lines))) + (should (equal breaks '(t nil t nil t nil t t))) + (should (equal source-lines '("aa" "bb" "cc" "dd"))) + (should (equal source-maps + '((0 2 2 4) (4 6 6 8) + (8 10 10 12) (12 14 14 14)))) + (dolist (line source-lines) + (should-not (string-prefix-p " " line)) + (should-not (string-suffix-p " " line))) + (should (seq-every-p + (lambda (line) + (not (ekp-layout-line-hyphen-p line))) + lines)))))))) + +(ert-deftest ekp-test-private-face-policy-does-not-leak-from-plan () + "Private face policy is stripped from plan strings, boxes, and rendering." + (ekp-tests--with-clean-state + (let* ((source (propertize "aa bb cc" + 'face 'ekp-test-inline + 'ekp-custom-property 'kept)) + (width 100)) + (put-text-property 0 5 'ekp--face-break-policy 'no-hyphen source) + (let* ((plan (ekp-layout-plan source width)) + (plan-string (ekp-layout-plan-string plan)) + (para (ekp-layout-plan-para plan)) + (boxes (append (ekp-para-boxes para) nil)) + (rendered (ekp-render-layout-string plan)) + (key (ekp--para-key source))) + (ekp-tests--assert-no-private-policy-properties plan-string) + (ekp-tests--assert-no-private-policy-properties (car key)) + (ekp-tests--assert-no-private-policy-properties (car ekp--last-para)) + (ekp-tests--assert-no-private-policy-properties + (car (cadr ekp--last-para))) + (dolist (box boxes) + (ekp-tests--assert-no-private-policy-properties box)) + (ekp-tests--assert-no-private-policy-properties rendered) + (should (equal-including-properties + (substring plan-string 0 5) + (propertize "aa bb" + 'face 'ekp-test-inline + 'ekp-custom-property 'kept))) + (should (equal-including-properties + (substring (car key) 0 5) + (propertize "aa bb" + 'face 'ekp-test-inline + 'ekp-custom-property 'kept))))))) + +(ert-deftest ekp-test-kinsoku-profiles-public-path () + "Kinsoku profiles are selectable and do not leak global punctuation state." + (ekp-tests--with-clean-state + (let ((width 2)) + (let ((ekp-kinsoku-profile 'common)) + (should (member ?ぁ (ekp-tests--line-start-chars "あぁい" width))) + (should-not (member ?。 (ekp-tests--line-start-chars "あ。い" width)))) + (let ((ekp-kinsoku-profile 'zh)) + (should-not (member ?， (ekp-tests--line-start-chars "中，文" width))) + (should-not (member ?、 (ekp-tests--line-start-chars "中、文" width)))) + (let ((ekp-kinsoku-profile 'ja)) + (dolist (char '(?ぁ ?ー ?々)) + (should-not + (member char + (ekp-tests--line-start-chars + (concat "あ" (char-to-string char) "い") width))))) + (let ((ekp-kinsoku-profile 'ja) + (ekp-cjk-no-line-start-extra "")) + (should-not (member ?ぁ (ekp-tests--line-start-chars "あぁい" width)))) + (let ((ekp-kinsoku-profile 'off)) + (should (member ?。 (ekp-tests--line-start-chars "あ。い" width)))) + (let ((ekp-kinsoku-profile 'custom) + (ekp-cjk-no-line-start-extra "※") + (ekp-cjk-no-line-end-extra "〒")) + (should-not (member ?※ (ekp-tests--line-start-chars "あ※い" width))) + (let ((lines (ekp-tests--rendered-lines "〒あい" width))) + (should-not (seq-some + (lambda (line) (string-suffix-p "〒" line)) + (butlast lines)))) + (should (member ?☆ (ekp-tests--line-start-chars "あ☆い" width)))) + (let ((ekp-kinsoku-profile 'custom) + (ekp-cjk-no-line-start-extra "") + (ekp-cjk-no-line-end-extra "")) + (should (member ?※ (ekp-tests--line-start-chars "あ※い" width))))))) + +(ert-deftest ekp-test-overlong-token-policies-are-distinguishable () + "Emergency, overflow, and natural overlong policies expose distinct states." + (ekp-tests--with-clean-state + (let* ((token "supercalifragilisticexpialidocious") + (text (concat "aa " token " zz")) + (width 8) + (emergency (let ((ekp-overlong-token-policy 'emergency)) + (ekp-layout-plan text width))) + (overflow (let ((ekp-overlong-token-policy 'overflow)) + (ekp-layout-plan text width))) + (natural (let ((ekp-overlong-token-policy 'natural)) + (ekp-layout-plan text width)))) + (should (eq (ekp-tests--plan-state emergency) 'planned)) + (should (eq (ekp-tests--plan-state overflow) 'planned)) + (should (eq (ekp-tests--plan-state natural) 'natural)) + (should (eq (ekp-tests--plan-reason natural) 'overlong-token)) + (should-not (equal (ekp-render-layout-string emergency) + (ekp-render-layout-string overflow))) + (should (equal-including-properties + (let ((ekp-overlong-token-policy 'natural)) + (ekp-pixel-justify text width)) + text)) + (ekp-tests--assert-no-private-policy-properties + (ekp-render-layout-string natural))))) + +(ert-deftest ekp-test-policy-properties-change-cache-identity () + "In-place `ekp-break-policy' changes invalidate paragraph and DP identity." + (ekp-tests--with-clean-state + (let* ((text (copy-sequence "internationalization policy cache")) + (width 12) + (plain (ekp-layout-plan text width))) + (put-text-property 0 (length "internationalization") + 'ekp-break-policy 'no-hyphen text) + (let ((blocked (ekp-layout-plan text width))) + (should-not (eq (ekp-layout-plan-para plain) + (ekp-layout-plan-para blocked))) + (should-not (equal (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines plain) nil)) + (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines blocked) nil)))) + (remove-text-properties 0 (length text) '(ekp-break-policy nil) text) + (let ((roundtrip (ekp-layout-plan text width))) + (should (equal (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines plain) nil)) + (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines roundtrip) + nil))))))))) + +(ert-deftest ekp-test-policy-analysis-does-not-leak-private-properties () + "Policy analysis preserves public properties and strips internal markers." + (ekp-tests--with-clean-state + (let* ((source (propertize "processKeyword42" + 'face 'ekp-test-inline + 'ekp-custom-property 'kept)) + (rendered (let ((ekp-inline-code-policy 'no-hyphen) + (ekp-token-break-policies + '((identifier . no-hyphen)))) + (ekp-pixel-justify source 8)))) + (should (equal (ekp-tests--content rendered) + (ekp-tests--content source))) + (should (eq (get-text-property 0 'face rendered) + 'ekp-test-inline)) + (should (eq (get-text-property 0 'ekp-custom-property rendered) + 'kept)) + (ekp-tests--assert-no-private-policy-properties rendered)))) + +(ert-deftest ekp-test-policy-analysis-reuses-source-when-no-policy-matches () + "No-match policy analysis must return the original string object." + (ekp-tests--with-clean-state + (let ((source (propertize "ordinary words without policy" + 'face 'ekp-test-face)) + (copy-count 0) + (copy-sequence-fn (symbol-function 'copy-sequence))) + (cl-letf (((symbol-function 'copy-sequence) + (lambda (sequence) + (setq copy-count (1+ copy-count)) + (funcall copy-sequence-fn sequence)))) + (let ((analysis (ekp--analyze-policies source))) + (should (eq (car analysis) source)) + (should (null (cdr analysis))))) + (should (= copy-count 0)) + (should (eq (get-text-property 0 'face source) 'ekp-test-face))))) + +(ert-deftest ekp-test-c-policy-contract-remains-fifteen-fields-and-args () + "Policy compilation must not expand the C DP ABI." + (ekp-tests--with-clean-state + (let* ((para (ekp--get-para + (propertize "internationalization policy contract" + 'ekp-break-policy 'no-hyphen))) + (prepared (ekp--prepare-para-for-c para 12)) + captured-args) + (should (= (length prepared) 15)) + (let ((ekp-use-c-module t) + (ekp-c-module-loaded t)) + (cl-letf (((symbol-function 'ekp-c-break-with-arrays) + (lambda (&rest args) + (setq captured-args args) + (cons nil 0.0)))) + (ekp-dp-cache "internationalization policy contract" 12))) + (should (= (length captured-args) 15))))) + +(ert-deftest ekp-test-c-emergency-stretch-contract-remains-fifteen-fields-and-args () + "Configurable emergency stretch must not expand the C DP ABI." + (ekp-tests--with-clean-state + (let* ((ekp-emergency-stretch-pixel 4) + (para (ekp--get-para "alpha beta emergency stretch contract")) + (prepared (ekp--prepare-para-for-c para 12)) + captured-args) + (should (= (length prepared) 15)) + (let ((ekp-use-c-module t) + (ekp-c-module-loaded t)) + (cl-letf (((symbol-function 'ekp-c-break-with-arrays) + (lambda (&rest args) + (setq captured-args args) + (cons nil 0.0)))) + (ekp-dp-cache "alpha beta emergency stretch contract" 12))) + (should (= (length captured-args) 15))))) + +(ert-deftest ekp-test-c-emergency-stretch-syncs-fixed-budget-as-eighth-param () + "The C penalty sync receives the fixed emergency stretch as argument 8." + (ekp-tests--with-clean-state + (let ((ekp-emergency-stretch-pixel 7) + captured-args) + (cl-letf (((symbol-function 'ekp-c-set-penalties) + (lambda (&rest args) + (setq captured-args args)))) + (ekp--c-sync-params)) + (should (= (length captured-args) 8)) + (should (= (nth 7 captured-args) 7))))) + +(ert-deftest ekp-test-c-emergency-stretch-batch-payload-remains-fifteen-fields () + "Batch paragraphs keep the 15-field C ABI when emergency stretch is configured." + (ekp-tests--with-clean-state + (let ((ekp-use-c-module t) + (ekp-c-module-loaded t) + (ekp-emergency-stretch-pixel 7) + captured-batch) + (cl-letf (((symbol-function 'ekp-c-set-penalties) #'ignore) + ((symbol-function 'ekp-c-break-batch) + (lambda (batch) + (setq captured-batch batch) + nil))) + (ekp--dp-cache-batch + '("alpha beta emergency batch" + "gamma delta emergency batch") + 12)) + (should (vectorp captured-batch)) + (should (= (length captured-batch) 2)) + (dotimes (index (length captured-batch)) + (should (= (length (aref captured-batch index)) 15)))))) + +(ert-deftest ekp-test-c-policy-contract-explicit-no-break-reaches-c-dispatch () + "The public C dispatch path must handle explicit no-break paragraphs." + (ekp-tests--with-clean-state + (let* ((atom (propertize "foo bar baz" 'ekp-no-break t)) + (text (concat "aa " atom " zz")) + (ekp-use-c-module t) + (ekp-c-module-loaded t) + c-called) + (cl-letf (((symbol-function 'ekp-c-break-with-arrays) + (lambda (&rest _args) + (setq c-called t) + (cons nil 0.0)))) + (ekp-dp-cache text 60)) + (should c-called)))) + +(ert-deftest ekp-test-c-policy-contract-explicit-no-break-stores-c-directly () + "Explicit no-break C results must be stored without Elisp comparison fallback." + (skip-unless (ekp-tests--c-available)) + (ekp-tests--with-clean-state + (let* ((atom (propertize "foo bar baz" 'ekp-no-break t)) + (text (concat "aa " atom " zz")) + (ekp-use-c-module t)) + (cl-letf (((symbol-function 'ekp--dp-cache-elisp) + (lambda (&rest _) + (error "explicit no-break C dispatch must not call Elisp")))) + (let ((result (ekp-dp-cache text 60))) + (should (plist-get result :breaks)) + (should (numberp (plist-get result :cost)))))))) + +(ert-deftest ekp-test-c-batch-policy-parity-explicit-no-break-orphan-fixture () + "Batch C DP must match Elisp for the strengthened explicit no-break fixture." + (skip-unless (ekp-tests--c-available)) + (let* ((atom (propertize + (concat "原子演示: 代码片段 " (make-string 20 ?a)) + 'ekp-no-break t)) + (text (concat + "行内" atom + " 永不折散、空格保持字面宽度；不间断空格让 " + "100_000 与 3.14_MB 这类数字单位锁在同一行。")) + (width 41) + elisp-result elisp-signatures + batch-result batch-signatures) + (ekp-tests--with-clean-state + (let ((ekp-use-c-module nil)) + (setq elisp-result (ekp-dp-cache text width) + elisp-signatures + (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines + (ekp-layout-plan text width)) + nil))))) + (ekp-tests--with-clean-state + (let ((ekp-use-c-module t)) + (setq batch-result (car (ekp--dp-cache-batch (list text) width)) + batch-signatures + (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines + (ekp-layout-plan text width)) + nil))))) + (should (equal (plist-get batch-result :breaks) + (plist-get elisp-result :breaks))) + (should (equal (plist-get batch-result :cost) + (plist-get elisp-result :cost))) + (should (equal batch-signatures elisp-signatures)))) + +(ert-deftest ekp-test-c-policy-contract-forbidden-positions-are-break-indices () + "C forbidden positions carry only real break indices, never policy sentinels." + (ekp-tests--with-clean-state + (let* ((atom (propertize "foo bar" + 'ekp-no-break t + 'ekp-break-policy 'normal)) + (para (ekp--get-para atom)) + (n (length (ekp-para-boxes para))) + (forbidden (ekp-para-forbidden-positions para))) + (should-not (= (length forbidden) 0)) + (dotimes (i (length forbidden)) + (should (<= 1 (aref forbidden i))) + (should (<= (aref forbidden i) n)))))) + +(ert-deftest ekp-test-explicit-hard-atom-keeps-preceding-boundary-legal () + "An explicit hard atom must not rewrite an adjacent ordinary break." + (ekp-tests--with-clean-state + (dolist (case '(("行" "内" "原子演示") + ("甲乙" "丙" "代码片段"))) + (pcase-let ((`(,prefix ,ordinary ,atom-text) case)) + (let* ((atom (propertize atom-text 'ekp-no-break t)) + (text (concat prefix ordinary atom " 后文")) + (para (ekp--get-para text)) + (boxes (ekp-para-boxes para)) + (breaks (ekp-para-breaks-allowed para)) + (atom-index + (cl-loop for i from 0 below (length boxes) + when (get-text-property 0 'ekp-no-break + (aref boxes i)) + return i)) + (ordinary-index (and atom-index (1- atom-index)))) + (should atom-index) + (should (> ordinary-index 0)) + (should (equal (substring-no-properties (aref boxes ordinary-index)) + ordinary)) + (should-not (get-text-property 0 'ekp-no-break + (aref boxes ordinary-index))) + (should-not (ekp--box-space-p (aref boxes ordinary-index))) + (should (aref breaks ordinary-index))))))) + +(ert-deftest ekp-test-c-policy-contract-single-dispatch-rejects-malformed-breaks () + "Malformed non-nil C single-dispatch breaks are backend contract errors." + (ekp-tests--with-clean-state + (cl-labels + ((nboxes (args) + (1- (length (car args)))) + (valid-breaks (args) + (list (nboxes args))) + (assert-backend-contract-error (_label err) + (should + (memq 'ekp-backend-contract-error + (get (car err) 'error-conditions))))) + (let ((ekp-use-c-module t) + (ekp-c-module-loaded t) + (elisp-calls 0) + (elisp (symbol-function 'ekp--dp-cache-elisp)) + (text "alpha beta gamma delta epsilon") + (width 16)) + (cl-letf (((symbol-function 'ekp-c-break-with-arrays) + (lambda (&rest _) + (cons nil 0.0))) + ((symbol-function 'ekp--dp-cache-elisp) + (lambda (&rest args) + (cl-incf elisp-calls) + (apply elisp args)))) + (should (plist-get (ekp-dp-cache text width) :breaks)) + (should (= elisp-calls 1))) + (dolist + (case + `(("out-of-range break" + . ,(lambda (args) (cons (list (1+ (nboxes args))) 0.0))) + ("partial final coverage" + . ,(lambda (args) (cons (list (1- (nboxes args))) 0.0))) + ("duplicate breaks" + . ,(lambda (_args) (cons '(1 1) 0.0))) + ("decreasing breaks" + . ,(lambda (args) (cons (list 2 1 (nboxes args)) 0.0))) + ("non-integer breaks" + . ,(lambda (args) (cons (list 1 'bad (nboxes args)) 0.0))) + ("non-list breaks" + . ,(lambda (args) (cons (vector (nboxes args)) 0.0))) + ("nonnumeric cost" + . ,(lambda (args) (cons (valid-breaks args) 'bad-cost))) + ("malformed non-cons result" + . ,(lambda (_args) 'bad-result)))) + (ekp-clear-caches) + (setq elisp-calls 0) + (let ((label (car case)) + (make-result (cdr case))) + (ert-info ((format "single malformed C case: %s" label)) + (cl-letf (((symbol-function 'ekp-c-break-with-arrays) + (lambda (&rest args) + (funcall make-result args))) + ((symbol-function 'ekp--dp-cache-elisp) + (lambda (&rest _) + (cl-incf elisp-calls) + (error "single malformed C result called Elisp fallback")))) + (let ((err (should-error (ekp-dp-cache text width)))) + (should (= elisp-calls 0)) + (assert-backend-contract-error label err)))))))))) + +(ert-deftest ekp-test-c-policy-contract-batch-dispatch-rejects-malformed-breaks () + "Malformed non-nil C batch breaks are backend contract errors." + (ekp-tests--with-clean-state + (cl-labels + ((nboxes (entry) + (1- (length (aref entry 0)))) + (valid-breaks (entry) + (list (nboxes entry))) + (one-entry-vector (batch make-result) + (let ((results (make-vector (length batch) nil))) + (aset results 0 (funcall make-result (aref batch 0))) + results)) + (assert-backend-contract-error (_label err) + (should + (memq 'ekp-backend-contract-error + (get (car err) 'error-conditions))))) + (let ((ekp-use-c-module t) + (ekp-c-module-loaded t) + (elisp-calls 0) + (elisp (symbol-function 'ekp--dp-cache-elisp)) + (text '("alpha beta gamma delta epsilon")) + (width 16)) + (cl-letf (((symbol-function 'ekp-c-break-batch) + (lambda (_batch) nil)) + ((symbol-function 'ekp--dp-cache-elisp) + (lambda (&rest args) + (cl-incf elisp-calls) + (apply elisp args)))) + (should (plist-get (car (ekp--dp-cache-batch text width)) + :breaks)) + (should (= elisp-calls 1))) + (ekp-clear-caches) + (setq elisp-calls 0) + (cl-letf (((symbol-function 'ekp-c-break-batch) + (lambda (batch) + (make-vector (length batch) nil))) + ((symbol-function 'ekp--dp-cache-elisp) + (lambda (&rest args) + (cl-incf elisp-calls) + (apply elisp args)))) + (should (plist-get (car (ekp--dp-cache-batch text width)) + :breaks)) + (should (= elisp-calls 1))) + (dolist + (case + `(("out-of-range break" + . ,(lambda (batch) + (one-entry-vector + batch + (lambda (entry) + (cons (list (1+ (nboxes entry))) 0.0))))) + ("partial final coverage" + . ,(lambda (batch) + (one-entry-vector + batch + (lambda (entry) + (cons (list (1- (nboxes entry))) 0.0))))) + ("duplicate breaks" + . ,(lambda (batch) + (one-entry-vector batch + (lambda (_entry) (cons '(1 1) 0.0))))) + ("decreasing breaks" + . ,(lambda (batch) + (one-entry-vector + batch + (lambda (entry) + (cons (list 2 1 (nboxes entry)) 0.0))))) + ("non-integer breaks" + . ,(lambda (batch) + (one-entry-vector + batch + (lambda (entry) + (cons (list 1 'bad (nboxes entry)) 0.0))))) + ("non-list breaks" + . ,(lambda (batch) + (one-entry-vector + batch + (lambda (entry) + (cons (vector (nboxes entry)) 0.0))))) + ("nonnumeric cost" + . ,(lambda (batch) + (one-entry-vector + batch + (lambda (entry) + (cons (valid-breaks entry) 'bad-cost))))) + ("malformed non-cons result" + . ,(lambda (batch) + (one-entry-vector batch (lambda (_entry) 'bad-result)))) + ("wrong non-nil container" + . ,(lambda (batch) + (append (one-entry-vector + batch + (lambda (entry) + (cons (valid-breaks entry) 0.0))) + nil))) + ("wrong vector length" + . ,(lambda (_batch) [])))) + (ekp-clear-caches) + (setq elisp-calls 0) + (let ((label (car case)) + (make-results (cdr case))) + (ert-info ((format "batch malformed C case: %s" label)) + (cl-letf (((symbol-function 'ekp-c-break-batch) + (lambda (batch) + (funcall make-results batch))) + ((symbol-function 'ekp--dp-cache-elisp) + (lambda (&rest _) + (cl-incf elisp-calls) + (error "batch malformed C result called Elisp fallback")))) + (let ((err (should-error (ekp--dp-cache-batch text width)))) + (should (= elisp-calls 0)) + (assert-backend-contract-error label err)))))))))) + (ert-deftest ekp-test-split-fullwidth-alnum-not-punct () "Fullwidth letters/digits are content, not punctuation." (should-not (ekp-cjk-fw-punct-p "Ａ")) @@ -508,6 +1758,28 @@ a single Latin-Latin space is dropped (glue handles it)." (should (equal (ekp-tests--content (ekp-pixel-justify s w)) (ekp-tests--content s))))))) +(ert-deftest ekp-test-emergency-stretch-underfull-renderer-distributes-rest-into-gaps () + "A normal emergency-stretch underfull line must not render rest as tail fill." + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module nil) + (ekp-emergency-stretch-pixel 1) + (text "alpha beta gamma delta epsilon") + (width 12) + (para (ekp--get-para text)) + (strict (ekp--dp-run-1d para width nil)) + (plan (ekp-layout-plan text width)) + (rendered (ekp-render-layout-string plan)) + (line (aref (ekp-layout-plan-lines plan) 0)) + (gaps (append (ekp-layout-line-gaps line) nil))) + (should-not strict) + (should (= (car (ekp-tests--line-widths rendered)) width)) + (should gaps) + (should (seq-some (lambda (gap) + (> (ekp-layout-gap-target-pixel gap) + (ekp-layout-gap-natural-pixel gap))) + gaps)) + (should (= (ekp-layout-line-trailing-pixel line) 0))))) + (ert-deftest ekp-test-justify-narrow-cjk-one-char-per-line () "At a width narrower than one CJK char, output one char per line instead of losing the paragraph (regression: used to return \"\")." @@ -671,6 +1943,27 @@ module is bypassed automatically (it has no looseness support)." (r2 (ekp-dp-cache s 60))) (should (eq r1 r2))))) +(ert-deftest ekp-test-emergency-stretch-pixel-is-dp-cache-input () + "Changing explicit emergency stretch must change final-pass DP identity." + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module nil) + (text "alpha beta gamma delta epsilon") + (width 12) + (para (ekp--get-para text))) + (should-not (ekp--dp-run-1d para width nil)) + (let* ((ekp-emergency-stretch-pixel 1) + (small (ekp--dp-cache-para para width))) + (should small) + (let* ((ekp-emergency-stretch-pixel 20) + (cached-large (ekp--dp-cache-para para width))) + (should (= (hash-table-count (ekp-para-dp-cache para)) 2)) + (ekp-clear-caches) + (let* ((fresh-para (ekp--get-para text)) + (ekp-emergency-stretch-pixel 20) + (fresh-large (ekp--dp-cache-para fresh-para width))) + (should (equal cached-large fresh-large)) + (should-not (equal small fresh-large)))))))) + ;;;; Line metrics invariants (brute force cross-check) (ert-deftest ekp-test-line-ideal-brute-force () @@ -890,7 +2183,7 @@ module is bypassed automatically (it has no looseness support)." "A chosen Latin discretionary break must be explicit in the core plan." (ekp-tests--with-clean-state (let* ((plan (ekp-layout-plan - "extraordinary hyphenation demonstration paragraph" 15)) + "extraordinary hyphenation demonstration paragraph" 16)) (line (seq-find (lambda (candidate) (eq (ekp-layout-line-break-kind candidate) 'hyphen)) @@ -1055,6 +2348,89 @@ returned the stale looseness-0 layout for the same (string, width)." (dolist (case cases) (apply #'ekp-tests--assert-dp-cache-parameter-isolated case)))) +(ert-deftest ekp-test-final-pass-artificial-demerits-preserve-last-active-path () + "The final pass must not lose its last active path at an overfull atom." + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module nil) + (atom (propertize "internationalization atom" 'ekp-no-break t)) + (text (concat "x " atom " y")) + (para (ekp--get-para text)) + (boxes (ekp-para-boxes para)) + (n (length boxes)) + (atom-end + (cl-loop for i from 0 below n + when (get-text-property 0 'ekp-no-break (aref boxes i)) + maximize (1+ i))) + (strict (ekp--dp-run-1d para 12 nil)) + (final (ekp--dp-run-1d para 12 t))) + (should-not strict) + (should final) + (should (equal (plist-get final :breaks) (list atom-end n))) + (should (= (aref (aref (plist-get final :state) 1) atom-end) 0.0)) + (ekp-tests--assert-complete-plan (ekp-layout-plan text 12))))) + +(ert-deftest ekp-test-emergency-stretch-pixel-controls-final-pass-fitness () + "Final-pass fitness must use the configured emergency stretch budget." + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module nil) + (ekp-emergency-stretch-pixel 1) + (text "alpha beta gamma delta epsilon") + (width 12) + (para (ekp--get-para text)) + (strict (ekp--dp-run-1d para width nil)) + (dp (ekp-dp-cache text width)) + (first-break (car (plist-get dp :breaks))) + (first-rest (car (plist-get dp :rests))) + (first-gaps (car (plist-get dp :gaps))) + (params (ekp-para-glue-params para)) + (stretch (+ (* (nth 0 first-gaps) + (plist-get params :lws-stretch)) + (* (nth 1 first-gaps) + (plist-get params :mws-stretch)) + (* (nth 2 first-gaps) + (plist-get params :cws-stretch)) + (or (plist-get params :extra-stretch) 0) + ekp-emergency-stretch-pixel)) + (expected (ekp--compute-fitness-class first-rest stretch)) + (actual (aref (aref (plist-get dp :state) 5) first-break))) + (should-not strict) + (should (> first-rest 0)) + (should (= expected 3)) + (should (= actual expected))))) + +(ert-deftest ekp-test-emergency-stretch-pixel-controls-parshape-cost () + "Parshape final-pass cost must use the configured emergency stretch budget." + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module nil) + (ekp-emergency-stretch-pixel 1) + (ekp-parshape (list (cons 0 12) (cons 0 50))) + (ekp-line-penalty 0) + (ekp-adjacent-fitness-penalty 0) + (ekp-hyphen-penalty 0) + (ekp-consecutive-hyphen-penalty 0) + (ekp-last-line-min-ratio 0) + (text "alpha beta gamma delta epsilon") + (para (ekp--get-para text)) + (strict (ekp--dp-run-loose para 12 nil)) + (dp (ekp-dp-cache text 12)) + (first-rest (car (plist-get dp :rests))) + (first-gaps (car (plist-get dp :gaps))) + (params (ekp-para-glue-params para)) + (stretch (+ (* (nth 0 first-gaps) + (plist-get params :lws-stretch)) + (* (nth 1 first-gaps) + (plist-get params :mws-stretch)) + (* (nth 2 first-gaps) + (plist-get params :cws-stretch)) + (or (plist-get params :extra-stretch) 0) + ekp-emergency-stretch-pixel)) + (badness (ekp--compute-badness first-rest stretch)) + (expected-cost (expt badness 2))) + (should-not strict) + (should (equal (plist-get dp :breaks) '(3 7))) + (should (> first-rest 0)) + (should (< (abs (- (plist-get dp :cost) expected-cost)) 0.0001))))) + (ert-deftest ekp-test-dp-cache-identical-signature-hits () "Structurally equal DP signatures must reuse the same cached result." (ekp-tests--with-clean-state @@ -1073,9 +2449,16 @@ returned the stale looseness-0 layout for the same (string, width)." (let* ((plain "fontified 键检查内容") (marked (propertize plain 'fontified t)) (faced (propertize plain 'face 'bold)) - (faced+marked (propertize plain 'face 'bold 'fontified t))) + (faced+marked (propertize plain 'face 'bold 'fontified t)) + (faced+split (propertize plain 'face 'bold)) + (faced+boundary (copy-sequence faced))) + (put-text-property 3 7 'fontified t faced+split) + (put-text-property 7 10 'jit-lock-defer-multiline t faced+split) + (put-text-property 3 7 'face 'italic faced+boundary) (should (equal (ekp--para-key plain) (ekp--para-key marked))) (should (equal (ekp--para-key faced) (ekp--para-key faced+marked))) + (should (equal (ekp--para-key faced) (ekp--para-key faced+split))) + (should-not (equal (ekp--para-key faced) (ekp--para-key faced+boundary))) (should-not (equal (ekp--para-key plain) (ekp--para-key faced))))) (ert-deftest ekp-test-auto-spacing-signature-keys-para-cache () @@ -1115,6 +2498,349 @@ returned the stale looseness-0 layout for the same (string, width)." (should (= count (hash-table-count ekp--para-cache))) (should (eq table-hit (ekp--get-para text))))))) +(ert-deftest ekp-test-para-cache-ignores-width-when-policy-semantics-match () + "Paragraph cache identity is semantic, not raw policy-measure keyed." + (ekp-tests--with-clean-state + (let ((ekp-use-c-module nil) + (text (copy-sequence "alpha beta gamma delta")) + (analysis-count 0) + (make-count 0) + (analyze-policies (symbol-function 'ekp--analyze-policies)) + (make-para (symbol-function 'ekp--make-para))) + (put-text-property 0 (length text) + 'ekp--face-break-policy 'no-hyphen text) + (cl-letf (((symbol-function 'ekp--analyze-policies) + (lambda (string) + (setq analysis-count (1+ analysis-count)) + (funcall analyze-policies string))) + ((symbol-function 'ekp--make-para) + (lambda (string &optional policy-analysis) + (setq make-count (1+ make-count)) + (funcall make-para string policy-analysis)))) + (let* ((narrow (ekp-layout-plan text 12)) + (narrow-intervals + (ekp-para-resolved-policies (ekp-layout-plan-para narrow))) + (wide (ekp-layout-plan text 30)) + (wide-intervals + (ekp-para-resolved-policies (ekp-layout-plan-para wide)))) + (should (equal narrow-intervals wide-intervals)) + (should (= analysis-count 1)) + (should (eq (ekp-layout-plan-para narrow) + (ekp-layout-plan-para wide))) + (should (= make-count 1))))))) + +(ert-deftest ekp-test-para-cache-distinguishes-automatic-no-break-downgrade () + "A real automatic no-break threshold change keeps distinct paragraph data." + (cl-labels + ((break-policy-present-p (para policy) + (seq-some + (lambda (interval) + (eq (ekp--policy-interval-break-policy interval) policy)) + (ekp-para-resolved-policies para))) + (assert-order (first-width second-width rigid-width) + (ekp-tests--with-clean-state + (let ((ekp-use-c-module nil) + (text (copy-sequence "alpha beta gamma"))) + (put-text-property 0 (length text) + 'ekp--face-break-policy 'no-break text) + (let* ((first (ekp-layout-plan text first-width)) + (first-para (ekp-layout-plan-para first)) + (second (ekp-layout-plan text second-width)) + (second-para (ekp-layout-plan-para second)) + (rigid-para (if (= first-width rigid-width) + first-para + second-para)) + (downgraded-para (if (= first-width rigid-width) + second-para + first-para))) + (should-not (eq first-para second-para)) + (should-not (equal (ekp-para-resolved-policies first-para) + (ekp-para-resolved-policies second-para))) + (should (break-policy-present-p rigid-para 'no-break)) + (should (break-policy-present-p downgraded-para 'no-hyphen))))))) + (assert-order 100 8 100) + (assert-order 8 100 100))) + +(ert-deftest ekp-test-policy-cache-invalidates-on-input-and-config-change () + "Policy analysis cache keys must track raw inputs and public config." + (ekp-tests--with-clean-state + (let* ((text (copy-sequence "processKeyword42 policy cache")) + (width 100) + (plain (ekp-layout-plan text width))) + (put-text-property 0 (length "processKeyword42") + 'ekp--face-break-policy 'no-hyphen text) + (let ((face-policy (ekp-layout-plan text width))) + (should-not (eq (ekp-layout-plan-para plain) + (ekp-layout-plan-para face-policy))) + (should (seq-some + (lambda (interval) + (eq (ekp--policy-interval-break-policy interval) + 'no-hyphen)) + (ekp-para-resolved-policies + (ekp-layout-plan-para face-policy))))))) + (ekp-tests--with-clean-state + (let* ((text (copy-sequence "processKeyword42 policy cache")) + (width 100) + (normal (let ((ekp-token-break-policies nil)) + (ekp-layout-plan text width))) + (configured (let ((ekp-token-break-policies + '((identifier . no-break)))) + (ekp-layout-plan text width)))) + (should-not (eq (ekp-layout-plan-para normal) + (ekp-layout-plan-para configured))) + (should-not (equal (ekp-para-resolved-policies + (ekp-layout-plan-para normal)) + (ekp-para-resolved-policies + (ekp-layout-plan-para configured))))))) + +(ert-deftest ekp-test-layout-plan-cache-reuses-semantic-plan-for-same-key () + "Repeated layout for the same semantic paragraph and width reuses assembly." + (ekp-tests--with-clean-state + (let ((ekp-use-c-module nil) + (text (copy-sequence "alpha beta gamma delta epsilon")) + (assembly-count 0) + (assemble-plan (symbol-function 'ekp--layout-plan-from-para))) + (cl-letf (((symbol-function 'ekp--layout-plan-from-para) + (lambda (&rest args) + (setq assembly-count (1+ assembly-count)) + (apply assemble-plan args)))) + (let ((first (ekp-layout-plan text 20))) + (should (= assembly-count 1)) + (let ((second (ekp-layout-plan text 20))) + (should (eq (ekp-layout-plan-para first) + (ekp-layout-plan-para second))) + (should (equal (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines first) nil)) + (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines second) + nil)))) + (should (= assembly-count 1)))))))) + +(ert-deftest ekp-test-layout-plan-cache-keeps-distinct-semantic-keys () + "Plan reuse must not alias different widths, policy input, or config." + (ekp-tests--with-clean-state + (let ((ekp-use-c-module nil) + (text (copy-sequence "alpha beta gamma delta epsilon")) + (assembly-count 0) + (assemble-plan (symbol-function 'ekp--layout-plan-from-para))) + (cl-letf (((symbol-function 'ekp--layout-plan-from-para) + (lambda (&rest args) + (setq assembly-count (1+ assembly-count)) + (apply assemble-plan args)))) + (ekp-layout-plan text 20) + (ekp-layout-plan text 30) + (should (= assembly-count 2))))) + (ekp-tests--with-clean-state + (let ((ekp-use-c-module nil) + (text (copy-sequence "alpha beta gamma delta epsilon")) + (assembly-count 0) + (assemble-plan (symbol-function 'ekp--layout-plan-from-para))) + (cl-letf (((symbol-function 'ekp--layout-plan-from-para) + (lambda (&rest args) + (setq assembly-count (1+ assembly-count)) + (apply assemble-plan args)))) + (let ((plain (ekp-layout-plan text 20))) + (put-text-property 0 (length text) + 'ekp--face-break-policy 'no-hyphen text) + (let ((policy (ekp-layout-plan text 20))) + (should (= assembly-count 2)) + (should-not (eq (ekp-layout-plan-para plain) + (ekp-layout-plan-para policy)))))))) + (ekp-tests--with-clean-state + (let ((ekp-use-c-module nil) + (text (copy-sequence "processKeyword42 plan cache")) + (assembly-count 0) + (assemble-plan (symbol-function 'ekp--layout-plan-from-para))) + (cl-letf (((symbol-function 'ekp--layout-plan-from-para) + (lambda (&rest args) + (setq assembly-count (1+ assembly-count)) + (apply assemble-plan args)))) + (let ((normal (let ((ekp-token-break-policies nil)) + (ekp-layout-plan text 100))) + (configured (let ((ekp-token-break-policies + '((identifier . no-break)))) + (ekp-layout-plan text 100)))) + (should (= assembly-count 2)) + (should-not (eq (ekp-layout-plan-para normal) + (ekp-layout-plan-para configured)))))))) + +(ert-deftest ekp-test-layout-plan-cache-does-not-expose-stored-plan () + "Cached semantic plans must be returned as mutation-isolated values." + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module nil) + (text (copy-sequence "alpha beta gamma delta epsilon")) + (width 20) + (plan1 (ekp-layout-plan text width)) + (source (substring-no-properties text)) + (signatures (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines plan1) nil)))) + (setf (ekp-layout-plan-string plan1) "mutated cached plan") + (let ((plan2 (ekp-layout-plan text width))) + (should-not (eq plan1 plan2)) + (should (equal (ekp-layout-plan-string plan2) source)) + (should (equal (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines plan2) nil)) + signatures)))))) + +(ert-deftest ekp-test-layout-plan-cache-deep-copies-nested-plan-objects () + "Cached semantic plans must own mutable consumer-facing plan slots." + (ekp-tests--with-clean-state + (cl-labels + ((line-signatures (plan) + (mapcar #'ekp-layout-line-signature + (append (ekp-layout-plan-lines plan) nil))) + (gap-signatures (plan) + (cl-loop + for line across (ekp-layout-plan-lines plan) + append (cl-loop + for gap across (ekp-layout-line-gaps line) + collect (list (ekp-layout-gap-kind gap) + (ekp-layout-gap-left-box gap) + (ekp-layout-gap-right-box gap) + (ekp-layout-gap-source-start gap) + (ekp-layout-gap-source-end gap) + (ekp-layout-gap-natural-pixel gap) + (ekp-layout-gap-target-pixel gap))))) + (snapshot (plan) + (list :string (substring-no-properties + (ekp-layout-plan-string plan)) + :context (copy-tree (ekp-layout-plan-context plan)) + :boxes (mapcar #'substring-no-properties + (append (ekp-layout-plan-boxes plan) nil)) + :offsets (mapcar (lambda (offset) + (cons (car offset) (cdr offset))) + (append (ekp-layout-plan-offsets plan) nil)) + :lines (line-signatures plan) + :gaps (gap-signatures plan))) + (assert-pristine (text width expected) + (let ((again (ekp-layout-plan text width))) + (should (equal (snapshot again) expected)))) + (first-line-with-gap (plan) + (seq-find (lambda (candidate) + (and (> (length (ekp-layout-line-glues candidate)) 0) + (> (length (ekp-layout-line-gaps candidate)) 0))) + (append (ekp-layout-plan-lines plan) nil)))) + (let* ((ekp-use-c-module nil) + (text (copy-sequence + "alpha中文beta混排gamma段落")) + (width 20)) + (put-text-property 0 (length text) + 'ekp--face-break-policy 'no-hyphen text) + (let* ((baseline (ekp-layout-plan text width)) + (expected (snapshot baseline))) + (should (> (length (ekp-layout-plan-lines baseline)) 1)) + (should (first-line-with-gap baseline)) + (let ((plan (ekp-layout-plan text width))) + (aset (ekp-layout-plan-string plan) 0 ?X)) + (assert-pristine text width expected) + (let ((plan (ekp-layout-plan text width))) + (setcar (ekp-layout-plan-context plan) 'mutated-context)) + (assert-pristine text width expected) + (let ((plan (ekp-layout-plan text width))) + (aset (ekp-layout-plan-boxes plan) 0 "mutated-box")) + (assert-pristine text width expected) + (let* ((plan (ekp-layout-plan text width)) + (box (aref (ekp-layout-plan-boxes plan) 0))) + (aset box 0 ?X)) + (assert-pristine text width expected) + (let ((plan (ekp-layout-plan text width))) + (setcar (aref (ekp-layout-plan-offsets plan) 0) 9999)) + (assert-pristine text width expected) + (let ((plan (ekp-layout-plan text width))) + (aset (ekp-layout-plan-lines plan) 0 nil)) + (assert-pristine text width expected) + (let* ((plan (ekp-layout-plan text width)) + (line (aref (ekp-layout-plan-lines plan) 0))) + (setf (ekp-layout-line-source-start line) 9999) + (setf (ekp-layout-line-signature line) '(mutated line struct))) + (assert-pristine text width expected) + (let* ((plan (ekp-layout-plan text width)) + (line (first-line-with-gap plan))) + (aset (ekp-layout-line-glues line) 0 9999) + (aset (ekp-layout-line-gaps line) 0 nil)) + (assert-pristine text width expected) + (let* ((plan (ekp-layout-plan text width)) + (line (first-line-with-gap plan)) + (gap (aref (ekp-layout-line-gaps line) 0))) + (setf (ekp-layout-gap-target-pixel gap) 9999)) + (assert-pristine text width expected)))))) + +(ert-deftest ekp-test-layout-plan-cache-context-owns-policy-strings () + "Plan context copies must not alias mutable public policy inputs." + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module nil) + (suffix (copy-sequence "uX")) + (ekp-number-unit-suffixes (list suffix)) + (ekp-token-break-policies '((number-unit . no-break))) + (text (copy-sequence "100uX alpha beta gamma delta")) + (width 16) + (assembly-count 0) + (assemble-plan (symbol-function 'ekp--layout-plan-from-para))) + (cl-letf (((symbol-function 'ekp--layout-plan-from-para) + (lambda (&rest args) + (setq assembly-count (1+ assembly-count)) + (apply assemble-plan args)))) + (let* ((plan (ekp-layout-plan text width)) + (context-suffix + (seq-find (lambda (candidate) + (equal candidate suffix)) + (ekp-tests--strings-in-tree + (ekp-layout-plan-context plan))))) + (should (= assembly-count 1)) + (should context-suffix) + (aset context-suffix 0 ?v) + (should (equal suffix "uX")) + (let ((again (ekp-layout-plan text width))) + (should (= assembly-count 1)) + (should + (seq-some (lambda (candidate) + (equal candidate suffix)) + (ekp-tests--strings-in-tree + (ekp-layout-plan-context again)))))))))) + +(ert-deftest ekp-test-policy-analysis-cache-key-owns-policy-strings () + "Policy-analysis cache keys must own mutable public policy strings." + (ekp-tests--with-clean-state + (let* ((ekp-use-c-module nil) + (suffix (copy-sequence "uX")) + (line-start-extra (copy-sequence "《")) + (ekp-number-unit-suffixes (list suffix)) + (ekp-token-break-policies '((number-unit . no-break))) + (ekp-kinsoku-profile 'custom) + (ekp-cjk-no-line-start-extra line-start-extra) + (text (copy-sequence "100uX alpha beta gamma delta")) + (width 16) + cache-key first-plan) + (setq first-plan (ekp-layout-plan text width)) + (should + (seq-some + (lambda (interval) + (and (eq (ekp--policy-interval-category interval) 'number-unit) + (eq (ekp--policy-interval-break-policy interval) 'no-break))) + (ekp-para-resolved-policies (ekp-layout-plan-para first-plan)))) + (maphash (lambda (key _value) + (setq cache-key key)) + ekp--policy-analysis-cache) + (should cache-key) + (should (seq-some (lambda (string) (equal string "uX")) + (ekp-tests--strings-in-tree cache-key))) + (should (seq-some (lambda (string) (equal string "《")) + (ekp-tests--strings-in-tree cache-key))) + (store-substring suffix 1 "Y") + (store-substring line-start-extra 0 "》") + (should (seq-some (lambda (string) (equal string "uX")) + (ekp-tests--strings-in-tree cache-key))) + (should (seq-some (lambda (string) (equal string "《")) + (ekp-tests--strings-in-tree cache-key))) + (let ((changed-plan (ekp-layout-plan text width))) + (should-not + (seq-some + (lambda (interval) + (and (eq (ekp--policy-interval-category interval) 'number-unit) + (eq (ekp--policy-interval-break-policy interval) 'no-break))) + (ekp-para-resolved-policies + (ekp-layout-plan-para changed-plan)))))))) + (ert-deftest ekp-test-global-width-cache-consistent () "The global width cache returns exactly `string-pixel-width'." (ekp-clear-caches)