Browse Source

org-macs: Optimize `org-string-width'

* lisp/org-macs.el (org--string-from-props): New function.
(org-string-display): Remove function.
(org-string-width): Use new function.
Nicolas Goaziou 1 year ago
parent
commit
1334572582
2 changed files with 57 additions and 96 deletions
  1. 36 62
      lisp/org-macs.el
  2. 21 34
      testing/lisp/test-org-macs.el

+ 36 - 62
lisp/org-macs.el

@@ -826,73 +826,47 @@ end of string are ignored."
 		      results		;skip trailing separator
 		    (cons (substring string i) results)))))))
 
-(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)
-				  'display
-				  (and (not (stringp display))
-				       (cl-remove-if #'stringp display))
-				  props))))))))
-    ;; `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-from-props (s property)
+  "Return visible string according to text properties in string S.
+PROPERTY is either `invisible' or `display'."
+  (let ((len (length s))
+	(new nil)
+	(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))
+	     (props (text-properties-at i s))
+	     (value
+	      (if (eq property 'invisible)
+		  ;; 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))
+		       "")
+		(let ((display (plist-get props 'display)))
+		  (pcase (if (stringp display) display
+			   (cl-some #'stringp display))
+		    (`nil nil)
+		    ;; Displayed string could contain invisible parts,
+		    ;; but no nested display.
+		    (s (org--string-from-props s 'invisible)))))))
+	(when value
+	  (setq new (concat new (substring s cursor i) value))
+	  (setq cursor end))
+	(setq i end)))
+    (if new (concat new (substring s cursor))
+      ;; If PROPERTY was not found, return S as-is.
+      s)))
 
 (defun org-string-width (string)
   "Return width of STRING when displayed in the current buffer.
 Unlike `string-width', this function takes into consideration
 `invisible' and `display' text properties."
-  (string-width (org-string-display string)))
+  (string-width
+   (org--string-from-props (org--string-from-props string 'display)
+			   'invisible)))
 
 (defun org-not-nil (v)
   "If V not nil, and also not the string \"nil\", then return V.

+ 21 - 34
testing/lisp/test-org-macs.el

@@ -39,44 +39,31 @@
   ;; When nil, SEPARATORS matches any number of blank characters.
   (should (equal '("a" "b") (org-split-string "a \t\nb"))))
 
-(ert-deftest test-org/string-display ()
-  "Test `org-string-display' specifications."
-  (should (equal "a" (org-string-display "a")))
-  (should (equal "" (org-string-display "")))
+(ert-deftest test-org/string-width ()
+  "Test `org-string-width' specifications."
+  (should (= 1 (org-string-width "a")))
+  (should (= 0 (org-string-width "")))
   ;; 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)))))
+  (should (= 0 (org-string-width #("a" 0 1 (invisible t)))))
+  (should (= 1 (org-string-width #("ab" 0 1 (invisible t)))))
+  (should (= 1 (org-string-width #("ab" 1 2 (invisible t)))))
+  (should (= 3 (org-string-width
+		#("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))))))
+  (should (= 0 (let ((buffer-invisibility-spec t))
+                 (org-string-width #("a" 0 1 (invisible foo))))))
+  (should (= 0 (let ((buffer-invisibility-spec '(foo)))
+                 (org-string-width #("a" 0 1 (invisible foo))))))
+  (should (= 0 (let ((buffer-invisibility-spec '((foo . t))))
+                 (org-string-width #("a" 0 1 (invisible foo))))))
+  (should (= 1 (let ((buffer-invisibility-spec '(bar)))
+                 (org-string-width #("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")))))
+  (should (= 3 (org-string-width #("a" 0 1 (display "abc")))))
+  (should (= 5 (org-string-width #("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))))))
-  ;; Also preserve `display' property in original string.
-  (should
-   (equal "abc"
-	  (let ((s #("123" 1 2 (display "abc" face foo))))
-	    (org-string-display s)
-	    (get-text-property 1 'display s)))))
+  (should (= 4 (org-string-width
+		#("123" 1 2 (display #("abc" 1 2 (invisible t))))))))
 
 
 ;;; Regexp