[PATCH v2 29/38] org-string-width: Work around `window-pixel-width' bug in old Emacs

[Ihor Radchenko]

---
 lisp/org-macs.el | 188 ++++++++++++++++++++++++++++++++---------------
 1 file changed, 129 insertions(+), 59 deletions(-)

diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index e56a234d3..a1d514d50 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -893,73 +893,143 @@ (defun org-split-string (string &optional separators)
                      results           ;skip trailing separator
                    (cons (substring string i) results)))))))
 
+(defun org--string-from-props (s property beg end)
+  "Return the visible part of string S.
+Visible part is determined according to text PROPERTY, which is
+either `invisible' or `display'.  BEG and END are 0-indices
+delimiting S."
+  (let ((width 0)
+       (cursor beg))
+    (while (setq beg (text-property-not-all beg end property nil s))
+      (let* ((next (next-single-property-change beg property s end))
+            (props (text-properties-at beg s))
+            (spec (plist-get props property))
+            (value
+             (pcase property
+               (`invisible
+                ;; If `invisible' property in PROPS means text is to
+                ;; be invisible, return 0.  Otherwise return nil so
+                ;; as to resume search.
+                (and (or (eq t buffer-invisibility-spec)
+                         (assoc-string spec buffer-invisibility-spec))
+                     0))
+               (`display
+                (pcase spec
+                  (`nil nil)
+                  (`(space . ,props)
+                   (let ((width (plist-get props :width)))
+                     (and (wholenump width) width)))
+                  (`(image . ,_)
+                    (and (fboundp 'image-size)
+                         (ceiling (car (image-size spec)))))
+                  ((pred stringp)
+                   ;; Displayed string could contain invisible parts,
+                   ;; but no nested display.
+                   (org--string-from-props spec 'invisible 0 (length spec)))
+                  (_
+                   ;; Un-handled `display' value.  Ignore it.
+                   ;; Consider the original string instead.
+                   nil)))
+               (_ (error "Unknown property: %S" property)))))
+       (when value
+         (cl-incf width
+                  ;; When looking for `display' parts, we still need
+                  ;; to look for `invisible' property elsewhere.
+                  (+ (cond ((eq property 'display)
+                            (org--string-from-props s 'invisible cursor beg))
+                           ((= cursor beg) 0)
+                           (t (string-width (substring s cursor beg))))
+                     value))
+         (setq cursor next))
+       (setq beg next)))
+    (+ width
+       ;; Look for `invisible' property in the last part of the
+       ;; string.  See above.
+       (cond ((eq property 'display)
+             (org--string-from-props s 'invisible cursor end))
+            ((= cursor end) 0)
+            (t (string-width (substring s cursor end)))))))
+
+(defun org--string-width-1 (string)
+  "Return width of STRING when displayed in the current buffer.
+Unlike `string-width', this function takes into consideration
+`invisible' and `display' text properties.  It supports the
+latter in a limited way, mostly for combinations used in Org.
+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)
   "Return width of STRING when displayed in the current buffer.
 Return width in pixels when PIXELS is non-nil."
-  ;; Wrap/line prefix will make `window-text-pizel-size' return too
-  ;; large value including the prefix.
-  ;; Face should be removed to make sure that all the string symbols
-  ;; are using default face with constant width.  Constant char width
-  ;; is critical to get right string width from pixel width.
-  (remove-text-properties 0 (length string)
-                          '(wrap-prefix t line-prefix t face t)
-                          string)
-  (let (;; We need to remove the folds to make sure that folded table
-        ;; alignment is not messed up.
-        (current-invisibility-spec
-         (or (and (not (listp buffer-invisibility-spec))
-                  buffer-invisibility-spec)
-             (let (result)
-               (dolist (el buffer-invisibility-spec)
-                 (unless (or (memq el
-                                   '(org-fold-drawer
-                                     org-fold-block
-                                     org-fold-outline))
-                             (and (listp el)
-                                  (memq (car el)
-                                        '(org-fold-drawer
-                                          org-fold-block
-                                          org-fold-outline))))
-                   (push el result)))
-               result)))
-        (current-char-property-alias-alist char-property-alias-alist))
-    (with-temp-buffer
-      (setq-local display-line-numbers nil)
-      (setq-local buffer-invisibility-spec
-                  (if (listp current-invisibility-spec)
-                      (mapcar (lambda (el)
-                                ;; Consider elipsis to have 0 width.
-                                ;; It is what Emacs 28+ does, but we have
-                                ;; to force it in earlier Emacs versions.
-                                (if (and (consp el) (cdr el))
-                                    (list (car el))
-                                  el))
-                              current-invisibility-spec)
-                    current-invisibility-spec))
-      (setq-local char-property-alias-alist
-                  current-char-property-alias-alist)
-      (let (pixel-width symbol-width)
-        (with-silent-modifications
-          (setf (buffer-string) string)
-          (setq pixel-width
-                (if (get-buffer-window (current-buffer))
-                    (car (window-text-pixel-size
-                          nil (line-beginning-position) (point-max)))
-                  (set-window-buffer nil (current-buffer))
-                  (car (window-text-pixel-size
-                        nil (line-beginning-position) (point-max)))))
-          (unless pixels
-            (setf (buffer-string) "a")
-            (setq symbol-width
+  (if (and (version< emacs-version "28") (not pixels))
+      ;; FIXME: Fallback to old limited version, because
+      ;; `window-pixel-width' is buggy in older Emacs.
+      (org--string-width-1 string)
+    ;; Wrap/line prefix will make `window-text-pizel-size' return too
+    ;; large value including the prefix.
+    ;; Face should be removed to make sure that all the string symbols
+    ;; are using default face with constant width.  Constant char width
+    ;; is critical to get right string width from pixel width.
+    (remove-text-properties 0 (length string)
+                            '(wrap-prefix t line-prefix t face t)
+                            string)
+    (let (;; We need to remove the folds to make sure that folded table
+          ;; alignment is not messed up.
+          (current-invisibility-spec
+           (or (and (not (listp buffer-invisibility-spec))
+                    buffer-invisibility-spec)
+               (let (result)
+                 (dolist (el buffer-invisibility-spec)
+                   (unless (or (memq el
+                                     '(org-fold-drawer
+                                       org-fold-block
+                                       org-fold-outline))
+                               (and (listp el)
+                                    (memq (car el)
+                                          '(org-fold-drawer
+                                            org-fold-block
+                                            org-fold-outline))))
+                     (push el result)))
+                 result)))
+          (current-char-property-alias-alist char-property-alias-alist))
+      (with-temp-buffer
+        (setq-local display-line-numbers nil)
+        (setq-local buffer-invisibility-spec
+                    (if (listp current-invisibility-spec)
+                        (mapcar (lambda (el)
+                                  ;; Consider elipsis to have 0 width.
+                                  ;; It is what Emacs 28+ does, but we have
+                                  ;; to force it in earlier Emacs versions.
+                                  (if (and (consp el) (cdr el))
+                                      (list (car el))
+                                    el))
+                                current-invisibility-spec)
+                      current-invisibility-spec))
+        (setq-local char-property-alias-alist
+                    current-char-property-alias-alist)
+        (let (pixel-width symbol-width)
+          (with-silent-modifications
+            (setf (buffer-string) string)
+            (setq pixel-width
                   (if (get-buffer-window (current-buffer))
                       (car (window-text-pixel-size
                             nil (line-beginning-position) (point-max)))
                     (set-window-buffer nil (current-buffer))
                     (car (window-text-pixel-size
-                          nil (line-beginning-position) (point-max)))))))
-        (if pixels
-            pixel-width
-          (/ pixel-width symbol-width))))))
+                          nil (line-beginning-position) (point-max)))))
+            (unless pixels
+              (setf (buffer-string) "a")
+              (setq symbol-width
+                    (if (get-buffer-window (current-buffer))
+                        (car (window-text-pixel-size
+                              nil (line-beginning-position) (point-max)))
+                      (set-window-buffer nil (current-buffer))
+                      (car (window-text-pixel-size
+                            nil (line-beginning-position) (point-max)))))))
+          (if pixels
+              pixel-width
+            (/ pixel-width symbol-width)))))))
 
 (defun org-not-nil (v)
   "If V not nil, and also not the string \"nil\", then return V.
-- 
2.35.1



-- 
Ihor Radchenko,
PhD,
Center for Advancing Materials Performance from the Nanoscale (CAMP-nano)
State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong 
University, Xi'an, China
Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg