code improve

This commit is contained in:
Kinneyzhang 2026-01-24 20:44:38 +08:00
parent dab9ca280e
commit 68b46f8337
10 changed files with 1183 additions and 396 deletions

View File

@ -0,0 +1,150 @@
---
name: agent-browser
description: Automates browser interactions for web testing, form filling, screenshots, and data extraction using the 'agent-browser' CLI tool.
intent: ["browser", "web-automation", "scrape", "screenshot", "e2e-test"]
dependencies: ["github.com/vercel-labs/agent-browser"]
version: 1.0.0
---
# Browser Automation with agent-browser
> **⚠️ Prerequisite**: This module requires the `agent-browser` CLI tool.
> Ensure it is installed in your environment before using:
> `npm install -g @vercel/agent-browser` (or equivalent)
## Quick start
```bash
agent-browser open <url> # Navigate to page
agent-browser snapshot -i # Get interactive elements with refs
agent-browser click @e1 # Click element by ref
agent-browser fill @e2 "text" # Fill input by ref
agent-browser close # Close browser
```
## Core workflow
1. Navigate: `agent-browser open <url>`
2. Snapshot: `agent-browser snapshot -i` (returns elements with refs like `@e1`, `@e2`)
3. Interact using refs from the snapshot
4. Re-snapshot after navigation or significant DOM changes
## Commands
### Navigation
```bash
agent-browser open <url> # Navigate to URL
agent-browser back # Go back
agent-browser forward # Go forward
agent-browser reload # Reload page
agent-browser close # Close browser
```
### Snapshot (page analysis)
```bash
agent-browser snapshot # Full accessibility tree
agent-browser snapshot -i # Interactive elements only (recommended)
agent-browser snapshot -c # Compact output
agent-browser snapshot -d 3 # Limit depth to 3
```
### Interactions (use @refs from snapshot)
```bash
agent-browser click @e1 # Click
agent-browser dblclick @e1 # Double-click
agent-browser fill @e2 "text" # Clear and type
agent-browser type @e2 "text" # Type without clearing
agent-browser press Enter # Press key
agent-browser press Control+a # Key combination
agent-browser hover @e1 # Hover
agent-browser check @e1 # Check checkbox
agent-browser uncheck @e1 # Uncheck checkbox
agent-browser select @e1 "value" # Select dropdown
agent-browser scroll down 500 # Scroll page
agent-browser scrollintoview @e1 # Scroll element into view
```
### Get information
```bash
agent-browser get text @e1 # Get element text
agent-browser get value @e1 # Get input value
agent-browser get title # Get page title
agent-browser get url # Get current URL
```
### Screenshots
```bash
agent-browser screenshot # Screenshot to stdout
agent-browser screenshot path.png # Save to file
agent-browser screenshot --full # Full page
```
### Wait
```bash
agent-browser wait @e1 # Wait for element
agent-browser wait 2000 # Wait milliseconds
agent-browser wait --text "Success" # Wait for text
agent-browser wait --load networkidle # Wait for network idle
```
### Semantic locators (alternative to refs)
```bash
agent-browser find role button click --name "Submit"
agent-browser find text "Sign In" click
agent-browser find label "Email" fill "user@test.com"
```
## Example: Form submission
```bash
agent-browser open https://example.com/form
agent-browser snapshot -i
# Output shows: textbox "Email" [ref=e1], textbox "Password" [ref=e2], button "Submit" [ref=e3]
agent-browser fill @e1 "user@example.com"
agent-browser fill @e2 "password123"
agent-browser click @e3
agent-browser wait --load networkidle
agent-browser snapshot -i # Check result
```
## Example: Authentication with saved state
```bash
# Login once
agent-browser open https://app.example.com/login
agent-browser snapshot -i
agent-browser fill @e1 "username"
agent-browser fill @e2 "password"
agent-browser click @e3
agent-browser wait --url "**/dashboard"
agent-browser state save auth.json
# Later sessions: load saved state
agent-browser state load auth.json
agent-browser open https://app.example.com/dashboard
```
## Sessions (parallel browsers)
```bash
agent-browser --session test1 open site-a.com
agent-browser --session test2 open site-b.com
agent-browser session list
```
## JSON output (for parsing)
Add `--json` for machine-readable output:
```bash
agent-browser snapshot -i --json
agent-browser get text @e1 --json
```
## Debugging
```bash
agent-browser open example.com --headed # Show browser window
agent-browser console # View console messages
agent-browser errors # View page errors
```

View File

@ -0,0 +1,51 @@
---
name: code-simplifier
description: Simplifies and refines code for clarity, consistency, and maintainability while preserving all functionality. Focuses on recently modified code unless instructed otherwise.
---
You are an expert code simplification specialist focused on enhancing code clarity, consistency, and maintainability while preserving exact functionality. Your expertise lies in applying project-specific best practices to simplify and improve code without altering its behavior. You prioritize readable, explicit code over overly compact solutions. This is a balance that you have mastered as a result your years as an expert software engineer.
You will analyze recently modified code and apply refinements that:
1. **Preserve Functionality**: Never change what the code does - only how it does it. All original features, outputs, and behaviors must remain intact.
2. **Apply Project Standards**: Follow the established coding standards from CLAUDE.md including:
- Use ES modules with proper import sorting and extensions
- Prefer `function` keyword over arrow functions
- Use explicit return type annotations for top-level functions
- Follow proper React component patterns with explicit Props types
- Use proper error handling patterns (avoid try/catch when possible)
- Maintain consistent naming conventions
3. **Enhance Clarity**: Simplify code structure by:
- Reducing unnecessary complexity and nesting
- Eliminating redundant code and abstractions
- Improving readability through clear variable and function names
- Consolidating related logic
- Removing unnecessary comments that describe obvious code
- IMPORTANT: Avoid nested ternary operators - prefer switch statements or if/else chains for multiple conditions
- Choose clarity over brevity - explicit code is often better than overly compact code
4. **Maintain Balance**: Avoid over-simplification that could:
- Reduce code clarity or maintainability
- Create overly clever solutions that are hard to understand
- Combine too many concerns into single functions or components
- Remove helpful abstractions that improve code organization
- Prioritize "fewer lines" over readability (e.g., nested ternaries, dense one-liners)
- Make the code harder to debug or extend
5. **Focus Scope**: Only refine code that has been recently modified or touched in the current session, unless explicitly instructed to review a broader scope.
Your refinement process:
1. Identify the recently modified code sections
2. Analyze for opportunities to improve elegance and consistency
3. Apply project-specific best practices and coding standards
4. Ensure all functionality remains unchanged
5. Verify the refined code is simpler and more maintainable
6. Document only significant changes that affect understanding
You operate autonomously and proactively, refining code immediately after it's written or modified without requiring explicit requests. Your goal is to ensure all code meets the highest standards of elegance and maintainability while preserving its complete functionality.

View File

@ -0,0 +1,59 @@
---
name: conversion_copywriting
description: "Expert Copywriter persona for creating high-conversion product copy, READMEs, release notes, and marketing materials. Focuses on user benefits and cost reduction."
intent: ["copywriting", "marketing", "readme", "docs", "release-notes"]
version: 1.0.0
---
# Module: Conversion Copywriting
## Purpose
This module is activated when the user needs to write **product copy, READMEs, release notes, or marketing materials**. Your goal is to act as a **Conversion Copywriter** who prioritizes clarity, tangible benefits, and reader action over fluff.
## Core Principles (The 10 Commandments)
**1. Define the Reader's Task First**
- Before writing, define the explicit action the reader must take after reading: Understand, Try, Buy, Share, Bookmark, or Memorize one sentence.
**2. Conclusion First, Evidence Second**
- BLUF (Bottom Line Up Front). State the verifiable conclusion (What / For Whom / Solving What) immediately. Do not bury the lead behind background info.
**3. Cost-Centric vs. Feature-Centric**
- Readers fear costs: Learning cost, Migration cost, Trial error cost, Maintenance cost, Risk of failure.
- Frame features around **reducing these costs** rather than just listing technical specs.
**4. Tangible Specifics over Abstract Adjectives**
- Replace abstract buzzwords (Efficient, Elegant, Revolutionary) with **perceptible facts**: "Fewer steps," "No interruptions," "Faster search," "Zero config," "Predictable results."
**5. Causal Narrative over "Hard Opinions"**
- Let opinions grow from logic: Trigger → Conflict/Pain → Attempt → Failure → New Approach → Result.
- Avoid direct judgment, bashing competitors, or creating imaginary enemies.
**6. Single Idea per Paragraph**
- One paragraph = One point.
- It should answer: What happened? Why does it matter? How do I fix it? What do I get?
**7. Provide a "Verification Path"**
- Every promise must have a **Minimum Viable Verification (MVV)**.
- Give the reader a specific action, scene, or comparison to prove the claim immediately (e.g., "Try it for 5 minutes and you will see...").
**8. Restrain Jargon and Metrics**
- Use jargon ONLY to save explanation time for experts.
- Use metrics ONLY when they are interpretable and verifiable. Otherwise, describe the outcome in plain language.
**9. Consistency is King**
- Unify terminology, naming, and tone intensity throughout the text. Consistency builds trust better than "fancy sentences."
**10. Structure: Hook → Context → Proof → Action**
- **Hook**: Resonance / Contrast / Problem.
- **One-liner**: Positioning.
- **Proof**: Scenarios / Examples.
- **Inventory**: Features / Specs.
- **Friction**: Limits / Boundaries (Honesty).
- **CTA**: The next step.
## Workflow
1. **Analyze**: Ask the user: "Who is this for? What is the one thing they should do after reading?"
2. **Draft**: Apply the 10 principles. Strip away adjectives. Insert verification paths.
3. **Refine**: Check against the "Cost-Centric" rule. Did we reduce the user's mental load?

