ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

org-table-header-set-header: Fix header calculation 

* lisp/org-table.el (org-table-header-set-header): Make sure that
Emacs finishes any queued redisplay before calculating window
boundaries.  Do not make assumptions about the same character width of
table lines.
(org-table-row-get-visible-string): Refactor calculation of the visual
text representation.  Inherit all the text properties - in particular,
composition.  Collect non-intersecting overlays into text properties.

Reported-by: Ypo <ypuntot@gmail.com>
Link: https://orgmode.org/list/87a605oyht.fsf@localhost
This commit is contained in:
Ihor Radchenko 2024-01-31 15:56:26 +01:00
parent c9ed0388e7
commit 5f22a1be40
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 19 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
lisp/org-table.el
View File

@ -467,16 +467,17 @@ prevents it from hanging Emacs."
This may be useful when columns have been shrunk." This may be useful when columns have been shrunk."
(save-excursion (save-excursion
(when pos (goto-char pos)) (when pos (goto-char pos))
(goto-char (line-beginning-position)) (let* ((beg (line-beginning-position))
(let ((end (line-end-position)) str) (end (line-end-position))
(goto-char (1- pos)) (str (buffer-substring beg end)))
(while (progn (forward-char 1) (< (point) end)) ;; FIXME: This does not handle intersecting overlays.
(let ((ov (car (overlays-at (point))))) (dolist (ov (overlays-in beg end))
(if (not ov) (when (overlay-get ov 'display)
(push (char-to-string (char-after)) str) (put-text-property
(push (overlay-get ov 'display) str) (- (overlay-start ov) beg) (- (overlay-end ov) beg)
(goto-char (1- (overlay-end ov)))))) 'display (overlay-get ov 'display)
(format "|%s" (mapconcat #'identity (reverse str) ""))))) str)))
str)))
(defvar-local org-table-header-overlay nil) (defvar-local org-table-header-overlay nil)
(put 'org-table-header-overlay 'permanent-local t) (put 'org-table-header-overlay 'permanent-local t)
@ -487,19 +488,24 @@ This may be useful when columns have been shrunk."
(progn (progn
(when (overlayp org-table-header-overlay) (when (overlayp org-table-header-overlay)
(delete-overlay org-table-header-overlay)) (delete-overlay org-table-header-overlay))
;; We might be called after scrolling but before display is
;; updated. Make sure that any queued redisplay is executed
;; before we look into `window-start'.
(redisplay)
(let* ((ws (window-start)) (let* ((ws (window-start))
(beg (save-excursion (beg (save-excursion
(goto-char (org-table-begin)) (goto-char (org-table-begin))
(while (or (org-at-table-hline-p) (while (or (org-at-table-hline-p)
(looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>")) (looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>"))
(move-beginning-of-line 2)) (move-beginning-of-line 2))
(line-beginning-position))) (line-beginning-position))))
(end (save-excursion (goto-char beg) (line-end-position))))
(if (pos-visible-in-window-p beg) (if (pos-visible-in-window-p beg)
(when (overlayp org-table-header-overlay) (when (overlayp org-table-header-overlay)
(delete-overlay org-table-header-overlay)) (delete-overlay org-table-header-overlay))
(setq org-table-header-overlay (setq org-table-header-overlay
(make-overlay ws (+ ws (- end beg)))) (make-overlay
(save-excursion (goto-char ws) (line-beginning-position))
(save-excursion (goto-char ws) (line-end-position))))
(org-overlay-display (org-overlay-display
org-table-header-overlay org-table-header-overlay
(org-table-row-get-visible-string beg) (org-table-row-get-visible-string beg)