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.
This commit is contained in:
Nicolas Goaziou 2018-07-18 19:15:19 +02:00
parent 9a816fe3ea
commit 1334572582
2 changed files with 57 additions and 96 deletions

View file

@ -826,73 +826,47 @@ 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-display (string) (defun org--string-from-props (s property)
"Return STRING as it is displayed in the current buffer. "Return visible string according to text properties in string S.
This function takes into consideration `invisible' and `display' PROPERTY is either `invisible' or `display'."
text properties." (let ((len (length s))
(let* ((build-from-parts (new nil)
(lambda (s property filter) (i 0)
;; Build a new string out of string S. On every group of (cursor 0))
;; contiguous characters with the same PROPERTY value, (while (setq i (text-property-not-all i len property nil s))
;; call FILTER on the properties list at the beginning of (let* ((end (next-single-property-change i property s len))
;; the group. If it returns a string, replace the (props (text-properties-at i s))
;; characters in the group with it. Otherwise, preserve (value
;; those characters. (if (eq property 'invisible)
(let ((len (length s)) ;; If `invisible' property in PROPS means text is to
(new "") ;; be invisible, return the empty string. Otherwise
(i 0) ;; return nil so that the part is skipped.
(cursor 0)) (and (or (eq t buffer-invisibility-spec)
(while (setq i (text-property-not-all i len property nil s)) (assoc-string (plist-get props 'invisible)
(let ((end (next-single-property-change i property s len)) buffer-invisibility-spec))
(value (funcall filter (text-properties-at i s)))) "")
(when value (let ((display (plist-get props 'display)))
(setq new (concat new (substring s cursor i) value)) (pcase (if (stringp display) display
(setq cursor end)) (cl-some #'stringp display))
(setq i end))) (`nil nil)
(concat new (substring s cursor))))) ;; Displayed string could contain invisible parts,
(prune-invisible ;; but no nested display.
(lambda (s) (s (org--string-from-props s 'invisible)))))))
(funcall build-from-parts s 'invisible (when value
(lambda (props) (setq new (concat new (substring s cursor i) value))
;; If `invisible' property in PROPS means text (setq cursor end))
;; is to be invisible, return the empty string. (setq i end)))
;; Otherwise return nil so that the part is (if new (concat new (substring s cursor))
;; skipped. ;; If PROPERTY was not found, return S as-is.
(and (or (eq t buffer-invisibility-spec) s)))
(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-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." `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) (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.

View file

@ -39,44 +39,31 @@
;; When nil, SEPARATORS matches any number of blank characters. ;; When nil, SEPARATORS matches any number of blank characters.
(should (equal '("a" "b") (org-split-string "a \t\nb")))) (should (equal '("a" "b") (org-split-string "a \t\nb"))))
(ert-deftest test-org/string-display () (ert-deftest test-org/string-width ()
"Test `org-string-display' specifications." "Test `org-string-width' specifications."
(should (equal "a" (org-string-display "a"))) (should (= 1 (org-string-width "a")))
(should (equal "" (org-string-display ""))) (should (= 0 (org-string-width "")))
;; Ignore invisible characters. ;; Ignore invisible characters.
(should (equal "" (org-string-display #("a" 0 1 (invisible t))))) (should (= 0 (org-string-width #("a" 0 1 (invisible t)))))
(should (equal "b" (org-string-display #("ab" 0 1 (invisible t))))) (should (= 1 (org-string-width #("ab" 0 1 (invisible t)))))
(should (equal "a" (org-string-display #("ab" 1 2 (invisible t))))) (should (= 1 (org-string-width #("ab" 1 2 (invisible t)))))
(should (equal "ace" (org-string-display (should (= 3 (org-string-width
#("abcde" 1 2 (invisible t) 3 4 (invisible t))))) #("abcde" 1 2 (invisible t) 3 4 (invisible t)))))
;; Check if `invisible' value really means invisibility. ;; Check if `invisible' value really means invisibility.
(should (equal "" (let ((buffer-invisibility-spec t)) (should (= 0 (let ((buffer-invisibility-spec t))
(org-string-display #("a" 0 1 (invisible foo)))))) (org-string-width #("a" 0 1 (invisible foo))))))
(should (equal "" (let ((buffer-invisibility-spec '(foo))) (should (= 0 (let ((buffer-invisibility-spec '(foo)))
(org-string-display #("a" 0 1 (invisible foo)))))) (org-string-width #("a" 0 1 (invisible foo))))))
(should (equal "" (let ((buffer-invisibility-spec '((foo . t)))) (should (= 0 (let ((buffer-invisibility-spec '((foo . t))))
(org-string-display #("a" 0 1 (invisible foo)))))) (org-string-width #("a" 0 1 (invisible foo))))))
(should (equal "a" (let ((buffer-invisibility-spec '(bar))) (should (= 1 (let ((buffer-invisibility-spec '(bar)))
(org-string-display #("a" 0 1 (invisible foo)))))) (org-string-width #("a" 0 1 (invisible foo))))))
;; Check `display' property. ;; Check `display' property.
(should (equal "abc" (org-string-display #("a" 0 1 (display "abc"))))) (should (= 3 (org-string-width #("a" 0 1 (display "abc")))))
(should (equal "1abc3" (org-string-display #("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 (equal "1ac3" (org-string-display (should (= 4 (org-string-width
#("123" 1 2 (display #("abc" 1 2 (invisible t))))))) #("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)))))
;;; Regexp ;;; Regexp