Skip to content

Instantly share code, notes, and snippets.

@jdtsmith
Last active December 3, 2023 15:24
Show Gist options
  • Save jdtsmith/ad765047a6afe20f353de573d8c07da9 to your computer and use it in GitHub Desktop.
Save jdtsmith/ad765047a6afe20f353de573d8c07da9 to your computer and use it in GitHub Desktop.
Testing Emacs SVG layout positioning
;;; test-svg-wrapped --- test pixel position for SVG images -*- lexical-binding: t; -*-
;; This small code creates a buffer with a couple long lines with
;; several SVG images of varying height interspersed. It also
;; includes a tool to check if the pixel height information one pixel
;; above each character agrees with expectations. To use:
;; M-x my/test-svg-positions
;; (use a C-u prefix to create SVG overlays instead of text properties)
;;
;; A test buffer will be created; see svg-pixel-demo-report. Resize
;; the frame containing the text with images narrower and narrower, and
;; re-run the report from that buffer:
;;
;; M-x my/check-buffer-pixel-values
;;; Code:
(require 'svg)
(eval-when-compile (require 'cl-lib))
(defun my/check-buffer-pixel-values ()
(interactive)
(goto-char (point-min))
(let ((line-heights (vconcat (save-excursion
(cl-loop while (< (point) (point-max))
collect (line-pixel-height)
do (vertical-motion 1)))))
(line 0)
vmax)
(with-output-to-temp-buffer "svg-pixel-demo-report"
(princ (format "SVG Position analysis for %s (width %d, %s)\n\n"
(current-buffer) (window-width)
(if (next-single-property-change (point-min) 'display)
"text-properties" "overlays")))
(while (not (eobp))
(beginning-of-visual-line)
(vertical-motion 1)
(setq vmax (save-excursion (end-of-visual-line) (point)))
(save-excursion
(while (and (<= (point) vmax) (not (eobp)))
(let* ((ps (window-text-pixel-size nil (cons (point) -1)
(point) nil nil nil t))
(h (nth 1 ps)))
(unless (= h (aref line-heights line))
(princ
(format "Incorrect at point=%3d: line %2d at %12S (%5s): expected %2d got %2d\n"
(point) (+ line 2) (posn-x-y (posn-at-point))
(if (or (overlays-at (point))
(get-text-property (point) 'display))
"image"
(char-to-string (char-after (point))))
(aref line-heights line) h))))
(forward-char)))
(cl-incf line)))))
(defun my/test-svg-positions (arg)
(interactive "P")
(let ((buf "svg-pixel-demo")
(default-height (frame-char-height)))
(with-current-buffer (get-buffer-create buf)
(erase-buffer)
(insert "\nPellentesque condimentum, magna ut suscipit hendrerit, ipsum augue ornare nulla, non luctus diam neque sit amet urna.\nEtiam vel tortor sodales tellus ultricies commodo. Curabitur vulputate vestibulum lorem. Nam euismod tellus id erat.\n\nNullam tristique diam non turpis.\n")
(goto-char (point-min))
(cl-loop for i from 1
for p = (point) then (progn (forward-word) (point))
while (< p (point-max))
if (zerop (% i 5)) do
(let* ((word-start (save-excursion (backward-word) (point)))
(r0 (/ (float i) 11))
(r (round (* 10 (- r0 (floor r0))))) ; some psuedo-randoms
(r2 (round (* 10 (- (* r0 10) (floor (* r0 10))))))
(h (+ default-height (* 3 r2)))
(w (+ 142 (* 2 (round (expt (1+ r) 1.25)))))
(m (/ w 2))
(svg (svg-create w h)))
(svg-circle svg m m m
:fill-color (face-foreground 'default)
:stroke-width 3
:stroke-color (if (zerop (% i 2)) "green" "red"))
(if arg
(let ((ov (make-overlay word-start p)))
(overlay-put ov 'evaporate t)
(overlay-put ov 'display
(svg-image svg :ascent 'center)))
(put-text-property word-start p 'display
(svg-image svg :ascent 'center)))))
(pop-to-buffer buf)
(visual-line-mode 1)
(my/check-buffer-pixel-values))))
Display the source blob
Display the rendered blob
Raw
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
;;; test-svg-wrapped --- test pixel position for SVG images -*- lexical-binding: t; -*-
;; This small code creates a buffer with a couple long lines with
;; several SVG images of varying height interspersed. It also
;; includes a tool to check if the pixel height information one pixel
;; above each character agrees with expectations. To use:
;; M-x my/test-svg-positions
;; (use a C-u prefix to create SVG overlays instead of text properties)
;;
;; A test buffer will be created; see svg-pixel-demo-report. Resize
;; the frame containing the text with images narrower and narrower, and
;; re-run the report from that buffer:
;;
;; M-x my/check-buffer-pixel-values
;;; Code:
(require 'svg)
(eval-when-compile (require 'cl-lib))
(defun my/check-buffer-pixel-values ()
(interactive)
(goto-char (point-min))
(let ((line-heights (vconcat (save-excursion
(cl-loop while (< (point) (point-max))
collect (line-pixel-height)
do (vertical-motion 1)))))
(line 0)
vmax)
(with-output-to-temp-buffer "svg-pixel-demo-report"
(princ (format "SVG Position analysis for %s (width %d, %s)\n\n"
(current-buffer) (window-width)
(if (next-single-property-change (point-min) 'display)
"text-properties" "overlays")))
(while (not (eobp))
(beginning-of-visual-line)
(vertical-motion 1)
(setq vmax (save-excursion (end-of-visual-line) (point)))
(save-excursion
(while (and (<= (point) vmax) (not (eobp)))
(let* ((ps (window-text-pixel-size nil (cons (point) -1)
(point) nil nil nil t))
(h (nth 1 ps)))
(unless (= h (aref line-heights line))
(princ
(format "Incorrect at point=%3d: line %2d at %12S (%5s): expected %2d got %2d\n"
(point) (+ line 2) (posn-x-y (posn-at-point))
(if (or (overlays-at (point))
(get-text-property (point) 'display))
"image"
(char-to-string (char-after (point))))
(aref line-heights line) h))))
(forward-char)))
(cl-incf line)))))
(defun my/test-svg-positions (arg)
(interactive "P")
(let ((buf "svg-pixel-demo")
(default-height (frame-char-height)))
(with-current-buffer (get-buffer-create buf)
(erase-buffer)
(insert "\nPellentesque condimentum, magna ut suscipit hendrerit, ipsum augue ornare nulla, non luctus diam neque sit amet urna.\nEtiam vel tortor sodales tellus ultricies commodo. Curabitur vulputate vestibulum lorem. Nam euismod tellus id erat.\n\nNullam tristique diam non turpis.\n")
(goto-char (point-min))
(cl-loop for i from 1
for p = (point) then (progn (forward-word) (point))
while (< p (point-max))
if (zerop (% i 5)) do
(let* ((word-start (save-excursion (backward-word) (point)))
(r0 (/ (float i) 11))
(r (round (* 10 (- r0 (floor r0))))) ; some psuedo-randoms
(r2 (round (* 10 (- (* r0 10) (floor (* r0 10))))))
(h (+ default-height (* 3 r2)))
(w (+ 40 (* 2 (round (expt (1+ r) 1.25)))))
(m (/ w 2))
(svg (svg-create w h)))
(svg-circle svg m m m
:fill-color (face-foreground 'default)
:stroke-width 3
:stroke-color (if (zerop (% i 2)) "green" "red"))
(if arg
(let ((ov (make-overlay word-start p)))
(overlay-put ov 'evaporate t)
(overlay-put ov 'display
(svg-image svg :ascent 'center)))
(put-text-property word-start p 'display
(svg-image svg :ascent 'center)))))
(pop-to-buffer buf)
(visual-line-mode 1)
(my/check-buffer-pixel-values))))
@jdtsmith
Copy link
Author

jdtsmith commented Dec 3, 2023

See Emacs Bug#67533. Updated to create wider SVGs to trigger the "wider than 1/4 the default frame width" bug.

@jdtsmith
Copy link
Author

jdtsmith commented Dec 3, 2023

The patch Eli developed on 3 Dec fixes all the pixel computation issues I've experienced, even in a large/complex file with many images.

One final, perhaps related, issue remains with inline images and visual-line-mode: navigation (including vertical-motion and next/previous-line) gets confused by images on the first column, quite rarely.

Here's a short video of this happening, in which I invoke next-line repeatedly. You can see the short wrapped line pulvinar nibh. gets skipped with next-line, but not previous-line. The same is true with vertical-motion. I'm working on a reproduction for this rare navigation-with-inline-images bug, but it has been elusive.

svg_image_navigation_bug.mov

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment