keep original text properties of string after typesetting

2025-08-22 00:06:14 +08:00 · 2025-08-22 00:06:14 +08:00 · 37baccded8
commit 37baccded8
parent 165be829df
7 changed files with 107 additions and 34 deletions
--- a/ekp-hyphen.el
+++ b/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)
-                                    (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 ""))))
+              (setq result (concat (substring result 0 index)
+                                   changestr
+                                   (substring result (+ index cut)))))
+          (setq result (concat (substring result 0 idx)
+                               hyphen
+                               (substring result idx))))))
+    result))

 (defun ekp-hyphen-boxes (ekp-hyphen word)
  (split-string (ekp-hyphen-inserted ekp-hyphen word " ") " "))
--- a/ekp-utils.el
+++ b/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) ?.)
-      (and (>= char #x3000) (<= char #x303F))
-      (and (>= char #xFF00) (<= char #xFF60))))
+  (let ((char (seq-first str)))
+    (or (equal (char-syntax char) ?.)
+        (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))
-               (str (char-to-string char)))
+        (let* ((str (buffer-substring (point) (1+ (point)))))
          (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)
--- a/ekp.el
+++ b/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)))
-           (boxes-lst
-            (seq-map (lambda (box)
-                       (propertize
-                        box 'face `(:family ,(ekp-latin-font string))))
-                     boxes-lst)))
+    (let ((boxes-lst (apply #'append (nreverse new-boxes))))
      (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)))
--- a/readme.md
+++ b/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...

--- a/readme_zh.md
+++ b/readme_zh.md
@ -46,7 +46,7 @@ Emacs-kp 实现了 knuth-plass 排版算法，但其功能不局限于英文排

 ## 下一步

- [ ] 重排之后，保留文本原本的样式。
+- [x] 重排之后，保留文本原本的样式。
 - [ ] 使用 rust 动态模块重写：利用 rust 并行计算提升渲染性能。
 - [ ] 实现排版自动修正功能：比如修正中文中使用的英文标点；英文中使用的中文标点等

--- a/tests/ekp-tests.el
+++ b/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 font)
+(defun ekp-test-str (cjk latin &optional font)
  (let ((file (concat "./text"
                      (and cjk (concat "-" cjk))
                      (and latin (concat "-" latin))
                      ".txt" )))
-    (propertize (file-content file)
-                'face `(:family ,font))))
+    (if 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)
--- a/tests/text-zh-en_US.txt
+++ b/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算法。）