forked from mirrors/org-mode
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
parent
9a816fe3ea
commit
1334572582
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue