forked from mirrors/org-mode
org-string-width: Work around `window-pixel-width' bug in old Emacs
This commit is contained in:
Ihor Radchenko
parent
2e3566e1e9
commit
0daa209a74
188
lisp/org-macs.el
188
lisp/org-macs.el
|
|
@ -893,73 +893,143 @@ end of string are ignored."
|
|||
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.
|
||||
|
|
|
|||
Loading…
Reference in New Issue