From 6421f6b1fbd7af26b4b803c47ee6a7126eb62acb Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sat, 24 Jan 2026 22:40:53 +0800 Subject: [PATCH] refactor ekp cache and code improve --- ekp-hyphen.el | 490 ++++-------- ekp-utils.el | 229 ++---- ekp.el | 1898 +++++++++++++++++++++----------------------- readme.md | 177 ++++- readme_zh.md | 179 ++++- tests/ekp-tests.el | 77 +- 6 files changed, 1523 insertions(+), 1527 deletions(-) diff --git a/ekp-hyphen.el b/ekp-hyphen.el index fc60ca2..7d43d58 100644 --- a/ekp-hyphen.el +++ b/ekp-hyphen.el @@ -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--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)) + (setq found (gethash (string-join parts "_") + ekp-hyphen--langs-short) + parts (butlast parts))) + found))) -(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)) +;;; Pattern Compilation -(defun ekp-hyphen--parse (pat) - "Parse pattern string PAT to list of (digit string, non-digit string)." - (let ((pos 0) - (len (length pat)) - res) +(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) - (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))) + ;; 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--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 - (while (and parts (not found)) - (let ((lang (mapconcat #'identity parts "_"))) - (setq found (gethash lang ekp-hyphen--languages-lowercase)) - (pop parts))) - found)))) +(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) + (forward-line 1) ; skip encoding line + (while (not (eobp)) + (let* ((line (string-trim (buffer-substring-no-properties + (point) (line-end-position)))) + (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 + :left 2 :right 2))) -(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))) +;;; Hyphenation Algorithm -(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--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) + (dotimes (i (length prio)) + (when (cl-oddp (aref prio i)) + (push (1- i) result))) + (nreverse result)))) -(defun ekp-hyphen--read-dic-file (path) - "Read a .dic file from PATH. Return (encoding . lines-list)." - (with-temp-buffer - (insert-file-contents path) - (let ((encoding (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--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--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 - :cache (make-hash-table :test 'equal) - :maxlen maxlen)))) +;;; Public API -(defun ekp-hyphen--hyphdict-positions (hyphdict word) - "Find all hyphenation positions in WORD using HYPHDICT. -Returns list of ekp-hyphen--datint objects (odd value = break allowed)." - (let* ((word-lower (downcase word)) - (cache (ekp-hyphen--hyphdict-cache hyphdict)) - (cached-result (gethash word-lower cache))) - (or cached-result - (let ((points (ekp-hyphen--compute-positions hyphdict word-lower))) - (puthash word-lower points cache) - points)))) +(defun ekp-hyphen-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--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-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--apply-pattern (priorities pattern start) - "Apply PATTERN values to PRIORITIES array starting at START." - (let ((offset (car pattern)) - (values (cdr pattern))) - (cl-loop for idx from (+ start offset) - for val in values - when (and (<= 0 idx) (< idx (length priorities))) - do (setf (nth idx priorities) - (max val (nth idx priorities)))))) - -(defun ekp-hyphen--extract-break-positions (priorities) - "Extract break positions from PRIORITIES array. -Returns list of ekp-hyphen--datint objects for odd-valued positions." - (let (result) - (cl-loop for idx from 0 below (length priorities) - for priority in priorities - when (cl-oddp (if (ekp-hyphen--datint-p priority) - (ekp-hyphen--datint-value priority) - priority)) - do (push (if (ekp-hyphen--datint-p priority) - priority - (ekp-hyphen--make-datint :value (- idx 1))) - result)) - (nreverse result))) - -(defun ekp-hyphen-load-languages (dict-dir) - "Scan DICT-DIR for hyphenation dictionaries and populate - `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)))))) +(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 (+ 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 diff --git a/ekp-utils.el b/ekp-utils.el index 2caed25..1e004e6 100644 --- a/ekp-utils.el +++ b/ekp-utils.el @@ -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 diff --git a/ekp.el b/ekp.el index 398d56f..dca08a2 100644 --- a/ekp.el +++ b/ekp.el @@ -1,988 +1,910 @@ -;; -*- lexical-binding: t; -*- - -(require 'ekp-utils) -(require 'ekp-hyphen) - -(defconst ekp-load-file-name (or load-file-name (buffer-file-name))) - -(defvar ekp-latin-lang "en_US") - -(defvar ekp-param-use-default-p t - "Used in internal, you should not modify it!") - -(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-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) - -(defvar ekp-line-penalty 10 - "Penalty added for each line break (K-P: linepenalty). -Higher values prefer fewer lines with more stretching. -Typical range: 0-100. Default 10.") - -(defvar ekp-hyphen-penalty 50 - "Penalty for breaking a word with hyphen (K-P: hyphenpenalty). -Higher values avoid hyphenation. Default 50.") - -(defvar ekp-adjacent-fitness-penalty 100 - "Penalty when adjacent lines differ in fitness class by > 1. -Ensures visual consistency. Default 100.") - -(defvar ekp-last-line-min-ratio 0.5 - "Minimum fill ratio for last line (0.0-1.0). -Avoids orphaned words. Default 0.5 = at least half width.") - -(defvar ekp-looseness 0 - "Target line count adjustment from optimal. -0 = optimal, +1 = one more line (looser), -1 = one fewer line (tighter). -Useful for fitting text to specific space.") - -(defvar ekp-caches - (make-hash-table - :test 'equal :size 100 :rehash-size 1.5 :weakness nil) - "Key of ekp-caches is the hash of string.") - -(defun ekp-root-dir () - (when ekp-load-file-name - (file-name-directory ekp-load-file-name))) - -(defun ekp-load-dicts () - (ekp-hyphen-load-languages - (expand-file-name "./dictionaries" (ekp-root-dir)))) - -(ekp-load-dicts) - -(defun ekp-param-check () - "Check whether all params 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)) - 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-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)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; 正确版本：包含完整字符集和组合标记 -(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) - (let* ((boxes (ekp-split-to-boxes string)) - (idx 0) - new-boxes idxs) - (dolist (box (append boxes nil)) - (save-match-data - (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)) - (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) - "STR should be single letter string." - (cond - ;; a half-width cjk punct - ((or (string= "“" str) (string= "”" str)) 'cjk) - ((= (string-width str) 1) 'latin) - ((= (string-width str) 2) - (if (ekp-cjk-fw-punct-p str) - 'cjk-punct - 'cjk)) - (t (error "Abnormal string width %s for %s" - (string-width str) str)))) - -(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))))) - -(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." - (let ((before (cdr prev-box-type)) - (after (car curr-box-type))) - (if before - (cond - ((and (eq before 'latin) (eq after 'latin)) 'lws) - ((and (eq before 'cjk) (eq after 'cjk)) 'cws) - ((or (and (eq before 'cjk) (eq after 'latin)) - (and (eq before 'latin) (eq after 'cjk))) - 'mws) - ((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-glue-ideal-pixel (type) - (cond ((or (null type) (eq 'nws type)) 0) - ((eq 'lws type) ekp-lws-ideal-pixel) - ((eq 'mws type) ekp-mws-ideal-pixel) - ((eq 'cws type) ekp-cws-ideal-pixel))) - -(defun ekp-glue-min-pixel (type) - (cond ((or (null type) (eq 'nws type)) 0) - ((eq 'lws type) ekp-lws-min-pixel) - ((eq 'mws type) ekp-mws-min-pixel) - ((eq 'cws type) ekp-cws-min-pixel))) - -(defun ekp-glue-max-pixel (type) - (cond ((or (null type) (eq 'nws type)) 0) - ((eq 'lws type) ekp-lws-max-pixel) - ((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))))) - -(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))) - (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 - :latin-font latin-font - :cjk-font cjk-font - :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 - :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)))) - -(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-ideal-prefixs (string) - (ekp-param-data string :ideal-prefixs)) - -(defun ekp-min-prefixs (string) - (ekp-param-data string :min-prefixs)) - -(defun ekp-max-prefixs (string) - (ekp-param-data string :max-prefixs)) - -;;; Knuth-Plass Badness and Demerits -;; -;; K-P defines badness as how much a line deviates from ideal: -;; badness = 100 * |r|³ where r = adjustment / flexibility -;; -;; Demerits combine badness with penalties to rank line breaks: -;; demerits = (linepenalty + badness)² + penalties -;; -;; Fitness classes ensure visual consistency: -;; 0=tight, 1=decent, 2=loose, 3=very-loose -;; Adjacent lines with class difference > 1 get extra penalty. - -(defun ekp--compute-badness (adjustment-pixel flexibility-pixel) - "Compute Knuth-Plass badness from ADJUSTMENT-PIXEL and FLEXIBILITY-PIXEL. -Returns 0 if no adjustment needed, 10000 (infinite) if impossible." - (cond - ((= adjustment-pixel 0) 0) - ((<= flexibility-pixel 0) 10000) - (t (let ((ratio (/ (float adjustment-pixel) flexibility-pixel))) - (min 10000 (* 100 (expt (abs ratio) 3))))))) - -(defun ekp--compute-fitness-class (adjustment-pixel flexibility-pixel) - "Classify line tightness into fitness class (0-3). -0=tight (shrunk), 1=decent, 2=loose, 3=very-loose." - (if (<= flexibility-pixel 0) - 1 ; default to decent - (let ((ratio (/ (float adjustment-pixel) flexibility-pixel))) - (cond - ((< ratio -0.5) 0) ; tight (significantly shrunk) - ((< ratio 0.5) 1) ; decent (close to ideal) - ((< ratio 1.0) 2) ; loose - (t 3))))) ; very loose - -(defun ekp--compute-demerits (badness penalty prev-fitness curr-fitness - end-with-hyphenp prev-hyphen-count) - "Compute K-P demerits for a line break. -BADNESS is the line badness, PENALTY is break penalty (e.g., hyphen). -PREV-FITNESS and CURR-FITNESS are fitness classes of adjacent lines. -Returns total demerits for this break." - (let* (;; Base demerits: (linepenalty + badness)² - (base (expt (+ ekp-line-penalty badness) 2)) - ;; Add break penalty - (with-penalty (+ base (* penalty penalty))) - ;; Fitness incompatibility penalty - (fitness-delta (abs (- prev-fitness curr-fitness))) - (with-fitness (if (> fitness-delta 1) - (+ with-penalty ekp-adjacent-fitness-penalty) - with-penalty)) - ;; Consecutive hyphen penalty (quadratic growth) - (hyphen-count (if end-with-hyphenp (1+ prev-hyphen-count) 0)) - (with-hyphen (if end-with-hyphenp - (+ with-fitness (* 100 hyphen-count hyphen-count)) - with-fitness))) - with-hyphen)) - -(defun ekp--gaps-list (glues-types) - "Count gaps by type: (latin-gaps mix-gaps cjk-gaps)." - (list (seq-count (lambda (it) (eq 'lws it)) glues-types) - (seq-count (lambda (it) (eq 'mws it)) glues-types) - (seq-count (lambda (it) (eq 'cws it)) glues-types))) - -(defun ekp--compute-stretch-capacity (gaps-list) - "Return total stretchable pixels for GAPS-LIST." - (+ (* (nth 0 gaps-list) ekp-lws-stretch-pixel) - (* (nth 1 gaps-list) ekp-mws-stretch-pixel) - (* (nth 2 gaps-list) ekp-cws-stretch-pixel))) - -(defun ekp--compute-shrink-capacity (gaps-list) - "Return total shrinkable pixels for GAPS-LIST (CJK gaps don't shrink)." - (+ (* (nth 0 gaps-list) ekp-lws-shrink-pixel) - (* (nth 1 gaps-list) ekp-mws-shrink-pixel))) - -(defun ekp--line-badness-and-fitness (ideal-pixel line-pixel glues-types) - "Compute badness, fitness class, and gaps for a line. -Returns (:badness NUM :fitness NUM :gaps LIST :adjustment NUM :flexibility NUM)." - (let* ((glues-types (seq-drop glues-types 1)) - (gaps-list (ekp--gaps-list glues-types)) - (adjustment (- line-pixel ideal-pixel)) - (flexibility (if (> adjustment 0) - (ekp--compute-stretch-capacity gaps-list) - (ekp--compute-shrink-capacity gaps-list))) - (badness (ekp--compute-badness adjustment flexibility)) - (fitness (ekp--compute-fitness-class adjustment flexibility))) - (list :badness badness - :fitness fitness - :gaps gaps-list - :adjustment adjustment - :flexibility flexibility))) - -;; Keep old function for compatibility -(defun ekp--line-cost-and-gaps (ideal-pixel line-pixel glues-types) - "Compute badness cost for a line using Knuth-Plass formula. -IDEAL-PIXEL is natural width, LINE-PIXEL is target width. -Returns (:cost NUMBER :gaps GAPS-LIST)." - (let* ((result (ekp--line-badness-and-fitness ideal-pixel line-pixel glues-types))) - (list :cost (plist-get result :badness) - :gaps (plist-get result :gaps)))) - -(defun ekp-hyphenate-p (glues-types n) - "Return non-nil if position N ends with hyphenation." - (and (< n (length glues-types)) - (eq 'nws (aref glues-types n)))) - -;;; Dynamic Programming Line Breaking Algorithm -;; Implements optimal line breaking using Knuth-Plass algorithm. -;; -;; Key data structures: -;; - demerits[i]: minimum demerits to reach position i -;; - backptrs[i]: previous break point for optimal path -;; - fitness[i]: fitness class at break i (for adjacent penalty) -;; - rests[i]: adjustment pixels at break i -;; - gaps[i]: gap counts by type -;; - hyphen-counts[i]: consecutive hyphen count - -(defun ekp--dp-init-arrays (n) - "Initialize DP arrays for N boxes. -Returns (backptrs demerits rests gaps hyphen-counts fitness-classes line-counts)." - (let ((backptrs (make-vector (1+ n) nil)) - (demerits (make-vector (1+ n) nil)) - (rests (make-vector (1+ n) nil)) - (gaps (make-vector (1+ n) nil)) - (hyphen-counts (make-vector (1+ n) 0)) - (fitness-classes (make-vector (1+ n) 1)) ; default: decent - (line-counts (make-vector (1+ n) 0))) ; for looseness - (aset demerits 0 0.0) - (list backptrs demerits rests gaps hyphen-counts fitness-classes line-counts))) - -(defun ekp--dp-line-metrics (i k glues-types ideal-prefixs min-prefixs max-prefixs) - "Compute line metrics for boxes I to K. -Returns (ideal-pixel min-pixel max-pixel) excluding leading glue." - (let ((leading-glue-type (aref glues-types i))) - (list (- (aref ideal-prefixs k) (aref ideal-prefixs i) - (ekp-glue-ideal-pixel leading-glue-type)) - (- (aref min-prefixs k) (aref min-prefixs i) - (ekp-glue-min-pixel leading-glue-type)) - (- (aref max-prefixs k) (aref max-prefixs i) - (ekp-glue-max-pixel leading-glue-type))))) - -(defun ekp--dp-force-break (i k arrays glues-types ideal-prefixs hyphen-pixel line-pixel) - "Force a break at K-1 when no valid break found. Update ARRAYS." - (let* ((backptrs (nth 0 arrays)) - (demerits (nth 1 arrays)) - (rests (nth 2 arrays)) - (gaps (nth 3 arrays)) - (fitness-classes (nth 5 arrays)) - (line-counts (nth 6 arrays)) - (break-pos (1- k)) - (hyphenate-p (ekp-hyphenate-p glues-types break-pos)) - (ideal-pixel (- (aref ideal-prefixs break-pos) - (aref ideal-prefixs i) - (ekp-glue-ideal-pixel (aref glues-types i)))) - (rest-pixel (- line-pixel ideal-pixel))) - (when hyphenate-p (cl-incf ideal-pixel hyphen-pixel)) - ;; Force break with high demerits - (aset demerits break-pos (+ 10000 (expt rest-pixel 2))) - (aset rests break-pos rest-pixel) - (aset backptrs break-pos i) - (aset fitness-classes break-pos 3) ; very loose - (aset line-counts break-pos (1+ (aref line-counts i))) - (aset gaps break-pos - (ekp--gaps-list (seq-drop (cl-subseq glues-types i break-pos) 1))))) - -(defun ekp--dp-compute-line-demerits (j is-last end-with-hyphenp - ideal-pixel line-pixel - glues-types i k - prev-hyphen-count prev-fitness) - "Compute line demerits using full K-P formula. -Returns (demerits gaps fitness new-hyphen-count)." - (cond - ;; Single word line - ((= j 0) - (let* ((badness (ekp--compute-badness (- line-pixel ideal-pixel) 1)) - (fitness 1) ; decent - (penalty (if end-with-hyphenp ekp-hyphen-penalty 0)) - (new-hyphen (if end-with-hyphenp 1 0)) - (dem (ekp--compute-demerits badness penalty prev-fitness fitness - end-with-hyphenp prev-hyphen-count))) - (list dem nil fitness new-hyphen))) - ;; Last line: minimal demerits if reasonably filled - (is-last - (let* ((fill-ratio (/ (float ideal-pixel) line-pixel)) - ;; Penalize if last line is too short - (badness (if (< fill-ratio ekp-last-line-min-ratio) - (* 50 (- 1.0 fill-ratio)) - 0)) - (dem (expt (+ ekp-line-penalty badness) 2))) - (list dem nil 1 0))) - ;; Normal line - (t - (let* ((result (ekp--line-badness-and-fitness ideal-pixel line-pixel - (seq-subseq glues-types i k))) - (badness (plist-get result :badness)) - (fitness (plist-get result :fitness)) - (line-gaps (plist-get result :gaps)) - (penalty (if end-with-hyphenp ekp-hyphen-penalty 0)) - (new-hyphen (if end-with-hyphenp (1+ prev-hyphen-count) 0)) - (dem (ekp--compute-demerits badness penalty prev-fitness fitness - end-with-hyphenp prev-hyphen-count))) - (list dem line-gaps fitness new-hyphen))))) - -;; Unused but kept for reference -(defun ekp--dp-update-best (k arrays line-demerits line-gaps fitness - ideal-pixel line-pixel base-demerits new-hyphen line-num) - "Update ARRAYS at position K if this break is better." - (let* ((backptrs (nth 0 arrays)) - (demerits (nth 1 arrays)) - (rests (nth 2 arrays)) - (gaps (nth 3 arrays)) - (hyphen-counts (nth 4 arrays)) - (fitness-classes (nth 5 arrays)) - (line-counts (nth 6 arrays)) - (total-demerits (+ base-demerits line-demerits))) - (when (or (null (aref demerits k)) - (< total-demerits (aref demerits k))) - (aset rests k (- line-pixel ideal-pixel)) - (aset gaps k line-gaps) - (aset demerits k total-demerits) - (aset backptrs k (aref backptrs k)) ; will be set by caller - (aset fitness-classes k fitness) - (aset hyphen-counts k new-hyphen) - (aset line-counts k line-num) - t))) - -(defun ekp--dp-trace-breaks (backptrs n) - "Trace optimal break points from BACKPTRS array." - (let ((breaks (list n)) - (index n)) - (while (> index 0) - (let ((prev (aref backptrs index))) - (if prev - (progn (push prev breaks) - (setq index prev)) - (setq index (1- index))))) - (cdr breaks))) - -(defun ekp--dp-trace-breaks-with-looseness (backptrs line-counts n target-lines) - "Trace breaks, preferring paths with TARGET-LINES line count. -Used for looseness parameter support." - (if (= ekp-looseness 0) - (ekp--dp-trace-breaks backptrs n) - ;; Find path closest to target line count - (let ((optimal-lines (aref line-counts n)) - (target (+ optimal-lines ekp-looseness))) - ;; For now, just use optimal path - ;; Full looseness would require tracking multiple paths - (ekp--dp-trace-breaks backptrs n)))) - -(defun ekp--dp-store-cache (string line-pixel dp-cache) - "Store DP-CACHE for STRING at LINE-PIXEL." - (if-let ((dp-record (cdr (ekp-param-cache string)))) - (puthash line-pixel dp-cache dp-record) - (let ((dp-record (make-hash-table :test 'equal :size 100 - :rehash-size 1.5 :weakness nil))) - (puthash line-pixel dp-cache dp-record) - (puthash (ekp-param-fmtstr) - (cons (ekp-param-data string) dp-record) - (cdr (ekp-text-cache string)))))) - -(defun ekp-dp-cache (string line-pixel) - "Compute optimal line breaks for STRING at LINE-PIXEL width. -Uses Knuth-Plass dynamic programming with demerits." - (if-let* ((dp-record (cdr (ekp-param-cache string))) - (cached (gethash line-pixel dp-record))) - cached - ;; Gather input data - (let* ((glues-types (ekp-glues-types string)) - (boxes (ekp-boxes string)) - (hyphen-pixel (ekp-hyphen-pixel string)) - (n (length boxes)) - (ideal-prefixs (ekp-ideal-prefixs string)) - (min-prefixs (ekp-min-prefixs string)) - (max-prefixs (ekp-max-prefixs string)) - (arrays (ekp--dp-init-arrays n)) - (backptrs (nth 0 arrays)) - (demerits (nth 1 arrays)) - (rests (nth 2 arrays)) - (gaps (nth 3 arrays)) - (hyphen-counts (nth 4 arrays)) - (fitness-classes (nth 5 arrays)) - (line-counts (nth 6 arrays))) - ;; Main DP loop: for each reachable position i - (dotimes (i (1+ n)) - (when (aref demerits i) - (let ((prev-hyphen-count (aref hyphen-counts i)) - (prev-fitness (aref fitness-classes i)) - (prev-line-count (aref line-counts i))) - (catch 'break - ;; Try extending line to each position k > i - (dotimes (j (- n i)) - (let* ((k (+ i j 1)) - (is-last (= k n)) - (end-with-hyphenp (ekp-hyphenate-p glues-types k)) - (metrics (ekp--dp-line-metrics - i k glues-types ideal-prefixs min-prefixs max-prefixs)) - (ideal-pixel (nth 0 metrics)) - (min-pixel (nth 1 metrics)) - (max-pixel (nth 2 metrics))) - ;; Add hyphen width if line ends with hyphen - (when end-with-hyphenp - (cl-incf ideal-pixel hyphen-pixel) - (cl-incf max-pixel hyphen-pixel) - (cl-incf min-pixel hyphen-pixel)) - ;; Check if line is too long - (when (or (> min-pixel line-pixel) - (and is-last (> ideal-pixel line-pixel))) - (when (null (aref demerits (1- k))) - (ekp--dp-force-break i k arrays glues-types - ideal-prefixs hyphen-pixel line-pixel)) - (throw 'break nil)) - ;; Valid break point: compute demerits - (when (or (<= min-pixel line-pixel max-pixel) - (and is-last (<= ideal-pixel line-pixel))) - (pcase-let ((`(,dem ,line-gaps ,fitness ,new-hyphen) - (ekp--dp-compute-line-demerits - j is-last end-with-hyphenp - ideal-pixel line-pixel glues-types i k - prev-hyphen-count prev-fitness))) - (let ((total-dem (+ (aref demerits i) dem))) - (when (or (null (aref demerits k)) - (< total-dem (aref demerits k))) - (aset rests k (- line-pixel ideal-pixel)) - (aset gaps k line-gaps) - (aset demerits k total-dem) - (aset backptrs k i) - (aset fitness-classes k fitness) - (aset hyphen-counts k new-hyphen) - (aset line-counts k (1+ prev-line-count)))))))))))) - ;; Extract optimal solution - (let* ((breaks (ekp--dp-trace-breaks-with-looseness - backptrs line-counts n (aref line-counts n))) - (lines-rests (mapcar (lambda (i) (aref rests i)) breaks)) - (lines-gaps (mapcar (lambda (i) (aref gaps i)) breaks)) - (dp-cache (list :rests lines-rests - :gaps lines-gaps - :breaks breaks - :cost (aref demerits n) - :line-count (aref line-counts n)))) - (ekp--dp-store-cache string line-pixel dp-cache) - dp-cache)))) - -(defun ekp-dp-data (string line-pixel &optional key) - "Return the data plist of dp cache. If KEY is non-nil, -return the value of KEY in plist." - (let ((data (ekp-dp-cache string line-pixel))) - (if key - (plist-get data key) - data))) - -(defun ekp-total-cost (string line-pixel) - "Return the COST of kp algorithm." - (ekp-dp-data string line-pixel :cost)) - -(defun ekp-line-breaks (string line-pixel) - "Return the break points of kp algorithm." - (ekp-dp-data string line-pixel :breaks)) - -;;; Line Glue Distribution -;; Distributes extra/deficit space across glues (gaps between boxes) -;; Priority: latin gaps → mixed gaps → CJK gaps - -(defun ekp--distribute-gap-adjustment (rest-pixel gaps-list stretch-p) - "Distribute REST-PIXEL across GAPS-LIST. -STRETCH-P indicates stretch (t) or shrink (nil) mode. -Returns ((latin-adj . latin-extra) (mix-adj . mix-extra) (cjk-adj . cjk-extra))." - (let* ((latin-gaps (nth 0 gaps-list)) - (mix-gaps (nth 1 gaps-list)) - (cjk-gaps (nth 2 gaps-list)) - (remaining rest-pixel) - ;; Per-gap adjustment values - (latin-change (if stretch-p ekp-lws-stretch-pixel ekp-lws-shrink-pixel)) - (mix-change (if stretch-p ekp-mws-stretch-pixel ekp-mws-shrink-pixel)) - (cjk-change (if stretch-p ekp-cws-stretch-pixel 0)) - ;; Results - (latin-adj 0) (latin-extra 0) - (mix-adj 0) (mix-extra 0) - (cjk-adj 0) (cjk-extra 0)) - ;; Distribute to latin gaps first - (let ((latin-capacity (* latin-gaps latin-change))) - (if (< remaining latin-capacity) - (when (> latin-gaps 0) - (setq latin-adj (/ remaining latin-gaps)) - (setq latin-extra (% remaining latin-gaps)) - (setq remaining 0)) - (setq latin-adj latin-change) - (setq remaining (- remaining latin-capacity)))) - ;; Then to mixed gaps - (when (> remaining 0) - (let ((mix-capacity (* mix-gaps mix-change))) - (if (< remaining mix-capacity) - (when (> mix-gaps 0) - (setq mix-adj (/ remaining mix-gaps)) - (setq mix-extra (% remaining mix-gaps)) - (setq remaining 0)) - (setq mix-adj mix-change) - (setq remaining (- remaining mix-capacity))))) - ;; Finally to CJK gaps - (when (and (> remaining 0) (> cjk-gaps 0)) - (setq cjk-adj (/ remaining cjk-gaps)) - (setq cjk-extra (% remaining cjk-gaps))) - (list (cons latin-adj latin-extra) - (cons mix-adj mix-extra) - (cons cjk-adj cjk-extra)))) - -(defun ekp--compute-glue-pixels (glues-types gaps-distribution stretch-p) - "Compute actual glue pixels from GLUES-TYPES and GAPS-DISTRIBUTION. -Returns list of pixel values for each glue." - (let ((latin-adj (car (nth 0 gaps-distribution))) - (latin-extra (cdr (nth 0 gaps-distribution))) - (mix-adj (car (nth 1 gaps-distribution))) - (mix-extra (cdr (nth 1 gaps-distribution))) - (cjk-adj (car (nth 2 gaps-distribution))) - (cjk-extra (cdr (nth 2 gaps-distribution))) - (latin-idx -1) (mix-idx -1) (cjk-idx -1)) - (mapcar - (lambda (type) - (let* ((base (ekp-glue-ideal-pixel type)) - (adj (pcase type - ('lws (cl-incf latin-idx) - (+ latin-adj (if (< latin-idx latin-extra) 1 0))) - ('mws (cl-incf mix-idx) - (+ mix-adj (if (< mix-idx mix-extra) 1 0))) - ('cws (cl-incf cjk-idx) - (+ cjk-adj (if (< cjk-idx cjk-extra) 1 0))) - ('nws 0) - (_ 0)))) - (if stretch-p (+ base adj) (- base adj)))) - glues-types))) - -(defun ekp--line-glue-single-box (line-pixel box-width hyphen-p hyphen-pixel) - "Compute glues for a single-box line." - (let ((trailing (- line-pixel box-width (if hyphen-p hyphen-pixel 0)))) - (list 0 trailing))) - -(defun ekp--line-glue-last-line (glues-types ideal-pixel line-pixel) - "Compute glues for last line (ragged right)." - (append '(0) - (mapcar #'ekp-glue-ideal-pixel glues-types) - (list (- line-pixel ideal-pixel)))) - -(defun ekp--line-glue-normal (glues-types rest-pixel gaps-list) - "Compute glues for a normal (justified) line." - (if (= rest-pixel 0) - (append '(0) (mapcar #'ekp-glue-ideal-pixel glues-types) '(0)) - (let* ((stretch-p (> rest-pixel 0)) - (distribution (ekp--distribute-gap-adjustment - (abs rest-pixel) gaps-list stretch-p)) - (glue-pixels (ekp--compute-glue-pixels glues-types distribution stretch-p))) - (append '(0) glue-pixels '(0))))) - -(defun ekp-line-glues (string line-pixel) - "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)) - (breaks (ekp-line-breaks string line-pixel)) - (lines-rests (ekp-dp-data string line-pixel :rests)) - (lines-gaps (ekp-dp-data string line-pixel :gaps)) - (hyphen-pixel (ekp-hyphen-pixel string)) - (line-glues (make-vector (length breaks) nil)) - (start 0)) - (dotimes (i (length breaks)) - (let* ((end (nth i breaks)) - (line-boxes-widths (cl-subseq boxes-widths start end)) - (line-glues-types (seq-drop (cl-subseq glues-types start end) 1)) - (is-last (>= end boxes-num)) - (hyphen-p (ekp-hyphenate-p glues-types end)) - (ideal-pixel (- (aref ideal-prefixs end) - (aref ideal-prefixs start) - (ekp-glue-ideal-pixel (aref glues-types start)))) - (max-pixel (+ (- (aref max-prefixs end) - (aref max-prefixs start) - (ekp-glue-max-pixel (aref glues-types start))) - (if hyphen-p hyphen-pixel 0))) - glue-list) - (setq glue-list - (cond - ;; Single box: just trailing space - ((= 1 (length line-boxes-widths)) - (ekp--line-glue-single-box line-pixel - (aref line-boxes-widths 0) - hyphen-p hyphen-pixel)) - ;; Last line: ragged right - (is-last - (ekp--line-glue-last-line line-glues-types ideal-pixel line-pixel)) - ;; Forced break (line too short even at max stretch) - ((< max-pixel line-pixel) - (append '(0) - (mapcar #'ekp-glue-max-pixel line-glues-types) - (list (- line-pixel max-pixel)))) - ;; Normal justified line - (t - (ekp--line-glue-normal line-glues-types - (nth i lines-rests) - (nth i lines-gaps))))) - (aset line-glues i (vconcat glue-list)) - (setq start end))) - line-glues)) - -(defun ekp-combine-glues-and-boxes (glues boxes) - (let* ((glues (append glues nil)) - (last-glue (car (last glues))) - (glues (-drop-last 1 glues)) - (boxes (append boxes nil))) - (if (= (length glues) (length boxes)) - (string-join (append (-interleave glues boxes) - (list last-glue))) - (error "(length glues) + 1 != (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)) - (breaks (ekp-line-breaks string line-pixel)) - (num (length breaks)) - (lines-glues (ekp-line-glues string line-pixel)) - (glues-types (ekp-glues-types string)) - (start 0) strings) - (dotimes (i num) - (let* ((end (nth i breaks)) - (line-boxes (cl-subseq boxes start end)) - (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) - (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) - strings) - (setq start end))) - (mapconcat 'identity (nreverse strings) "\n"))) - -(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"))) - (mapconcat (lambda (str) - (if (string-blank-p str) - "" - (ekp--pixel-justify str line-pixel))) - strs "\n"))) - -;;; Optimal Width Search -;; Uses ternary search instead of linear scan. -;; Cost function is roughly unimodal: too narrow = many breaks = high cost, -;; too wide = overstretched lines = high cost. - -(defun ekp--compute-avg-cost (strings pixel) - "Compute average cost for STRINGS at PIXEL width." - (let ((costs (mapcar (lambda (s) - (if (string-blank-p s) 0 - (abs (ekp-total-cost s pixel)))) - strings))) - (/ (float (apply #'+ costs)) (max 1 (length costs))))) - -(defun ekp--ternary-search-optimal-width (strings min-pixel max-pixel) - "Find optimal width in [MIN-PIXEL, MAX-PIXEL] using ternary search. -Returns the pixel width with minimum average cost." - (let ((lo min-pixel) - (hi max-pixel)) - ;; Ternary search: O(log n) instead of O(n) - (while (> (- hi lo) 2) - (let* ((mid1 (+ lo (/ (- hi lo) 3))) - (mid2 (- hi (/ (- hi lo) 3))) - (cost1 (ekp--compute-avg-cost strings mid1)) - (cost2 (ekp--compute-avg-cost strings mid2))) - (if (< cost1 cost2) - (setq hi mid2) - (setq lo mid1)))) - ;; Final linear scan over remaining 3 candidates - (let ((best-pixel lo) - (best-cost (ekp--compute-avg-cost strings lo))) - (dolist (p (list (1+ lo) hi)) - (when (<= p max-pixel) - (let ((cost (ekp--compute-avg-cost strings p))) - (when (< cost best-cost) - (setq best-cost cost - best-pixel p))))) - best-pixel))) - -(defun ekp-pixel-range-justify (string min-pixel max-pixel &optional use-cache) - "Find optimal width for STRING between MIN-PIXEL and MAX-PIXEL. -Returns (justified-text . optimal-pixel). -Uses ternary search for O(log n) complexity instead of O(n)." - (let* ((ekp-caches (if use-cache - ekp-caches - (make-hash-table - :test 'equal :size 100 :rehash-size 1.5 :weakness nil))) - (strings (split-string string "\n")) - (best-pixel (ekp--ternary-search-optimal-width strings min-pixel max-pixel))) - (cons (ekp-pixel-justify string best-pixel use-cache) best-pixel))) - -(provide 'ekp) +;;; 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 (or load-file-name (buffer-file-name)) + "Path to this file, for locating dictionaries.") + +(defvar ekp-latin-lang "en_US" + "Language code for hyphenation (e.g., 'en_US', 'de_DE').") + +;;;; 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 "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) + +;;;; K-P Algorithm Parameters + +(defvar ekp-line-penalty 10 + "Penalty for each line break. Higher = fewer lines. Default 10.") + +(defvar ekp-hyphen-penalty 50 + "Penalty for hyphenated breaks. Higher = avoid hyphenation. Default 50.") + +(defvar ekp-adjacent-fitness-penalty 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).") + +(defvar ekp-looseness 0 + "Target line count offset: 0=optimal, +1=looser, -1=tighter.") + +;;;; 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 () + "Return directory containing ekp.el." + (when ekp--load-file + (file-name-directory ekp--load-file))) + +(defun ekp--load-dicts () + "Load hyphenation dictionaries." + (ekp-hyphen-load-languages + (expand-file-name "dictionaries" (ekp-root-dir)))) + +(ekp--load-dicts) + +;;;; 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) + "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-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)) + +;;;; 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.") + +(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 hyphen-idxs) + (dolist (box (append boxes nil)) + (if (string-match (format "^\\([[{<„‚¿¡*@\"']*\\)\\(%s+\\)\\([]}>.,*?\"']*\\)$" + ekp--latin-regexp) + box) + ;; 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))) + (cons (vconcat (apply #'append (nreverse new-boxes))) + (vconcat (nreverse hyphen-idxs))))) + +(defun ekp--str-type (str) + "STR should be single letter string." + (cond + ;; a half-width cjk punct + ((or (string= "“" str) (string= "”" str)) 'cjk) + ((= (string-width str) 1) 'latin) + ((= (string-width str) 2) + (if (ekp-cjk-fw-punct-p str) + 'cjk-punct + 'cjk)) + (t (error "Abnormal string width %s for %s" + (string-width str) str)))) + +(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))))) + +(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." + (let ((before (cdr prev-box-type)) + (after (car curr-box-type))) + (if before + (cond + ((and (eq before 'latin) (eq after 'latin)) 'lws) + ((and (eq before 'cjk) (eq after 'cjk)) 'cws) + ((or (and (eq before 'cjk) (eq after 'latin)) + (and (eq before 'latin) (eq after 'cjk))) + 'mws) + ((or (eq before 'cjk-punct) (eq after 'cjk-punct)) 'cws)) + 'nws))) + +(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) + ((eq 'lws type) ekp-lws-ideal-pixel) + ((eq 'mws type) ekp-mws-ideal-pixel) + ((eq 'cws type) ekp-cws-ideal-pixel))) + +(defun ekp-glue-min-pixel (type) + (cond ((or (null type) (eq 'nws type)) 0) + ((eq 'lws type) ekp-lws-min-pixel) + ((eq 'mws type) ekp-mws-min-pixel) + ((eq 'cws type) ekp-cws-min-pixel))) + +(defun ekp-glue-max-pixel (type) + (cond ((or (null type) (eq 'nws type)) 0) + ((eq 'lws type) ekp-lws-max-pixel) + ((eq 'mws type) ekp-mws-max-pixel) + ((eq 'cws type) ekp-cws-max-pixel))) + +;;; ============================================================ +;;; 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)) + (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--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 + :hyphen-pixel hyphen-pixel + :ideal-prefixs ideal-prefixs + :min-prefixs min-prefixs + :max-prefixs max-prefixs + :dp-cache (make-hash-table :test 'eql :size 20)))) + +(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-clear-caches () + "Clear all paragraph caches." + (interactive) + (setq ekp--para-cache nil)) + +;;;; Paragraph Accessors + +(defun ekp--boxes (string) + (ekp-para-boxes (ekp--get-para string))) + +(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: +;; 0=tight, 1=decent, 2=loose, 3=very-loose +;; Adjacent lines with class difference > 1 get extra penalty. + +(defun ekp--compute-badness (adjustment-pixel flexibility-pixel) + "Compute Knuth-Plass badness from ADJUSTMENT-PIXEL and FLEXIBILITY-PIXEL. +Returns 0 if no adjustment needed, 10000 (infinite) if impossible." + (cond + ((= adjustment-pixel 0) 0) + ((<= flexibility-pixel 0) 10000) + (t (let ((ratio (/ (float adjustment-pixel) flexibility-pixel))) + (min 10000 (* 100 (expt (abs ratio) 3))))))) + +(defun ekp--compute-fitness-class (adjustment-pixel flexibility-pixel) + "Classify line tightness into fitness class (0-3). +0=tight (shrunk), 1=decent, 2=loose, 3=very-loose." + (if (<= flexibility-pixel 0) + 1 ; default to decent + (let ((ratio (/ (float adjustment-pixel) flexibility-pixel))) + (cond + ((< ratio -0.5) 0) ; tight (significantly shrunk) + ((< ratio 0.5) 1) ; decent (close to ideal) + ((< ratio 1.0) 2) ; loose + (t 3))))) ; very loose + +(defun ekp--compute-demerits (badness penalty prev-fitness curr-fitness + end-with-hyphenp prev-hyphen-count) + "Compute K-P demerits for a line break. +BADNESS is the line badness, PENALTY is break penalty (e.g., hyphen). +PREV-FITNESS and CURR-FITNESS are fitness classes of adjacent lines. +Returns total demerits for this break." + (let* (;; Base demerits: (linepenalty + badness)² + (base (expt (+ ekp-line-penalty badness) 2)) + ;; Add break penalty + (with-penalty (+ base (* penalty penalty))) + ;; Fitness incompatibility penalty + (fitness-delta (abs (- prev-fitness curr-fitness))) + (with-fitness (if (> fitness-delta 1) + (+ with-penalty ekp-adjacent-fitness-penalty) + with-penalty)) + ;; Consecutive hyphen penalty (quadratic growth) + (hyphen-count (if end-with-hyphenp (1+ prev-hyphen-count) 0)) + (with-hyphen (if end-with-hyphenp + (+ with-fitness (* 100 hyphen-count hyphen-count)) + with-fitness))) + with-hyphen)) + +(defun ekp--gaps-list (glues-types) + "Count gaps by type: (latin-gaps mix-gaps cjk-gaps)." + (list (seq-count (lambda (it) (eq 'lws it)) glues-types) + (seq-count (lambda (it) (eq 'mws it)) glues-types) + (seq-count (lambda (it) (eq 'cws it)) glues-types))) + +(defun ekp--compute-stretch-capacity (gaps-list) + "Return total stretchable pixels for GAPS-LIST." + (+ (* (nth 0 gaps-list) ekp-lws-stretch-pixel) + (* (nth 1 gaps-list) ekp-mws-stretch-pixel) + (* (nth 2 gaps-list) ekp-cws-stretch-pixel))) + +(defun ekp--compute-shrink-capacity (gaps-list) + "Return total shrinkable pixels for GAPS-LIST (CJK gaps don't shrink)." + (+ (* (nth 0 gaps-list) ekp-lws-shrink-pixel) + (* (nth 1 gaps-list) ekp-mws-shrink-pixel))) + +(defun ekp--line-badness-and-fitness (ideal-pixel line-pixel glues-types) + "Compute badness, fitness class, and gaps for a line. +Returns (:badness NUM :fitness NUM :gaps LIST :adjustment NUM :flexibility NUM)." + (let* ((glues-types (seq-drop glues-types 1)) + (gaps-list (ekp--gaps-list glues-types)) + (adjustment (- line-pixel ideal-pixel)) + (flexibility (if (> adjustment 0) + (ekp--compute-stretch-capacity gaps-list) + (ekp--compute-shrink-capacity gaps-list))) + (badness (ekp--compute-badness adjustment flexibility)) + (fitness (ekp--compute-fitness-class adjustment flexibility))) + (list :badness badness + :fitness fitness + :gaps gaps-list + :adjustment adjustment + :flexibility flexibility))) + +(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 + +(defun ekp--dp-init-arrays (n) + "Initialize DP arrays for N boxes. +Returns (backptrs demerits rests gaps hyphen-counts fitness-classes line-counts)." + (let ((backptrs (make-vector (1+ n) nil)) + (demerits (make-vector (1+ n) nil)) + (rests (make-vector (1+ n) nil)) + (gaps (make-vector (1+ n) nil)) + (hyphen-counts (make-vector (1+ n) 0)) + (fitness-classes (make-vector (1+ n) 1)) ; default: decent + (line-counts (make-vector (1+ n) 0))) ; for looseness + (aset demerits 0 0.0) + (list backptrs demerits rests gaps hyphen-counts fitness-classes line-counts))) + +(defun ekp--dp-line-metrics (i k glues-types ideal-prefixs min-prefixs max-prefixs) + "Compute line metrics for boxes I to K. +Returns (ideal-pixel min-pixel max-pixel) excluding leading glue." + (let ((leading-glue-type (aref glues-types i))) + (list (- (aref ideal-prefixs k) (aref ideal-prefixs i) + (ekp-glue-ideal-pixel leading-glue-type)) + (- (aref min-prefixs k) (aref min-prefixs i) + (ekp-glue-min-pixel leading-glue-type)) + (- (aref max-prefixs k) (aref max-prefixs i) + (ekp-glue-max-pixel leading-glue-type))))) + +(defun ekp--dp-force-break (i k arrays glues-types ideal-prefixs hyphen-pixel line-pixel) + "Force a break at K-1 when no valid break found. Update ARRAYS." + (let* ((backptrs (nth 0 arrays)) + (demerits (nth 1 arrays)) + (rests (nth 2 arrays)) + (gaps (nth 3 arrays)) + (fitness-classes (nth 5 arrays)) + (line-counts (nth 6 arrays)) + (break-pos (1- k)) + (hyphenate-p (ekp--hyphenate-p glues-types break-pos)) + (ideal-pixel (- (aref ideal-prefixs break-pos) + (aref ideal-prefixs i) + (ekp-glue-ideal-pixel (aref glues-types i)))) + (rest-pixel (- line-pixel ideal-pixel))) + (when hyphenate-p (cl-incf ideal-pixel hyphen-pixel)) + ;; Force break with high demerits + (aset demerits break-pos (+ 10000 (expt rest-pixel 2))) + (aset rests break-pos rest-pixel) + (aset backptrs break-pos i) + (aset fitness-classes break-pos 3) ; very loose + (aset line-counts break-pos (1+ (aref line-counts i))) + (aset gaps break-pos + (ekp--gaps-list (seq-drop (cl-subseq glues-types i break-pos) 1))))) + +(defun ekp--dp-compute-line-demerits (j is-last end-with-hyphenp + ideal-pixel line-pixel + glues-types i k + prev-hyphen-count prev-fitness) + "Compute line demerits using full K-P formula. +Returns (demerits gaps fitness new-hyphen-count)." + (cond + ;; Single word line + ((= j 0) + (let* ((badness (ekp--compute-badness (- line-pixel ideal-pixel) 1)) + (fitness 1) ; decent + (penalty (if end-with-hyphenp ekp-hyphen-penalty 0)) + (new-hyphen (if end-with-hyphenp 1 0)) + (dem (ekp--compute-demerits badness penalty prev-fitness fitness + end-with-hyphenp prev-hyphen-count))) + (list dem nil fitness new-hyphen))) + ;; Last line: minimal demerits if reasonably filled + (is-last + (let* ((fill-ratio (/ (float ideal-pixel) line-pixel)) + ;; Penalize if last line is too short + (badness (if (< fill-ratio ekp-last-line-min-ratio) + (* 50 (- 1.0 fill-ratio)) + 0)) + (dem (expt (+ ekp-line-penalty badness) 2))) + (list dem nil 1 0))) + ;; Normal line + (t + (let* ((result (ekp--line-badness-and-fitness ideal-pixel line-pixel + (seq-subseq glues-types i k))) + (badness (plist-get result :badness)) + (fitness (plist-get result :fitness)) + (line-gaps (plist-get result :gaps)) + (penalty (if end-with-hyphenp ekp-hyphen-penalty 0)) + (new-hyphen (if end-with-hyphenp (1+ prev-hyphen-count) 0)) + (dem (ekp--compute-demerits badness penalty prev-fitness fitness + end-with-hyphenp prev-hyphen-count))) + (list dem line-gaps fitness new-hyphen))))) + +(defun ekp--dp-trace-breaks (backptrs n) + "Trace optimal break points from BACKPTRS array." + (let ((breaks (list n)) + (index n)) + (while (> index 0) + (let ((prev (aref backptrs index))) + (if prev + (progn (push prev breaks) + (setq index prev)) + (setq index (1- index))))) + (cdr breaks))) + +(defun ekp--dp-trace-breaks-with-looseness (backptrs line-counts n target-lines) + "Trace breaks, preferring paths with TARGET-LINES line count. +Used for looseness parameter support." + (if (= ekp-looseness 0) + (ekp--dp-trace-breaks backptrs n) + ;; Find path closest to target line count + (let ((optimal-lines (aref line-counts n)) + (target (+ optimal-lines ekp-looseness))) + ;; For now, just use optimal path + ;; Full looseness would require tracking multiple paths + (ekp--dp-trace-breaks backptrs n)))) + +(defun ekp--dp-store-cache (string line-pixel dp-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." + (let* ((para (ekp--get-para string)) + (cached (ekp--dp-get-cached para line-pixel))) + (if cached + cached + ;; 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-para-ideal-prefixs para)) + (min-prefixs (ekp-para-min-prefixs para)) + (max-prefixs (ekp-para-max-prefixs para)) + (arrays (ekp--dp-init-arrays n)) + (backptrs (nth 0 arrays)) + (demerits (nth 1 arrays)) + (rests (nth 2 arrays)) + (gaps (nth 3 arrays)) + (hyphen-counts (nth 4 arrays)) + (fitness-classes (nth 5 arrays)) + (line-counts (nth 6 arrays))) + ;; Main DP loop: for each reachable position i + (dotimes (i (1+ n)) + (when (aref demerits i) + (let ((prev-hyphen-count (aref hyphen-counts i)) + (prev-fitness (aref fitness-classes i)) + (prev-line-count (aref line-counts i))) + (catch 'break + ;; Try extending line to each position k > i + (dotimes (j (- n i)) + (let* ((k (+ i j 1)) + (is-last (= k n)) + (end-with-hyphenp (ekp--hyphenate-p glues-types k)) + (metrics (ekp--dp-line-metrics + i k glues-types ideal-prefixs min-prefixs max-prefixs)) + (ideal-pixel (nth 0 metrics)) + (min-pixel (nth 1 metrics)) + (max-pixel (nth 2 metrics))) + ;; Add hyphen width if line ends with hyphen + (when end-with-hyphenp + (cl-incf ideal-pixel hyphen-pixel) + (cl-incf max-pixel hyphen-pixel) + (cl-incf min-pixel hyphen-pixel)) + ;; Check if line is too long + (when (or (> min-pixel line-pixel) + (and is-last (> ideal-pixel line-pixel))) + (when (null (aref demerits (1- k))) + (ekp--dp-force-break i k arrays glues-types + ideal-prefixs hyphen-pixel line-pixel)) + (throw 'break nil)) + ;; Valid break point: compute demerits + (when (or (<= min-pixel line-pixel max-pixel) + (and is-last (<= ideal-pixel line-pixel))) + (pcase-let ((`(,dem ,line-gaps ,fitness ,new-hyphen) + (ekp--dp-compute-line-demerits + j is-last end-with-hyphenp + ideal-pixel line-pixel glues-types i k + prev-hyphen-count prev-fitness))) + (let ((total-dem (+ (aref demerits i) dem))) + (when (or (null (aref demerits k)) + (< total-dem (aref demerits k))) + (aset rests k (- line-pixel ideal-pixel)) + (aset gaps k line-gaps) + (aset demerits k total-dem) + (aset backptrs k i) + (aset fitness-classes k fitness) + (aset hyphen-counts k new-hyphen) + (aset line-counts k (1+ prev-line-count)))))))))))) + ;; Extract optimal solution + (let* ((breaks (ekp--dp-trace-breaks-with-looseness + backptrs line-counts n (aref line-counts n))) + (lines-rests (mapcar (lambda (i) (aref rests i)) breaks)) + (lines-gaps (mapcar (lambda (i) (aref gaps i)) breaks)) + (dp-result (list :rests lines-rests + :gaps lines-gaps + :breaks breaks + :cost (aref demerits n) + :line-count (aref line-counts n)))) + (puthash line-pixel dp-result (ekp-para-dp-cache para)) + dp-result))))) + +(defun ekp-dp-data (string line-pixel &optional key) + "Return the data plist of dp cache. If KEY is non-nil, +return the value of KEY in plist." + (let ((data (ekp-dp-cache string line-pixel))) + (if key + (plist-get data key) + data))) + +(defun ekp-total-cost (string line-pixel) + "Return the COST of kp algorithm." + (ekp-dp-data string line-pixel :cost)) + +(defun ekp-line-breaks (string line-pixel) + "Return the break points of kp algorithm." + (ekp-dp-data string line-pixel :breaks)) + +;;; Line Glue Distribution +;; Distributes extra/deficit space across glues (gaps between boxes) +;; Priority: latin gaps → mixed gaps → CJK gaps + +(defun ekp--distribute-gap-adjustment (rest-pixel gaps-list stretch-p) + "Distribute REST-PIXEL across GAPS-LIST. +STRETCH-P indicates stretch (t) or shrink (nil) mode. +Returns ((latin-adj . latin-extra) (mix-adj . mix-extra) (cjk-adj . cjk-extra))." + (let* ((latin-gaps (nth 0 gaps-list)) + (mix-gaps (nth 1 gaps-list)) + (cjk-gaps (nth 2 gaps-list)) + (remaining rest-pixel) + ;; Per-gap adjustment values + (latin-change (if stretch-p ekp-lws-stretch-pixel ekp-lws-shrink-pixel)) + (mix-change (if stretch-p ekp-mws-stretch-pixel ekp-mws-shrink-pixel)) + (cjk-change (if stretch-p ekp-cws-stretch-pixel 0)) + ;; Results + (latin-adj 0) (latin-extra 0) + (mix-adj 0) (mix-extra 0) + (cjk-adj 0) (cjk-extra 0)) + ;; Distribute to latin gaps first + (let ((latin-capacity (* latin-gaps latin-change))) + (if (< remaining latin-capacity) + (when (> latin-gaps 0) + (setq latin-adj (/ remaining latin-gaps)) + (setq latin-extra (% remaining latin-gaps)) + (setq remaining 0)) + (setq latin-adj latin-change) + (setq remaining (- remaining latin-capacity)))) + ;; Then to mixed gaps + (when (> remaining 0) + (let ((mix-capacity (* mix-gaps mix-change))) + (if (< remaining mix-capacity) + (when (> mix-gaps 0) + (setq mix-adj (/ remaining mix-gaps)) + (setq mix-extra (% remaining mix-gaps)) + (setq remaining 0)) + (setq mix-adj mix-change) + (setq remaining (- remaining mix-capacity))))) + ;; Finally to CJK gaps + (when (and (> remaining 0) (> cjk-gaps 0)) + (setq cjk-adj (/ remaining cjk-gaps)) + (setq cjk-extra (% remaining cjk-gaps))) + (list (cons latin-adj latin-extra) + (cons mix-adj mix-extra) + (cons cjk-adj cjk-extra)))) + +(defun ekp--compute-glue-pixels (glues-types gaps-distribution stretch-p) + "Compute actual glue pixels from GLUES-TYPES and GAPS-DISTRIBUTION. +Returns list of pixel values for each glue." + (let ((latin-adj (car (nth 0 gaps-distribution))) + (latin-extra (cdr (nth 0 gaps-distribution))) + (mix-adj (car (nth 1 gaps-distribution))) + (mix-extra (cdr (nth 1 gaps-distribution))) + (cjk-adj (car (nth 2 gaps-distribution))) + (cjk-extra (cdr (nth 2 gaps-distribution))) + (latin-idx -1) (mix-idx -1) (cjk-idx -1)) + (mapcar + (lambda (type) + (let* ((base (ekp-glue-ideal-pixel type)) + (adj (pcase type + ('lws (cl-incf latin-idx) + (+ latin-adj (if (< latin-idx latin-extra) 1 0))) + ('mws (cl-incf mix-idx) + (+ mix-adj (if (< mix-idx mix-extra) 1 0))) + ('cws (cl-incf cjk-idx) + (+ cjk-adj (if (< cjk-idx cjk-extra) 1 0))) + ('nws 0) + (_ 0)))) + (if stretch-p (+ base adj) (- base adj)))) + glues-types))) + +(defun ekp--line-glue-single-box (line-pixel box-width hyphen-p hyphen-pixel) + "Compute glues for a single-box line." + (let ((trailing (- line-pixel box-width (if hyphen-p hyphen-pixel 0)))) + (list 0 trailing))) + +(defun ekp--line-glue-last-line (glues-types ideal-pixel line-pixel) + "Compute glues for last line (ragged right)." + (append '(0) + (mapcar #'ekp-glue-ideal-pixel glues-types) + (list (- line-pixel ideal-pixel)))) + +(defun ekp--line-glue-normal (glues-types rest-pixel gaps-list) + "Compute glues for a normal (justified) line." + (if (= rest-pixel 0) + (append '(0) (mapcar #'ekp-glue-ideal-pixel glues-types) '(0)) + (let* ((stretch-p (> rest-pixel 0)) + (distribution (ekp--distribute-gap-adjustment + (abs rest-pixel) gaps-list stretch-p)) + (glue-pixels (ekp--compute-glue-pixels glues-types distribution stretch-p))) + (append '(0) glue-pixels '(0))))) + +(defun ekp-line-glues (string line-pixel) + "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)) + (breaks (ekp-line-breaks string line-pixel)) + (lines-rests (ekp-dp-data string line-pixel :rests)) + (lines-gaps (ekp-dp-data string line-pixel :gaps)) + (hyphen-pixel (ekp--hyphen-pixel string)) + (line-glues (make-vector (length breaks) nil)) + (start 0)) + (dotimes (i (length breaks)) + (let* ((end (nth i breaks)) + (line-boxes-widths (cl-subseq boxes-widths start end)) + (line-glues-types (seq-drop (cl-subseq glues-types start end) 1)) + (is-last (>= end boxes-num)) + (hyphen-p (ekp--hyphenate-p glues-types end)) + (ideal-pixel (- (aref ideal-prefixs end) + (aref ideal-prefixs start) + (ekp-glue-ideal-pixel (aref glues-types start)))) + (max-pixel (+ (- (aref max-prefixs end) + (aref max-prefixs start) + (ekp-glue-max-pixel (aref glues-types start))) + (if hyphen-p hyphen-pixel 0))) + glue-list) + (setq glue-list + (cond + ;; Single box: just trailing space + ((= 1 (length line-boxes-widths)) + (ekp--line-glue-single-box line-pixel + (aref line-boxes-widths 0) + hyphen-p hyphen-pixel)) + ;; Last line: ragged right + (is-last + (ekp--line-glue-last-line line-glues-types ideal-pixel line-pixel)) + ;; Forced break (line too short even at max stretch) + ((< max-pixel line-pixel) + (append '(0) + (mapcar #'ekp-glue-max-pixel line-glues-types) + (list (- line-pixel max-pixel)))) + ;; Normal justified line + (t + (ekp--line-glue-normal line-glues-types + (nth i lines-rests) + (nth i lines-gaps))))) + (aset line-glues i (vconcat glue-list)) + (setq start end))) + line-glues)) + +(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 (butlast glues)) + (boxes (append boxes nil))) + (if (= (length glues) (length boxes)) + (string-join (append (ekp--interleave glues boxes) + (list last-glue))) + (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)) + (breaks (ekp-line-breaks string line-pixel)) + (num (length breaks)) + (lines-glues (ekp-line-glues string line-pixel)) + (glues-types (ekp--glues-types string)) + (start 0) strings) + (dotimes (i num) + (let* ((end (nth i breaks)) + (line-boxes (cl-subseq boxes start end)) + (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) + (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) + strings) + (setq start end))) + (mapconcat 'identity (nreverse strings) "\n"))) + +(defun ekp-pixel-justify (string line-pixel &optional _use-cache) + "Justify multiline STRING to LINE-PIXEL. +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) + "" + (ekp--pixel-justify str line-pixel))) + strs "\n"))) + +;;; Optimal Width Search +;; +;; 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 ((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) iterations + (while (> (- hi lo) 2) + (let* ((mid1 (+ lo (/ (- hi lo) 3))) + (mid2 (- hi (/ (- hi lo) 3))) + (cost1 (ekp--compute-avg-cost strings mid1)) + (cost2 (ekp--compute-avg-cost strings mid2))) + (if (< cost1 cost2) + (setq hi mid2) + (setq lo mid1)))) + ;; Final linear scan over remaining 3 candidates + (let ((best-pixel lo) + (best-cost (ekp--compute-avg-cost strings lo))) + (dolist (p (list (1+ lo) hi)) + (when (<= p max-pixel) + (let ((cost (ekp--compute-avg-cost strings p))) + (when (< cost best-cost) + (setq best-cost cost + best-pixel p))))) + best-pixel))) + +(defun ekp-pixel-range-justify (string min-pixel max-pixel &optional _use-cache) + "Find optimal width for STRING between MIN-PIXEL and MAX-PIXEL. +Returns (justified-text . optimal-pixel). +Uses ternary search for O(log n) width evaluations. +All preprocessing is cached via ekp--para-cache." + (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) best-pixel))) + +(provide 'ekp) + +;;; ekp.el ends here diff --git a/readme.md b/readme.md index d636709..3a2a160 100644 --- a/readme.md +++ b/readme.md @@ -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) diff --git a/readme_zh.md b/readme_zh.md index 8ed3899..3bc7e78 100644 --- a/readme_zh.md +++ b/readme_zh.md @@ -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) diff --git a/tests/ekp-tests.el b/tests/ekp-tests.el index 38dd87c..11b3ecf 100644 --- a/tests/ekp-tests.el +++ b/tests/ekp-tests.el @@ -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)