[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH v2 29/38] org-string-width: Work around `window-pixel-width' bug
From: |
Ihor Radchenko |
Subject: |
[PATCH v2 29/38] org-string-width: Work around `window-pixel-width' bug in old Emacs |
Date: |
Wed, 20 Apr 2022 21:27:48 +0800 |
---
lisp/org-macs.el | 188 ++++++++++++++++++++++++++++++++---------------
1 file changed, 129 insertions(+), 59 deletions(-)
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index e56a234d3..a1d514d50 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -893,73 +893,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.
--
2.35.1
--
Ihor Radchenko,
PhD,
Center for Advancing Materials Performance from the Nanoscale (CAMP-nano)
State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong
University, Xi'an, China
Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg
- [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions, (continued)
- [PATCH v2 17/38] org-compat: Work around some third-party packages using outline-* functions, Ihor Radchenko, 2022/04/20
- [PATCH v2 20/38] Add org-fold-related tests---, Ihor Radchenko, 2022/04/20
- [PATCH v2 22/38] ORG-NEWS: Add list of changes---, Ihor Radchenko, 2022/04/20
- [PATCH v2 23/38] Backport contributed commits---, Ihor Radchenko, 2022/04/20
- [PATCH v2 21/38] org-manual: Update to new org-fold function names---, Ihor Radchenko, 2022/04/20
- [PATCH v2 25/38] Fix bug in org-get-headingFixes #26, where fontification could make the matching and extraction of heading, Anders Johansson, 2022/04/20
- [PATCH v2 24/38] Fix typo: delete-duplicates → delete-dups, Anders Johansson, 2022/04/20
- [PATCH v2 26/38] Rename remaining org-force-cycle-archived, Anders Johansson, 2022/04/20
- [PATCH v2 27/38] Fix org-fold--hide-drawers--overlays---, Ihor Radchenko, 2022/04/20
- [PATCH v2 28/38] org-string-width: Handle undefined behaviour in older Emacs, Ihor Radchenko, 2022/04/20
- [PATCH v2 29/38] org-string-width: Work around `window-pixel-width' bug in old Emacs,
Ihor Radchenko <=
- [PATCH v2 30/38] org-fold-show-set-visibility: Fix edge case when folded region is at BOB, Ihor Radchenko, 2022/04/20
- [PATCH v2 32/38] test-org/string-width: Add tests for strings with prefix properties, Ihor Radchenko, 2022/04/20
- [PATCH v2 31/38] org-fold-core: Fix fontification inside folded regions, Ihor Radchenko, 2022/04/20
- [PATCH v2 33/38] org--string-from-props: Fix handling folds in Emacs <28, Ihor Radchenko, 2022/04/20
- [PATCH v2 34/38] org-link-make-string: Throw error when both LINK and DESCRIPTION are empty, Ihor Radchenko, 2022/04/20
- [PATCH v2 35/38] test-ol/org-toggle-link-display: Fix compatibility with old Emacs, Ihor Radchenko, 2022/04/20
- [PATCH v2 36/38] org-macs.el: Fix fontification checks take 2---, Ihor Radchenko, 2022/04/20
- [PATCH v2 37/38] org-fold-core-fontify-region: Fix cases when fontification is not registered, Ihor Radchenko, 2022/04/20
- [PATCH v2 38/38] org-agenda.el: Re-enable native compilation* lisp/org-agenda.el: Re-enable native compilation as it does not, Ihor Radchenko, 2022/04/20
- Re: [PATCH v2 00/38] Final call for comments: Merge org-fold feature branch, Bastien, 2022/04/20