[elpa] externals/org 80ce6152ba: lisp/org-table.el: Improve cell alignment accuracy

[ELPA Syncer]

branch: externals/org
commit 80ce6152ba915b7c53d239f2b030f7afb8e70e8e
Author: Ihor Radchenko <yantar92@posteo.net>
Commit: Ihor Radchenko <yantar92@posteo.net>

    lisp/org-table.el: Improve cell alignment accuracy
    
    * lisp/org-macs.el (org-string-width): Add new optional argument
    providing reference face to be used for relative width calculation.
    Use `ceiling' when the total string width is a fraction of "a" width.
    * lisp/org-table.el (org-table-blank-field):
    (org-table-clean-line):
    (org-table--shrink-field):
    (org-table--align-field):
    (org-table-align):
    (org-table-justify-field-maybe): Use org-table face as reference for
    width calculation.
    
    When org-table face is not default, `org-string-width' may not return
    correct width as " " and "-" in the table may not have the same width
    as "a" with default face used as reference in `org-string-width'.
    With this patch, the width calculation becomes more accurate, although
    may still be off if the table faces are customized to be more
    piece-mill.
    
    Reported-by: ltmsyvag
    Link: https://emacs-china.org/t/org-9-6-5-org/24484
---
 lisp/org-macs.el  | 12 +++++++-----
 lisp/org-table.el | 17 +++++++++--------
 2 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 604ffc1b4b..7170733797 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -1085,9 +1085,11 @@ Results may be off sometimes if it cannot handle a given
 `display' value."
   (org--string-from-props string 'display 0 (length string)))
 
-(defun org-string-width (string &optional pixels)
+(defun org-string-width (string &optional pixels default-face)
   "Return width of STRING when displayed in the current buffer.
-Return width in pixels when PIXELS is non-nil."
+Return width in pixels when PIXELS is non-nil.
+When PIXELS is nil, DEFAULT-FACE is the face used to calculate relative
+STRING width.  When REFERENCE-FACE is nil, `default' face is used."
   (if (and (version< emacs-version "28") (not pixels))
       ;; FIXME: Fallback to old limited version, because
       ;; `window-pixel-width' is buggy in older Emacs.
@@ -1102,7 +1104,7 @@ Return width in pixels when PIXELS is non-nil."
     ;; is critical to get right string width from pixel width (not needed
     ;; when PIXELS are requested though).
     (unless pixels
-      (remove-text-properties 0 (length string) '(face t) string))
+      (put-text-property 0 (length string) 'face (or default-face 'default) 
string))
     (let (;; We need to remove the folds to make sure that folded table
           ;; alignment is not messed up.
           (current-invisibility-spec
@@ -1146,11 +1148,11 @@ Return width in pixels when PIXELS is non-nil."
             (setq pixel-width (org-buffer-text-pixel-width))
             (unless pixels
               (erase-buffer)
-              (insert "a")
+              (insert (propertize "a" 'face (or default-face 'default)))
               (setq symbol-width (org-buffer-text-pixel-width))))
           (if pixels
               pixel-width
-            (/ pixel-width symbol-width)))))))
+            (ceiling pixel-width symbol-width)))))))
 
 (defmacro org-current-text-column ()
   "Like `current-column' but ignore display properties.
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 112def0349..d79d92dd1a 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -1232,7 +1232,7 @@ Return t when the line exists, nil if it does not exist."
     (if (looking-at "|[^|\n]+")
        (let* ((pos (match-beginning 0))
               (match (match-string 0))
-              (len (save-match-data (org-string-width match))))
+              (len (save-match-data (org-string-width match nil 'org-table))))
          (replace-match (concat "|" (make-string (1- len) ?\ )))
          (goto-char (+ 2 pos))
          (substring match 1)))))
@@ -1731,7 +1731,7 @@ In particular, this does handle wide and invisible 
characters."
               (concat "|"
                        (make-string
                         (save-match-data
-                          (org-string-width (match-string 1 s)))
+                          (org-string-width (match-string 1 s) nil 'org-table))
                        ?\ )
                        "|")
               t t s)))
@@ -3996,7 +3996,7 @@ already hidden."
           start end (make-string (1+ width) ?-) "")))
    ((equal contents "")                        ;no contents to hide
     (list
-     (let ((w (org-string-width (buffer-substring start end)))
+     (let ((w (org-string-width (buffer-substring start end) nil 'org-table))
           ;; We really want WIDTH + 2 whitespace, to include blanks
           ;; around fields.
           (full (+ 2 width)))
@@ -4015,7 +4015,8 @@ already hidden."
     (let* ((lead (org-with-point-at start (skip-chars-forward " ")))
           (trail (org-with-point-at end (abs (skip-chars-backward " "))))
           (contents-width (org-string-width
-                           (buffer-substring (+ start lead) (- end trail)))))
+                           (buffer-substring (+ start lead) (- end trail))
+                            nil 'org-table)))
       (cond
        ;; Contents are too large to fit in WIDTH character.  Limit, if
        ;; possible, blanks at the beginning of the field to a single
@@ -4040,7 +4041,7 @@ already hidden."
                      (let ((mean (+ (ash lower -1)
                                     (ash upper -1)
                                     (logand lower upper 1))))
-                       (pcase (org-string-width (buffer-substring begin mean))
+                       (pcase (org-string-width (buffer-substring begin mean) 
nil 'org-table)
                          ((pred (= width)) (throw :exit mean))
                          ((pred (< width)) (setq upper mean))
                          (_ (setq lower mean)))))
@@ -4351,7 +4352,7 @@ extension of the given file name, and finally on the 
variable
   "Format FIELD according to column WIDTH and alignment ALIGN.
 FIELD is a string.  WIDTH is a number.  ALIGN is either \"c\",
 \"l\" or\"r\"."
-  (let* ((spaces (- width (org-string-width field)))
+  (let* ((spaces (- width (org-string-width field nil 'org-table)))
         (prefix (pcase align
                   ("l" "")
                   ("r" (make-string spaces ?\s))
@@ -4400,7 +4401,7 @@ FIELD is a string.  WIDTH is a number.  ALIGN is either 
\"c\",
                  (non-empty 0))
              (dolist (row rows)
                (let ((cell (or (nth i row) "")))
-                 (setq max-width (max max-width (org-string-width cell)))
+                 (setq max-width (max max-width (org-string-width cell nil 
'org-table)))
                  (cond (fixed-align? nil)
                        ((equal cell "") nil)
                        ((string-match "\\`<\\([lrc]\\)[0-9]*>\\'" cell)
@@ -4497,7 +4498,7 @@ Optional argument NEW may specify text to replace the 
current field content."
                          ((not new)
                           (concat (org-table--align-field field width align)
                                   "|"))
-                         ((and width (<= (org-string-width new) width))
+                         ((and width (<= (org-string-width new nil 'org-table) 
width))
                           (concat (org-table--align-field new width align)
                                   "|"))
                          (t