diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 0a7da0637..db98dd149 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -887,73 +887,143 @@ (defun org-split-string (string &optional separators) results ;skip trailing separator (cons (substring string i) results))))))) +(defun org--string-from-props (s property beg end) + "Return the visible part of string S. +Visible part is determined according to text PROPERTY, which is +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)) + (value + (pcase property + (`invisible + ;; If `invisible' property in PROPS means text is to + ;; be invisible, return 0. Otherwise return nil so + ;; as to resume search. + (and (or (eq t buffer-invisibility-spec) + (assoc-string spec buffer-invisibility-spec)) + 0)) + (`display + (pcase spec + (`nil nil) + (`(space . ,props) + (let ((width (plist-get props :width))) + (and (wholenump width) width))) + (`(image . ,_) + (and (fboundp 'image-size) + (ceiling (car (image-size spec))))) + ((pred stringp) + ;; Displayed string could contain invisible parts, + ;; but no nested display. + (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))))) + (when value + (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-1 (string) + "Return width of STRING when displayed in the current buffer. +Unlike `string-width', this function takes into consideration +`invisible' and `display' text properties. It supports the +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-string-width (string &optional pixels) "Return width of STRING when displayed in the current buffer. Return width in pixels when PIXELS is non-nil." - ;; Wrap/line prefix will make `window-text-pizel-size' return too - ;; large value including the prefix. - ;; Face should be removed to make sure that all the string symbols - ;; are using default face with constant width. Constant char width - ;; is critical to get right string width from pixel width. - (remove-text-properties 0 (length string) - '(wrap-prefix t line-prefix t face t) - string) - (let (;; We need to remove the folds to make sure that folded table - ;; alignment is not messed up. - (current-invisibility-spec - (or (and (not (listp buffer-invisibility-spec)) - buffer-invisibility-spec) - (let (result) - (dolist (el buffer-invisibility-spec) - (unless (or (memq el - '(org-fold-drawer - org-fold-block - org-fold-outline)) - (and (listp el) - (memq (car el) - '(org-fold-drawer - org-fold-block - org-fold-outline)))) - (push el result))) - result))) - (current-char-property-alias-alist char-property-alias-alist)) - (with-temp-buffer - (setq-local display-line-numbers nil) - (setq-local buffer-invisibility-spec - (if (listp current-invisibility-spec) - (mapcar (lambda (el) - ;; Consider elipsis to have 0 width. - ;; It is what Emacs 28+ does, but we have - ;; to force it in earlier Emacs versions. - (if (and (consp el) (cdr el)) - (list (car el)) - el)) - current-invisibility-spec) - current-invisibility-spec)) - (setq-local char-property-alias-alist - current-char-property-alias-alist) - (let (pixel-width symbol-width) - (with-silent-modifications - (setf (buffer-string) string) - (setq pixel-width - (if (get-buffer-window (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max))) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max))))) - (unless pixels - (setf (buffer-string) "a") - (setq symbol-width + (if (and (version< emacs-version "28") (not pixels)) + ;; FIXME: Fallback to old limited version, because + ;; `window-pixel-width' is buggy in older Emacs. + (org--string-width-1 string) + ;; Wrap/line prefix will make `window-text-pizel-size' return too + ;; large value including the prefix. + ;; Face should be removed to make sure that all the string symbols + ;; are using default face with constant width. Constant char width + ;; is critical to get right string width from pixel width. + (remove-text-properties 0 (length string) + '(wrap-prefix t line-prefix t face t) + string) + (let (;; We need to remove the folds to make sure that folded table + ;; alignment is not messed up. + (current-invisibility-spec + (or (and (not (listp buffer-invisibility-spec)) + buffer-invisibility-spec) + (let (result) + (dolist (el buffer-invisibility-spec) + (unless (or (memq el + '(org-fold-drawer + org-fold-block + org-fold-outline)) + (and (listp el) + (memq (car el) + '(org-fold-drawer + org-fold-block + org-fold-outline)))) + (push el result))) + result))) + (current-char-property-alias-alist char-property-alias-alist)) + (with-temp-buffer + (setq-local display-line-numbers nil) + (setq-local buffer-invisibility-spec + (if (listp current-invisibility-spec) + (mapcar (lambda (el) + ;; Consider elipsis to have 0 width. + ;; It is what Emacs 28+ does, but we have + ;; to force it in earlier Emacs versions. + (if (and (consp el) (cdr el)) + (list (car el)) + el)) + current-invisibility-spec) + current-invisibility-spec)) + (setq-local char-property-alias-alist + current-char-property-alias-alist) + (let (pixel-width symbol-width) + (with-silent-modifications + (setf (buffer-string) string) + (setq pixel-width (if (get-buffer-window (current-buffer)) (car (window-text-pixel-size nil (line-beginning-position) (point-max))) (set-window-buffer nil (current-buffer)) (car (window-text-pixel-size - nil (line-beginning-position) (point-max))))))) - (if pixels - pixel-width - (/ pixel-width symbol-width)))))) + nil (line-beginning-position) (point-max))))) + (unless pixels + (setf (buffer-string) "a") + (setq symbol-width + (if (get-buffer-window (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))))))) + (if pixels + pixel-width + (/ pixel-width symbol-width))))))) (defun org-not-nil (v) "If V not nil, and also not the string \"nil\", then return V.