[elpa] externals/org 8739a95782 2/7: Let org-columns correctly detect string-widths in code

[ELPA Syncer]

branch: externals/org
commit 8739a957820c5c02cb8d713ac1f4d3be918ec02c
Author: Ruijie Yu <ruijie@netyu.xyz>
Commit: Ihor Radchenko <yantar92@posteo.net>

    Let org-columns correctly detect string-widths in code
    
    TODO: maybe I should also make a test directly on
    `org-columns-add-ellipses'.  Will do in next iteration unless
    objections.
    
    * lisp/org-colview.el (org-columns--truncate-below-width): add a
    helper function that will trim off just enough data from string to
    fit into expected width.
    (org-columns-add-ellipses): make sure to do truncation correctly
    even in CJK locales (where an ellipsis character takes two
    spaces).
    
    * testing/lisp/test-org-colview.el
    (test-org-colview/substring-below-width): add test to make sure
    helper function is correct.
    (test-org-colview/columns-width): fix incorrect expectations for
    CJK locales about ellipses.
---
 lisp/org-colview.el              | 26 +++++++++++++++++-----
 testing/lisp/test-org-colview.el | 47 +++++++++++++++++++++++++++-------------
 2 files changed, 53 insertions(+), 20 deletions(-)

diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 7aa5ef645c..8d8d8954d6 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -452,14 +452,30 @@ DATELINE is non-nil when the face used should be
            "Type \\<org-columns-map>`\\[org-columns-edit-value]' \
 to edit property")))))))
 
+(defun org-columns--truncate-below-width (string width)
+  "Return a substring of STRING no wider than WIDTH.
+This substring must start at 0, and must be the longest possible
+substring whose `string-width' does not exceed WIDTH."
+  (declare (side-effect-free t))
+  (let ((end (min width (length string))) res)
+    (while (and end (>= end 0))
+      (let* ((curr (string-width string 0 end))
+             (excess (- curr width)))
+        (if (> excess 0)
+            (cl-decf end (max 1 (/ excess 2)))
+          (setq res (substring string 0 end) end nil))))
+    res))
+
 (defun org-columns-add-ellipses (string width)
   "Truncate STRING with WIDTH characters, with ellipses."
   (cond
-   ((<= (length string) width) string)
-   ((<= width (length org-columns-ellipses))
-    (substring org-columns-ellipses 0 width))
-   (t (concat (substring string 0 (- width (length org-columns-ellipses)))
-             org-columns-ellipses))))
+   ((<= (string-width string) width) string)
+   ((<= width (string-width org-columns-ellipses))
+    (org-columns--truncate-below-width org-columns-ellipses width))
+   (t (concat
+       (org-columns--truncate-below-width
+        string (- width (string-width org-columns-ellipses)))
+       org-columns-ellipses))))
 
 (defvar org-columns-full-header-line-format nil
   "The full header line format, will be shifted by horizontal scrolling." )
diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el
index a80763622c..8b537e5b51 100644
--- a/testing/lisp/test-org-colview.el
+++ b/testing/lisp/test-org-colview.el
@@ -92,47 +92,64 @@
           (org-columns-compile-format
            "%ITEM{+;%.1f}"))))
 
+(ert-deftest test-org-colview/substring-below-width ()
+  "Test `org-columns--truncate-below-width'."
+  (cl-flet ((check (string width expect)
+              (string= expect (org-columns--truncate-below-width
+                               string width))))
+    (if (= (char-width ?…) 2)
+        (progn (should (check "12…" 3 "12"))
+               (should (check "1…2" 1 "1"))
+               (should (check "1…2" 2 "1"))
+               (should (check "1…2" 3 "1…"))
+               (should (check "……………………" 7 "………")))
+      (progn (should (check "12…" 4 "12…"))
+             (should (check "1…2" 1 "1"))
+             (should (check "1…2" 2 "1…"))
+             (should (check "1…2" 3 "1…2"))
+             (should (check "……………………" 7 "…………………"))))))
+
 (ert-deftest test-org-colview/get-format ()
   "Test `org-columns-get-format' specifications."
   ;; Without any clue, use `org-columns-default-format'.
   (should
    (equal "%A"
          (org-test-with-temp-text "* H"
-           (let ((org-columns-default-format "%A"))
-             (org-columns-get-format)))))
+                                  (let ((org-columns-default-format "%A"))
+                                    (org-columns-get-format)))))
   ;; If COLUMNS keyword is set, use it.
   (should
    (equal "%B"
          (org-test-with-temp-text "#+COLUMNS: %B\n* H"
-           (let ((org-columns-default-format "%A"))
-             (org-columns-get-format)))))
+                                  (let ((org-columns-default-format "%A"))
+                                    (org-columns-get-format)))))
   (should
    (equal "%B"
          (org-test-with-temp-text "#+columns: %B\n* H"
-           (let ((org-columns-default-format "%A"))
-             (org-columns-get-format)))))
+                                  (let ((org-columns-default-format "%A"))
+                                    (org-columns-get-format)))))
   (should
    (equal "%B"
          (org-test-with-temp-text "* H\n#+COLUMNS: %B"
-           (let ((org-columns-default-format "%A"))
-             (org-columns-get-format)))))
+                                  (let ((org-columns-default-format "%A"))
+                                    (org-columns-get-format)))))
   ;; When :COLUMNS: property is set somewhere in the tree, use it over
   ;; the previous ways.
   (should
    (equal
     "%C"
     (org-test-with-temp-text
-       "#+COLUMNS: %B\n* H\n:PROPERTIES:\n:COLUMNS: %C\n:END:\n** S\n<point>"
-      (let ((org-columns-default-format "%A"))
-       (org-columns-get-format)))))
+     "#+COLUMNS: %B\n* H\n:PROPERTIES:\n:COLUMNS: %C\n:END:\n** S\n<point>"
+     (let ((org-columns-default-format "%A"))
+       (org-columns-get-format)))))
   ;; When optional argument is provided, prefer it.
   (should
    (equal
     "%D"
     (org-test-with-temp-text
-       "#+COLUMNS: %B\n* H\n:PROPERTIES:\n:COLUMNS: %C\n:END:\n** S\n<point>"
-      (let ((org-columns-default-format "%A"))
-       (org-columns-get-format "%D"))))))
+     "#+COLUMNS: %B\n* H\n:PROPERTIES:\n:COLUMNS: %C\n:END:\n** S\n<point>"
+     (let ((org-columns-default-format "%A"))
+       (org-columns-get-format "%D"))))))
 
 (ert-deftest test-org-colview/columns-scope ()
   "Test `org-columns' scope."
@@ -226,7 +243,7 @@
              (org-columns))
            (org-trim (get-char-property (point) 'display)))))
   (should
-   (equal "1234… |"
+   (equal (if (= 1 (char-width ?…)) "1234… |" "123… |")
          (org-test-with-temp-text "* H\n:PROPERTIES:\n:P: 123456\n:END:"
            (let ((org-columns-default-format "%5P")
                  (org-columns-ellipses "…"))