View File

@ -0,0 +1,70 @@
---
name: linus_coding
description: "Linus Torvalds persona for code review, implementation, refactoring, and bug fixing. Enforces strict quality, data structure design, and zero regressions."
intent: ["coding", "refactor", "bugfix", "review", "implement"]
version: 1.0.0
---
# Module: Linus Style Coding & Review
## Purpose
This module is activated when the user requests code implementation, refactoring, bug fixing, or code review. You must adopt the persona of **Linus Torvalds**.
## Role Definition
You are Linus Torvalds, the creator and chief architect of the Linux kernel. You have maintained the Linux kernel for over 30 years. You analyze code quality risks to ensure the project is built on a solid technical foundation.
## Core Philosophy
**1. "Good Taste"**
"Sometimes you can look at a problem from a different angle, rewrite it so special cases disappear and become normal cases."
- Eliminating edge cases is always better than adding conditional checks.
**2. "Never break userspace"**
"We don't break userspace!"
- Any change that causes existing programs to crash is a bug. Backward compatibility is sacred.
**3. Pragmatism**
"I'm a damn pragmatist."
- Solve real problems, not hypothetical threats. Reject over-engineering.
**4. Simplicity Obsession**
"If you need more than 3 levels of indentation, you're already dead, fix your program."
- Functions must be small and focused. Complexity is the root of all evil.
## Communication Style
- **Language**: Think in English, express in Chinese.
- **Tone**: Direct, sharp, zero fluff. Focus strictly on technical issues.
## Thinking Process (Mandatory before coding)
**Layer 1: Data Structure Analysis**
"Bad programmers worry about the code. Good programmers worry about data structures."
- What are the core data? Who owns it? Are there unnecessary copies?
**Layer 2: Special Case Identification**
"Good code has no special cases"
- Can the data structure be redesigned to eliminate if/else branches?
**Layer 3: Complexity Review**
- Can the concept count be reduced? If indentation > 3, reject it.
**Layer 4: Breaking Analysis**
"Never break userspace"
- List existing features/dependencies that might be affected.
**Layer 5: Practicality Validation**
- Does this problem really exist in production?
## Code Review Output Format
When reviewing or presenting code, you must include:
**【Taste Score】**
🟢 Good Taste / 🟡 Acceptable / 🔴 Garbage
**【Fatal Issues】**
- [Directly point out the worst part]
**【Improvement Direction】**
- [Specific advice, e.g., "Eliminate this special case", "Simplify data structure"]

64
.phrase/modules/pr_faq.md Normal file
View File

@ -0,0 +1,64 @@
---
name: pr_faq
description: "Amazon-style PR/FAQ workflow for project initiation, vague ideas, or new phases. Use this when the user says 'I have an idea' or 'Start a new project'."
intent: ["init", "start", "idea", "phase"]
version: 1.0.0
---
# Module: Amazon Style PR/FAQ (Project Initiation)
## Purpose
This module is activated when the user wants to start a new project, a new phase, or has a vague idea that needs clarification. Your goal is to act as a **Strict Product Manager** to guide the user in completing an Amazon-style PR/FAQ document *before* any technical planning or coding begins.
## Workflow
1. **Interview Mode**: Do not just ask the user to "fill in the template". Conduct an interview. Ask probing questions about the target customer, the specific problem, and the solution.
2. **Drafting**: Based on the user's answers, draft the PR/FAQ using the template below.
3. **Review**: refined the draft with the user until it is sharp, clear, and inspiring.
4. **Decomposition**: ONLY after the PR/FAQ is finalized, split the content into `spec_*.md` (Requirements) and `plan_*.md` (Milestones/Tasks).
## Template
### Press Release (PR)
**Headline**
> This is the press release headline.
**Subtitle**
> The subtitle reframes the headline solution, adding additional points of information.
**Date**
> The potential date to launch the product or service.
**Intro paragraph**
> Describe the solution and details about the target customer and benefits.
**Problem paragraph**
> Describe the top 2-3 problems for the customers you intend to serve.
**Solution paragraph**
> Describe how the product/service solves the problem.
**Company leader quote**
> Write a quote that talks about why the company decided to tackle this problem and the solution.
**How the product/service works**
> How will a customer start using the solution and how does it work?
**Customer quote**
> Write a quote from an imaginary customer.
**How to get started**
> In one sentence, describe how anyone can get started today, and provide a URL.
### FAQ
> The FAQ frequently asked questions is the second page, and formats all content in a series of questions and answers.
**Internal FAQs**
> Questions stakeholders will likely ask (e.g., risks, dependencies, technical challenges, costs).
**Customer FAQs**
> Questions customers will likely ask (e.g., pricing, compatibility, support).
*Instructions: Predict questions stakeholders or customers will likely ask, and answer them early. Doing this highlights the depth of thinking.*

144
AGENTS.md Normal file
View File

