refactor ekp cache and code improve

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

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 'cl-lib)
(require 'subr-x) ; for hash-table-keys
;; Cache: dictionary path -> compiled HyphDict ;;; Data Structure
(defvar ekp-hyphen--hdcache (make-hash-table :test 'equal)) ;; Single struct holds everything: patterns, cache, and margin constraints.
;; Language registry: "en_US" -> dictionary file path (cl-defstruct (ekp-hyphen (:constructor ekp-hyphen--create))
(defvar ekp-hyphen--languages (make-hash-table :test 'equal)) "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) ;;; Global State
(defvar ekp-hyphen--languages-lowercase (make-hash-table :test 'equal))
;; Lines in .dic files starting with these are metadata, not patterns (defvar ekp-hyphen--cache (make-hash-table :test 'equal)
(defconst ekp-hyphen--ignored "Cache: dictionary path -> compiled ekp-hyphen.")
'("%" "#" "LEFTHYPHENMIN" "RIGHTHYPHENMIN"
"COMPOUNDLEFTHYPHENMIN" "COMPOUNDRIGHTHYPHENMIN"))
;; Data structures for hyphenation algorithm (defvar ekp-hyphen--langs (make-hash-table :test 'equal)
;; See: Liang, F.M. "Word Hy-phen-a-tion by Com-put-er" (1983) "Registry: language code -> dictionary file path.")
(cl-defstruct (ekp-hyphen--datint (defvar ekp-hyphen--langs-short (make-hash-table :test 'equal)
(:constructor ekp-hyphen--make-datint)) "Fallback: short code (e.g., 'en') -> first matching dict path.")
"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 ;;; Dictionary Loading
(: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
(cl-defstruct (ekp-hyphen (:constructor ekp-hyphen--make)) (defun ekp-hyphen-load-languages (dir)
"User-facing hyphenator object." "Scan DIR for .dic files, populate language registry."
hd ; compiled HyphDict (dolist (file (directory-files dir t "\\.dic\\'"))
left ; minimum chars before first break (default 2) (let* ((name (file-name-nondirectory file))
right) ; minimum chars after last break (default 2) (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 (defun ekp-hyphen--resolve-lang (lang)
(:constructor ekp-hyphen--make-hyphdict)) "Resolve LANG to dictionary path, trying exact then short forms."
"Compiled hyphenation dictionary." (or (gethash lang ekp-hyphen--langs)
patterns ; hash: pattern-string -> (offset . values) (let* ((norm (downcase (replace-regexp-in-string "-" "_" lang)))
cache ; hash: word -> positions (memoization) (parts (split-string norm "_"))
maxlen) ; longest pattern length (optimization) found)
(while (and parts (not found))
(setq found (gethash (string-join parts "_")
ekp-hyphen--langs-short)
parts (butlast parts)))
found)))
(defun ekp-hyphen--parse-hex (s) ;;; Pattern Compilation
"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) (defun ekp-hyphen--parse-pattern (pat)
"Parse pattern string PAT to list of (digit string, non-digit string)." "Parse PAT like 'hy3ph' into (letters offset . values).
(let ((pos 0) Values array has length = letters + 1 (position after last letter).
(len (length pat)) E.g., 'a1bc2' -> letters='abc', values=(0 1 0 2)."
res) (let ((pos 0) (len (length pat)) letters values)
(while (< pos len) (while (< pos len)
(let* ((digit (if (and (< pos len) (>= (aref pat pos) ?0) ;; Read optional digit (priority before next letter or at end)
(<= (aref pat pos) ?9)) (let ((digit 0))
(prog1 (string (aref pat pos)) (cl-incf pos)) (when (and (< pos len)
"")) (>= (aref pat pos) ?0)
(ndigit (if (and (< pos len) (or (< (aref pat pos) ?0) (<= (aref pat pos) ?9))
(> (aref pat pos) ?9))) (setq digit (- (aref pat pos) ?0))
(prog1 (string (aref pat pos)) (cl-incf pos)) (cl-incf pos))
""))) (push digit values)
(push (list digit ndigit) res))) ;; Read letter if present
(nreverse res))) (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--language-path (language) (defun ekp-hyphen--compile (path)
"Get a fallback language available in our dictionaries for string LANGUAGE." "Compile dictionary at PATH into ekp-hyphen struct."
(let* ((parts (split-string (let ((patterns (make-hash-table :test 'equal))
(downcase (replace-regexp-in-string "-" "_" language)) "_")) (maxlen 0))
(found nil)) (with-temp-buffer
(or (gethash language ekp-hyphen--languages) (insert-file-contents path)
(progn (forward-line 1) ; skip encoding line
(while (and parts (not found)) (while (not (eobp))
(let ((lang (mapconcat #'identity parts "_"))) (let* ((line (string-trim (buffer-substring-no-properties
(setq found (gethash lang ekp-hyphen--languages-lowercase)) (point) (line-end-position))))
(pop parts))) (skip (or (string-empty-p line)
found)))) (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
:left 2 :right 2)))
(defun ekp-hyphen--altparser-create (pattern alternative) ;;; Hyphenation Algorithm
"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)))
(defun ekp-hyphen--altparser-call (altparser val) (defun ekp-hyphen--compute (h word)
"Call ALTPARSER with value VAL." "Compute break positions for WORD using hyphenator H."
(let ((index (cl-decf (ekp-hyphen--altparser-index altparser))) (let* ((padded (concat "." (downcase word) "."))
(v (string-to-number val))) (len (length padded))
(if (cl-oddp v) (maxlen (ekp-hyphen-maxlen h))
(ekp-hyphen--make-datint (patterns (ekp-hyphen-patterns h))
:value v (prio (make-vector (1+ len) 0)))
:data (list (ekp-hyphen--altparser-change altparser) ;; Apply matching patterns
index (dotimes (i (1- len))
(ekp-hyphen--altparser-cut altparser))) (cl-loop for j from (1+ i) to (min (+ i maxlen) len)
v))) 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)
(dotimes (i (length prio))
(when (cl-oddp (aref prio i))
(push (1- i) result)))
(nreverse result))))
(defun ekp-hyphen--read-dic-file (path) (defun ekp-hyphen--positions (h word)
"Read a .dic file from PATH. Return (encoding . lines-list)." "Get cached break positions for WORD."
(with-temp-buffer (let* ((key (downcase word))
(insert-file-contents path) (cache (ekp-hyphen-cache h)))
(let ((encoding (buffer-substring-no-properties (or (gethash key cache)
(point) (line-end-position)))) (puthash key (ekp-hyphen--compute h word) cache))))
(forward-line 1)
(cons encoding
(split-string (buffer-substring-no-properties
(point) (point-max))
"\n" t)))))
(defun ekp-hyphen--make-hyphdict-from-path (path) ;;; Public API
"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
:cache (make-hash-table :test 'equal)
:maxlen maxlen))))
(defun ekp-hyphen--hyphdict-positions (hyphdict word) (defun ekp-hyphen-create (&optional lang file left right)
"Find all hyphenation positions in WORD using HYPHDICT. "Create hyphenator for LANG or dictionary FILE.
Returns list of ekp-hyphen--datint objects (odd value = break allowed)." LEFT/RIGHT: min chars before/after breaks (default 2)."
(let* ((word-lower (downcase word)) (let ((path (or (and lang (ekp-hyphen--resolve-lang lang)) file)))
(cache (ekp-hyphen--hyphdict-cache hyphdict)) (unless path (error "No dictionary for: %s" lang))
(cached-result (gethash word-lower cache))) (let ((h (or (gethash path ekp-hyphen--cache)
(or cached-result (puthash path (ekp-hyphen--compile path)
(let ((points (ekp-hyphen--compute-positions hyphdict word-lower))) ekp-hyphen--cache))))
(puthash word-lower points cache) (if (or left right)
points)))) (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--compute-positions (hyphdict word) (defun ekp-hyphen-positions (h word)
"Compute hyphenation positions for WORD (internal, no caching)." "Return valid break positions in WORD, respecting margins."
(let* ((pointed-word (concat "." word ".")) (let ((left (ekp-hyphen-left h))
(word-len (length pointed-word)) (right (- (length word) (ekp-hyphen-right h))))
(max-pattern-len (ekp-hyphen--hyphdict-maxlen hyphdict)) (cl-remove-if-not (lambda (p) (and (>= p left) (<= p right)))
(patterns (ekp-hyphen--hyphdict-patterns hyphdict)) (ekp-hyphen--positions h word))))
;; 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) (defun ekp-hyphen-inserted (h word &optional hyphen)
"Apply PATTERN values to PRIORITIES array starting at START." "Return WORD with HYPHEN inserted at break points."
(let ((offset (car pattern)) (let ((hyphen (or hyphen "-")) (result word) (off 0))
(values (cdr pattern))) (dolist (pos (ekp-hyphen-positions h word))
(cl-loop for idx from (+ start offset) (setq result (concat (substring result 0 (+ pos off))
for val in values hyphen
when (and (<= 0 idx) (< idx (length priorities))) (substring result (+ pos off)))
do (setf (nth idx priorities) off (+ off (length hyphen))))
(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
`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-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))))
(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-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-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)
hyphen
(substring result idx))))))
result)) result))
(defun ekp-hyphen-boxes (ekp-hyphen word) (defun ekp-hyphen-boxes (h word)
(split-string (ekp-hyphen-inserted ekp-hyphen word " ") " ")) "Split WORD into syllables at break points."
(split-string (ekp-hyphen-inserted h word " ") " "))
(provide 'ekp-hyphen) (provide 'ekp-hyphen)
;; (defun ekp-hyphen-iterate (ekp-hyphen word) ;;; ekp-hyphen.el ends here
;; "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))))))))

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) ;;; Commentary:
;; "Return if char CHAR is cjk."
;; (or ;; Utilities for the Emacs Knuth-Plass (EKP) typesetting package.
;; ;; CJK统一表意文字基本区
;; (<= #x4E00 char #x9FFF) ;;; Code:
;; ;; CJK扩展A区
;; (<= #x3400 char #x4DBF) ;;;; Font Detection
;; ;; CJK扩展B区注意超出16位范围
;; (and (<= #x20000 char) (<= char #x2A6DF))
;; ;; CJK兼容/部首扩展等
;; ;; CJK符号和标点
;; (<= #x3000 char #x303F)
;; ;; 日文假名
;; (<= #x3040 char #x30FF)
;; ;; 韩文谚文
;; (<= #xAC00 char #xD7AF)
;; ;; CJK兼容表意文字
;; (<= #xF900 char #xFAFF)))
(defsubst ekp-cjk-char-p (char) (defsubst ekp-cjk-char-p (char)
"Return non-nil if CHAR is a CJK character." "Return non-nil if CHAR is a CJK character."
@ -104,78 +94,6 @@
(ekp-font-family letter) (ekp-font-family letter)
(ekp-font-family ""))) (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) (defun ekp-pixel-spacing (pixel)
"Return a pixel spacing with a PIXEL pixel width." "Return a pixel spacing with a PIXEL pixel width."
(if (= pixel 0) (if (= pixel 0)
@ -262,67 +180,72 @@ Whitespace separates boxes; CJK punctuation attaches to preceding char."
(make-hash-table (make-hash-table
:test 'equal :size 100 :rehash-size 1.5 :weakness nil))) :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-start-process-with-callback
;; (defun ekp-strings (string n) (process-name command-args callback
;; "Split STRING to average N parts but don't split in a word." &optional output-buffer)
;; ;; used for rust "执行命令(带参数)并在完成后调用回调"
;; (let* ((size (length string)) (let* ((buffer-name (generate-new-buffer-name
;; (each-size (/ size n)) (or output-buffer "*EKP Process Output*")))
;; (str-ends (--map (if (= it n) size (* it each-size)) (process (apply #'start-process process-name
;; (number-sequence 1 n))) buffer-name command-args)))
;; regions) (set-process-sentinel
;; (with-temp-buffer process
;; (insert string) `(lambda (proc event)
;; (goto-char (point-min)) (if (string-match-p "finished" event)
;; (let ((str-start 0) (when (memq (process-status proc) '(exit signal))
;; (prev-end 0)) (unwind-protect
;; (dolist (str-end str-ends) (funcall ',callback proc (process-buffer proc))
;; (when (> str-end prev-end) (when (buffer-live-p (process-buffer proc))
;; (goto-char (1+ str-end)) (kill-buffer (process-buffer proc)))))
;; (while (and (not (eobp)) (message "%s, please check %s" (string-trim event)
;; (not (eq ? (char-after))) ,buffer-name))))
;; (< (char-width (char-after)) 2)) process))
;; (forward-char 1))
;; (setq str-end (1- (point))) (defun ekp-rust-module-reload (module)
;; (push (cons str-start str-end) regions) (let ((tmpfile (make-temp-file
;; (setq prev-end str-end) (file-name-nondirectory module))))
;; (setq str-start str-end))))) (copy-file module tmpfile t)
;; (vconcat (--map (module-load tmpfile)))
;; (substring string (car it) (cdr it))
;; (nreverse regions))))) (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) (provide 'ekp-utils)
;;; ekp-utils.el ends here

758
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-utils)
(require 'ekp-hyphen) (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 ;;;; Glue Parameters
"Used in internal, you should not modify it!") ;; Glue = flexible space between boxes (Knuth-Plass terminology)
;; lws = Latin Word Space, mws = Mixed (Latin-CJK), cws = CJK
(defvar ekp-lws-ideal-pixel nil (defvar ekp-lws-ideal-pixel nil "Ideal Latin word spacing (pixels).")
"The ideal pixel of whitespace between latin words.") (defvar ekp-lws-stretch-pixel nil "Max stretch for Latin spacing.")
(defvar ekp-lws-shrink-pixel nil "Max shrink for Latin spacing.")
(defvar ekp-lws-stretch-pixel nil (defvar ekp-mws-ideal-pixel nil "Ideal mixed (Latin-CJK) spacing.")
"The stretch pixel of whitespace between latin words.") (defvar ekp-mws-stretch-pixel nil "Max stretch for mixed spacing.")
(defvar ekp-mws-shrink-pixel nil "Max shrink for mixed spacing.")
(defvar ekp-lws-shrink-pixel nil (defvar ekp-cws-ideal-pixel nil "Ideal CJK character spacing.")
"The shrink pixel of whitespace between latin words.") (defvar ekp-cws-stretch-pixel nil "Max stretch for CJK spacing.")
(defvar ekp-cws-shrink-pixel nil "Max shrink for CJK spacing.")
(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.")
;; Derived limits (computed from above)
(defvar ekp-lws-max-pixel nil) (defvar ekp-lws-max-pixel nil)
(defvar ekp-lws-min-pixel nil) (defvar ekp-lws-min-pixel nil)
(defvar ekp-mws-max-pixel nil) (defvar ekp-mws-max-pixel nil)
(defvar ekp-mws-min-pixel nil) (defvar ekp-mws-min-pixel nil)
(defvar ekp-cws-max-pixel nil) (defvar ekp-cws-max-pixel nil)
(defvar ekp-cws-min-pixel nil) (defvar ekp-cws-min-pixel nil)
;;; Knuth-Plass Algorithm Parameters ;;;; K-P Algorithm Parameters
;; These control the trade-offs in line breaking optimization.
;; See: Knuth & Plass, "Breaking Paragraphs into Lines" (1981)
(defvar ekp-line-penalty 10 (defvar ekp-line-penalty 10
"Penalty added for each line break (K-P: linepenalty). "Penalty for each line break. Higher = fewer lines. Default 10.")
Higher values prefer fewer lines with more stretching.
Typical range: 0-100. Default 10.")
(defvar ekp-hyphen-penalty 50 (defvar ekp-hyphen-penalty 50
"Penalty for breaking a word with hyphen (K-P: hyphenpenalty). "Penalty for hyphenated breaks. Higher = avoid hyphenation. Default 50.")
Higher values avoid hyphenation. Default 50.")
(defvar ekp-adjacent-fitness-penalty 100 (defvar ekp-adjacent-fitness-penalty 100
"Penalty when adjacent lines differ in fitness class by > 1. "Penalty when adjacent lines differ in tightness by >1 class.")
Ensures visual consistency. Default 100.")
(defvar ekp-last-line-min-ratio 0.5 (defvar ekp-last-line-min-ratio 0.5
"Minimum fill ratio for last line (0.0-1.0). "Minimum fill ratio for last line (0.0-1.0).")
Avoids orphaned words. Default 0.5 = at least half width.")
(defvar ekp-looseness 0 (defvar ekp-looseness 0
"Target line count adjustment from optimal. "Target line count offset: 0=optimal, +1=looser, -1=tighter.")
0 = optimal, +1 = one more line (looser), -1 = one fewer line (tighter).
Useful for fitting text to specific space.")
(defvar ekp-caches ;;;; Paragraph Cache Structure
(make-hash-table ;;
:test 'equal :size 100 :rehash-size 1.5 :weakness nil) ;; All paragraph data is stored in a flat struct for O(1) access.
"Key of ekp-caches is the hash of string.") ;; 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 () (defun ekp-root-dir ()
(when ekp-load-file-name "Return directory containing ekp.el."
(file-name-directory ekp-load-file-name))) (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 (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 () ;;;; Parameter Management
"Check whether all params are set."
(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 (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-mws-ideal-pixel ekp-mws-stretch-pixel ekp-mws-shrink-pixel
ekp-cws-ideal-pixel ekp-cws-stretch-pixel ekp-cws-shrink-pixel)) ekp-cws-ideal-pixel ekp-cws-stretch-pixel ekp-cws-shrink-pixel))
(defun ekp-param-set-default (string) (defun ekp-param-set-default (string)
(let* ((lws-pixel (ekp-word-spacing-pixel string)) "Set default spacing parameters based on STRING's font."
(mws-pixel (- lws-pixel 2))) (let* ((lws (ekp-word-spacing-pixel string))
(ekp-param-set (mws (- lws 2)))
lws-pixel (round (* lws-pixel 0.5)) (round (* lws-pixel 0.333)) (ekp-param-set lws (/ lws 2) (/ lws 3)
mws-pixel (round (* mws-pixel 0.5)) (round (* mws-pixel 0.333)) mws (/ mws 2) (/ mws 3)
0 2 0))) 0 2 0)))
(defun ekp-param-set ( lws-ideal lws-stretch lws-shrink (defun ekp-param-set (lws-i lws-+ lws-- mws-i mws-+ mws-- cws-i cws-+ cws--)
mws-ideal mws-stretch mws-shrink "Set all spacing parameters.
cws-ideal cws-stretch cws-shrink) LWS = Latin word space, MWS = mixed, CWS = CJK.
(setq ekp-lws-ideal-pixel lws-ideal) Each takes ideal, stretch (+), and shrink (-) values."
(setq ekp-lws-stretch-pixel lws-stretch) (setq ekp-lws-ideal-pixel lws-i ekp-lws-stretch-pixel lws-+ ekp-lws-shrink-pixel lws--
(setq ekp-lws-shrink-pixel lws-shrink) ekp-mws-ideal-pixel mws-i ekp-mws-stretch-pixel mws-+ ekp-mws-shrink-pixel mws--
(setq ekp-mws-ideal-pixel mws-ideal) ekp-cws-ideal-pixel cws-i ekp-cws-stretch-pixel cws-+ ekp-cws-shrink-pixel cws--)
(setq ekp-mws-stretch-pixel mws-stretch) (unless (ekp--params-set-p)
(setq ekp-mws-shrink-pixel mws-shrink) (error "All spacing parameters must be non-nil"))
(setq ekp-cws-ideal-pixel cws-ideal) (setq ekp-lws-max-pixel (+ lws-i lws-+) ekp-lws-min-pixel (- lws-i lws--)
(setq ekp-cws-stretch-pixel cws-stretch) ekp-mws-max-pixel (+ mws-i mws-+) ekp-mws-min-pixel (- mws-i mws--)
(setq ekp-cws-shrink-pixel cws-shrink) ekp-cws-max-pixel (+ cws-i cws-+) ekp-cws-min-pixel (- cws-i cws--))
(unless (ekp-param-check) (setq ekp--use-default-params nil))
(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-fmtstr () ;;;; Text Analysis
(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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst ekp--latin-regexp
"[A-Za-z'\\-\u00C0-\u00D6\u00D8-\u00F6\u00F8-\u00FF\u0100-\u024F\u1E00-\u1EFF]"
"Regexp matching Latin characters including accented forms.")
;; 正确版本:包含完整字符集和组合标记 (defun ekp--split-with-hyphen (string)
(defvar ekp-latin-regexp "Split STRING into boxes with hyphenation points marked.
(concat Returns (boxes-vector . hyphen-positions-vector)."
"[" ; 开始字符集
"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)
(let* ((boxes (ekp-split-to-boxes string)) (let* ((boxes (ekp-split-to-boxes string))
(idx 0) (idx 0) new-boxes hyphen-idxs)
new-boxes idxs)
(dolist (box (append boxes nil)) (dolist (box (append boxes nil))
(save-match-data (if (string-match (format "^\\([[{<„‚¿¡*@\"']*\\)\\(%s+\\)\\([]}>.,*?\"']*\\)$"
(if (string-match ekp--latin-regexp)
(format box)
"^\\([[{<„‚¿¡*@\"']*\\)\\(%s+\\)\\([]}>.,*?\"']*\\)$" ;; Latin word: apply hyphenation
ekp-latin-regexp) (let* ((left (match-string 1 box))
box) (word (match-string 2 box))
(let* ((pure-word (match-string 2 box)) (right (match-string 3 box))
(left-punct (match-string 1 box)) (parts (ekp-hyphen-boxes (ekp-hyphen-create ekp-latin-lang) word))
(right-punct (match-string 3 box)) (n (length parts)))
(word-lst (ekp-hyphen-boxes (when left (setcar parts (concat left (car parts))))
(ekp-hyphen-create ekp-latin-lang) (when right (setcar (last parts) (concat (car (last parts)) right)))
pure-word)) (push parts new-boxes)
(num (length word-lst))) (dotimes (i n)
(when left-punct (when (< i (1- n)) (push idx hyphen-idxs))
(setf (car word-lst) (concat left-punct (cl-incf idx)))
(car word-lst)))) ;; Non-Latin: single box
(when right-punct (push (list box) new-boxes)
(setf (car (last word-lst)) (cl-incf idx)))
(concat (car (last word-lst)) (cons (vconcat (apply #'append (nreverse new-boxes)))
right-punct))) (vconcat (nreverse hyphen-idxs)))))
(push word-lst new-boxes)
(dotimes (i num)
(when (< i (1- num))
(push idx idxs))
(cl-incf idx)))
(push (list box) new-boxes)
(cl-incf idx))))
(let ((boxes-lst (apply #'append (nreverse new-boxes))))
(cons (vconcat boxes-lst)
(vconcat (nreverse idxs))))))
(defun ekp-str-type (str) (defun ekp--str-type (str)
"STR should be single letter string." "STR should be single letter string."
(cond (cond
;; a half-width cjk punct ;; a half-width cjk punct
@ -198,12 +176,12 @@ Useful for fitting text to specific space.")
(t (error "Abnormal string width %s for %s" (t (error "Abnormal string width %s for %s"
(string-width str) str)))) (string-width str) str))))
(defun ekp-box-type (box) (defun ekp--box-type (box)
(unless (or (null box) (string-empty-p box)) (unless (or (null box) (string-empty-p box))
(cons (ekp-str-type (substring box 0 1)) (cons (ekp--str-type (substring box 0 1))
(ekp-str-type (substring box -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 "Lws means whitespace between latin words; cws means
whitespace between cjk words; mws means whitespace between whitespace between cjk words; mws means whitespace between
cjk and latin words; nws means no whitespace." 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)) ((or (eq before 'cjk-punct) (eq after 'cjk-punct)) 'cws))
'nws))) 'nws)))
(defun ekp--glues-types (boxes boxes-types hyphen_positions) (defun ekp--compute-glue-types (boxes boxes-types hyphen-positions)
"Set type of all glue in boxes using `ekp-glue-type', "Compute glue types for BOXES. Positions after HYPHEN-POSITIONS are 'nws."
set type to 'nws for each glue after position in hyphen_positions." (let* ((n (length boxes))
;; IMPORTANT! (glues (make-vector n nil))
(let* ((num (length boxes)) prev-type)
(glues-types (make-vector num nil)) (dolist (i (append hyphen-positions nil))
prev-box-type curr-box-type) (aset glues (1+ i) 'nws))
;; set hyphen position to 'nws (dotimes (i n)
(dolist (i (append hyphen_positions nil)) (unless (aref glues i)
(aset glues-types (1+ i) 'nws)) (let ((curr-type (aref boxes-types i)))
(dotimes (i num) (aset glues i (ekp--glue-type prev-type curr-type))
(unless (aref glues-types i) (setq prev-type curr-type))))
(let ((curr-box-type (aref boxes-types i))) glues))
(aset glues-types
i (ekp-glue-type prev-box-type curr-box-type))
(setq prev-box-type curr-box-type))))
glues-types))
(defun ekp-glue-ideal-pixel (type) (defun ekp-glue-ideal-pixel (type)
(cond ((or (null type) (eq 'nws type)) 0) (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 'mws type) ekp-mws-max-pixel)
((eq 'cws type) ekp-cws-max-pixel))) ((eq 'cws type) ekp-cws-max-pixel)))
(defun ekp-text-hash (string) ;;; ============================================================
;;; Cache Implementation: Fast Hash + Flat Structure
;;; ============================================================
(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)) (let ((latin-font (ekp-latin-font string))
(cjk-font (ekp-cjk-font string)) (cjk-font (ekp-cjk-font string)))
(print-text-properties t)) ;; Combine: string identity + fonts + spacing params
(secure-hash ;; sxhash is O(n) but much faster than MD5
'md5 (format "%s|%s|%s" latin-font cjk-font (prin1-to-string string))))) (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-text-cache (string) (defun ekp--make-para (string)
;; consider font "Create and fully initialize ekp-para struct for STRING.
;; (text-data . param-cache(param-data . dp-cache(dp-data))) Computes ALL data in one pass: text, params, and prefix arrays."
"Return the text cache of STRING. Text cache consists of ;; Ensure params are set
(data . param-cache). Data is a plist (:boxes boxes :boxes-widths (when (or ekp--use-default-params (null (ekp--params-set-p)))
boxes-widths :glues-types glues-types)." (ekp-param-set-default string))
(let ((text-hash (ekp-text-hash string))) (setq ekp--use-default-params t)
(if-let ((_ ekp-caches) ;; Extract fonts
(cache (gethash text-hash ekp-caches))) (let* ((latin-font (ekp-latin-font string))
cache (cjk-font (ekp-cjk-font string))
(when (or ekp-param-use-default-p ;; Split into boxes with hyphenation
(null (ekp-param-check))) (split-result (ekp--split-with-hyphen string))
(ekp-param-set-default string)) (boxes (car split-result))
(setq ekp-param-use-default-p t) (hyphen-positions (cdr split-result))
(let* ((cjk-font (ekp-cjk-font string)) (n (length boxes))
(latin-font (ekp-latin-font string)) ;; Compute box properties
(cons (ekp-split-string string)) (boxes-widths (vconcat (mapcar #'string-pixel-width boxes)))
(boxes (car cons)) (boxes-types (vconcat (mapcar #'ekp--box-type boxes)))
(hyphen_after_positions (cdr cons)) (glues-types (ekp--compute-glue-types boxes boxes-types hyphen-positions))
(boxes-widths (vconcat (hyphen-pixel (string-pixel-width "-"))
(mapcar #'string-pixel-width boxes))) ;; Compute prefix arrays in one pass
(boxes-types (vconcat (mapcar #'ekp-box-type boxes))) (ideal-prefixs (make-vector (1+ n) 0))
(glues-types (ekp--glues-types boxes boxes-types (min-prefixs (make-vector (1+ n) 0))
hyphen_after_positions)) (max-prefixs (make-vector (1+ n) 0)))
(plist (list :boxes boxes ;; Single loop for all prefix computations
:latin-font latin-font (dotimes (i n)
:cjk-font cjk-font (let ((box-w (aref boxes-widths i))
:boxes-widths boxes-widths (glue-type (aref glues-types i)))
: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) (aset ideal-prefixs (1+ i)
(+ (aref ideal-prefixs i) (aref boxes-widths i) (+ (aref ideal-prefixs i) box-w
(ekp-glue-ideal-pixel (aref glues-types i)))) (ekp-glue-ideal-pixel glue-type)))
(aset min-prefixs (1+ i) (aset min-prefixs (1+ i)
(+ (aref min-prefixs i) (aref boxes-widths i) (+ (aref min-prefixs i) box-w
(ekp-glue-min-pixel (aref glues-types i)))) (ekp-glue-min-pixel glue-type)))
(aset max-prefixs (1+ i) (aset max-prefixs (1+ i)
(+ (aref max-prefixs i) (aref boxes-widths i) (+ (aref max-prefixs i) box-w
(ekp-glue-max-pixel (aref glues-types i))))) (ekp-glue-max-pixel glue-type)))))
(let* ((param-data (list :ideal-prefixs ideal-prefixs ;; Create struct with all data
:min-prefixs min-prefixs (ekp-para--create
:max-prefixs max-prefixs)) :string string
(param-cache (cons param-data nil))) :latin-font latin-font
(if-let ((param-record (cdr (ekp-text-cache string)))) :cjk-font cjk-font
(puthash (ekp-param-fmtstr) param-cache param-record) :boxes boxes
(let ((param-record (make-hash-table :boxes-widths boxes-widths
:test 'equal :size 100 :boxes-types boxes-types
:rehash-size 1.5 :weakness nil))) :glues-types glues-types
(puthash (ekp-param-fmtstr) param-cache param-record) :hyphen-pixel hyphen-pixel
(puthash (ekp-text-hash string) :ideal-prefixs ideal-prefixs
(cons (ekp-text-data string) param-record) :min-prefixs min-prefixs
ekp-caches))) :max-prefixs max-prefixs
param-cache)))) :dp-cache (make-hash-table :test 'eql :size 20))))
(defun ekp-param-data (string &optional key) (defun ekp--get-para (string)
"Return the data plist of param cache. If KEY is non-nil, "Get or create ekp-para struct for STRING.
return the value of KEY in plist." This is the main entry point for cached paragraph data."
(let ((data (car (ekp-param-cache string)))) (unless ekp--para-cache
(if key (setq ekp--para-cache (make-hash-table :test 'eql :size 100)))
(plist-get data key) (let ((key (ekp--para-hash string)))
data))) (or (gethash key ekp--para-cache)
(let ((para (ekp--make-para string)))
(puthash key para ekp--para-cache)
para))))
(defun ekp-ideal-prefixs (string) (defun ekp-clear-caches ()
(ekp-param-data string :ideal-prefixs)) "Clear all paragraph caches."
(interactive)
(setq ekp--para-cache nil))
(defun ekp-min-prefixs (string) ;;;; Paragraph Accessors
(ekp-param-data string :min-prefixs))
(defun ekp-max-prefixs (string) (defun ekp--boxes (string)
(ekp-param-data string :max-prefixs)) (ekp-para-boxes (ekp--get-para string)))
;;; Knuth-Plass Badness and Demerits (defun ekp--boxes-widths (string)
;; (ekp-para-boxes-widths (ekp--get-para string)))
;; K-P defines badness as how much a line deviates from ideal:
;; badness = 100 * |r|³ where r = adjustment / flexibility (defun ekp--glues-types (string)
;; (ekp-para-glues-types (ekp--get-para string)))
;; Demerits combine badness with penalties to rank line breaks:
(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 ;; demerits = (linepenalty + badness)² + penalties
;; ;;
;; Fitness classes ensure visual consistency: ;; Fitness classes ensure visual consistency:
@ -474,30 +426,12 @@ Returns (:badness NUM :fitness NUM :gaps LIST :adjustment NUM :flexibility NUM).
:adjustment adjustment :adjustment adjustment
:flexibility flexibility))) :flexibility flexibility)))
;; Keep old function for compatibility (defun ekp--hyphenate-p (glues-types n)
(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." "Return non-nil if position N ends with hyphenation."
(and (< n (length glues-types)) (and (< n (length glues-types))
(eq 'nws (aref glues-types n)))) (eq 'nws (aref glues-types n))))
;;; Dynamic Programming Line Breaking Algorithm ;;;; Dynamic Programming Line Breaking
;; 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) (defun ekp--dp-init-arrays (n)
"Initialize DP arrays for N boxes. "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)) (fitness-classes (nth 5 arrays))
(line-counts (nth 6 arrays)) (line-counts (nth 6 arrays))
(break-pos (1- k)) (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) (ideal-pixel (- (aref ideal-prefixs break-pos)
(aref ideal-prefixs i) (aref ideal-prefixs i)
(ekp-glue-ideal-pixel (aref glues-types 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))) end-with-hyphenp prev-hyphen-count)))
(list dem line-gaps fitness new-hyphen))))) (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) (defun ekp--dp-trace-breaks (backptrs n)
"Trace optimal break points from BACKPTRS array." "Trace optimal break points from BACKPTRS array."
(let ((breaks (list n)) (let ((breaks (list n))
@ -632,39 +543,38 @@ Used for looseness parameter support."
;; Full looseness would require tracking multiple paths ;; Full looseness would require tracking multiple paths
(ekp--dp-trace-breaks backptrs n)))) (ekp--dp-trace-breaks backptrs n))))
(defun ekp--dp-store-cache (string line-pixel dp-cache) (defun ekp--dp-store-cache (string line-pixel dp-result)
"Store DP-CACHE for STRING at LINE-PIXEL." "Store DP-RESULT for STRING at LINE-PIXEL in para's dp-cache."
(if-let ((dp-record (cdr (ekp-param-cache string)))) (let ((para (ekp--get-para string)))
(puthash line-pixel dp-cache dp-record) (puthash line-pixel dp-result (ekp-para-dp-cache para))))
(let ((dp-record (make-hash-table :test 'equal :size 100
:rehash-size 1.5 :weakness nil))) (defun ekp--dp-get-cached (para line-pixel)
(puthash line-pixel dp-cache dp-record) "Get cached DP result from PARA for LINE-PIXEL, or nil."
(puthash (ekp-param-fmtstr) (gethash line-pixel (ekp-para-dp-cache para)))
(cons (ekp-param-data string) dp-record)
(cdr (ekp-text-cache string))))))
(defun ekp-dp-cache (string line-pixel) (defun ekp-dp-cache (string line-pixel)
"Compute optimal line breaks for STRING at LINE-PIXEL width. "Compute optimal line breaks for STRING at LINE-PIXEL width.
Uses Knuth-Plass dynamic programming with demerits." Uses Knuth-Plass dynamic programming with demerits."
(if-let* ((dp-record (cdr (ekp-param-cache string))) (let* ((para (ekp--get-para string))
(cached (gethash line-pixel dp-record))) (cached (ekp--dp-get-cached para line-pixel)))
cached (if cached
;; Gather input data cached
(let* ((glues-types (ekp-glues-types string)) ;; Get data directly from struct (O(1) access)
(boxes (ekp-boxes string)) (let* ((glues-types (ekp-para-glues-types para))
(hyphen-pixel (ekp-hyphen-pixel string)) (boxes (ekp-para-boxes para))
(n (length boxes)) (hyphen-pixel (ekp-para-hyphen-pixel para))
(ideal-prefixs (ekp-ideal-prefixs string)) (n (length boxes))
(min-prefixs (ekp-min-prefixs string)) (ideal-prefixs (ekp-para-ideal-prefixs para))
(max-prefixs (ekp-max-prefixs string)) (min-prefixs (ekp-para-min-prefixs para))
(arrays (ekp--dp-init-arrays n)) (max-prefixs (ekp-para-max-prefixs para))
(backptrs (nth 0 arrays)) (arrays (ekp--dp-init-arrays n))
(demerits (nth 1 arrays)) (backptrs (nth 0 arrays))
(rests (nth 2 arrays)) (demerits (nth 1 arrays))
(gaps (nth 3 arrays)) (rests (nth 2 arrays))
(hyphen-counts (nth 4 arrays)) (gaps (nth 3 arrays))
(fitness-classes (nth 5 arrays)) (hyphen-counts (nth 4 arrays))
(line-counts (nth 6 arrays))) (fitness-classes (nth 5 arrays))
(line-counts (nth 6 arrays)))
;; Main DP loop: for each reachable position i ;; Main DP loop: for each reachable position i
(dotimes (i (1+ n)) (dotimes (i (1+ n))
(when (aref demerits i) (when (aref demerits i)
@ -676,7 +586,7 @@ Uses Knuth-Plass dynamic programming with demerits."
(dotimes (j (- n i)) (dotimes (j (- n i))
(let* ((k (+ i j 1)) (let* ((k (+ i j 1))
(is-last (= k n)) (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 (metrics (ekp--dp-line-metrics
i k glues-types ideal-prefixs min-prefixs max-prefixs)) i k glues-types ideal-prefixs min-prefixs max-prefixs))
(ideal-pixel (nth 0 metrics)) (ideal-pixel (nth 0 metrics))
@ -712,18 +622,18 @@ Uses Knuth-Plass dynamic programming with demerits."
(aset fitness-classes k fitness) (aset fitness-classes k fitness)
(aset hyphen-counts k new-hyphen) (aset hyphen-counts k new-hyphen)
(aset line-counts k (1+ prev-line-count)))))))))))) (aset line-counts k (1+ prev-line-count))))))))))))
;; Extract optimal solution ;; Extract optimal solution
(let* ((breaks (ekp--dp-trace-breaks-with-looseness (let* ((breaks (ekp--dp-trace-breaks-with-looseness
backptrs line-counts n (aref line-counts n))) backptrs line-counts n (aref line-counts n)))
(lines-rests (mapcar (lambda (i) (aref rests i)) breaks)) (lines-rests (mapcar (lambda (i) (aref rests i)) breaks))
(lines-gaps (mapcar (lambda (i) (aref gaps 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 :gaps lines-gaps
:breaks breaks :breaks breaks
:cost (aref demerits n) :cost (aref demerits n)
:line-count (aref line-counts n)))) :line-count (aref line-counts n))))
(ekp--dp-store-cache string line-pixel dp-cache) (puthash line-pixel dp-result (ekp-para-dp-cache para))
dp-cache)))) dp-result)))))
(defun ekp-dp-data (string line-pixel &optional key) (defun ekp-dp-data (string line-pixel &optional key)
"Return the data plist of dp cache. If KEY is non-nil, "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. "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. Returns vector of vectors, each inner vector is glue pixels for one line.
Each line's glues: [0 glue1 glue2 ... trailing-space]." Each line's glues: [0 glue1 glue2 ... trailing-space]."
(let* ((boxes-widths (ekp-boxes-widths string)) (let* ((boxes-widths (ekp--boxes-widths string))
(boxes-num (length (ekp-boxes string))) (boxes-num (length (ekp--boxes string)))
(glues-types (ekp-glues-types string)) (glues-types (ekp--glues-types string))
(ideal-prefixs (ekp-ideal-prefixs string)) (ideal-prefixs (ekp--ideal-prefixs string))
(max-prefixs (ekp-max-prefixs string)) (max-prefixs (ekp--max-prefixs string))
(breaks (ekp-line-breaks string line-pixel)) (breaks (ekp-line-breaks string line-pixel))
(lines-rests (ekp-dp-data string line-pixel :rests)) (lines-rests (ekp-dp-data string line-pixel :rests))
(lines-gaps (ekp-dp-data string line-pixel :gaps)) (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)) (line-glues (make-vector (length breaks) nil))
(start 0)) (start 0))
(dotimes (i (length breaks)) (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-boxes-widths (cl-subseq boxes-widths start end))
(line-glues-types (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)) (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) (ideal-pixel (- (aref ideal-prefixs end)
(aref ideal-prefixs start) (aref ideal-prefixs start)
(ekp-glue-ideal-pixel (aref glues-types 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))) (setq start end)))
line-glues)) 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)) (let* ((glues (append glues nil))
(last-glue (car (last glues))) (last-glue (car (last glues)))
(glues (-drop-last 1 glues)) (glues (butlast glues))
(boxes (append boxes nil))) (boxes (append boxes nil)))
(if (= (length glues) (length boxes)) (if (= (length glues) (length boxes))
(string-join (append (-interleave glues boxes) (string-join (append (ekp--interleave glues boxes)
(list last-glue))) (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) (defun ekp--pixel-justify (string line-pixel)
"Justify single STRING to LINE-PIXEL." "Justify single STRING to LINE-PIXEL."
(let* ((boxes (ekp-boxes string)) (let* ((boxes (ekp--boxes string))
(hyphen (ekp-hyphen-str string)) (hyphen (ekp--hyphen-str string))
(breaks (ekp-line-breaks string line-pixel)) (breaks (ekp-line-breaks string line-pixel))
(num (length breaks)) (num (length breaks))
(lines-glues (ekp-line-glues string line-pixel)) (lines-glues (ekp-line-glues string line-pixel))
(glues-types (ekp-glues-types string)) (glues-types (ekp--glues-types string))
(start 0) strings) (start 0) strings)
(dotimes (i num) (dotimes (i num)
(let* ((end (nth i breaks)) (let* ((end (nth i breaks))
@ -912,23 +832,18 @@ Each line's glues: [0 glue1 glue2 ... trailing-space]."
(line-glues (mapcar #'ekp-pixel-spacing (line-glues (mapcar #'ekp-pixel-spacing
(aref lines-glues i)))) (aref lines-glues i))))
;; not last line and glue is 'nws, should add hyphen ;; 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)) (setf (aref line-boxes (- end start 1))
(concat (aref line-boxes (- end start 1)) hyphen))) (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) strings)
(setq start end))) (setq start end)))
(mapconcat 'identity (nreverse strings) "\n"))) (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. "Justify multiline STRING to LINE-PIXEL.
When USE-CACHE is non-nil, use the cache for performance. USE-CACHE is ignored; caching is always enabled via ekp--para-cache."
Default is nil, meaning cache is not used." (let ((strs (split-string string "\n")))
(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")))
(mapconcat (lambda (str) (mapconcat (lambda (str)
(if (string-blank-p str) (if (string-blank-p str)
"" ""
@ -936,24 +851,28 @@ Default is nil, meaning cache is not used."
strs "\n"))) strs "\n")))
;;; Optimal Width Search ;;; Optimal Width Search
;; Uses ternary search instead of linear scan. ;;
;; Cost function is roughly unimodal: too narrow = many breaks = high cost, ;; Uses ternary search with aggressive caching.
;; too wide = overstretched lines = high cost. ;; The key optimization: reuse box/glue preprocessing across all widths.
(defun ekp--compute-avg-cost (strings pixel) (defun ekp--compute-avg-cost (strings pixel)
"Compute average cost for STRINGS at PIXEL width." "Compute average cost for STRINGS at PIXEL width."
(let ((costs (mapcar (lambda (s) (let ((total-cost 0)
(if (string-blank-p s) 0 (count 0))
(abs (ekp-total-cost s pixel)))) (dolist (s strings)
strings))) (unless (string-blank-p s)
(/ (float (apply #'+ costs)) (max 1 (length costs))))) (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) (defun ekp--ternary-search-optimal-width (strings min-pixel max-pixel)
"Find optimal width in [MIN-PIXEL, MAX-PIXEL] using ternary search. "Find optimal width in [MIN-PIXEL, MAX-PIXEL] using ternary search.
Returns the pixel width with minimum average cost." Returns the pixel width with minimum average cost."
(let ((lo min-pixel) (let ((lo min-pixel)
(hi max-pixel)) (hi max-pixel))
;; Ternary search: O(log n) instead of O(n) ;; Ternary search: O(log n) iterations
(while (> (- hi lo) 2) (while (> (- hi lo) 2)
(let* ((mid1 (+ lo (/ (- hi lo) 3))) (let* ((mid1 (+ lo (/ (- hi lo) 3)))
(mid2 (- hi (/ (- 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 p)))))
best-pixel))) 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. "Find optimal width for STRING between MIN-PIXEL and MAX-PIXEL.
Returns (justified-text . optimal-pixel). Returns (justified-text . optimal-pixel).
Uses ternary search for O(log n) complexity instead of O(n)." Uses ternary search for O(log n) width evaluations.
(let* ((ekp-caches (if use-cache All preprocessing is cached via ekp--para-cache."
ekp-caches (let* ((strings (split-string string "\n"))
(make-hash-table ;; Pre-warm caches
:test 'equal :size 100 :rehash-size 1.5 :weakness nil))) (_ (dolist (s strings)
(strings (split-string string "\n")) (unless (string-blank-p s)
(ekp--get-para s))))
(best-pixel (ekp--ternary-search-optimal-width strings min-pixel max-pixel))) (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) (provide 'ekp)
;;; ekp.el ends here

177
readme.md
View File

@ -1,67 +1,172 @@
[中文文档](./readme_zh.md) [中文文档](./readme_zh.md)
## Introduction # Emacs-KP: Knuth-Plass Line Breaking for Emacs
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 implements the Knuth-Plass optimal line breaking algorithm with full support for CJK (Chinese, Japanese, Korean) and Latin mixed text typesetting.
## Demo ## Demo
First, let's look at a demo of the typesetting effect:
![ekp-demo](./images/ekp-demo-with-cache.gif) ![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 ## 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 ## Usage
### Configuration ### 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 | | Parameter | Description |
|:----------------------|:---------------------------------------------------------------| |:----------------------|:-----------------------------------------------|
| ekp-lws-ideal-pixel | Ideal pixel width between Latin words | | `ekp-lws-ideal-pixel` | Ideal space between Latin words |
| ekp-lws-stretch-pixel | Stretchable pixel width between Latin words | | `ekp-lws-stretch-pixel` | Maximum stretch between Latin words |
| ekp-lws-shrink-pixel | Shrinkable pixel width between Latin words | | `ekp-lws-shrink-pixel` | Maximum shrink between Latin words |
| ekp-mws-ideal-pixel | Ideal pixel width between Latin words and CJK characters | | `ekp-mws-ideal-pixel` | Ideal space between Latin and CJK |
| ekp-mws-stretch-pixel | Stretchable pixel width between Latin words and CJK characters | | `ekp-mws-stretch-pixel` | Maximum stretch between Latin and CJK |
| ekp-mws-shrink-pixel | Shrinkable pixel width between Latin words and CJK characters | | `ekp-mws-shrink-pixel` | Maximum shrink between Latin and CJK |
| ekp-cws-ideal-pixel | Ideal pixel width between CJK characters | | `ekp-cws-ideal-pixel` | Ideal space between CJK characters |
| ekp-cws-stretch-pixel | Stretchable pixel width between CJK characters | | `ekp-cws-stretch-pixel` | Maximum stretch between CJK characters |
| ekp-cws-shrink-pixel | Shrinkable pixel width 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. Default values follow K-P recommendations:
- The stretchable width defaults to 1/2 of the ideal width. - Ideal = space character width
- The shrinkable width defaults to 1/3 of the ideal 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 ### 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 original text properties after formatting
- [x] Preserve the original text's text properties. - [x] Full Knuth-Plass demerits model with fitness classes
- [ ] Refactor using Rust dynamic modules: Utilize Rust's parallel computing capabilities to enhance rendering performance. - [x] Hyphenation with consecutive-hyphen penalty
- [ ] Implement autocorrection for punctuation: Correct English punctuation mistakenly used in Chinese text; Correct Chinese punctuation mistakenly used in English texts... - [ ] Rust dynamic module for parallel computation
- [ ] Auto-correction for mixed punctuation
## Credits ## Credits
- The core algorithm is fundamentally derived from the seminal paper: "Breaking Paragraphs into Lines" by DONALD E. KNUTH AND MICHAEL F. PLASS. - 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
- 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 - Dictionaries: [Hunspell hyphenation patterns](https://github.com/Kozea/Pyphen)

View File

@ -1,57 +1,170 @@
## 介绍 # Emacs-KP: Knuth-Plass 排版算法 Emacs 实现
Emacs-kp 实现了 knuth-plass 排版算法,但其功能不局限于英文排版,我对算法的进一步优化,实现了 CJK 与 Latin 系语言的混合排版。
Emacs-kp 实现了 Knuth-Plass 最优断行算法,并扩展支持 CJK中日韩与拉丁文混合排版。
## 演示 ## 演示
先来看一下排版效果的 demo
![ekp-demo](./images/ekp-demo-with-cache.gif) ![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-param-set`**:配置间距参数(单位:像素):
|:----------------------|:------------------------------------------|
| 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 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-cellcar 是排版后的文本cdr 是最优排版效果的像素值。请注意,该函数会遍历计算最小和最大像素之间的排版代价取最小值的情况,如果范围设置的太大执行时间可能会显著变长。后续考虑使用 rust 动态模块来并行计算,提高性能。 ## 路线图
## 下一步 - [x] 排版后保留原始文本属性
- [x] 完整的 Knuth-Plass demerits 模型与 fitness classes
- [x] 支持连续连字符惩罚的断词
- [ ] Rust 动态模块实现并行计算
- [ ] 混合标点自动修正
- [x] 重排之后,保留文本原本的样式。 ## 致谢
- [ ] 使用 rust 动态模块重写:利用 rust 并行计算提升渲染性能。
- [ ] 实现排版自动修正功能:比如修正中文中使用的英文标点;英文中使用的中文标点等
## 感谢 - 核心算法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 算法
1. 毫无疑问核心算法源自此篇论文 "Breaking Paragraphs into Lines" by DONALD E. KNUTH AND MICHAEL F. PLASS - 词典:[Hunspell 断词模式](https://github.com/Kozea/Pyphen)
2. 拉丁单词的 hypen 断词的实现是由 Pyphen 这个 python 库的代码转写而来的,词库也来源于此: https://github.com/Kozea/Pyphen

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) (defun ekp-file-content (file)
(with-temp-buffer (with-temp-buffer
(insert-file-contents file) (insert-file-contents file)
@ -132,3 +134,74 @@
"\n" (ekp-pixel-justify (string-join lst "\n\n") 683)))) "\n" (ekp-pixel-justify (string-join lst "\n\n") 683))))
;; (ekp-test-keep-props) ;; (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)