keep original text properties of string after typesetting

ekp-hyphen.el

@@ -229,10 +229,31 @@ LEFT and RIGHT are minimum first/last syllable chars. CACHE t/nil."
                              (<= (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."
+  "Return WORD with all possible hyphens inserted, preserving
+text properties."
   (let ((hyphen (or hyphen "-"))
-        (letters (string-to-list word)))
+        (result word))
     (dolist (pos (reverse (ekp-hyphen-positions ekp-hyphen word)))
       (let ((idx (ekp-hyphen--datint-value pos)))
         (if (ekp-hyphen--datint-data pos)
@@ -241,13 +262,13 @@ LEFT and RIGHT are minimum first/last syllable chars. CACHE t/nil."
                    (index (+ (nth 1 data) idx))
                    (cut (nth 2 data))
                    (changestr (replace-regexp-in-string "=" hyphen change)))
-              (setq letters (append (cl-subseq letters 0 index)
+              (setq result (concat (substring result 0 index)
-                                    (string-to-list changestr)
+                                   changestr
-                                    (cl-subseq letters (+ index cut)))))
+                                   (substring result (+ index cut)))))
-          (setq letters (append (cl-subseq letters 0 idx)
+          (setq result (concat (substring result 0 idx)
-                                (string-to-list hyphen)
+                               hyphen
-                                (cl-subseq letters idx))))))
+                               (substring result idx))))))
-    (concat "" (mapconcat #'char-to-string letters ""))))
+    result))
 
 (defun ekp-hyphen-boxes (ekp-hyphen word)
   (split-string (ekp-hyphen-inserted ekp-hyphen word " ") " "))

ekp-utils.el