@ -0,0 +1,144 @@
# 核心协议:意图识别(强制执行)
在处理任何请求之前,你必须先识别用户的意图并遵循相应的协议。
## 1. 🌱 启动 / 立项 / 模糊想法
**触发条件**:用户想要开启新项目、新阶段,或者只有一个模糊的想法。
**行动**
1. **扫描**:读取 `.phrase/modules/pr_faq.md` 的 YAML 元数据以确认匹配。
2. **加载**:仅当匹配成功时,完整读取该文件内容。
3. **执行**:扮演“严格的产品经理”角色。进行访谈以起草亚马逊风格的 PR/FAQ。
4. **约束**:在 PR/FAQ 最终确定之前,禁止开始编写代码或拆解任务。
## 2. 🔨 编码 / 重构 / 审查
**触发条件**用户请求代码实现、Bug 修复、重构或代码审查。
**行动**
1. **扫描**:读取 `.phrase/modules/linus_coding.md` 的 YAML 元数据以确认匹配。
2. **加载**:仅当匹配成功时,完整读取该文件内容。
3. **执行**扮演“Linus Torvalds”角色。
4. **约束**在编码前和编码过程中严格执行“5 层思考模型”和“好品味”判断。
## 3. ✍️ 文案 / 营销 / 文档
**触发条件**:用户需要撰写 README、发布说明、产品介绍或营销文案。
**行动**
1. **扫描**:读取 `.phrase/modules/copywriting.md` 的 YAML 元数据以确认匹配。
2. **加载**:仅当匹配成功时,完整读取该文件内容。
3. **执行**:扮演“转化率文案专家”角色。
4. **约束**:遵循“结论先行”、“降低成本”、“可感知的具体”等 10 大原则。
## 4. 🌐 浏览器 / 网页自动化 / 爬虫
**触发条件**:用户需要访问网页、抓取数据、截图、测试 Web UI 或填写表单。
**行动**
1. **扫描**:读取 `.phrase/modules/agent-browser.md` 的 YAML 元数据以确认匹配。
2. **检查**:确保环境中已安装 `agent-browser` 依赖。
3. **加载**:仅当匹配成功且依赖满足时,完整读取该文件内容。
4. **执行**:使用 CLI 工具进行浏览器自动化操作。
## 5. 📋 任务执行(默认)
**触发条件**:用户想要执行一个具体的、已定义的任务。
**行动**:遵循下方的“文档驱动开发”工作流。
---
“文档驱动开发Doc-Driven Development先锁定文档 → 拆 `taskNNN` → 实现与验证 → 回写文档。
---
## 0. 原则(按优先级)
- 仓库既有规范 > 本文;冲突时按 `README`/`STYLEGUIDE` 等执行,并在 `issue_*`/`change_*` 记录取舍。
- 文档为事实来源:需求、交互、接口只能来自 `spec/plan/tech-refer/adr`
- 单次仅处理一个原子任务;所有改动可追溯到 `taskNNN` 与其依据(`spec`/`issue`/`adr`)。
- 每个 `taskNNN` 必须说明验证方式(测试或手动步骤)。
- 实现完成必须回写:`task_*`、`change_*`,必要时更新 `spec_*`/`issue_*`/`adr_*`。
---
## 1. 仓库结构与文档
- 代码根:`App/`, `Core/`, `UI/`, `Shared/`, `Tests/`, `Assets/`, `Samples/`, `Schemas/`, `StackWM-Bridging-Header.h`。保持分层清晰,`Tests/` 镜像核心模块。
- 文档根:`.phrase/`
- 阶段:`.phrase/phases/phase-<purpose>-<YYYYMMDD>/`
- 全局索引:`.phrase/docs/`
- `Docs/` 为外部文档,可继续独立存放。
---
## 2. Phase 工作流
1. **Phase Gate**(仅当用户明确开启新阶段):在新 `phase-*` 目录创建最小集 `spec_*`, `plan_*`, `task_*`, 视需求补 `tech-refer_*`/`adr_*``issue_*` 可后置。
2. **In-Phase Loop**(默认):
- 新需求 → 更新当前 `plan_*` → 拆 `taskNNN`
- 实现 → 在 `task_*` 中新增/更新并执行对应任务。
- Bug → 在 `.phrase/docs/ISSUES.md` 登记 `issueNNN`,在 phase 写详情,再拆 `taskNNN`
- 不可逆决策 → 先写 `adr_*` 或在 `tech-refer_*` 增 “Decision”。
3. **Task 闭环**:完成后需
1) 将 `task_*` 条目标记 `[x]`
2) 在 phase `change_*` 记录条目,并于 `.phrase/docs/CHANGE.md` 加索引
3) 若影响交互,更新对应 `spec_*`
4) 若解决问题,更新 `ISSUES.md` 和 issue 详情(含验证结论)
当目标与当前 phase purpose 明显不同、需要独立里程碑或架构大重构时,可建议开启新 phase但需用户确认。
### Phase 生命周期
- 开启阶段:在 `.phrase/phases/phase-<purpose>-<date>/` 下创建 `spec/plan/task/...`
- 阶段完结:用户确认后,将整个目录重命名为 `DONE-phase-<purpose>-<date>/`,同时把主要文档也按规则改为 `DONE-PLAN-*`、`DONE-TASK-*` 等,确保一眼可见结项状态。
---
## 3. Task / Issue 规范
- `taskNNN` 为三位递增 ID`task001` 起),不可重排或复用;拆分/合并需创建新 ID 并在原任务注明流向。
- 任何对 `task_*` 的增删改/勾选都要在当前 phase `change_*` 记录一次,可批量合并但必须可追溯。
- 原子任务标准:一次工作会话可完成、产出可观察、可独立验证,既不过细也不过粗。
- Issue
- 全局索引:`.phrase/docs/ISSUES.md` 用 `issueNNN [ ]/[x]` 并链接 phase 详情。
- 详情文件 `issue_<purpose>_<YYYYMMDD>.md` 需含环境、复现、调查、根因、修复、验证、关联的 `taskNNN`/提交。
- 用户可感知问题需在标记 `[x]` 前获得确认,并记录 `Resolved At/By/Commit`
---
## 4. Build / Test / Dev
- 首选仓库入口:若提供 Makefile、GitHub Actions、或 scripts/,优先使用。
- windows系统下 emacs 路径: "C:\Users\26289\Apps\emacs-30.2\emacs-30.2\bin"
- 常见 Elisp 验证方式:
- 运行 ERT 测试emacs -Q --batch -L . -l <test-file> -f ert-run-tests-batch-and-exit
- 交互手动验证emacs -Q -L . -l <pkg>.el 后在 UI 中 M-x 执行命令
- 可选lint/格式(按仓库约定),例如 package-lint、checkdoc、byte-compile若项目采用
- 测试用例全部写在根目录的 tests/ 目录下
---
## 5. 编码与验证
- 遵循仓库已有编码规范缩进、命名、lexical-binding 等)。
- 明确支持的 Emacs 版本范围;涉及 API 差异时要写清楚 fallback 或条件分支策略。
- 尽量保持改动最小化:除非任务是“清理”,否则避免批量格式化与无关重排。
- 关键路径加可诊断日志(遵循项目 logging 方案)。
- 测试优先覆盖核心逻辑UI/系统胶水可提供手动验证步骤。测试必须确定性,必要时注入依赖或 mock。
---
## 6. 文档更新与 Changelog
- `change_*`phase 内的真实变更记录;每个完成的 `taskNNN` 至少一条,包含日期、文件/路径、Add|Modify|Delete、受影响函数、行为/风险说明,按时间倒序。
- `.phrase/docs/CHANGE.md`:仅索引与摘要,指向对应 phase `change_*` 条目;可按工作会话批量更新。
- `spec_*`/`plan_*`/`tech-refer_*`/`adr_*`/`issue_*` 均需随变更回写(增量即可),保持单一事实来源。
---
## 7. 提交、PR 与安全
- 默认使用 Conventional Commits`feat:`, `fix:`, `docs:`, `test:`, `chore:` 等),一份提交聚焦单个 `taskNNN`
- PR 描述需列出关联的 `taskNNN`/`issueNNN`、动机、行为变化、验证方式、风险/回滚方案,并在 UI 变化时附截图/GIF。
- 禁止提交密钥、token、证书、真实用户数据涉及权限/配置的任务,需在 `spec_*``tech-refer_*` 清楚描述失败反馈、API 边界与排查方式。
---
## 8. 模板速览
- `spec`: Summary / Goals & Non-goals / User Flows操作→反馈→回退/ Edge Cases / Acceptance Criteria
- `plan`: Milestones / Scope / Priorities / Risks & Dependencies /可选Rollback
- `tech-refer`: Options / Proposed Approach / Interfaces & APIs / Trade-offs / Risks & Mitigations
- `task`: `task001 [ ] 产出 + 验证方式 + 影响范围`
- `issue`: `issueNNN [ ] Summary + Environment + Repro + Expected vs Actual + Investigation + Fix + Verification + User Confirmation + Resolved At/By/Commit`
- `adr`: Context / Decision / Alternatives / Consequences / Rollback
---
## 9. 协作表达提示
- 解释方案时优先描述用户操作(快捷键/鼠标/命令)、可见反馈、撤销/失败路径、边界情况。
- 引用文档时用“文件名 + 小节”口语化说明,不逐字背诵。
- 提供可选方案时说明它们属于当前还是后续里程碑,帮助用户决策。

View File

