From 112b3a0e5246fd3a04e33d67a26052e5a206ecd0 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sun, 26 Jul 2026 18:43:45 +0800 Subject: [PATCH] =?UTF-8?q?refactor!:=20overhaul=20KP=20core=20=E2=80=94?= =?UTF-8?q?=20correctness,=20C=20parity,=20performance,=20tests,=20docs?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - fix: ekp-param-set silently reset after first justify (now persists; ekp-param-reset added) - fix: narrow-width CJK returned empty string (data loss); two-pass emergency-break strategy guarantees output for any input - fix: K-P penalties never synced to C module; space-box metrics divergence between C and Elisp engines - fix: para cache ignored ekp-latin-lang (stale hyphenation after language switch) and used collision-prone sxhash keys - fix: fullwidth letters/digits misclassified as CJK punctuation - fix: combining chars split from their base char in the tokenizer - fix: punctuation-wrapped words (word!/(word)/word;) never hyphenated - fix: renderer double-counted stripped space widths; negative glue clamped; batch/tty font detection no longer crashes - feat: real looseness support via (position × line-count) DP - perf: O(1) line metrics and gap counts via prefix arrays (inner loop previously allocated O(n) subsequences → O(n³) total); box measurement dedupe; eq fast-path para lookup; prebuilt per-para glue arrays → zh justify 7547ms → 96ms (compiled elisp) / 57ms (C); range-justify 68.5s → 0.48s / 34ms; C module itself 3–19× faster - test: 36 batch-safe ERT tests + 300-case property fuzz (C/elisp byte-identical output, zero content loss) replacing ad-hoc suite - docs: readme/readme_zh/DEVELOPER/DEVELOPER_ZH/ekp_c-README rewritten to match the implementation; phase handoff in .phrase/phases/ BREAKING: requires Emacs 29.1+; C module must be rebuilt (v1.1, new arities); ekp-threshold-factor / ekp-flagged-penalty / ekp-forced-break-penalty removed; Rust module stubs removed. Co-Authored-By: Claude Fable 5 --- .../phase-kp-overhaul-20260726/HANDOFF.md | 185 ++ DEVELOPER.md | 326 +++- DEVELOPER_ZH.md | 297 ++- ekp-hyphen.el | 6 +- ekp-utils.el | 160 +- ekp.el | 1681 +++++++++-------- ekp_c/README.md | 159 +- ekp_c/ekp.c | 75 +- ekp_c/ekp_kp.c | 245 ++- ekp_c/ekp_module.h | 14 +- readme.md | 201 +- readme_zh.md | 179 +- tests/ekp-bench.el | 80 + tests/ekp-demo.el | 112 ++ tests/ekp-fuzz.el | 71 + tests/ekp-tests.el | 756 +++++--- tests/run-tests.sh | 10 + 17 files changed, 2875 insertions(+), 1682 deletions(-) create mode 100644 .phrase/phases/phase-kp-overhaul-20260726/HANDOFF.md create mode 100644 tests/ekp-bench.el create mode 100644 tests/ekp-demo.el create mode 100644 tests/ekp-fuzz.el create mode 100755 tests/run-tests.sh diff --git a/.phrase/phases/phase-kp-overhaul-20260726/HANDOFF.md b/.phrase/phases/phase-kp-overhaul-20260726/HANDOFF.md new file mode 100644 index 0000000..e9e04c2 --- /dev/null +++ b/.phrase/phases/phase-kp-overhaul-20260726/HANDOFF.md @@ -0,0 +1,185 @@ +# KP 算法系统性优化 — 进度交接文档 + +> 阶段:phase-kp-overhaul-20260726 +> 状态:**已完成并提交**——分支 `kp-overhaul`(基于 main@11437cb), +> 合并到 main:`git checkout main && git merge kp-overhaul` +> 审查状态:自查 + 300 例随机性质测试已完成(0 失败);多智能体 workflow 审查仍可选(见"未完成事项") +> 本文档面向下一次会话/贡献者,保证无缝衔接。 + +## 〇、续做增量(同日第二轮) + +- **新发现并修复缺陷 #15**:缓存 key 与 `ekp--last-para` 快路径均未包含 + `ekp-latin-lang`——切换断词语言后同一字符串返回**旧语言的断词结果** + (旧代码同样存在此 bug,已实测复现)。修复:key 与快路径都纳入语言; + 新增回归测试 `ekp-test-para-cache-tracks-language`。测试总数 35 → **36**, + 全部通过;byte-compile 仍零警告。 +- **300 例随机性质测试通过(0 失败)**:随机中西混排/CJK 标点/ZWSP/双空格/ + 超长词 × 随机宽度 1–300px,断言 ① C 与 elisp 输出逐字节一致 ② 内容零丢失 + ③ 代价有限 ④ 不报错。脚本已固化为 tests/ekp-fuzz.el(确定性 LCG 种子 42,可复现; + 需 C 模块,单独运行:emacs -Q --batch -L . -l tests/ekp-fuzz.el)。 + +## 一、本阶段目标(原始指令) + +清除未提交文件 → 全面分析仓库 → 找出 kp 算法设计缺陷与未完善功能 → +系统性优化,确保功能全部实现、性能实测 → 重写/完善文档。 + +## 二、提交内容 + +以下改动已在 `kp-overhaul` 分支提交(refactor! 单提交,含本文档): + +``` +M ekp.el # 核心重写:DP、缓存、参数、渲染、C 桥接 +M ekp-utils.el # 字体检测 batch 回退、全角/组合字符修复、删 Rust 死代码 +M ekp-hyphen.el # 仅 docstring 修正 +M ekp_c/ekp_kp.c # 两遍紧急策略、badness 封顶、空格数组、参数化 penalties +M ekp_c/ekp.c # API v1.1:break-with-arrays 11 参、set-penalties 4-6 参 +M ekp_c/ekp_module.h # 版本 1.1、结构体新字段 +M tests/ekp-tests.el # 全新 ERT 套件(36 个测试) +A tests/ekp-bench.el # 基准脚本 +A tests/ekp-demo.el # 交互式 demo(从旧 tests 迁移) +A tests/run-tests.sh # 一键跑测试 +A tests/ekp-fuzz.el # 300 例随机性质测试(需 C 模块,单独运行) +M readme.md / readme_zh.md / DEVELOPER.md / DEVELOPER_ZH.md / ekp_c/README.md +``` + +`ekp_c/ekp.dylib` 已用新源码重新编译(版本 1.1,gitignore 忽略编译产物)。 +会话开始时已按指令 `git clean -fd` 清除了全部 Syncthing sync-conflict 垃圾文件。 + +**建议提交信息**(Conventional Commits,单提交或按 fix/perf/test/docs 拆分): + +``` +refactor!: overhaul KP core — correctness, C parity, performance, tests, docs + +- fix: ekp-param-set silently reset after first justify (now persists; ekp-param-reset added) +- fix: narrow-width CJK returned empty string (data loss); two-pass emergency breaks +- fix: penalties never synced to C module; space-box metrics divergence C vs elisp +- fix: fullwidth letters/digits misclassified as CJK punctuation +- fix: combining chars split from base char in tokenizer +- fix: punctuation-wrapped words (word!/(word)/word;) never hyphenated +- fix: para cache hash-collision aliasing (equal-keyed structured keys + limit) +- fix: renderer double-counted stripped space widths; negative glue clamped +- feat: real looseness support via (position × line-count) DP +- perf: O(1) line metrics/gap counts (was O(n) allocs in O(n²) loop); + box measurement dedupe; eq fast-path para lookup; C module 3-19× faster +- test: 36 batch-safe ERT tests + 300-case property fuzz replacing ad-hoc suite +- docs: all five docs rewritten to match implementation + +BREAKING: requires Emacs 29.1+; C module must be rebuilt (v1.1, arity changes); +ekp-threshold-factor / ekp-flagged-penalty / ekp-forced-break-penalty removed; +Rust module stubs removed. +``` + +## 三、已完成工作(按类别) + +### 1. 实测确认并修复的正确性缺陷(elisp) + +| # | 缺陷 | 修复 | +|---|------|------| +| 1 | `ekp-param-set` 一次性失效:第二次排版起用户参数被静默重置 | 显式参数持久化(`ekp--params-explicit`),新增 `ekp-param-reset`;auto 模式按字符串派生 | +| 2 | 超窄宽度 CJK 整段返回空串(数据丢失);超长不可断词产生负宽 glue | 两遍 DP:严格遍 + 紧急单盒断行遍(仅在段尾不可达时);glue 钳制 ≥0 | +| 3 | `flagged-positions` 死代码(从未填充)、`ekp-threshold-factor` 剪枝语义可疑 | 连同 `ekp-flagged-penalty`/`ekp-forced-break-penalty` 一并删除 | +| 4 | para 缓存用 sxhash 整数 key,碰撞会串段 | `equal` 结构化 key(内容+属性区间+字体+参数或 `auto`)+ `ekp-para-cache-limit`(256) | +| 5 | 全角字母/数字(ＡＢＣ１２３)被当标点附着到前字 | `ekp-cjk-fw-punct-p` 排除 FF10-19/FF21-3A/FF41-5A | +| 6 | 组合字符(café NFD)被当空格拆成独立 box | 零宽附着类(Mn/Mc/Me、ZWJ/ZWNJ、变体选择符)并入前文;ZWSP 仍作断点 | +| 7 | `word!`、`(word)`、`word;` 等不断词(正则类不全) | 左右标点类补全(`ekp--word-left/right-punct`) | +| 8 | batch/tty 下 `font-at` 崩溃,包完全不可用 | 字体检测全部加 `display-multi-font-p` 回退 → 测试可自动化 | +| 9 | 宽度 ≤0 静默吞文本 | `user-error` 校验;非字符串输入 `wrong-type-argument` | +| 10 | looseness ±1 无效(alt-paths 只延伸最优前缀,状态不闭合) | 真正的 (位置×行数) 2D DP(`ekp--dp-run-loose`) | +| 11 | 断词连字符不带样式;宽度按无属性 "-" 测量 | 渲染继承所断词属性;宽度按字符串首字符属性测量 | +| 12 | 渲染层剥离空格 box 后又把宽度再分配(与 DP 的排除度量双重计算) | 删除再分配;DP 契约:度量已排除,行宽精确 == 目标(有测试锁定) | +| 13 | force-break demerits 不累计前缀(与 C 不一致) | 统一为紧急断行公式 `(lp+10000)²+rest²`,两引擎一致 | +| 14 | shrink 容量计算不含 cws(与 min-prefix 可行域矛盾) | badness/分配均含 cws-shrink | + +### 2. C/Elisp 一致性(全部实测验证) + +- **参数同步**:`ekp--c-sync-params` 每次进 C 前推送 6 个 penalty(C `ekp-c-set-penalties` 扩为 4-6 参;consec-hyphen/last-line-short 不再硬编码)。 +- **badness 封顶**:C 侧超 10000 曾变 `EKP_INFINITY`(断点被丢),现与 elisp 一致封顶 10000。 +- **空格 box 度量**:新增 `lead-spaces`/`trail-spaces` 数组(n+1)传给 C;`ekp-c-break-with-arrays` 9→11 参,batch 向量 9→11 元素。 +- **两遍紧急策略**:C 与 elisp 完全相同(严格遍 → 不可达时紧急遍)。 +- **版本门禁**:模块版本 1.1;`ekp-c-module-load` 拒绝旧模块并回落 elisp(`ekp-c-module-required-version`)。 +- **looseness ≠ 0 时自动绕过 C**(`ekp--c-available-p`)。 +- **验证结果**:6 个测试文件 × 5 宽度 = 30/30 输出逐字节一致;penalty 极值下同样一致。 + +### 3. 性能(实测,batch Emacs 30.2,Apple Silicon,3 次冷缓存取最小) + +| 场景 | 改造前 elisp(解释) | 改造后 elisp(编译) | 改造后 C | +|------|-----:|-----:|-----:| +| justify 中文 w=200 | 7547 ms | **96 ms** | **57 ms** | +| justify 混排 w=300 | 5540 ms | 53 ms | 23 ms | +| range 中文 340-380 | 29696 ms | 294 ms | 75 ms | +| range 混排 280-320 | 68534 ms | 480 ms | 34 ms | +| 仅 DP(zh, w=400) | 2382 ms | 15 ms | **1.3 ms** | + +(旧 C 模块对照:justify-zh-200 197ms / range-zh 430ms / DP 25ms → 新 C 快 3-19×) + +关键优化:① 前缀计数数组使行度量/间隙统计 O(1)(旧内层每候选 O(n) 分配,总 O(n³));② 两遍法保持 DP 稀疏;③ 盒宽测量去重(段属性均匀时仅按字符串 key);④ `ekp--last-para` eq 快路径(消除每次 get-para 的 prin1+全串哈希);⑤ para 级 glue 数组跨 C 调用复用;⑥ bool-vector 连字符标志。 + +基线/复现脚本:`tests/ekp-bench.el`(改造前基线数字已录入 DEVELOPER*.md §9)。 + +### 4. 测试(tests/ekp-tests.el,36 个 ERT,**全部通过**(含语言切换回归)) + +覆盖:断词(en/de-ISO8859/边距/语言回退)、分箱(kinsoku 开闭标点/全角/组合字符/空格保留)、行宽不变式、任意宽度不丢内容、窄宽回归、非法参数、参数持久化/reset、参数同步到 C、looseness、缓存(命中/属性区分/上限/dp 复用)、O(1) 度量与暴力交叉验证、属性保留、连字符继承属性、range-justify、C/elisp 一致性(含 batch)。C 模块未编译时相关测试自动 skip。 + +运行:`tests/run-tests.sh /Applications/Emacs.app/Contents/MacOS/Emacs` + +### 5. 文档(全部重写,与实现逐条对齐) + +readme.md / readme_zh.md(用户指南 + 真实性能表 + 已知限制)、 +DEVELOPER.md / DEVELOPER_ZH.md(五阶段管线、数据结构、demerits 公式与 +TeX 差异、两遍策略、C 集成、基准方法学)、ekp_c/README.md(修正了 +"wavefront 并行"“zero copy" 等与实现不符的旧说法;明确 `ekp-c-break-lines` +为实验路径)。**Package-Requires 已改为 Emacs 29.1**(string-pixel-width +/ object-intervals 实际要求;旧标注 27.1 不真实)。 + +### 6. 死代码清理 + +ekp-utils.el 的 Rust 模块支持(ekp_rust 目录不存在)已删除; +process 回调的 eval 式 lambda 改为词法闭包;byte-compile 零警告。 + +## 四、未完成事项(下次会话优先处理) + +1. **多智能体对抗审查(可选)**:因会话限额(21:50 Asia/Shanghai 重置) + 未能以 workflow 形式执行;已用两项替代手段覆盖主要风险: + ① 针对脚本 prompt 中列出的重点自查项逐项人工核查——eq 快路径过期 + (发现并修复了语言维度的真实 bug,见"续做增量")、C 空格数组索引 + (lead/trail 均 n+1 元素,i0)/行尾空格串 + (lead/trail-spaces 数组),渲染剥离同一批 box 且**不再**补偿宽度。 +3. **紧急断行只在第二遍**:存在合法排版时结果必须是纯 K-P 最优。 +4. **`ekp--last-para` 失效点**:任何影响 para 内容的全局状态变化 + (参数 apply/reset、clear-caches)都必须置 nil。 +5. C 模块 API 变化必须递增 `EKP_VERSION_MINOR` 并同步 + `ekp-c-module-required-version`。 diff --git a/DEVELOPER.md b/DEVELOPER.md index b2b6c95..513776c 100644 --- a/DEVELOPER.md +++ b/DEVELOPER.md @@ -1,137 +1,253 @@ # Developer Documentation for Emacs-KP -This document details the internal architecture, API, and algorithms of `emacs-kp`. It is intended for contributors and advanced users who want to understand how the package works or extend it. +This document describes the internal architecture, algorithms and APIs of +`emacs-kp`, as implemented. It is intended for contributors and advanced +users. -## 1. Architecture Overview +## 1. Pipeline Overview -`emacs-kp` follows a layered architecture to separate text processing, layout computation, and rendering. +A justification call flows through five stages: ``` -┌─────────────────────────────────────────────────────────────────┐ -│ User API Layer (ekp.el) │ -│ ekp-pixel-justify ekp-pixel-range-justify ekp-clear-caches │ -└─────────────────────────────────────────────────────────────────┘ - │ - ▼ -┌─────────────────────────────────────────────────────────────────┐ -│ Caching Layer (ekp-utils.el) │ -│ ekp--get-para (paragraph cache) ekp-dp-cache (DP result cache)│ -└─────────────────────────────────────────────────────────────────┘ - │ - ┌───────────────┴───────────────┐ - ▼ ▼ -┌─────────────────────────┐ ┌─────────────────────────┐ -│ Pure Elisp Path │ │ C Module Path │ -│ ekp--dp-cache-elisp │ │ ekp--dp-cache-via-c │ -│ (O(n²) DP in Elisp) │ │ (calls C for DP) │ -└─────────────────────────┘ └─────────────────────────┘ - │ - ▼ - ┌─────────────────────────┐ - │ C Dynamic Module │ - │ ekp_break_with_prefixes│ - │ (8-thread parallel) │ - └─────────────────────────┘ - │ - ▼ -┌─────────────────────────────────────────────────────────────────┐ -│ Rendering Layer │ -│ ekp--render-justified (apply breaks, insert glue pixels) │ -└─────────────────────────────────────────────────────────────────┘ + string + │ + ▼ + ① Tokenize ekp-split-to-boxes (ekp-utils.el) + │ Latin words / CJK chars / space runs → boxes, + │ kinsoku attachment of CJK punctuation + ▼ + ② Hyphenate ekp--split-with-hyphen (ekp.el + ekp-hyphen.el) + │ Latin word boxes → syllable boxes (Liang patterns) + ▼ + ③ Measure & index ekp--make-para (ekp.el) + │ pixel widths, glue types, prefix-sum arrays + │ → cached `ekp-para` struct + ▼ + ④ Break (DP) ekp--dp-run-1d / C module (ekp.el / ekp_c/) + │ Knuth-Plass dynamic program → break positions + ▼ + ⑤ Render ekp-line-glues, ekp--pixel-justify + distribute glue pixels, strip edge space boxes, + attach hyphens → lines joined with "\n" ``` -## 2. Elisp Core (ekp.el) +`ekp-pixel-justify` splits its input on `"\n"` and runs each non-blank +segment through this pipeline as an independent paragraph (in parallel +via the C batch API when available). -### Data Structures +## 2. Data Structures -#### `ekp-para` Struct +### `ekp-para` (the paragraph cache entry) -The central data structure is `ekp-para`, which represents a preprocessed paragraph. It is cached to avoid re-tokenizing and re-measuring text. +Everything the DP and renderer need, computed once per paragraph: -```elisp -(cl-defstruct ekp-para - string ; Original text with properties - latin-font ; Detected Latin font - cjk-font ; Detected CJK font - boxes ; Vector of box strings - boxes-widths ; Vector of box pixel widths - boxes-types ; Vector of (start-type . end-type) - glues-types ; Vector of glue type symbols (lws, mws, cws, nws) - hyphen-pixel ; Width of hyphen character - hyphen-positions ; Vector of hyphenable box indices - ideal-prefixs ; Prefix sum: ideal widths (for O(1) width calc) - min-prefixs ; Prefix sum: minimum widths - max-prefixs ; Prefix sum: maximum widths - dp-cache) ; Hash table: line-pixel → DP result +| Field | Contents | +|:------|:---------| +| `string`, `latin-font`, `cjk-font` | source text and detected fonts | +| `boxes` | vector of box strings | +| `boxes-widths` | pixel width per box (measured with deduplication) | +| `boxes-types` | `(START-TYPE . END-TYPE)` per box: `latin`/`cjk`/`cjk-punct`/`space` | +| `glues-types` | glue class *before* each box: `lws`/`mws`/`cws`/`nws` | +| `hyphen-pixel`, `hyphen-positions` | hyphen width; sorted vector of box indices after which a hyphen may be inserted | +| `ideal/min/max-prefixs` | prefix sums of box+glue widths at ideal / max-shrunk / max-stretched (n+1 elements) | +| `glue-ideals/shrinks/stretches` | leading-glue values per box index (n elements) — also passed verbatim to C | +| `lws/mws/cws-prefixs` | prefix **counts** of each stretchable glue class → O(1) gap counting per candidate line | +| `lead-spaces` | `lead-spaces[i]` = width of the space-box run starting at box i; index 0 forced to 0 (first-line indentation is kept) | +| `trail-spaces` | `trail-spaces[k]` = width of the space-box run ending at box k−1 | +| `glue-params` | plist snapshot of the nine spacing values at creation time | +| `dp-cache` | hash: line-width → dp-result plist | + +The paragraph cache (`ekp--para-cache`) is keyed with `equal` on a +structured key — string content, printed text-property intervals, +detected fonts, the hyphenation language (`ekp-latin-lang`), and +either the nine explicit spacing values or the symbol `auto`. +Structured keys make hash collisions harmless (they were possible with +the previous `sxhash`-integer scheme). The cache is flushed when it +exceeds `ekp-para-cache-limit`. A one-entry fast path +(`ekp--last-para`, checked by string `eq` + language) covers the many +same-string lookups inside one justification call. + +### dp-result + +`(:rests R :gaps G :breaks B :cost C :line-count N)` where `breaks` are +exclusive end indices per line, `rests[i]` = line-width − line-ideal +(the pixels the glue must absorb), `gaps[i]` = `(lws-count mws-count +cws-count)` for glue distribution (nil for single-box and last lines). + +## 3. Line Metrics + +For a candidate line spanning boxes `[i, k)`: + +``` +raw = prefix[k] − prefix[i] − leading-glue(i) +space-w = min(raw, lead-spaces[i] + trail-spaces[k]) +width = raw − space-w (+ hyphen-pixel if box k−1 hyphenates) ``` -#### Glue Types -- `lws`: Latin Word Space (between Latin words) -- `mws`: Mixed Word Space (between Latin and CJK) -- `cws`: CJK Word Space (between CJK chars) -- `nws`: No Word Space (fixed) +computed for ideal, min and max in O(1). Space-box runs at the line +edges are excluded because the renderer strips them; the DP and the +renderer therefore agree exactly, and every justified line renders at +precisely the target width (`ekp-test-justify-line-width-invariant`). -### Core Functions +## 4. The Knuth-Plass DP -#### `(ekp-pixel-justify STRING LINE-PIXEL)` -Justifies `STRING` to `LINE-PIXEL` width. -1. Checks cache for existing `ekp-para`. -2. If miss, creates `ekp-para` (tokenize, measure, hyphenate). -3. Calls DP engine (Elisp or C) to get breaks. -4. Renders result using display properties (specifically `space` display property for glues). +`ekp--dp-run-1d` relaxes positions left to right. For each reachable +start `i` it scans end positions `k` until the line's minimum width +exceeds the target. A break at `k` is valid when +`min ≤ target ≤ max`, or for the last line when `ideal ≤ target`. -#### `(ekp-pixel-range-justify STRING MIN-PIXEL MAX-PIXEL)` -Finds the "best" width within a range. Uses ternary search (O(log n)) to minimize demerits. Useful for finding the optimal width for a specific paragraph. +**Demerits** (per line, matching `ekp_c/ekp_kp.c` exactly): -#### `(ekp-param-set ...)` -Sets the 9 spacing parameters (Ideal/Stretch/Shrink for LWS/MWS/CWS). +``` +demerits = (line-penalty + badness)² + + penalty² ; hyphen-penalty at hyphen breaks + + adjacent-fitness-penalty ; if |fitness − prev-fitness| > 1 + + consecutive-hyphen-penalty × run² +badness = min(10000, 100·|adjustment/flexibility|³) +``` -## 3. C Dynamic Module (ekp_c) +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`. -For large texts, the C module provides ~20x speedup by parallelizing the O(n²) Dynamic Programming phase. +Deviations from the 1981 paper, by design: penalties are always added +as `+p²` (no negative/flagged penalties), there is no `q`/looseness in +the main pass (see §6), and adjacent-fitness is a flat constant. -### Source Structure -- `ekp_c/ekp.c`: Emacs module entry point. -- `ekp_c/ekp_kp.c`: The Knuth-Plass algorithm implementation. -- `ekp_c/ekp_thread_pool.c`: Worker thread pool. -- `ekp_c/ekp_hyphen.c`: Liang's hyphenation algorithm. +### Two-pass emergency strategy -### C API (exposed to Elisp) +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. -#### `(ekp-c-init)` -Initializes the module and thread pool. +## 5. Rendering -#### `(ekp-c-break-with-prefixes ...)` -The low-level DP function. It takes flat arrays (pointers) from Elisp: -- Prefix sums (ideal, min, max) -- Glue parameters per box -- Hyphen positions -- Target line width +`ekp-line-glues` turns each line's `rest` into per-glue pixel values: -It returns a list of break indices and total cost. +- rest > 0 → stretch, distributed latin → mixed → CJK; CJK gaps absorb + any leftover beyond nominal capacity (emergency spreading). +- rest < 0 → shrink, same priority order, never below the per-class + shrink limit; glue widths are clamped at ≥ 0. +- Last lines are ragged-right (ideal glues + trailing filler); + single-box lines get a trailing filler clamped at ≥ 0. -### Memory Model -- **Zero Copy**: Elisp passes pointers to vector data directly to C. -- **Flat Arrays**: Data is structured as parallel arrays for cache efficiency. -- **Thread Safety**: The module uses a fixed thread pool. The DP algorithm uses a wavefront pattern for parallelizing the inner loop. +`ekp--pixel-justify` then strips leading space boxes (except on the +first line — indentation) and trailing space boxes, and appends a +hyphen — propertized like the word it breaks — where a line ends at a +hyphenation point. Stripped widths are *not* redistributed: the DP +already excluded them (§3). -## 4. Algorithm Details +Glues become `(space :width (N))` display properties, so justification +is pixel-exact in GUI Emacs and column-exact in batch/tty. -### The Knuth-Plass Algorithm -Based on the 1981 paper "Breaking Paragraphs into Lines". +## 6. Looseness -**Cost Function (Demerits):** -`D = (LinePenalty + Badness)² + Penalty²` +`ekp-looseness` ≠ 0 switches to `ekp--dp-run-loose`, a full +(position × line-count) DP that keeps the best path *per line count*, +then picks the final count closest to (optimal + looseness), breaking +ties by demerits. This is heavier than the 1D pass and is Elisp-only; +`ekp--c-available-p` returns nil while looseness is active so both +engines never disagree. -**Badness:** -`100 * |Adjustment / Flexibility|³` +## 7. C Module Integration -### CJK Extensions -- **Boxes**: Each CJK character is a separate box. -- **Glues**: Specific glue types for CJK-CJK and CJK-Latin transitions allow fine-tuning spacing (e.g., adding slight breathing room between English and Chinese). +The C module (`ekp_c/`, version 1.1) runs only stage ④. Elisp remains +the source of truth for all font-dependent data. -### Hyphenation -Uses Frank Liang's algorithm (standard in TeX). -- Patterns are loaded from `dictionaries/*.dic`. -- `ekp-hyphen.el` handles this in pure Elisp. -- C module has its own implementation (`ekp_hyphen.c`) for speed if needed, though currently Elisp handles tokenization. +- `ekp-c-break-with-arrays` (11 args): the para's prefix arrays, glue + arrays, hyphen data, line width and the two space-run arrays. + Returns `(breaks . cost)`. +- `ekp-c-break-batch`: a vector of 11-element vectors, processed in + parallel by a pthread pool — one task per paragraph (that is the + correct granularity; the DP itself is sequential by nature). +- `ekp-c-set-penalties` (4–6 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. + +Any C failure (NULL result) silently falls back to the Elisp engine. +The two engines are verified to produce byte-identical output by +`ekp-test-c-parity-simple` / `ekp-test-c-parity-files`. + +`ekp-c-break-lines` (C-side tokenization via `ekp_paragraph.c` and +`ekp_hyphen.c`) is an experimental, self-contained path that ekp.el +does not use; see `ekp_c/README.md`. + +## 8. Hyphenation (ekp-hyphen.el) + +Liang's pattern algorithm, Pyphen-compatible: + +- `dictionaries/hyph_*.dic` are compiled to a pattern hash on first + use and cached per path. Files may be UTF-8 or ISO-8859 (Emacs + auto-detects; verified by `ekp-test-hyphen-de-iso8859-dict`). +- `ekp-hyphen-create LANG` resolves exact codes, then progressively + shorter prefixes (`"de_CH" → "de"`). +- Margins default to 2 characters on each side of a break. + +Word boxes are matched against +`^[left-punct]* (latin-word) [right-punct]*$` so that punctuation- +wrapped words (`(word)`, `word!`, `»word«`) still hyphenate; the +punctuation stays glued to the first/last syllable box. + +## 9. Testing & Benchmarks + +```bash +tests/run-tests.sh [emacs] # 36 ERT tests, batch-safe +emacs -Q --batch -L . --eval '(setq ekp-use-c-module nil)' -l tests/ekp-bench.el +emacs -Q --batch -L . --eval '(progn (require (quote ekp)) (ekp-c-module-load))' \ + -l tests/ekp-bench.el +``` + +Key invariants under test: rendered line width == target (pixel-exact +justification), no content loss at any width, brute-force cross-checks +of the O(1) prefix machinery, Elisp/C parity on the bundled texts, and +parameter persistence/sync regressions. + +Benchmark results (batch Emacs 30.2, Apple Silicon M-series, +`tests/text-zh.txt` ≈ 3.6 KB Chinese + samples; min of 3 cold-cache +runs) — before is the pre-rewrite implementation, interpreted: + +| Case | Before (Elisp) | After (Elisp, interpreted) | After (Elisp, compiled) | After (C) | +|:-------------------------|---------------:|---------------------------:|------------------------:|----------:| +| justify zh w=200 | 7547 ms | 1780 ms | 96 ms | 57 ms | +| justify zh w=400 | 2928 ms | 815 ms | 71 ms | 57 ms | +| justify mixed w=300 | 5540 ms | 1275 ms | 53 ms | 23 ms | +| range-justify zh 340–380 | 29696 ms | 8937 ms | 294 ms | 75 ms | +| range-justify mix 280–320| 68534 ms | 14552 ms | 480 ms | 34 ms | +| DP only, zh w=400 | 2382 ms | 591 ms | 15 ms | 1.3 ms | + +("After (C)" columns measured with byte-compiled Elisp around the C +calls. For reference, the pre-rewrite C module measured 197 ms / +430 ms / 25 ms on justify-zh-200 / range-zh / DP-only — the rewrite +also sped up the C path 3–19× via prebuilt per-para glue arrays, an +`eq' fast path in the para cache, and O(1) rest/gap reconstruction.) + +The dominant wins: O(1) line metrics via prefix arrays (the old inner +loop allocated O(n) subsequences per candidate, O(n³) total), the +two-pass emergency strategy (keeps the DP sparse), box-measurement +deduplication, and per-para glue arrays reused across C calls. + +## 10. File Map + +``` +ekp.el Core: para struct, caching, DP (1D + looseness), + glue distribution, rendering, public API +ekp-utils.el Tokenizer (boxes, kinsoku), font detection with + batch/tty fallbacks, C module loading +ekp-hyphen.el Liang hyphenation + dictionary registry +ekp_c/ C dynamic module (see ekp_c/README.md) +dictionaries/ Hunspell hyphenation patterns (from Pyphen) +tests/ ekp-tests.el (ERT), ekp-bench.el, ekp-demo.el, + sample texts, run-tests.sh +archive/ Historical prototypes; not loaded, kept for reference +``` diff --git a/DEVELOPER_ZH.md b/DEVELOPER_ZH.md index d61dade..0d25420 100644 --- a/DEVELOPER_ZH.md +++ b/DEVELOPER_ZH.md @@ -1,137 +1,224 @@ # Emacs-KP 开发者文档 -本文档详细介绍了 `emacs-kp` 的内部架构、API 和算法原理。旨在帮助贡献者和高级用户理解其工作机制。 +本文档描述 `emacs-kp` 的实际内部架构、算法与 API,面向贡献者和高级用户。 -## 1. 架构概览 +## 1. 处理管线 -`emacs-kp` 采用分层架构，将文本处理、布局计算和渲染分离。 +一次排版调用经过五个阶段: ``` -┌─────────────────────────────────────────────────────────────────┐ -│ 用户 API 层 (ekp.el) │ -│ ekp-pixel-justify ekp-pixel-range-justify ekp-clear-caches │ -└─────────────────────────────────────────────────────────────────┘ - │ - ▼ -┌─────────────────────────────────────────────────────────────────┐ -│ 缓存层 (ekp-utils.el) │ -│ ekp--get-para (段落缓存) ekp-dp-cache (DP 结果缓存) │ -└─────────────────────────────────────────────────────────────────┘ - │ - ┌───────────────┴───────────────┐ - ▼ ▼ -┌─────────────────────────┐ ┌─────────────────────────┐ -│ 纯 Elisp 路径 │ │ C 模块路径 │ -│ ekp--dp-cache-elisp │ │ ekp--dp-cache-via-c │ -│ (Elisp 实现 O(n²) DP) │ │ (调用 C 进行 DP) │ -└─────────────────────────┘ └─────────────────────────┘ - │ - ▼ - ┌─────────────────────────┐ - │ C 动态模块 │ - │ ekp_break_with_prefixes│ - │ (8 线程并行计算) │ - └─────────────────────────┘ - │ - ▼ -┌─────────────────────────────────────────────────────────────────┐ -│ 渲染层 │ -│ ekp--render-justified (应用断点，插入 display 属性胶水) │ -└─────────────────────────────────────────────────────────────────┘ + 字符串 + │ + ▼ + ① 分词 ekp-split-to-boxes (ekp-utils.el) + │ 拉丁词 / CJK 单字 / 空格串 → 盒子(box); + │ CJK 标点按避头尾规则附着 + ▼ + ② 断词 ekp--split-with-hyphen (ekp.el + ekp-hyphen.el) + │ 拉丁词盒子 → 音节盒子(Liang 模式) + ▼ + ③ 测量与索引 ekp--make-para (ekp.el) + │ 像素宽度、glue 类型、前缀和数组 + │ → 缓存为 `ekp-para` 结构 + ▼ + ④ 断行(DP) ekp--dp-run-1d / C 模块 (ekp.el / ekp_c/) + │ Knuth-Plass 动态规划 → 断点序列 + ▼ + ⑤ 渲染 ekp-line-glues, ekp--pixel-justify + 分配 glue 像素、剥离行首尾空格盒、附加连字符 + → 以 "\n" 连接的行 ``` -## 2. Elisp 核心 (ekp.el) +`ekp-pixel-justify` 按 `"\n"` 拆分输入,每个非空段独立走这条管线 +(C 模块可用时通过 batch API 并行处理)。 -### 数据结构 +## 2. 数据结构 -#### `ekp-para` 结构体 +### `ekp-para`(段落缓存条目) -核心数据结构是 `ekp-para`，代表预处理后的段落。它被缓存以避免重复分词和测量。 +DP 和渲染需要的一切,每段只算一次: -```elisp -(cl-defstruct ekp-para - string ; 带有属性的原始文本 - latin-font ; 检测到的拉丁字体 - cjk-font ; 检测到的 CJK 字体 - boxes ; Box 字符串向量 - boxes-widths ; Box 像素宽度向量 - boxes-types ; 类型向量 (start-type . end-type) - glues-types ; 胶水类型符号向量 (lws, mws, cws, nws) - hyphen-pixel ; 连字符宽度 - hyphen-positions ; 可断词 Box 索引向量 - ideal-prefixs ; 前缀和：理想宽度 (用于 O(1) 宽度计算) - min-prefixs ; 前缀和：最小宽度 - max-prefixs ; 前缀和：最大宽度 - dp-cache) ; 哈希表：行宽像素 → DP 结果 +| 字段 | 内容 | +|:-----|:-----| +| `string`, `latin-font`, `cjk-font` | 原文与检测到的字体 | +| `boxes` | 盒子字符串向量 | +| `boxes-widths` | 每个盒子的像素宽(带去重测量) | +| `boxes-types` | 每盒 `(首类型 . 尾类型)`:`latin`/`cjk`/`cjk-punct`/`space` | +| `glues-types` | 每个盒子*之前*的 glue 类别:`lws`/`mws`/`cws`/`nws` | +| `hyphen-pixel`, `hyphen-positions` | 连字符宽度;可断词盒索引的有序向量 | +| `ideal/min/max-prefixs` | 盒+glue 宽度在理想/最收/最伸状态下的前缀和(n+1 个元素) | +| `glue-ideals/shrinks/stretches` | 按盒索引的前导 glue 值(n 个)——原样传给 C | +| `lws/mws/cws-prefixs` | 各可伸缩 glue 类别的前缀**计数** → 每候选行 O(1) 数间隙 | +| `lead-spaces` | `lead-spaces[i]` = 从盒 i 开始的连续空格盒总宽;下标 0 强制为 0(首行缩进保留) | +| `trail-spaces` | `trail-spaces[k]` = 到盒 k−1 结束的连续空格盒总宽 | +| `glue-params` | 创建时九个间距值的 plist 快照 | +| `dp-cache` | 哈希:行宽 → dp-result plist | + +段落缓存(`ekp--para-cache`)以 `equal` 比较结构化 key——字符串内容、 +文本属性区间的打印形式、检测字体、断词语言(`ekp-latin-lang`)、九个 +显式间距值(或符号 `auto`)。结构化 key 使哈希碰撞无害(旧的 `sxhash` +整数方案理论上可能串段)。超过 `ekp-para-cache-limit` 时整体清空。 +单条快路径(`ekp--last-para`,按字符串 `eq` + 语言校验)覆盖同一次 +排版内的大量同字符串查询。 + +### dp-result + +`(:rests R :gaps G :breaks B :cost C :line-count N)`。`breaks` 为每行 +的排他终点索引;`rests[i]` = 行宽 − 行理想宽(glue 需要吸收的像素); +`gaps[i]` = `(lws数 mws数 cws数)` 用于 glue 分配(单盒行和末行为 nil)。 + +## 3. 行度量 + +候选行覆盖盒子 `[i, k)` 时: + +``` +raw = prefix[k] − prefix[i] − 前导glue(i) +space-w = min(raw, lead-spaces[i] + trail-spaces[k]) +width = raw − space-w (若盒 k−1 处断词,再加连字符宽) ``` -#### 胶水类型 (Glue Types) -- `lws` (Latin Word Space): 拉丁词间距 -- `mws` (Mixed Word Space): 中西文间距 -- `cws` (CJK Word Space): CJK 字符间距 -- `nws` (No Word Space): 固定间距 +理想/最小/最大三个值均 O(1) 得出。行边缘的空格盒串被排除,因为渲染层 +会剥离它们;DP 与渲染层因此严格一致,每一行的渲染宽度精确等于目标宽 +(测试 `ekp-test-justify-line-width-invariant`)。 -### 核心函数 +## 4. Knuth-Plass 动态规划 -#### `(ekp-pixel-justify STRING LINE-PIXEL)` -将 `STRING` 按 `LINE-PIXEL` 宽度对齐。 -1. 检查缓存中是否有对应的 `ekp-para`。 -2. 若未命中，创建 `ekp-para`（分词、测量、断词处理）。 -3. 调用 DP 引擎（Elisp 或 C）计算断点。 -4. 使用 display 属性（特别是 `space` 属性）渲染结果。 +`ekp--dp-run-1d` 从左到右松弛位置。对每个可达起点 `i` 扫描终点 `k`, +直到行的最小宽度超过目标。断点合法条件:`min ≤ 目标 ≤ max`,或末行 +`ideal ≤ 目标`。 -#### `(ekp-pixel-range-justify STRING MIN-PIXEL MAX-PIXEL)` -在范围内寻找“最佳”宽度。使用三分搜索 (O(log n)) 最小化 demerits。用于自动寻找最适合该段落的宽度。 +**Demerits**(每行,与 `ekp_c/ekp_kp.c` 完全一致): -#### `(ekp-param-set ...)` -设置 9 个间距参数（LWS/MWS/CWS 的 Ideal/Stretch/Shrink）。 +``` +demerits = (line-penalty + badness)² + + penalty² ; 断词处为 hyphen-penalty + + adjacent-fitness-penalty ; 当 |fitness − 前行fitness| > 1 + + consecutive-hyphen-penalty × 连续次数² +badness = min(10000, 100·|adjustment/flexibility|³) +``` -## 3. C 动态模块 (ekp_c) +松紧等级(tight/decent/loose/very-loose)沿用 TeX 的比例阈值。特殊情 +况:单盒行 flexibility 固定为 1、fitness 为 decent;末行代价为 +`(line-penalty + 短行badness)²`,填充率低于 `ekp-last-line-min-ratio` +时 `短行badness = last-line-short-penalty × (1 − 填充率)`。 -对于长文本，C 模块通过并行化 O(n²) 动态规划阶段提供约 20 倍的加速。 +与 1981 论文的差异(有意为之):penalty 一律以 `+p²` 计入(无负 +penalty/flagged 断点),主流程无 `q`/looseness(见 §6),相邻松紧惩 +罚为平坦常数。 -### 源码结构 -- `ekp_c/ekp.c`: Emacs 模块入口点。 -- `ekp_c/ekp_kp.c`: Knuth-Plass 算法实现。 -- `ekp_c/ekp_thread_pool.c`: 工作线程池。 -- `ekp_c/ekp_hyphen.c`: Liang 断词算法。 +### 两遍紧急策略 -### C API (暴露给 Elisp) +某些输入不存在合法排版:比行宽更宽的不可断盒子,或无法伸展到目标宽 +的刚性(全 `nws`)区段。先跑严格遍;若段尾不可达,第二遍额外允许 +**紧急断行**——demerits 为 `(line-penalty + 10000)² + rest²` 的单盒行, +不低于任何常规行的代价。由位置归纳可证:任何输入必有输出(回归:窄 +栏 CJK 曾整段返回空串),常规输入不付任何代价、保持纯 K-P 最优。两个 +引擎实现完全相同的策略。 -#### `(ekp-c-init)` -初始化模块和线程池。 +## 5. 渲染 -#### `(ekp-c-break-with-prefixes ...)` -底层 DP 函数。它接收来自 Elisp 的扁平数组（指针）： -- 前缀和数组 (ideal, min, max) -- 每个 Box 的胶水参数 -- 连字符位置 -- 目标行宽 +`ekp-line-glues` 把每行的 `rest` 转成各 glue 的像素值: -返回断点索引列表和总代价。 +- rest > 0 → 拉伸,按 拉丁 → 中西 → CJK 优先级分配;CJK 间隙可吸收超 + 出名义容量的剩余(紧急摊布)。 +- rest < 0 → 收缩,同样的优先级,不低于各类收缩下限;glue 宽度钳制 + ≥ 0。 +- 末行右侧不齐(理想 glue + 尾部填充);单盒行的尾部填充钳制 ≥ 0。 -### 内存模型 -- **零拷贝 (Zero Copy)**: Elisp 直接将向量数据的指针传递给 C。 -- **扁平数组**: 数据结构为并行数组，提高缓存效率。 -- **线程安全**: 模块使用固定线程池。DP 算法采用波前模式 (Wavefront) 并行化内部循环。 +`ekp--pixel-justify` 随后剥离行首空格盒(首行除外——缩进)与行尾空格 +盒,在断词处附加连字符(继承所断单词的文本属性)。剥离的宽度**不再** +重新分配:DP 已经排除了它们(§3)。 -## 4. 算法细节 +Glue 渲染为 `(space :width (N))` display 属性,GUI 下像素级精确, +batch/tty 下按字符列精确。 -### Knuth-Plass 算法 -基于 1981 年论文 "Breaking Paragraphs into Lines"。 +## 6. Looseness -**代价函数 (Demerits):** -`D = (LinePenalty + Badness)² + Penalty²` +`ekp-looseness` ≠ 0 时切换到 `ekp--dp-run-loose`:完整的 +(位置 × 行数)DP,为每个行数保留最优路径,最终选取与 +(最优行数 + looseness)最接近的行数,平局取 demerits 更小者。该路径 +比 1D 重,仅有 Elisp 实现;looseness 激活期间 `ekp--c-available-p` +返回 nil,两引擎永不分歧。 -**劣度 (Badness):** -`100 * |Adjustment / Flexibility|³` +## 7. C 模块集成 -### CJK 扩展 -- **Boxes**: 每个 CJK 字符视为一个独立的 Box。 -- **Glues**: 针对 CJK-CJK 和 CJK-Latin 的特定胶水类型允许精细调整间距（例如在汉字和英文之间增加微小的空隙）。 +C 模块(`ekp_c/`,版本 1.1)只执行阶段 ④。所有字体相关数据以 Elisp +为唯一事实来源。 -### 断词 (Hyphenation) -使用 Frank Liang 算法（TeX 标准）。 -- 模式从 `dictionaries/*.dic` 加载。 -- `ekp-hyphen.el` 在纯 Elisp 中处理。 -- C 模块有自己的实现 (`ekp_hyphen.c`)，目前主要由 Elisp 负责分词。 +- `ekp-c-break-with-arrays`(11 参数):para 的前缀数组、glue 数组、 + 断词数据、行宽和两个空格串数组。返回 `(breaks . cost)`。 +- `ekp-c-break-batch`:11 元素向量的向量,由 pthread 线程池并行处理 + ——每段一个任务(这是正确的并行粒度;DP 本身天然串行)。 +- `ekp-c-set-penalties`(4–6 参数):`ekp--c-sync-params` 在**每次** + 进入 C 之前调用,保证 `ekp-line-penalty` 等变量始终生效(回归:此 + 前从未同步)。 +- `ekp-c-module-load` 拒绝低于 `ekp-c-module-required-version` 的模块 + 并回落到 Elisp,避免升级后的参数数量不匹配。 + +C 端任何失败(返回 NULL)都会静默回落到 Elisp 引擎。两引擎输出逐字 +节一致,由 `ekp-test-c-parity-simple` / `ekp-test-c-parity-files` 验证。 + +`ekp-c-break-lines`(经 `ekp_paragraph.c`、`ekp_hyphen.c` 的 C 端自行 +分词路径)是实验性的独立路径,ekp.el 不使用;见 `ekp_c/README.md`。 + +## 8. 断词(ekp-hyphen.el) + +Liang 模式算法,兼容 Pyphen: + +- `dictionaries/hyph_*.dic` 首次使用时编译为模式哈希并按路径缓存。 + 文件可为 UTF-8 或 ISO-8859(Emacs 自动检测;由 + `ekp-test-hyphen-de-iso8859-dict` 验证)。 +- `ekp-hyphen-create LANG` 先精确匹配,再逐级缩短(`"de_CH" → "de"`)。 +- 断点两侧默认至少保留 2 个字符。 + +词盒按 `^[左标点]* (拉丁词) [右标点]*$` 匹配,因此被标点包裹的词 +(`(word)`、`word!`、`»word«`)仍可断词;标点粘在首/末音节盒上。 + +## 9. 测试与基准 + +```bash +tests/run-tests.sh [emacs] # 36 个 ERT 测试,batch 可跑 +emacs -Q --batch -L . --eval '(setq ekp-use-c-module nil)' -l tests/ekp-bench.el +emacs -Q --batch -L . --eval '(progn (require (quote ekp)) (ekp-c-module-load))' \ + -l tests/ekp-bench.el +``` + +核心被测不变式:渲染行宽 == 目标宽(像素级对齐)、任意宽度下不丢内 +容、O(1) 前缀机制与暴力算法交叉验证、内置文本上的 Elisp/C 一致性、 +参数持久化/同步回归。 + +基准结果(batch Emacs 30.2、Apple Silicon、`tests/text-zh.txt` ≈ +3.6KB 中文及各示例;3 次冷缓存取最小值)——"改造前"为重写前的实现 +(解释执行): + +| 场景 | 改造前 (Elisp) | 改造后 (Elisp 解释) | 改造后 (Elisp 编译) | 改造后 (C) | +|:-----------------------|---------------:|--------------------:|--------------------:|-----------:| +| justify 中文 w=200 | 7547 ms | 1780 ms | 96 ms | 57 ms | +| justify 中文 w=400 | 2928 ms | 815 ms | 71 ms | 57 ms | +| justify 混排 w=300 | 5540 ms | 1275 ms | 53 ms | 23 ms | +| range 中文 340–380 | 29696 ms | 8937 ms | 294 ms | 75 ms | +| range 混排 280–320 | 68534 ms | 14552 ms | 480 ms | 34 ms | +| 仅 DP,中文 w=400 | 2382 ms | 591 ms | 15 ms | 1.3 ms | + +("改造后 (C)" 列在字节编译的 Elisp 环境下测得。作为参照,重写前的 +C 模块在 justify-中文-200 / range-中文 / 仅-DP 上分别为 197 ms / +430 ms / 25 ms——重写通过 para 级预建 glue 数组、para 缓存的 `eq' +快路径和 O(1) 重建 rest/gap,把 C 路径也提速了 3–19 倍。) + +主要收益来源:前缀数组带来的 O(1) 行度量(旧内层每候选分配 O(n) 子 +序列,总计 O(n³))、两遍紧急策略(保持 DP 稀疏)、盒宽测量去重。 + +## 10. 文件地图 + +``` +ekp.el 核心:para 结构、缓存、DP(1D + looseness)、 + glue 分配、渲染、公共 API +ekp-utils.el 分词器(盒子、避头尾)、带 batch/tty 回退的字体 + 检测、C 模块加载 +ekp-hyphen.el Liang 断词 + 词典注册 +ekp_c/ C 动态模块(见 ekp_c/README.md) +dictionaries/ Hunspell 断词模式(来自 Pyphen) +tests/ ekp-tests.el(ERT)、ekp-bench.el、ekp-demo.el、 + 示例文本、run-tests.sh +archive/ 历史原型;不参与加载,仅作参考 +``` diff --git a/ekp-hyphen.el b/ekp-hyphen.el index 7d43d58..98d91d7 100644 --- a/ekp-hyphen.el +++ b/ekp-hyphen.el @@ -40,7 +40,7 @@ LEFT/RIGHT: minimum chars before first / after last break." "Registry: language code -> dictionary file path.") (defvar ekp-hyphen--langs-short (make-hash-table :test 'equal) - "Fallback: short code (e.g., 'en') -> first matching dict path.") + "Fallback: short code (e.g., \"en\") -> first matching dict path.") ;;; Dictionary Loading @@ -69,9 +69,9 @@ LEFT/RIGHT: minimum chars before first / after last break." ;;; Pattern Compilation (defun ekp-hyphen--parse-pattern (pat) - "Parse PAT like 'hy3ph' into (letters offset . values). + "Parse PAT like \"hy3ph\" into (letters offset . values). Values array has length = letters + 1 (position after last letter). -E.g., 'a1bc2' -> letters='abc', values=(0 1 0 2)." +E.g., \"a1bc2\" -> letters=\"abc\", values=(0 1 0 2)." (let ((pos 0) (len (length pat)) letters values) (while (< pos len) ;; Read optional digit (priority before next letter or at end) diff --git a/ekp-utils.el b/ekp-utils.el index 80149bb..172ae8a 100644 --- a/ekp-utils.el +++ b/ekp-utils.el @@ -32,18 +32,28 @@ ))) (defun ekp-font-family (string &optional position) - (format "%s" (font-get (font-at (or position 0) nil string) :family))) + "Return font family name used to display STRING at POSITION. +Falls back to the default face family when no window-system font +information is available (batch mode, tty frames)." + (if-let* ((font (and (display-multi-font-p) + (ignore-errors (font-at (or position 0) nil string))))) + (format "%s" (font-get font :family)) + (let ((family (face-attribute 'default :family))) + (if (stringp family) family (format "%s" family))))) (defun ekp-font-monospace-p (font-family) - (let* ((font (find-font (font-spec :family font-family))) - (font-name (font-xlfd-name font)) - (type (nth 10 (split-string font-name "-" t)))) - ;; 'c' used in terminal - (or (or (string= "m" type) (string= "c" type)) - (let ((info (font-info font-name))) - (and info (> (length info) 4) - ;; 等宽字体的核心标志: 最大宽度等于平均宽度 - (= (aref info 7) (aref info 11))))))) + "Return non-nil if FONT-FAMILY appears to be monospace. +Returns nil (unknown) when font information is unavailable." + (when-let* ((font (and (display-multi-font-p) + (find-font (font-spec :family font-family)))) + (font-name (font-xlfd-name font))) + (let ((type (nth 10 (split-string font-name "-" t)))) + ;; 'c' used in terminal + (or (or (string= "m" type) (string= "c" type)) + (let ((info (font-info font-name))) + (and info (> (length info) 4) + ;; 等宽字体的核心标志: 最大宽度等于平均宽度 + (= (aref info 7) (aref info 11)))))))) (defun ekp-get-latin-letter (string) (with-temp-buffer @@ -109,11 +119,18 @@ (propertize " " 'display `(space :width (,pixel))))) (defun ekp-cjk-fw-punct-p (str) - "Return if CHAR is CJK full-width punctuation." + "Return non-nil if STR starts with a CJK full-width punctuation char. +Full-width alphanumerics (ＡＢＣ, １２３) are NOT punctuation." (let ((char (seq-first str))) - (or (equal (char-syntax char) ?.) - (and (>= char #x3000) (<= char #x303F)) - (and (>= char #xFF00) (<= char #xFF60))))) + (and + ;; Exclude fullwidth Latin letters and digits (FF10-FF19, + ;; FF21-FF3A, FF41-FF5A): they are content, not punctuation. + (not (or (and (>= char #xFF10) (<= char #xFF19)) + (and (>= char #xFF21) (<= char #xFF3A)) + (and (>= char #xFF41) (<= char #xFF5A)))) + (or (equal (char-syntax char) ?.) + (and (>= char #x3000) (<= char #x303F)) + (and (>= char #xFF00) (<= char #xFF60)))))) (defun ekp-cjk-opening-punct-p (str) "Return non-nil if STR ends with a CJK opening punctuation. @@ -162,6 +179,15 @@ Rules: (cons spaces boxes) boxes)) +(defun ekp--zero-width-attaching-p (char) + "Return non-nil if zero-width CHAR must attach to the preceding text. +Combining marks (Mn/Mc/Me), ZWJ/ZWNJ, CGJ and variation selectors +attach to the previous character; other zero-width characters (such +as zero-width space U+200B) are treated as invisible break points." + (or (memq (get-char-code-property char 'general-category) '(Mn Mc Me)) + (memq char '(#x200C #x200D #x034F)) + (and (>= char #xFE00) (<= char #xFE0F)))) + (defun ekp--handle-latin-char (str state latin-word cjk-char boxes) "Handle a latin (width=1) character. Return (new-state new-latin-word new-cjk-char new-boxes)." @@ -208,7 +234,8 @@ Return (new-state new-latin-word new-cjk-char new-boxes)." (defun ekp-split-to-boxes (string) "Split STRING into typographic boxes. Latin words become single boxes; CJK chars are individual boxes. -Whitespace runs are preserved as separate boxes; CJK punctuation attaches to preceding char." +Whitespace runs are preserved as separate boxes; CJK punctuation +attaches to its neighboring char per kinsoku rules." (if (string-blank-p string) (vector string) (with-temp-buffer @@ -222,9 +249,20 @@ Whitespace runs are preserved as separate boxes; CJK punctuation attaches to pre boxes) ; result list (built in reverse) (while (not (eobp)) (let* ((str (buffer-substring (point) (1+ (point)))) + (char (string-to-char str)) (width (string-width str))) (cond - ;; Whitespace or zero-width: flush content, accumulate spaces + ;; Zero-width combining/joining chars: attach to preceding text + ((and (= 0 width) (not (string-blank-p str)) + (ekp--zero-width-attaching-p char)) + (cond + (latin-word (setq latin-word (concat latin-word str))) + (cjk-char (setq cjk-char (concat cjk-char str))) + (spaces (setq spaces (concat spaces str))) + (boxes (setcar boxes (concat (car boxes) str))) + ;; String starts with a combining char: start an accumulator + (t (setq latin-word str state 1)))) + ;; Whitespace or other zero-width: flush content, accumulate spaces ((or (string-blank-p str) (= 0 width)) ;; Don't flush opening punct - keep it held for attachment to next char (if (and cjk-char (ekp-cjk-opening-punct-p cjk-char)) @@ -265,22 +303,24 @@ Whitespace runs are preserved as separate boxes; CJK punctuation attaches to pre (defun ekp-start-process-with-callback (process-name command-args callback &optional output-buffer) - "执行命令（带参数）并在完成后调用回调" + "Run COMMAND-ARGS asynchronously; call CALLBACK on success. +CALLBACK receives (PROCESS BUFFER). The output buffer is killed +after CALLBACK returns." (let* ((buffer-name (generate-new-buffer-name (or output-buffer "*EKP Process Output*"))) (process (apply #'start-process process-name buffer-name command-args))) (set-process-sentinel process - `(lambda (proc event) - (if (string-match-p "finished" event) - (when (memq (process-status proc) '(exit signal)) - (unwind-protect - (funcall ',callback proc (process-buffer proc)) - (when (buffer-live-p (process-buffer proc)) - (kill-buffer (process-buffer proc))))) - (message "%s, please check %s" (string-trim event) - ,buffer-name)))) + (lambda (proc event) + (if (string-match-p "finished" event) + (when (memq (process-status proc) '(exit signal)) + (unwind-protect + (funcall callback proc (process-buffer proc)) + (when (buffer-live-p (process-buffer proc)) + (kill-buffer (process-buffer proc))))) + (message "%s, please check %s" (string-trim event) + buffer-name)))) process)) (defun ekp--module-reload (module) @@ -290,50 +330,15 @@ Whitespace runs are preserved as separate boxes; CJK punctuation attaches to pre (copy-file module tmpfile t) (module-load tmpfile))) -;;; Rust Module Support (currently unused — ekp_rust/ directory does not exist) - -(defalias 'ekp-rust-module-reload #'ekp--module-reload) - -(defun ekp-module-dir () - (when-let ((root-dir (ekp-root-dir))) - (expand-file-name "ekp_rust" root-dir))) - -(defun ekp-module-file () - (when-let* ((module-dir (ekp-module-dir)) - (filename (cond ((eq system-type 'darwin) "libekp.dylib") - ((eq system-type 'windows-nt) "ekp.dll") - (t "libekp.so")))) - (expand-file-name (concat "target/release/" filename) module-dir))) - -(defun ekp-module-load () - "Load rust module of ekp." - (if (executable-find "cargo") - (let ((file (ekp-module-file))) - (if file - (ekp--module-reload file) - (ekp-module-build))) - (error "Please install cargo and add it to executable path!"))) - -(defun ekp-module-build () - "Reload ekp rust module." - (interactive) - (if (executable-find "cargo") - (ekp-start-process-with-callback - "ekp-build" - (cond - ((eq system-type 'windows-nt) - `("cmd.exe" "/c" ,(format "cd %s && cargo build -r" - (ekp-module-dir)))) - (t `(,shell-file-name "-c" ,(format "cd %s && cargo build -r" - (ekp-module-dir))))) - (lambda (proc buffer) - (ekp--module-reload (ekp-module-file)) - (message "ekp rust module reload success!"))) - (error "Please install cargo and add it to executable path!"))) - ;;; C Module Support ;; Parallel C implementation using pthreads +;; Defined by the dynamic module (ekp_c/ekp.dylib | .so | .dll) +(declare-function ekp-c-init "ext:ekp") +(declare-function ekp-c-version "ext:ekp") +(declare-function ekp-c-thread-count "ext:ekp") +(declare-function ekp-c-load-hyphenator "ext:ekp") + (defvar ekp-c-module-loaded nil "Non-nil if C module is loaded.") @@ -356,8 +361,13 @@ Whitespace runs are preserved as separate boxes; CJK punctuation attaches to pre (defalias 'ekp-c-module-reload #'ekp--module-reload "Load MODULE from a temp copy to allow rebuilding.") +(defconst ekp-c-module-required-version "1.1" + "Minimum C module version compatible with this Elisp code.") + (defun ekp-c-module-load () - "Load EKP C module if available." + "Load EKP C module if available. +Refuses to enable a module older than +`ekp-c-module-required-version' (rebuild with make)." (interactive) (let ((file (ekp-c-module-file))) (if (and file (file-exists-p file)) @@ -365,9 +375,15 @@ Whitespace runs are preserved as separate boxes; CJK punctuation attaches to pre (ekp-c-module-reload file) (when (fboundp 'ekp-c-init) (ekp-c-init) - (setq ekp-c-module-loaded t) - (message "ekp-c module loaded (version %s, %d threads)" - (ekp-c-version) (ekp-c-thread-count)))) + (if (version< (ekp-c-version) ekp-c-module-required-version) + (progn + (setq ekp-c-module-loaded nil) + (message "ekp-c module version %s is too old (need %s+). \ +Run 'make' in ekp_c/ to rebuild; falling back to Elisp." + (ekp-c-version) ekp-c-module-required-version)) + (setq ekp-c-module-loaded t) + (message "ekp-c module loaded (version %s, %d threads)" + (ekp-c-version) (ekp-c-thread-count))))) (message "C module not found. Run 'make' in ekp_c/ directory.")))) (defun ekp-c-load-dictionary (lang) @@ -396,7 +412,7 @@ Whitespace runs are preserved as separate boxes; CJK punctuation attaches to pre ((eq system-type 'windows-nt) `("cmd.exe" "/c" ,(format "cd %s && make" module-dir))) (t `(,shell-file-name "-c" ,(format "cd %s && make" module-dir)))) - (lambda (proc buffer) + (lambda (_proc _buffer) (ekp-c-module-load) (message "ekp C module build success!"))) (error "Makefile not found in ekp_c/ directory")))) diff --git a/ekp.el b/ekp.el index 60b067d..4dc83f6 100644 --- a/ekp.el +++ b/ekp.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2024 ;; Author: emacs-kp contributors ;; Keywords: text, typesetting, CJK -;; Package-Requires: ((emacs "27.1")) +;; Package-Requires: ((emacs "29.1")) ;;; Commentary: @@ -22,11 +22,16 @@ (require 'ekp-utils) (require 'ekp-hyphen) +;; Defined by the dynamic module (ekp_c/ekp.dylib | .so | .dll) +(declare-function ekp-c-set-penalties "ext:ekp") +(declare-function ekp-c-break-with-arrays "ext:ekp") +(declare-function ekp-c-break-batch "ext:ekp") + (defconst ekp--load-file (or load-file-name (buffer-file-name)) "Path to this file, for locating dictionaries.") (defvar ekp-latin-lang "en_US" - "Language code for hyphenation (e.g., 'en_US', 'de_DE').") + "Language code for hyphenation (e.g., \"en_US\", \"de_DE\").") (defvar ekp-use-c-module t "When non-nil, use C dynamic module for DP computation if available. @@ -64,7 +69,8 @@ Set to nil to force pure Elisp implementation.") "Penalty for each line break. Higher = fewer lines. Default 10.") (defvar ekp-hyphen-penalty 50 - "Penalty for hyphenated breaks. Higher = avoid hyphenation. Default 50.") + "Penalty for hyphenated breaks. Higher = avoid hyphenation. Default 50. +Note: added to demerits as penalty², following the K-P formula.") (defvar ekp-adjacent-fitness-penalty 100 "Penalty when adjacent lines differ in tightness by >1 class.") @@ -73,55 +79,63 @@ Set to nil to force pure Elisp implementation.") "Base penalty multiplier for consecutive hyphenated lines. Actual penalty = this × count², encouraging spread of hyphens.") -(defvar ekp-forced-break-penalty 10000 - "Base penalty for forced breaks where no valid break exists. -High value ensures forced breaks are last resort.") - (defvar ekp-last-line-short-penalty 50 "Penalty multiplier for underfilled last lines. -Applied as: this × (1 - fill-ratio) when fill < ekp-last-line-min-ratio.") +Applied as: this × (1 - fill-ratio) when fill < `ekp-last-line-min-ratio'.") (defvar ekp-last-line-min-ratio 0.5 "Minimum fill ratio for last line (0.0-1.0).") (defvar ekp-looseness 0 - "Target line count offset: 0=optimal, +1=looser (more lines), -1=tighter (fewer lines). -When non-zero, the algorithm tracks multiple paths and selects the one -whose line count is closest to (optimal + looseness).") + "Target line count offset: 0=optimal, +1=looser (more lines), -1=tighter. +When non-zero, a full (position × line-count) dynamic program is run +and the path whose line count is closest to (optimal + looseness) with +the lowest demerits is selected. Only supported by the Elisp engine; +when non-zero the C module is bypassed automatically.") -(defvar ekp-threshold-factor 0 - "Threshold factor for early pruning (0 = disabled). -When > 0, breakpoints with demerits > best × (1 + factor) are skipped. -Typical value: 2.0 for moderate pruning, 5.0 for aggressive pruning. -Reduces computation time for long paragraphs at slight quality cost.") - -(defvar ekp-flagged-penalty -10000 - "Penalty for flagged (forced) breaks. -Negative value means this break is preferred (mandatory). -When a box ends with a forced break marker, it will be selected. -Used for explicit line breaks in poetry, code blocks, etc.") +(defconst ekp--infinite-badness 10000 + "Badness value treated as infinitely bad (matches TeX).") ;;;; Paragraph Cache Structure ;; ;; All paragraph data is stored in a flat struct for O(1) access. -;; Cache key: sxhash of (string, fonts, spacing params) (cl-defstruct (ekp-para (:constructor ekp-para--create)) "Preprocessed paragraph data." string latin-font cjk-font boxes boxes-widths boxes-types glues-types hyphen-pixel hyphen-positions - flagged-positions ; vector of indices for forced line breaks ideal-prefixs min-prefixs max-prefixs - ;; Store glue params at para creation time for consistent C module calls - glue-params ; plist (:lws-ideal :lws-shrink :lws-stretch :mws-* :cws-*) + ;; Per-position leading glue values (indexed by box, n elements) + glue-ideals glue-shrinks glue-stretches + ;; Prefix counts of each stretchable glue type (n+1 elements each); + ;; entry i = number of that glue type among glue indices 0..i-1. + lws-prefixs mws-prefixs cws-prefixs + ;; Space-box run widths: lead-spaces[i] = total width of consecutive + ;; space boxes starting at box i (forced to 0 at i=0 so that first-line + ;; indentation is preserved); trail-spaces[k] = total width of + ;; consecutive space boxes ending at box k-1. + lead-spaces trail-spaces + ;; Glue params snapshot at para creation time (plist) + glue-params (dp-cache nil :type hash-table)) (defvar ekp--para-cache nil - "Cache: hash-key → ekp-para struct.") + "Cache: equal-keyed table, content key → ekp-para struct.") -(defvar ekp--use-default-params t - "Internal flag for parameter initialization.") +(defvar ekp--last-para nil + "Fast path: (string-object lang para) of the most recent lookup. +One justification call resolves the same string object many times; +this avoids recomputing the full cache key each time. Invalidated +by parameter changes, language changes and `ekp-clear-caches'.") + +(defvar ekp-para-cache-limit 256 + "Maximum number of cached paragraphs. +When exceeded, the whole paragraph cache is flushed (cheap to rebuild).") + +(defvar ekp--params-explicit nil + "Non-nil after `ekp-param-set'; spacing params then persist until +`ekp-param-reset'. When nil, defaults are derived from each string.") ;;;; Initialization ;; ekp-root-dir is provided by ekp-utils.el @@ -141,18 +155,8 @@ Used for explicit line breaks in poetry, code blocks, etc.") ekp-mws-ideal-pixel ekp-mws-stretch-pixel ekp-mws-shrink-pixel ekp-cws-ideal-pixel ekp-cws-stretch-pixel ekp-cws-shrink-pixel)) -(defun ekp-param-set-default (string) - "Set default spacing parameters based on STRING's font." - (let* ((lws (ekp-word-spacing-pixel string)) - (mws (- lws 1))) - (ekp-param-set lws (ceiling (/ (float lws) 2)) (ceiling (/ (float lws) 3)) - mws (ceiling (/ (float mws) 2)) (ceiling (/ (float mws) 3)) - 0 ekp-default-cws-stretch-pixel 0))) - -(defun ekp-param-set (lws-i lws-+ lws-- mws-i mws-+ mws-- cws-i cws-+ cws--) - "Set all spacing parameters. -LWS = Latin word space, MWS = mixed, CWS = CJK. -Each takes ideal, stretch (+), and shrink (-) values." +(defun ekp--param-apply (lws-i lws-+ lws-- mws-i mws-+ mws-- cws-i cws-+ cws--) + "Set the nine spacing variables and derived limits (internal)." (setq ekp-lws-ideal-pixel lws-i ekp-lws-stretch-pixel lws-+ ekp-lws-shrink-pixel lws-- ekp-mws-ideal-pixel mws-i ekp-mws-stretch-pixel mws-+ ekp-mws-shrink-pixel mws-- @@ -163,24 +167,62 @@ Each takes ideal, stretch (+), and shrink (-) values." (setq ekp-lws-max-pixel (+ lws-i lws-+) ekp-lws-min-pixel (- lws-i lws--) ekp-mws-max-pixel (+ mws-i mws-+) ekp-mws-min-pixel (- mws-i mws--) ekp-cws-max-pixel (+ cws-i cws-+) ekp-cws-min-pixel (- cws-i cws--)) - (setq ekp--use-default-params nil)) + ;; Spacing changed: paragraphs must be re-resolved against it. + (setq ekp--last-para nil)) + +(defun ekp-param-set (lws-i lws-+ lws-- mws-i mws-+ mws-- cws-i cws-+ cws--) + "Set all spacing parameters explicitly; they persist until `ekp-param-reset'. +LWS = Latin word space, MWS = mixed, CWS = CJK. +Each takes ideal, stretch (+), and shrink (-) values in pixels." + (ekp--param-apply lws-i lws-+ lws-- mws-i mws-+ mws-- cws-i cws-+ cws--) + (setq ekp--params-explicit t)) + +(defun ekp-param-set-default (string) + "Compute and apply default spacing parameters based on STRING's font. +Does not mark parameters as explicit; each paragraph gets fresh defaults." + (let* ((lws (max 1 (ekp-word-spacing-pixel string))) + (mws (max 0 (- lws 1)))) + (ekp--param-apply lws (ceiling (/ (float lws) 2)) (ceiling (/ (float lws) 3)) + mws (ceiling (/ (float mws) 2)) (ceiling (/ (float mws) 3)) + 0 ekp-default-cws-stretch-pixel 0))) + +(defun ekp-param-reset () + "Clear explicit spacing parameters; defaults are derived per string again." + (interactive) + (setq ekp--params-explicit nil) + (setq ekp-lws-ideal-pixel nil ekp-lws-stretch-pixel nil + ekp-lws-shrink-pixel nil ekp-mws-ideal-pixel nil + ekp-mws-stretch-pixel nil ekp-mws-shrink-pixel nil + ekp-cws-ideal-pixel nil ekp-cws-stretch-pixel nil + ekp-cws-shrink-pixel nil) + (setq ekp--last-para nil)) ;;;; Text Analysis (defconst ekp--latin-regexp - "[A-Za-z'\\-\u00C0-\u00D6\u00D8-\u00F6\u00F8-\u00FF\u0100-\u024F\u1E00-\u1EFF]" + "[A-Za-z'\\-À-ÖØ-öø-ÿĀ-ɏḀ-ỿ]" "Regexp matching Latin characters including accented forms.") +(defconst ekp--word-left-punct "[({<„‚«‹¿¡*@\"'‘“" + "Characters that may precede a hyphenatable Latin word.") + +(defconst ekp--word-right-punct ")}>.,;:!?*\"'’”»›" + "Characters that may follow a hyphenatable Latin word. +NB: `]' is included separately at the start of the character class.") + (defun ekp--split-with-hyphen (string) "Split STRING into boxes with hyphenation points marked. Returns (boxes-vector . hyphen-positions-vector)." (let* ((boxes (ekp-split-to-boxes string)) + ;; NB: both punct sets are spliced into character classes; + ;; they contain no chars that are special inside [...]. + (word-re (format "^\\([%s]*\\)\\(%s+\\)\\([]%s]*\\)$" + ekp--word-left-punct + ekp--latin-regexp + ekp--word-right-punct)) (idx 0) new-boxes hyphen-idxs) (dolist (box (append boxes nil)) - (if (string-match - (format "^\\([[{<„‚¿¡*@\"']*\\)\\(%s+\\)\\([]}>.,*?\"']*\\)$" - ekp--latin-regexp) - box) + (if (string-match word-re box) ;; Latin word: apply hyphenation (let* ((left (match-string 1 box)) (word (match-string 2 box)) @@ -188,9 +230,11 @@ Returns (boxes-vector . hyphen-positions-vector)." (parts (ekp-hyphen-boxes (ekp-hyphen-create ekp-latin-lang) word)) (n (length parts))) - (when left (setcar parts (concat left (car parts)))) - (when right (setcar (last parts) - (concat (car (last parts)) right))) + (when (> (length left) 0) + (setcar parts (concat left (car parts)))) + (when (> (length right) 0) + (setcar (last parts) + (concat (car (last parts)) right))) (push parts new-boxes) (dotimes (i n) (when (< i (1- n)) (push idx hyphen-idxs)) @@ -202,33 +246,46 @@ Returns (boxes-vector . hyphen-positions-vector)." (vconcat (nreverse hyphen-idxs))))) (defun ekp--str-type (str) - "STR should be single letter string." + "Classify single-character string STR. +Returns one of `space', `latin', `cjk', `cjk-punct'." (cond - ;; Whitespace (space, tab, etc.) or zero-width characters + ;; Whitespace or zero-width characters ((or (string-blank-p str) (= (string-width str) 0)) 'space) ;; a half-width cjk punct ((or (string= "“" str) (string= "”" str)) 'cjk) ((= (string-width str) 1) 'latin) - ((= (string-width str) 2) - (if (ekp-cjk-fw-punct-p str) - 'cjk-punct - 'cjk)) - (t (error "Abnormal string width %s for %s" - (string-width str) str)))) + ((ekp-cjk-fw-punct-p str) 'cjk-punct) + ;; double-width (or wider): CJK-like content, including emoji + (t 'cjk))) + +(defun ekp--box-edge-char (box from-end) + "Return the first (or last, if FROM-END) visible char of BOX as a string. +Skips zero-width characters; falls back to the edge char." + (let* ((len (length box)) + (idx (if from-end (1- len) 0)) + (step (if from-end -1 1))) + (while (and (>= idx 0) (< idx len) + (= (char-width (aref box idx)) 0)) + (setq idx (+ idx step))) + (if (and (>= idx 0) (< idx len)) + (substring box idx (1+ idx)) + (substring box (if from-end (1- len) 0) + (if from-end len 1))))) (defun ekp--box-type (box) + "Return (START-TYPE . END-TYPE) for BOX, or nil for empty boxes." (unless (or (null box) (string-empty-p box)) ;; Space/zero-width boxes: type is (space . space) (if (or (string-blank-p box) (= (string-width box) 0)) '(space . space) - (cons (ekp--str-type (substring box 0 1)) - (ekp--str-type (substring box -1)))))) + (cons (ekp--str-type (ekp--box-edge-char box nil)) + (ekp--str-type (ekp--box-edge-char box t)))))) (defun ekp--glue-type (prev-box-type curr-box-type) - "Lws means whitespace between latin words; cws means -whitespace between cjk words; mws means whitespace between -cjk and latin words; nws means no whitespace. -Space boxes (preserved whitespace) need no additional glue." + "Glue type between boxes: `lws', `mws', `cws' or `nws'. +Lws means whitespace between latin words; cws between cjk chars; +mws between cjk and latin; nws means no whitespace. Space boxes +\(preserved whitespace) need no additional glue." (let ((before (cdr prev-box-type)) (after (car curr-box-type))) (if before @@ -244,17 +301,17 @@ Space boxes (preserved whitespace) need no additional glue." 'nws))) (defun ekp--compute-glue-types (boxes boxes-types hyphen-positions) - "Compute glue types for BOXES. Positions after HYPHEN-POSITIONS are 'nws." + "Compute glue types for BOXES. Positions after HYPHEN-POSITIONS are `nws'." (let* ((n (length boxes)) (glues (make-vector n nil)) prev-type) (dolist (i (append hyphen-positions nil)) (aset glues (1+ i) 'nws)) (dotimes (i n) - (unless (aref glues i) - (let ((curr-type (aref boxes-types i))) - (aset glues i (ekp--glue-type prev-type curr-type)) - (setq prev-type curr-type)))) + (let ((curr-type (aref boxes-types i))) + (unless (aref glues i) + (aset glues i (ekp--glue-type prev-type curr-type))) + (setq prev-type curr-type))) glues)) (defun ekp-glue-ideal-pixel (type) @@ -300,41 +357,77 @@ Space boxes (preserved whitespace) need no additional glue." ((eq 'cws type) (plist-get params :cws-stretch))))) (defun ekp--para-glue-min (para type) - "Get minimum glue pixel (ideal - shrink) for TYPE using PARA's stored params." + "Get minimum glue pixel (ideal - shrink) for TYPE." (- (ekp--para-glue-ideal para type) (ekp--para-glue-shrink para type))) (defun ekp--para-glue-max (para type) - "Get maximum glue pixel (ideal + stretch) for TYPE using PARA's stored params." + "Get maximum glue pixel (ideal + stretch) for TYPE." (+ (ekp--para-glue-ideal para type) (ekp--para-glue-stretch para type))) ;;; ============================================================ -;;; Cache Implementation: Fast Hash + Flat Structure +;;; Cache Implementation ;;; ============================================================ -(defun ekp--para-hash (string) - "Compute fast hash key for STRING. -Uses sxhash on serialized representation to correctly handle text properties." +(defun ekp--para-key (string) + "Compute cache key for STRING. +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 parameters \(or the symbol `auto' when defaults +are derived per string)." (let ((latin-font (ekp-latin-font string)) (cjk-font (ekp-cjk-font string))) - ;; Combine: string content + text properties + fonts + spacing params - ;; Use prin1-to-string on intervals to ensure property values are hashed - (sxhash - (list (sxhash string) - (sxhash (prin1-to-string (object-intervals string))) - latin-font cjk-font - ekp-lws-ideal-pixel ekp-lws-stretch-pixel ekp-lws-shrink-pixel - ekp-mws-ideal-pixel ekp-mws-stretch-pixel ekp-mws-shrink-pixel - ekp-cws-ideal-pixel ekp-cws-stretch-pixel ekp-cws-shrink-pixel)))) + (list string + (prin1-to-string (object-intervals string)) + latin-font cjk-font + ekp-latin-lang + (if (and ekp--params-explicit (ekp--params-set-p)) + (list ekp-lws-ideal-pixel ekp-lws-stretch-pixel + ekp-lws-shrink-pixel ekp-mws-ideal-pixel + ekp-mws-stretch-pixel ekp-mws-shrink-pixel + ekp-cws-ideal-pixel ekp-cws-stretch-pixel + ekp-cws-shrink-pixel) + 'auto)))) + +(defun ekp--measure-boxes (boxes uniform-props) + "Measure pixel widths of BOXES, deduplicating identical boxes. +Identity = same characters AND same text properties. When +UNIFORM-PROPS is non-nil (the whole paragraph carries at most one +property run), plain string equality suffices as the key. For CJK +text where each character is a box, deduplication dramatically +reduces the number of `string-pixel-width' calls." + (let* ((n (length boxes)) + (seen (make-hash-table :test 'equal :size n)) + (widths (make-vector n 0))) + (dotimes (i n) + (let* ((box (aref boxes i)) + (key (if uniform-props box + (cons box (object-intervals box)))) + (w (gethash key seen))) + (unless w + (setq w (string-pixel-width box)) + (puthash key w seen)) + (aset widths i w))) + widths)) + +(defun ekp--hyphen-width-for (string) + "Pixel width of the hyphen char, styled like STRING's first char." + (let ((props (and (> (length string) 0) (text-properties-at 0 string)))) + (string-pixel-width (if props (apply #'propertize "-" props) "-")))) + +(defun ekp--space-box-type-p (box-type) + "Return non-nil if BOX-TYPE describes a whitespace box." + (and box-type (eq (car box-type) 'space))) (defun ekp--make-para (string) - "Create and fully initialize ekp-para struct for STRING. + "Create and fully initialize `ekp-para' struct for STRING. Computes ALL data in one pass: text, params, and prefix arrays." - ;; Ensure params are set - (when (or ekp--use-default-params (null (ekp--params-set-p))) + ;; 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)) - (setq ekp--use-default-params t) ;; Extract fonts (let* ((latin-font (ekp-latin-font string)) (cjk-font (ekp-cjk-font string)) @@ -344,29 +437,58 @@ Computes ALL data in one pass: text, params, and prefix arrays." (hyphen-positions (cdr split-result)) (n (length boxes)) ;; Compute box properties - (boxes-widths (vconcat (mapcar #'string-pixel-width boxes))) + (boxes-widths (ekp--measure-boxes + boxes (null (cdr (object-intervals string))))) (boxes-types (vconcat (mapcar #'ekp--box-type boxes))) (glues-types (ekp--compute-glue-types boxes boxes-types hyphen-positions)) - (hyphen-pixel (string-pixel-width "-")) - ;; Compute prefix arrays in one pass + (hyphen-pixel (ekp--hyphen-width-for string)) + ;; Prefix arrays (ideal-prefixs (make-vector (1+ n) 0)) (min-prefixs (make-vector (1+ n) 0)) - (max-prefixs (make-vector (1+ n) 0))) + (max-prefixs (make-vector (1+ n) 0)) + (glue-ideals (make-vector n 0)) + (glue-shrinks (make-vector n 0)) + (glue-stretches (make-vector n 0)) + (lws-prefixs (make-vector (1+ n) 0)) + (mws-prefixs (make-vector (1+ n) 0)) + (cws-prefixs (make-vector (1+ n) 0)) + (lead-spaces (make-vector (1+ n) 0)) + (trail-spaces (make-vector (1+ n) 0))) ;; Single loop for all prefix computations (dotimes (i n) - (let ((box-w (aref boxes-widths i)) - (glue-type (aref glues-types i))) - (aset ideal-prefixs (1+ i) - (+ (aref ideal-prefixs i) box-w - (ekp-glue-ideal-pixel glue-type))) - (aset min-prefixs (1+ i) - (+ (aref min-prefixs i) box-w - (ekp-glue-min-pixel glue-type))) - (aset max-prefixs (1+ i) - (+ (aref max-prefixs i) box-w - (ekp-glue-max-pixel glue-type))))) - ;; Create struct with all data, including glue params at creation time + (let* ((box-w (aref boxes-widths i)) + (glue-type (aref glues-types i)) + (g-ideal (ekp-glue-ideal-pixel glue-type)) + (g-min (ekp-glue-min-pixel glue-type)) + (g-max (ekp-glue-max-pixel glue-type))) + (aset glue-ideals i g-ideal) + (aset glue-shrinks i (- g-ideal g-min)) + (aset glue-stretches i (- g-max g-ideal)) + (aset ideal-prefixs (1+ i) (+ (aref ideal-prefixs i) box-w g-ideal)) + (aset min-prefixs (1+ i) (+ (aref min-prefixs i) box-w g-min)) + (aset max-prefixs (1+ i) (+ (aref max-prefixs i) box-w g-max)) + (aset lws-prefixs (1+ i) (+ (aref lws-prefixs i) + (if (eq glue-type 'lws) 1 0))) + (aset mws-prefixs (1+ i) (+ (aref mws-prefixs i) + (if (eq glue-type 'mws) 1 0))) + (aset cws-prefixs (1+ i) (+ (aref cws-prefixs i) + (if (eq glue-type 'cws) 1 0))) + ;; trail-spaces[k]: width of space-box run ending at k-1 + (aset trail-spaces (1+ i) + (if (ekp--space-box-type-p (aref boxes-types i)) + (+ (aref trail-spaces i) box-w) + 0)))) + ;; lead-spaces[i]: width of space-box run starting at i (backwards pass). + ;; Index 0 forced to 0: first-line leading spaces are indentation. + (let ((i (1- n))) + (while (>= i 0) + (aset lead-spaces i + (if (ekp--space-box-type-p (aref boxes-types i)) + (+ (aref boxes-widths i) (aref lead-spaces (1+ i))) + 0)) + (setq i (1- i)))) + (aset lead-spaces 0 0) (ekp-para--create :string string :latin-font latin-font @@ -380,6 +502,14 @@ Computes ALL data in one pass: text, params, and prefix arrays." :ideal-prefixs ideal-prefixs :min-prefixs min-prefixs :max-prefixs max-prefixs + :glue-ideals glue-ideals + :glue-shrinks glue-shrinks + :glue-stretches glue-stretches + :lws-prefixs lws-prefixs + :mws-prefixs mws-prefixs + :cws-prefixs cws-prefixs + :lead-spaces lead-spaces + :trail-spaces trail-spaces :glue-params (list :lws-ideal ekp-lws-ideal-pixel :lws-stretch ekp-lws-stretch-pixel :lws-shrink ekp-lws-shrink-pixel @@ -392,20 +522,34 @@ Computes ALL data in one pass: text, params, and prefix arrays." :dp-cache (make-hash-table :test 'eql :size 20)))) (defun ekp--get-para (string) - "Get or create ekp-para struct for STRING. + "Get or create `ekp-para' struct for STRING. This is the main entry point for cached paragraph data." - (unless ekp--para-cache - (setq ekp--para-cache (make-hash-table :test 'eql :size 100))) - (let ((key (ekp--para-hash string))) - (or (gethash key ekp--para-cache) - (let ((para (ekp--make-para string))) - (puthash key para ekp--para-cache) - para)))) + (if (and ekp--last-para + (eq (car ekp--last-para) string) + (equal (nth 1 ekp--last-para) ekp-latin-lang)) + (nth 2 ekp--last-para) + (unless ekp--para-cache + (setq ekp--para-cache (make-hash-table :test 'equal :size 100))) + (let* ((key (ekp--para-key string)) + (para (or (gethash key ekp--para-cache) + (progn + (when (>= (hash-table-count ekp--para-cache) + ekp-para-cache-limit) + (clrhash ekp--para-cache)) + ;; NB: in auto-params mode `ekp--make-para' updates + ;; the spacing variables, which invalidates + ;; `ekp--last-para'; set the fast path afterwards. + (let ((p (ekp--make-para string))) + (puthash key p ekp--para-cache) + p))))) + (setq ekp--last-para (list string ekp-latin-lang para)) + para))) (defun ekp-clear-caches () "Clear all paragraph caches." (interactive) - (setq ekp--para-cache nil)) + (setq ekp--para-cache nil) + (setq ekp--last-para nil)) ;;;; Paragraph Accessors @@ -433,12 +577,8 @@ This is the main entry point for cached paragraph data." (defun ekp--hyphen-positions (string) (ekp-para-hyphen-positions (ekp--get-para string))) -(defun ekp--hyphen-str (_string) - "Return hyphen character." - "-") - ;;;; K-P Badness and Demerits -;; demerits = (linepenalty + badness)² + penalties +;; demerits = (linepenalty + badness)² + penalty² + extras ;; ;; Fitness classes ensure visual consistency: ;; 0=tight, 1=decent, 2=loose, 3=very-loose @@ -449,9 +589,9 @@ This is the main entry point for cached paragraph data." Returns 0 if no adjustment needed, 10000 (infinite) if impossible." (cond ((= adjustment-pixel 0) 0) - ((<= flexibility-pixel 0) 10000) + ((<= flexibility-pixel 0) ekp--infinite-badness) (t (let ((ratio (/ (float adjustment-pixel) flexibility-pixel))) - (min 10000 (* 100 (expt (abs ratio) 3))))))) + (min ekp--infinite-badness (* 100 (expt (abs ratio) 3))))))) (defun ekp--compute-fitness-class (adjustment-pixel flexibility-pixel) "Classify line tightness into fitness class (0-3). @@ -488,44 +628,6 @@ Returns total demerits for this break." with-fitness))) with-hyphen)) -(defun ekp--gaps-list (glues-types) - "Count gaps by type: (latin-gaps mix-gaps cjk-gaps)." - (list (seq-count (lambda (it) (eq 'lws it)) glues-types) - (seq-count (lambda (it) (eq 'mws it)) glues-types) - (seq-count (lambda (it) (eq 'cws it)) glues-types))) - -(defun ekp--compute-stretch-capacity (para gaps-list) - "Return total stretchable pixels for GAPS-LIST using PARA's stored params." - (let ((params (ekp-para-glue-params para))) - (+ (* (nth 0 gaps-list) (plist-get params :lws-stretch)) - (* (nth 1 gaps-list) (plist-get params :mws-stretch)) - (* (nth 2 gaps-list) (plist-get params :cws-stretch))))) - -(defun ekp--compute-shrink-capacity (para gaps-list) - "Return total shrinkable pixels for GAPS-LIST using PARA's stored params. -CJK gaps don't shrink." - (let ((params (ekp-para-glue-params para))) - (+ (* (nth 0 gaps-list) (plist-get params :lws-shrink)) - (* (nth 1 gaps-list) (plist-get params :mws-shrink))))) - -(defun ekp--line-badness-and-fitness (para ideal-pixel line-pixel glues-types) - "Compute badness, fitness class, and gaps for a line. -Uses PARA's stored glue params for consistent capacity calculation. -Returns (:badness NUM :fitness NUM :gaps LIST :adjustment NUM :flexibility NUM)." - (let* ((glues-types (seq-drop glues-types 1)) - (gaps-list (ekp--gaps-list glues-types)) - (adjustment (- line-pixel ideal-pixel)) - (flexibility (if (> adjustment 0) - (ekp--compute-stretch-capacity para gaps-list) - (ekp--compute-shrink-capacity para gaps-list))) - (badness (ekp--compute-badness adjustment flexibility)) - (fitness (ekp--compute-fitness-class adjustment flexibility))) - (list :badness badness - :fitness fitness - :gaps gaps-list - :adjustment adjustment - :flexibility flexibility))) - (defun ekp--sorted-vector-member-p (vec n) "Return non-nil if N exists in sorted vector VEC. Uses binary search for O(log n) lookup." @@ -541,174 +643,240 @@ Uses binary search for O(log n) lookup." (= (aref vec lo) n)))) (defalias 'ekp--hyphenate-p #'ekp--sorted-vector-member-p - "Return non-nil if position N in HYPHEN-POSITIONS ends with hyphenation. -HYPHEN-POSITIONS is a sorted vector of indices where hyphenation can occur.") + "Return non-nil if position N in HYPHEN-POSITIONS ends with hyphenation.") -(defalias 'ekp--flagged-p #'ekp--sorted-vector-member-p - "Return non-nil if position N in FLAGGED-POSITIONS is a flagged (forced) break. -FLAGGED-POSITIONS is a sorted vector of indices where forced breaks occur.") +;;;; Shared Line Measurement (O(1) via prefix arrays) + +(defun ekp--gaps-between (para i k) + "Return (latin-gaps mix-gaps cjk-gaps) inside line I..K (exclusive glues). +Counts glue indices I+1 .. K-1 using precomputed prefix counts." + (let ((lp (ekp-para-lws-prefixs para)) + (mp (ekp-para-mws-prefixs para)) + (cp (ekp-para-cws-prefixs para)) + (j (1+ i))) + (list (- (aref lp k) (aref lp j)) + (- (aref mp k) (aref mp j)) + (- (aref cp k) (aref cp j))))) + +(defun ekp--line-ideal-pixel (para i k) + "Ideal width of line I..K: box+glue ideals, minus leading glue and +stripped space-box runs, plus hyphen width when the line hyphenates." + (let* ((ip (ekp-para-ideal-prefixs para)) + (raw (- (aref ip k) (aref ip i) + (aref (ekp-para-glue-ideals para) i))) + (space-w (min raw (+ (aref (ekp-para-lead-spaces para) i) + (aref (ekp-para-trail-spaces para) k)))) + (ideal (- raw space-w))) + (if (ekp--hyphenate-p (ekp-para-hyphen-positions para) (1- k)) + (+ ideal (ekp-para-hyphen-pixel para)) + ideal))) ;;;; Dynamic Programming Line Breaking +;; +;; 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. -(defun ekp--dp-init-arrays (n) - "Initialize DP arrays for N boxes. -Returns (backptrs demerits rests gaps hyphen-counts fitness-classes line-counts alt-paths). -When looseness != 0, alt-paths tracks alternative paths by (position . line-count)." - (let ((backptrs (make-vector (1+ n) nil)) - (demerits (make-vector (1+ n) nil)) - (rests (make-vector (1+ n) nil)) - (gaps (make-vector (1+ n) nil)) - (hyphen-counts (make-vector (1+ n) 0)) - (fitness-classes (make-vector (1+ n) 1)) ; default: decent - (line-counts (make-vector (1+ n) 0)) ; for looseness - ;; alt-paths: hash (position . line-count) -> (backptr . demerits) - ;; Size based on estimated paths: n positions × ~10 possible line counts - (alt-paths (when (/= ekp-looseness 0) - (make-hash-table :test 'equal :size (min 1000 (* n 10)))))) +(defun ekp--dp-cache-elisp (para line-pixel) + "Pure Elisp DP implementation. Returns and caches the dp-result plist." + (if (/= ekp-looseness 0) + (ekp--dp-cache-elisp-loose para line-pixel) + (let ((dp-result (or (ekp--dp-run-1d para line-pixel nil) + (ekp--dp-run-1d para line-pixel t)))) + (puthash line-pixel dp-result (ekp-para-dp-cache para)) + dp-result))) + +(defun ekp--hyphen-flags (hyphen-positions n) + "Return a bool-vector of length N flagging hyphenatable box indices." + (let ((v (make-bool-vector (max n 1) nil))) + (dotimes (j (length hyphen-positions)) + (aset v (aref hyphen-positions j) t)) + v)) + +(defun ekp--dp-run-1d (para line-pixel allow-emergency) + "One strict (or emergency-permitting) K-P DP pass over PARA. +Returns the dp-result plist, or nil when the paragraph end is +unreachable (only possible when ALLOW-EMERGENCY is nil)." + (let* ((boxes (ekp-para-boxes para)) + (n (length boxes)) + (hyphen-pixel (ekp-para-hyphen-pixel para)) + (hyph-flags (ekp--hyphen-flags + (ekp-para-hyphen-positions para) n)) + (ideal-prefixs (ekp-para-ideal-prefixs para)) + (min-prefixs (ekp-para-min-prefixs para)) + (max-prefixs (ekp-para-max-prefixs para)) + (glue-ideals (ekp-para-glue-ideals para)) + (glue-shrinks (ekp-para-glue-shrinks para)) + (glue-stretches (ekp-para-glue-stretches para)) + (lws-prefixs (ekp-para-lws-prefixs para)) + (mws-prefixs (ekp-para-mws-prefixs para)) + (cws-prefixs (ekp-para-cws-prefixs para)) + (lead-spaces (ekp-para-lead-spaces para)) + (trail-spaces (ekp-para-trail-spaces para)) + (params (ekp-para-glue-params para)) + (lws-stretch (plist-get params :lws-stretch)) + (mws-stretch (plist-get params :mws-stretch)) + (cws-stretch (plist-get params :cws-stretch)) + (lws-shrink (plist-get params :lws-shrink)) + (mws-shrink (plist-get params :mws-shrink)) + (cws-shrink (plist-get params :cws-shrink)) + (backptrs (make-vector (1+ n) nil)) + (demerits (make-vector (1+ n) nil)) + (rests (make-vector (1+ n) nil)) + (gaps (make-vector (1+ n) nil)) + (hyphen-counts (make-vector (1+ n) 0)) + (fitness-classes (make-vector (1+ n) 1))) (aset demerits 0 0.0) - ;; Initialize alt-paths for position 0 - (when alt-paths - (puthash (cons 0 0) (cons nil 0.0) alt-paths)) - (list backptrs demerits rests gaps - hyphen-counts fitness-classes line-counts alt-paths))) + (dotimes (i n) + (when (aref demerits i) + (let* ((prev-dem (aref demerits i)) + (prev-hyphen-count (aref hyphen-counts i)) + (prev-fitness (aref fitness-classes i)) + (ip-i (aref ideal-prefixs i)) + (mn-i (aref min-prefixs i)) + (mx-i (aref max-prefixs i)) + (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))) + (lead-space (aref lead-spaces i)) + (k (1+ i))) + (catch 'break + (while (<= k n) + (let* ((is-last (= k n)) + (single-box (= k (1+ i))) + (end-with-hyphenp (aref hyph-flags (1- k))) + (hyph-w (if end-with-hyphenp hyphen-pixel 0)) + (raw-ideal (- (aref ideal-prefixs k) ip-i lead-glue-ideal)) + (space-w (min raw-ideal + (+ lead-space (aref trail-spaces k)))) + (ideal (+ (- raw-ideal space-w) hyph-w)) + (minw (+ (- (aref min-prefixs k) mn-i lead-glue-min + space-w) + hyph-w)) + (maxw (+ (- (aref max-prefixs k) mx-i lead-glue-max + space-w) + hyph-w))) + (cond + ;; Line already too long: emergency-record single box, + ;; then stop extending. + ((or (> minw line-pixel) + (and is-last (> ideal line-pixel))) + (when (and single-box allow-emergency) + (ekp--dp-relax-emergency + demerits backptrs rests gaps hyphen-counts + fitness-classes i k prev-dem + (- line-pixel ideal) end-with-hyphenp + prev-hyphen-count)) + (throw 'break nil)) + ;; Valid break point + ((or (<= minw line-pixel maxw) + (and is-last (<= ideal line-pixel))) + (let* ((adjustment (- line-pixel ideal)) + dem line-gaps fitness new-hyphen) + (cond + ;; Single box line: fixed flexibility of 1 + (single-box + (let* ((badness (ekp--compute-badness adjustment 1)) + (penalty (if end-with-hyphenp + ekp-hyphen-penalty 0))) + (setq fitness 1 + new-hyphen (if end-with-hyphenp + (1+ prev-hyphen-count) 0) + line-gaps nil + dem (ekp--compute-demerits + badness penalty prev-fitness fitness + end-with-hyphenp prev-hyphen-count)))) + ;; Last line: minimal demerits if reasonably filled + (is-last + (let* ((fill-ratio (/ (float ideal) line-pixel)) + (badness (if (< fill-ratio + ekp-last-line-min-ratio) + (* ekp-last-line-short-penalty + (- 1.0 fill-ratio)) + 0))) + (setq fitness 1 new-hyphen 0 line-gaps nil + dem (expt (+ ekp-line-penalty badness) 2)))) + ;; Normal justified line + (t + (let* ((j (1+ i)) + (lcnt (- (aref lws-prefixs k) + (aref lws-prefixs j))) + (mcnt (- (aref mws-prefixs k) + (aref mws-prefixs j))) + (ccnt (- (aref cws-prefixs k) + (aref cws-prefixs j))) + (flexibility + (if (> adjustment 0) + (+ (* lcnt lws-stretch) + (* mcnt mws-stretch) + (* ccnt cws-stretch)) + (+ (* lcnt lws-shrink) + (* mcnt mws-shrink) + (* ccnt cws-shrink)))) + (badness (ekp--compute-badness + adjustment flexibility)) + (penalty (if end-with-hyphenp + ekp-hyphen-penalty 0))) + (setq fitness (ekp--compute-fitness-class + adjustment flexibility) + new-hyphen (if end-with-hyphenp + (1+ prev-hyphen-count) 0) + line-gaps (list lcnt mcnt ccnt) + dem (ekp--compute-demerits + badness penalty prev-fitness fitness + end-with-hyphenp prev-hyphen-count))))) + (let ((total (+ prev-dem dem))) + (when (or (null (aref demerits k)) + (< total (aref demerits k))) + (aset demerits k total) + (aset backptrs k i) + (aset rests k adjustment) + (aset gaps k line-gaps) + (aset fitness-classes k fitness) + (aset hyphen-counts k new-hyphen))))) + ;; Invalid single box (rigid underfull): emergency + ;; record so the DP cannot dead-end (2nd pass only). + ((and single-box allow-emergency) + (ekp--dp-relax-emergency + demerits backptrs rests gaps hyphen-counts + fitness-classes i k prev-dem + (- line-pixel ideal) end-with-hyphenp + prev-hyphen-count))) + (setq k (1+ k)))))))) + ;; Extract solution (nil when end unreachable in the strict pass) + (when (aref demerits n) + (let ((breaks (ekp--dp-trace-breaks backptrs n))) + (list :rests (mapcar (lambda (b) (aref rests b)) breaks) + :gaps (mapcar (lambda (b) (aref gaps b)) breaks) + :breaks breaks + :cost (aref demerits n) + :line-count (length breaks)))))) -(defun ekp--leading-space-width (i boxes-types boxes-widths) - "Compute total width of leading space boxes starting at position I. -Returns 0 if box at I is not a space box." - (let ((n (length boxes-types)) - (width 0) - (pos i)) - (while (and (< pos n) - (let ((box-type (aref boxes-types pos))) - (and box-type (eq (car box-type) 'space)))) - (cl-incf width (aref boxes-widths pos)) - (cl-incf pos)) - width)) - -(defun ekp--trailing-space-width (k boxes-types boxes-widths) - "Compute total width of trailing space boxes ending before position K. -K is the exclusive end position (break point). -Returns 0 if box at K-1 is not a space box." - (let ((width 0) - (pos (1- k))) - (while (and (>= pos 0) - (let ((box-type (aref boxes-types pos))) - (and box-type (eq (car box-type) 'space)))) - (cl-incf width (aref boxes-widths pos)) - (cl-decf pos)) - width)) - -(defun ekp--dp-line-metrics (para i k glues-types ideal-prefixs min-prefixs max-prefixs) - "Compute line metrics for boxes I to K using PARA's stored glue params. -Returns (ideal-pixel min-pixel max-pixel) excluding leading glue. -For first line (i=0): includes leading space widths (paragraph indentation). -For non-first lines (i>0): excludes leading space widths (line-break artifacts). -Always excludes trailing space widths." - (let* ((leading-glue-type (aref glues-types i)) - (boxes-types (ekp-para-boxes-types para)) - (boxes-widths (ekp-para-boxes-widths para)) - ;; For non-first lines, exclude leading space width (will be stripped) - ;; First line (i=0) keeps leading spaces for paragraph indentation - (leading-space-w (if (> i 0) - (ekp--leading-space-width i boxes-types boxes-widths) - 0)) - ;; Always exclude trailing space width (always stripped) - (trailing-space-w (ekp--trailing-space-width k boxes-types boxes-widths)) - (space-w (+ leading-space-w trailing-space-w))) - (list (- (aref ideal-prefixs k) (aref ideal-prefixs i) - (ekp--para-glue-ideal para leading-glue-type) - space-w) - (- (aref min-prefixs k) (aref min-prefixs i) - (ekp--para-glue-min para leading-glue-type) - space-w) - (- (aref max-prefixs k) (aref max-prefixs i) - (ekp--para-glue-max para leading-glue-type) - space-w)))) - -(defun ekp--dp-force-break (para i k arrays glues-types hyphen-positions ideal-prefixs hyphen-pixel line-pixel) - "Force a break at K-1 when no valid break found. Update ARRAYS. -Uses PARA's stored glue params for consistency." - (let* ((backptrs (nth 0 arrays)) - (demerits (nth 1 arrays)) - (rests (nth 2 arrays)) - (gaps (nth 3 arrays)) - (fitness-classes (nth 5 arrays)) - (line-counts (nth 6 arrays)) - (break-pos (1- k)) - (hyphenate-p (ekp--hyphenate-p hyphen-positions break-pos)) - (boxes-types (ekp-para-boxes-types para)) - (boxes-widths (ekp-para-boxes-widths para)) - ;; For non-first lines, exclude leading space width - (leading-space-w (if (> i 0) - (ekp--leading-space-width i boxes-types boxes-widths) - 0)) - ;; Always exclude trailing space width - (trailing-space-w (ekp--trailing-space-width k boxes-types boxes-widths)) - (space-w (+ leading-space-w trailing-space-w)) - (ideal-pixel (- (aref ideal-prefixs break-pos) - (aref ideal-prefixs i) - (ekp--para-glue-ideal para (aref glues-types i)) - space-w)) - (rest-pixel (- line-pixel ideal-pixel))) - (when hyphenate-p (cl-incf ideal-pixel hyphen-pixel)) - ;; Force break with high demerits - (aset demerits break-pos (+ ekp-forced-break-penalty (expt rest-pixel 2))) - (aset rests break-pos rest-pixel) - (aset backptrs break-pos i) - (aset fitness-classes break-pos 3) ; very loose - (aset line-counts break-pos (1+ (aref line-counts i))) - (aset gaps break-pos - (ekp--gaps-list (seq-drop (cl-subseq glues-types i break-pos) 1))))) - -(defun ekp--dp-compute-line-demerits (para j is-last end-with-hyphenp - ideal-pixel line-pixel - glues-types i k - prev-hyphen-count prev-fitness - &optional end-with-flaggedp) - "Compute line demerits using full K-P formula. -Uses PARA's stored glue params for consistent badness calculation. -END-WITH-FLAGGEDP indicates a forced break (very low/negative demerits). -Returns (demerits gaps fitness new-hyphen-count)." - (cond - ;; Flagged (forced) break: use negative penalty to ensure selection - (end-with-flaggedp - (let* ((result (ekp--line-badness-and-fitness - para ideal-pixel line-pixel - (seq-subseq glues-types i k))) - (line-gaps (plist-get result :gaps))) - ;; Use flagged penalty (negative = preferred) - (list ekp-flagged-penalty line-gaps 1 0))) - ;; Single word line - ((= j 0) - (let* ((badness (ekp--compute-badness (- line-pixel ideal-pixel) 1)) - (fitness 1) ; decent - (penalty (if end-with-hyphenp ekp-hyphen-penalty 0)) - (new-hyphen (if end-with-hyphenp 1 0)) - (dem (ekp--compute-demerits badness penalty prev-fitness fitness - end-with-hyphenp prev-hyphen-count))) - (list dem nil fitness new-hyphen))) - ;; Last line: minimal demerits if reasonably filled - (is-last - (let* ((fill-ratio (/ (float ideal-pixel) line-pixel)) - ;; Penalize if last line is too short - (badness (if (< fill-ratio ekp-last-line-min-ratio) - (* ekp-last-line-short-penalty (- 1.0 fill-ratio)) - 0)) - (dem (expt (+ ekp-line-penalty badness) 2))) - (list dem nil 1 0))) - ;; Normal line - (t - (let* ((result (ekp--line-badness-and-fitness - para ideal-pixel line-pixel - (seq-subseq glues-types i k))) - (badness (plist-get result :badness)) - (fitness (plist-get result :fitness)) - (line-gaps (plist-get result :gaps)) - (penalty (if end-with-hyphenp ekp-hyphen-penalty 0)) - (new-hyphen (if end-with-hyphenp (1+ prev-hyphen-count) 0)) - (dem (ekp--compute-demerits badness penalty prev-fitness fitness - end-with-hyphenp prev-hyphen-count))) - (list dem line-gaps fitness new-hyphen))))) +(defun ekp--dp-relax-emergency (demerits backptrs rests gaps hyphen-counts + fitness-classes i k prev-dem rest + end-with-hyphenp prev-hyphen-count) + "Record an emergency (over/underfull single-box) break at K from I. +REST is line-pixel minus the line's ideal width (may be negative). +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 nil) + (aset fitness-classes k 3) + (aset hyphen-counts k + (if end-with-hyphenp (1+ prev-hyphen-count) 0))))) (defun ekp--dp-trace-breaks (backptrs n) "Trace optimal break points from BACKPTRS array." @@ -717,173 +885,329 @@ Returns (demerits gaps fitness new-hyphen-count)." (while (> index 0) (let ((prev (aref backptrs index))) (if prev - (progn (push prev breaks) + (progn (when (> prev 0) (push prev breaks)) (setq index prev)) + ;; Defensive: should not happen (every position is reachable) (setq index (1- index))))) - (cdr breaks))) + breaks)) -(defun ekp--dp-trace-breaks-with-looseness (backptrs line-counts n target-lines - &optional alt-paths) - "Trace breaks, preferring paths with TARGET-LINES line count. -Used for looseness parameter support. -ALT-PATHS is a hash table mapping (position . line-count) to (backptr . demerits) -for alternative paths when looseness != 0." - (if (or (= ekp-looseness 0) (null alt-paths)) - (ekp--dp-trace-breaks backptrs n) - ;; Find path closest to target line count - (let* ((optimal-lines (aref line-counts n)) - (target (+ optimal-lines ekp-looseness)) - (best-path nil) - (best-diff most-positive-fixnum)) - ;; Search alt-paths for best match at position n - (maphash - (lambda (key value) - (when (= (car key) n) ; position = n (end) - (let* ((line-count (cdr key)) - (diff (abs (- line-count target)))) - (when (< diff best-diff) - (setq best-diff diff) - (setq best-path (cons line-count (car value))))))) ; (line-count . backptr) - alt-paths) - (if best-path - ;; Trace back using alt-paths - (ekp--dp-trace-alt-path alt-paths n (car best-path)) - ;; Fallback to optimal path - (ekp--dp-trace-breaks backptrs n))))) +;;;; Looseness: full (position × line-count) DP +;; +;; `ekp-looseness' asks for a paragraph with (optimal + looseness) +;; lines. The 1D DP only keeps the single best path per position, so +;; alternative line counts are lost. Here we keep the best path per +;; (position, line-count) state instead, then select the final state +;; whose line count is closest to the target. -(defun ekp--dp-trace-alt-path (alt-paths n target-lines) - "Trace alternative path from ALT-PATHS ending at N with TARGET-LINES." - (let ((breaks (list n)) - (index n) - (lines target-lines) - (max-iterations (* n 2))) ; Safety limit to prevent infinite loop - (while (and (> index 0) (> max-iterations 0)) - (let* ((key (cons index lines)) - (entry (gethash key alt-paths))) - (if entry - (let ((prev (car entry))) - (when (> prev 0) (push prev breaks)) - (setq index prev) - (cl-decf lines)) - ;; No entry found at current line count, give up - (setq index 0))) - (cl-decf max-iterations)) - (cdr breaks))) +(defun ekp--dp-cache-elisp-loose (para line-pixel) + "Elisp DP tracking all line counts, for `ekp-looseness' support. +Two passes like the 1D engine: strict first, then with emergency +breaks when no valid layout exists." + (let ((dp-result (or (ekp--dp-run-loose para line-pixel nil) + (ekp--dp-run-loose para line-pixel t)))) + (puthash line-pixel dp-result (ekp-para-dp-cache para)) + dp-result)) -(defun ekp--dp-store-cache (string line-pixel dp-result) - "Store DP-RESULT for STRING at LINE-PIXEL in para's dp-cache." - (let ((para (ekp--get-para string))) - (puthash line-pixel dp-result (ekp-para-dp-cache para)))) +(defun ekp--dp-run-loose (para line-pixel allow-emergency) + "One (position × line-count) DP pass. Returns dp-result or nil." + (let* ((boxes (ekp-para-boxes para)) + (n (length boxes)) + (hyphen-pixel (ekp-para-hyphen-pixel para)) + (hyphen-positions (ekp-para-hyphen-positions para)) + (ideal-prefixs (ekp-para-ideal-prefixs para)) + (min-prefixs (ekp-para-min-prefixs para)) + (max-prefixs (ekp-para-max-prefixs para)) + (glue-ideals (ekp-para-glue-ideals para)) + (glue-shrinks (ekp-para-glue-shrinks para)) + (glue-stretches (ekp-para-glue-stretches para)) + (lead-spaces (ekp-para-lead-spaces para)) + (trail-spaces (ekp-para-trail-spaces para)) + (params (ekp-para-glue-params para)) + (lws-stretch (plist-get params :lws-stretch)) + (mws-stretch (plist-get params :mws-stretch)) + (cws-stretch (plist-get params :cws-stretch)) + (lws-shrink (plist-get params :lws-shrink)) + (mws-shrink (plist-get params :mws-shrink)) + (cws-shrink (plist-get params :cws-shrink)) + ;; 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))) + (puthash (cons 0 0) (vector 0.0 nil 1 0 nil nil) states) + (push 0 (aref counts-at 0)) + (dotimes (i n) + (dolist (lc (aref counts-at i)) + (let* ((st (gethash (cons i lc) states)) + (prev-dem (aref st 0)) + (prev-fitness (aref st 2)) + (prev-hyphen-count (aref st 3)) + (ip-i (aref ideal-prefixs i)) + (mn-i (aref min-prefixs i)) + (mx-i (aref max-prefixs i)) + (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))) + (lead-space (aref lead-spaces i)) + (k (1+ i))) + (catch 'break + (while (<= k n) + (let* ((is-last (= k n)) + (single-box (= k (1+ i))) + (end-with-hyphenp + (ekp--hyphenate-p hyphen-positions (1- k))) + (hyph-w (if end-with-hyphenp hyphen-pixel 0)) + (raw-ideal (- (aref ideal-prefixs k) ip-i lead-glue-ideal)) + (space-w (min raw-ideal + (+ lead-space (aref trail-spaces k)))) + (ideal (+ (- raw-ideal space-w) hyph-w)) + (minw (+ (- (aref min-prefixs k) mn-i lead-glue-min + space-w) + hyph-w)) + (maxw (+ (- (aref max-prefixs k) mx-i lead-glue-max + space-w) + hyph-w)) + (adjustment (- line-pixel ideal)) + candidate) + (cond + ((or (> minw line-pixel) + (and is-last (> ideal line-pixel))) + (when (and single-box allow-emergency) + (setq candidate + (list (+ (expt (+ ekp-line-penalty + ekp--infinite-badness) 2) + (* (float adjustment) adjustment)) + adjustment nil 3 + (if end-with-hyphenp + (1+ prev-hyphen-count) 0))) + (ekp--dp-loose-relax states counts-at k (1+ lc) i + prev-dem candidate)) + (throw 'break nil)) + ((or (<= minw line-pixel maxw) + (and is-last (<= ideal line-pixel))) + (setq candidate + (cond + (single-box + (let* ((badness (ekp--compute-badness adjustment 1)) + (penalty (if end-with-hyphenp + ekp-hyphen-penalty 0)) + (nh (if end-with-hyphenp + (1+ prev-hyphen-count) 0))) + (list (ekp--compute-demerits + badness penalty prev-fitness 1 + end-with-hyphenp prev-hyphen-count) + adjustment nil 1 nh))) + (is-last + (let* ((fill-ratio (/ (float ideal) line-pixel)) + (badness (if (< fill-ratio + ekp-last-line-min-ratio) + (* ekp-last-line-short-penalty + (- 1.0 fill-ratio)) + 0))) + (list (expt (+ ekp-line-penalty badness) 2) + adjustment nil 1 0))) + (t + (let* ((line-gaps (ekp--gaps-between para i k)) + (lcnt (nth 0 line-gaps)) + (mcnt (nth 1 line-gaps)) + (ccnt (nth 2 line-gaps)) + (flexibility + (if (> adjustment 0) + (+ (* lcnt lws-stretch) + (* mcnt mws-stretch) + (* ccnt cws-stretch)) + (+ (* lcnt lws-shrink) + (* mcnt mws-shrink) + (* ccnt cws-shrink)))) + (badness (ekp--compute-badness + adjustment flexibility)) + (fitness (ekp--compute-fitness-class + adjustment flexibility)) + (penalty (if end-with-hyphenp + ekp-hyphen-penalty 0)) + (nh (if end-with-hyphenp + (1+ prev-hyphen-count) 0))) + (list (ekp--compute-demerits + badness penalty prev-fitness fitness + 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 single-box allow-emergency) + (setq candidate + (list (+ (expt (+ ekp-line-penalty + ekp--infinite-badness) 2) + (* (float adjustment) adjustment)) + adjustment nil 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 k (1+ k)))))))) + ;; 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))) + (let ((optimal-count nil) (optimal-dem nil)) + (dolist (c end-counts) + (let ((dem (aref (gethash (cons n c) states) 0))) + (when (or (null optimal-dem) (< dem optimal-dem)) + (setq optimal-dem dem optimal-count c)))) + (let* ((target (+ optimal-count ekp-looseness)) + (best-count nil) (best-diff nil) (best-dem nil)) + (dolist (c end-counts) + (let ((diff (abs (- c target))) + (dem (aref (gethash (cons n c) states) 0))) + (when (or (null best-count) + (< diff best-diff) + (and (= diff best-diff) (< dem best-dem))) + (setq best-count c best-diff diff best-dem dem)))) + ;; Trace back through states + (let ((breaks nil) (lines-rests nil) (lines-gaps nil) + (pos n) (lc best-count)) + (while (> pos 0) + (let ((st (gethash (cons pos lc) states))) + (push pos breaks) + (push (aref st 4) lines-rests) + (push (aref st 5) lines-gaps) + (setq pos (or (aref st 1) 0) + lc (1- lc)))) + (list :rests lines-rests + :gaps lines-gaps + :breaks breaks + :cost best-dem + :line-count (length breaks)))))))) + +(defun ekp--dp-loose-relax (states counts-at k lines i prev-dem candidate) + "Relax state (K . LINES) with CANDIDATE from position I. +CANDIDATE is (DEM-DELTA REST GAPS FITNESS HYPHEN-COUNT)." + (let* ((key (cons k lines)) + (total (+ prev-dem (nth 0 candidate))) + (existing (gethash key states))) + (when (or (null existing) (< total (aref existing 0))) + (unless existing + (push lines (aref counts-at k))) + (puthash key (vector total i (nth 3 candidate) (nth 4 candidate) + (nth 1 candidate) (nth 2 candidate)) + states)))) + +;;;; DP Dispatch and C Module Integration (defun ekp--dp-get-cached (para line-pixel) "Get cached DP result from PARA for LINE-PIXEL, or nil." (gethash line-pixel (ekp-para-dp-cache para))) +(defun ekp--c-available-p () + "Return non-nil when the C module can be used for DP." + (and ekp-use-c-module + (boundp 'ekp-c-module-loaded) ekp-c-module-loaded + (fboundp 'ekp-c-break-with-arrays) + ;; looseness needs the (position × line-count) DP, Elisp only + (= ekp-looseness 0))) + +(defun ekp--c-sync-params () + "Push current K-P penalty settings to the C module." + (when (fboundp 'ekp-c-set-penalties) + (ekp-c-set-penalties ekp-line-penalty + ekp-hyphen-penalty + ekp-adjacent-fitness-penalty + (float ekp-last-line-min-ratio) + ekp-consecutive-hyphen-penalty + (float ekp-last-line-short-penalty)))) + (defun ekp-dp-cache (string line-pixel) "Compute optimal line breaks for STRING at LINE-PIXEL width. Uses Knuth-Plass dynamic programming with demerits. -If `ekp-use-c-module' is non-nil and C module is available, uses it." +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." (let* ((para (ekp--get-para string)) (cached (ekp--dp-get-cached para line-pixel))) - (if cached - cached - ;; Try C module first (if enabled and available) - (if (and ekp-use-c-module - (boundp 'ekp-c-module-loaded) ekp-c-module-loaded - (fboundp 'ekp-c-break-with-arrays)) - (ekp--dp-cache-via-c para string line-pixel) - ;; Fallback to Elisp implementation - (ekp--dp-cache-elisp para string line-pixel))))) + (cond + (cached cached) + ((ekp--c-available-p) + (ekp--dp-cache-via-c para line-pixel)) + (t (ekp--dp-cache-elisp para line-pixel))))) -(defun ekp--glue-type-to-int (type) - "Convert glue TYPE symbol to integer for C module. -0=nws, 1=lws, 2=mws, 3=cws." - (pcase type - ('lws 1) - ('mws 2) - ('cws 3) - (_ 0))) ; nws or nil - -(defun ekp--prepare-para-for-batch (para line-pixel) - "Prepare PARA data as vector for batch API at LINE-PIXEL. -Returns [ideal-prefix min-prefix max-prefix glue-ideals glue-shrinks - glue-stretches hyphen-positions hyphen-width line-width]. -Uses PARA's stored glue-params to ensure consistency with prefix arrays." - (let* ((ideal-prefixs (ekp-para-ideal-prefixs para)) - (min-prefixs (ekp-para-min-prefixs para)) - (max-prefixs (ekp-para-max-prefixs para)) - (glues-types (ekp-para-glues-types para)) - (hyphen-positions (ekp-para-hyphen-positions para)) - (hyphen-pixel (ekp-para-hyphen-pixel para)) - (n (length (ekp-para-boxes para))) - (glue-ideals (make-vector n 0)) - (glue-shrinks (make-vector n 0)) - (glue-stretches (make-vector n 0))) - ;; Use para's stored glue params, not global variables - (dotimes (i n) - (let ((type (aref glues-types i))) - (aset glue-ideals i (ekp--para-glue-ideal para type)) - (aset glue-shrinks i (ekp--para-glue-shrink para type)) - (aset glue-stretches i (ekp--para-glue-stretch para type)))) - (vector ideal-prefixs min-prefixs max-prefixs - glue-ideals glue-shrinks glue-stretches - hyphen-positions hyphen-pixel line-pixel))) - -(defun ekp--store-batch-result (para line-pixel breaks cost) - "Store batch result (BREAKS, COST) into PARA's dp-cache for LINE-PIXEL. -Computes rests and gaps from breaks using PARA's stored glue params." - (let* ((glues-types (ekp-para-glues-types para)) - (ideal-prefixs (ekp-para-ideal-prefixs para)) - (hyphen-positions (ekp-para-hyphen-positions para)) - (hyphen-pixel (ekp-para-hyphen-pixel para)) - (start 0) - lines-rests lines-gaps) +(defun ekp--lines-data-from-breaks (para line-pixel breaks) + "Compute (RESTS . GAPS) lists for BREAKS, matching the DP's metrics." + (let ((start 0) rests gapss) (dolist (end breaks) - (let* ((leading-glue-type (aref glues-types start)) - (end-with-hyphenp (ekp--hyphenate-p hyphen-positions (1- end))) - (ideal-pixel (- (aref ideal-prefixs end) - (aref ideal-prefixs start) - (ekp--para-glue-ideal para leading-glue-type)))) - (when end-with-hyphenp - (cl-incf ideal-pixel hyphen-pixel)) - (push (- line-pixel ideal-pixel) lines-rests) - (push (ekp--gaps-list - (seq-drop (cl-subseq glues-types start end) 1)) - lines-gaps) - (setq start end))) - (let ((dp-result (list :rests (nreverse lines-rests) - :gaps (nreverse lines-gaps) - :breaks breaks - :cost cost - :line-count (length breaks)))) - (puthash line-pixel dp-result (ekp-para-dp-cache para)) - dp-result))) + (push (- line-pixel (ekp--line-ideal-pixel para start end)) rests) + (push (if (or (= end (1+ start)) + (= end (length (ekp-para-boxes para)))) + nil + (ekp--gaps-between para start end)) + gapss) + (setq start end)) + (cons (nreverse rests) (nreverse gapss)))) + +(defun ekp--store-c-result (para line-pixel breaks cost) + "Store a C-module result (BREAKS, COST) into PARA's dp-cache." + (let* ((data (ekp--lines-data-from-breaks para line-pixel breaks)) + (dp-result (list :rests (car data) + :gaps (cdr data) + :breaks breaks + :cost cost + :line-count (length breaks)))) + (puthash line-pixel dp-result (ekp-para-dp-cache para)) + dp-result)) + +(defun ekp--prepare-para-for-c (para line-pixel) + "Prepare PARA data as an 11-element vector for the C batch API." + (vector (ekp-para-ideal-prefixs para) + (ekp-para-min-prefixs para) + (ekp-para-max-prefixs para) + (ekp-para-glue-ideals para) + (ekp-para-glue-shrinks para) + (ekp-para-glue-stretches para) + (ekp-para-hyphen-positions para) + (ekp-para-hyphen-pixel para) + line-pixel + (ekp-para-lead-spaces para) + (ekp-para-trail-spaces para))) + +(defun ekp--dp-cache-via-c (para line-pixel) + "Compute breaks using the C module with PARA's precomputed arrays. +The C module receives all font-dependent data from Elisp; it only +runs the pure DP. Falls back to Elisp when the C call fails." + (ekp--c-sync-params) + (let* ((result (ekp-c-break-with-arrays + (ekp-para-ideal-prefixs para) + (ekp-para-min-prefixs para) + (ekp-para-max-prefixs para) + (ekp-para-glue-ideals para) + (ekp-para-glue-shrinks para) + (ekp-para-glue-stretches para) + (ekp-para-hyphen-positions para) + (ekp-para-hyphen-pixel para) + line-pixel + (ekp-para-lead-spaces para) + (ekp-para-trail-spaces para))) + (c-breaks (car result)) + (c-cost (cdr result))) + (if (null c-breaks) + (ekp--dp-cache-elisp para line-pixel) + (ekp--store-c-result para line-pixel c-breaks c-cost)))) (defun ekp--dp-cache-batch (strings line-pixel) - "Compute DP for multiple STRINGS in parallel using C batch API. -Returns list of dp-results in same order as STRINGS. -Only processes strings that aren't already cached." + "Compute DP for multiple STRINGS in parallel using 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)) (needs-compute '()) ; list of (index . para) (results (make-vector (length strings) nil))) - ;; Check which paras need computation (cl-loop for para in paras for i from 0 for cached = (ekp--dp-get-cached para line-pixel) do (if cached (aset results i cached) (push (cons i para) needs-compute))) - ;; If all cached, return immediately (if (null needs-compute) (append results nil) - ;; Prepare batch input for uncached paras + (ekp--c-sync-params) (let* ((needs-compute (nreverse needs-compute)) (batch-input (vconcat (mapcar (lambda (ip) - (ekp--prepare-para-for-batch (cdr ip) line-pixel)) + (ekp--prepare-para-for-c (cdr ip) line-pixel)) needs-compute))) (batch-results (ekp-c-break-batch batch-input))) - ;; Process results (cl-loop for ip in needs-compute for j from 0 for idx = (car ip) @@ -891,208 +1215,27 @@ Only processes strings that aren't already cached." for res = (aref batch-results j) for breaks = (car res) for cost = (cdr res) - do (if breaks - (aset results idx - (ekp--store-batch-result para line-pixel breaks cost)) - ;; C failed, fallback to Elisp - (aset results idx - (ekp--dp-cache-elisp para (ekp-para-string para) line-pixel))))) + do (aset results idx + (if breaks + (ekp--store-c-result para line-pixel breaks cost) + ;; C failed, fallback to Elisp + (ekp--dp-cache-elisp para line-pixel))))) (append results nil)))) -(defun ekp--dp-cache-via-c (para string line-pixel) - "Compute breaks using C module with Elisp's pre-computed prefix arrays. -C module receives ALL font-dependent data from Elisp's para struct: -prefix sums, glue values, hyphen info. C only does pure DP. -Uses PARA's stored glue-params for consistency with cached prefix arrays." - (ignore string) ; Use para's data instead - (let* ((ideal-prefixs (ekp-para-ideal-prefixs para)) - (min-prefixs (ekp-para-min-prefixs para)) - (max-prefixs (ekp-para-max-prefixs para)) - (glues-types (ekp-para-glues-types para)) - (hyphen-positions (ekp-para-hyphen-positions para)) - (hyphen-pixel (ekp-para-hyphen-pixel para)) - (n (length (ekp-para-boxes para))) - ;; Build glue value arrays for C using para's stored params - (glue-ideals (make-vector n 0)) - (glue-shrinks (make-vector n 0)) - (glue-stretches (make-vector n 0))) - ;; Extract glue values from para's stored params, not global variables - (dotimes (i n) - (let ((type (aref glues-types i))) - (aset glue-ideals i (ekp--para-glue-ideal para type)) - (aset glue-shrinks i (ekp--para-glue-shrink para type)) - (aset glue-stretches i (ekp--para-glue-stretch para type)))) - ;; Call C module with all Elisp-computed arrays - (let* ((result (ekp-c-break-with-arrays - ideal-prefixs - min-prefixs - max-prefixs - glue-ideals - glue-shrinks - glue-stretches - hyphen-positions - hyphen-pixel - line-pixel)) - (c-breaks (car result)) - (c-cost (cdr result))) - (if (null c-breaks) - ;; C module failed, fallback to Elisp - (ekp--dp-cache-elisp para string line-pixel) - ;; C module succeeded: compute rests and gaps from breaks - (let* ((breaks c-breaks) - (start 0) - lines-rests lines-gaps) - ;; Compute rests and gaps for each line using para's stored params - (dolist (end breaks) - (let* ((leading-glue-type (aref glues-types start)) - (end-with-hyphenp (ekp--hyphenate-p hyphen-positions (1- end))) - (ideal-pixel (- (aref ideal-prefixs end) - (aref ideal-prefixs start) - (ekp--para-glue-ideal para leading-glue-type)))) - (when end-with-hyphenp - (cl-incf ideal-pixel hyphen-pixel)) - (push (- line-pixel ideal-pixel) lines-rests) - (push (ekp--gaps-list - (seq-drop (cl-subseq glues-types start end) 1)) - lines-gaps) - (setq start end))) - (let ((dp-result (list :rests (nreverse lines-rests) - :gaps (nreverse lines-gaps) - :breaks breaks - :cost c-cost - :line-count (length breaks)))) - (puthash line-pixel dp-result (ekp-para-dp-cache para)) - dp-result)))))) - -(defun ekp--dp-cache-elisp (para string line-pixel) - "Pure Elisp DP implementation." - (ignore string) ; para already contains all needed data - ;; Get data directly from struct (O(1) access) - (let* ((glues-types (ekp-para-glues-types para)) - (boxes (ekp-para-boxes para)) - (hyphen-pixel (ekp-para-hyphen-pixel para)) - (hyphen-positions (ekp-para-hyphen-positions para)) - (flagged-positions (ekp-para-flagged-positions para)) - (n (length boxes)) - (ideal-prefixs (ekp-para-ideal-prefixs para)) - (min-prefixs (ekp-para-min-prefixs para)) - (max-prefixs (ekp-para-max-prefixs para)) - (arrays (ekp--dp-init-arrays n)) - (backptrs (nth 0 arrays)) - (demerits (nth 1 arrays)) - (rests (nth 2 arrays)) - (gaps (nth 3 arrays)) - (hyphen-counts (nth 4 arrays)) - (fitness-classes (nth 5 arrays)) - (line-counts (nth 6 arrays)) - (alt-paths (nth 7 arrays)) ; for looseness support - ;; Track best demerits at end for threshold pruning - (best-end-demerits nil)) - ;; Main DP loop: for each reachable position i - (dotimes (i (1+ n)) - (when (aref demerits i) - ;; Threshold pruning: skip if demerits already too high - (let ((should-process - (or (<= ekp-threshold-factor 0) - (null best-end-demerits) - (<= (aref demerits i) - (* best-end-demerits (1+ ekp-threshold-factor)))))) - (when should-process - (let ((prev-hyphen-count (aref hyphen-counts i)) - (prev-fitness (aref fitness-classes i)) - (prev-line-count (aref line-counts i))) - (catch 'break - ;; Try extending line to each position k > i - (dotimes (j (- n i)) - (let* ((k (+ i j 1)) - (is-last (= k n)) - ;; k is the break position (exclusive), k-1 is the last box index - (end-with-hyphenp - (ekp--hyphenate-p hyphen-positions (1- k))) - (end-with-flaggedp - (ekp--flagged-p flagged-positions (1- k))) - (metrics (ekp--dp-line-metrics - para i k glues-types - ideal-prefixs min-prefixs max-prefixs)) - (ideal-pixel (nth 0 metrics)) - (min-pixel (nth 1 metrics)) - (max-pixel (nth 2 metrics))) - ;; Add hyphen width if line ends with hyphen - (when end-with-hyphenp - (cl-incf ideal-pixel hyphen-pixel) - (cl-incf max-pixel hyphen-pixel) - (cl-incf min-pixel hyphen-pixel)) - ;; Check if line is too long (but allow flagged breaks anyway) - (when (and (not end-with-flaggedp) - (or (> min-pixel line-pixel) - (and is-last (> ideal-pixel line-pixel)))) - (when (null (aref demerits (1- k))) - (ekp--dp-force-break - para i k arrays glues-types hyphen-positions - ideal-prefixs hyphen-pixel line-pixel)) - (throw 'break nil)) - ;; Valid break point: compute demerits - ;; Flagged breaks are always valid - (when (or end-with-flaggedp - (<= min-pixel line-pixel max-pixel) - (and is-last (<= ideal-pixel line-pixel))) - (pcase-let ((`(,dem ,line-gaps ,fitness ,new-hyphen) - (ekp--dp-compute-line-demerits - para j is-last end-with-hyphenp - ideal-pixel line-pixel glues-types i k - prev-hyphen-count prev-fitness - end-with-flaggedp))) - (let ((total-dem (+ (aref demerits i) dem)) - (new-line-count (1+ prev-line-count))) - ;; Update optimal path (always) - (when (or (null (aref demerits k)) - (< total-dem (aref demerits k))) - (aset rests k (- line-pixel ideal-pixel)) - (aset gaps k line-gaps) - (aset demerits k total-dem) - (aset backptrs k i) - (aset fitness-classes k fitness) - (aset hyphen-counts k new-hyphen) - (aset line-counts k new-line-count) - ;; Update best end demerits for threshold pruning - (when (= k n) - (when (or (null best-end-demerits) - (< total-dem best-end-demerits)) - (setq best-end-demerits total-dem)))) - ;; Track alternative paths for looseness (if enabled) - (when alt-paths - (let* ((key (cons k new-line-count)) - (existing (gethash key alt-paths))) - (when (or (null existing) - (< total-dem (cdr existing))) - (puthash key (cons i total-dem) alt-paths))))))))))))))) - ;; Extract optimal solution - (let* ((breaks (ekp--dp-trace-breaks-with-looseness - backptrs line-counts n (aref line-counts n) alt-paths)) - (lines-rests (mapcar (lambda (i) (aref rests i)) breaks)) - (lines-gaps (mapcar (lambda (i) (aref gaps i)) breaks)) - (dp-result (list :rests lines-rests - :gaps lines-gaps - :breaks breaks - :cost (aref demerits n) - :line-count (aref line-counts n)))) - (puthash line-pixel dp-result (ekp-para-dp-cache para)) - dp-result))) - (defun ekp-dp-data (string line-pixel &optional key) - "Return the data plist of dp cache. If KEY is non-nil, -return the value of KEY in plist." + "Return the dp cache plist for STRING at LINE-PIXEL. +If KEY is non-nil, return the value of KEY in the plist." (let ((data (ekp-dp-cache string line-pixel))) (if key (plist-get data key) data))) (defun ekp-total-cost (string line-pixel) - "Return the COST of kp algorithm." + "Return the total demerits of the K-P solution." (ekp-dp-data string line-pixel :cost)) (defun ekp-line-breaks (string line-pixel) - "Return the break points of kp algorithm." + "Return the break points of the K-P solution." (ekp-dp-data string line-pixel :breaks)) ;;; Line Glue Distribution @@ -1115,7 +1258,9 @@ Returns ((latin-adj . latin-extra) (mix-adj . mix-extra) (cjk-adj . cjk-extra)). (mix-change (if stretch-p (plist-get params :mws-stretch) (plist-get params :mws-shrink))) - (cjk-change (if stretch-p (plist-get params :cws-stretch) 0)) + (cjk-change (if stretch-p + (plist-get params :cws-stretch) + (plist-get params :cws-shrink))) ;; Results (latin-adj 0) (latin-extra 0) (mix-adj 0) (mix-extra 0) @@ -1139,10 +1284,20 @@ Returns ((latin-adj . latin-extra) (mix-adj . mix-extra) (cjk-adj . cjk-extra)). (setq remaining 0)) (setq mix-adj mix-change) (setq remaining (- remaining mix-capacity))))) - ;; Finally to CJK gaps - (when (and (> remaining 0) (> cjk-gaps 0)) - (setq cjk-adj (/ remaining cjk-gaps)) - (setq cjk-extra (% remaining cjk-gaps))) + ;; Finally to CJK gaps. When stretching, CJK gaps absorb any + ;; leftover beyond their nominal capacity (emergency spreading); + ;; when shrinking they never shrink below their limit. + (when (> remaining 0) + (if stretch-p + (when (> cjk-gaps 0) + (setq cjk-adj (/ remaining cjk-gaps)) + (setq cjk-extra (% remaining cjk-gaps))) + (let ((cjk-capacity (* cjk-gaps cjk-change))) + (if (< remaining cjk-capacity) + (when (> cjk-gaps 0) + (setq cjk-adj (/ remaining cjk-gaps)) + (setq cjk-extra (% remaining cjk-gaps))) + (setq cjk-adj cjk-change))))) (list (cons latin-adj latin-extra) (cons mix-adj mix-extra) (cons cjk-adj cjk-extra)))) @@ -1167,83 +1322,93 @@ Returns list of pixel values for each glue. Uses PARA's stored glue params." (+ mix-adj (if (< mix-idx mix-extra) 1 0))) ('cws (cl-incf cjk-idx) (+ cjk-adj (if (< cjk-idx cjk-extra) 1 0))) - ('nws 0) (_ 0)))) - (if stretch-p (+ base adj) (- base adj)))) + (max 0 (if stretch-p (+ base adj) (- base adj))))) glues-types))) (defun ekp--line-glue-single-box (line-pixel box-width hyphen-p hyphen-pixel) - "Compute glues for a single-box line." + "Compute glues for a single-box line. +The trailing filler is clamped at 0 for overfull boxes." (let ((trailing (- line-pixel box-width (if hyphen-p hyphen-pixel 0)))) - (list 0 trailing))) + (list 0 (max 0 trailing)))) (defun ekp--line-glue-last-line (para glues-types ideal-pixel line-pixel) "Compute glues for last line (ragged right). Uses PARA's stored glue params." (append '(0) (mapcar (lambda (type) (ekp--para-glue-ideal para type)) glues-types) - (list (- line-pixel ideal-pixel)))) + (list (max 0 (- line-pixel ideal-pixel))))) (defun ekp--line-glue-normal (para glues-types rest-pixel gaps-list) "Compute glues for a normal (justified) line. Uses PARA's stored glue params." (if (= rest-pixel 0) - (append '(0) (mapcar (lambda (type) (ekp--para-glue-ideal para type)) glues-types) '(0)) + (append '(0) (mapcar (lambda (type) (ekp--para-glue-ideal para type)) + glues-types) + '(0)) (let* ((stretch-p (> rest-pixel 0)) (distribution (ekp--distribute-gap-adjustment para (abs rest-pixel) gaps-list stretch-p)) - (glue-pixels (ekp--compute-glue-pixels para glues-types distribution stretch-p))) + (glue-pixels (ekp--compute-glue-pixels + para glues-types distribution stretch-p))) (append '(0) glue-pixels '(0))))) (defun ekp-line-glues (string line-pixel) "Compute glue pixels for each line after breaking STRING at LINE-PIXEL. Returns vector of vectors, each inner vector is glue pixels for one line. -Each line's glues: [0 glue1 glue2 ... trailing-space]. -Uses the cached para's stored glue params for consistency." +Each line's glues: [0 glue1 glue2 ... trailing-space]." (let* ((para (ekp--get-para string)) - (boxes-widths (ekp--boxes-widths string)) - (boxes-num (length (ekp--boxes string))) - (glues-types (ekp--glues-types string)) - (hyphen-positions (ekp--hyphen-positions string)) - (ideal-prefixs (ekp--ideal-prefixs string)) - (max-prefixs (ekp--max-prefixs string)) + (boxes-num (length (ekp-para-boxes para))) + (glues-types (ekp-para-glues-types para)) + (hyphen-positions (ekp-para-hyphen-positions para)) (breaks (ekp-line-breaks string line-pixel)) (lines-rests (ekp-dp-data string line-pixel :rests)) (lines-gaps (ekp-dp-data string line-pixel :gaps)) - (hyphen-pixel (ekp--hyphen-pixel string)) + (hyphen-pixel (ekp-para-hyphen-pixel para)) (line-glues (make-vector (length breaks) nil)) (start 0)) (dotimes (i (length breaks)) (let* ((end (nth i breaks)) - (line-boxes-widths (cl-subseq boxes-widths start end)) - (line-glues-types (seq-drop (cl-subseq glues-types start end) 1)) + (line-glues-types (append (cl-subseq glues-types (1+ start) end) + nil)) (is-last (>= end boxes-num)) - ;; end is exclusive, end-1 is the last box index (hyphen-p (ekp--hyphenate-p hyphen-positions (1- end))) - (ideal-pixel (- (aref ideal-prefixs end) - (aref ideal-prefixs start) - (ekp--para-glue-ideal para (aref glues-types start)))) - (max-pixel (+ (- (aref max-prefixs end) - (aref max-prefixs start) - (ekp--para-glue-max para (aref glues-types start))) - (if hyphen-p hyphen-pixel 0))) + ;; DP-consistent metrics (space-box runs excluded, hyphen incl.) + (ideal-pixel (ekp--line-ideal-pixel para start end)) + (max-pixel (let* ((mx (ekp-para-max-prefixs para)) + (ip (ekp-para-ideal-prefixs para)) + (raw-ideal (- (aref ip end) (aref ip start) + (aref (ekp-para-glue-ideals para) + start))) + (space-w (min raw-ideal + (+ (aref (ekp-para-lead-spaces para) + start) + (aref (ekp-para-trail-spaces para) + end))))) + (+ (- (aref mx end) (aref mx start) + (+ (aref (ekp-para-glue-ideals para) start) + (aref (ekp-para-glue-stretches para) start)) + space-w) + (if hyphen-p hyphen-pixel 0)))) glue-list) (setq glue-list (cond ;; Single box: just trailing space - ((= 1 (length line-boxes-widths)) + ((= 1 (- end start)) (ekp--line-glue-single-box line-pixel - (aref line-boxes-widths 0) + (- ideal-pixel + (if hyphen-p hyphen-pixel 0)) hyphen-p hyphen-pixel)) ;; Last line: ragged right (is-last (ekp--line-glue-last-line para line-glues-types ideal-pixel line-pixel)) - ;; Forced break (line too short even at max stretch) + ;; Emergency underfull line (can't stretch to width): + ;; set glues to max and pad with trailing filler. ((< max-pixel line-pixel) (append '(0) (mapcar (lambda (type) (ekp--para-glue-max para type)) line-glues-types) - (list (- line-pixel max-pixel)))) + (list (max 0 (- line-pixel max-pixel))))) ;; Normal justified line (t (ekp--line-glue-normal para line-glues-types @@ -1253,6 +1418,8 @@ Uses the cached para's stored glue params for consistency." (setq start end))) line-glues)) +;;;; Rendering + (defun ekp--box-space-p (box) "Return non-nil if BOX is a whitespace-only box." (and box (not (string-empty-p box)) @@ -1278,91 +1445,44 @@ Uses the cached para's stored glue params for consistency." (error "Glues count (%d) must equal boxes count (%d) + 1" (1+ (length glues)) (length boxes))))) -(defun ekp--pixel-spacing-width (spacing) - "Extract pixel width from a SPACING created by `ekp-pixel-spacing'." - (if (string-empty-p spacing) - 0 - (let ((display (get-text-property 0 'display spacing))) - (if (and display (eq (car display) 'space)) - (let ((width-spec (plist-get (cdr display) :width))) - (if (listp width-spec) (car width-spec) (or width-spec 0))) - 0)))) - -(defun ekp--redistribute-extra-width (glues extra-width) - "Redistribute EXTRA-WIDTH across GLUES proportionally. -GLUES is a list of pixel spacing strings. Returns adjusted list. -The extra width is distributed to all glues except leading (first) glue." - (when (and glues (> extra-width 0)) - (let* ((inner-glues (butlast (cdr glues))) ; glues between boxes (not leading/trailing) - (n (length inner-glues))) - (if (= n 0) - ;; No inner glues, add all to trailing - (let* ((trailing (car (last glues))) - (old-width (ekp--pixel-spacing-width trailing)) - (new-width (+ old-width extra-width))) - (setf (car (last glues)) (ekp-pixel-spacing new-width))) - ;; Distribute across inner glues - (let ((per-glue (/ extra-width n)) - (remainder (% extra-width n)) - (idx 0)) - (setq glues - (cons (car glues) ; leading glue unchanged - (append - (mapcar - (lambda (g) - (let* ((old-w (ekp--pixel-spacing-width g)) - (extra (+ per-glue (if (< idx remainder) 1 0))) - (new-w (+ old-w extra))) - (cl-incf idx) - (ekp-pixel-spacing new-w))) - inner-glues) - (last glues)))))))) ; trailing glue unchanged - glues) - -(defun ekp--strip-line-spaces (line-boxes line-glues line-boxes-widths - &optional strip-leading strip-trailing) +(defun ekp--strip-line-spaces (line-boxes line-glues + &optional strip-leading strip-trailing) "Strip leading/trailing space boxes from LINE-BOXES based on flags. -STRIP-LEADING: if non-nil, strip leading space boxes (default: nil = keep). -STRIP-TRAILING: if non-nil, strip trailing space boxes (default: nil = keep). -Returns (stripped-boxes . adjusted-glues) with extra width redistributed. -LINE-BOXES-WIDTHS is the pixel widths corresponding to LINE-BOXES. -The removed space width is redistributed to remaining glues for proper justification." +STRIP-LEADING / STRIP-TRAILING: strip space boxes at that edge. +Returns (stripped-boxes . adjusted-glues). + +The stripped widths are NOT redistributed: the DP already excluded +these space-box runs from its line metrics, so the remaining boxes +plus distributed glues already fill the target width exactly." (let* ((boxes (append line-boxes nil)) - (glues (append line-glues nil)) - (widths (append line-boxes-widths nil)) - (removed-width 0)) ; Track total width of removed space boxes + (glues (append line-glues nil))) (when (> (length boxes) 0) ;; Strip trailing space boxes (if requested) (when strip-trailing (while (and boxes (ekp--box-space-p (car (last boxes)))) - ;; Accumulate width of removed space box - (cl-incf removed-width (car (last widths))) (setq boxes (butlast boxes)) - (setq widths (butlast widths)) - ;; Remove second-to-last glue (the one before the trailing space box) - ;; Keep the last glue which is trailing space for the line + ;; Remove second-to-last glue (the one before the trailing + ;; space box); keep the last glue (line's trailing filler). (when (> (length glues) 1) (setq glues (append (butlast (butlast glues)) (last glues)))))) ;; Strip leading space boxes (if requested) (when strip-leading (while (and boxes (ekp--box-space-p (car boxes))) - ;; Accumulate width of removed space box - (cl-incf removed-width (car widths)) (setq boxes (cdr boxes)) - (setq widths (cdr widths)) ;; Remove the second glue (the one after the leading glue) (when (> (length glues) 1) (setq glues (cons (car glues) (cddr glues))))))) - ;; Redistribute removed width to remaining glues for proper justification - (when (> removed-width 0) - (setq glues (ekp--redistribute-extra-width glues removed-width))) (cons (vconcat boxes) glues))) +(defun ekp--hyphen-for-box (box) + "Return a hyphen string styled like the end of BOX." + (let ((props (and (> (length box) 0) + (text-properties-at (1- (length box)) box)))) + (if props (apply #'propertize "-" props) "-"))) + (defun ekp--pixel-justify (string line-pixel) - "Justify single STRING to LINE-PIXEL." + "Justify single-paragraph STRING to LINE-PIXEL." (let* ((boxes (ekp--boxes string)) - (boxes-widths (ekp--boxes-widths string)) - (hyphen (ekp--hyphen-str string)) (breaks (ekp-line-breaks string line-pixel)) (num (length breaks)) (lines-glues (ekp-line-glues string line-pixel)) @@ -1371,41 +1491,49 @@ The removed space width is redistributed to remaining glues for proper justifica (dotimes (i num) (let* ((end (nth i breaks)) (line-boxes (cl-subseq boxes start end)) - (line-boxes-widths (cl-subseq boxes-widths start end)) (line-glues-raw (mapcar #'ekp-pixel-spacing (aref lines-glues i))) ;; Strip space boxes: - ;; - First line (i=0): keep leading spaces (paragraph indentation) - ;; - Other lines: strip leading spaces (line-break artifacts) + ;; - First line (i=0): keep leading spaces (indentation) + ;; - Other lines: strip leading spaces (break artifacts) ;; - All lines: strip trailing spaces (is-first-line (= i 0)) (stripped (ekp--strip-line-spaces line-boxes line-glues-raw - line-boxes-widths - (not is-first-line) ; strip-leading - t)) ; strip-trailing + (not is-first-line) + t)) (line-boxes (car stripped)) (line-glues (cdr stripped)) ;; Check if last box of this line needs hyphen - (last-box-idx (1- end)) (need-hyphen (and (< i (1- num)) ; not last line - (ekp--hyphenate-p hyphen-positions last-box-idx)))) + (ekp--hyphenate-p hyphen-positions (1- end))))) (when (and need-hyphen (> (length line-boxes) 0)) - (setf (aref line-boxes (1- (length line-boxes))) - (concat (aref line-boxes (1- (length line-boxes))) hyphen))) + (let ((last-idx (1- (length line-boxes)))) + (aset line-boxes last-idx + (concat (aref line-boxes last-idx) + (ekp--hyphen-for-box (aref line-boxes last-idx)))))) (when (> (length line-boxes) 0) (push (ekp--combine-glues-and-boxes line-glues line-boxes) strings)) (setq start end))) (mapconcat 'identity (nreverse strings) "\n"))) +(defun ekp--validate-width (line-pixel) + "Signal a user error unless LINE-PIXEL is a positive integer." + (unless (and (integerp line-pixel) (> line-pixel 0)) + (user-error "ekp: line width must be a positive integer, got %S" + line-pixel))) + (defun ekp-pixel-justify (string line-pixel) - "Justify multiline STRING to LINE-PIXEL. -When C module is available and enabled, uses parallel batch processing." + "Justify multiline STRING to LINE-PIXEL pixels. +Each newline-separated segment is treated as one paragraph. +When the C module is available, paragraphs are computed in parallel." + (unless (stringp string) + (signal 'wrong-type-argument (list 'stringp string))) + (ekp--validate-width line-pixel) (let* ((strs (split-string string "\n")) (non-blank-strs (cl-remove-if #'string-blank-p strs)) - (use-batch (and ekp-use-c-module - (boundp 'ekp-c-module-loaded) ekp-c-module-loaded + (use-batch (and (ekp--c-available-p) (fboundp 'ekp-c-break-batch) (> (length non-blank-strs) 1)))) ;; Pre-compute all DP results in parallel if using batch @@ -1420,11 +1548,18 @@ When C module is available and enabled, uses parallel batch processing." ;;; Optimal Width Search ;; -;; Uses ternary search with aggressive caching. -;; The key optimization: reuse box/glue preprocessing across all widths. +;; Ternary search over average demerits, refined with a local scan. +;; Note: cost as a function of width is not strictly unimodal (line +;; count changes cause jumps), so the result is a good local optimum; +;; the final neighborhood scan smooths out small non-unimodalities. (defun ekp--compute-avg-cost (strings pixel) "Compute average cost for STRINGS at PIXEL width." + ;; Batch all paragraphs through the C module in one call if possible. + (when (and (ekp--c-available-p) (fboundp 'ekp-c-break-batch)) + (let ((non-blank (cl-remove-if #'string-blank-p strings))) + (when (> (length non-blank) 1) + (ekp--dp-cache-batch non-blank pixel)))) (let ((total-cost 0) (count 0)) (dolist (s strings) @@ -1449,22 +1584,28 @@ Returns the pixel width with minimum average cost." (if (< cost1 cost2) (setq hi mid2) (setq lo mid1)))) - ;; Final linear scan over remaining 3 candidates - (let ((best-pixel lo) - (best-cost (ekp--compute-avg-cost strings lo))) - (dolist (p (list (1+ lo) hi)) - (when (<= p max-pixel) - (let ((cost (ekp--compute-avg-cost strings p))) - (when (< cost best-cost) - (setq best-cost cost - best-pixel p))))) + ;; Local scan around the ternary result to escape small + ;; non-unimodalities (cost jumps when the line count changes). + (let* ((center (/ (+ lo hi) 2)) + (best-pixel nil) + (best-cost nil)) + (cl-loop for p from (max min-pixel (- center 3)) + to (min max-pixel (+ center 3)) + for cost = (ekp--compute-avg-cost strings p) + when (or (null best-cost) (< cost best-cost)) + do (setq best-cost cost best-pixel p)) best-pixel))) (defun ekp-pixel-range-justify (string min-pixel max-pixel) "Find optimal width for STRING between MIN-PIXEL and MAX-PIXEL. -Returns (justified-text . optimal-pixel). -Uses ternary search for O(log n) width evaluations. -All preprocessing is cached via ekp--para-cache." +Returns (justified-text . optimal-pixel)." + (unless (stringp string) + (signal 'wrong-type-argument (list 'stringp string))) + (ekp--validate-width min-pixel) + (ekp--validate-width max-pixel) + (when (> min-pixel max-pixel) + (user-error "ekp: min-pixel (%d) must be <= max-pixel (%d)" + min-pixel max-pixel)) (let* ((strings (split-string string "\n")) ;; Pre-warm caches (_ (dolist (s strings) diff --git a/ekp_c/README.md b/ekp_c/README.md index b2ce10a..8ede685 100644 --- a/ekp_c/README.md +++ b/ekp_c/README.md @@ -1,6 +1,11 @@ # EKP C Dynamic Module -High-performance C implementation of the Knuth-Plass line breaking algorithm with multi-threaded parallel computation. +C implementation of the Knuth-Plass DP for emacs-kp (module version 1.1). + +The division of labor: **Elisp owns all font-dependent data** +(tokenization, pixel measurement, glue values, prefix sums); the C +module runs only the O(n²) dynamic program. This keeps the two engines +byte-identical in output while making the hot loop native. ## Architecture @@ -8,112 +13,94 @@ High-performance C implementation of the Knuth-Plass line breaking algorithm wit ekp_c/ ├── ekp_module.h # Core data structures and API declarations ├── ekp.c # Emacs module entry point (emacs_module_init) -├── ekp_kp.c # Knuth-Plass DP algorithm + global state -├── ekp_hyphen.c # Liang hyphenation with thread-safe caching -├── ekp_paragraph.c # Text tokenization and box/glue construction -├── ekp_thread_pool.c # Work-stealing thread pool -└── Makefile # Build system +├── ekp_kp.c # Knuth-Plass DP + two-pass emergency strategy +├── ekp_thread_pool.c # Thread pool (parallelism across paragraphs) +├── ekp_hyphen.c # Liang hyphenation (experimental path only) +├── ekp_paragraph.c # C-side tokenization (experimental path only) +└── Makefile ``` +Parallelism model: the DP for one paragraph is sequential (each +position depends on all earlier ones), so the thread pool parallelizes +across **paragraphs** via `ekp-c-break-batch` — the correct granularity, +with zero synchronization in the inner loop. + ## Building ```bash cd ekp_c -make +make # → ekp.dylib (macOS) / ekp.so (Linux) / ekp.dll (Windows) ``` -Requirements: -- C11 compiler (clang, gcc) -- Emacs with dynamic module support (27.1+) -- pthread library - -### Build Options +Requirements: C11 compiler, Emacs 27.1+ headers, pthreads. ```bash make DEBUG=1 # Debug build with sanitizers -make clean # Remove build artifacts -make info # Show build configuration -make test # Run basic tests in Emacs +make clean +make info ``` -## Performance Optimizations - -### 1. Multi-threaded Processing -- 8-thread pool for parallel DP candidate evaluation -- Wavefront parallelization for large paragraphs (>100 boxes) -- Lock-free work queue with condition variables - -### 2. O(1) Range Queries -- Prefix sum arrays for ideal/min/max line widths -- Eliminates repeated summation in inner DP loop - -### 3. Fast Hyphenation -- FNV-1a hash for O(1) pattern lookup -- Thread-safe LRU cache (4096 entries) -- Read-write locks for concurrent access - -### 4. Memory Layout -- Flat, cache-friendly data structures -- Parallel arrays for boxes, glues, widths -- Minimal allocations in hot paths - -## API - -### Initialization +## API (as used by ekp.el) ```elisp -(ekp-c-init) ; Initialize module with thread pool -(ekp-c-cleanup) ; Release all resources -(ekp-c-version) ; => "1.0" -(ekp-c-thread-count) ; => 8 +(ekp-c-init) ; init global state + thread pool +(ekp-c-version) ; => "1.1" — checked by ekp-c-module-load +(ekp-c-thread-count) ; => 8 +(ekp-c-cleanup) + +;; Synced automatically by ekp.el before every call: +(ekp-c-set-penalties LINE HYPHEN FITNESS LAST-RATIO + &optional CONSEC-HYPHEN LAST-SHORT) + +;; Single paragraph (11 args): +(ekp-c-break-with-arrays IDEAL-PREFIX MIN-PREFIX MAX-PREFIX + GLUE-IDEALS GLUE-SHRINKS GLUE-STRETCHES + HYPHEN-POS HYPHEN-WIDTH LINE-WIDTH + LEAD-SPACES TRAIL-SPACES) +;; => (BREAKS . TOTAL-COST) + +;; Many paragraphs in parallel: vector of 11-element vectors +(ekp-c-break-batch PARAGRAPHS) ; => vector of (BREAKS . COST) ``` -### Hyphenation +`LEAD-SPACES` / `TRAIL-SPACES` are the space-box run widths that the +Elisp renderer strips from line edges; the DP excludes them from line +metrics so both layers agree exactly (new in 1.1). + +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. + +### Experimental: self-contained C path + +`ekp-c-break-lines` tokenizes and hyphenates in C +(`ekp_paragraph.c`, `ekp_hyphen.c`) with a measurement callback into +Emacs. ekp.el does **not** use this path; its tokenizer is a +simplified approximation of `ekp-split-to-boxes`. Kept for +experimentation. ```elisp -(ekp-c-load-hyphenator "/path/to/hyph_en_US.dic") ; => 0 (index) -(ekp-c-hyphenate 0 "hyphenation") ; => (2 5 7) +(ekp-c-load-hyphenator "/path/to/hyph_en_US.dic") ; => index +(ekp-c-hyphenate 0 "hyphenation") ; => (2 5) +(ekp-c-break-lines "text..." 0 600 #'string-pixel-width) ``` -### Line Breaking +## Performance -```elisp -(ekp-c-break-lines - "Your paragraph text here" - 0 ; hyphenator index - 600 ; line width in pixels - #'string-pixel-width) ; measurement function +Measured with `tests/ekp-bench.el` (batch Emacs 30.2, Apple Silicon, +byte-compiled Elisp around the C calls, min of 3 cold-cache runs): -;; Returns: ((breaks...) . total-cost) -``` +| Case | Elisp engine (compiled) | C engine | +|:----------------------------|------------------------:|---------:| +| justify text-zh.txt w=200 | 96 ms | 57 ms | +| justify mixed text w=300 | 53 ms | 23 ms | +| range-justify zh 340–380 | 294 ms | 75 ms | +| range-justify mix 280–320 | 480 ms | 34 ms | +| DP only, text-zh w=400 | 15 ms | 1.3 ms | -### Parameters - -```elisp -;; Spacing: (lws-i lws+ lws- mws-i mws+ mws- cws-i cws+ cws-) -(ekp-c-set-spacing 7 3 2 5 2 1 0 2 0) - -;; Penalties: (line-penalty hyphen-penalty fitness-penalty last-line-ratio) -(ekp-c-set-penalties 10 50 100 0.5) -``` - -## Design Notes - -Following Linus's philosophy: - -1. **Data structures are the code** - Get box/glue layout right, algorithm follows naturally -2. **Simple thread model** - Fixed pool, no dynamic thread creation in hot path -3. **Minimal abstraction** - Direct array access, no virtual dispatch -4. **Fail fast** - Return NULL/nil on errors, let Emacs handle it - -## Benchmark - -Typical speedup vs pure Elisp implementation: - -| Paragraph Size | Elisp | C Module | Speedup | -|----------------|-------|----------|---------| -| 100 chars | 5ms | 0.3ms | 16x | -| 500 chars | 45ms | 2ms | 22x | -| 2000 chars | 350ms | 12ms | 29x | - -*Note: Actual performance depends on CPU, Emacs version, and text characteristics.* +The pure-DP speedup is ~12× (1.3 ms vs 15 ms); end-to-end gains are +smaller because tokenization, measurement and rendering stay in Elisp. +The C engine matters most for `range-justify` (many widths per text) +and multi-paragraph batches. diff --git a/ekp_c/ekp.c b/ekp_c/ekp.c index 6dd9564..6545e05 100644 --- a/ekp_c/ekp.c +++ b/ekp_c/ekp.c @@ -148,6 +148,10 @@ static emacs_value Fekp_c_set_penalties(emacs_env *env, ptrdiff_t nargs, ekp_global->hyphen_penalty = env->extract_integer(env, args[1]); ekp_global->fitness_penalty = env->extract_integer(env, args[2]); ekp_global->last_line_ratio = env->extract_float(env, args[3]); + if (nargs > 4) + ekp_global->consec_hyphen_penalty = env->extract_integer(env, args[4]); + if (nargs > 5) + ekp_global->last_line_short_penalty = env->extract_float(env, args[5]); return env->intern(env, "t"); } @@ -319,7 +323,7 @@ static emacs_value Fekp_c_break_with_arrays(emacs_env *env, ptrdiff_t nargs, { (void)data; - if (!ekp_global || nargs < 9) + if (!ekp_global || nargs < 11) return env->intern(env, "nil"); /* Get prefix array sizes (n+1 elements) */ @@ -336,11 +340,15 @@ static emacs_value Fekp_c_break_with_arrays(emacs_env *env, ptrdiff_t nargs, int32_t *glue_ideals = malloc(n * sizeof(int32_t)); int32_t *glue_shrinks = malloc(n * sizeof(int32_t)); int32_t *glue_stretches = malloc(n * sizeof(int32_t)); + int32_t *lead_spaces = malloc(prefix_len * sizeof(int32_t)); + int32_t *trail_spaces = malloc(prefix_len * sizeof(int32_t)); if (!ideal_prefix || !min_prefix || !max_prefix || - !glue_ideals || !glue_shrinks || !glue_stretches) { + !glue_ideals || !glue_shrinks || !glue_stretches || + !lead_spaces || !trail_spaces) { free(ideal_prefix); free(min_prefix); free(max_prefix); free(glue_ideals); free(glue_shrinks); free(glue_stretches); + free(lead_spaces); free(trail_spaces); return env->intern(env, "nil"); } @@ -349,6 +357,8 @@ static emacs_value Fekp_c_break_with_arrays(emacs_env *env, ptrdiff_t nargs, ideal_prefix[i] = env->extract_integer(env, env->vec_get(env, args[0], i)); min_prefix[i] = env->extract_integer(env, env->vec_get(env, args[1], i)); max_prefix[i] = env->extract_integer(env, env->vec_get(env, args[2], i)); + lead_spaces[i] = env->extract_integer(env, env->vec_get(env, args[9], i)); + trail_spaces[i] = env->extract_integer(env, env->vec_get(env, args[10], i)); } /* Extract glue arrays */ @@ -379,10 +389,12 @@ static emacs_value Fekp_c_break_with_arrays(emacs_env *env, ptrdiff_t nargs, glue_ideals, glue_shrinks, glue_stretches, n, hyph_pos, hyph_count > 0 ? (size_t)hyph_count : 0, - hyph_width, line_width); + hyph_width, line_width, + lead_spaces, trail_spaces); free(ideal_prefix); free(min_prefix); free(max_prefix); free(glue_ideals); free(glue_shrinks); free(glue_stretches); + free(lead_spaces); free(trail_spaces); free(hyph_pos); if (!result) @@ -415,7 +427,8 @@ static bool extract_paragraph_data( int32_t **ideal_prefix, int32_t **min_prefix, int32_t **max_prefix, int32_t **glue_ideals, int32_t **glue_shrinks, int32_t **glue_stretches, int32_t **hyph_pos, size_t *n, ptrdiff_t *hyph_count, - int32_t *hyph_width, int32_t *line_width) + int32_t *hyph_width, int32_t *line_width, + int32_t **lead_spaces, int32_t **trail_spaces) { ptrdiff_t prefix_len = env->vec_size(env, args[0]); if (prefix_len <= 1) @@ -429,11 +442,15 @@ static bool extract_paragraph_data( *glue_ideals = malloc(*n * sizeof(int32_t)); *glue_shrinks = malloc(*n * sizeof(int32_t)); *glue_stretches = malloc(*n * sizeof(int32_t)); + *lead_spaces = malloc(prefix_len * sizeof(int32_t)); + *trail_spaces = malloc(prefix_len * sizeof(int32_t)); if (!*ideal_prefix || !*min_prefix || !*max_prefix || - !*glue_ideals || !*glue_shrinks || !*glue_stretches) { + !*glue_ideals || !*glue_shrinks || !*glue_stretches || + !*lead_spaces || !*trail_spaces) { free(*ideal_prefix); free(*min_prefix); free(*max_prefix); free(*glue_ideals); free(*glue_shrinks); free(*glue_stretches); + free(*lead_spaces); free(*trail_spaces); return false; } @@ -441,6 +458,8 @@ static bool extract_paragraph_data( (*ideal_prefix)[i] = env->extract_integer(env, env->vec_get(env, args[0], i)); (*min_prefix)[i] = env->extract_integer(env, env->vec_get(env, args[1], i)); (*max_prefix)[i] = env->extract_integer(env, env->vec_get(env, args[2], i)); + (*lead_spaces)[i] = env->extract_integer(env, env->vec_get(env, args[9], i)); + (*trail_spaces)[i] = env->extract_integer(env, env->vec_get(env, args[10], i)); } for (size_t i = 0; i < *n; i++) { @@ -498,11 +517,15 @@ static emacs_value Fekp_c_break_batch(emacs_env *env, ptrdiff_t nargs, int32_t **all_glue_sh = calloc(para_count, sizeof(int32_t *)); int32_t **all_glue_st = calloc(para_count, sizeof(int32_t *)); int32_t **all_hyph = calloc(para_count, sizeof(int32_t *)); + int32_t **all_lead = calloc(para_count, sizeof(int32_t *)); + int32_t **all_trail = calloc(para_count, sizeof(int32_t *)); if (!inputs || !all_ideal || !all_min || !all_max || - !all_glue_i || !all_glue_sh || !all_glue_st || !all_hyph) { + !all_glue_i || !all_glue_sh || !all_glue_st || !all_hyph || + !all_lead || !all_trail) { free(inputs); free(all_ideal); free(all_min); free(all_max); free(all_glue_i); free(all_glue_sh); free(all_glue_st); free(all_hyph); + free(all_lead); free(all_trail); return env->intern(env, "nil"); } @@ -510,9 +533,9 @@ static emacs_value Fekp_c_break_batch(emacs_env *env, ptrdiff_t nargs, for (ptrdiff_t p = 0; p < para_count; p++) { emacs_value para_vec = env->vec_get(env, args[0], p); - /* Extract 9 arguments from this paragraph's vector */ - emacs_value para_args[9]; - for (int i = 0; i < 9; i++) { + /* Extract 11 arguments from this paragraph's vector */ + emacs_value para_args[11]; + for (int i = 0; i < 11; i++) { para_args[i] = env->vec_get(env, para_vec, i); } @@ -524,15 +547,17 @@ static emacs_value Fekp_c_break_batch(emacs_env *env, ptrdiff_t nargs, &all_ideal[p], &all_min[p], &all_max[p], &all_glue_i[p], &all_glue_sh[p], &all_glue_st[p], &all_hyph[p], &n, &hyph_count, - &hyph_width, &line_width)) { + &hyph_width, &line_width, + &all_lead[p], &all_trail[p])) { /* Cleanup on failure */ for (ptrdiff_t j = 0; j < p; j++) { free(all_ideal[j]); free(all_min[j]); free(all_max[j]); free(all_glue_i[j]); free(all_glue_sh[j]); free(all_glue_st[j]); - free(all_hyph[j]); + free(all_hyph[j]); free(all_lead[j]); free(all_trail[j]); } free(inputs); free(all_ideal); free(all_min); free(all_max); free(all_glue_i); free(all_glue_sh); free(all_glue_st); free(all_hyph); + free(all_lead); free(all_trail); return env->intern(env, "nil"); } @@ -547,6 +572,8 @@ static emacs_value Fekp_c_break_batch(emacs_env *env, ptrdiff_t nargs, inputs[p].hyphen_count = hyph_count > 0 ? (size_t)hyph_count : 0; inputs[p].hyphen_width = hyph_width; inputs[p].line_width = line_width; + inputs[p].lead_spaces = all_lead[p]; + inputs[p].trail_spaces = all_trail[p]; } /* Process all paragraphs in parallel */ @@ -556,10 +583,11 @@ static emacs_value Fekp_c_break_batch(emacs_env *env, ptrdiff_t nargs, for (ptrdiff_t p = 0; p < para_count; p++) { free(all_ideal[p]); free(all_min[p]); free(all_max[p]); free(all_glue_i[p]); free(all_glue_sh[p]); free(all_glue_st[p]); - free(all_hyph[p]); + free(all_hyph[p]); free(all_lead[p]); free(all_trail[p]); } free(inputs); free(all_ideal); free(all_min); free(all_max); free(all_glue_i); free(all_glue_sh); free(all_glue_st); free(all_hyph); + free(all_lead); free(all_trail); if (!results) return env->intern(env, "nil"); @@ -646,13 +674,16 @@ Arguments are: LWS-IDEAL LWS-STRETCH LWS-SHRINK\n\ LWS = Latin Word Space, MWS = Mixed, CWS = CJK.\n\n\ (fn LWS-I LWS-+ LWS-- MWS-I MWS-+ MWS-- CWS-I CWS-+ CWS--)"); - defun(env, "ekp-c-set-penalties", 4, 4, Fekp_c_set_penalties, + defun(env, "ekp-c-set-penalties", 4, 6, 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\ FITNESS-PENALTY: penalty for adjacent line tightness mismatch (default 100)\n\ -LAST-LINE-RATIO: minimum fill ratio for last line (default 0.5)\n\n\ -(fn LINE-PENALTY HYPHEN-PENALTY FITNESS-PENALTY LAST-LINE-RATIO)"); +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\n\ +(fn LINE-PENALTY HYPHEN-PENALTY FITNESS-PENALTY LAST-LINE-RATIO \ +&optional CONSEC-HYPHEN-PENALTY LAST-LINE-SHORT-PENALTY)"); defun(env, "ekp-c-hyphenate", 2, 2, Fekp_c_hyphenate, "Get hyphenation positions for WORD using HYPHENATOR-INDEX.\n\ @@ -666,7 +697,7 @@ MEASURE-FUNC: function that takes a string and returns pixel width\n\n\ Returns (BREAKS . TOTAL-COST) where BREAKS is list of break positions.\n\n\ (fn STRING HYPHENATOR-INDEX LINE-WIDTH MEASURE-FUNC)"); - defun(env, "ekp-c-break-with-arrays", 9, 9, Fekp_c_break_with_arrays, + defun(env, "ekp-c-break-with-arrays", 11, 11, Fekp_c_break_with_arrays, "Break lines using Elisp's pre-computed prefix arrays (preferred API).\n\n\ IDEAL-PREFIX: vector of ideal width prefix sums (n+1 elements)\n\ MIN-PREFIX: vector of min width prefix sums (n+1 elements)\n\ @@ -676,10 +707,13 @@ GLUE-SHRINKS: vector of glue shrink amounts (n elements)\n\ GLUE-STRETCHES: vector of glue stretch amounts (n elements)\n\ HYPHEN-POS: vector of hyphenable box indices (sorted)\n\ HYPHEN-WIDTH: pixel width of hyphen character\n\ -LINE-WIDTH: target line width in pixels\n\n\ +LINE-WIDTH: target line width in pixels\n\ +LEAD-SPACES: vector (n+1) of space-box run widths starting at box i\n\ +TRAIL-SPACES: vector (n+1) of space-box run widths ending at box k-1\n\n\ Returns (BREAKS . TOTAL-COST) where BREAKS is list of box indices.\n\ This API ensures C uses Elisp's font-dependent measurements.\n\n\ -(fn IDEAL-PREFIX MIN-PREFIX MAX-PREFIX GLUE-IDEALS GLUE-SHRINKS GLUE-STRETCHES HYPHEN-POS HYPHEN-WIDTH LINE-WIDTH)"); +(fn IDEAL-PREFIX MIN-PREFIX MAX-PREFIX GLUE-IDEALS GLUE-SHRINKS GLUE-STRETCHES \ +HYPHEN-POS HYPHEN-WIDTH LINE-WIDTH LEAD-SPACES TRAIL-SPACES)"); defun(env, "ekp-c-version", 0, 0, Fekp_c_version, "Return EKP C module version string."); @@ -689,9 +723,10 @@ This API ensures C uses Elisp's font-dependent measurements.\n\n\ defun(env, "ekp-c-break-batch", 1, 1, Fekp_c_break_batch, "Break multiple paragraphs in parallel.\n\n\ -PARAGRAPHS: vector of paragraph data, each element is a vector of 9 items:\n\ +PARAGRAPHS: vector of paragraph data, each element is a vector of 11 items:\n\ [ideal-prefix min-prefix max-prefix glue-ideals glue-shrinks\n\ - glue-stretches hyphen-positions hyphen-width line-width]\n\n\ + glue-stretches hyphen-positions hyphen-width line-width\n\ + lead-spaces trail-spaces]\n\n\ Returns vector of (BREAKS . COST) for each paragraph.\n\ This is the high-performance API for multi-paragraph processing.\n\n\ (fn PARAGRAPHS)"); diff --git a/ekp_c/ekp_kp.c b/ekp_c/ekp_kp.c index 7ed72e4..396a13f 100644 --- a/ekp_c/ekp_kp.c +++ b/ekp_c/ekp_kp.c @@ -25,17 +25,22 @@ ekp_state_t *ekp_global = NULL; #define FITNESS_LOOSE 2 #define FITNESS_VERY_LOOSE 3 +/* Infinite badness: capped at 10000 like TeX (and the Elisp engine). + * NOT EKP_INFINITY: a badness-10000 line is terrible but still usable, + * matching ekp--compute-badness in ekp.el exactly. */ +#define EKP_BADNESS_INF 10000.0 + /* Badness computation */ static inline double compute_badness(int32_t adjustment, int32_t flexibility) { if (adjustment == 0) return 0.0; if (flexibility <= 0) - return EKP_INFINITY; + return EKP_BADNESS_INF; double ratio = (double)adjustment / flexibility; double badness = 100.0 * fabs(ratio * ratio * ratio); - return badness > 10000.0 ? EKP_INFINITY : badness; + return badness > EKP_BADNESS_INF ? EKP_BADNESS_INF : badness; } /* Fitness classification */ @@ -58,7 +63,8 @@ static inline uint8_t compute_fitness(int32_t adjustment, int32_t flexibility) static inline double compute_demerits(double badness, int32_t penalty, uint8_t prev_fitness, uint8_t curr_fitness, bool end_hyphen, int prev_hyphen_count, - int line_penalty, int fitness_penalty) + int line_penalty, int fitness_penalty, + int consec_hyphen_penalty) { /* Base: (line_penalty + badness)² */ double base = (line_penalty + badness); @@ -75,7 +81,7 @@ static inline double compute_demerits(double badness, int32_t penalty, /* Consecutive hyphen penalty (quadratic growth) */ if (end_hyphen) { int count = prev_hyphen_count + 1; - base += 100.0 * count * count; + base += (double)consec_hyphen_penalty * count * count; } return base; @@ -121,26 +127,40 @@ typedef struct { const int32_t *ideal_prefix; const int32_t *min_prefix; const int32_t *max_prefix; - + /* Glue arrays (nullable) */ const int32_t *glue_ideals; const int32_t *glue_shrinks; const int32_t *glue_stretches; - + /* Hyphen info */ const int32_t *hyphen_positions; size_t hyphen_count; int32_t hyphen_width; - + + /* Space-box run widths (nullable, n+1 elements each): + * lead_spaces[i] = width of space-box run starting at box i + * trail_spaces[k] = width of space-box run ending at box k-1 + * These runs are stripped by the renderer, so line metrics + * exclude them (matching ekp.el). */ + const int32_t *lead_spaces; + const int32_t *trail_spaces; + /* Dimensions */ size_t n; /* box count */ int32_t line_width; - + /* K-P parameters */ int line_penalty; int hyphen_penalty; int fitness_penalty; double last_line_ratio; + int consec_hyphen_penalty; + double last_line_short_penalty; + + /* Two-pass strategy: strict K-P first; emergency single-box + * breaks only in the second pass (when no valid layout exists). */ + bool allow_emergency; } dp_input_t; /* @@ -171,6 +191,33 @@ static inline bool dp_is_hyphen(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, + int32_t rest, bool end_hyphen, + double *demerits, int32_t *backptrs, int32_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; + } +} + static void dp_process_position( const dp_input_t *in, size_t i, @@ -189,86 +236,86 @@ static void dp_process_position( { size_t n = in->n; int32_t line_width = in->line_width; - + /* Get leading glue for line starting at i */ int32_t lead_ideal = (in->glue_ideals && i < n) ? in->glue_ideals[i] : 0; int32_t lead_shrink = (in->glue_shrinks && i < n) ? in->glue_shrinks[i] : 0; int32_t lead_stretch = (in->glue_stretches && i < n) ? in->glue_stretches[i] : 0; - + int32_t lead_space = in->lead_spaces ? in->lead_spaces[i] : 0; + /* Try extending to each position k > i */ for (size_t k = i + 1; k <= n; k++) { bool is_last = (k == n); + bool is_single_box = (k == i + 1); bool end_hyphen = dp_is_hyphen(in, k - 1); - - /* Line metrics from i to k (excluding leading glue) */ - int32_t ideal = in->ideal_prefix[k] - in->ideal_prefix[i] - lead_ideal; + int32_t hyph_w = end_hyphen ? in->hyphen_width : 0; + + /* Line metrics from i to k, excluding leading glue and the + * space-box runs the renderer strips (leading + trailing). */ + int32_t raw_ideal = in->ideal_prefix[k] - in->ideal_prefix[i] - lead_ideal; + int32_t space_w = lead_space + + (in->trail_spaces ? in->trail_spaces[k] : 0); + if (space_w > raw_ideal) + space_w = raw_ideal; + + int32_t ideal = raw_ideal - space_w + hyph_w; int32_t min_w = in->min_prefix[k] - in->min_prefix[i] - - (lead_ideal - lead_shrink); + (lead_ideal - lead_shrink) - space_w + hyph_w; int32_t max_w = in->max_prefix[k] - in->max_prefix[i] - - (lead_ideal + lead_stretch); - - /* Add hyphen width if needed */ - if (end_hyphen) { - ideal += in->hyphen_width; - min_w += in->hyphen_width; - max_w += in->hyphen_width; - } - - /* Too long? Also handle is_last && ideal > line_width. */ + (lead_ideal + lead_stretch) - space_w + hyph_w; + + /* Too long? (last line is never shrunk below its ideal) */ if (min_w > line_width || (is_last && ideal > line_width)) { - /* Force break if nothing else found */ - if (k > i + 1 && demerits[k - 1] >= EKP_INFINITY) { - int32_t prev_ideal = in->ideal_prefix[k - 1] - in->ideal_prefix[i] - lead_ideal; - int32_t rest = line_width - prev_ideal; - demerits[k - 1] = prev_dem + 10000.0 + (double)rest * rest; - backptrs[k - 1] = i; - rest_pixels[k - 1] = rest; - fitness[k - 1] = FITNESS_VERY_LOOSE; - hyphen_counts[k - 1] = 0; - line_counts[k - 1] = prev_lines + 1; - } + if (is_single_box && in->allow_emergency) + dp_relax_emergency(in, i, k, prev_dem, prev_hyph, prev_lines, + line_width - ideal, end_hyphen, + demerits, backptrs, rest_pixels, + fitness, hyphen_counts, line_counts); break; /* No point trying longer lines */ } - + /* Valid break? */ bool valid = (min_w <= line_width && max_w >= line_width) || (is_last && ideal <= line_width); - - if (!valid) + + if (!valid) { + /* Rigid underfull single box: emergency-record so the + * position after it stays reachable (2nd pass only). */ + if (is_single_box && in->allow_emergency) + dp_relax_emergency(in, i, k, prev_dem, prev_hyph, prev_lines, + line_width - ideal, end_hyphen, + demerits, backptrs, rest_pixels, + fitness, hyphen_counts, line_counts); continue; - + } + /* Compute demerits */ int32_t adjustment = line_width - ideal; int32_t flexibility = (adjustment > 0) ? (max_w - ideal) : (ideal - min_w); - - /* Single-box line: use minimum flexibility of 1 */ - bool is_single_box = (k == i + 1); - if (is_single_box && flexibility <= 0) - flexibility = 1; - + double badness; uint8_t fit; double dem; - - /* Single-box line: use fixed flexibility=1, fitness=decent - * This must come BEFORE is_last check to match Elisp behavior - * where single-box lines use consistent calculation */ + + /* 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; - + int penalty = end_hyphen ? in->hyphen_penalty : 0; dem = prev_dem + compute_demerits(badness, penalty, prev_fit, fit, end_hyphen, prev_hyph, in->line_penalty, - in->fitness_penalty); + in->fitness_penalty, + in->consec_hyphen_penalty); } else if (is_last) { /* Last line: minimal penalty if reasonably filled */ double fill_ratio = (double)ideal / line_width; if (fill_ratio < in->last_line_ratio) { - badness = 50.0 * (1.0 - fill_ratio); + badness = in->last_line_short_penalty * (1.0 - fill_ratio); } else { badness = 0.0; } @@ -278,15 +325,16 @@ static void dp_process_position( } else { badness = compute_badness(adjustment, flexibility); fit = compute_fitness(adjustment, flexibility); - + int penalty = end_hyphen ? in->hyphen_penalty : 0; dem = prev_dem + compute_demerits(badness, penalty, prev_fit, fit, end_hyphen, prev_hyph, in->line_penalty, - in->fitness_penalty); + in->fitness_penalty, + in->consec_hyphen_penalty); } - + /* Update if better */ if (dem < demerits[k]) { demerits[k] = dem; @@ -336,12 +384,19 @@ static void process_dp_range(void *arg) .hyphen_positions = p->hyphen_positions, .hyphen_count = p->hyphen_count, .hyphen_width = p->hyphen_width, + .lead_spaces = NULL, + .trail_spaces = NULL, .n = n, .line_width = work->line_width, .line_penalty = work->line_penalty, .hyphen_penalty = work->hyphen_penalty, .fitness_penalty = work->fitness_penalty, - .last_line_ratio = work->last_line_ratio + .last_line_ratio = work->last_line_ratio, + .consec_hyphen_penalty = + ekp_global ? ekp_global->consec_hyphen_penalty : 100, + .last_line_short_penalty = + ekp_global ? ekp_global->last_line_short_penalty : 50.0, + .allow_emergency = true }; /* Process each position in range */ @@ -545,7 +600,9 @@ ekp_result_t *ekp_break_with_prefixes( const int32_t *hyphen_positions, size_t hyphen_count, int32_t hyphen_width, - int32_t line_width) + int32_t line_width, + const int32_t *lead_spaces, + const int32_t *trail_spaces) { if (!ideal_prefix || !min_prefix || !max_prefix || n == 0 || line_width <= 0) return NULL; @@ -580,6 +637,8 @@ ekp_result_t *ekp_break_with_prefixes( int hp = ekp_global ? ekp_global->hyphen_penalty : 50; int fp = ekp_global ? ekp_global->fitness_penalty : 100; double last_ratio = ekp_global ? ekp_global->last_line_ratio : 0.5; + int chp = ekp_global ? ekp_global->consec_hyphen_penalty : 100; + double llsp = ekp_global ? ekp_global->last_line_short_penalty : 50.0; /* Create unified input structure */ dp_input_t in = { @@ -592,33 +651,58 @@ ekp_result_t *ekp_break_with_prefixes( .hyphen_positions = hyphen_positions, .hyphen_count = hyphen_count, .hyphen_width = hyphen_width, + .lead_spaces = lead_spaces, + .trail_spaces = trail_spaces, .n = n, .line_width = line_width, .line_penalty = lp, .hyphen_penalty = hp, .fitness_penalty = fp, - .last_line_ratio = last_ratio + .last_line_ratio = last_ratio, + .consec_hyphen_penalty = chp, + .last_line_short_penalty = llsp, + .allow_emergency = false }; - /* DP: for each valid start, try all ends */ - for (size_t i = 0; i < n; i++) { - if (demerits[i] >= EKP_INFINITY) - continue; - - dp_process_position(&in, i, - demerits[i], - fitness[i], - hyph_counts[i], - line_counts[i], - demerits, - backptrs, - rest_pixels, - fitness, - hyph_counts, - line_counts); + /* Two passes: strict Knuth-Plass first; if the paragraph end is + * unreachable, rerun permitting emergency single-box breaks. + * Mirrors ekp--dp-cache-elisp. */ + for (int pass = 0; pass < 2; pass++) { + in.allow_emergency = (pass == 1); + + for (size_t i = 0; i <= n; i++) { + demerits[i] = EKP_INFINITY; + backptrs[i] = -1; + rest_pixels[i] = 0; + fitness[i] = FITNESS_DECENT; + hyph_counts[i] = 0; + line_counts[i] = 0; + } + demerits[0] = 0.0; + + /* DP: for each valid start, try all ends */ + for (size_t i = 0; i < n; i++) { + if (demerits[i] >= EKP_INFINITY) + continue; + + dp_process_position(&in, i, + demerits[i], + fitness[i], + hyph_counts[i], + line_counts[i], + demerits, + backptrs, + rest_pixels, + fitness, + hyph_counts, + line_counts); + } + + if (demerits[n] < EKP_INFINITY) + break; } - /* If no valid path found to end, return NULL to fallback to Elisp */ + /* Unreachable even with emergency breaks: cannot happen, but be safe */ if (demerits[n] >= EKP_INFINITY) { free(demerits); free(backptrs); free(rest_pixels); free(fitness); free(hyph_counts); free(line_counts); @@ -686,7 +770,8 @@ static void batch_worker(void *arg) in->glue_ideals, in->glue_shrinks, in->glue_stretches, in->n, in->hyphen_positions, in->hyphen_count, - in->hyphen_width, in->line_width); + in->hyphen_width, in->line_width, + in->lead_spaces, in->trail_spaces); } /* @@ -713,7 +798,8 @@ ekp_result_t **ekp_break_batch(ekp_batch_input_t *inputs, size_t count) in->glue_ideals, in->glue_shrinks, in->glue_stretches, in->n, in->hyphen_positions, in->hyphen_count, - in->hyphen_width, in->line_width); + in->hyphen_width, in->line_width, + in->lead_spaces, in->trail_spaces); } return results; } @@ -729,7 +815,8 @@ ekp_result_t **ekp_break_batch(ekp_batch_input_t *inputs, size_t count) in->glue_ideals, in->glue_shrinks, in->glue_stretches, in->n, in->hyphen_positions, in->hyphen_count, - in->hyphen_width, in->line_width); + in->hyphen_width, in->line_width, + in->lead_spaces, in->trail_spaces); } return results; } @@ -781,6 +868,8 @@ int ekp_init(void) ekp_global->hyphen_penalty = 50; ekp_global->fitness_penalty = 100; ekp_global->last_line_ratio = 0.5; + ekp_global->consec_hyphen_penalty = 100; + ekp_global->last_line_short_penalty = 50.0; /* Create thread pool */ ekp_global->pool = ekp_pool_create(EKP_THREAD_POOL_SIZE); diff --git a/ekp_c/ekp_module.h b/ekp_c/ekp_module.h index 675ff82..f142a38 100644 --- a/ekp_c/ekp_module.h +++ b/ekp_c/ekp_module.h @@ -16,7 +16,7 @@ /* Version */ #define EKP_VERSION_MAJOR 1 -#define EKP_VERSION_MINOR 0 +#define EKP_VERSION_MINOR 1 /* Limits */ #define EKP_MAX_PATTERN_LEN 64 @@ -191,6 +191,8 @@ typedef struct { int hyphen_penalty; int fitness_penalty; double last_line_ratio; + int consec_hyphen_penalty; /* multiplier for consecutive hyphens */ + double last_line_short_penalty; /* multiplier for short last lines */ } ekp_state_t; /* Global state instance */ @@ -231,6 +233,10 @@ void ekp_result_destroy(ekp_result_t *r); * hyphen_count: length of hyphen_positions * hyphen_width: pixel width of hyphen character * line_width: target line width in pixels + * lead_spaces: (n+1 elements, nullable) width of the space-box run + * starting at box i; entry 0 must be 0 (indentation kept) + * trail_spaces: (n+1 elements, nullable) width of the space-box run + * ending at box k-1 */ ekp_result_t *ekp_break_with_prefixes( const int32_t *ideal_prefix, @@ -243,7 +249,9 @@ ekp_result_t *ekp_break_with_prefixes( const int32_t *hyphen_positions, size_t hyphen_count, int32_t hyphen_width, - int32_t line_width); + int32_t line_width, + const int32_t *lead_spaces, + const int32_t *trail_spaces); /* * Batch input for parallel processing @@ -260,6 +268,8 @@ typedef struct { size_t hyphen_count; int32_t hyphen_width; int32_t line_width; + const int32_t *lead_spaces; /* nullable, n+1 elements */ + const int32_t *trail_spaces; /* nullable, n+1 elements */ } ekp_batch_input_t; /* diff --git a/readme.md b/readme.md index 04380ef..81c2c61 100644 --- a/readme.md +++ b/readme.md @@ -2,119 +2,166 @@ [中文文档](./readme_zh.md) | [Developer Guide](./DEVELOPER.md) -Emacs-kp implements the Knuth-Plass optimal line breaking algorithm with full support for CJK (Chinese, Japanese, Korean) and Latin mixed text typesetting. - -## Demo - +Emacs-kp implements the Knuth-Plass optimal line breaking algorithm with +full support for CJK (Chinese, Japanese, Korean) and Latin mixed text +typesetting, entirely inside Emacs. ## Features -- **Optimal Line Breaking**: Uses Knuth-Plass algorithm for globally optimal paragraph layout. -- **CJK Support**: Full support for Chinese, Japanese, Korean with mixed Latin text. -- **Hyphenation**: Frank Liang's algorithm with language-specific dictionaries. -- **Text Properties Preserved**: Font faces, colors, and other Emacs text properties are maintained. -- **C Module Acceleration**: Optional multi-threaded C module for 16-29x speedup. -- **Automatic Font Handling**: Spacing parameters computed from actual font metrics. +- **Optimal line breaking** — the Knuth-Plass dynamic program finds the + globally optimal set of breaks for a paragraph, not greedy first-fit. +- **CJK support** — every CJK character is a breakable box; kinsoku rules + keep punctuation attached (`，。` never start a line, `「《` never end + one); dedicated inter-CJK and CJK↔Latin spacing. +- **Hyphenation** — Frank Liang's algorithm (the TeX algorithm) with 70+ + Hunspell pattern dictionaries bundled. +- **Pixel-accurate justification** — every justified line renders at + exactly the requested pixel width, using `display (space :width ...)` + properties; works with variable-width fonts. +- **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 + 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 + thread pool that processes paragraphs in parallel (see benchmarks). ---- +## Requirements -## User Guide +- Emacs **29.1+** (uses `string-pixel-width` and `object-intervals`) +- Optional, for the C module: a C11 compiler and pthreads -### Quick Start - -1. **Install Dependencies**: - Ensure you have a C compiler if you plan to use the C module (recommended for performance). - -2. **Configuration**: +## Quick Start ```elisp (add-to-list 'load-path "/path/to/emacs-kp") (require 'ekp) -;; Basic usage: justify text to 600 pixels width -(ekp-pixel-justify "Your paragraph text here..." 600) +;; Justify a paragraph to 600 pixels +(insert (ekp-pixel-justify "Your paragraph text here..." 600)) -;; Find optimal width in a range (returns (text . optimal-width)) +;; Find the best width in a range; returns (justified-text . width) (ekp-pixel-range-justify "Your text" 400 800) ``` -### Configuration +Multiline strings are treated as one paragraph per line; blank lines are +preserved. -#### Language Settings +### C module (recommended for long texts) -**`ekp-latin-lang`** (default: `"en_US"`) - -Primary Latin language for hyphenation. Supported languages are in `dictionaries/` directory: -- `en_US`, `en_GB` - English -- `de_DE` - German -- `fr` - French -- `es` - Spanish -- And many more... - -```elisp -(setq ekp-latin-lang "de_DE") +```bash +cd ekp_c && make # requires C11 compiler, produces ekp.dylib/.so/.dll ``` -#### Spacing Parameters +```elisp +(ekp-c-module-load) ; prints "ekp-c module loaded (version 1.1, N threads)" +``` -Use `ekp-param-set` to configure spacing (in pixels). If not set, defaults are computed automatically from font metrics. +Once loaded (and since `ekp-use-c-module` defaults to `t`), all +justification calls automatically use the C engine. The Elisp and C +engines produce **identical output**; Elisp is the always-available +fallback. If the module on disk is older than the Elisp code expects, +loading refuses with a message asking you to rebuild. + +## Configuration + +### Hyphenation language + +```elisp +(setq ekp-latin-lang "de_DE") ; default "en_US" +``` + +Any `dictionaries/hyph_.dic` works; short codes like `"de"` +resolve to the first matching dictionary. + +### Spacing parameters + +Three glue classes control spacing (all values in pixels): + +| Group | Between | +|:--------|:---------------------------| +| `lws-*` | two Latin words | +| `mws-*` | a Latin word and a CJK char| +| `cws-*` | two CJK characters | + +Each class has an ideal width, a maximum stretch and a maximum shrink: ```elisp (ekp-param-set lws-ideal lws-stretch lws-shrink mws-ideal mws-stretch mws-shrink cws-ideal cws-stretch cws-shrink) +;; e.g. (ekp-param-set 7 3 2 5 2 1 0 2 0) ``` -| Parameter Group | Description | -|:----------------|:------------| -| `lws-*` | Latin Word Space: between Latin words | -| `mws-*` | Mixed Word Space: between Latin and CJK | -| `cws-*` | CJK Word Space: between CJK characters | +- If you never call `ekp-param-set`, defaults are derived automatically + from the font of each string. +- Explicit parameters **persist** until you call `ekp-param-reset`, + which returns to automatic per-string defaults. -#### K-P Algorithm Parameters +### Algorithm parameters -| Variable | Default | Description | -|:---------|:--------|:------------| -| `ekp-line-penalty` | 10 | Base cost per line break | -| `ekp-hyphen-penalty` | 50 | Extra cost for hyphenated breaks | -| `ekp-adjacent-fitness-penalty` | 100 | Cost for inconsistent line tightness | -| `ekp-last-line-min-ratio` | 0.5 | Minimum fill ratio for last line | -| `ekp-looseness` | 0 | Target line count offset (±n lines) | +| Variable | Default | Meaning | +|:--------------------------------|:--------|:--------| +| `ekp-line-penalty` | 10 | Base cost per line; higher prefers fewer lines | +| `ekp-hyphen-penalty` | 50 | Cost of a hyphenated break (added as penalty²) | +| `ekp-adjacent-fitness-penalty` | 100 | Cost when adjacent lines differ in tightness by >1 class | +| `ekp-consecutive-hyphen-penalty`| 100 | Multiplier for runs of hyphenated lines (× count²) | +| `ekp-last-line-min-ratio` | 0.5 | Minimum fill ratio for the last line | +| `ekp-last-line-short-penalty` | 50 | Cost multiplier for a too-short last line | +| `ekp-looseness` | 0 | Target line count offset: +1 = one line more than optimal, −1 = one fewer | -### C Dynamic Module (Recommended) +All parameters take effect with both engines: the Elisp side syncs them +to the C module before every call. `ekp-looseness` is handled by a +dedicated Elisp path (the C module is bypassed automatically while it +is non-zero). -For large texts, the optional C module provides significant performance improvement through multi-threaded parallel computation. +### Caching -#### Building +Tokenization, measurement, and DP results are cached per paragraph. + +- `ekp-para-cache-limit` (default 256): max cached paragraphs; the + cache is flushed when the limit is reached. +- `M-x ekp-clear-caches` clears everything (use after changing fonts or + themes that affect glyph widths). + +## Performance + +Measured on the bundled sample texts (`tests/ekp-bench.el`), batch +Emacs 30.2, Apple Silicon; see DEVELOPER.md for methodology: + +| Case (text-zh.txt ≈ 3.6 KB) | Elisp (byte-compiled) | C module | +|:-----------------------------|----------------------:|---------:| +| justify, width 200px | 96 ms | 57 ms | +| optimal-width search 340–380 | 294 ms | 75 ms | +| DP only, width 400px | 15 ms | 1.3 ms | + +**Byte-compile the package** — the Elisp engine is ~10× faster +compiled. Both engines produce identical output; the C module pays +off most for optimal-width search and long multi-paragraph texts. + +## Known Limitations + +- Widths are computed from the string's own text properties. If the + destination buffer remaps faces (different `:height`, themes), widths + may differ; justify with the same properties you will display. +- One font is assumed per Latin/CJK script per paragraph when computing + spacing defaults; mixed-font paragraphs work but spacing defaults come + from the first font found. +- `ekp-pixel-range-justify` minimizes average demerits with a ternary + search plus a local scan; cost is not perfectly unimodal in width, so + the result is a very good, but not guaranteed global, optimum. +- In batch/tty Emacs, pixel widths degrade to character columns (the + full pipeline still works; useful for testing). + +## Testing ```bash -cd ekp_c -make +tests/run-tests.sh /path/to/emacs # 36 ERT tests, all batch-safe ``` -*Requirements: C11 compiler, Emacs 27.1+* - -#### Loading - -```elisp -(require 'ekp-utils) - -;; Load and initialize C module -(ekp-c-module-load) - -;; Optional: Load hyphenation dictionary for C module -(ekp-c-load-dictionary "en_US") -``` - -Once loaded, `ekp-use-c-module` defaults to `t`, and all justification functions will automatically use the C module. - ---- - -## Algorithm & Architecture - -For a detailed explanation of the internal architecture, algorithms, and API reference, please refer to the **[Developer Guide](./DEVELOPER.md)**. ## Credits -- **Core Algorithm**: ["Breaking Paragraphs into Lines"](https://gwern.net/doc/design/typography/tex/1981-knuth.pdf) by Donald E. Knuth and Michael F. Plass (1981) -- **Hyphenation**: Adapted from [Pyphen](https://github.com/Kozea/Pyphen), using Liang's algorithm +- **Core algorithm**: ["Breaking Paragraphs into Lines"](https://gwern.net/doc/design/typography/tex/1981-knuth.pdf) by Donald E. Knuth and Michael F. Plass (1981) +- **Hyphenation**: Frank Liang's algorithm, adapted from [Pyphen](https://github.com/Kozea/Pyphen) - **Dictionaries**: [Hunspell hyphenation patterns](https://github.com/Kozea/Pyphen) diff --git a/readme_zh.md b/readme_zh.md index 05dd68f..6b5e4f1 100644 --- a/readme_zh.md +++ b/readme_zh.md @@ -2,119 +2,148 @@ [English Documentation](./readme.md) | [开发者指南](./DEVELOPER_ZH.md) -Emacs-kp 实现了 Knuth-Plass 最优断行算法，并扩展支持 CJK（中日韩）与拉丁文混合排版。 - -## 演示 - +Emacs-kp 在 Emacs 内部完整实现了 Knuth-Plass 最优断行算法,支持中日韩 +(CJK)与拉丁文混合排版。 ## 特性 -- **全局最优断行**：使用 Knuth-Plass 算法寻找段落的全局最优布局。 -- **CJK 支持**：完美支持中日韩与拉丁文的混合排版。 -- **连字符断词**：使用 Frank Liang 算法和特定语言词典。 -- **属性保留**：排版后保留字体、颜色等所有 Emacs 文本属性。 -- **C 模块加速**：可选的多线程 C 模块提供 16-29 倍性能提升。 -- **自动字体处理**：根据实际字体度量自动计算间距参数。 +- **全局最优断行** — Knuth-Plass 动态规划求段落全局最优断点,而非贪心 + 首次适应。 +- **CJK 支持** — 每个 CJK 字符都是可断行的盒子;避头尾规则保证标点正确 + 附着(`,。` 不出现在行首,`「《` 不出现在行尾);汉字间距、中西文间距 + 独立可调。 +- **连字符断词** — Frank Liang 算法(TeX 同款),内置 70+ 种语言的 + Hunspell 词典。 +- **像素级两端对齐** — 每一行渲染宽度精确等于目标像素宽度(通过 + `display (space :width ...)` 属性实现),支持变宽字体。 +- **文本属性保留** — face、颜色等属性完整保留;断词插入的连字符继承所 + 在单词的样式。 +- **困难输入不丢内容** — 超长不可断 token(URL、窄栏长词)退化为紧急 + 断行而不是吞掉文本;任何输入都有输出。 +- **可选 C 模块** — 动态模块用 C 执行 DP,线程池并行处理多个段落(见 + 性能数据)。 ---- +## 环境要求 -## 用户指南 +- Emacs **29.1+**(依赖 `string-pixel-width` 与 `object-intervals`) +- 可选(C 模块):C11 编译器和 pthreads -### 快速开始 - -1. **安装依赖**： - 建议安装 C 编译器以构建高性能模块。 - -2. **配置与使用**： +## 快速开始 ```elisp (add-to-list 'load-path "/path/to/emacs-kp") (require 'ekp) -;; 基本用法：将文本按 600 像素宽度对齐 -(ekp-pixel-justify "这是一段测试文本..." 600) +;; 按 600 像素宽度两端对齐 +(insert (ekp-pixel-justify "这是一段测试文本..." 600)) -;; 范围对齐：寻找 400-800 像素范围内的最优宽度 +;; 在范围内寻找最优宽度,返回 (对齐文本 . 最优宽度) (ekp-pixel-range-justify "测试文本" 400 800) ``` -### 配置详情 +多行字符串按行分段处理,空行保留。 -#### 语言设置 +### C 模块(长文本推荐) -**`ekp-latin-lang`** (默认: `"en_US"`) - -用于断词的主要拉丁语言。支持的语言位于 `dictionaries/` 目录： -- `en_US`, `en_GB` - 英语 -- `de_DE` - 德语 -- `fr` - 法语 -- `es` - 西班牙语 -- 等等... - -```elisp -(setq ekp-latin-lang "de_DE") +```bash +cd ekp_c && make # 需要 C11 编译器,产出 ekp.dylib/.so/.dll ``` -#### 间距参数 +```elisp +(ekp-c-module-load) ; 显示 "ekp-c module loaded (version 1.1, N threads)" +``` -使用 `ekp-param-set` 配置间距（像素）。若不设置，将根据字体自动计算。 +加载后(`ekp-use-c-module` 默认为 `t`)所有排版调用自动走 C 引擎。 +Elisp 与 C 两个引擎的输出**完全一致**;Elisp 是永远可用的后备。若磁盘 +上的模块版本旧于 Elisp 代码的要求,加载会拒绝并提示重新编译。 + +## 配置 + +### 断词语言 + +```elisp +(setq ekp-latin-lang "de_DE") ; 默认 "en_US" +``` + +`dictionaries/hyph_.dic` 中的任意语言均可;`"de"` 这类短代码会解 +析到第一个匹配的词典。 + +### 间距参数 + +三类 glue 控制间距(单位均为像素): + +| 参数组 | 位置 | +|:-------|:-----| +| `lws-*` | 拉丁词之间 | +| `mws-*` | 拉丁词与 CJK 字符之间 | +| `cws-*` | CJK 字符之间 | + +每类包含理想宽度、最大拉伸、最大收缩: ```elisp (ekp-param-set lws-ideal lws-stretch lws-shrink mws-ideal mws-stretch mws-shrink cws-ideal cws-stretch cws-shrink) +;; 例如 (ekp-param-set 7 3 2 5 2 1 0 2 0) ``` -| 参数组 | 说明 | -|:-------|:-----| -| `lws-*` | 拉丁词间距 (Latin Word Space) | -| `mws-*` | 中西文间距 (Mixed Word Space) | -| `cws-*` | CJK 字符间距 (CJK Word Space) | +- 从不调用 `ekp-param-set` 时,参数按每个字符串的字体自动计算。 +- 显式设置的参数**持久生效**,直到调用 `ekp-param-reset` 恢复自动模式。 -#### K-P 算法参数 +### 算法参数 -| 变量 | 默认值 | 说明 | +| 变量 | 默认值 | 含义 | |:-----|:-------|:-----| -| `ekp-line-penalty` | 10 | 每行断行的基础惩罚 | -| `ekp-hyphen-penalty` | 50 | 连字符断词的惩罚 | -| `ekp-adjacent-fitness-penalty` | 100 | 相邻行松紧度不一致的惩罚 | -| `ekp-last-line-min-ratio` | 0.5 | 末行最小填充比例 | -| `ekp-looseness` | 0 | 目标行数偏移（±n 行） | +| `ekp-line-penalty` | 10 | 每行基础代价;越大越倾向少行 | +| `ekp-hyphen-penalty` | 50 | 连字符断词代价(以 penalty² 计入) | +| `ekp-adjacent-fitness-penalty` | 100 | 相邻行松紧等级相差 >1 的代价 | +| `ekp-consecutive-hyphen-penalty` | 100 | 连续断词行的代价系数(× 次数²) | +| `ekp-last-line-min-ratio` | 0.5 | 末行最小填充比例 | +| `ekp-last-line-short-penalty` | 50 | 末行过短的代价系数 | +| `ekp-looseness` | 0 | 目标行数偏移:+1 比最优多一行,−1 少一行 | -### C 动态模块 (推荐) +所有参数对两个引擎都生效:每次调用 C 之前 Elisp 会同步这些参数。 +`ekp-looseness` 由专门的 Elisp 路径处理(非零时自动绕过 C 模块)。 -对于长文本，建议使用 C 模块以获得显著的性能提升。 +### 缓存 -#### 构建 +分词、测宽和 DP 结果按段落缓存。 + +- `ekp-para-cache-limit`(默认 256):缓存段落数上限,超过后整体清空。 +- `M-x ekp-clear-caches` 清空所有缓存(更换字体或影响字宽的主题后使用)。 + +## 性能 + +基于内置示例文本(`tests/ekp-bench.el`)、batch Emacs 30.2、Apple +Silicon 测得;方法见 DEVELOPER_ZH.md: + +| 场景(text-zh.txt ≈ 3.6KB) | Elisp(字节编译) | C 模块 | +|:----------------------------|------------------:|-------:| +| 两端对齐,宽 200px | 96 ms | 57 ms | +| 最优宽度搜索 340–380 | 294 ms | 75 ms | +| 仅 DP,宽 400px | 15 ms | 1.3 ms | + +**请字节编译本包**——编译后 Elisp 引擎快约 10 倍。两引擎输出完全一 +致;C 模块在最优宽度搜索和长多段文本上收益最大。 + +## 已知限制 + +- 宽度按字符串自身的文本属性测量。若目标 buffer 重映射了 face(不同 + `:height`、主题),宽度可能有偏差;请用与显示时相同的属性做排版。 +- 计算默认间距时假定每段落的拉丁/CJK 各使用一种字体;混合字体段落可以 + 工作,但默认间距取自找到的第一个字体。 +- `ekp-pixel-range-justify` 用三分搜索加局部扫描最小化平均 demerits; + 代价关于宽度并非严格单峰,结果是很好的局部最优,不保证全局最优。 +- batch/tty 模式下像素宽度退化为字符列数(整条管线仍可工作,便于测试)。 + +## 测试 ```bash -cd ekp_c -make +tests/run-tests.sh /path/to/emacs # 36 个 ERT 测试,全部支持 batch ``` -*要求：C11 编译器，Emacs 27.1+* - -#### 加载 - -```elisp -(require 'ekp-utils) - -;; 加载并初始化 C 模块 -(ekp-c-module-load) - -;; 可选：为 C 模块加载断词字典 -(ekp-c-load-dictionary "en_US") -``` - -加载后，`ekp-use-c-module` 默认为 `t`，所有排版函数将自动使用 C 模块进行加速。 - ---- - -## 算法与架构 - -关于内部架构、算法细节和 API 参考的详细说明，请参阅 **[开发者指南](./DEVELOPER_ZH.md)**。 ## 致谢 - **核心算法**: ["Breaking Paragraphs into Lines"](https://gwern.net/doc/design/typography/tex/1981-knuth.pdf) by Donald E. Knuth and Michael F. Plass (1981) -- **断词算法**: 改编自 [Pyphen](https://github.com/Kozea/Pyphen)，使用 Liang 算法 +- **断词算法**: Frank Liang 算法,改编自 [Pyphen](https://github.com/Kozea/Pyphen) - **词典**: [Hunspell 断词模式](https://github.com/Kozea/Pyphen) diff --git a/tests/ekp-bench.el b/tests/ekp-bench.el new file mode 100644 index 0000000..1cc3cc0 --- /dev/null +++ b/tests/ekp-bench.el @@ -0,0 +1,80 @@ +;;; ekp-bench.el --- Benchmarks for EKP -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Performance benchmarks over the bundled sample texts. Run: +;; +;; # Pure Elisp engine +;; emacs -Q --batch -L . --eval '(setq ekp-use-c-module nil)' \ +;; -l tests/ekp-bench.el +;; +;; # C module engine (build ekp_c first) +;; emacs -Q --batch -L . \ +;; --eval '(progn (require (quote ekp)) (ekp-c-module-load))' \ +;; -l tests/ekp-bench.el +;; +;; In batch mode widths are measured in character columns, so the +;; numbers are engine-comparable but not identical to GUI timings. + +;;; Code: + +(require 'ekp) + +(defun ekp-bench--read (name) + (with-temp-buffer + (insert-file-contents + (expand-file-name name (expand-file-name "tests" (ekp-root-dir)))) + (buffer-string))) + +(defun ekp-bench-run (label thunk &optional n) + "Run THUNK N times (cold caches); report the fastest run." + (let ((n (or n 3)) (times nil)) + (dotimes (_ n) + (ekp-clear-caches) + (garbage-collect) + (let ((t0 (float-time))) + (funcall thunk) + (push (- (float-time) t0) times))) + (message "%-42s %8.1f ms (min of %d)" + label (* 1000 (apply #'min times)) n))) + +(let* ((zh (ekp-bench--read "text-zh.txt")) + (en (ekp-bench--read "text-en_US.txt")) + (mix (ekp-bench--read "text-zh-en_US.txt")) + (zh3 (string-join (list zh zh zh) "\n"))) + (message "== engine: %s ==" (if (and (boundp 'ekp-c-module-loaded) + ekp-c-module-loaded + ekp-use-c-module) + "C" "elisp")) + (ekp-bench-run "justify zh w=200" (lambda () (ekp-pixel-justify zh 200))) + (ekp-bench-run "justify zh w=400" (lambda () (ekp-pixel-justify zh 400))) + (ekp-bench-run "justify en w=200" (lambda () (ekp-pixel-justify en 200))) + (ekp-bench-run "justify en w=400" (lambda () (ekp-pixel-justify en 400))) + (ekp-bench-run "justify mix w=300" (lambda () (ekp-pixel-justify mix 300))) + (ekp-bench-run "justify zh3 w=400" (lambda () (ekp-pixel-justify zh3 400))) + (ekp-bench-run "range zh 340-380" + (lambda () (ekp-pixel-range-justify zh 340 380))) + (ekp-bench-run "range mix 280-320" + (lambda () (ekp-pixel-range-justify mix 280 320))) + (ekp-bench-run "para-create zh (all lines)" + (lambda () (dolist (s (split-string zh "\n")) + (unless (string-blank-p s) (ekp--get-para s))))) + ;; DP only: paragraphs pre-tokenized, fresh DP each round + (let ((paras (cl-remove-if #'string-blank-p (split-string zh "\n"))) + (times nil)) + (dolist (s paras) (ekp--get-para s)) + (dotimes (_ 3) + (dolist (s paras) + (clrhash (ekp-para-dp-cache (ekp--get-para s)))) + (garbage-collect) + (let ((t0 (float-time))) + (dolist (s paras) (ekp-dp-cache s 400)) + (push (- (float-time) t0) times))) + (message "%-42s %8.1f ms (min of 3)" "DP-only zh w=400 (paras cached)" + (* 1000 (apply #'min times))))) + +(message "bench done") + +(provide 'ekp-bench) + +;;; ekp-bench.el ends here diff --git a/tests/ekp-demo.el b/tests/ekp-demo.el new file mode 100644 index 0000000..154fe39 --- /dev/null +++ b/tests/ekp-demo.el @@ -0,0 +1,112 @@ +;;; ekp-demo.el --- Interactive demos for EKP -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Interactive, GUI-only demonstrations. Evaluate the file in a +;; graphical Emacs session, then run the forms in the comments. +;; Automated tests live in ekp-tests.el. + +;;; Code: + +(require 'ekp) + +(defun ekp-demo--file-content (file) + (with-temp-buffer + (insert-file-contents + (expand-file-name file (expand-file-name "tests" (ekp-root-dir)))) + (buffer-substring (point-min) (point-max)))) + +(defun ekp-demo-propertize (string properties &optional start end) + "Add PROPERTIES to a copy of STRING without clobbering existing ones." + (let* ((string (copy-sequence string)) + (start (or start 0)) + (end (or end (length string)))) + (while properties + (let ((prop (pop properties)) + (value (pop properties))) + (pcase prop + ('face (add-face-text-property start end value t string)) + ('display (add-display-text-property + start end (car value) (cadr value) string)) + (_ (put-text-property start end prop value string))))) + string)) + +(defun ekp-demo--pop-buffer (height &rest strings) + (declare (indent defun)) + (let ((buffer (pop-to-buffer "*ekp-demo*" + `(display-buffer-at-bottom + (window-height . ,(or height 10)))))) + (with-current-buffer buffer + (local-set-key "q" 'quit-window) + (let ((inhibit-read-only t)) + (erase-buffer) + (apply #'insert strings))) + buffer)) + +(defun ekp-demo-str (cjk latin &optional font) + "Load a test text (see tests/text-*.txt) with optional FONT face." + (let ((file (concat "text" + (and cjk (concat "-" cjk)) + (and latin (concat "-" latin)) + ".txt"))) + (if font + (ekp-demo-propertize (ekp-demo--file-content file) + `(face (:family ,font))) + (ekp-demo--file-content file)))) + +(defun ekp-demo-justify (cjk latin font pixel) + "Justify a sample text at PIXEL width and show it." + (setq ekp-latin-lang (or latin "en_US")) + (ekp-demo--pop-buffer 35 + (ekp-pixel-justify (ekp-demo-str cjk latin font) pixel))) + +(defun ekp-demo-range-justify (cjk latin font min max) + "Find the optimal width in [MIN, MAX] and show the result." + (setq ekp-latin-lang (or latin "en_US")) + (ekp-demo--pop-buffer 35 + (car (ekp-pixel-range-justify (ekp-demo-str cjk latin font) min max)))) + +;; (ekp-demo-justify nil "en_US" "Times New Roman" 699) +;; (ekp-demo-justify "zh" "en_US" "Cascadia Next SC" 666) +;; (ekp-demo-justify nil "de_DE" "Georgia" 666) +;; (ekp-demo-range-justify "zh" "en_US" nil 666 690) + +(defun ekp-demo-animate (min-pixel max-pixel &optional inc) + "Animate justification from MIN-PIXEL to MAX-PIXEL." + (let ((str (ekp-demo-str "zh" "en_US")) + (pixel-lst (number-sequence min-pixel max-pixel (or inc 1))) + (buf (get-buffer-create "*ekp-demo-animate*"))) + (save-window-excursion + (delete-other-windows) + (switch-to-buffer buf) + (with-current-buffer buf + (dolist (pixel pixel-lst) + (erase-buffer) + (insert (ekp-pixel-justify str pixel)) + (goto-char (point-min)) + (sit-for 0.00001)))))) + +;; (ekp-demo-animate 400 800 1) + +(defun ekp-demo-mixed-faces () + "Show that per-paragraph fonts and faces survive justification." + (let* ((str (ekp-demo-str "zh" "en_US")) + (lst (split-string str "\n" t))) + (setq lst (list + (ekp-demo-propertize + (ekp-demo-propertize (nth 0 lst) + '(face (:family "Comic Sans MS"))) + '(face (:height 1.3 :foreground "cyan")) 0 2) + (ekp-demo-propertize + (ekp-demo-propertize (nth 1 lst) + '(face (:family "Cascadia Next SC"))) + '(face (:height 1.3 :foreground "green")) 0 2))) + (ekp-clear-caches) + (ekp-demo--pop-buffer 30 + "\n" (ekp-pixel-justify (string-join lst "\n\n") 683)))) + +;; (ekp-demo-mixed-faces) + +(provide 'ekp-demo) + +;;; ekp-demo.el ends here diff --git a/tests/ekp-fuzz.el b/tests/ekp-fuzz.el new file mode 100644 index 0000000..0a805a0 --- /dev/null +++ b/tests/ekp-fuzz.el @@ -0,0 +1,71 @@ +;;; ekp-fuzz.el --- property-based stress test for ekp -*- lexical-binding: t; -*- + +(require 'ekp) +(require 'cl-lib) + +(ekp-c-module-load) +(unless ekp-c-module-loaded (error "C module required for parity fuzz")) + +(defvar fuzz--seed 42) +(defun fuzz--rand (n) ; deterministic LCG so failures are reproducible + (setq fuzz--seed (mod (+ (* fuzz--seed 1103515245) 12345) 2147483648)) + (mod fuzz--seed n)) + +(defconst fuzz--cjk "中文排版是门艺术需要考虑标点悬挂避头尾规则同时兼顾美观") +(defconst fuzz--words '("the" "quick" "hyphenation" "emergency" "extraordinary" + "a" "of" "supercalifragilisticexpialidocious" + "bcdfghjklmnpqrstvwxz" "word!" "(paren)" "don't" + "test," "end." "«quoted»" "naïve" "Ｆｕｌｌ" "１２３")) +(defconst fuzz--puncts '("，" "。" "、" "《" "》" "「" "」" "！" "？")) + +(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) + ;; latin word + ((or 0 1 2 3) (push (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)))) + (push (substring fuzz--cjk start (+ start len)) parts))) + ;; CJK punct + (8 (push (nth (fuzz--rand (length fuzz--puncts)) fuzz--puncts) parts)) + ;; spaces / zwsp + (9 (push (if (= 0 (fuzz--rand 3)) "​" " ") parts)))) + (string-trim (apply #'concat (nreverse parts))))) + +(defun fuzz--content (s) + (replace-regexp-in-string "[ \t\n​-]+" "" (substring-no-properties s))) + +(ekp-param-set 5 2 1 4 2 1 0 3 0) +(let ((cases 300) (fails 0)) + (dotimes (i cases) + (let* ((s (fuzz--gen-string)) + (w (+ 1 (fuzz--rand 300)))) + (unless (string-blank-p s) + (condition-case err + (let (el cr) + (setq ekp-use-c-module nil) + (ekp-clear-caches) + (setq el (ekp-pixel-justify s w)) + (setq ekp-use-c-module t) + (ekp-clear-caches) + (setq cr (ekp-pixel-justify s w)) + ;; ① parity + (unless (equal el cr) + (cl-incf fails) + (message "PARITY FAIL #%d w=%d s=%S" i w s)) + ;; ② content preservation + (unless (equal (fuzz--content el) (fuzz--content s)) + (cl-incf fails) + (message "CONTENT FAIL #%d w=%d s=%S" i w s)) + ;; ③ finite cost + (unless (numberp (ekp-total-cost s w)) + (cl-incf fails) + (message "COST FAIL #%d w=%d" i w))) + (error (cl-incf fails) + (message "ERROR #%d w=%d s=%S err=%S" i w s err)))))) + (message "fuzz done: %d cases, %d failures" cases fails) + (kill-emacs (if (> fails 0) 1 0))) diff --git a/tests/ekp-tests.el b/tests/ekp-tests.el index 87e66a1..b115ca5 100644 --- a/tests/ekp-tests.el +++ b/tests/ekp-tests.el @@ -1,289 +1,467 @@ -;;; ekp-tests.el --- Tests for EKP -*- lexical-binding: t; -*- - -(require 'ekp) -(require 'ert) - -;;;; Test Utilities -(defun ekp-file-content (file) - (with-temp-buffer - (insert-file-contents file) - (buffer-substring (point-min) (point-max)))) - -(defun ekp-propertize (string properties - &optional start end) - "不会覆盖原有的属性，返回新的字符串。" - ;; 防止是 make-list 创建的元素，它们都属于同一个对象 - ;; 最好先复制一份字符串 - (let* ((string (copy-sequence string)) - (start (or start 0)) - (end (or end (length string)))) - (while properties - (let ((prop (pop properties)) - (value (pop properties))) - (pcase prop - ('face (add-face-text-property - start end value t string)) - ('display (add-display-text-property - start end (car value) (cadr value) - string)) - (_ (put-text-property - start end prop value string))))) - string)) - -(defun my-pop-to-buffer (buffer-or-name &optional action norecord) - (declare (indent defun)) - (let ((buffer (pop-to-buffer buffer-or-name action norecord))) - (with-current-buffer buffer (local-set-key "q" 'quit-window)) - buffer)) - -(defun pop-buffer-insert (height &rest strings) - (declare (indent defun)) - (let* ((height (or height 10)) - (buffer (my-pop-to-buffer "*pop-buffer-insert*" - `(display-buffer-at-bottom - (window-height . ,height))))) - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (apply #'insert strings))))) - -;;; tests - -(defun ekp-test-hyphen-word (lang word) - (setq ekp-latin-lang lang) - (ekp-hyphen-boxes - (ekp-hyphen-create ekp-latin-lang) word)) - -;; (ekp-test-hyphen-word "de_DE" "ästhetisch") - -(defun ekp-test-justify (cjk latin font pixel) - ;; (ekp-clear-caches) - (setq ekp-latin-lang latin) - (pop-buffer-insert 35 - (ekp-pixel-justify - (ekp-test-str cjk latin font) pixel))) - -(defun ekp-test-range-justify (cjk latin font min max) - ;; (ekp-clear-caches) - (setq ekp-latin-lang latin) - (pop-buffer-insert 35 - (car (ekp-pixel-range-justify - (ekp-test-str cjk latin font) min max)))) - -;; (ekp-test-justify nil "en_US" "Cascadia Next SC" 399) -;; (ekp-test-justify nil "en_US" "Times New Roman" 699) -;; (ekp-test-justify nil "en_US" "Georgia" 699) -;; (ekp-test-justify nil "en_US" "Noto Serif" 700) -;; (ekp-test-justify nil "en_US" "Garamond" 699) -;; (ekp-test-justify "zh" "en_US" "Cascadia Next SC" 666) -;; (ekp-test-range-justify "zh" "en_US" "Cascadia Next SC" 666 690) -;; (ekp-test-justify nil "fr" "Cascadia Next SC" 666) -;; (ekp-test-justify nil "de_DE" "Cascadia Next SC" 666) -;; (ekp-test-justify "zh" "en_US" "Noto Serif" 689) -;; (ekp-test-justify "zh" nil nil 980) -;; (ekp-clear-caches) - -;;; FIXME: font size also affect! -(defun ekp-test-str (cjk latin &optional font) - (let ((file (concat "./text" - (and cjk (concat "-" cjk)) - (and latin (concat "-" latin)) - ".txt" ))) - (if font - (ekp-propertize (ekp-file-content file) - `(face (:family ,font))) - (ekp-file-content file)))) - -(defun ekp-test-demo (min-pixel max-pixel &optional inc) - (let ((str (ekp-test-str "zh" "en_US" "Cascadia Next SC")) - (pixel-lst (number-sequence min-pixel max-pixel inc)) - (buf (get-buffer-create "*ekp-test-demo*"))) - ;; (ekp-clear-caches) - (save-window-excursion - (delete-other-windows) - (switch-to-buffer buf) - (with-current-buffer buf - (dolist (pixel pixel-lst) - (erase-buffer) - (insert (ekp-pixel-justify str pixel)) - (goto-char (point-min)) - (sit-for 0.00001)))))) - -;; (ekp-test-demo 400 800 1) - -(defun ekp-test-keep-props () - (let* ((str (ekp-test-str "zh" "en_US")) - (lst (split-string str "\n" t))) - (setq lst (list - (ekp-propertize - (ekp-propertize (nth 0 lst) - '(face (:family "Comic Sans MS"))) - '(face (:height 1.3 :foreground "cyan")) - 0 2) - (ekp-propertize - (ekp-propertize (nth 1 lst) - '(face (:family "Cascadia Next SC"))) - '(face (:height 1.3 :foreground "green")) - 0 2) - (ekp-propertize - (ekp-propertize (nth 2 lst) - '(face (:family "IBM 3270 Narrow"))) - '(face (:height 1.3 :foreground "orange")) - 0 2))) - (ekp-clear-caches) - (pop-buffer-insert 30 - "\n" (ekp-pixel-justify (string-join lst "\n\n") 683)))) - -;; (ekp-test-keep-props) - -;;; Performance Tests - -(defun ekp-test-perf-range-justify (min max &optional iterations) - "Benchmark ekp-pixel-range-justify from MIN to MAX. -Returns time in seconds." - (let* ((iterations (or iterations 3)) - (str (ekp-test-str "zh" "en_US")) - (start-time (float-time)) - result) - (dotimes (_ iterations) - (ekp-clear-caches) - (setq result (ekp-pixel-range-justify str min max))) - (let ((elapsed (/ (- (float-time) start-time) iterations))) - (message "Range [%d, %d]: %.3fs avg, optimal=%dpx" - min max elapsed (cdr result)) - elapsed))) - -;; (ekp-test-perf-range-justify 666 690 3) - -;;; Unit Tests (batch-mode safe, no font required) - -(defun ekp-test-unit--hash-consistency () - "Test that sxhash is consistent for same input." - (let* ((str "test string") - (hash1 (sxhash (list (sxhash str) "font1" "font2" 8 4 2))) - (hash2 (sxhash (list (sxhash str) "font1" "font2" 8 4 2)))) - (if (= hash1 hash2) - (message "✓ Hash consistency: PASSED") - (message "✗ Hash consistency: FAILED")))) - -(defun ekp-test-unit--struct-access () - "Test struct slot access." - (let ((para (record 'ekp-para - "test" ; string - nil nil ; latin-font, cjk-font - (vector "a" "b" "c") ; boxes - (vector 10 20 30) ; boxes-widths - nil ; boxes-types - (vector 'nws 'lws 'lws) ; glues-types - 5 ; hyphen-pixel - nil ; hyphen-positions - nil ; flagged-positions - (vector 0 10 38 76) ; ideal-prefixs - (vector 0 10 34 70) ; min-prefixs - (vector 0 10 42 82) ; max-prefixs - nil ; glue-params - (make-hash-table :test 'eql)))) ; dp-cache - (if (and (equal (ekp-para-string para) "test") - (= (length (ekp-para-boxes para)) 3) - (= (aref (ekp-para-boxes-widths para) 1) 20) - (= (ekp-para-hyphen-pixel para) 5)) - (message "✓ Struct access: PASSED") - (message "✗ Struct access: FAILED")))) - -(defun ekp-test-unit--dp-cache-storage () - "Test DP results are stored in hash table." - (let ((cache (make-hash-table :test 'eql))) - (puthash 100 '(:breaks (1) :cost 50) cache) - (let ((cached (gethash 100 cache))) - (if (and cached (= (plist-get cached :cost) 50)) - (message "✓ DP cache storage: PASSED") - (message "✗ DP cache storage: FAILED"))))) - -;;; New Feature Tests - -(defun ekp-test-unit--hyphenate-p-binary-search () - "Test binary search hyphenation lookup." - (let ((positions (vector 3 7 12 18 25))) - (if (and (ekp--hyphenate-p positions 7) ; exists - (ekp--hyphenate-p positions 25) ; last element - (not (ekp--hyphenate-p positions 10)) ; doesn't exist - (not (ekp--hyphenate-p positions 0))) ; before first - (message "✓ Binary search hyphenate-p: PASSED") - (message "✗ Binary search hyphenate-p: FAILED")))) - -(defun ekp-test-unit--flagged-p-binary-search () - "Test binary search flagged position lookup." - (let ((positions (vector 5 10 20))) - (if (and (ekp--flagged-p positions 5) ; exists - (ekp--flagged-p positions 20) ; last element - (not (ekp--flagged-p positions 15)) ; doesn't exist - (not (ekp--flagged-p positions 1))) ; before first - (message "✓ Binary search flagged-p: PASSED") - (message "✗ Binary search flagged-p: FAILED")))) - -(defun ekp-test-unit--alt-paths-hash () - "Test alternative paths hash table for looseness." - (let ((alt-paths (make-hash-table :test 'equal))) - ;; Simulate tracking paths: (position . line-count) -> (backptr . demerits) - (puthash (cons 10 3) (cons 5 150.0) alt-paths) - (puthash (cons 10 4) (cons 6 200.0) alt-paths) - (puthash (cons 20 5) (cons 10 300.0) alt-paths) - (let* ((entry1 (gethash (cons 10 3) alt-paths)) - (entry2 (gethash (cons 10 4) alt-paths))) - (if (and entry1 - (= (car entry1) 5) - (= (cdr entry1) 150.0) - entry2 - (= (car entry2) 6)) - (message "✓ Alt paths hash: PASSED") - (message "✗ Alt paths hash: FAILED"))))) - -(defun ekp-test-unit--threshold-factor () - "Test threshold factor variable." - (let ((original ekp-threshold-factor)) - (setq ekp-threshold-factor 2.0) - (let ((result (and (numberp ekp-threshold-factor) - (= ekp-threshold-factor 2.0)))) - (setq ekp-threshold-factor original) - (if result - (message "✓ Threshold factor: PASSED") - (message "✗ Threshold factor: FAILED"))))) - -(defun ekp-test-unit--flagged-penalty () - "Test flagged penalty is negative (preferred break)." - (if (< ekp-flagged-penalty 0) - (message "✓ Flagged penalty negative: PASSED") - (message "✗ Flagged penalty negative: FAILED"))) - -(defun ekp-test-unit-all () - "Run all unit tests." - (interactive) - (message "=== Running Unit Tests ===") - (ekp-test-unit--hash-consistency) - (ekp-test-unit--struct-access) - (ekp-test-unit--dp-cache-storage) - ;; New feature tests - (ekp-test-unit--hyphenate-p-binary-search) - (ekp-test-unit--flagged-p-binary-search) - (ekp-test-unit--alt-paths-hash) - (ekp-test-unit--threshold-factor) - (ekp-test-unit--flagged-penalty) - (message "=== Unit Tests Complete ===")) - -(should - (equal (progn - (ekp-clear-caches) - (setq ekp-use-c-module nil) - (ekp-pixel-justify - (propertize " 作为神之编辑器（Editor of the Gods），Emacs 早已超越了普通文本编辑器的范畴。它是由​​Richard Stallman​​于1976年创建的​​GNU项目​核心组件，其名字源自 Editor MACroS​​。在过去的半个世纪里，Emacs演化成了一个​​self-documenting, customizable, extensible​​的生态系统，用户可通过​​Emacs Lisp (elisp)​​ 重新定义编辑行为。M-x 是每个Emacer的魔法咒语——按下Alt（或Meta键）加x即可召唤任意命令，比如M-x butterfly这样的复活节彩蛋。中国开发者常戏称其为“​​永远的操作系统​​”，因为你可以通过org-mode管理TODO list、用magit操作Git仓库、甚至用EMMS播放MP3音乐。在Unix哲学中，Emacs坚持“一个编辑器统治所有​​”（One Editor to Rule Them All）的理念，这与VS Code等现代编辑器形成鲜明对比。C-x C-f打开文件，C-x C-s保存文档，看似复杂的组合键一旦形成​​肌肉记忆​​，效率就会呈指数级飙升。著名Python库Black的开发者曾公开表示：\"​​My .emacs is my second brain.​​" - 'face '(:family "Comic Sans MS")) - 683)) - (progn - (ekp-clear-caches) - (setq ekp-use-c-module t) - (ekp-pixel-justify - (propertize " 作为神之编辑器（Editor of the Gods），Emacs 早已超越了普通文本编辑器的范畴。它是由​​Richard Stallman​​于1976年创建的​​GNU项目​核心组件，其名字源自 Editor MACroS​​。在过去的半个世纪里，Emacs演化成了一个​​self-documenting, customizable, extensible​​的生态系统，用户可通过​​Emacs Lisp (elisp)​​ 重新定义编辑行为。M-x 是每个Emacer的魔法咒语——按下Alt（或Meta键）加x即可召唤任意命令，比如M-x butterfly这样的复活节彩蛋。中国开发者常戏称其为“​​永远的操作系统​​”，因为你可以通过org-mode管理TODO list、用magit操作Git仓库、甚至用EMMS播放MP3音乐。在Unix哲学中，Emacs坚持“一个编辑器统治所有​​”（One Editor to Rule Them All）的理念，这与VS Code等现代编辑器形成鲜明对比。C-x C-f打开文件，C-x C-s保存文档，看似复杂的组合键一旦形成​​肌肉记忆​​，效率就会呈指数级飙升。著名Python库Black的开发者曾公开表示：\"​​My .emacs is my second brain.​​" - 'face '(:family "Comic Sans MS")) - 683)))) - -;; (ekp-test-unit-all) +;;; ekp-tests.el --- ERT tests for EKP -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Automated test suite for emacs-kp. All tests are batch-safe: +;; +;; emacs -Q --batch -L . -l tests/ekp-tests.el \ +;; -f ert-run-tests-batch-and-exit +;; +;; In batch mode text is measured in character columns (1px per +;; column, 2px per CJK char), which exercises the full pipeline +;; deterministically without a window system. +;; +;; C module tests are skipped automatically when ekp_c/ekp.dylib (or +;; .so/.dll) has not been built. +;; +;; Interactive demos live in tests/ekp-demo.el; benchmarks in +;; tests/ekp-bench.el. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'ekp) + +;;;; Fixtures + +(defvar ekp-tests--defaults + (list 10 50 100 100 50 0.5 0) + "Default values of the tunable K-P variables (see fixture).") + +(defmacro ekp-tests--with-clean-state (&rest body) + "Run BODY with fresh caches and restore all tunables afterwards." + `(unwind-protect + (progn + (ekp-clear-caches) + (ekp-param-reset) + ,@body) + (cl-destructuring-bind (lp hp afp chp llsp llmr loose) + ekp-tests--defaults + (setq ekp-line-penalty lp + ekp-hyphen-penalty hp + ekp-adjacent-fitness-penalty afp + ekp-consecutive-hyphen-penalty chp + ekp-last-line-short-penalty llsp + ekp-last-line-min-ratio llmr + ekp-looseness loose)) + (ekp-param-reset) + (ekp-clear-caches))) + +(defun ekp-tests--line-widths (out) + "Rendered pixel width of each line of OUT." + (mapcar #'string-pixel-width (split-string out "\n"))) + +(defun ekp-tests--content (s) + "S without whitespace, newlines, hyphens and zero-width spaces. +Used to verify no content is lost by justification." + (replace-regexp-in-string "[ \t\n​-]+" "" (substring-no-properties s))) + +(defvar ekp-tests--c-tried nil) +(defun ekp-tests--c-available () + "Load the C module once; return non-nil when usable." + (unless ekp-tests--c-tried + (setq ekp-tests--c-tried t) + (ignore-errors (ekp-c-module-load))) + (and (boundp 'ekp-c-module-loaded) ekp-c-module-loaded)) + +(defun ekp-tests--file (name) + (expand-file-name name (expand-file-name "tests" (ekp-root-dir)))) + +(defun ekp-tests--file-content (name) + (with-temp-buffer + (insert-file-contents (ekp-tests--file name)) + (buffer-string))) + +;;;; Hyphenation (Liang's algorithm) + +(ert-deftest ekp-test-hyphen-en () + (let ((h (ekp-hyphen-create "en_US"))) + (should (equal (ekp-hyphen-boxes h "hyphenation") + '("hy" "phen" "ation"))) + (should (equal (ekp-hyphen-boxes h "emergency") + '("emer" "gen" "cy"))) + ;; Words with no break points come back whole + (should (equal (ekp-hyphen-boxes h "cat") '("cat"))))) + +(ert-deftest ekp-test-hyphen-de-iso8859-dict () + "German dictionary is ISO-8859 encoded; umlauts must decode correctly." + (let ((h (ekp-hyphen-create "de_DE"))) + (should (equal (ekp-hyphen-boxes h "ästhetisch") + '("äs" "the" "tisch"))) + (should (equal (ekp-hyphen-boxes h "Universität") + '("Uni" "ver" "si" "tät"))))) + +(ert-deftest ekp-test-hyphen-margins () + "Breaks respect the left/right margins (min 2 chars each side)." + (let ((h (ekp-hyphen-create "en_US"))) + (dolist (pos (ekp-hyphen-positions h "hyphenation")) + (should (>= pos 2)) + (should (<= pos (- (length "hyphenation") 2)))))) + +(ert-deftest ekp-test-hyphen-lang-fallback () + "Short language codes resolve to a dictionary." + (should (ekp-hyphen-create "en")) + (should-error (ekp-hyphen-create "zz_XX"))) + +;;;; Box splitting + +(ert-deftest ekp-test-split-latin-words () + (should (equal (append (ekp-split-to-boxes "hello world") nil) + '("hello" "world")))) + +(ert-deftest ekp-test-split-cjk-chars () + (should (equal (append (ekp-split-to-boxes "中文排版") nil) + '("中" "文" "排" "版")))) + +(ert-deftest ekp-test-split-cjk-punct-attaches () + "Closing CJK punctuation attaches to the preceding char (kinsoku)." + (let ((boxes (append (ekp-split-to-boxes "中文，排版。") nil))) + (should (member "文，" boxes)) + (should (member "版。" boxes)))) + +(ert-deftest ekp-test-split-cjk-opening-punct-holds () + "Opening CJK punctuation attaches to the following char (kinsoku)." + (let ((boxes (append (ekp-split-to-boxes "看《中文》吧") nil))) + (should (member "《中" boxes)))) + +(ert-deftest ekp-test-split-fullwidth-alnum-not-punct () + "Fullwidth letters/digits are content, not punctuation." + (should-not (ekp-cjk-fw-punct-p "Ａ")) + (should-not (ekp-cjk-fw-punct-p "５")) + (should-not (ekp-cjk-fw-punct-p "ｚ")) + (should (ekp-cjk-fw-punct-p "！")) + (should (ekp-cjk-fw-punct-p "。")) + (should (equal (append (ekp-split-to-boxes "中ＡＢ文") nil) + '("中" "Ａ" "Ｂ" "文")))) + +(ert-deftest ekp-test-split-combining-chars-attach () + "Combining marks must stay attached to their base character." + (let ((nfd (string ?c ?a ?f ?e #x0301))) ; "cafe" + combining acute + (should (= 1 (length (ekp-split-to-boxes nfd)))))) + +(ert-deftest ekp-test-split-preserved-spaces () + "Leading spaces and CJK-adjacent spaces are preserved as boxes; +a single Latin-Latin space is dropped (glue handles it)." + ;; leading spaces preserved + (should (equal (aref (ekp-split-to-boxes " indent text") 0) " ")) + ;; CJK-latin space preserved + (should (member " " (append (ekp-split-to-boxes "中文 Latin") nil))) + ;; latin-latin single space dropped + (should-not (member " " (append (ekp-split-to-boxes "two words") nil)))) + +(ert-deftest ekp-test-split-with-hyphen-punctuation () + "Punctuation around a word must not disable hyphenation." + (ekp-tests--with-clean-state + (let ((ekp-latin-lang "en_US")) + (dolist (word '("hyphenation" "hyphenation!" "(hyphenation)" + "hyphenation;" "hyphenation," "\"hyphenation\"")) + (let ((res (ekp--split-with-hyphen word))) + (should (> (length (cdr res)) 0))))))) + +;;;; Justification core + +(ert-deftest ekp-test-justify-line-width-invariant () + "Every justified line renders at exactly the requested pixel width." + (ekp-tests--with-clean-state + (ekp-param-set 5 2 1 4 2 1 0 3 0) + (dolist (case '(("中文 Latin 混排 test 保留 space 的情况 with spaces" + 30 40 50) + ("The quick brown fox jumps over the lazy dog runs fast" + 40 60) + ("中文排版是一门艺术需要考虑标点悬挂避头尾等规则" 20 30))) + (let ((s (car case))) + (dolist (w (cdr case)) + (ekp-clear-caches) + (dolist (lw (ekp-tests--line-widths (ekp-pixel-justify s w))) + (should (= lw w)))))))) + +(ert-deftest ekp-test-justify-no-content-loss () + "Justification must never lose characters, at any width." + (ekp-tests--with-clean-state + (ekp-param-set 3 1 1 2 1 1 0 2 0) + (dolist (s '("中文排版测试" + "The quick brown fox jumps over the lazy dog" + "中文 mixed 混排 words 测试" + "bcdfghjklmnpqrstvwxz supercalifragilistic")) + (dolist (w '(1 3 10 50 200)) + (ekp-clear-caches) + (should (equal (ekp-tests--content (ekp-pixel-justify s w)) + (ekp-tests--content s))))))) + +(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 \"\")." + (ekp-tests--with-clean-state + (let ((out (ekp-pixel-justify "中文排版测试" 1))) + (should (= 6 (length (split-string out "\n"))))))) + +(ert-deftest ekp-test-justify-edge-inputs () + (ekp-tests--with-clean-state + (should (equal (ekp-pixel-justify "" 100) "")) + (should (equal (ekp-pixel-justify " " 100) "")) + (should (stringp (ekp-pixel-justify "x" 100))) + (should (stringp (ekp-pixel-justify "hello" 100))))) + +(ert-deftest ekp-test-justify-invalid-args () + (ekp-tests--with-clean-state + (should-error (ekp-pixel-justify "text" 0) :type 'user-error) + (should-error (ekp-pixel-justify "text" -5) :type 'user-error) + (should-error (ekp-pixel-justify "text" 2.5) :type 'user-error) + (should-error (ekp-pixel-justify 42 100) :type 'wrong-type-argument) + (should-error (ekp-pixel-range-justify "text" 100 50) :type 'user-error))) + +(ert-deftest ekp-test-justify-multiline-blank-preserved () + "Blank input lines separate paragraphs and survive as empty lines." + (ekp-tests--with-clean-state + (let ((out (ekp-pixel-justify "para one text\n\npara two text" 200))) + (should (= 3 (length (split-string out "\n")))) + (should (equal "" (nth 1 (split-string out "\n"))))))) + +(ert-deftest ekp-test-justify-breaks-monotonic () + (ekp-tests--with-clean-state + (let* ((s "one two three four five six seven eight") + (breaks (ekp-line-breaks s 30)) + (n (length (ekp--boxes s)))) + (should (equal breaks (sort (copy-sequence breaks) #'<))) + (should (= (car (last breaks)) n))))) + +;;;; Parameters + +(ert-deftest ekp-test-params-persist () + "Explicit `ekp-param-set' persists across paragraphs (regression: +they used to be silently reset after the first justification)." + (ekp-tests--with-clean-state + (ekp-param-set 5 2 1 4 2 1 0 3 0) + (ekp-pixel-justify "first paragraph of text here" 60) + (ekp-pixel-justify "second different paragraph text" 60) + (should (= ekp-lws-ideal-pixel 5)) + (should (= ekp-mws-ideal-pixel 4)))) + +(ert-deftest ekp-test-params-reset-restores-auto () + (ekp-tests--with-clean-state + (ekp-param-set 9 3 2 8 3 2 0 4 0) + (ekp-param-reset) + ;; After reset, defaults are derived per string again + (ekp-pixel-justify "some text to justify here" 60) + (should-not (= (or ekp-lws-ideal-pixel 0) 9)))) + +(ert-deftest ekp-test-params-affect-c-module () + "Penalty variables must reach the C module (regression: they were +never synced, so Elisp and C diverged)." + (skip-unless (ekp-tests--c-available)) + (ekp-tests--with-clean-state + (ekp-param-set 3 1 1 2 1 1 0 2 0) + (let ((s "The quick brown fox jumps over the lazy dog and keeps running through the emergency broadcast system test of hyphenation quality")) + (dolist (hp '(50 1000000)) + (setq ekp-hyphen-penalty hp) + (setq ekp-use-c-module t) + (ekp-clear-caches) + (let ((c-out (ekp-pixel-justify s 40))) + (setq ekp-use-c-module nil) + (ekp-clear-caches) + (should (equal (ekp-pixel-justify s 40) c-out))))))) + +;;;; Looseness + +(ert-deftest ekp-test-looseness () + "looseness=+1 adds a line when feasible; -1 removes one; the C +module is bypassed automatically (it has no looseness support)." + (ekp-tests--with-clean-state + (ekp-param-set 1 1 1 1 0 0 0 2 0) + (let* ((s "one two three four five six seven eight nine ten eleven twelve") + (lines (lambda () + (ekp-clear-caches) + (length (split-string (ekp-pixel-justify s 30) "\n")))) + (n0 (progn (setq ekp-looseness 0) (funcall lines))) + (n+ (progn (setq ekp-looseness 1) (funcall lines))) + (n- (progn (setq ekp-looseness -1) (funcall lines)))) + (should (= n+ (1+ n0))) + (should (<= n- n0))))) + +;;;; Caching + +(ert-deftest ekp-test-para-cache-hit () + (ekp-tests--with-clean-state + (let ((p1 (ekp--get-para "same string")) + (p2 (ekp--get-para "same string"))) + (should (eq p1 p2))))) + +(ert-deftest ekp-test-para-cache-distinguishes-properties () + "Strings differing only in text properties must not share a para." + (ekp-tests--with-clean-state + (let ((p1 (ekp--get-para "same string")) + (p2 (ekp--get-para (propertize "same string" 'face 'bold)))) + (should-not (eq p1 p2))))) + +(ert-deftest ekp-test-para-cache-limit () + (ekp-tests--with-clean-state + (let ((ekp-para-cache-limit 2)) + (ekp--get-para "one") + (ekp--get-para "two") + (ekp--get-para "three") ; triggers flush + (should (<= (hash-table-count ekp--para-cache) 2))))) + +(ert-deftest ekp-test-para-cache-tracks-language () + "Switching `ekp-latin-lang' must not reuse stale hyphenation +\(regression: the cache key ignored the language)." + (ekp-tests--with-clean-state + (let ((s "Universität hyphenation emergency") + (old ekp-latin-lang)) + (unwind-protect + (progn + (setq ekp-latin-lang "en_US") + (let ((b-en (copy-sequence (ekp--boxes s)))) + (setq ekp-latin-lang "de_DE") + ;; Same string object, no cache clear: must re-hyphenate. + (let ((b-de (ekp--boxes s))) + (should-not (equal b-en b-de)) + ;; And it must equal a fresh computation. + (ekp-clear-caches) + (should (equal b-de (ekp--boxes s)))))) + (setq ekp-latin-lang old))))) + +(ert-deftest ekp-test-dp-cache-reuse () + (ekp-tests--with-clean-state + (let* ((s "cached paragraph text here") + (r1 (ekp-dp-cache s 60)) + (r2 (ekp-dp-cache s 60))) + (should (eq r1 r2))))) + +;;;; Line metrics invariants (brute force cross-check) + +(ert-deftest ekp-test-line-ideal-brute-force () + "`ekp--line-ideal-pixel' must equal a naive recomputation." + (ekp-tests--with-clean-state + (ekp-param-set 5 2 1 4 2 1 0 3 0) + (let* ((s "中文 Latin 混排 test 的情况 with spaces 结尾") + (para (ekp--get-para s)) + (n (length (ekp-para-boxes para))) + (widths (ekp-para-boxes-widths para)) + (types (ekp-para-boxes-types para)) + (glues (ekp-para-glues-types para)) + (hyphens (ekp-para-hyphen-positions para))) + (dotimes (i n) + (cl-loop for k from (1+ i) to n do + (let* ((box-sum (cl-loop for j from i below k + sum (aref widths j))) + (glue-sum (cl-loop for j from (1+ i) below k + sum (ekp--para-glue-ideal + para (aref glues j)))) + ;; strip leading (i>0) and trailing space runs + (lead (if (> i 0) + (let ((w 0) (j i)) + (while (and (< j k) + (eq (car (aref types j)) 'space)) + (cl-incf w (aref widths j)) + (cl-incf j)) + w) + 0)) + (trail (let ((w 0) (j (1- k))) + (while (and (>= j i) + (eq (car (aref types j)) 'space)) + (cl-incf w (aref widths j)) + (cl-decf j)) + w)) + (raw (+ box-sum glue-sum)) + (space-w (min raw (+ lead trail))) + (expected (+ (- raw space-w) + (if (ekp--hyphenate-p hyphens (1- k)) + (ekp-para-hyphen-pixel para) + 0)))) + (should (= (ekp--line-ideal-pixel para i k) expected)))))))) + +(ert-deftest ekp-test-gaps-between-brute-force () + "`ekp--gaps-between' must equal naive counting." + (ekp-tests--with-clean-state + (ekp-param-set 5 2 1 4 2 1 0 3 0) + (let* ((s "中文 Latin 混排 test words 测试") + (para (ekp--get-para s)) + (n (length (ekp-para-boxes para))) + (glues (ekp-para-glues-types para))) + (dotimes (i n) + (cl-loop for k from (1+ i) to n do + (let ((expected + (list (cl-loop for j from (1+ i) below k + count (eq (aref glues j) 'lws)) + (cl-loop for j from (1+ i) below k + count (eq (aref glues j) 'mws)) + (cl-loop for j from (1+ i) below k + count (eq (aref glues j) 'cws))))) + (should (equal (ekp--gaps-between para i k) expected)))))))) + +;;;; Text properties + +(ert-deftest ekp-test-properties-preserved () + (ekp-tests--with-clean-state + (let* ((s (propertize "styled text keeps faces across justification" + 'face '(:foreground "cyan"))) + (out (ekp-pixel-justify s 60)) + (pos (string-match "styled" out))) + (should pos) + (should (equal (get-text-property pos 'face out) + '(:foreground "cyan")))))) + +(ert-deftest ekp-test-hyphen-inherits-properties () + "Inserted hyphens carry the face of the word they break." + (ekp-tests--with-clean-state + (ekp-param-set 3 1 1 2 1 1 0 2 0) + (let* ((s (propertize "extraordinary hyphenation demonstration paragraph" + 'face 'italic)) + (out (ekp-pixel-justify s 20))) + (when-let* ((pos (cl-position ?- out))) + (should (equal (get-text-property pos 'face out) 'italic)))))) + +;;;; Range justify + +(ert-deftest ekp-test-range-justify () + (ekp-tests--with-clean-state + (ekp-param-set 5 2 1 4 2 1 0 3 0) + (let* ((s "The quick brown fox jumps over the lazy dog and keeps running along") + (res (ekp-pixel-range-justify s 50 80)) + (w (cdr res))) + (should (<= 50 w 80)) + (ekp-clear-caches) + (should (equal (car res) (ekp-pixel-justify s w)))))) + +;;;; C module parity + +(ert-deftest ekp-test-c-parity-simple () + (skip-unless (ekp-tests--c-available)) + (ekp-tests--with-clean-state + (ekp-param-set 5 2 1 4 2 1 0 3 0) + (dolist (s '("The quick brown fox jumps over the lazy dog and keeps running through the broadcast system" + "中文排版是一门艺术,需要考虑标点悬挂、避头尾等规则,同时兼顾 Latin 混排的美观。" + "中文 Latin 混排 test 保留 space 的情况 with spaces")) + (dolist (w '(30 40 60 100 200)) + (setq ekp-use-c-module nil) + (ekp-clear-caches) + (let ((el (ekp-pixel-justify s w))) + (setq ekp-use-c-module t) + (ekp-clear-caches) + (should (equal el (ekp-pixel-justify s w)))))))) + +(ert-deftest ekp-test-c-parity-files () + "Full parity on the bundled sample texts (exercises the batch API)." + (skip-unless (ekp-tests--c-available)) + (ekp-tests--with-clean-state + (ekp-param-set 5 2 1 4 2 1 0 3 0) + (dolist (f '("text-zh.txt" "text-en_US.txt" "text-zh-en_US.txt")) + (let ((s (ekp-tests--file-content f))) + (dolist (w '(100 250)) + (setq ekp-use-c-module nil) + (ekp-clear-caches) + (let ((el (ekp-pixel-justify s w))) + (setq ekp-use-c-module t) + (ekp-clear-caches) + (should (equal el (ekp-pixel-justify s w))))))))) + +(ert-deftest ekp-test-c-fallback-when-disabled () + "`ekp-use-c-module' nil forces the Elisp engine even when loaded." + (ekp-tests--with-clean-state + (let ((ekp-use-c-module nil)) + (should (stringp (ekp-pixel-justify "plain elisp path works" 60)))))) + +(provide 'ekp-tests) + +;;; ekp-tests.el ends here diff --git a/tests/run-tests.sh b/tests/run-tests.sh new file mode 100755 index 0000000..10cbcd9 --- /dev/null +++ b/tests/run-tests.sh @@ -0,0 +1,10 @@ +#!/bin/sh +# Run the EKP test suite in batch mode. +# Usage: tests/run-tests.sh [path-to-emacs] + +EMACS="${1:-${EMACS:-emacs}}" +ROOT="$(cd "$(dirname "$0")/.." && pwd)" + +exec "$EMACS" -Q --batch -L "$ROOT" \ + -l "$ROOT/tests/ekp-tests.el" \ + -f ert-run-tests-batch-and-exit