ekp/ekp.el
Kinneyzhang 95ed2b32d1 feat: buffer-level justification — region commands and auto-justify mode
The renderer (shared by both engines) is now lossless: synthesized
glue carries the original text it replaced (ekp-glue), soft line
breaks carry the whitespace swallowed around the break
(ekp-soft-break), break hyphens are marked (ekp-soft-hyphen), and
paragraph-edge whitespace survives as zero-display ekp-hidden text.
Orphaned ekp--combine-glues-and-boxes / ekp--interleave removed.

New ekp-region.el:
- ekp-justify-region / ekp-unjustify-region: in-place justification
  with exact structural restore (character- and property-exact),
  robust to edits made while justified
- ekp-auto-justify-mode: keeps the buffer justified at the window
  width; debounced re-flow on window resize, incremental
  per-paragraph re-justification after edits (served by the
  paragraph cache)
- fix found in live GUI testing: buffer-local members of
  window-size-change-functions receive the WINDOW as argument and
  may run with an unrelated buffer current; the handler now resolves
  window and buffer explicitly (regression test included)

Tests: 47 ERT (36 core + 11 region) passing; 300-case fuzz 0
failures (C/elisp parity unchanged); byte-compile clean with
error-on-warn. Verified interactively in GUI Emacs: justified at
1403px maximized, auto-reflowed to 614px on frame resize.

docs: interactive-use section in readme.md / readme_zh.md
ci: byte-compile list includes ekp-region.el

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
2026-07-26 20:23:03 +08:00