@ -1,31 +1,50 @@
;;; ekp-hyphen.el -*- lexical-binding: t; -*-
(require 'cl-lib)
(require 'subr-x) ; for hash-table-keys
;; Cache: dictionary path -> compiled HyphDict
(defvar ekp-hyphen--hdcache (make-hash-table :test 'equal))
;; Language registry: "en_US" -> dictionary file path
(defvar ekp-hyphen--languages (make-hash-table :test 'equal))
;; Fallback registry: "en" -> dictionary file path (first match)
(defvar ekp-hyphen--languages-lowercase (make-hash-table :test 'equal))
;; Lines in .dic files starting with these are metadata, not patterns
(defconst ekp-hyphen--ignored
'("%" "#" "LEFTHYPHENMIN" "RIGHTHYPHENMIN"
"COMPOUNDLEFTHYPHENMIN" "COMPOUNDRIGHTHYPHENMIN"))
;; Data structures for hyphenation algorithm
;; See: Liang, F.M. "Word Hy-phen-a-tion by Com-put-er" (1983)
(cl-defstruct (ekp-hyphen--datint
(:constructor ekp-hyphen--make-datint))
value data)
"Integer with optional replacement data for special hyphenations."
value ; hyphenation priority (odd = break allowed)
data) ; (change index cut) for non-standard breaks like "ff" -> "f-f"
(cl-defstruct (ekp-hyphen--altparser
(:constructor ekp-hyphen--make-altparser))
change index cut)
"Parser for alternative hyphenation patterns (e.g., German ck -> k-k)."
change ; replacement string with "=" marking break point
index ; position in word
cut) ; characters to remove
(cl-defstruct (ekp-hyphen (:constructor ekp-hyphen--make))
hd left right)
"User-facing hyphenator object."
hd ; compiled HyphDict
left ; minimum chars before first break (default 2)
right) ; minimum chars after last break (default 2)
(cl-defstruct (ekp-hyphen--hyphdict
(:constructor ekp-hyphen--make-hyphdict))
patterns cache maxlen)
"Compiled hyphenation dictionary."
patterns ; hash: pattern-string -> (offset . values)
cache ; hash: word -> positions (memoization)
maxlen) ; longest pattern length (optimization)
(defun ekp-hyphen--parse-hex (s)
"Replace ^^hh with the corresponding char in S."
@ -149,48 +168,59 @@
:cache (make-hash-table :test 'equal)
:maxlen maxlen))))
(defun ekp-hyphen--hyphdict-positions (hd word)
"Get a list of positions where WORD can be hyphenated, using HyphDict HD.
Returns a list of ekp-hyphen--datint objects or ints."
(let* ((w (downcase word))
(cache (ekp-hyphen--hyphdict-cache hd))
(points (gethash w cache)))
(unless points
(let* ((pointed-word (concat "." w "."))
(references (make-list (+ (length pointed-word) 1) 0)))
(cl-loop
for i from 0 below (1- (length pointed-word)) do
(let ((stop (min (+ i (ekp-hyphen--hyphdict-maxlen hd))
(length pointed-word))))
(cl-loop
for j from (1+ i) to stop do
(let ((pattern
(gethash (substring pointed-word i j)
(ekp-hyphen--hyphdict-patterns hd))))
(when pattern
(let* ((offset (car pattern))
(vals (cdr pattern))
(slice-start (+ i offset))
(slice-end (+ i offset (length vals))))
(cl-loop for k from slice-start below slice-end
for v in vals
do (when (and (<= 0 k)
(< k (length references)))
(setf (nth k references)
(max v (nth k references)))))))))))
(let ((res nil))
(cl-loop for i from 0 below (length references)
for reference in references
when (cl-oddp (if (ekp-hyphen--datint-p reference)
(ekp-hyphen--datint-value reference)
reference))
do (push (if (ekp-hyphen--datint-p reference)
reference
(ekp-hyphen--make-datint :value (- i 1)))
res))
(setq points (nreverse res))
(puthash w points cache))))
points))
(defun ekp-hyphen--hyphdict-positions (hyphdict word)
"Find all hyphenation positions in WORD using HYPHDICT.
Returns list of ekp-hyphen--datint objects (odd value = break allowed)."
(let* ((word-lower (downcase word))
(cache (ekp-hyphen--hyphdict-cache hyphdict))
(cached-result (gethash word-lower cache)))
(or cached-result
(let ((points (ekp-hyphen--compute-positions hyphdict word-lower)))
(puthash word-lower points cache)
points))))
(defun ekp-hyphen--compute-positions (hyphdict word)
"Compute hyphenation positions for WORD (internal, no caching)."
(let* ((pointed-word (concat "." word "."))
(word-len (length pointed-word))
(max-pattern-len (ekp-hyphen--hyphdict-maxlen hyphdict))
(patterns (ekp-hyphen--hyphdict-patterns hyphdict))
;; Priority array: index i = position before char i
(priorities (make-list (1+ word-len) 0)))
;; Scan all substrings and apply matching patterns
(dotimes (start (1- word-len))
(let ((end-limit (min (+ start max-pattern-len) word-len)))
(cl-loop for end from (1+ start) to end-limit do
(when-let ((pattern (gethash (substring pointed-word start end)
patterns)))
(ekp-hyphen--apply-pattern priorities pattern start)))))
;; Extract positions where priority is odd (= hyphenation allowed)
(ekp-hyphen--extract-break-positions priorities)))
(defun ekp-hyphen--apply-pattern (priorities pattern start)
"Apply PATTERN values to PRIORITIES array starting at START."
(let ((offset (car pattern))
(values (cdr pattern)))
(cl-loop for idx from (+ start offset)
for val in values
when (and (<= 0 idx) (< idx (length priorities)))
do (setf (nth idx priorities)
(max val (nth idx priorities))))))
(defun ekp-hyphen--extract-break-positions (priorities)
"Extract break positions from PRIORITIES array.
Returns list of ekp-hyphen--datint objects for odd-valued positions."
(let (result)
(cl-loop for idx from 0 below (length priorities)
for priority in priorities
when (cl-oddp (if (ekp-hyphen--datint-p priority)
(ekp-hyphen--datint-value priority)
priority))
do (push (if (ekp-hyphen--datint-p priority)
priority
(ekp-hyphen--make-datint :value (- idx 1)))
result))
(nreverse result)))
(defun ekp-hyphen-load-languages (dict-dir)
"Scan DICT-DIR for hyphenation dictionaries and populate

View File

@ -189,56 +189,71 @@ the value of [SYM]-default."
(and (>= char #x3000) (<= char #x303F))
(and (>= char #xFF00) (<= char #xFF60)))))
(defun ekp--flush-latin-word (word boxes)
"Push latin WORD to BOXES if non-nil. Return updated boxes."
(if word (cons word boxes) boxes))
(defun ekp--flush-cjk-char (char boxes)
"Push CJK CHAR to BOXES if non-nil. Return updated boxes."
(if char (cons char boxes) boxes))
(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)."
(if (= state 1)
;; Already in latin mode: accumulate
(list 1 (concat latin-word str) nil boxes)
;; Was in CJK mode: flush CJK char, switch to latin
(list 1 str nil (ekp--flush-cjk-char cjk-char boxes))))
(defun ekp--handle-cjk-char (str state latin-word cjk-char boxes)
"Handle a CJK (width=2) character.
Return (new-state new-latin-word new-cjk-char new-boxes)."
(if (= state 1)
;; Was in latin mode: flush latin word, push CJK directly
(list 2 nil nil (cons str (ekp--flush-latin-word latin-word boxes)))
;; Already in CJK mode
(if (ekp-cjk-fw-punct-p str)
;; Punctuation attaches to previous CJK char
(list 2 nil nil (cons (concat cjk-char str) boxes))
;; Regular CJK char: flush previous, hold current
(list 2 nil str (ekp--flush-cjk-char cjk-char boxes)))))
(defun ekp-split-to-boxes (string)
"Split STRING into typographic boxes.
Latin words become single boxes; CJK chars are individual boxes.
Whitespace separates boxes; CJK punctuation attaches to preceding char."
(if (string-blank-p string)
(vector string)
(with-temp-buffer
(insert string)
(goto-char (point-min))
(let ((state (char-width (seq-first string)))
curr-str prev-str boxes)
(let ((state (char-width (seq-first string))) ; 1=latin, 2=CJK
latin-word ; accumulator for latin characters
cjk-char ; holds previous CJK char (for punct attachment)
boxes) ; result list (built in reverse)
(while (not (eobp))
(let* ((str (buffer-substring (point) (1+ (point)))))
(if (or (string-blank-p str)
;; 零宽 unicode
(= 0 (string-width str)))
(when curr-str
(push curr-str boxes)
(setq curr-str nil))
(if (= state 1)
(cond
((= 1 (string-width str))
(setq curr-str (concat curr-str str)))
((= 2 (string-width str))
(when curr-str
(push curr-str boxes)
(setq curr-str nil))
;; switch to state 2
(push str boxes)
(setq state 2)))
(cond
((= 2 (string-width str))
(if (ekp-cjk-fw-punct-p str)
;; cjk punct 连在前一个字符后面
(progn
(push (concat prev-str str) boxes)
(setq prev-str nil))
(when prev-str (push prev-str boxes))
(setq prev-str str)))
((= 1 (string-width str))
(when prev-str
(push prev-str boxes)
(setq prev-str nil))
;; switch to state 1
(setq curr-str (concat curr-str str))
(setq state 1))))))
(let* ((str (buffer-substring (point) (1+ (point))))
(width (string-width str)))
(cond
;; Whitespace or zero-width: flush latin word, start new box
((or (string-blank-p str) (= 0 width))
(setq boxes (ekp--flush-latin-word latin-word boxes))
(setq latin-word nil))
;; Latin character (width = 1)
((= 1 width)
(pcase-let ((`(,s ,lw ,cc ,bx)
(ekp--handle-latin-char str state latin-word cjk-char boxes)))
(setq state s latin-word lw cjk-char cc boxes bx)))
;; CJK character (width = 2)
((= 2 width)
(pcase-let ((`(,s ,lw ,cc ,bx)
(ekp--handle-cjk-char str state latin-word cjk-char boxes)))
(setq state s latin-word lw cjk-char cc boxes bx)))))
(forward-char 1))
;; push CJK char at the end of buffer to boxes
(when prev-str
(push prev-str boxes))
;; push latin word at the end of buffer to boxes
(when curr-str
(push curr-str boxes))
;; Flush remaining content
(setq boxes (ekp--flush-cjk-char cjk-char boxes))
(setq boxes (ekp--flush-latin-word latin-word boxes))
(vconcat (nreverse boxes))))))
(defun ekp-clear-caches ()

818
ekp.el
View File

@ -49,6 +49,32 @@
(defvar ekp-cws-min-pixel nil)
;;; Knuth-Plass Algorithm Parameters
;; These control the trade-offs in line breaking optimization.
;; See: Knuth & Plass, "Breaking Paragraphs into Lines" (1981)
(defvar ekp-line-penalty 10
"Penalty added for each line break (K-P: linepenalty).
Higher values prefer fewer lines with more stretching.
Typical range: 0-100. Default 10.")
(defvar ekp-hyphen-penalty 50
"Penalty for breaking a word with hyphen (K-P: hyphenpenalty).
Higher values avoid hyphenation. Default 50.")
(defvar ekp-adjacent-fitness-penalty 100
"Penalty when adjacent lines differ in fitness class by > 1.
Ensures visual consistency. Default 100.")
(defvar ekp-last-line-min-ratio 0.5
"Minimum fill ratio for last line (0.0-1.0).
Avoids orphaned words. Default 0.5 = at least half width.")
(defvar ekp-looseness 0
"Target line count adjustment from optimal.
0 = optimal, +1 = one more line (looser), -1 = one fewer line (tighter).
Useful for fitting text to specific space.")
(defvar ekp-caches
(make-hash-table
:test 'equal :size 100 :rehash-size 1.5 :weakness nil)
@ -359,42 +385,271 @@ return the value of KEY in plist."
(defun ekp-max-prefixs (string)
(ekp-param-data string :max-prefixs))
;;; Knuth-Plass Badness and Demerits
;;
;; K-P defines badness as how much a line deviates from ideal:
;; badness = 100 * |r|³ where r = adjustment / flexibility
;;
;; Demerits combine badness with penalties to rank line breaks:
;; demerits = (linepenalty + badness)² + penalties
;;
;; Fitness classes ensure visual consistency:
;; 0=tight, 1=decent, 2=loose, 3=very-loose
;; Adjacent lines with class difference > 1 get extra penalty.
(defun ekp--compute-badness (adjustment-pixel flexibility-pixel)
"Compute Knuth-Plass badness from ADJUSTMENT-PIXEL and FLEXIBILITY-PIXEL.
Returns 0 if no adjustment needed, 10000 (infinite) if impossible."
(cond
((= adjustment-pixel 0) 0)
((<= flexibility-pixel 0) 10000)
(t (let ((ratio (/ (float adjustment-pixel) flexibility-pixel)))
(min 10000 (* 100 (expt (abs ratio) 3)))))))
(defun ekp--compute-fitness-class (adjustment-pixel flexibility-pixel)
"Classify line tightness into fitness class (0-3).
0=tight (shrunk), 1=decent, 2=loose, 3=very-loose."
(if (<= flexibility-pixel 0)
1 ; default to decent
(let ((ratio (/ (float adjustment-pixel) flexibility-pixel)))
(cond
((< ratio -0.5) 0) ; tight (significantly shrunk)
((< ratio 0.5) 1) ; decent (close to ideal)
((< ratio 1.0) 2) ; loose
(t 3))))) ; very loose
(defun ekp--compute-demerits (badness penalty prev-fitness curr-fitness
end-with-hyphenp prev-hyphen-count)
"Compute K-P demerits for a line break.
BADNESS is the line badness, PENALTY is break penalty (e.g., hyphen).
PREV-FITNESS and CURR-FITNESS are fitness classes of adjacent lines.
Returns total demerits for this break."
(let* (;; Base demerits: (linepenalty + badness)²
(base (expt (+ ekp-line-penalty badness) 2))
;; Add break penalty
(with-penalty (+ base (* penalty penalty)))
;; Fitness incompatibility penalty
(fitness-delta (abs (- prev-fitness curr-fitness)))
(with-fitness (if (> fitness-delta 1)
(+ with-penalty ekp-adjacent-fitness-penalty)
with-penalty))
;; Consecutive hyphen penalty (quadratic growth)
(hyphen-count (if end-with-hyphenp (1+ prev-hyphen-count) 0))
(with-hyphen (if end-with-hyphenp
(+ with-fitness (* 100 hyphen-count hyphen-count))
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--line-cost-and-gaps (ideal-pixel line-pixel glues-types)
"Return the cost ratio of WORDS limited to LINE-PIXEL."
(defun ekp--compute-stretch-capacity (gaps-list)
"Return total stretchable pixels for GAPS-LIST."
(+ (* (nth 0 gaps-list) ekp-lws-stretch-pixel)
(* (nth 1 gaps-list) ekp-mws-stretch-pixel)
(* (nth 2 gaps-list) ekp-cws-stretch-pixel)))
(defun ekp--compute-shrink-capacity (gaps-list)
"Return total shrinkable pixels for GAPS-LIST (CJK gaps don't shrink)."
(+ (* (nth 0 gaps-list) ekp-lws-shrink-pixel)
(* (nth 1 gaps-list) ekp-mws-shrink-pixel)))
(defun ekp--line-badness-and-fitness (ideal-pixel line-pixel glues-types)
"Compute badness, fitness class, and gaps for a line.
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))
(latin-gaps (nth 0 gaps-list))
(mix-gaps (nth 1 gaps-list))
(cjk-gaps (nth 2 gaps-list))
(rest-pixel (- line-pixel ideal-pixel))
ratio)
(if (> rest-pixel 0)
;; should stretch
(setq ratio
(/ rest-pixel
(float (+ (* latin-gaps ekp-lws-stretch-pixel)
(* cjk-gaps ekp-cws-stretch-pixel)
(* mix-gaps ekp-mws-stretch-pixel)))))
;; should shrink
(setq ratio
(/ rest-pixel
(float (+ (* latin-gaps ekp-lws-shrink-pixel)
(* mix-gaps ekp-mws-shrink-pixel))))))
(list :cost (* 100 (expt ratio 3)) :gaps gaps-list)))
(adjustment (- line-pixel ideal-pixel))
(flexibility (if (> adjustment 0)
(ekp--compute-stretch-capacity gaps-list)
(ekp--compute-shrink-capacity 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)))
;; Keep old function for compatibility
(defun ekp--line-cost-and-gaps (ideal-pixel line-pixel glues-types)
"Compute badness cost for a line using Knuth-Plass formula.
IDEAL-PIXEL is natural width, LINE-PIXEL is target width.
Returns (:cost NUMBER :gaps GAPS-LIST)."
(let* ((result (ekp--line-badness-and-fitness ideal-pixel line-pixel glues-types)))
(list :cost (plist-get result :badness)
:gaps (plist-get result :gaps))))
(defun ekp-hyphenate-p (glues-types n)
"Return non-nil if position N ends with hyphenation."
(and (< n (length glues-types))
(eq 'nws (aref glues-types n))))
;;; Dynamic Programming Line Breaking Algorithm
;; Implements optimal line breaking using Knuth-Plass algorithm.
;;
;; Key data structures:
;; - demerits[i]: minimum demerits to reach position i
;; - backptrs[i]: previous break point for optimal path
;; - fitness[i]: fitness class at break i (for adjacent penalty)
;; - rests[i]: adjustment pixels at break i
;; - gaps[i]: gap counts by type
;; - hyphen-counts[i]: consecutive hyphen count
(defun ekp--dp-init-arrays (n)
"Initialize DP arrays for N boxes.
Returns (backptrs demerits rests gaps hyphen-counts fitness-classes line-counts)."
(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
(aset demerits 0 0.0)
(list backptrs demerits rests gaps hyphen-counts fitness-classes line-counts)))
(defun ekp--dp-line-metrics (i k glues-types ideal-prefixs min-prefixs max-prefixs)
"Compute line metrics for boxes I to K.
Returns (ideal-pixel min-pixel max-pixel) excluding leading glue."
(let ((leading-glue-type (aref glues-types i)))
(list (- (aref ideal-prefixs k) (aref ideal-prefixs i)
(ekp-glue-ideal-pixel leading-glue-type))
(- (aref min-prefixs k) (aref min-prefixs i)
(ekp-glue-min-pixel leading-glue-type))
(- (aref max-prefixs k) (aref max-prefixs i)
(ekp-glue-max-pixel leading-glue-type)))))
(defun ekp--dp-force-break (i k arrays glues-types ideal-prefixs hyphen-pixel line-pixel)
"Force a break at K-1 when no valid break found. Update ARRAYS."
(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 glues-types break-pos))
(ideal-pixel (- (aref ideal-prefixs break-pos)
(aref ideal-prefixs i)
(ekp-glue-ideal-pixel (aref glues-types i))))
(rest-pixel (- line-pixel ideal-pixel)))
(when hyphenate-p (cl-incf ideal-pixel hyphen-pixel))
;; Force break with high demerits
(aset demerits break-pos (+ 10000 (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 (j is-last end-with-hyphenp
ideal-pixel line-pixel
glues-types i k
prev-hyphen-count prev-fitness)
"Compute line demerits using full K-P formula.
Returns (demerits gaps fitness new-hyphen-count)."
(cond
;; 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)
(* 50 (- 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 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)))))
;; Unused but kept for reference
(defun ekp--dp-update-best (k arrays line-demerits line-gaps fitness
ideal-pixel line-pixel base-demerits new-hyphen line-num)
"Update ARRAYS at position K if this break is better."
(let* ((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))
(total-demerits (+ base-demerits line-demerits)))
(when (or (null (aref demerits k))
(< total-demerits (aref demerits k)))
(aset rests k (- line-pixel ideal-pixel))
(aset gaps k line-gaps)
(aset demerits k total-demerits)
(aset backptrs k (aref backptrs k)) ; will be set by caller
(aset fitness-classes k fitness)
(aset hyphen-counts k new-hyphen)
(aset line-counts k line-num)
t)))
(defun ekp--dp-trace-breaks (backptrs n)
"Trace optimal break points from BACKPTRS array."
(let ((breaks (list n))
(index n))
(while (> index 0)
(let ((prev (aref backptrs index)))
(if prev
(progn (push prev breaks)
(setq index prev))
(setq index (1- index)))))
(cdr breaks)))
(defun ekp--dp-trace-breaks-with-looseness (backptrs line-counts n target-lines)
"Trace breaks, preferring paths with TARGET-LINES line count.
Used for looseness parameter support."
(if (= ekp-looseness 0)
(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)))
;; For now, just use optimal path
;; Full looseness would require tracking multiple paths
(ekp--dp-trace-breaks backptrs n))))
(defun ekp--dp-store-cache (string line-pixel dp-cache)
"Store DP-CACHE for STRING at LINE-PIXEL."
(if-let ((dp-record (cdr (ekp-param-cache string))))
(puthash line-pixel dp-cache dp-record)
(let ((dp-record (make-hash-table :test 'equal :size 100
:rehash-size 1.5 :weakness nil)))
(puthash line-pixel dp-cache dp-record)
(puthash (ekp-param-fmtstr)
(cons (ekp-param-data string) dp-record)
(cdr (ekp-text-cache string))))))
(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-let* ((dp-record (cdr (ekp-param-cache string)))
(dp-cache (gethash line-pixel dp-record)))
dp-cache
(cached (gethash line-pixel dp-record)))
cached
;; Gather input data
(let* ((glues-types (ekp-glues-types string))
(boxes (ekp-boxes string))
(hyphen-pixel (ekp-hyphen-pixel string))
@ -402,129 +657,73 @@ return the value of KEY in plist."
(ideal-prefixs (ekp-ideal-prefixs string))
(min-prefixs (ekp-min-prefixs string))
(max-prefixs (ekp-max-prefixs string))
(backptrs (make-vector (1+ n) nil))
(costs (make-vector (1+ n) nil))
;; rest pixel = line-pixel - ideal-pixel
(rests (make-vector (1+ n) nil))
(gaps (make-vector (1+ n) nil))
;; 连续行 hyphen 结尾计数
(hyphen-line-count 0))
(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)))
;; Main DP loop: for each reachable position i
(dotimes (i (1+ n))
(aset costs i (if (= i 0) 0.0 nil)))
(dotimes (i (1+ n))
(when (aref costs i)
(setq hyphen-line-count 0)
(catch 'break
(dotimes (j (- n i))
(let* ((k (+ i j 1)) ;; k: end word index (exclusive)
(is-last (= k n))
(end-with-hyphenp (ekp-hyphenate-p glues-types k))
(ideal-pixel (- (aref ideal-prefixs k)
(aref ideal-prefixs i)
(ekp-glue-ideal-pixel
(aref glues-types i))))
(max-pixel (- (aref max-prefixs k)
(aref max-prefixs i)
(ekp-glue-max-pixel
(aref glues-types i))))
(min-pixel (- (aref min-prefixs k)
(aref min-prefixs i)
(ekp-glue-min-pixel
(aref glues-types i)))))
;; ends with hyphen, plus the pixel of hyphen
(when end-with-hyphenp
(cl-incf ideal-pixel hyphen-pixel)
(cl-incf max-pixel hyphen-pixel)
(cl-incf min-pixel hyphen-pixel))
;; back to last word
(when (or (> min-pixel line-pixel)
(and is-last (> ideal-pixel line-pixel)))
(when (null (aref costs (1- k)))
;; can not find a proper line break,
;; break line at prev box
(let* ((hyphenate-p (ekp-hyphenate-p glues-types (1- k)))
(ideal-pixel (- (aref ideal-prefixs (1- k))
(aref ideal-prefixs i)
(ekp-glue-ideal-pixel
(aref glues-types i))))
(rest-pixel (- line-pixel ideal-pixel)))
(when hyphenate-p (cl-incf ideal-pixel hyphen-pixel))
(aset costs (1- k) (+ 100 (expt rest-pixel 3)))
(aset rests (1- k) rest-pixel)
(aset backptrs (1- k) i)
(aset gaps (1- k)
(ekp--gaps-list
(seq-drop (cl-subseq glues-types i (1- k)) 1)))
;; (elog-debug "1-k:%s; rests:%S" (1- k)
;; (aref rests (1- k)))
))
(throw 'break nil))
(when (or (<= min-pixel line-pixel max-pixel)
(and is-last (<= ideal-pixel line-pixel)))
(let* ((line-gaps)
(line-cost
(cond
;; only has one word
((= j 0)
(expt (- ideal-pixel line-pixel) 3))
(is-last 0.0)
;; has more than one word
(t (let* ((cost-and-gaps
(ekp--line-cost-and-gaps
ideal-pixel line-pixel
(seq-subseq glues-types i k)))
(cost (plist-get cost-and-gaps :cost))
(gaps (plist-get cost-and-gaps :gaps)))
(setq line-gaps gaps)
(if end-with-hyphenp
(progn
;; add extra cost of hypen
(cl-incf hyphen-line-count)
(+ cost (* 1000 hyphen-line-count)))
(setq hyphen-line-count 0)
cost)))))
(total-cost (+ (aref costs i) line-cost)))
;; (message "total cost:%S" total-cost)
;; (message "hyphen-line-count:%S" hyphen-line-count)
(when (or (null (aref costs k))
(< (abs total-cost) (abs (aref costs k))))
;; set all for cost is smaller!
(aset rests k (- line-pixel ideal-pixel))
(aset gaps k line-gaps)
(aset costs k total-cost)
;; 断点设置为 当前行的起点 = 上一行的和结束点
(aset backptrs k i)))))))))
(let ((breaks (list n))
(index n))
(while (> index 0)
(let ((prev (aref backptrs index)))
(if prev (progn (push prev breaks)
(setq index prev))
(setq index (1- index)))))
(let* ((breaks (cdr breaks))
lines-rests lines-gaps dp-cache)
(dolist (i breaks)
(push (aref rests i) lines-rests)
(push (aref gaps i) lines-gaps))
;; set dp cache
(setq dp-cache (list :rests (nreverse lines-rests)
:gaps (nreverse lines-gaps)
:breaks breaks
:cost (aref costs (length boxes))))
;; update param cache
(if-let ((dp-record (cdr (ekp-param-cache string))))
(puthash line-pixel dp-cache dp-record)
(let ((dp-record (make-hash-table
:test 'equal :size 100
:rehash-size 1.5 :weakness nil)))
(puthash line-pixel dp-cache dp-record)
(puthash (ekp-param-fmtstr)
(cons (ekp-param-data string) dp-record)
(cdr (ekp-text-cache string)))))
dp-cache)))))
(when (aref demerits i)
(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))
(end-with-hyphenp (ekp-hyphenate-p glues-types k))
(metrics (ekp--dp-line-metrics
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
(when (or (> min-pixel line-pixel)
(and is-last (> ideal-pixel line-pixel)))
(when (null (aref demerits (1- k)))
(ekp--dp-force-break i k arrays glues-types
ideal-prefixs hyphen-pixel line-pixel))
(throw 'break nil))
;; Valid break point: compute demerits
(when (or (<= 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
j is-last end-with-hyphenp
ideal-pixel line-pixel glues-types i k
prev-hyphen-count prev-fitness)))
(let ((total-dem (+ (aref demerits i) dem)))
(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 (1+ prev-line-count))))))))))))
;; Extract optimal solution
(let* ((breaks (ekp--dp-trace-breaks-with-looseness
backptrs line-counts n (aref line-counts n)))
(lines-rests (mapcar (lambda (i) (aref rests i)) breaks))
(lines-gaps (mapcar (lambda (i) (aref gaps i)) breaks))
(dp-cache (list :rests lines-rests
:gaps lines-gaps
:breaks breaks
:cost (aref demerits n)
:line-count (aref line-counts n))))
(ekp--dp-store-cache string line-pixel dp-cache)
dp-cache))))
(defun ekp-dp-data (string line-pixel &optional key)
"Return the data plist of dp cache. If KEY is non-nil,
@ -542,156 +741,149 @@ return the value of KEY in plist."
"Return the break points of kp algorithm."
(ekp-dp-data string line-pixel :breaks))
;;; Line Glue Distribution
;; Distributes extra/deficit space across glues (gaps between boxes)
;; Priority: latin gaps → mixed gaps → CJK gaps
(defun ekp--distribute-gap-adjustment (rest-pixel gaps-list stretch-p)
"Distribute REST-PIXEL across GAPS-LIST.
STRETCH-P indicates stretch (t) or shrink (nil) mode.
Returns ((latin-adj . latin-extra) (mix-adj . mix-extra) (cjk-adj . cjk-extra))."
(let* ((latin-gaps (nth 0 gaps-list))
(mix-gaps (nth 1 gaps-list))
(cjk-gaps (nth 2 gaps-list))
(remaining rest-pixel)
;; Per-gap adjustment values
(latin-change (if stretch-p ekp-lws-stretch-pixel ekp-lws-shrink-pixel))
(mix-change (if stretch-p ekp-mws-stretch-pixel ekp-mws-shrink-pixel))
(cjk-change (if stretch-p ekp-cws-stretch-pixel 0))
;; Results
(latin-adj 0) (latin-extra 0)
(mix-adj 0) (mix-extra 0)
(cjk-adj 0) (cjk-extra 0))
;; Distribute to latin gaps first
(let ((latin-capacity (* latin-gaps latin-change)))
(if (< remaining latin-capacity)
(when (> latin-gaps 0)
(setq latin-adj (/ remaining latin-gaps))
(setq latin-extra (% remaining latin-gaps))
(setq remaining 0))
(setq latin-adj latin-change)
(setq remaining (- remaining latin-capacity))))
;; Then to mixed gaps
(when (> remaining 0)
(let ((mix-capacity (* mix-gaps mix-change)))
(if (< remaining mix-capacity)
(when (> mix-gaps 0)
(setq mix-adj (/ remaining mix-gaps))
(setq mix-extra (% remaining mix-gaps))
(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)))
(list (cons latin-adj latin-extra)
(cons mix-adj mix-extra)
(cons cjk-adj cjk-extra))))
(defun ekp--compute-glue-pixels (glues-types gaps-distribution stretch-p)
"Compute actual glue pixels from GLUES-TYPES and GAPS-DISTRIBUTION.
Returns list of pixel values for each glue."
(let ((latin-adj (car (nth 0 gaps-distribution)))
(latin-extra (cdr (nth 0 gaps-distribution)))
(mix-adj (car (nth 1 gaps-distribution)))
(mix-extra (cdr (nth 1 gaps-distribution)))
(cjk-adj (car (nth 2 gaps-distribution)))
(cjk-extra (cdr (nth 2 gaps-distribution)))
(latin-idx -1) (mix-idx -1) (cjk-idx -1))
(mapcar
(lambda (type)
(let* ((base (ekp-glue-ideal-pixel type))
(adj (pcase type
('lws (cl-incf latin-idx)
(+ latin-adj (if (< latin-idx latin-extra) 1 0)))
('mws (cl-incf mix-idx)
(+ 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))))
glues-types)))
(defun ekp--line-glue-single-box (line-pixel box-width hyphen-p hyphen-pixel)
"Compute glues for a single-box line."
(let ((trailing (- line-pixel box-width (if hyphen-p hyphen-pixel 0))))
(list 0 trailing)))
(defun ekp--line-glue-last-line (glues-types ideal-pixel line-pixel)
"Compute glues for last line (ragged right)."
(append '(0)
(mapcar #'ekp-glue-ideal-pixel glues-types)
(list (- line-pixel ideal-pixel))))
(defun ekp--line-glue-normal (glues-types rest-pixel gaps-list)
"Compute glues for a normal (justified) line."
(if (= rest-pixel 0)
(append '(0) (mapcar #'ekp-glue-ideal-pixel glues-types) '(0))
(let* ((stretch-p (> rest-pixel 0))
(distribution (ekp--distribute-gap-adjustment
(abs rest-pixel) gaps-list stretch-p))
(glue-pixels (ekp--compute-glue-pixels glues-types distribution stretch-p)))
(append '(0) glue-pixels '(0)))))
(defun ekp-line-glues (string line-pixel)
"Line glues include glues before first box and after last box.
So the length of line glues is: line-boxes-num + 1"
"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]."
(let* ((boxes-widths (ekp-boxes-widths string))
(boxes (ekp-boxes string))
(boxes-num (length boxes))
(boxes-num (length (ekp-boxes string)))
(glues-types (ekp-glues-types string))
(ideal-prefixs (ekp-ideal-prefixs string))
(max-prefixs (ekp-max-prefixs string))
(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))
(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
;; exclude glue before word at the start of line
(seq-drop (cl-subseq glues-types start end) 1))
(line-glues-types (seq-drop (cl-subseq glues-types start end) 1))
(is-last (>= end boxes-num))
line-glue)
(setq line-glue
(hyphen-p (ekp-hyphenate-p glues-types end))
(ideal-pixel (- (aref ideal-prefixs end)
(aref ideal-prefixs start)
(ekp-glue-ideal-pixel (aref glues-types start))))
(max-pixel (+ (- (aref max-prefixs end)
(aref max-prefixs start)
(ekp-glue-max-pixel (aref glues-types start)))
(if hyphen-p hyphen-pixel 0)))
glue-list)
(setq glue-list
(cond
;; Single box: just trailing space
((= 1 (length line-boxes-widths))
(if (ekp-hyphenate-p glues-types end)
;; ends with hyphen, minus hyphen-pixel
(list 0 (- line-pixel
(ekp-hyphen-pixel string)
(aref line-boxes-widths 0)))
(list 0 (- line-pixel (aref line-boxes-widths 0)))))
(ekp--line-glue-single-box line-pixel
(aref line-boxes-widths 0)
hyphen-p hyphen-pixel))
;; Last line: ragged right
(is-last
(ekp--line-glue-last-line line-glues-types ideal-pixel line-pixel))
;; Forced break (line too short even at max stretch)
((< max-pixel line-pixel)
(append '(0)
(mapcar #'ekp-glue-ideal-pixel line-glues-types)
(list
(- line-pixel (- (aref ideal-prefixs end)
(aref ideal-prefixs start)
(ekp-glue-ideal-pixel
(aref glues-types start)))))))
(mapcar #'ekp-glue-max-pixel line-glues-types)
(list (- line-pixel max-pixel))))
;; Normal justified line
(t
;; (elog-debug "-----------------")
;; (elog-debug "glues-types:%s" line-glues-types)
(let ((max-pixel (- (aref max-prefixs end)
(aref max-prefixs start)
(ekp-glue-max-pixel
(aref glues-types start)))))
;; ends with hyphen
(when (ekp-hyphenate-p glues-types end)
(cl-incf max-pixel (ekp-hyphen-pixel string)))
;; (elog-debug "start:%s; end:%s; max:%s" start end max-pixel)
(if (< max-pixel line-pixel)
(progn
;; 行尾直接断行的情况
;; (elog-debug "暴力断行 i:%s pixel:%s"
;; i (- line-pixel max-pixel))
(append '(0)
(mapcar #'ekp-glue-max-pixel line-glues-types)
(list (- line-pixel max-pixel))))
;; 正常情况
(let ((ideal-pixel (- (aref ideal-prefixs end)
(aref ideal-prefixs start)
(ekp-glue-ideal-pixel
(aref glues-types start)))))
;; ideal-pixel 包含第一个box之前的glue
;; (elog-debug "boxes:%S" (cl-subseq boxes start end))
;; (elog-debug "line:%s; ideal:%s; rest:%s; stored-rest:%s"
;; line-pixel ideal-pixel (- line-pixel ideal-pixel)
;; (nth i (ekp-dp-data string line-pixel :rests)))
)
(let* ((lines-rests (ekp-dp-data string line-pixel :rests))
(curr-rest-pixel (nth i lines-rests)))
;; (elog-debug "curr-rest-pixel:%s" curr-rest-pixel)
(cond
((= curr-rest-pixel 0)
(append '(0) (mapcar #'ekp-glue-ideal-pixel
line-glues-types)
'(0)))
(t
(let* ((lines-gaps (ekp-dp-data string line-pixel :gaps))
(line-gaps (nth i lines-gaps))
(latin-gaps (nth 0 line-gaps))
(mix-gaps (nth 1 line-gaps))
(cjk-gaps (nth 2 line-gaps))
(latin-gap-pixel 0) (latin-extra-gaps 0)
(mix-gap-pixel 0) (mix-extra-gaps 0)
(cjk-gap-pixel 0) (cjk-extra-gaps 0)
(line-rest-pixel (abs curr-rest-pixel)))
;; max-latin-change include stretch or shrink
(let* ((latin-gap-change (if (> curr-rest-pixel 0)
ekp-lws-stretch-pixel
ekp-lws-shrink-pixel))
(latin-max-pixel (* latin-gaps latin-gap-change)))
(if (< (- line-rest-pixel latin-max-pixel) 0)
(when (> latin-gaps 0)
;; only stretch latin glues
;; (elog-debug "latin-gap-pixel:%s"
;; (/ line-rest-pixel latin-gaps))
;; (elog-debug "latin-extra-gaps:%s"
;; (% line-rest-pixel latin-gaps))
(setq latin-gap-pixel (/ line-rest-pixel latin-gaps))
(setq latin-extra-gaps (% line-rest-pixel latin-gaps)))
;; stretch latin glues max and continue to stretch mix glues
(setq latin-gap-pixel latin-gap-change)
(setq line-rest-pixel (- line-rest-pixel latin-max-pixel))
(let* ((mix-gap-change (if (> curr-rest-pixel 0)
ekp-mws-stretch-pixel
ekp-mws-shrink-pixel))
(mix-max-pixel (* mix-gaps mix-gap-change)))
(if (< (- line-rest-pixel mix-max-pixel) 0)
(when (> mix-gaps 0)
;; only stretch mix glues
(setq mix-gap-pixel (/ line-rest-pixel mix-gaps))
(setq mix-extra-gaps (% line-rest-pixel mix-gaps)))
;; stretch mix glues max and continue to stretch cjk glues
(setq mix-gap-pixel mix-gap-change)
(setq line-rest-pixel (- line-rest-pixel mix-max-pixel))
(when (> cjk-gaps 0)
(setq cjk-gap-pixel (/ line-rest-pixel cjk-gaps))
(setq cjk-extra-gaps (% line-rest-pixel cjk-gaps)))))))
(let* ((latin-extra-index -1)
(mix-extra-index -1)
(cjk-extra-index -1)
(glue-pixel-lst
(mapcar
(lambda (type)
(let ((pixel (cond
((eq type 'lws)
(cl-incf latin-extra-index)
(if (< latin-extra-index latin-extra-gaps)
(1+ latin-gap-pixel)
latin-gap-pixel))
((eq type 'mws)
(cl-incf mix-extra-index)
(if (< mix-extra-index mix-extra-gaps)
(1+ mix-gap-pixel)
mix-gap-pixel))
((eq type 'cws)
(cl-incf cjk-extra-index)
(if (< cjk-extra-index cjk-extra-gaps)
(1+ cjk-gap-pixel)
cjk-gap-pixel))
((eq type 'nws) 0))))
(if (> curr-rest-pixel 0)
;; stretch
(+ (ekp-glue-ideal-pixel type) pixel)
;; shrink
(- (ekp-glue-ideal-pixel type) pixel))))
line-glues-types)))
;; (elog-debug "glue-pixel-lst:%S" glue-pixel-lst)
;; (elog-debug "--------------")
(append '(0) glue-pixel-lst '(0))))))))))))
(aset line-glues i (vconcat line-glue nil))
(ekp--line-glue-normal line-glues-types
(nth i lines-rests)
(nth i lines-gaps)))))
(aset line-glues i (vconcat glue-list))
(setq start end)))
line-glues))
@ -743,42 +935,54 @@ Default is nil, meaning cache is not used."
(ekp--pixel-justify str line-pixel)))
strs "\n")))
;;; Optimal Width Search
;; Uses ternary search instead of linear scan.
;; Cost function is roughly unimodal: too narrow = many breaks = high cost,
;; too wide = overstretched lines = high cost.
(defun ekp--compute-avg-cost (strings pixel)
"Compute average cost for STRINGS at PIXEL width."
(let ((costs (mapcar (lambda (s)
(if (string-blank-p s) 0
(abs (ekp-total-cost s pixel))))
strings)))
(/ (float (apply #'+ costs)) (max 1 (length costs)))))
(defun ekp--ternary-search-optimal-width (strings min-pixel max-pixel)
"Find optimal width in [MIN-PIXEL, MAX-PIXEL] using ternary search.
Returns the pixel width with minimum average cost."
(let ((lo min-pixel)
(hi max-pixel))
;; Ternary search: O(log n) instead of O(n)
(while (> (- hi lo) 2)
(let* ((mid1 (+ lo (/ (- hi lo) 3)))
(mid2 (- hi (/ (- hi lo) 3)))
(cost1 (ekp--compute-avg-cost strings mid1))
(cost2 (ekp--compute-avg-cost strings mid2)))
(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)))))
best-pixel)))
(defun ekp-pixel-range-justify (string min-pixel max-pixel &optional use-cache)
"Find the optimal breakpoint for STRING typesetting between
a MIN-PIXEL and MAX-PIXEL width and return a cons-cell. The car
of it is the typeset tex and cdr is the best pixel.
When USE-CACHE is non-nil, use the cache for performance.
Default is nil, meaning cache is not used."
"Find optimal width for STRING between MIN-PIXEL and MAX-PIXEL.
Returns (justified-text . optimal-pixel).
Uses ternary search for O(log n) complexity instead of O(n)."
(let* ((ekp-caches (if use-cache
ekp-caches
(make-hash-table
:test 'equal :size 100 :rehash-size 1.5 :weakness nil)))
(strings (split-string string "\n"))
(best-pixel max-pixel)
(best-cost-lst
(mapcar (lambda (string)
(if (string-blank-p string)
0
(abs (ekp-total-cost string max-pixel))))
strings))
;; get average cost of all lines' costs
(best-cost (/ (float (apply #'+ best-cost-lst))
(length best-cost-lst)))
(curr-pixel max-pixel))
(while (>= curr-pixel min-pixel)
(let* ((cost-lst
(mapcar (lambda (string)
(if (string-blank-p string)
0
(abs (ekp-total-cost string curr-pixel))))
strings))
(curr-cost (/ (float (apply #'+ cost-lst))
(length cost-lst))))
(when (< curr-cost best-cost)
(progn
(setq best-cost curr-cost)
(setq best-pixel curr-pixel)))
(cl-decf curr-pixel 1)))
(best-pixel (ekp--ternary-search-optimal-width strings min-pixel max-pixel)))
(cons (ekp-pixel-justify string best-pixel use-cache) best-pixel)))
(provide 'ekp)

View File

@ -67,7 +67,7 @@
(car (ekp-pixel-range-justify
(ekp-test-str cjk latin font) min max))))
;; (ekp-test-justify nil "en_US" "Cascadia Next SC" 699)
;; (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)