Testing Emacs SVG layout positioning

bug67533_test_svg_file.el

;;; 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))))

svg_test.svg

test-svg-wrapped.el

;;; 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))))

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