@@ -182,11 +182,12 @@ the value of [SYM]-default."
       ""
     (propertize " " 'display `(space :width (,pixel)))))
 
-(defun ekp-cjk-fw-punct-p (char)
+(defun ekp-cjk-fw-punct-p (str)
   "Return if CHAR is CJK full-width punctuation."
-  (or (equal (char-syntax char) ?.)
+  (let ((char (seq-first str)))
-      (and (>= char #x3000) (<= char #x303F))
+    (or (equal (char-syntax char) ?.)
-      (and (>= char #xFF00) (<= char #xFF60))))
+        (and (>= char #x3000) (<= char #x303F))
+        (and (>= char #xFF00) (<= char #xFF60)))))
 
 (defun ekp-split-to-boxes (string)
   (with-temp-buffer
@@ -195,8 +196,7 @@ the value of [SYM]-default."
     (let ((state (char-width (seq-first string)))
           curr-str prev-str boxes)
       (while (not (eobp))
-        (let* ((char (char-after))
+        (let* ((str (buffer-substring (point) (1+ (point)))))
-               (str (char-to-string char)))
           (if (or (string-blank-p str)
                   ;; 零宽 unicode
                   (= 0 (string-width str)))
@@ -216,7 +216,7 @@ the value of [SYM]-default."
                   (setq state 2)))
               (cond
                ((= 2 (string-width str))
-                (if (ekp-cjk-fw-punct-p char)
+                (if (ekp-cjk-fw-punct-p str)
                     ;; cjk punct 连在前一个字符后面
                     (progn
                       (push (concat prev-str str) boxes)

ekp.el

@@ -155,12 +155,7 @@
                 (cl-incf idx)))
           (push (list box) new-boxes)
           (cl-incf idx))))
-    (let* ((boxes-lst (apply #'append (nreverse new-boxes)))
+    (let ((boxes-lst (apply #'append (nreverse new-boxes))))
-           (boxes-lst
-            (seq-map (lambda (box)
-                       (propertize
-                        box 'face `(:family ,(ekp-latin-font string))))
-                     boxes-lst)))
       (cons (vconcat boxes-lst)
             (vconcat (nreverse idxs))))))
 
@@ -171,7 +166,7 @@
    ((or (string= "“" str) (string= "”" str)) 'cjk)
    ((= (string-width str) 1) 'latin)
    ((= (string-width str) 2)
-    (if (ekp-cjk-fw-punct-p (string-to-char str))
+    (if (ekp-cjk-fw-punct-p str)
         'cjk-punct
       'cjk))
    (t (error "Abnormal string width %s for %s"
@@ -290,8 +285,11 @@ return the value of KEY in plist."
   (ekp-text-data string :boxes))
 
 (defun ekp-hyphen-str (string)
-  (propertize
+  "-"
-   "-" 'face `(:family ,(ekp-text-data string :latin-font))))
+  ;; (propertize
+  ;;  "-"
+  ;;  'face `(:family ,(ekp-text-data string :latin-font)))
+  )
 
 (defun ekp-hyphen-pixel (string)
   (string-pixel-width (ekp-hyphen-str string)))

readme.md

@@ -56,7 +56,7 @@ Formats the text STRING to fit a pixel width of LINE-PIXEL per line and returns
 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.
 
 ## Next Todos
-- [ ] Preserve the original text's text properties.
+- [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...
 

readme_zh.md

@@ -46,7 +46,7 @@ Emacs-kp 实现了 knuth-plass 排版算法，但其功能不局限于英文排
 
 ## 下一步
 
-- [ ] 重排之后，保留文本原本的样式。
+- [x] 重排之后，保留文本原本的样式。
 - [ ] 使用 rust 动态模块重写：利用 rust 并行计算提升渲染性能。
 - [ ] 实现排版自动修正功能：比如修正中文中使用的英文标点；英文中使用的中文标点等
 

tests/ekp-tests.el

@@ -1,6 +1,32 @@
 ;; -*- lexical-binding: t; -*-
 
 ;;; utils
+(defun ekp-file-content (file)
+  (with-temp-buffer
+    (insert-file-contents file)
+    (buffer-substring (point-min) (point-max))))
+
+(defun ekp-propertize (string properties
+                              &optional start end)
+  "不会覆盖原有的属性，返回新的字符串。"
+  ;; 防止是 make-list 创建的元素，它们都属于同一个对象
+  ;; 最好先复制一份字符串
+  (let* ((string (copy-sequence string))
+         (start (or start 0))
+         (end (or end (length string))))
+    (while properties
+      (let ((prop (pop properties))
+            (value (pop properties)))
+        (pcase prop
+          ('face (add-face-text-property
+                  start end value t string))
+          ('display (add-display-text-property
+                     start end (car value) (cadr value)
+                     string))
+          (_ (put-text-property
+              start end prop value string)))))
+    string))
+
 (defun my-pop-to-buffer (buffer-or-name &optional action norecord)
   (declare (indent defun))
   (let ((buffer (pop-to-buffer buffer-or-name action norecord)))
@@ -41,26 +67,29 @@
     (car (ekp-pixel-range-justify
           (ekp-test-str cjk latin font) min max))))
 
-;; (ekp-test-justify "zh" "en_US" "Cascadia Next SC" 666)
 ;; (ekp-test-justify nil "en_US" "Cascadia Next SC" 699)
 ;; (ekp-test-justify nil "en_US" "Times New Roman" 699)
 ;; (ekp-test-justify nil "en_US" "Georgia" 699)
+;; (ekp-test-justify nil "en_US" "Noto Serif" 700)
 ;; (ekp-test-justify nil "en_US" "Garamond" 699)
+;; (ekp-test-justify "zh" "en_US" "Cascadia Next SC" 666)
 ;; (ekp-test-range-justify "zh" "en_US" "Cascadia Next SC" 666 690)
 ;; (ekp-test-justify nil "fr" "Cascadia Next SC" 666)
 ;; (ekp-test-justify nil "de_DE" "Cascadia Next SC" 666)
 ;; (ekp-test-justify "zh" "en_US" "Noto Serif" 689)
 ;; (ekp-test-justify "zh" nil nil 980)
+;; (ekp-clear-caches)
 
 ;;; FIXME: font size also affect!
-
+(defun ekp-test-str (cjk latin &optional font)
-(defun ekp-test-str (cjk latin font)
   (let ((file (concat "./text"
                       (and cjk (concat "-" cjk))
                       (and latin (concat "-" latin))
                       ".txt" )))
-    (propertize (file-content file)
+    (if font
-                'face `(:family ,font))))
+        (ekp-propertize (ekp-file-content file)
+                        `(face (:family ,font)))
+      (ekp-file-content file))))
 
 (defun ekp-test-demo (min-pixel max-pixel &optional inc)
   (let ((str (ekp-test-str "zh" "en_US" "Cascadia Next SC"))
@@ -78,3 +107,28 @@
           (sit-for 0.00001))))))
 
 ;; (ekp-test-demo 400 800 1)
+
+(defun ekp-test-keep-props ()
+  (let* ((str (ekp-test-str "zh" "en_US"))
+         (lst (split-string str "\n" t)))
+    (setq lst (list
+               (ekp-propertize
+                (ekp-propertize (nth 0 lst)
+                                '(face (:family "Comic Sans MS")))
+                '(face (:height 1.3 :foreground "Cyan"))
+                0 2)
+               (ekp-propertize
+                (ekp-propertize (nth 1 lst)
+                                '(face (:family "Cascadia Next SC")))
+                '(face (:height 1.3 :foreground "Cyan"))
+                0 2)
+               (ekp-propertize
+                (ekp-propertize (nth 2 lst)
+                                '(face (:family  "Source Han Sans SC")))
+                '(face (:height 1.3 :foreground "Cyan"))
+                0 2)))
+    (ekp-clear-caches)
+    (pop-buffer-insert 30
+      (ekp-pixel-justify (string-join lst "\n\n") 683))))
+
+;; (ekp-test-keep-props)

tests/text-zh-en_US.txt

@@ -1,5 +1,5 @@
-作为神之编辑器（Editor of the Gods），Emacs 早已超越了普通文本编辑器的范畴。它是由​​Richard Stallman​​于1976年创建的​​GNU项目​核心组件，其名字源自 Editor MACroS​​。在过去的半个世纪里，Emacs演化成了一个​​self-documenting, customizable, extensible​​的生态系统，用户可通过​​Emacs Lisp (elisp)​​ 重新定义编辑行为。M-x 是每个Emacer的魔法咒语——按下Alt（或Meta键）加x即可召唤任意命令，比如M-x butterfly这样的复活节彩蛋。中国开发者常戏称其为“​​永远的操作系统​​”，因为你可以通过org-mode管理TODO list、用magit操作Git仓库、甚至用EMMS播放MP3音乐。在Unix哲学中，Emacs坚持“一个编辑器统治所有​​”（One Editor to Rule Them All）的理念，这与VS Code等现代编辑器形成鲜明对比。C-x C-f打开文件，C-x C-s保存文档，看似复杂的组合键一旦形成​​肌肉记忆​​，效率就会呈指数级飙升。著名Python库Black的开发者曾公开表示："​​My .emacs is my second brain.​​"
+作为神之编辑器（Editor of the Gods）l，Emacs 早已超越了普通文本编辑器的范畴。它是由​​Richard Stallman​​于1976年创建的​​GNU项目​核心组件，其名字源自 Editor MACroS​​。在过去的半个世纪里，Emacs演化成了一个​​self-documenting, customizable, extensible​​的生态系统，用户可通过​​Emacs Lisp (elisp)​​ 重新定义编辑行为。M-x 是每个Emacer的魔法咒语——按下Alt（或Meta键）加x即可召唤任意命令，比如M-x butterfly这样的复活节彩蛋。中国开发者常戏称其为“​​永远的操作系统​​”，因为你可以通过org-mode管理TODO list、用magit操作Git仓库、甚至用EMMS播放MP3音乐。在Unix哲学中，Emacs坚持“一个编辑器统治所有​​”（One Editor to Rule Them All）的理念，这与VS Code等现代编辑器形成鲜明对比。C-x C-f打开文件，C-x C-s保存文档，看似复杂的组合键一旦形成​​肌肉记忆​​，效率就会呈指数级飙升。著名Python库Black的开发者曾公开表示："​​My .emacs is my second brain.​​"
 
 当然，​​学习曲线​​（Learning Curve）也是陡峭的。新用户需要理解buffer、window、frame的区别：当你C-x 2分割视窗时，两个窗口共享同一个frame；而C-x 5 2会创建新frame —— 这种设计对Retina显示屏尤其友好。中文用户还必须配置ivy或helm这类模糊搜索插件来优化中文输入，著名的.emacs.d配置仓库如 purcell/emacs.d 在GitHub上有超过​​11k stars​​。最令人震撼的是其​​实时文档系统​​：按下C-h k后点击任何按键组合，都会弹出对应函数的elisp文档。这种​​introspective capability​​让定制化没有边界。有程序员开玩笑说：“当你终于调通.emacs配置时，第一件事应该是用M-x doctor找心理医生。” 毕竟，谁没经历过因为(setq indent-tabs-mode nil)配置错误导致Python代码崩溃的深夜呢？
 
-Emacs哲学的精髓在于：​​不是工具适应人，而是人塑造工具​​（Not the tool adapts to human, but human forges the tool）。正如Stallman所言："​​Free as in freedom.​​" 当你用org-capture记录灵感时，用gnus收发邮件时，甚至用M-x tetris摸鱼时，都是在践行这种数字世界的自由意志。（注：This text intentionally contains mixed spacing/tab alignment for KP algorithm testing purposes. 本文故意包含混合空格/制表符对齐以测试KP算法。）
+对于Emacs，其哲学的精髓在于：​​不是工具适应人，而是人塑造工具​​（Not the tool adapts to human, but human forges the tool）。正如Stallman所言："​​Free as in freedom.​​" 当你用org-capture记录灵感时，用gnus收发邮件时，甚至用M-x tetris摸鱼时，都是在践行这种数字世界的自由意志。（注：This text intentionally contains mixed spacing/tab alignment for KP algorithm testing purposes. 本文故意包含混合空格/制表符对齐以测试KP算法。）