diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-07-28 12:15:47 +0200 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-07-28 12:15:47 +0200 |
commit | 90f606d9c260b28519df1b549adad256f6e5708f (patch) | |
tree | 8ca590e450f702c852ce123c91c135362221e45a | |
parent | e79b0bd9f33c270515379028ba344e620ea63bba (diff) | |
download | org-mode-90f606d9c260b28519df1b549adad256f6e5708f.tar.gz |
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.
-rw-r--r-- | lisp/org-macs.el | 88 | ||||
-rw-r--r-- | testing/lisp/test-org-macs.el | 57 |
2 files changed, 125 insertions, 20 deletions
diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 3f6ce4a..c105f75 100644 --- a/lisp/org-macs.el +++ b/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. diff --git a/testing/lisp/test-org-macs.el b/testing/lisp/test-org-macs.el new file mode 100644 index 0000000..b5ece07 --- /dev/null +++ b/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 |