Re: master 5f9b5803bea: Fix zooming images in SHR

[Eli Zaretskii]

> Date: Wed, 26 Jun 2024 08:58:29 -0700
> Cc: jm@pub.pink, emacs-devel@gnu.org
> From: Jim Porter <jporterbugs@gmail.com>
> 
> On 6/26/2024 6:49 AM, Eli Zaretskii wrote:
> >> Date: Tue, 25 Jun 2024 22:09:20 -0700
> >> Cc: jm@pub.pink, emacs-devel@gnu.org
> >> From: Jim Porter <jporterbugs@gmail.com>
> >>
> >> Hmm. What do you see if you try this patch? (Warning, it may print quite
> >> a bit since it'll dump the full buffer contents including properties.)
> > 
> > It doesn't apply, please resend as attachment.
> 
> Here you go.

Thanks.  The result:

Initial buffer contents:
#("*" 0 1 (help-echo #("*" 0 1 (shr-indentation nil)) image-displayer #[771 
"☻\2052 \302\303♦\"\203( \300\2052 \300♥\304\225\305O!\211\205' ☻b\210 
☺♦♦{\"\210`☻|\207\306♥\307p♣♣E\310\211%\207" [nil shr-put-image-function 
string-match "\\`cid:" 0 nil url-retrieve shr-image-fetched t] 9 
("d:/gnu/git/emacs/branch/lisp/net/shr.elc" . 34913)] image-url 
"file://d:/gnu/git/emacs/branch/test/data/image/blank-100x200.png" shr-alt "*" 
context-menu-functions (image-context-menu) keymap (keymap keymap (keymap (13 . 
shr-browse-url) (79 . shr-save-contents) (118 . shr-browse-url) (117 . 
shr-maybe-probe-and-copy-url) (119 . shr-maybe-probe-and-copy-url) (73 . 
shr-insert-image) (C-down-mouse-1 . shr-mouse-browse-url-new-window) (mouse-2 . 
shr-browse-url) (follow-link . mouse-face) (9 . shr-next-link) (122 . 
shr-zoom-image) (27 keymap (9 . shr-previous-link) (105 . shr-browse-image)) 
(97 . shr-show-alt-text)) keymap (105 keymap (118 . image-flip-vertically) (104 
. image-flip-horizontally) (114 . image-rotate)) keymap (C-mouse-4 . 
image-mouse-increase-size) (C-wheel-up . image-mouse-increase-size) (C-mouse-5 
. image-mouse-decrease-size) (C-wheel-down . image-mouse-decrease-size) (105 
keymap (120 . image-cut) (99 . image-crop) (111 . image-save) (43 . 
image-increase-size) (45 . image-decrease-size))) inhibit-isearch nil 
rear-nonsticky t display (image :type svg :data "<svg width=\"100\" 
height=\"100\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\"; 
xmlns:xlink=\"http://www.w3.org/1999/xlink\";> <defs> <linearGradient 
id=\"background\" x1=\"0\" x2=\"0\" y1=\"0\" y2=\"1\"> <stop offset=\"0%\" 
stop-color=\"#b0b0b0\"></stop> <stop offset=\"100%\" 
stop-color=\"#808080\"></stop></linearGradient></defs> <rect width=\"100\" 
height=\"100\" x=\"0\" y=\"0\" x1=\"0\" x2=\"0\" y1=\"0\" y2=\"1\" 
fill=\"url(#background)\" stroke=\"black\" stroke-width=\"2\"></rect></svg>" 
:scale 1 :transform-smoothing t :ascent 100)))

Test shr-test/zoom-image backtrace:
  signal(error ("Timed out waiting for initial load"))
  error("Timed out waiting for initial load")
  (progn (error message))
  (if (> (float-time (time-since start)) shr-test--max-wait-time) (pro
  (while (not (funcall predicate)) (if (> (float-time (time-since star
  (let ((start (current-time)) (message (or message "timed out waiting
  shr-test-wait-for(#f(lambda () [(put-image-calls 0)] (= put-image-ca
  (let ((dom (libxml-parse-html-region (point-min) (point-max)))) (era
  (let ((shr-image-animate nil)) (let ((dom (libxml-parse-html-region
  (let ((shr-use-fonts nil)) (let ((shr-image-animate nil)) (let ((dom
  (let ((shr-width 80)) (let ((shr-use-fonts nil)) (let ((shr-image-an
  (let ((shr-put-image-function #'(lambda (&rest args) (setq put-image
  (let ((put-image-calls 0)) (let ((shr-put-image-function #'(lambda (
  (progn (fset 'url-queue-retrieve vnew) (let ((put-image-calls 0)) (l
  (unwind-protect (progn (fset 'url-queue-retrieve vnew) (let ((put-im
  (let* ((vnew #'(lambda (&rest args) (apply #'run-at-time 0 nil #'url
  (progn (fset 'display-graphic-p #'always) (let* ((vnew #'(lambda (&r
  (unwind-protect (progn (fset 'display-graphic-p #'always) (let* ((vn
  (let* ((old (symbol-function 'display-graphic-p))) (unwind-protect (
  (let ((ert--infos (cons (cons "Info: " (format "image with alt=%S" a
  (progn (let ((ert--infos (cons (cons "Info: " (format "image with al
  (unwind-protect (progn (let ((ert--infos (cons (cons "Info: " (forma
  (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn
  (let ((temp-buffer (generate-new-buffer " *temp*" t))) (save-current
  (let ((alt (car tail))) (let ((temp-buffer (generate-new-buffer " *t
  (while tail (let ((alt (car tail))) (let ((temp-buffer (generate-new
  (let ((tail '(nil))) (while tail (let ((alt (car tail))) (let ((temp
  (let ((image (expand-file-name "data/image/blank-100x200.png" (geten
  #f(lambda () [t] (let ((value-60 (gensym "ert-form-evaluation-aborte
  #f(compiled-function () #<bytecode -0x7ebd847580e0a91>)()
  handler-bind-1(#f(compiled-function () #<bytecode -0x7ebd847580e0a91
  ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
  ert-run-test(#s(ert-test :name shr-test/zoom-image :documentation "T
  ert-run-or-rerun-test(#s(ert--stats :selector ... :tests ... :test-m
  ert-run-tests((not (or (tag :unstable) (tag :nativecomp))) #f(compil
  ert-run-tests-batch((not (or (tag :unstable) (tag :nativecomp))))
  ert-run-tests-batch-and-exit((not (or (tag :unstable) (tag :nativeco
  eval((ert-run-tests-batch-and-exit '(not (or (tag :unstable) (tag :n
  command-line-1(("-L" ";." "-l" "ert" "--eval" "(setq treesit-extra-l
  command-line()
  normal-top-level()
Test shr-test/zoom-image condition:
    Info: image with alt=nil
    (error "Timed out waiting for initial load")