Ver código fonte

org-macs: Fix last commit

* lisp/org-macs.el (org--string-from-props): Do not raise an error on
  unsupported display properties.  Change signature to avoid creating
  new strings unnecessarily.  Update docstring accordingly.
(org-string-width): Apply signature change.
* testing/lisp/test-org-macs.el (test-org/string-width): Add test.

Reported-by: Colin Baxter <m43cap@yandex.com>
<http://lists.gnu.org/r/emacs-orgmode/2018-10/msg00346.html>
Nicolas Goaziou 6 anos atrás
pai
commit
4b905774ac
2 arquivos alterados com 44 adições e 30 exclusões
  1. 41 29
      lisp/org-macs.el
  2. 3 1
      testing/lisp/test-org-macs.el

+ 41 - 29
lisp/org-macs.el

@@ -826,58 +826,70 @@ end of string are ignored."
 		      results		;skip trailing separator
 		      results		;skip trailing separator
 		    (cons (substring string i) results)))))))
 		    (cons (substring string i) results)))))))
 
 
-(defun org--string-from-props (s property)
+(defun org--string-from-props (s property beg end)
   "Return the visible part of string S.
   "Return the visible part of string S.
 Visible part is determined according to text PROPERTY, which is
 Visible part is determined according to text PROPERTY, which 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))
+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))
 	     (spec (plist-get props property))
 	     (value
 	     (value
 	      (pcase property
 	      (pcase property
 		(`invisible
 		(`invisible
 		 ;; If `invisible' property in PROPS means text is to
 		 ;; If `invisible' property in PROPS means text is to
-		 ;; be invisible, return the empty string.  Otherwise
-		 ;; return nil so that the part is skipped.
+		 ;; be invisible, return 0.  Otherwise return nil so
+		 ;; as to resume search.
 		 (and (or (eq t buffer-invisibility-spec)
 		 (and (or (eq t buffer-invisibility-spec)
 			  (assoc-string spec buffer-invisibility-spec))
 			  (assoc-string spec buffer-invisibility-spec))
-		      ""))
+		      0))
 		(`display
 		(`display
 		 (pcase spec
 		 (pcase spec
 		   (`nil nil)
 		   (`nil nil)
+		   (`(space . ,props)
+		    (let ((width (plist-get props :width)))
+		      (and (wholenump width) width)))
 		   (`(image . ,_)
 		   (`(image . ,_)
-		    ;; Since we are returning a string, create
-		    ;; a place-holder with the same width as the
-		    ;; image.
-		    (make-string (ceiling (car (image-size spec))) ?\s))
+		    (ceiling (car (image-size spec))))
 		   ((pred stringp)
 		   ((pred stringp)
 		    ;; Displayed string could contain invisible parts,
 		    ;; Displayed string could contain invisible parts,
 		    ;; but no nested display.
 		    ;; but no nested display.
-		    (org--string-from-props spec 'invisible))
-		   (_ (error "Un-handled `display' value: %S" spec))))
+		    (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)))))
 		(_ (error "Unknown property: %S" property)))))
 	(when value
 	(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)))
+	  (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 (string)
 (defun org-string-width (string)
   "Return width of STRING when displayed in the current buffer.
   "Return width of STRING when displayed in the current buffer.
 Unlike `string-width', this function takes into consideration
 Unlike `string-width', this function takes into consideration
 `invisible' and `display' text properties.  It supports the
 `invisible' and `display' text properties.  It supports the
-latter in a limited way; it raises an error if it cannot handle
-a given `display' combination."
-  (string-width
-   (org--string-from-props (org--string-from-props string 'display)
-			   'invisible)))
+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-not-nil (v)
 (defun org-not-nil (v)
   "If V not nil, and also not the string \"nil\", then return V.
   "If V not nil, and also not the string \"nil\", then return V.

+ 3 - 1
testing/lisp/test-org-macs.el

@@ -63,7 +63,9 @@
   (should (= 5 (org-string-width #("1a3" 1 2 (display "abc")))))
   (should (= 5 (org-string-width #("1a3" 1 2 (display "abc")))))
   ;; `display' string can also contain invisible characters.
   ;; `display' string can also contain invisible characters.
   (should (= 4 (org-string-width
   (should (= 4 (org-string-width
-		#("123" 1 2 (display #("abc" 1 2 (invisible t))))))))
+		#("123" 1 2 (display #("abc" 1 2 (invisible t)))))))
+  ;; Test `space' property in `display'.
+  (should (= 2 (org-string-width #(" " 0 1 (display (space :width 2)))))))
 
 
 
 
 ;;; Regexp
 ;;; Regexp