1690 lines
74 KiB
EmacsLisp
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; 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 "29.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)
;; Defined by the dynamic module (ekp_c/ekp.dylib | .so | .dll)
(declare-function ekp-c-set-penalties "ext:ekp")
(declare-function ekp-c-break-with-arrays "ext:ekp")
(declare-function ekp-c-break-batch "ext:ekp")
(defconst ekp--load-file (or load-file-name (buffer-file-name))
"Path to this file, for locating dictionaries.")
(defvar ekp-latin-lang "en_US"
"Language code for hyphenation (e.g., \"en_US\", \"de_DE\").")
(defvar ekp-use-c-module t
"When non-nil, use C dynamic module for DP computation if available.
The C module provides significant performance improvement for large texts.
Set to nil to force pure Elisp implementation.")
;;;; 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-default-cws-stretch-pixel 2
"Max stretched pixel of whitespace between CJK chars.")
(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.
Note: added to demerits as penalty², following the K-P formula.")
(defvar ekp-adjacent-fitness-penalty 100
"Penalty when adjacent lines differ in tightness by >1 class.")
(defvar ekp-consecutive-hyphen-penalty 100
"Base penalty multiplier for consecutive hyphenated lines.
Actual penalty = this × count², encouraging spread of hyphens.")
(defvar ekp-last-line-short-penalty 50
"Penalty multiplier for underfilled last lines.
Applied as: this × (1 - fill-ratio) when fill < `ekp-last-line-min-ratio'.")
(defvar ekp-last-line-min-ratio 0.5
"Minimum fill ratio for last line (0.0-1.0).")
(defvar ekp-looseness 0
"Target line count offset: 0=optimal, +1=looser (more lines), -1=tighter.
When non-zero, a full (position × line-count) dynamic program is run
and the path whose line count is closest to (optimal + looseness) with
the lowest demerits is selected. Only supported by the Elisp engine;
when non-zero the C module is bypassed automatically.")
(defconst ekp--infinite-badness 10000
"Badness value treated as infinitely bad (matches TeX).")
;;;; Paragraph Cache Structure
;;
;; All paragraph data is stored in a flat struct for O(1) access.
(cl-defstruct (ekp-para (:constructor ekp-para--create))
"Preprocessed paragraph data."
string latin-font cjk-font
boxes boxes-widths boxes-types glues-types
hyphen-pixel hyphen-positions
ideal-prefixs min-prefixs max-prefixs
;; Per-position leading glue values (indexed by box, n elements)
glue-ideals glue-shrinks glue-stretches
;; Prefix counts of each stretchable glue type (n+1 elements each);
;; entry i = number of that glue type among glue indices 0..i-1.
lws-prefixs mws-prefixs cws-prefixs
;; Space-box run widths: lead-spaces[i] = total width of consecutive
;; space boxes starting at box i (forced to 0 at i=0 so that first-line
;; indentation is preserved); trail-spaces[k] = total width of
;; consecutive space boxes ending at box k-1.
lead-spaces trail-spaces
;; Glue params snapshot at para creation time (plist)
glue-params
(dp-cache nil :type hash-table))
(defvar ekp--para-cache nil
"Cache: equal-keyed table, content key → ekp-para struct.")
(defvar ekp--last-para nil
"Fast path: (string-object lang para) of the most recent lookup.
One justification call resolves the same string object many times;
this avoids recomputing the full cache key each time. Invalidated
by parameter changes, language changes and `ekp-clear-caches'.")
(defvar ekp-para-cache-limit 256
"Maximum number of cached paragraphs.
When exceeded, the whole paragraph cache is flushed (cheap to rebuild).")
(defvar ekp--params-explicit nil
"Non-nil after `ekp-param-set'; spacing params then persist until
`ekp-param-reset'. When nil, defaults are derived from each string.")
;;;; Initialization
;; ekp-root-dir is provided by ekp-utils.el
(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-apply (lws-i lws-+ lws-- mws-i mws-+ mws-- cws-i cws-+ cws--)
"Set the nine spacing variables and derived limits (internal)."
(setq ekp-lws-ideal-pixel lws-i ekp-lws-stretch-pixel lws-+
ekp-lws-shrink-pixel lws-- ekp-mws-ideal-pixel mws-i
ekp-mws-stretch-pixel mws-+ ekp-mws-shrink-pixel mws--
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--))
;; Spacing changed: paragraphs must be re-resolved against it.
(setq ekp--last-para nil))
(defun ekp-param-set (lws-i lws-+ lws-- mws-i mws-+ mws-- cws-i cws-+ cws--)
"Set all spacing parameters explicitly; they persist until `ekp-param-reset'.
LWS = Latin word space, MWS = mixed, CWS = CJK.
Each takes ideal, stretch (+), and shrink (-) values in pixels."
(ekp--param-apply lws-i lws-+ lws-- mws-i mws-+ mws-- cws-i cws-+ cws--)
(setq ekp--params-explicit t))
(defun ekp-param-set-default (string)
"Compute and apply default spacing parameters based on STRING's font.
Does not mark parameters as explicit; each paragraph gets fresh defaults."
(let* ((lws (max 1 (ekp-word-spacing-pixel string)))
(mws (max 0 (- lws 1))))
(ekp--param-apply lws (ceiling (/ (float lws) 2)) (ceiling (/ (float lws) 3))
mws (ceiling (/ (float mws) 2)) (ceiling (/ (float mws) 3))
0 ekp-default-cws-stretch-pixel 0)))
(defun ekp-param-reset ()
"Clear explicit spacing parameters; defaults are derived per string again."
(interactive)
(setq ekp--params-explicit nil)
(setq ekp-lws-ideal-pixel nil ekp-lws-stretch-pixel nil
ekp-lws-shrink-pixel nil ekp-mws-ideal-pixel nil
ekp-mws-stretch-pixel nil ekp-mws-shrink-pixel nil
ekp-cws-ideal-pixel nil ekp-cws-stretch-pixel nil
ekp-cws-shrink-pixel nil)
(setq ekp--last-para nil))
;;;; Text Analysis
(defconst ekp--latin-regexp
"[A-Za-z'\\-À-ÖØ-öø-ÿĀ-ɏḀ-ỿ]"
"Regexp matching Latin characters including accented forms.")
(defconst ekp--word-left-punct "[({<„‚«‹¿¡*@\"'‘“"
"Characters that may precede a hyphenatable Latin word.")
(defconst ekp--word-right-punct ")}>.,;:!?*\"'’”»›"
"Characters that may follow a hyphenatable Latin word.
NB: `]' is included separately at the start of the character class.")
(defun ekp--split-with-hyphen (string)
"Split STRING into boxes with hyphenation points marked.
Returns (boxes-vector . hyphen-positions-vector)."
(let* ((boxes (ekp-split-to-boxes string))
;; NB: both punct sets are spliced into character classes;
;; they contain no chars that are special inside [...].
(word-re (format "^\\([%s]*\\)\\(%s+\\)\\([]%s]*\\)$"
ekp--word-left-punct
ekp--latin-regexp
ekp--word-right-punct))
(idx 0) new-boxes hyphen-idxs)
(dolist (box (append boxes nil))
(if (string-match word-re 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 (> (length left) 0)
(setcar parts (concat left (car parts))))
(when (> (length right) 0)
(setcar (last parts)
(concat (car (last parts)) right)))
(push parts new-boxes)
(dotimes (i n)
(when (< i (1- n)) (push idx hyphen-idxs))
(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)
"Classify single-character string STR.
Returns one of `space', `latin', `cjk', `cjk-punct'."
(cond
;; Whitespace or zero-width characters
((or (string-blank-p str) (= (string-width str) 0)) 'space)
;; a half-width cjk punct
((or (string= "" str) (string= "" str)) 'cjk)
((= (string-width str) 1) 'latin)
((ekp-cjk-fw-punct-p str) 'cjk-punct)
;; double-width (or wider): CJK-like content, including emoji
(t 'cjk)))
(defun ekp--box-edge-char (box from-end)
"Return the first (or last, if FROM-END) visible char of BOX as a string.
Skips zero-width characters; falls back to the edge char."
(let* ((len (length box))
(idx (if from-end (1- len) 0))
(step (if from-end -1 1)))
(while (and (>= idx 0) (< idx len)
(= (char-width (aref box idx)) 0))
(setq idx (+ idx step)))
(if (and (>= idx 0) (< idx len))
(substring box idx (1+ idx))
(substring box (if from-end (1- len) 0)
(if from-end len 1)))))
(defun ekp--box-type (box)
"Return (START-TYPE . END-TYPE) for BOX, or nil for empty boxes."
(unless (or (null box) (string-empty-p box))
;; Space/zero-width boxes: type is (space . space)
(if (or (string-blank-p box) (= (string-width box) 0))
'(space . space)
(cons (ekp--str-type (ekp--box-edge-char box nil))
(ekp--str-type (ekp--box-edge-char box t))))))
(defun ekp--glue-type (prev-box-type curr-box-type)
"Glue type between boxes: `lws', `mws', `cws' or `nws'.
Lws means whitespace between latin words; cws between cjk chars;
mws between cjk and latin; nws means no whitespace. Space boxes
\(preserved whitespace) need no additional glue."
(let ((before (cdr prev-box-type))
(after (car curr-box-type)))
(if before
(cond
;; Space boxes: no additional glue needed
((or (eq before 'space) (eq after 'space)) 'nws)
((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)
(let ((curr-type (aref boxes-types i)))
(unless (aref glues i)
(aset glues i (ekp--glue-type prev-type curr-type)))
(setq prev-type curr-type)))
glues))
(defun ekp-glue-ideal-pixel (type)
(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--para-glue-ideal (para type)
"Get ideal glue pixel for TYPE using PARA's stored glue params."
(let ((params (ekp-para-glue-params para)))
(cond ((or (null type) (eq 'nws type)) 0)
((eq 'lws type) (plist-get params :lws-ideal))
((eq 'mws type) (plist-get params :mws-ideal))
((eq 'cws type) (plist-get params :cws-ideal)))))
(defun ekp--para-glue-shrink (para type)
"Get shrink amount for TYPE using PARA's stored glue params."
(let ((params (ekp-para-glue-params para)))
(cond ((or (null type) (eq 'nws type)) 0)
((eq 'lws type) (plist-get params :lws-shrink))
((eq 'mws type) (plist-get params :mws-shrink))
((eq 'cws type) (plist-get params :cws-shrink)))))
(defun ekp--para-glue-stretch (para type)
"Get stretch amount for TYPE using PARA's stored glue params."
(let ((params (ekp-para-glue-params para)))
(cond ((or (null type) (eq 'nws type)) 0)
((eq 'lws type) (plist-get params :lws-stretch))
((eq 'mws type) (plist-get params :mws-stretch))
((eq 'cws type) (plist-get params :cws-stretch)))))
(defun ekp--para-glue-min (para type)
"Get minimum glue pixel (ideal - shrink) for TYPE."
(- (ekp--para-glue-ideal para type)
(ekp--para-glue-shrink para type)))
(defun ekp--para-glue-max (para type)
"Get maximum glue pixel (ideal + stretch) for TYPE."
(+ (ekp--para-glue-ideal para type)
(ekp--para-glue-stretch para type)))
;;; ============================================================
;;; Cache Implementation
;;; ============================================================
(defun ekp--para-key (string)
"Compute cache key for STRING.
The key is a structure compared with `equal', so hash collisions
cannot alias two different paragraphs. It covers: characters, text
properties, detected fonts, the hyphenation language, and the
effective spacing parameters \(or the symbol `auto' when defaults
are derived per string)."
(let ((latin-font (ekp-latin-font string))
(cjk-font (ekp-cjk-font string)))
(list string
(prin1-to-string (object-intervals string))
latin-font cjk-font
ekp-latin-lang
(if (and ekp--params-explicit (ekp--params-set-p))
(list ekp-lws-ideal-pixel ekp-lws-stretch-pixel
ekp-lws-shrink-pixel ekp-mws-ideal-pixel
ekp-mws-stretch-pixel ekp-mws-shrink-pixel
ekp-cws-ideal-pixel ekp-cws-stretch-pixel
ekp-cws-shrink-pixel)
'auto))))
(defun ekp--measure-boxes (boxes uniform-props)
"Measure pixel widths of BOXES, deduplicating identical boxes.
Identity = same characters AND same text properties. When
UNIFORM-PROPS is non-nil (the whole paragraph carries at most one
property run), plain string equality suffices as the key. For CJK
text where each character is a box, deduplication dramatically
reduces the number of `string-pixel-width' calls."
(let* ((n (length boxes))
(seen (make-hash-table :test 'equal :size n))
(widths (make-vector n 0)))
(dotimes (i n)
(let* ((box (aref boxes i))
(key (if uniform-props box
(cons box (object-intervals box))))
(w (gethash key seen)))
(unless w
(setq w (string-pixel-width box))
(puthash key w seen))
(aset widths i w)))
widths))
(defun ekp--hyphen-width-for (string)
"Pixel width of the hyphen char, styled like STRING's first char."
(let ((props (and (> (length string) 0) (text-properties-at 0 string))))
(string-pixel-width (if props (apply #'propertize "-" props) "-"))))
(defun ekp--space-box-type-p (box-type)
"Return non-nil if BOX-TYPE describes a whitespace box."
(and box-type (eq (car box-type) 'space)))
(defun ekp--make-para (string)
"Create and fully initialize `ekp-para' struct for STRING.
Computes ALL data in one pass: text, params, and prefix arrays."
;; Ensure params: explicit params persist; otherwise derive defaults
;; from this string's font.
(unless (and ekp--params-explicit (ekp--params-set-p))
(ekp-param-set-default string))
;; 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 (ekp--measure-boxes
boxes (null (cdr (object-intervals string)))))
(boxes-types (vconcat (mapcar #'ekp--box-type boxes)))
(glues-types (ekp--compute-glue-types
boxes boxes-types hyphen-positions))
(hyphen-pixel (ekp--hyphen-width-for string))
;; Prefix arrays
(ideal-prefixs (make-vector (1+ n) 0))
(min-prefixs (make-vector (1+ n) 0))
(max-prefixs (make-vector (1+ n) 0))
(glue-ideals (make-vector n 0))
(glue-shrinks (make-vector n 0))
(glue-stretches (make-vector n 0))
(lws-prefixs (make-vector (1+ n) 0))
(mws-prefixs (make-vector (1+ n) 0))
(cws-prefixs (make-vector (1+ n) 0))
(lead-spaces (make-vector (1+ n) 0))
(trail-spaces (make-vector (1+ n) 0)))
;; Single loop for all prefix computations
(dotimes (i n)
(let* ((box-w (aref boxes-widths i))
(glue-type (aref glues-types i))
(g-ideal (ekp-glue-ideal-pixel glue-type))
(g-min (ekp-glue-min-pixel glue-type))
(g-max (ekp-glue-max-pixel glue-type)))
(aset glue-ideals i g-ideal)
(aset glue-shrinks i (- g-ideal g-min))
(aset glue-stretches i (- g-max g-ideal))
(aset ideal-prefixs (1+ i) (+ (aref ideal-prefixs i) box-w g-ideal))
(aset min-prefixs (1+ i) (+ (aref min-prefixs i) box-w g-min))
(aset max-prefixs (1+ i) (+ (aref max-prefixs i) box-w g-max))
(aset lws-prefixs (1+ i) (+ (aref lws-prefixs i)
(if (eq glue-type 'lws) 1 0)))
(aset mws-prefixs (1+ i) (+ (aref mws-prefixs i)
(if (eq glue-type 'mws) 1 0)))
(aset cws-prefixs (1+ i) (+ (aref cws-prefixs i)
(if (eq glue-type 'cws) 1 0)))
;; trail-spaces[k]: width of space-box run ending at k-1
(aset trail-spaces (1+ i)
(if (ekp--space-box-type-p (aref boxes-types i))
(+ (aref trail-spaces i) box-w)
0))))
;; lead-spaces[i]: width of space-box run starting at i (backwards pass).
;; Index 0 forced to 0: first-line leading spaces are indentation.
(let ((i (1- n)))
(while (>= i 0)
(aset lead-spaces i
(if (ekp--space-box-type-p (aref boxes-types i))
(+ (aref boxes-widths i) (aref lead-spaces (1+ i)))
0))
(setq i (1- i))))
(aset lead-spaces 0 0)
(ekp-para--create
:string string
:latin-font latin-font
:cjk-font cjk-font
:boxes boxes
:boxes-widths boxes-widths
:boxes-types boxes-types
:glues-types glues-types
:hyphen-pixel hyphen-pixel
:hyphen-positions hyphen-positions
:ideal-prefixs ideal-prefixs
:min-prefixs min-prefixs
:max-prefixs max-prefixs
:glue-ideals glue-ideals
:glue-shrinks glue-shrinks
:glue-stretches glue-stretches
:lws-prefixs lws-prefixs
:mws-prefixs mws-prefixs
:cws-prefixs cws-prefixs
:lead-spaces lead-spaces
:trail-spaces trail-spaces
:glue-params (list :lws-ideal ekp-lws-ideal-pixel
:lws-stretch ekp-lws-stretch-pixel
:lws-shrink ekp-lws-shrink-pixel
:mws-ideal ekp-mws-ideal-pixel
:mws-stretch ekp-mws-stretch-pixel
:mws-shrink ekp-mws-shrink-pixel
:cws-ideal ekp-cws-ideal-pixel
:cws-stretch ekp-cws-stretch-pixel
:cws-shrink ekp-cws-shrink-pixel)
: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."
(if (and ekp--last-para
(eq (car ekp--last-para) string)
(equal (nth 1 ekp--last-para) ekp-latin-lang))
(nth 2 ekp--last-para)
(unless ekp--para-cache
(setq ekp--para-cache (make-hash-table :test 'equal :size 100)))
(let* ((key (ekp--para-key string))
(para (or (gethash key ekp--para-cache)
(progn
(when (>= (hash-table-count ekp--para-cache)
ekp-para-cache-limit)
(clrhash ekp--para-cache))
;; NB: in auto-params mode `ekp--make-para' updates
;; the spacing variables, which invalidates
;; `ekp--last-para'; set the fast path afterwards.
(let ((p (ekp--make-para string)))
(puthash key p ekp--para-cache)
p)))))
(setq ekp--last-para (list string ekp-latin-lang para))
para)))
(defun ekp-clear-caches ()
"Clear all paragraph caches."
(interactive)
(setq ekp--para-cache nil)
(setq ekp--last-para 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-positions (string)
(ekp-para-hyphen-positions (ekp--get-para string)))
;;;; K-P Badness and Demerits
;; demerits = (linepenalty + badness)² + penalty² + extras
;;
;; 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) ekp--infinite-badness)
(t (let ((ratio (/ (float adjustment-pixel) flexibility-pixel)))
(min ekp--infinite-badness (* 100 (expt (abs ratio) 3)))))))
(defun ekp--compute-fitness-class (adjustment-pixel flexibility-pixel)
"Classify line tightness into fitness class (0-3).
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 (* ekp-consecutive-hyphen-penalty
hyphen-count hyphen-count))
with-fitness)))
with-hyphen))
(defun ekp--sorted-vector-member-p (vec n)
"Return non-nil if N exists in sorted vector VEC.
Uses binary search for O(log n) lookup."
(and vec
(> (length vec) 0)
(let ((lo 0)
(hi (1- (length vec))))
(while (< lo hi)
(let ((mid (/ (+ lo hi) 2)))
(if (< (aref vec mid) n)
(setq lo (1+ mid))
(setq hi mid))))
(= (aref vec lo) n))))
(defalias 'ekp--hyphenate-p #'ekp--sorted-vector-member-p
"Return non-nil if position N in HYPHEN-POSITIONS ends with hyphenation.")
;;;; Shared Line Measurement (O(1) via prefix arrays)
(defun ekp--gaps-between (para i k)
"Return (latin-gaps mix-gaps cjk-gaps) inside line I..K (exclusive glues).
Counts glue indices I+1 .. K-1 using precomputed prefix counts."
(let ((lp (ekp-para-lws-prefixs para))
(mp (ekp-para-mws-prefixs para))
(cp (ekp-para-cws-prefixs para))
(j (1+ i)))
(list (- (aref lp k) (aref lp j))
(- (aref mp k) (aref mp j))
(- (aref cp k) (aref cp j)))))
(defun ekp--line-ideal-pixel (para i k)
"Ideal width of line I..K: box+glue ideals, minus leading glue and
stripped space-box runs, plus hyphen width when the line hyphenates."
(let* ((ip (ekp-para-ideal-prefixs para))
(raw (- (aref ip k) (aref ip i)
(aref (ekp-para-glue-ideals para) i)))
(space-w (min raw (+ (aref (ekp-para-lead-spaces para) i)
(aref (ekp-para-trail-spaces para) k))))
(ideal (- raw space-w)))
(if (ekp--hyphenate-p (ekp-para-hyphen-positions para) (1- k))
(+ ideal (ekp-para-hyphen-pixel para))
ideal)))
;;;; Dynamic Programming Line Breaking
;;
;; Design notes:
;; - All line metrics are O(1) via prefix arrays.
;; - Two-pass strategy: a strict Knuth-Plass pass runs first. If the
;; paragraph end is unreachable (some region admits no valid line,
;; e.g. an unbreakable box wider than the line, or a rigid run that
;; cannot stretch), a second pass permits "emergency" single-box
;; breaks with huge demerits, guaranteeing that every input yields
;; output. The C engine implements the identical strategy.
;; - Emergency demerits = (line-penalty + 10000)² + rest², i.e. at
;; least as bad as the worst regular line.
(defun ekp--dp-cache-elisp (para line-pixel)
"Pure Elisp DP implementation. Returns and caches the dp-result plist."
(if (/= ekp-looseness 0)
(ekp--dp-cache-elisp-loose para line-pixel)
(let ((dp-result (or (ekp--dp-run-1d para line-pixel nil)
(ekp--dp-run-1d para line-pixel t))))
(puthash line-pixel dp-result (ekp-para-dp-cache para))
dp-result)))
(defun ekp--hyphen-flags (hyphen-positions n)
"Return a bool-vector of length N flagging hyphenatable box indices."
(let ((v (make-bool-vector (max n 1) nil)))
(dotimes (j (length hyphen-positions))
(aset v (aref hyphen-positions j) t))
v))
(defun ekp--dp-run-1d (para line-pixel allow-emergency)
"One strict (or emergency-permitting) K-P DP pass over PARA.
Returns the dp-result plist, or nil when the paragraph end is
unreachable (only possible when ALLOW-EMERGENCY is nil)."
(let* ((boxes (ekp-para-boxes para))
(n (length boxes))
(hyphen-pixel (ekp-para-hyphen-pixel para))
(hyph-flags (ekp--hyphen-flags
(ekp-para-hyphen-positions para) n))
(ideal-prefixs (ekp-para-ideal-prefixs para))
(min-prefixs (ekp-para-min-prefixs para))
(max-prefixs (ekp-para-max-prefixs para))
(glue-ideals (ekp-para-glue-ideals para))
(glue-shrinks (ekp-para-glue-shrinks para))
(glue-stretches (ekp-para-glue-stretches para))
(lws-prefixs (ekp-para-lws-prefixs para))
(mws-prefixs (ekp-para-mws-prefixs para))
(cws-prefixs (ekp-para-cws-prefixs para))
(lead-spaces (ekp-para-lead-spaces para))
(trail-spaces (ekp-para-trail-spaces para))
(params (ekp-para-glue-params para))
(lws-stretch (plist-get params :lws-stretch))
(mws-stretch (plist-get params :mws-stretch))
(cws-stretch (plist-get params :cws-stretch))
(lws-shrink (plist-get params :lws-shrink))
(mws-shrink (plist-get params :mws-shrink))
(cws-shrink (plist-get params :cws-shrink))
(backptrs (make-vector (1+ n) nil))
(demerits (make-vector (1+ n) nil))
(rests (make-vector (1+ n) nil))
(gaps (make-vector (1+ n) nil))
(hyphen-counts (make-vector (1+ n) 0))
(fitness-classes (make-vector (1+ n) 1)))
(aset demerits 0 0.0)
(dotimes (i n)
(when (aref demerits i)
(let* ((prev-dem (aref demerits i))
(prev-hyphen-count (aref hyphen-counts i))
(prev-fitness (aref fitness-classes i))
(ip-i (aref ideal-prefixs i))
(mn-i (aref min-prefixs i))
(mx-i (aref max-prefixs i))
(lead-glue-ideal (aref glue-ideals i))
(lead-glue-min (- lead-glue-ideal (aref glue-shrinks i)))
(lead-glue-max (+ lead-glue-ideal (aref glue-stretches i)))
(lead-space (aref lead-spaces i))
(k (1+ i)))
(catch 'break
(while (<= k n)
(let* ((is-last (= k n))
(single-box (= k (1+ i)))
(end-with-hyphenp (aref hyph-flags (1- k)))
(hyph-w (if end-with-hyphenp hyphen-pixel 0))
(raw-ideal (- (aref ideal-prefixs k) ip-i lead-glue-ideal))
(space-w (min raw-ideal
(+ lead-space (aref trail-spaces k))))
(ideal (+ (- raw-ideal space-w) hyph-w))
(minw (+ (- (aref min-prefixs k) mn-i lead-glue-min
space-w)
hyph-w))
(maxw (+ (- (aref max-prefixs k) mx-i lead-glue-max
space-w)
hyph-w)))
(cond
;; Line already too long: emergency-record single box,
;; then stop extending.
((or (> minw line-pixel)
(and is-last (> ideal line-pixel)))
(when (and single-box allow-emergency)
(ekp--dp-relax-emergency
demerits backptrs rests gaps hyphen-counts
fitness-classes i k prev-dem
(- line-pixel ideal) end-with-hyphenp
prev-hyphen-count))
(throw 'break nil))
;; Valid break point
((or (<= minw line-pixel maxw)
(and is-last (<= ideal line-pixel)))
(let* ((adjustment (- line-pixel ideal))
dem line-gaps fitness new-hyphen)
(cond
;; Single box line: fixed flexibility of 1
(single-box
(let* ((badness (ekp--compute-badness adjustment 1))
(penalty (if end-with-hyphenp
ekp-hyphen-penalty 0)))
(setq fitness 1
new-hyphen (if end-with-hyphenp
(1+ prev-hyphen-count) 0)
line-gaps nil
dem (ekp--compute-demerits
badness penalty prev-fitness fitness
end-with-hyphenp prev-hyphen-count))))
;; Last line: minimal demerits if reasonably filled
(is-last
(let* ((fill-ratio (/ (float ideal) line-pixel))
(badness (if (< fill-ratio
ekp-last-line-min-ratio)
(* ekp-last-line-short-penalty
(- 1.0 fill-ratio))
0)))
(setq fitness 1 new-hyphen 0 line-gaps nil
dem (expt (+ ekp-line-penalty badness) 2))))
;; Normal justified line
(t
(let* ((j (1+ i))
(lcnt (- (aref lws-prefixs k)
(aref lws-prefixs j)))
(mcnt (- (aref mws-prefixs k)
(aref mws-prefixs j)))
(ccnt (- (aref cws-prefixs k)
(aref cws-prefixs j)))
(flexibility
(if (> adjustment 0)
(+ (* lcnt lws-stretch)
(* mcnt mws-stretch)
(* ccnt cws-stretch))
(+ (* lcnt lws-shrink)
(* mcnt mws-shrink)
(* ccnt cws-shrink))))
(badness (ekp--compute-badness
adjustment flexibility))
(penalty (if end-with-hyphenp
ekp-hyphen-penalty 0)))
(setq fitness (ekp--compute-fitness-class
adjustment flexibility)
new-hyphen (if end-with-hyphenp
(1+ prev-hyphen-count) 0)
line-gaps (list lcnt mcnt ccnt)
dem (ekp--compute-demerits
badness penalty prev-fitness fitness
end-with-hyphenp prev-hyphen-count)))))
(let ((total (+ prev-dem dem)))
(when (or (null (aref demerits k))
(< total (aref demerits k)))
(aset demerits k total)
(aset backptrs k i)
(aset rests k adjustment)
(aset gaps k line-gaps)
(aset fitness-classes k fitness)
(aset hyphen-counts k new-hyphen)))))
;; Invalid single box (rigid underfull): emergency
;; record so the DP cannot dead-end (2nd pass only).
((and single-box allow-emergency)
(ekp--dp-relax-emergency
demerits backptrs rests gaps hyphen-counts
fitness-classes i k prev-dem
(- line-pixel ideal) end-with-hyphenp
prev-hyphen-count)))
(setq k (1+ k))))))))
;; Extract solution (nil when end unreachable in the strict pass)
(when (aref demerits n)
(let ((breaks (ekp--dp-trace-breaks backptrs n)))
(list :rests (mapcar (lambda (b) (aref rests b)) breaks)
:gaps (mapcar (lambda (b) (aref gaps b)) breaks)
:breaks breaks
:cost (aref demerits n)
:line-count (length breaks))))))
(defun ekp--dp-relax-emergency (demerits backptrs rests gaps hyphen-counts
fitness-classes i k prev-dem rest
end-with-hyphenp prev-hyphen-count)
"Record an emergency (over/underfull single-box) break at K from I.
REST is line-pixel minus the line's ideal width (may be negative).
Only replaces an existing entry when strictly better."
(let ((total (+ prev-dem
(expt (+ ekp-line-penalty ekp--infinite-badness) 2)
(* (float rest) rest))))
(when (or (null (aref demerits k))
(< total (aref demerits k)))
(aset demerits k total)
(aset backptrs k i)
(aset rests k rest)
(aset gaps k nil)
(aset fitness-classes k 3)
(aset hyphen-counts k
(if end-with-hyphenp (1+ prev-hyphen-count) 0)))))
(defun ekp--dp-trace-breaks (backptrs n)
"Trace optimal break points from BACKPTRS array."
(let ((breaks (list n))
(index n))
(while (> index 0)
(let ((prev (aref backptrs index)))
(if prev
(progn (when (> prev 0) (push prev breaks))
(setq index prev))
;; Defensive: should not happen (every position is reachable)
(setq index (1- index)))))
breaks))
;;;; Looseness: full (position × line-count) DP
;;
;; `ekp-looseness' asks for a paragraph with (optimal + looseness)
;; lines. The 1D DP only keeps the single best path per position, so
;; alternative line counts are lost. Here we keep the best path per
;; (position, line-count) state instead, then select the final state
;; whose line count is closest to the target.
(defun ekp--dp-cache-elisp-loose (para line-pixel)
"Elisp DP tracking all line counts, for `ekp-looseness' support.
Two passes like the 1D engine: strict first, then with emergency
breaks when no valid layout exists."
(let ((dp-result (or (ekp--dp-run-loose para line-pixel nil)
(ekp--dp-run-loose para line-pixel t))))
(puthash line-pixel dp-result (ekp-para-dp-cache para))
dp-result))
(defun ekp--dp-run-loose (para line-pixel allow-emergency)
"One (position × line-count) DP pass. Returns dp-result or nil."
(let* ((boxes (ekp-para-boxes para))
(n (length boxes))
(hyphen-pixel (ekp-para-hyphen-pixel para))
(hyphen-positions (ekp-para-hyphen-positions para))
(ideal-prefixs (ekp-para-ideal-prefixs para))
(min-prefixs (ekp-para-min-prefixs para))
(max-prefixs (ekp-para-max-prefixs para))
(glue-ideals (ekp-para-glue-ideals para))
(glue-shrinks (ekp-para-glue-shrinks para))
(glue-stretches (ekp-para-glue-stretches para))
(lead-spaces (ekp-para-lead-spaces para))
(trail-spaces (ekp-para-trail-spaces para))
(params (ekp-para-glue-params para))
(lws-stretch (plist-get params :lws-stretch))
(mws-stretch (plist-get params :mws-stretch))
(cws-stretch (plist-get params :cws-stretch))
(lws-shrink (plist-get params :lws-shrink))
(mws-shrink (plist-get params :mws-shrink))
(cws-shrink (plist-get params :cws-shrink))
;; state: (pos . lines) -> [dem backptr fitness hyph rest gaps]
(states (make-hash-table :test 'equal :size (* 4 (1+ n))))
(counts-at (make-vector (1+ n) nil)))
(puthash (cons 0 0) (vector 0.0 nil 1 0 nil nil) states)
(push 0 (aref counts-at 0))
(dotimes (i n)
(dolist (lc (aref counts-at i))
(let* ((st (gethash (cons i lc) states))
(prev-dem (aref st 0))
(prev-fitness (aref st 2))
(prev-hyphen-count (aref st 3))
(ip-i (aref ideal-prefixs i))
(mn-i (aref min-prefixs i))
(mx-i (aref max-prefixs i))
(lead-glue-ideal (aref glue-ideals i))
(lead-glue-min (- lead-glue-ideal (aref glue-shrinks i)))
(lead-glue-max (+ lead-glue-ideal (aref glue-stretches i)))
(lead-space (aref lead-spaces i))
(k (1+ i)))
(catch 'break
(while (<= k n)
(let* ((is-last (= k n))
(single-box (= k (1+ i)))
(end-with-hyphenp
(ekp--hyphenate-p hyphen-positions (1- k)))
(hyph-w (if end-with-hyphenp hyphen-pixel 0))
(raw-ideal (- (aref ideal-prefixs k) ip-i lead-glue-ideal))
(space-w (min raw-ideal
(+ lead-space (aref trail-spaces k))))
(ideal (+ (- raw-ideal space-w) hyph-w))
(minw (+ (- (aref min-prefixs k) mn-i lead-glue-min
space-w)
hyph-w))
(maxw (+ (- (aref max-prefixs k) mx-i lead-glue-max
space-w)
hyph-w))
(adjustment (- line-pixel ideal))
candidate)
(cond
((or (> minw line-pixel)
(and is-last (> ideal line-pixel)))
(when (and single-box allow-emergency)
(setq candidate
(list (+ (expt (+ ekp-line-penalty
ekp--infinite-badness) 2)
(* (float adjustment) adjustment))
adjustment nil 3
(if end-with-hyphenp
(1+ prev-hyphen-count) 0)))
(ekp--dp-loose-relax states counts-at k (1+ lc) i
prev-dem candidate))
(throw 'break nil))
((or (<= minw line-pixel maxw)
(and is-last (<= ideal line-pixel)))
(setq candidate
(cond
(single-box
(let* ((badness (ekp--compute-badness adjustment 1))
(penalty (if end-with-hyphenp
ekp-hyphen-penalty 0))
(nh (if end-with-hyphenp
(1+ prev-hyphen-count) 0)))
(list (ekp--compute-demerits
badness penalty prev-fitness 1
end-with-hyphenp prev-hyphen-count)
adjustment nil 1 nh)))
(is-last
(let* ((fill-ratio (/ (float ideal) line-pixel))
(badness (if (< fill-ratio
ekp-last-line-min-ratio)
(* ekp-last-line-short-penalty
(- 1.0 fill-ratio))
0)))
(list (expt (+ ekp-line-penalty badness) 2)
adjustment nil 1 0)))
(t
(let* ((line-gaps (ekp--gaps-between para i k))
(lcnt (nth 0 line-gaps))
(mcnt (nth 1 line-gaps))
(ccnt (nth 2 line-gaps))
(flexibility
(if (> adjustment 0)
(+ (* lcnt lws-stretch)
(* mcnt mws-stretch)
(* ccnt cws-stretch))
(+ (* lcnt lws-shrink)
(* mcnt mws-shrink)
(* ccnt cws-shrink))))
(badness (ekp--compute-badness
adjustment flexibility))
(fitness (ekp--compute-fitness-class
adjustment flexibility))
(penalty (if end-with-hyphenp
ekp-hyphen-penalty 0))
(nh (if end-with-hyphenp
(1+ prev-hyphen-count) 0)))
(list (ekp--compute-demerits
badness penalty prev-fitness fitness
end-with-hyphenp prev-hyphen-count)
adjustment line-gaps fitness nh)))))
(ekp--dp-loose-relax states counts-at k (1+ lc) i
prev-dem candidate))
((and single-box allow-emergency)
(setq candidate
(list (+ (expt (+ ekp-line-penalty
ekp--infinite-badness) 2)
(* (float adjustment) adjustment))
adjustment nil 3
(if end-with-hyphenp
(1+ prev-hyphen-count) 0)))
(ekp--dp-loose-relax states counts-at k (1+ lc) i
prev-dem candidate)))
(setq k (1+ k))))))))
;; Select final state: line count closest to (optimal + looseness).
;; nil when the end is unreachable (strict pass only).
(when-let* ((end-counts (aref counts-at n)))
(let ((optimal-count nil) (optimal-dem nil))
(dolist (c end-counts)
(let ((dem (aref (gethash (cons n c) states) 0)))
(when (or (null optimal-dem) (< dem optimal-dem))
(setq optimal-dem dem optimal-count c))))
(let* ((target (+ optimal-count ekp-looseness))
(best-count nil) (best-diff nil) (best-dem nil))
(dolist (c end-counts)
(let ((diff (abs (- c target)))
(dem (aref (gethash (cons n c) states) 0)))
(when (or (null best-count)
(< diff best-diff)
(and (= diff best-diff) (< dem best-dem)))
(setq best-count c best-diff diff best-dem dem))))
;; Trace back through states
(let ((breaks nil) (lines-rests nil) (lines-gaps nil)
(pos n) (lc best-count))
(while (> pos 0)
(let ((st (gethash (cons pos lc) states)))
(push pos breaks)
(push (aref st 4) lines-rests)
(push (aref st 5) lines-gaps)
(setq pos (or (aref st 1) 0)
lc (1- lc))))
(list :rests lines-rests
:gaps lines-gaps
:breaks breaks
:cost best-dem
:line-count (length breaks))))))))
(defun ekp--dp-loose-relax (states counts-at k lines i prev-dem candidate)
"Relax state (K . LINES) with CANDIDATE from position I.
CANDIDATE is (DEM-DELTA REST GAPS FITNESS HYPHEN-COUNT)."
(let* ((key (cons k lines))
(total (+ prev-dem (nth 0 candidate)))
(existing (gethash key states)))
(when (or (null existing) (< total (aref existing 0)))
(unless existing
(push lines (aref counts-at k)))
(puthash key (vector total i (nth 3 candidate) (nth 4 candidate)
(nth 1 candidate) (nth 2 candidate))
states))))
;;;; DP Dispatch and C Module Integration
(defun ekp--dp-get-cached (para line-pixel)
"Get cached DP result from PARA for LINE-PIXEL, or nil."
(gethash line-pixel (ekp-para-dp-cache para)))
(defun ekp--c-available-p ()
"Return non-nil when the C module can be used for DP."
(and ekp-use-c-module
(boundp 'ekp-c-module-loaded) ekp-c-module-loaded
(fboundp 'ekp-c-break-with-arrays)
;; looseness needs the (position × line-count) DP, Elisp only
(= ekp-looseness 0)))
(defun ekp--c-sync-params ()
"Push current K-P penalty settings to the C module."
(when (fboundp 'ekp-c-set-penalties)
(ekp-c-set-penalties ekp-line-penalty
ekp-hyphen-penalty
ekp-adjacent-fitness-penalty
(float ekp-last-line-min-ratio)
ekp-consecutive-hyphen-penalty
(float ekp-last-line-short-penalty))))
(defun ekp-dp-cache (string line-pixel)
"Compute optimal line breaks for STRING at LINE-PIXEL width.
Uses Knuth-Plass dynamic programming with demerits.
If `ekp-use-c-module' is non-nil and the C module is available (and
`ekp-looseness' is 0), the C module computes the DP."
(let* ((para (ekp--get-para string))
(cached (ekp--dp-get-cached para line-pixel)))
(cond
(cached cached)
((ekp--c-available-p)
(ekp--dp-cache-via-c para line-pixel))
(t (ekp--dp-cache-elisp para line-pixel)))))
(defun ekp--lines-data-from-breaks (para line-pixel breaks)
"Compute (RESTS . GAPS) lists for BREAKS, matching the DP's metrics."
(let ((start 0) rests gapss)
(dolist (end breaks)
(push (- line-pixel (ekp--line-ideal-pixel para start end)) rests)
(push (if (or (= end (1+ start))
(= end (length (ekp-para-boxes para))))
nil
(ekp--gaps-between para start end))
gapss)
(setq start end))
(cons (nreverse rests) (nreverse gapss))))
(defun ekp--store-c-result (para line-pixel breaks cost)
"Store a C-module result (BREAKS, COST) into PARA's dp-cache."
(let* ((data (ekp--lines-data-from-breaks para line-pixel breaks))
(dp-result (list :rests (car data)
:gaps (cdr data)
:breaks breaks
:cost cost
:line-count (length breaks))))
(puthash line-pixel dp-result (ekp-para-dp-cache para))
dp-result))
(defun ekp--prepare-para-for-c (para line-pixel)
"Prepare PARA data as an 11-element vector for the C batch API."
(vector (ekp-para-ideal-prefixs para)
(ekp-para-min-prefixs para)
(ekp-para-max-prefixs para)
(ekp-para-glue-ideals para)
(ekp-para-glue-shrinks para)
(ekp-para-glue-stretches para)
(ekp-para-hyphen-positions para)
(ekp-para-hyphen-pixel para)
line-pixel
(ekp-para-lead-spaces para)
(ekp-para-trail-spaces para)))
(defun ekp--dp-cache-via-c (para line-pixel)
"Compute breaks using the C module with PARA's precomputed arrays.
The C module receives all font-dependent data from Elisp; it only
runs the pure DP. Falls back to Elisp when the C call fails."
(ekp--c-sync-params)
(let* ((result (ekp-c-break-with-arrays
(ekp-para-ideal-prefixs para)
(ekp-para-min-prefixs para)
(ekp-para-max-prefixs para)
(ekp-para-glue-ideals para)
(ekp-para-glue-shrinks para)
(ekp-para-glue-stretches para)
(ekp-para-hyphen-positions para)
(ekp-para-hyphen-pixel para)
line-pixel
(ekp-para-lead-spaces para)
(ekp-para-trail-spaces para)))
(c-breaks (car result))
(c-cost (cdr result)))
(if (null c-breaks)
(ekp--dp-cache-elisp para line-pixel)
(ekp--store-c-result para line-pixel c-breaks c-cost))))
(defun ekp--dp-cache-batch (strings line-pixel)
"Compute DP for multiple STRINGS in parallel using the C batch API.
Returns list of dp-results in the same order as STRINGS.
Only computes strings that aren't already cached."
(let* ((paras (mapcar #'ekp--get-para strings))
(needs-compute '()) ; list of (index . para)
(results (make-vector (length strings) nil)))
(cl-loop for para in paras
for i from 0
for cached = (ekp--dp-get-cached para line-pixel)
do (if cached
(aset results i cached)
(push (cons i para) needs-compute)))
(if (null needs-compute)
(append results nil)
(ekp--c-sync-params)
(let* ((needs-compute (nreverse needs-compute))
(batch-input (vconcat
(mapcar (lambda (ip)
(ekp--prepare-para-for-c (cdr ip) line-pixel))
needs-compute)))
(batch-results (ekp-c-break-batch batch-input)))
(cl-loop for ip in needs-compute
for j from 0
for idx = (car ip)
for para = (cdr ip)
for res = (aref batch-results j)
for breaks = (car res)
for cost = (cdr res)
do (aset results idx
(if breaks
(ekp--store-c-result para line-pixel breaks cost)
;; C failed, fallback to Elisp
(ekp--dp-cache-elisp para line-pixel)))))
(append results nil))))
(defun ekp-dp-data (string line-pixel &optional key)
"Return the dp cache plist for STRING at LINE-PIXEL.
If KEY is non-nil, return the value of KEY in the plist."
(let ((data (ekp-dp-cache string line-pixel)))
(if key
(plist-get data key)
data)))
(defun ekp-total-cost (string line-pixel)
"Return the total demerits of the K-P solution."
(ekp-dp-data string line-pixel :cost))
(defun ekp-line-breaks (string line-pixel)
"Return the break points of the K-P solution."
(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 (para rest-pixel gaps-list stretch-p)
"Distribute REST-PIXEL across GAPS-LIST using PARA's stored glue params.
STRETCH-P indicates stretch (t) or shrink (nil) mode.
Returns ((latin-adj . latin-extra) (mix-adj . mix-extra) (cjk-adj . cjk-extra))."
(let* ((params (ekp-para-glue-params para))
(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 from para's stored params
(latin-change (if stretch-p
(plist-get params :lws-stretch)
(plist-get params :lws-shrink)))
(mix-change (if stretch-p
(plist-get params :mws-stretch)
(plist-get params :mws-shrink)))
(cjk-change (if stretch-p
(plist-get params :cws-stretch)
(plist-get params :cws-shrink)))
;; 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 stretching, CJK gaps absorb any
;; leftover beyond their nominal capacity (emergency spreading);
;; when shrinking they never shrink below their limit.
(when (> remaining 0)
(if stretch-p
(when (> cjk-gaps 0)
(setq cjk-adj (/ remaining cjk-gaps))
(setq cjk-extra (% remaining cjk-gaps)))
(let ((cjk-capacity (* cjk-gaps cjk-change)))
(if (< remaining cjk-capacity)
(when (> cjk-gaps 0)
(setq cjk-adj (/ remaining cjk-gaps))
(setq cjk-extra (% remaining cjk-gaps)))
(setq cjk-adj cjk-change)))))
(list (cons latin-adj latin-extra)
(cons mix-adj mix-extra)
(cons cjk-adj cjk-extra))))
(defun ekp--compute-glue-pixels (para glues-types gaps-distribution stretch-p)
"Compute actual glue pixels from GLUES-TYPES and GAPS-DISTRIBUTION.
Returns list of pixel values for each glue. Uses PARA's stored glue params."
(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--para-glue-ideal para 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)))
(_ 0))))
(max 0 (if stretch-p (+ base adj) (- base adj)))))
glues-types)))
(defun ekp--line-glue-single-box (line-pixel box-width hyphen-p hyphen-pixel)
"Compute glues for a single-box line.
The trailing filler is clamped at 0 for overfull boxes."
(let ((trailing (- line-pixel box-width (if hyphen-p hyphen-pixel 0))))
(list 0 (max 0 trailing))))
(defun ekp--line-glue-last-line (para glues-types ideal-pixel line-pixel)
"Compute glues for last line (ragged right). Uses PARA's stored glue params."
(append '(0)
(mapcar (lambda (type) (ekp--para-glue-ideal para type)) glues-types)
(list (max 0 (- line-pixel ideal-pixel)))))
(defun ekp--line-glue-normal (para glues-types rest-pixel gaps-list)
"Compute glues for a normal (justified) line. Uses PARA's stored glue params."
(if (= rest-pixel 0)
(append '(0) (mapcar (lambda (type) (ekp--para-glue-ideal para type))
glues-types)
'(0))
(let* ((stretch-p (> rest-pixel 0))
(distribution (ekp--distribute-gap-adjustment
para (abs rest-pixel) gaps-list stretch-p))
(glue-pixels (ekp--compute-glue-pixels
para glues-types distribution stretch-p)))
(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* ((para (ekp--get-para string))
(boxes-num (length (ekp-para-boxes para)))
(glues-types (ekp-para-glues-types para))
(hyphen-positions (ekp-para-hyphen-positions para))
(breaks (ekp-line-breaks string line-pixel))
(lines-rests (ekp-dp-data string line-pixel :rests))
(lines-gaps (ekp-dp-data string line-pixel :gaps))
(hyphen-pixel (ekp-para-hyphen-pixel para))
(line-glues (make-vector (length breaks) nil))
(start 0))
(dotimes (i (length breaks))
(let* ((end (nth i breaks))
(line-glues-types (append (cl-subseq glues-types (1+ start) end)
nil))
(is-last (>= end boxes-num))
(hyphen-p (ekp--hyphenate-p hyphen-positions (1- end)))
;; DP-consistent metrics (space-box runs excluded, hyphen incl.)
(ideal-pixel (ekp--line-ideal-pixel para start end))
(max-pixel (let* ((mx (ekp-para-max-prefixs para))
(ip (ekp-para-ideal-prefixs para))
(raw-ideal (- (aref ip end) (aref ip start)
(aref (ekp-para-glue-ideals para)
start)))
(space-w (min raw-ideal
(+ (aref (ekp-para-lead-spaces para)
start)
(aref (ekp-para-trail-spaces para)
end)))))
(+ (- (aref mx end) (aref mx start)
(+ (aref (ekp-para-glue-ideals para) start)
(aref (ekp-para-glue-stretches para) start))
space-w)
(if hyphen-p hyphen-pixel 0))))
glue-list)
(setq glue-list
(cond
;; Single box: just trailing space
((= 1 (- end start))
(ekp--line-glue-single-box line-pixel
(- ideal-pixel
(if hyphen-p hyphen-pixel 0))
hyphen-p hyphen-pixel))
;; Last line: ragged right
(is-last
(ekp--line-glue-last-line
para line-glues-types ideal-pixel line-pixel))
;; Emergency underfull line (can't stretch to width):
;; set glues to max and pad with trailing filler.
((< max-pixel line-pixel)
(append '(0)
(mapcar (lambda (type)
(ekp--para-glue-max para type))
line-glues-types)
(list (max 0 (- line-pixel max-pixel)))))
;; Normal justified line
(t
(ekp--line-glue-normal para line-glues-types
(nth i lines-rests)
(nth i lines-gaps)))))
(aset line-glues i (vconcat glue-list))
(setq start end)))
line-glues))
;;;; Rendering
(defun ekp--box-space-p (box)
"Return non-nil if BOX is a whitespace-only box."
(and box (not (string-empty-p box))
(or (string-blank-p box) (= (string-width box) 0))))
(defun ekp--strip-line-spaces (line-boxes line-glues
&optional strip-leading strip-trailing)
"Strip leading/trailing space boxes from LINE-BOXES based on flags.
STRIP-LEADING / STRIP-TRAILING: strip space boxes at that edge.
LINE-GLUES is treated as an opaque list of n+1 glue values kept in
sync with the boxes. Returns (kept-boxes kept-glues nlead ntrail)
where NLEAD / NTRAIL count the boxes stripped at each edge.
The stripped widths are NOT redistributed: the DP already excluded
these space-box runs from its line metrics, so the remaining boxes
plus distributed glues already fill the target width exactly."
(let ((boxes (append line-boxes nil))
(glues (append line-glues nil))
(nlead 0) (ntrail 0))
(when (> (length boxes) 0)
;; Strip trailing space boxes (if requested)
(when strip-trailing
(while (and boxes (ekp--box-space-p (car (last boxes))))
(setq ntrail (1+ ntrail))
(setq boxes (butlast boxes))
;; Remove second-to-last glue (the one before the trailing
;; space box); keep the last glue (line's trailing filler).
(when (> (length glues) 1)
(setq glues (append (butlast (butlast glues)) (last glues))))))
;; Strip leading space boxes (if requested)
(when strip-leading
(while (and boxes (ekp--box-space-p (car boxes)))
(setq nlead (1+ nlead))
(setq boxes (cdr boxes))
;; Remove the second glue (the one after the leading glue)
(when (> (length glues) 1)
(setq glues (cons (car glues) (cddr glues)))))))
(list boxes glues nlead ntrail)))
(defun ekp--box-offsets (string boxes)
"Locate each of BOXES in STRING; return a vector of (START . END).
Boxes are in order and separated only by characters the tokenizer
dropped (whitespace runs, zero-width breakers), so a sequential
leftmost scan aligns them unambiguously."
(let ((offsets (make-vector (length boxes) nil))
(p 0) (i 0))
(dolist (box boxes)
(let ((blen (length box)))
(while (not (eq t (compare-strings string p (+ p blen) box 0 blen)))
(setq p (1+ p)))
(aset offsets i (cons p (+ p blen)))
(setq p (+ p blen))
(setq i (1+ i))))
offsets))
(defun ekp--hide-string (string)
"Return STRING marked `ekp-hidden' and displayed as nothing."
(if (string-empty-p string)
string
(propertize string 'ekp-hidden t 'display "")))
(defun ekp--render-glue (pixel payload)
"Render a glue of PIXEL width that replaced original text PAYLOAD.
Zero-width glue renders as the hidden PAYLOAD itself, so no original
character is ever dropped."
(cond
((> pixel 0)
(propertize " " 'display `(space :width (,pixel)) 'ekp-glue payload))
(t (ekp--hide-string payload))))
(defun ekp--hyphen-for-box (box)
"Return a hyphen string styled like the end of BOX.
The `ekp-soft-hyphen' property marks it as synthesized, so
`ekp-unjustify-region' can strip it structurally."
(let ((props (and (> (length box) 0)
(text-properties-at (1- (length box)) box))))
(apply #'propertize "-" 'ekp-soft-hyphen t props)))
(defun ekp--pixel-justify (string line-pixel)
"Justify single-paragraph STRING to LINE-PIXEL.
The output is lossless with respect to STRING:
- synthesized spacing carries an `ekp-glue' property whose value is
the original text it replaced (usually a whitespace run),
- soft line breaks are newlines whose `ekp-soft-break' property holds
the original text swallowed around the break,
- original text outside any visible line (paragraph-edge whitespace)
survives as zero-display `ekp-hidden' text,
- break hyphens carry `ekp-soft-hyphen'.
`ekp-unjustify-region' inverts all four structurally."
(let* ((boxes (append (ekp--boxes string) nil))
(offsets (ekp--box-offsets string boxes))
(breaks (ekp-line-breaks string line-pixel))
(num (length breaks))
(lines-glues (ekp-line-glues string line-pixel))
(hyphen-positions (ekp--hyphen-positions string))
(start 0)
;; (rendered-text first-box-idx last-box-idx) per visible line
(lines nil))
(dotimes (i num)
(let* ((end (nth i breaks))
(line-boxes (cl-subseq boxes start end))
(glue-pixels (append (aref lines-glues i) nil))
;; Strip space boxes:
;; - First line (i=0): keep leading spaces (indentation)
;; - Other lines: strip leading spaces (break artifacts)
;; - All lines: strip trailing spaces
(is-first-line (= i 0))
(stripped (ekp--strip-line-spaces line-boxes glue-pixels
(not is-first-line)
t))
(kept (nth 0 stripped))
(kept-glues (nth 1 stripped))
(first-idx (+ start (nth 2 stripped)))
;; Check if last box of this line needs hyphen
(need-hyphen
(and (< i (1- num)) ; not last line
(ekp--hyphenate-p hyphen-positions (1- end)))))
(when kept
(let ((parts nil) (idx first-idx) (glues kept-glues) (n 0))
(dolist (box kept)
(push (ekp--render-glue
(pop glues)
(if (> idx first-idx)
(substring string
(cdr (aref offsets (1- idx)))
(car (aref offsets idx)))
;; leading glue of a line is always 0px and
;; replaces nothing; edge text is handled by
;; soft breaks / hidden runs below
""))
parts)
(push box parts)
(setq idx (1+ idx) n (1+ n)))
(when need-hyphen
(push (ekp--hyphen-for-box (car (last kept))) parts))
;; trailing filler glue (synthesized, replaces nothing)
(push (ekp--render-glue (car glues) "") parts)
(push (list (apply #'concat (nreverse parts))
first-idx (+ first-idx n -1))
lines)))
(setq start end)))
(setq lines (nreverse lines))
(if (null lines)
;; Defensive: no visible box at all (blank paragraphs are
;; filtered before this function).
(ekp--hide-string string)
(let* ((first-line (car lines))
(last-line (car (last lines)))
(parts (list (ekp--hide-string
(substring string 0
(car (aref offsets (nth 1 first-line)))))))
(prev nil))
(dolist (line lines)
(when prev
(push (propertize "\n" 'ekp-soft-break
(substring string
(cdr (aref offsets (nth 2 prev)))
(car (aref offsets (nth 1 line)))))
parts))
(push (nth 0 line) parts)
(setq prev line))
(push (ekp--hide-string
(substring string (cdr (aref offsets (nth 2 last-line)))))
parts)
(apply #'concat (nreverse parts))))))
(defun ekp--validate-width (line-pixel)
"Signal a user error unless LINE-PIXEL is a positive integer."
(unless (and (integerp line-pixel) (> line-pixel 0))
(user-error "ekp: line width must be a positive integer, got %S"
line-pixel)))
(defun ekp-pixel-justify (string line-pixel)
"Justify multiline STRING to LINE-PIXEL pixels.
Each newline-separated segment is treated as one paragraph.
When the C module is available, paragraphs are computed in parallel."
(unless (stringp string)
(signal 'wrong-type-argument (list 'stringp string)))
(ekp--validate-width line-pixel)
(let* ((strs (split-string string "\n"))
(non-blank-strs (cl-remove-if #'string-blank-p strs))
(use-batch (and (ekp--c-available-p)
(fboundp 'ekp-c-break-batch)
(> (length non-blank-strs) 1))))
;; Pre-compute all DP results in parallel if using batch
(when use-batch
(ekp--dp-cache-batch non-blank-strs line-pixel))
;; Now process each string (DP results are cached)
(mapconcat (lambda (str)
(if (string-blank-p str)
""
(ekp--pixel-justify str line-pixel)))
strs "\n")))
;;; Optimal Width Search
;;
;; Ternary search over average demerits, refined with a local scan.
;; Note: cost as a function of width is not strictly unimodal (line
;; count changes cause jumps), so the result is a good local optimum;
;; the final neighborhood scan smooths out small non-unimodalities.
(defun ekp--compute-avg-cost (strings pixel)
"Compute average cost for STRINGS at PIXEL width."
;; Batch all paragraphs through the C module in one call if possible.
(when (and (ekp--c-available-p) (fboundp 'ekp-c-break-batch))
(let ((non-blank (cl-remove-if #'string-blank-p strings)))
(when (> (length non-blank) 1)
(ekp--dp-cache-batch non-blank pixel))))
(let ((total-cost 0)
(count 0))
(dolist (s strings)
(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))))
;; Local scan around the ternary result to escape small
;; non-unimodalities (cost jumps when the line count changes).
(let* ((center (/ (+ lo hi) 2))
(best-pixel nil)
(best-cost nil))
(cl-loop for p from (max min-pixel (- center 3))
to (min max-pixel (+ center 3))
for cost = (ekp--compute-avg-cost strings p)
when (or (null best-cost) (< cost best-cost))
do (setq best-cost cost best-pixel p))
best-pixel)))
(defun ekp-pixel-range-justify (string min-pixel max-pixel)
"Find optimal width for STRING between MIN-PIXEL and MAX-PIXEL.
Returns (justified-text . optimal-pixel)."
(unless (stringp string)
(signal 'wrong-type-argument (list 'stringp string)))
(ekp--validate-width min-pixel)
(ekp--validate-width max-pixel)
(when (> min-pixel max-pixel)
(user-error "ekp: min-pixel (%d) must be <= max-pixel (%d)"
min-pixel max-pixel))
(let* ((strings (split-string string "\n"))
;; Pre-warm caches
(_ (dolist (s strings)
(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