org-macs: Fix `org-string-width' with `display' property

* lisp/org-macs.el (org-string-display): New function.
(org-string-width): Use new function.

* testing/lisp/test-org-macs.el: New file.

lisp/org-macs.el

@@ -60,26 +60,74 @@ and end of string are ignored."
       (setq string (replace-match "" nil nil string)))
     (split-string string separators)))
 
-(defun org-string-width (s)
-  "Compute width of string S, ignoring invisible characters."
-  (let ((invisiblep (lambda (v)
-		      ;; Non-nil if a V `invisible' property means
-		      ;; that that text is meant to be invisible.
-		      (or (eq t buffer-invisibility-spec)
-			  (assoc-string v buffer-invisibility-spec))))
-	(len (length s)))
-    (let ((invisible-parts nil))
-      (let ((cursor 0))
-	(while (setq cursor (text-property-not-all cursor len 'invisible nil s))
-	  (let ((end (or (next-single-property-change cursor 'invisible s len))))
-	    (when (funcall invisiblep (get-text-property cursor 'invisible s))
-	      (push (cons cursor end) invisible-parts))
-	    (setq cursor end))))
-      (let ((new-string s))
-	(pcase-dolist (`(,begin . ,end) invisible-parts)
-	  (setq new-string (concat (substring new-string 0 begin)
-				   (substring new-string end))))
-	(string-width new-string)))))
+(defun org-string-display (string)
+  "Return STRING as it is displayed in the current buffer.
+This function takes into consideration `invisible' and `display'
+text properties."
+  (let* ((build-from-parts
+	  (lambda (s property filter)
+	    ;; Build a new string out of string S.  On every group of
+	    ;; contiguous characters with the same PROPERTY value,
+	    ;; call FILTER on the properties list at the beginning of
+	    ;; the group.  If it returns a string, replace the
+	    ;; characters in the group with it.  Otherwise, preserve
+	    ;; those characters.
+	    (let ((len (length s))
+		  (new "")
+		  (i 0)
+		  (cursor 0))
+	      (while (setq i (text-property-not-all i len property nil s))
+		(let ((end (next-single-property-change i property s len))
+		      (value (funcall filter (text-properties-at i s))))
+		  (when value
+		    (setq new (concat new (substring s cursor i) value))
+		    (setq cursor end))
+		  (setq i end)))
+	      (concat new (substring s cursor)))))
+	 (prune-invisible
+	  (lambda (s)
+	    (funcall build-from-parts s 'invisible
+		     (lambda (props)
+		       ;; If `invisible' property in PROPS means text
+		       ;; is to be invisible, return the empty string.
+		       ;; Otherwise return nil so that the part is
+		       ;; skipped.
+		       (and (or (eq t buffer-invisibility-spec)
+				(assoc-string (plist-get props 'invisible)
+					      buffer-invisibility-spec))
+			    "")))))
+	 (replace-display
+	  (lambda (s)
+	    (funcall build-from-parts s 'display
+		     (lambda (props)
+		       ;; If there is any string specification in
+		       ;; `display' property return it.  Also attach
+		       ;; other text properties on the part to that
+		       ;; string (face...).
+		       (let* ((display (plist-get props 'display))
+			      (value (if (stringp display) display
+				       (cl-some #'stringp display))))
+			 (when value
+			   (apply
+			    #'propertize
+			    ;; Displayed string could contain
+			    ;; invisible parts, but no nested display.
+			    (funcall prune-invisible value)
+			    (plist-put props
+				       'display
+				       (and (not (stringp display))
+					    (cl-remove-if #'stringp
+							  display)))))))))))
+    ;; `display' property overrides `invisible' one.  So we first
+    ;; replace characters with `display' property.  Then we remove
+    ;; invisible characters.
+    (funcall prune-invisible (funcall replace-display string))))
+
+(defun org-string-width (string)
+  "Return width of STRING when displayed in the current buffer.
+Unlike to `string-width', this function takes into consideration
+`invisible' and `display' text properties."
+  (string-width (org-string-display string)))
 
 (defun org-not-nil (v)
   "If V not nil, and also not the string \"nil\", then return V.

testing/lisp/test-org-macs.el

@@ -0,0 +1,57 @@
+;;; test-org-macs.el --- Tests for Org Macs library  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017  Nicolas Goaziou
+
+;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(ert-deftest test-org/string-display ()
+  "Test `org-string-display' specifications."
+  (should (equal "a" (org-string-display "a")))
+  (should (equal "" (org-string-display "")))
+  ;; Ignore invisible characters.
+  (should (equal "" (org-string-display #("a" 0 1 (invisible t)))))
+  (should (equal "b" (org-string-display #("ab" 0 1 (invisible t)))))
+  (should (equal "a" (org-string-display #("ab" 1 2 (invisible t)))))
+  (should (equal "ace" (org-string-display
+                        #("abcde" 1 2 (invisible t) 3 4 (invisible t)))))
+  ;; Check if `invisible' value really means invisibility.
+  (should (equal "" (let ((buffer-invisibility-spec t))
+                      (org-string-display #("a" 0 1 (invisible foo))))))
+  (should (equal "" (let ((buffer-invisibility-spec '(foo)))
+                      (org-string-display #("a" 0 1 (invisible foo))))))
+  (should (equal "" (let ((buffer-invisibility-spec '((foo . t))))
+                      (org-string-display #("a" 0 1 (invisible foo))))))
+  (should (equal "a" (let ((buffer-invisibility-spec '(bar)))
+                       (org-string-display #("a" 0 1 (invisible foo))))))
+  ;; Check `display' property.
+  (should (equal "abc" (org-string-display #("a" 0 1 (display "abc")))))
+  (should (equal "1abc3" (org-string-display #("1a3" 1 2 (display "abc")))))
+  ;; `display' string can also contain invisible characters.
+  (should (equal "1ac3" (org-string-display
+			 #("123" 1 2 (display #("abc" 1 2 (invisible t)))))))
+  ;; Preserve other text properties when replacing with a display
+  ;; string.
+  (should
+   (eq 'foo
+       (get-text-property 1 'face
+			  (org-string-display
+			   #("123" 1 2 (display "abc" face foo)))))))
+
+
+(provide 'test-org-macs)
+;;; test-org-macs.el ends here