geekinney/ekp
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

refactor ekp cache and code improve

Browse Source
This commit is contained in:
Kinneyzhang 2026-01-24 22:40:53 +08:00
parent 68b46f8337
commit 6421f6b1fb
6 changed files with 1523 additions and 1527 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

478
ekp-hyphen.el
View File

@ -1,342 +1,202 @@
;;; ekp-hyphen.el -*- lexical-binding: t; -*-
;;; ekp-hyphen.el --- Liang hyphenation algorithm -*- lexical-binding: t; -*-
;; Copyright (C) 2024
;; Author: emacs-kp contributors
;; Keywords: text, hyphenation, typesetting
;; Package-Requires: ((emacs "27.1"))
;;; Commentary:
;; Implementation of Frank Liang's hyphenation algorithm.
;; See: Liang, F.M. "Word Hy-phen-a-tion by Com-put-er" (1983)
;;
;; Usage:
;; (ekp-hyphen-load-languages "/path/to/dictionaries")
;; (setq h (ekp-hyphen-create "en_US"))
;; (ekp-hyphen-inserted h "hyphenation") ; => "hy-phen-ation"
;; (ekp-hyphen-boxes h "hyphenation") ; => ("hy" "phen" "ation")
;;; Code:
(require 'cl-lib)
(require 'subr-x) ; for hash-table-keys
;; Cache: dictionary path -> compiled HyphDict
(defvar ekp-hyphen--hdcache (make-hash-table :test 'equal))
;;; Data Structure
;; Single struct holds everything: patterns, cache, and margin constraints.
;; Language registry: "en_US" -> dictionary file path
(defvar ekp-hyphen--languages (make-hash-table :test 'equal))
(cl-defstruct (ekp-hyphen (:constructor ekp-hyphen--create))
"Hyphenator object.
PATTERNS: hash-table, pattern-string -> (offset . priority-values).
CACHE: hash-table, word -> list of break positions.
MAXLEN: longest pattern length (bounds substring search).
LEFT/RIGHT: minimum chars before first / after last break."
patterns cache maxlen left right)
;; Fallback registry: "en" -> dictionary file path (first match)
(defvar ekp-hyphen--languages-lowercase (make-hash-table :test 'equal))
;;; Global State
;; Lines in .dic files starting with these are metadata, not patterns
(defconst ekp-hyphen--ignored
'("%" "#" "LEFTHYPHENMIN" "RIGHTHYPHENMIN"
"COMPOUNDLEFTHYPHENMIN" "COMPOUNDRIGHTHYPHENMIN"))
(defvar ekp-hyphen--cache (make-hash-table :test 'equal)
"Cache: dictionary path -> compiled ekp-hyphen.")
;; Data structures for hyphenation algorithm
;; See: Liang, F.M. "Word Hy-phen-a-tion by Com-put-er" (1983)
(defvar ekp-hyphen--langs (make-hash-table :test 'equal)
"Registry: language code -> dictionary file path.")
(cl-defstruct (ekp-hyphen--datint
(:constructor ekp-hyphen--make-datint))
"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"
(defvar ekp-hyphen--langs-short (make-hash-table :test 'equal)
"Fallback: short code (e.g., 'en') -> first matching dict path.")
(cl-defstruct (ekp-hyphen--altparser
(:constructor ekp-hyphen--make-altparser))
"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
;;; Dictionary Loading
(cl-defstruct (ekp-hyphen (:constructor ekp-hyphen--make))
"User-facing hyphenator object."
hd ; compiled HyphDict
left ; minimum chars before first break (default 2)
right) ; minimum chars after last break (default 2)
(defun ekp-hyphen-load-languages (dir)
"Scan DIR for .dic files, populate language registry."
(dolist (file (directory-files dir t "\\.dic\\'"))
(let* ((name (file-name-nondirectory file))
(lang (replace-regexp-in-string "\\(^hyph_\\|\\.dic$\\)" "" name))
(short (car (split-string lang "_"))))
(puthash lang file ekp-hyphen--langs)
(unless (gethash short ekp-hyphen--langs-short)
(puthash short file ekp-hyphen--langs-short)))))
(cl-defstruct (ekp-hyphen--hyphdict
(:constructor ekp-hyphen--make-hyphdict))
"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."
(replace-regexp-in-string
"\\^\\^\\([0-9a-fA-F][0-9a-fA-F]\\)"
(lambda (m) (string (string-to-number (match-string 1 m) 16)))
s))
(defun ekp-hyphen--parse (pat)
"Parse pattern string PAT to list of (digit string, non-digit string)."
(let ((pos 0)
(len (length pat))
res)
(while (< pos len)
(let* ((digit (if (and (< pos len) (>= (aref pat pos) ?0)
(<= (aref pat pos) ?9))
(prog1 (string (aref pat pos)) (cl-incf pos))
""))
(ndigit (if (and (< pos len) (or (< (aref pat pos) ?0)
(> (aref pat pos) ?9)))
(prog1 (string (aref pat pos)) (cl-incf pos))
"")))
(push (list digit ndigit) res)))
(nreverse res)))
(defun ekp-hyphen--language-path (language)
"Get a fallback language available in our dictionaries for string LANGUAGE."
(let* ((parts (split-string
(downcase (replace-regexp-in-string "-" "_" language)) "_"))
(found nil))
(or (gethash language ekp-hyphen--languages)
(progn
(defun ekp-hyphen--resolve-lang (lang)
"Resolve LANG to dictionary path, trying exact then short forms."
(or (gethash lang ekp-hyphen--langs)
(let* ((norm (downcase (replace-regexp-in-string "-" "_" lang)))
(parts (split-string norm "_"))
found)
(while (and parts (not found))
(let ((lang (mapconcat #'identity parts "_")))
(setq found (gethash lang ekp-hyphen--languages-lowercase))
(pop parts)))
found))))
(setq found (gethash (string-join parts "_")
ekp-hyphen--langs-short)
parts (butlast parts)))
found)))
(defun ekp-hyphen--altparser-create (pattern alternative)
"Create an AlternativeParser struct from PATTERN and ALTERNATIVE."
(let* ((alt (split-string alternative ","))
(change (nth 0 alt))
(index (string-to-number (nth 1 alt)))
(cut (string-to-number (nth 2 alt))))
(if (string-prefix-p "." pattern)
(cl-incf index))
(ekp-hyphen--make-altparser :change change :index index :cut cut)))
;;; Pattern Compilation
(defun ekp-hyphen--altparser-call (altparser val)
"Call ALTPARSER with value VAL."
(let ((index (cl-decf (ekp-hyphen--altparser-index altparser)))
(v (string-to-number val)))
(if (cl-oddp v)
(ekp-hyphen--make-datint
:value v
:data (list (ekp-hyphen--altparser-change altparser)
index
(ekp-hyphen--altparser-cut altparser)))
v)))
(defun ekp-hyphen--parse-pattern (pat)
"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)."
(let ((pos 0) (len (length pat)) letters values)
(while (< pos len)
;; Read optional digit (priority before next letter or at end)
(let ((digit 0))
(when (and (< pos len)
(>= (aref pat pos) ?0)
(<= (aref pat pos) ?9))
(setq digit (- (aref pat pos) ?0))
(cl-incf pos))
(push digit values)
;; Read letter if present
(when (and (< pos len)
(or (< (aref pat pos) ?0) (> (aref pat pos) ?9)))
(push (aref pat pos) letters)
(cl-incf pos))))
(setq letters (apply #'string (nreverse letters))
values (vconcat (nreverse values)))
;; Trim leading/trailing zeros
(let ((start 0) (end (length values)))
(while (and (< start end) (= (aref values start) 0)) (cl-incf start))
(while (and (> end start) (= (aref values (1- end)) 0)) (cl-decf end))
(when (> end start)
(list letters start (cl-subseq values start end))))))
(defun ekp-hyphen--read-dic-file (path)
"Read a .dic file from PATH. Return (encoding . lines-list)."
(defun ekp-hyphen--compile (path)
"Compile dictionary at PATH into ekp-hyphen struct."
(let ((patterns (make-hash-table :test 'equal))
(maxlen 0))
(with-temp-buffer
(insert-file-contents path)
(let ((encoding (buffer-substring-no-properties
(forward-line 1) ; skip encoding line
(while (not (eobp))
(let* ((line (string-trim (buffer-substring-no-properties
(point) (line-end-position))))
(forward-line 1)
(cons encoding
(split-string (buffer-substring-no-properties
(point) (point-max))
"\n" t)))))
(defun ekp-hyphen--make-hyphdict-from-path (path)
"Build a HyphDict structure from a .dic file at PATH."
(let* ((file (ekp-hyphen--read-dic-file path))
(encoding (car file))
(lines (cdr file))
(patterns (make-hash-table :test 'equal)))
(dolist (line lines)
(let* ((p (string-trim line)))
(unless (or (string-empty-p p)
(cl-some (lambda (ig) (string-prefix-p ig p))
ekp-hyphen--ignored))
(setq p (ekp-hyphen--parse-hex p))
(let* ((factory
(if (and (string-match "/" p) (string-match "=" p))
(let* ((split (split-string p "/" t))
(pattern (car split))
(alternative (cadr split)))
(lambda (i)
(ekp-hyphen--altparser-call
(ekp-hyphen--altparser-create pattern alternative)
(or i "0"))))
#'string-to-number))
(pattern (if (and (string-match "/" p) (string-match "=" p))
(car (split-string p "/" t))
p))
(tags-values
(mapcar (lambda (pr) (list (cadr pr)
(funcall factory (car pr))))
(ekp-hyphen--parse pattern))))
(let ((tags (mapcar #'car tags-values))
(values (mapcar #'cadr tags-values)))
(unless (= (apply #'max (mapcar
(lambda (v)
(if (integerp v) v
(ekp-hyphen--datint-value v)))
values))
0)
(let ((start 0) (end (length values)))
(while (and (< start end) (equal (elt values start) 0))
(cl-incf start))
(while (and (> end start) (equal (elt values (1- end)) 0))
(cl-decf end))
(puthash (apply #'concat tags)
(cons start (cl-subseq values start end))
patterns))))))))
(let* ((maxlen (apply #'max (mapcar #'length
(hash-table-keys patterns)))))
(ekp-hyphen--make-hyphdict :patterns patterns
(skip (or (string-empty-p line)
(string-match-p "^[%#]\\|HYPHENMIN" line)
(string-match-p "/" line)))) ; skip alt patterns
(unless skip
;; Handle ^^XX hex escapes
(setq line (replace-regexp-in-string
"\\^\\^\\([0-9a-fA-F]\\{2\\}\\)"
(lambda (m) (string (string-to-number
(match-string 1 m) 16)))
line))
(when-let ((parsed (ekp-hyphen--parse-pattern line)))
(puthash (car parsed) (cdr parsed) patterns)
(setq maxlen (max maxlen (length (car parsed)))))))
(forward-line 1)))
(ekp-hyphen--create :patterns patterns
:cache (make-hash-table :test 'equal)
:maxlen maxlen))))
:maxlen maxlen
:left 2 :right 2)))
(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))))
;;; Hyphenation Algorithm
(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."
(defun ekp-hyphen--compute (h word)
"Compute break positions for WORD using hyphenator H."
(let* ((padded (concat "." (downcase word) "."))
(len (length padded))
(maxlen (ekp-hyphen-maxlen h))
(patterns (ekp-hyphen-patterns h))
(prio (make-vector (1+ len) 0)))
;; Apply matching patterns
(dotimes (i (1- len))
(cl-loop for j from (1+ i) to (min (+ i maxlen) len)
for pat = (gethash (substring padded i j) patterns)
when pat do
(let ((off (car pat)) (vals (cadr pat)))
(dotimes (k (length vals))
(let ((pos (+ i off k)))
(when (< pos (length prio))
(aset prio pos (max (aref prio pos)
(aref vals k)))))))))
;; Collect odd positions (subtract 1 for padding offset)
(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)))
(dotimes (i (length prio))
(when (cl-oddp (aref prio i))
(push (1- i) result)))
(nreverse result))))
(defun ekp-hyphen-load-languages (dict-dir)
"Scan DICT-DIR for hyphenation dictionaries and populate
`ekp-hyphen--languages'."
(dolist (file (directory-files dict-dir t "\\.dic\\'"))
(let ((name (replace-regexp-in-string "\\(^hyph_\\|\\.dic$\\)" ""
(file-name-nondirectory file))))
(puthash name file ekp-hyphen--languages)
(let ((short (car (split-string name "_"))))
(unless (gethash short ekp-hyphen--languages-lowercase)
(puthash short file ekp-hyphen--languages-lowercase))))))
(defun ekp-hyphen--positions (h word)
"Get cached break positions for WORD."
(let* ((key (downcase word))
(cache (ekp-hyphen-cache h)))
(or (gethash key cache)
(puthash key (ekp-hyphen--compute h word) cache))))
(defun ekp-hyphen-create (&optional lang filename left right cache)
"Create a ekp-hyphen object. Prefer LANG, otherwise FILENAME.
LEFT and RIGHT are minimum first/last syllable chars. CACHE t/nil."
(let* ((left (or left 2))
(right (or right 2))
(cache (if (null cache) t cache))
(path (cond (lang (ekp-hyphen--language-path lang))
(filename filename))))
(unless path
(error "No dictionary found for language or filename"))
(let ((hd (or (and cache (gethash path ekp-hyphen--hdcache))
(let ((dict (ekp-hyphen--make-hyphdict-from-path path)))
(puthash path dict ekp-hyphen--hdcache)
dict))))
(ekp-hyphen--make :hd hd :left left :right right))))
;;; Public API
(defun ekp-hyphen-positions (ekp-hyphen word)
"Get hyphenation positions for WORD, using EKP-HYPHEN."
(let* ((hd (ekp-hyphen-hd ekp-hyphen))
(left (ekp-hyphen-left ekp-hyphen))
(right (- (length word) (ekp-hyphen-right ekp-hyphen))))
(cl-remove-if-not (lambda (i)
(and (<= left (ekp-hyphen--datint-value i))
(<= (ekp-hyphen--datint-value i) right)))
(ekp-hyphen--hyphdict-positions hd word))))
(defun ekp-hyphen-create (&optional lang file left right)
"Create hyphenator for LANG or dictionary FILE.
LEFT/RIGHT: min chars before/after breaks (default 2)."
(let ((path (or (and lang (ekp-hyphen--resolve-lang lang)) file)))
(unless path (error "No dictionary for: %s" lang))
(let ((h (or (gethash path ekp-hyphen--cache)
(puthash path (ekp-hyphen--compile path)
ekp-hyphen--cache))))
(if (or left right)
(ekp-hyphen--create :patterns (ekp-hyphen-patterns h)
:cache (ekp-hyphen-cache h)
:maxlen (ekp-hyphen-maxlen h)
:left (or left 2) :right (or right 2))
h))))
;; (defun ekp-hyphen-inserted (ekp-hyphen word &optional hyphen)
;; "Return WORD with all possible hyphens inserted."
;; (let ((hyphen (or hyphen "-"))
;; (letters (string-to-list word)))
;; (dolist (pos (reverse (ekp-hyphen-positions ekp-hyphen word)))
;; (let ((idx (ekp-hyphen--datint-value pos)))
;; (if (ekp-hyphen--datint-data pos)
;; (let* ((data (ekp-hyphen--datint-data pos))
;; (change (nth 0 data))
;; (index (+ (nth 1 data) idx))
;; (cut (nth 2 data))
;; (changestr (replace-regexp-in-string "=" hyphen change)))
;; (setq letters (append (cl-subseq letters 0 index)
;; (string-to-list changestr)
;; (cl-subseq letters (+ index cut)))))
;; (setq letters (append (cl-subseq letters 0 idx)
;; (string-to-list hyphen)
;; (cl-subseq letters idx))))))
;; (concat "" (mapconcat #'char-to-string letters ""))))
(defun ekp-hyphen-positions (h word)
"Return valid break positions in WORD, respecting margins."
(let ((left (ekp-hyphen-left h))
(right (- (length word) (ekp-hyphen-right h))))
(cl-remove-if-not (lambda (p) (and (>= p left) (<= p right)))
(ekp-hyphen--positions h word))))
(defun ekp-hyphen-inserted (ekp-hyphen word &optional hyphen)
"Return WORD with all possible hyphens inserted, preserving
text properties."
(let ((hyphen (or hyphen "-"))
(result word))
(dolist (pos (reverse (ekp-hyphen-positions ekp-hyphen word)))
(let ((idx (ekp-hyphen--datint-value pos)))
(if (ekp-hyphen--datint-data pos)
(let* ((data (ekp-hyphen--datint-data pos))
(change (nth 0 data))
(index (+ (nth 1 data) idx))
(cut (nth 2 data))
(changestr (replace-regexp-in-string "=" hyphen change)))
(setq result (concat (substring result 0 index)
changestr
(substring result (+ index cut)))))
(setq result (concat (substring result 0 idx)
(defun ekp-hyphen-inserted (h word &optional hyphen)
"Return WORD with HYPHEN inserted at break points."
(let ((hyphen (or hyphen "-")) (result word) (off 0))
(dolist (pos (ekp-hyphen-positions h word))
(setq result (concat (substring result 0 (+ pos off))
hyphen
(substring result idx))))))
(substring result (+ pos off)))
off (+ off (length hyphen))))
result))
(defun ekp-hyphen-boxes (ekp-hyphen word)
(split-string (ekp-hyphen-inserted ekp-hyphen word " ") " "))
(defun ekp-hyphen-boxes (h word)
"Split WORD into syllables at break points."
(split-string (ekp-hyphen-inserted h word " ") " "))
(provide 'ekp-hyphen)
;; (defun ekp-hyphen-iterate (ekp-hyphen word)
;; "Yield all hyphenation possibilities for WORD, longest first."
;; (let ((positions (reverse (ekp-hyphen-positions ekp-hyphen word)))
;; res)
;; (dolist (pos positions)
;; (let ((idx (ekp-hyphen--datint-value pos)))
;; (if (ekp-hyphen--datint-data pos)
;; (let* ((data (ekp-hyphen--datint-data pos))
;; (change (nth 0 data))
;; (index (+ (nth 1 data) idx))
;; (cut (nth 2 data))
;; (wordstr (if (string= word (upcase word))
;; (upcase change)
;; change))
;; (c1 (car (split-string wordstr "=")))
;; (c2 (cadr (split-string wordstr "="))))
;; (push (cons (concat (substring word 0 index) c1)
;; (concat c2 (substring word (+ index cut))))
;; res))
;; (push (cons (substring word 0 idx)
;; (substring word idx))
;; res))))
;; res))
;; (defun ekp-hyphen-wrap (ekp-hyphen word width &optional hyphen)
;; "Return (first-part . last-part) for WORD, where first-part
;; is <= WIDTH with hyphen."
;; (let ((hyphen (or hyphen "-"))
;; (poss (ekp-hyphen-iterate ekp-hyphen word)))
;; (setq width (- width (length hyphen)))
;; (catch 'found
;; (dolist (pair poss)
;; (when (<= (length (car pair)) width)
;; (throw 'found (cons (concat (car pair) hyphen)
;; (cdr pair))))))))
;;; ekp-hyphen.el ends here

229
ekp-utils.el
View File

@ -1,25 +1,15 @@
;; -*- lexical-binding: t; -*-
;;; ekp-utils.el --- Utility functions for EKP -*- lexical-binding: t; -*-
;;; related to font
;; Copyright (C) 2024
;; Author: emacs-kp contributors
;; (defun ekp-cjk-char-p (char)
;; "Return if char CHAR is cjk."
;; (or
;; ;; CJK统一表意文字（基本区）
;; (<= #x4E00 char #x9FFF)
;; ;; CJK扩展A区
;; (<= #x3400 char #x4DBF)
;; ;; CJK扩展B区（注意：超出16位范围）
;; (and (<= #x20000 char) (<= char #x2A6DF))
;; ;; CJK兼容/部首扩展等
;; ;; CJK符号和标点
;; (<= #x3000 char #x303F)
;; ;; 日文假名
;; (<= #x3040 char #x30FF)
;; ;; 韩文谚文
;; (<= #xAC00 char #xD7AF)
;; ;; CJK兼容表意文字
;; (<= #xF900 char #xFAFF)))
;;; Commentary:
;; Utilities for the Emacs Knuth-Plass (EKP) typesetting package.
;;; Code:
;;;; Font Detection
(defsubst ekp-cjk-char-p (char)
"Return non-nil if CHAR is a CJK character."
@ -104,78 +94,6 @@
(ekp-font-family letter)
(ekp-font-family "牛")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ekp-start-process-with-callback
(process-name command-args callback
&optional output-buffer)
"执行命令（带参数）并在完成后调用回调"
(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))))
process))
(defun ekp-rust-module-reload (module)
(let ((tmpfile (make-temp-file
(file-name-nondirectory module))))
(copy-file module tmpfile t)
(module-load tmpfile)))
(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-rust-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 `("zsh" "-c" ,(format "cd %s && cargo build -r"
(ekp-module-dir)))))
(lambda (proc buffer)
(ekp-rust-module-reload (ekp-module-file))
(message "ekp rust module reload success!")))
(error "Please install cargo and add it to executable path!")))
(defmacro ekp-setq (sym val)
"Set the value of symbol SYM to VAL. If VAL is nil, set to
the value of [SYM]-default."
`(setq ,sym (or ,val ,(intern (concat (symbol-name sym)
"-default")))))
(defun ekp-pixel-spacing (pixel)
"Return a pixel spacing with a PIXEL pixel width."
(if (= pixel 0)
@ -262,67 +180,72 @@ Whitespace separates boxes; CJK punctuation attaches to preceding char."
(make-hash-table
:test 'equal :size 100 :rehash-size 1.5 :weakness nil)))
;; (defun ekp-split-to-boxes (string)
;; "Split STRING into a vector: English by word, Chinese
;; by character, punctuation attached to previous unit."
;; (with-temp-buffer
;; (insert string)
;; (goto-char (point-min))
;; (let (words (index 0))
;; (while (not (eobp))
;; ;; skip whitespace
;; (skip-syntax-forward "-")
;; (unless (eobp)
;; (let ((start (point)))
;; (if (ekp-cjk-char-p (char-after))
;; (forward-char 1)
;; (forward-word 1)
;; ;; process float number
;; (when-let* ((char1 (char-after (point)))
;; (char2 (char-after (1+ (point))))
;; (_ (and (eq char1 ?.) (<= ?0 char2 ?9))))
;; (forward-word 1))
;; ;; process hyphen and contraction
;; (while (or (eq (char-after (point)) ?-)
;; (eq (char-after (point)) ?')
;; (eq (char-after (point)) ?/))
;; (forward-word 1)))
;; ;; attach punctuation
;; (while (and (not (eobp))
;; (with-syntax-table (standard-syntax-table)
;; (eq (char-syntax (char-after)) ?.)))
;; ;; (message "(char-after):%s" (char-after))
;; (forward-char 1))
;; (push (buffer-substring start (point)) words))))
;; (vconcat (nreverse words)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (defvar ekp-par-num 8)
;; (defun ekp-strings (string n)
;; "Split STRING to average N parts but don't split in a word."
;; ;; used for rust
;; (let* ((size (length string))
;; (each-size (/ size n))
;; (str-ends (--map (if (= it n) size (* it each-size))
;; (number-sequence 1 n)))
;; regions)
;; (with-temp-buffer
;; (insert string)
;; (goto-char (point-min))
;; (let ((str-start 0)
;; (prev-end 0))
;; (dolist (str-end str-ends)
;; (when (> str-end prev-end)
;; (goto-char (1+ str-end))
;; (while (and (not (eobp))
;; (not (eq ? (char-after)))
;; (< (char-width (char-after)) 2))
;; (forward-char 1))
;; (setq str-end (1- (point)))
;; (push (cons str-start str-end) regions)
;; (setq prev-end str-end)
;; (setq str-start str-end)))))
;; (vconcat (--map
;; (substring string (car it) (cdr it))
;; (nreverse regions)))))
(defun ekp-start-process-with-callback
(process-name command-args callback
&optional output-buffer)
"执行命令（带参数）并在完成后调用回调"
(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))))
process))
(defun ekp-rust-module-reload (module)
(let ((tmpfile (make-temp-file
(file-name-nondirectory module))))
(copy-file module tmpfile t)
(module-load tmpfile)))
(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-rust-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 `("zsh" "-c" ,(format "cd %s && cargo build -r"
(ekp-module-dir)))))
(lambda (proc buffer)
(ekp-rust-module-reload (ekp-module-file))
(message "ekp rust module reload success!")))
(error "Please install cargo and add it to executable path!")))
(provide 'ekp-utils)
;;; ekp-utils.el ends here

708
ekp.el
View File

@ -1,191 +1,169 @@
;; -*- lexical-binding: t; -*-
;;; ekp.el --- Knuth-Plass line breaking for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2024
;; Author: emacs-kp contributors
;; Keywords: text, typesetting, CJK
;; Package-Requires: ((emacs "27.1"))
;;; Commentary:
;; Implementation of the Knuth-Plass optimal line breaking algorithm
;; with support for CJK text and hyphenation.
;;
;; Reference: Knuth & Plass, "Breaking Paragraphs into Lines" (1981)
;;
;; Usage:
;; (ekp-pixel-justify "Your text here" 600)
;; (ekp-pixel-range-justify "Text" 500 700)
;;; Code:
(require 'cl-lib)
(require 'ekp-utils)
(require 'ekp-hyphen)
(defconst ekp-load-file-name (or load-file-name (buffer-file-name)))
(defconst ekp--load-file (or load-file-name (buffer-file-name))
"Path to this file, for locating dictionaries.")
(defvar ekp-latin-lang "en_US")
(defvar ekp-latin-lang "en_US"
"Language code for hyphenation (e.g., 'en_US', 'de_DE').")
(defvar ekp-param-use-default-p t
"Used in internal, you should not modify it!")
;;;; Glue Parameters
;; Glue = flexible space between boxes (Knuth-Plass terminology)
;; lws = Latin Word Space, mws = Mixed (Latin-CJK), cws = CJK
(defvar ekp-lws-ideal-pixel nil
"The ideal pixel of whitespace between latin words.")
(defvar ekp-lws-stretch-pixel nil
"The stretch pixel of whitespace between latin words.")
(defvar ekp-lws-shrink-pixel nil
"The shrink pixel of whitespace between latin words.")
(defvar ekp-mws-ideal-pixel nil
"The ideal pixel of whitespace between latin word and cjk char.")
(defvar ekp-mws-stretch-pixel nil
"The stretch pixel of whitespace between latin word and cjk char.")
(defvar ekp-mws-shrink-pixel nil
"The shrink pixel of whitespace between latin word and cjk char.")
(defvar ekp-cws-ideal-pixel nil
"The ideal pixel of non-whitespace, such between cjk chars.")
(defvar ekp-cws-stretch-pixel nil
"The stretch pixel of non-whitespace, such between cjk chars.")
(defvar ekp-cws-shrink-pixel nil
"The shrink pixel of non-whitespace, such between cjk chars.")
(defvar ekp-lws-ideal-pixel nil "Ideal Latin word spacing (pixels).")
(defvar ekp-lws-stretch-pixel nil "Max stretch for Latin spacing.")
(defvar ekp-lws-shrink-pixel nil "Max shrink for Latin spacing.")
(defvar ekp-mws-ideal-pixel nil "Ideal mixed (Latin-CJK) spacing.")
(defvar ekp-mws-stretch-pixel nil "Max stretch for mixed spacing.")
(defvar ekp-mws-shrink-pixel nil "Max shrink for mixed spacing.")
(defvar ekp-cws-ideal-pixel nil "Ideal CJK character spacing.")
(defvar ekp-cws-stretch-pixel nil "Max stretch for CJK spacing.")
(defvar ekp-cws-shrink-pixel nil "Max shrink for CJK spacing.")
;; Derived limits (computed from above)
(defvar ekp-lws-max-pixel nil)
(defvar ekp-lws-min-pixel nil)
(defvar ekp-mws-max-pixel nil)
(defvar ekp-mws-min-pixel nil)
(defvar ekp-cws-max-pixel nil)
(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)
;;;; K-P Algorithm Parameters
(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.")
"Penalty for each line break. Higher = fewer lines. Default 10.")
(defvar ekp-hyphen-penalty 50
"Penalty for breaking a word with hyphen (K-P: hyphenpenalty).
Higher values avoid hyphenation. Default 50.")
"Penalty for hyphenated breaks. Higher = 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.")
"Penalty when adjacent lines differ in tightness by >1 class.")
(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.")
"Minimum fill ratio for last line (0.0-1.0).")
(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.")
"Target line count offset: 0=optimal, +1=looser, -1=tighter.")
(defvar ekp-caches
(make-hash-table
:test 'equal :size 100 :rehash-size 1.5 :weakness nil)
"Key of ekp-caches is the hash of string.")
;;;; 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
ideal-prefixs min-prefixs max-prefixs
(dp-cache nil :type hash-table))
(defvar ekp--para-cache nil
"Cache: hash-key → ekp-para struct.")
(defvar ekp--use-default-params t
"Internal flag for parameter initialization.")
;;;; Initialization
(defun ekp-root-dir ()
(when ekp-load-file-name
(file-name-directory ekp-load-file-name)))
"Return directory containing ekp.el."
(when ekp--load-file
(file-name-directory ekp--load-file)))
(defun ekp-load-dicts ()
(defun ekp--load-dicts ()
"Load hyphenation dictionaries."
(ekp-hyphen-load-languages
(expand-file-name "./dictionaries" (ekp-root-dir))))
(expand-file-name "dictionaries" (ekp-root-dir))))
(ekp-load-dicts)
(ekp--load-dicts)
(defun ekp-param-check ()
"Check whether all params are set."
;;;; Parameter Management
(defun ekp--params-set-p ()
"Return non-nil if all spacing parameters are set."
(and 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))
(defun ekp-param-set-default (string)
(let* ((lws-pixel (ekp-word-spacing-pixel string))
(mws-pixel (- lws-pixel 2)))
(ekp-param-set
lws-pixel (round (* lws-pixel 0.5)) (round (* lws-pixel 0.333))
mws-pixel (round (* mws-pixel 0.5)) (round (* mws-pixel 0.333))
"Set default spacing parameters based on STRING's font."
(let* ((lws (ekp-word-spacing-pixel string))
(mws (- lws 2)))
(ekp-param-set lws (/ lws 2) (/ lws 3)
mws (/ mws 2) (/ mws 3)
0 2 0)))
(defun ekp-param-set ( lws-ideal lws-stretch lws-shrink
mws-ideal mws-stretch mws-shrink
cws-ideal cws-stretch cws-shrink)
(setq ekp-lws-ideal-pixel lws-ideal)
(setq ekp-lws-stretch-pixel lws-stretch)
(setq ekp-lws-shrink-pixel lws-shrink)
(setq ekp-mws-ideal-pixel mws-ideal)
(setq ekp-mws-stretch-pixel mws-stretch)
(setq ekp-mws-shrink-pixel mws-shrink)
(setq ekp-cws-ideal-pixel cws-ideal)
(setq ekp-cws-stretch-pixel cws-stretch)
(setq ekp-cws-shrink-pixel cws-shrink)
(unless (ekp-param-check)
(error "all pixel args should not be nil!"))
(setq ekp-lws-max-pixel (+ ekp-lws-ideal-pixel ekp-lws-stretch-pixel))
(setq ekp-lws-min-pixel (- ekp-lws-ideal-pixel ekp-lws-shrink-pixel))
(setq ekp-mws-max-pixel (+ ekp-mws-ideal-pixel ekp-mws-stretch-pixel))
(setq ekp-mws-min-pixel (- ekp-mws-ideal-pixel ekp-mws-shrink-pixel))
(setq ekp-cws-max-pixel (+ ekp-cws-ideal-pixel ekp-cws-stretch-pixel))
(setq ekp-cws-min-pixel (- ekp-cws-ideal-pixel ekp-cws-shrink-pixel))
(setq ekp-param-use-default-p nil))
(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."
(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--
ekp-cws-ideal-pixel cws-i ekp-cws-stretch-pixel cws-+ ekp-cws-shrink-pixel cws--)
(unless (ekp--params-set-p)
(error "All spacing parameters must be non-nil"))
(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))
(defun ekp-param-fmtstr ()
(format "%s-%s-%s-%s-%s-%s-%s-%s-%s"
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))
;;;; Text Analysis
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst ekp--latin-regexp
"[A-Za-z'\\-\u00C0-\u00D6\u00D8-\u00F6\u00F8-\u00FF\u0100-\u024F\u1E00-\u1EFF]"
"Regexp matching Latin characters including accented forms.")
;; 正确版本：包含完整字符集和组合标记
(defvar ekp-latin-regexp
(concat
"[" ; 开始字符集
"A-Za-z'-" ; 基础拉丁字母
"\300-\326\330-\366\370-\417" ; ISO-8859-1补充
"\u00C0-\u00D6\u00D8-\u00F6" ; Unicode基本补充
"\u00F8-\u00FF\u0100-\u024F" ; 扩展A/B
"\u1E00-\u1EFF" ; 扩展附加
"\uA780-\uA7F9" ; 拉丁扩展-D
"]" ; 闭合字符集
)
"正则表达式匹配所有拉丁字符及其变体，包括组合变音符")
(defun ekp-split-string (string)
;; return (boxes-vector . hyphen-positions-vector)
(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))
(idx 0)
new-boxes idxs)
(idx 0) new-boxes hyphen-idxs)
(dolist (box (append boxes nil))
(save-match-data
(if (string-match
(format
"^\\([[{<„‚¿¡*@\"']*\\)\\(%s+\\)\\([]}>.,*?\"']*\\)$"
ekp-latin-regexp)
(if (string-match (format "^\\([[{<„‚¿¡*@\"']*\\)\\(%s+\\)\\([]}>.,*?\"']*\\)$"
ekp--latin-regexp)
box)
(let* ((pure-word (match-string 2 box))
(left-punct (match-string 1 box))
(right-punct (match-string 3 box))
(word-lst (ekp-hyphen-boxes
(ekp-hyphen-create ekp-latin-lang)
pure-word))
(num (length word-lst)))
(when left-punct
(setf (car word-lst) (concat left-punct
(car word-lst))))
(when right-punct
(setf (car (last word-lst))
(concat (car (last word-lst))
right-punct)))
(push word-lst new-boxes)
(dotimes (i num)
(when (< i (1- num))
(push idx idxs))
;; Latin word: apply hyphenation
(let* ((left (match-string 1 box))
(word (match-string 2 box))
(right (match-string 3 box))
(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)))
(push parts new-boxes)
(dotimes (i n)
(when (< i (1- n)) (push idx hyphen-idxs))
(cl-incf idx)))
;; Non-Latin: single box
(push (list box) new-boxes)
(cl-incf idx))))
(let ((boxes-lst (apply #'append (nreverse new-boxes))))
(cons (vconcat boxes-lst)
(vconcat (nreverse idxs))))))
(cl-incf idx)))
(cons (vconcat (apply #'append (nreverse new-boxes)))
(vconcat (nreverse hyphen-idxs)))))
(defun ekp-str-type (str)
(defun ekp--str-type (str)
"STR should be single letter string."
(cond
;; a half-width cjk punct
@ -198,12 +176,12 @@ Useful for fitting text to specific space.")
(t (error "Abnormal string width %s for %s"
(string-width str) str))))
(defun ekp-box-type (box)
(defun ekp--box-type (box)
(unless (or (null box) (string-empty-p box))
(cons (ekp-str-type (substring box 0 1))
(ekp-str-type (substring box -1)))))
(cons (ekp--str-type (substring box 0 1))
(ekp--str-type (substring box -1)))))
(defun ekp-glue-type (prev-box-type curr-box-type)
(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."
@ -219,23 +197,19 @@ cjk and latin words; nws means no whitespace."
((or (eq before 'cjk-punct) (eq after 'cjk-punct)) 'cws))
'nws)))
(defun ekp--glues-types (boxes boxes-types hyphen_positions)
"Set type of all glue in boxes using `ekp-glue-type',
set type to 'nws for each glue after position in hyphen_positions."
;; IMPORTANT!
(let* ((num (length boxes))
(glues-types (make-vector num nil))
prev-box-type curr-box-type)
;; set hyphen position to 'nws
(dolist (i (append hyphen_positions nil))
(aset glues-types (1+ i) 'nws))
(dotimes (i num)
(unless (aref glues-types i)
(let ((curr-box-type (aref boxes-types i)))
(aset glues-types
i (ekp-glue-type prev-box-type curr-box-type))
(setq prev-box-type curr-box-type))))
glues-types))
(defun ekp--compute-glue-types (boxes boxes-types hyphen-positions)
"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))))
glues))
(defun ekp-glue-ideal-pixel (type)
(cond ((or (null type) (eq 'nws type)) 0)
@ -255,142 +229,120 @@ set type to 'nws for each glue after position in hyphen_positions."
((eq 'mws type) ekp-mws-max-pixel)
((eq 'cws type) ekp-cws-max-pixel)))
(defun ekp-text-hash (string)
(let ((latin-font (ekp-latin-font string))
(cjk-font (ekp-cjk-font string))
(print-text-properties t))
(secure-hash
'md5 (format "%s|%s|%s" latin-font cjk-font (prin1-to-string string)))))
;;; ============================================================
;;; Cache Implementation: Fast Hash + Flat Structure
;;; ============================================================
(defun ekp-text-cache (string)
;; consider font
;; (text-data . param-cache(param-data . dp-cache(dp-data)))
"Return the text cache of STRING. Text cache consists of
(data . param-cache). Data is a plist (:boxes boxes :boxes-widths
boxes-widths :glues-types glues-types)."
(let ((text-hash (ekp-text-hash string)))
(if-let ((_ ekp-caches)
(cache (gethash text-hash ekp-caches)))
cache
(when (or ekp-param-use-default-p
(null (ekp-param-check)))
(defun ekp--para-hash (string)
"Compute fast hash key for STRING.
Uses sxhash instead of MD5 for performance."
(let ((latin-font (ekp-latin-font string))
(cjk-font (ekp-cjk-font string)))
;; Combine: string identity + fonts + spacing params
;; sxhash is O(n) but much faster than MD5
(sxhash (list (sxhash 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))))
(defun ekp--make-para (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)))
(ekp-param-set-default string))
(setq ekp-param-use-default-p t)
(let* ((cjk-font (ekp-cjk-font string))
(latin-font (ekp-latin-font string))
(cons (ekp-split-string string))
(boxes (car cons))
(hyphen_after_positions (cdr cons))
(boxes-widths (vconcat
(mapcar #'string-pixel-width boxes)))
(boxes-types (vconcat (mapcar #'ekp-box-type boxes)))
(glues-types (ekp--glues-types boxes boxes-types
hyphen_after_positions))
(plist (list :boxes boxes
(setq ekp--use-default-params t)
;; Extract fonts
(let* ((latin-font (ekp-latin-font string))
(cjk-font (ekp-cjk-font string))
;; Split into boxes with hyphenation
(split-result (ekp--split-with-hyphen string))
(boxes (car split-result))
(hyphen-positions (cdr split-result))
(n (length boxes))
;; Compute box properties
(boxes-widths (vconcat (mapcar #'string-pixel-width boxes)))
(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
(ideal-prefixs (make-vector (1+ n) 0))
(min-prefixs (make-vector (1+ n) 0))
(max-prefixs (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
(ekp-para--create
:string string
:latin-font latin-font
:cjk-font cjk-font
:boxes boxes
:boxes-widths boxes-widths
:boxes-types boxes-types
:glues-types glues-types))
(cache (cons plist nil)))
(unless ekp-caches
(setq ekp-caches (make-hash-table
:test 'equal :size 100
:rehash-size 1.5 :weakness nil)))
(puthash text-hash cache ekp-caches)
cache))))
(defun ekp-text-data (string &optional key)
"Return the data plist of text cache. If KEY is non-nil,
return the value of KEY in plist."
(let ((data (car (ekp-text-cache string))))
(if key
(plist-get data key)
data)))
(defun ekp-boxes (string)
(ekp-text-data string :boxes))
(defun ekp-hyphen-str (string)
"-"
;; (propertize
;; "-"
;; 'face `(:family ,(ekp-text-data string :latin-font)))
)
(defun ekp-hyphen-pixel (string)
(string-pixel-width (ekp-hyphen-str string)))
(defun ekp-boxes-widths (string)
(ekp-text-data string :boxes-widths))
(defun ekp-boxes-types (string)
(ekp-text-data string :boxes-types))
(defun ekp-glues-types (string)
(ekp-text-data string :glues-types))
(defun ekp-param-cache (string)
;; (param-data . dp-cache(dp-data))
"Return a plist of ideal-prefixs, min-prefixs and max-prefixs
by caculating with string and other params."
(if-let* ((param-record (cdr (ekp-text-cache string)))
(param-cache (gethash (ekp-param-fmtstr) param-record)))
param-cache
(let* ((boxes-num (length (ekp-boxes string)))
(boxes-widths (ekp-boxes-widths string))
(glues-types (ekp-glues-types string))
(ideal-prefixs (make-vector (1+ boxes-num) 0))
(min-prefixs (make-vector (1+ boxes-num) 0))
(max-prefixs (make-vector (1+ boxes-num) 0)))
(dotimes (i boxes-num)
(aset ideal-prefixs (1+ i)
(+ (aref ideal-prefixs i) (aref boxes-widths i)
(ekp-glue-ideal-pixel (aref glues-types i))))
(aset min-prefixs (1+ i)
(+ (aref min-prefixs i) (aref boxes-widths i)
(ekp-glue-min-pixel (aref glues-types i))))
(aset max-prefixs (1+ i)
(+ (aref max-prefixs i) (aref boxes-widths i)
(ekp-glue-max-pixel (aref glues-types i)))))
(let* ((param-data (list :ideal-prefixs ideal-prefixs
:glues-types glues-types
:hyphen-pixel hyphen-pixel
:ideal-prefixs ideal-prefixs
:min-prefixs min-prefixs
:max-prefixs max-prefixs))
(param-cache (cons param-data nil)))
(if-let ((param-record (cdr (ekp-text-cache string))))
(puthash (ekp-param-fmtstr) param-cache param-record)
(let ((param-record (make-hash-table
:test 'equal :size 100
:rehash-size 1.5 :weakness nil)))
(puthash (ekp-param-fmtstr) param-cache param-record)
(puthash (ekp-text-hash string)
(cons (ekp-text-data string) param-record)
ekp-caches)))
param-cache))))
:max-prefixs max-prefixs
:dp-cache (make-hash-table :test 'eql :size 20))))
(defun ekp-param-data (string &optional key)
"Return the data plist of param cache. If KEY is non-nil,
return the value of KEY in plist."
(let ((data (car (ekp-param-cache string))))
(if key
(plist-get data key)
data)))
(defun ekp--get-para (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))))
(defun ekp-ideal-prefixs (string)
(ekp-param-data string :ideal-prefixs))
(defun ekp-clear-caches ()
"Clear all paragraph caches."
(interactive)
(setq ekp--para-cache nil))
(defun ekp-min-prefixs (string)
(ekp-param-data string :min-prefixs))
;;;; Paragraph Accessors
(defun ekp-max-prefixs (string)
(ekp-param-data string :max-prefixs))
(defun ekp--boxes (string)
(ekp-para-boxes (ekp--get-para string)))
;;; 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:
(defun ekp--boxes-widths (string)
(ekp-para-boxes-widths (ekp--get-para string)))
(defun ekp--glues-types (string)
(ekp-para-glues-types (ekp--get-para string)))
(defun ekp--ideal-prefixs (string)
(ekp-para-ideal-prefixs (ekp--get-para string)))
(defun ekp--min-prefixs (string)
(ekp-para-min-prefixs (ekp--get-para string)))
(defun ekp--max-prefixs (string)
(ekp-para-max-prefixs (ekp--get-para string)))
(defun ekp--hyphen-pixel (string)
(ekp-para-hyphen-pixel (ekp--get-para string)))
(defun ekp--hyphen-str (_string)
"Return hyphen character."
"-")
;;;; K-P Badness and Demerits
;; demerits = (linepenalty + badness)² + penalties
;;
;; Fitness classes ensure visual consistency:
@ -474,30 +426,12 @@ Returns (:badness NUM :fitness NUM :gaps LIST :adjustment NUM :flexibility NUM).
: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)
(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
;;;; Dynamic Programming Line Breaking
(defun ekp--dp-init-arrays (n)
"Initialize DP arrays for N boxes.
@ -532,7 +466,7 @@ Returns (ideal-pixel min-pixel max-pixel) excluding leading glue."
(fitness-classes (nth 5 arrays))
(line-counts (nth 6 arrays))
(break-pos (1- k))
(hyphenate-p (ekp-hyphenate-p glues-types break-pos))
(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))))
@ -585,29 +519,6 @@ Returns (demerits gaps fitness new-hyphen-count)."
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))
@ -632,31 +543,30 @@ Used for looseness parameter support."
;; 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-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-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-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)))
(cached (gethash line-pixel dp-record)))
(let* ((para (ekp--get-para string))
(cached (ekp--dp-get-cached para line-pixel)))
(if cached
cached
;; Gather input data
(let* ((glues-types (ekp-glues-types string))
(boxes (ekp-boxes string))
(hyphen-pixel (ekp-hyphen-pixel string))
;; 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))
(n (length boxes))
(ideal-prefixs (ekp-ideal-prefixs string))
(min-prefixs (ekp-min-prefixs string))
(max-prefixs (ekp-max-prefixs string))
(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))
@ -676,7 +586,7 @@ Uses Knuth-Plass dynamic programming with demerits."
(dotimes (j (- n i))
(let* ((k (+ i j 1))
(is-last (= k n))
(end-with-hyphenp (ekp-hyphenate-p glues-types k))
(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))
@ -717,13 +627,13 @@ Uses Knuth-Plass dynamic programming with demerits."
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
(dp-result (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))))
(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,
@ -838,15 +748,15 @@ Returns list of pixel values for each glue."
"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-num (length (ekp-boxes string)))
(glues-types (ekp-glues-types string))
(ideal-prefixs (ekp-ideal-prefixs string))
(max-prefixs (ekp-max-prefixs string))
(let* ((boxes-widths (ekp--boxes-widths string))
(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))
(hyphen-pixel (ekp--hyphen-pixel string))
(line-glues (make-vector (length breaks) nil))
(start 0))
(dotimes (i (length breaks))
@ -854,7 +764,7 @@ Each line's glues: [0 glue1 glue2 ... trailing-space]."
(line-boxes-widths (cl-subseq boxes-widths start end))
(line-glues-types (seq-drop (cl-subseq glues-types start end) 1))
(is-last (>= end boxes-num))
(hyphen-p (ekp-hyphenate-p glues-types end))
(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))))
@ -887,24 +797,34 @@ Each line's glues: [0 glue1 glue2 ... trailing-space]."
(setq start end)))
line-glues))
(defun ekp-combine-glues-and-boxes (glues boxes)
(defun ekp--interleave (list1 list2)
"Interleave elements of LIST1 and LIST2."
(let (result)
(while (or list1 list2)
(when list1 (push (pop list1) result))
(when list2 (push (pop list2) result)))
(nreverse result)))
(defun ekp--combine-glues-and-boxes (glues boxes)
"Combine GLUES (n+1 elements) and BOXES (n elements) into string."
(let* ((glues (append glues nil))
(last-glue (car (last glues)))
(glues (-drop-last 1 glues))
(glues (butlast glues))
(boxes (append boxes nil)))
(if (= (length glues) (length boxes))
(string-join (append (-interleave glues boxes)
(string-join (append (ekp--interleave glues boxes)
(list last-glue)))
(error "(length glues) + 1 != (length boxes)"))))
(error "Glues count (%d) must equal boxes count (%d) + 1"
(1+ (length glues)) (length boxes)))))
(defun ekp--pixel-justify (string line-pixel)
"Justify single STRING to LINE-PIXEL."
(let* ((boxes (ekp-boxes string))
(hyphen (ekp-hyphen-str string))
(let* ((boxes (ekp--boxes string))
(hyphen (ekp--hyphen-str string))
(breaks (ekp-line-breaks string line-pixel))
(num (length breaks))
(lines-glues (ekp-line-glues string line-pixel))
(glues-types (ekp-glues-types string))
(glues-types (ekp--glues-types string))
(start 0) strings)
(dotimes (i num)
(let* ((end (nth i breaks))
@ -912,23 +832,18 @@ Each line's glues: [0 glue1 glue2 ... trailing-space]."
(line-glues (mapcar #'ekp-pixel-spacing
(aref lines-glues i))))
;; not last line and glue is 'nws, should add hyphen
(when (ekp-hyphenate-p glues-types end)
(when (ekp--hyphenate-p glues-types end)
(setf (aref line-boxes (- end start 1))
(concat (aref line-boxes (- end start 1)) hyphen)))
(push (ekp-combine-glues-and-boxes line-glues line-boxes)
(push (ekp--combine-glues-and-boxes line-glues line-boxes)
strings)
(setq start end)))
(mapconcat 'identity (nreverse strings) "\n")))
(defun ekp-pixel-justify (string line-pixel &optional use-cache)
(defun ekp-pixel-justify (string line-pixel &optional _use-cache)
"Justify multiline STRING to LINE-PIXEL.
When USE-CACHE is non-nil, use the cache for performance.
Default is nil, meaning cache is not used."
(let ((ekp-caches (if use-cache
ekp-caches
(make-hash-table
:test 'equal :size 100 :rehash-size 1.5 :weakness nil)))
(strs (split-string string "\n")))
USE-CACHE is ignored; caching is always enabled via ekp--para-cache."
(let ((strs (split-string string "\n")))
(mapconcat (lambda (str)
(if (string-blank-p str)
""
@ -936,24 +851,28 @@ Default is nil, meaning cache is not used."
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.
;;
;; Uses ternary search with aggressive caching.
;; The key optimization: reuse box/glue preprocessing across all widths.
(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)))))
(let ((total-cost 0)
(count 0))
(dolist (s strings)
(unless (string-blank-p s)
(cl-incf total-cost (abs (ekp-total-cost s pixel)))
(cl-incf count)))
(if (> count 0)
(/ (float total-cost) count)
most-positive-fixnum)))
(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)
;; Ternary search: O(log n) iterations
(while (> (- hi lo) 2)
(let* ((mid1 (+ lo (/ (- hi lo) 3)))
(mid2 (- hi (/ (- hi lo) 3)))
@ -973,16 +892,19 @@ Returns the pixel width with minimum average cost."
best-pixel p)))))
best-pixel)))
(defun ekp-pixel-range-justify (string min-pixel max-pixel &optional use-cache)
(defun ekp-pixel-range-justify (string min-pixel max-pixel &optional _use-cache)
"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"))
Uses ternary search for O(log n) width evaluations.
All preprocessing is cached via ekp--para-cache."
(let* ((strings (split-string string "\n"))
;; Pre-warm caches
(_ (dolist (s strings)
(unless (string-blank-p s)
(ekp--get-para s))))
(best-pixel (ekp--ternary-search-optimal-width strings min-pixel max-pixel)))
(cons (ekp-pixel-justify string best-pixel use-cache) best-pixel)))
(cons (ekp-pixel-justify string best-pixel) best-pixel)))
(provide 'ekp)
;;; ekp.el ends here

177
readme.md
View File

@ -1,67 +1,172 @@
[中文文档](./readme_zh.md)
## Introduction
Emacs-kp implements the knuth-plass typesetting algorithm, but its capabilities extend beyond English typesetting. Through further optimization of the algorithm, it achieves hybrid typesetting for both CJK and Latin-based languages.
# Emacs-KP: Knuth-Plass Line Breaking for Emacs
Emacs-kp implements the Knuth-Plass optimal line breaking algorithm with full support for CJK (Chinese, Japanese, Korean) and Latin mixed text typesetting.
## Demo
First, let's look at a demo of the typesetting effect:
![ekp-demo](./images/ekp-demo-with-cache.gif)
## Algorithm Overview
### The Knuth-Plass Algorithm
The algorithm is based on the seminal 1981 paper ["Breaking Paragraphs into Lines"](http://www.eprg.org/G53DOC/pdfs/knuth-plass-breaking.pdf) by Donald Knuth and Michael Plass. Unlike greedy line-breaking (used by most text editors), K-P considers **all possible breakpoints** simultaneously to find the globally optimal solution.
#### Core Concepts
**1. Boxes, Glue, and Penalties**
Text is modeled as a sequence of three elements:
- **Box**: Indivisible content (characters, words) with fixed width
- **Glue**: Flexible space with ideal width, stretchability, and shrinkability
- **Penalty**: Cost for breaking at specific points (e.g., hyphenation)
```
┌─────┐ ┌─────┐ ┌─────┐
│ Box │─Glue─│ Box │─Glue─│ Box │
└─────┘ └─────┘ └─────┘
word (flexible) word
```
**2. Badness: Measuring Line Quality**
Each line's quality is measured by how much glue must stretch/shrink:
```
⎧ 0 if adjustment = 0
badness = ⎨ ∞ if impossible to fit
⎩ 100 × |adjustment/flexibility|³
```
- `adjustment` = target_width - natural_width
- `flexibility` = total stretchability (if stretching) or shrinkability (if shrinking)
**3. Demerits: Ranking Break Sequences**
Demerits combine badness with penalties to rank entire paragraph layouts:
```
demerits = (line_penalty + badness)² + penalty² + fitness_penalty
```
Where:
- `line_penalty`: Base cost per line (default: 10)
- `penalty`: Break-specific cost (hyphenation: 50)
- `fitness_penalty`: Extra cost when adjacent lines differ significantly in tightness
**4. Fitness Classes**
Lines are classified by tightness to ensure visual consistency:
- Class 0: Tight (significantly shrunk)
- Class 1: Decent (close to ideal)
- Class 2: Loose (stretched)
- Class 3: Very loose (significantly stretched)
Adjacent lines differing by more than one class incur additional penalty.
**5. Dynamic Programming**
The algorithm uses DP to find the minimum-demerits path through all valid breakpoints:
```
dp[k] = min over all valid i < k {
dp[i] + demerits(line from i to k)
}
```
Time complexity: O(n²) where n = number of potential breakpoints.
### CJK Extensions
Emacs-kp extends the original algorithm for CJK text:
1. **Character-level breaking**: CJK text can break between any characters
2. **Mixed spacing**: Three glue types for Latin-Latin, Latin-CJK, and CJK-CJK gaps
3. **Punctuation handling**: CJK punctuation attaches to adjacent characters
### Hyphenation
Latin word hyphenation uses Frank Liang's algorithm (TeX's hyphenation):
- Pattern-based approach with priority values
- Language-specific dictionaries (en_US, de_DE, fr, etc.)
- Configurable minimum characters before/after breaks
## Limitations
Currently, it only supports hybrid typesetting between CJK and one Latin-based language. Mixed typesetting with multiple Latin-based languages is not supported. This limitation arises because the system cannot precisely determine which language a word belongs to in order to perform hyphenation.
Currently supports CJK mixed with **one** Latin language only. Multi-Latin-language mixing is not supported because the system cannot reliably determine which language a word belongs to for hyphenation.
## Usage
### Configuration
`ekp-latin-lang` is used to set the primary Latin-based language in the text. The default setting is "en_US". All supported languages can be found in the "dictionaries" directory. The language name must match the name following "hyph_" in the dictionary files. Test cases include examples of German and French typesetting. Other languages have not been tested extensively but should theoretically work; however, finer customization may be required.
**`ekp-latin-lang`**: Primary Latin language for hyphenation (default: `"en_US"`).
See `dictionaries/` for supported languages.
`ekp-param-set` is a function used to configure fundamental typesetting parameters. These parameters include:
**`ekp-param-set`**: Configure spacing parameters (in pixels):
| Parameter | Meaning |
|:----------------------|:---------------------------------------------------------------|
| ekp-lws-ideal-pixel | Ideal pixel width between Latin words |
| ekp-lws-stretch-pixel | Stretchable pixel width between Latin words |
| ekp-lws-shrink-pixel | Shrinkable pixel width between Latin words |
| ekp-mws-ideal-pixel | Ideal pixel width between Latin words and CJK characters |
| ekp-mws-stretch-pixel | Stretchable pixel width between Latin words and CJK characters |
| ekp-mws-shrink-pixel | Shrinkable pixel width between Latin words and CJK characters |
| ekp-cws-ideal-pixel | Ideal pixel width between CJK characters |
| ekp-cws-stretch-pixel | Stretchable pixel width between CJK characters |
| ekp-cws-shrink-pixel | Shrinkable pixel width between CJK characters |
| Parameter | Description |
|:----------------------|:-----------------------------------------------|
| `ekp-lws-ideal-pixel` | Ideal space between Latin words |
| `ekp-lws-stretch-pixel` | Maximum stretch between Latin words |
| `ekp-lws-shrink-pixel` | Maximum shrink between Latin words |
| `ekp-mws-ideal-pixel` | Ideal space between Latin and CJK |
| `ekp-mws-stretch-pixel` | Maximum stretch between Latin and CJK |
| `ekp-mws-shrink-pixel` | Maximum shrink between Latin and CJK |
| `ekp-cws-ideal-pixel` | Ideal space between CJK characters |
| `ekp-cws-stretch-pixel` | Maximum stretch between CJK characters |
| `ekp-cws-shrink-pixel` | Maximum shrink between CJK characters |
For example: `(ekp-param-set 7 3 2 5 2 1 0 2 0)` sets the above parameters accordingly. **​​Do not modify these variables directly – always use this function for configuration.​​**
Example: `(ekp-param-set 7 3 2 5 2 1 0 2 0)`
If not manually configured, the default values follow KP algorithm recommendations for spaces between latin words:
**Do not set these variables directly—always use `ekp-param-set`.**
- The ideal width is set to the pixel width of a space character.
- The stretchable width defaults to 1/2 of the ideal width.
- The shrinkable width defaults to 1/3 of the ideal width.
Default values follow K-P recommendations:
- Ideal = space character width
- Stretch = ideal × 0.5
- Shrink = ideal × 0.33
For spaces between latin word and CJK character: `ekp-mws-ideal-pixel = ekp-lws-ideal-pixel - 2` while maintaining the same stretch/shrink proportions.
### K-P Algorithm Parameters
For spaces between CJK characters: Ideal width between CJK characters defaults to 0. Stretchable width between CJK characters defaults to 2 pixels. Shrinkable width between CJK characters defaults to 0 (non-compressible).
| Parameter | Default | Description |
|:------------------------------|:--------|:-----------------------------------------|
| `ekp-line-penalty` | 10 | Base penalty per line break |
| `ekp-hyphen-penalty` | 50 | Penalty for hyphenated breaks |
| `ekp-adjacent-fitness-penalty`| 100 | Penalty 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) |
### Core Functions
Two functions are provided:
```elisp
(ekp-pixel-justify string line-pixel)
```
Justify STRING to LINE-PIXEL width per line. Returns formatted text.
```(ekp-pixel-justify string line-pixel)```
```elisp
(ekp-pixel-range-justify string min-pixel max-pixel)
```
Find optimal width in [MIN-PIXEL, MAX-PIXEL] range using ternary search.
Returns `(formatted-text . optimal-pixel)`.
Formats the text STRING to fit a pixel width of LINE-PIXEL per line and returns the justified text.
Note: Uses O(log n) ternary search with aggressive caching.
```(ekp-pixel-range-justify string min-pixel max-pixel)```
```elisp
(ekp-clear-caches)
```
Clear all paragraph caches.
Searches for optimal typesetting within the range of MIN-PIXEL to MAX-PIXEL. Returns a cons-cell where the car is the formatted text and the cdr is the pixel value achieving the best typesetting result. Please Note: This function iteratively computes the typesetting cost between the minimum and maximum pixel values to find the optimal case at the minimum cost. ​​If the specified range is too large, execution time may increase significantly.​​ Future updates plan to leverage Rust dynamic libraries for parallel computation to improve performance.
## Roadmap
## Next Todos
- [x] Preserve the original text's text properties.
- [ ] Refactor using Rust dynamic modules: Utilize Rust's parallel computing capabilities to enhance rendering performance.
- [ ] Implement autocorrection for punctuation: Correct English punctuation mistakenly used in Chinese text; Correct Chinese punctuation mistakenly used in English texts...
- [x] Preserve original text properties after formatting
- [x] Full Knuth-Plass demerits model with fitness classes
- [x] Hyphenation with consecutive-hyphen penalty
- [ ] Rust dynamic module for parallel computation
- [ ] Auto-correction for mixed punctuation
## Credits
- The core algorithm is fundamentally derived from the seminal paper: "Breaking Paragraphs into Lines" by ​​DONALD E. KNUTH AND MICHAEL F. PLASS​​.
- The implementation of ​​Latin word hyphenation​​ is adapted from the source code of the ​​`Pyphen​`​ Python library, and the corresponding dictionaries originate from this project: https://github.com/Kozea/Pyphen
- Core algorithm: ["Breaking Paragraphs into Lines"](http://www.eprg.org/G53DOC/pdfs/knuth-plass-breaking.pdf) by Donald E. Knuth and Michael F. Plass (1981)
- Hyphenation: Adapted from [Pyphen](https://github.com/Kozea/Pyphen), using Liang's algorithm
- Dictionaries: [Hunspell hyphenation patterns](https://github.com/Kozea/Pyphen)

179
readme_zh.md
View File

@ -1,57 +1,170 @@
## 介绍
Emacs-kp 实现了 knuth-plass 排版算法，但其功能不局限于英文排版，我对算法的进一步优化，实现了 CJK 与 Latin 系语言的混合排版。
# Emacs-KP: Knuth-Plass 排版算法 Emacs 实现
Emacs-kp 实现了 Knuth-Plass 最优断行算法，并扩展支持 CJK（中日韩）与拉丁文混合排版。
## 演示
先来看一下排版效果的 demo：
![ekp-demo](./images/ekp-demo-with-cache.gif)
## 算法原理
### Knuth-Plass 算法
本算法基于 Donald Knuth 和 Michael Plass 于 1981 年发表的经典论文 ["Breaking Paragraphs into Lines"](http://www.eprg.org/G53DOC/pdfs/knuth-plass-breaking.pdf)。与大多数文本编辑器使用的贪心断行不同，K-P 算法**同时考虑所有可能的断点**，寻找全局最优解。
#### 核心概念
**1. Box（盒子）、Glue（胶水）、Penalty（惩罚）**
文本被建模为三种元素的序列：
- **Box**：不可分割的内容（字符、单词），具有固定宽度
- **Glue**：弹性空白，具有理想宽度、可拉伸量、可压缩量
- **Penalty**：在特定位置断行的代价（如连字符断词）
```
┌─────┐ ┌─────┐ ┌─────┐
│ Box │─Glue─│ Box │─Glue─│ Box │
└─────┘ └─────┘ └─────┘
单词 (弹性空白) 单词
```
**2. Badness（劣度）：衡量行的质量**
每行的质量由 glue 需要拉伸/压缩的程度来衡量：
```
⎧ 0 若 adjustment = 0
badness = ⎨ ∞ 若无法容纳
⎩ 100 × |adjustment/flexibility|³
```
- `adjustment` = 目标宽度 - 自然宽度
- `flexibility` = 可拉伸总量（拉伸时）或可压缩总量（压缩时）
**3. Demerits（缺陷值）：评估断行序列**
Demerits 综合 badness 和 penalty 来评估整个段落的排版质量：
```
demerits = (line_penalty + badness)² + penalty² + fitness_penalty
```
其中：
- `line_penalty`：每行的基础代价（默认：10）
- `penalty`：断点特定代价（连字符：50）
- `fitness_penalty`：相邻行松紧度差异过大时的额外代价
**4. Fitness Classes（适应度等级）**
行按松紧度分类，确保视觉一致性：
- 等级 0：紧凑（显著压缩）
- 等级 1：正常（接近理想）
- 等级 2：宽松（拉伸）
- 等级 3：非常宽松（显著拉伸）
相邻行等级差超过 1 会产生额外惩罚。
**5. 动态规划**
算法使用 DP 在所有有效断点中寻找最小 demerits 路径：
```
dp[k] = min over all valid i < k {
dp[i] + demerits(从 i 到 k 的行)
}
```
时间复杂度：O(n²)，n = 潜在断点数量。
### CJK 扩展
Emacs-kp 为 CJK 文本扩展了原算法：
1. **字符级断行**：CJK 文本可在任意字符间断行
2. **混合间距**：Latin-Latin、Latin-CJK、CJK-CJK 三种 glue 类型
3. **标点处理**：CJK 标点附着于相邻字符
### 连字符断词
拉丁语单词断词使用 Frank Liang 的算法（TeX 的断词算法）：
- 基于模式匹配的优先级方法
- 特定语言的词典（en_US、de_DE、fr 等）
- 可配置断点前后的最小字符数
## 局限
目前只支持 CJK 与任意一种拉丁系语言的混合排版，不支持多种拉丁系语言混合排版的场景。原因是无法精确判断单词属于哪种语言，从而对其进行 hyphen 断词。
目前仅支持 CJK 与**一种**拉丁语言的混合排版。不支持多种拉丁语言混排，因为系统无法可靠判断单词属于哪种语言以进行断词。
## 用法
### 配置项
`ekp-latin-lang` 用来设置文本中主要的拉丁系语言，默认设置为 "en_US"，dictionaries 下可以看到所有支持的语言，语言的名称也需要按照词典中 hyph_ 后面的名称来设置。测试用例中有德文和法文排版的例子，其他语言没有测试过，理论上应该没有问题，但不排除需要更为细节的调教。
`ekp-param-set` 这是一个函数，用来设置排版的基础参数，它们分别为：
**`ekp-latin-lang`**：用于断词的主要拉丁语言（默认：`"en_US"`）。
支持的语言见 `dictionaries/` 目录。
| 参数 | 含义 |
|:----------------------|:------------------------------------------|
| ekp-lws-ideal-pixel | 拉丁语言单词之间的理想像素宽度 |
| ekp-lws-stretch-pixel | 拉丁语言单词之间的可拉伸像素宽度 |
| ekp-lws-shrink-pixel | 拉丁语言单词之间的可压缩像素宽度 |
| ekp-mws-ideal-pixel | 拉丁语言单词和CJK字符之间的理想像素宽度 |
| ekp-mws-stretch-pixel | 拉丁语言单词和CJK字符之间的可拉伸像素宽度 |
| ekp-mws-shrink-pixel | 拉丁语言单词和CJK字符之间的可压缩像素宽度 |
| ekp-cws-ideal-pixel | CJK字符之间的理想像素宽度 |
| ekp-cws-stretch-pixel | CJK字符之间的可拉伸像素宽度 |
| ekp-cws-shrink-pixel | CJK字符之间的可压缩像素宽度 |
**`ekp-param-set`**：配置间距参数（单位：像素）：
例如 `(ekp-param-set 7 3 2 5 2 1 0 2 0)` 对应设置上面的值。请勿直接设置上面的变量，必须要使用这个函数来设置。
| 参数 | 说明 |
|:------------------------|:-------------------------------|
| `ekp-lws-ideal-pixel` | 拉丁单词间的理想间距 |
| `ekp-lws-stretch-pixel` | 拉丁单词间的最大拉伸量 |
| `ekp-lws-shrink-pixel` | 拉丁单词间的最大压缩量 |
| `ekp-mws-ideal-pixel` | 拉丁与 CJK 之间的理想间距 |
| `ekp-mws-stretch-pixel` | 拉丁与 CJK 之间的最大拉伸量 |
| `ekp-mws-shrink-pixel` | 拉丁与 CJK 之间的最大压缩量 |
| `ekp-cws-ideal-pixel` | CJK 字符间的理想间距 |
| `ekp-cws-stretch-pixel` | CJK 字符间的最大拉伸量 |
| `ekp-cws-shrink-pixel` | CJK 字符间的最大压缩量 |
如果不手动设置，默认会按照 KP 算法推荐的规则设置一个合适的值：理想宽度设置为空格的像素宽度；可拉伸宽度为理想宽度的1/2；可压缩宽度为理想宽度的1/3。默认设置 `ekp-mws-ideal-pixel = ekp-lws-ideal-pixel - 2`；拉伸和压缩比例与上面一致。中文字符间的理想宽度为0；可拉伸宽度2；无可压缩宽度。
示例：`(ekp-param-set 7 3 2 5 2 1 0 2 0)`
**请勿直接设置这些变量——必须使用 `ekp-param-set` 函数。**
默认值遵循 K-P 推荐：
- 理想宽度 = 空格字符宽度
- 可拉伸 = 理想 × 0.5
- 可压缩 = 理想 × 0.33
### 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 行） |
### 核心函数
提供了两个函数:
```elisp
(ekp-pixel-justify string line-pixel)
```
将 STRING 按 LINE-PIXEL 宽度排版，返回排版后的文本。
```(ekp-pixel-justify string line-pixel)```
```elisp
(ekp-pixel-range-justify string min-pixel max-pixel)
```
在 [MIN-PIXEL, MAX-PIXEL] 范围内使用三分搜索寻找最优宽度。
返回 `(排版文本 . 最优像素值)`。
将文本 STRING 按照每行像素宽度为 LINE-PIXEL 排版，返回排版后的文本。
注：使用 O(log n) 三分搜索，并积极缓存。
```(ekp-pixel-range-justify string min-pixel max-pixel)```
```elisp
(ekp-clear-caches)
```
清除所有段落缓存。
在 MIN-PIXEL 到 MAX-PIXEL 的返回内寻找最优排版，返回一个 cons-cell，car 是排版后的文本，cdr 是最优排版效果的像素值。请注意，该函数会遍历计算最小和最大像素之间的排版代价取最小值的情况，如果范围设置的太大执行时间可能会显著变长。后续考虑使用 rust 动态模块来并行计算，提高性能。
## 路线图
## 下一步
- [x] 排版后保留原始文本属性
- [x] 完整的 Knuth-Plass demerits 模型与 fitness classes
- [x] 支持连续连字符惩罚的断词
- [ ] Rust 动态模块实现并行计算
- [ ] 混合标点自动修正
- [x] 重排之后，保留文本原本的样式。
- [ ] 使用 rust 动态模块重写：利用 rust 并行计算提升渲染性能。
- [ ] 实现排版自动修正功能：比如修正中文中使用的英文标点；英文中使用的中文标点等
## 致谢
## 感谢
1. 毫无疑问核心算法源自此篇论文 "Breaking Paragraphs into Lines" by DONALD E. KNUTH AND MICHAEL F. PLASS
2. 拉丁单词的 hypen 断词的实现是由 Pyphen 这个 python 库的代码转写而来的，词库也来源于此: https://github.com/Kozea/Pyphen
- 核心算法：Donald E. Knuth 和 Michael F. Plass 的论文 ["Breaking Paragraphs into Lines"](http://www.eprg.org/G53DOC/pdfs/knuth-plass-breaking.pdf)（1981）
- 断词算法：改编自 [Pyphen](https://github.com/Kozea/Pyphen)，使用 Liang 算法
- 词典：[Hunspell 断词模式](https://github.com/Kozea/Pyphen)

77
tests/ekp-tests.el
View File

@ -1,6 +1,8 @@
;; -*- lexical-binding: t; -*-
;;; ekp-tests.el --- Tests for EKP -*- lexical-binding: t; -*-
;;; utils
(require 'ekp)
;;;; Test Utilities
(defun ekp-file-content (file)
(with-temp-buffer
(insert-file-contents file)
@ -132,3 +134,74 @@
"\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
(vector 0 10 38 76) ; ideal-prefixs
(vector 0 10 34 70) ; min-prefixs
(vector 0 10 42 82) ; max-prefixs
(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")))))
(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)
(message "=== Unit Tests Complete ==="))
;; (ekp-test-unit-all)