* Re: master 5f9b5803bea: Fix zooming images in SHR
[not found] ` <20240623061407.0C6DDC1FB5C@vcs2.savannah.gnu.org>
@ 2024-06-23 14:36 ` john muhl
2024-06-23 18:42 ` Jim Porter
0 siblings, 1 reply; 14+ messages in thread
From: john muhl @ 2024-06-23 14:36 UTC (permalink / raw)
To: Jim Porter, emacs-devel
The zoom-image test added here fails on --without-x builds.
Running 4 tests (2024-06-23 08:17:31+0200, selector `(not (or (tag :expensive-test) (tag :unstable) (tag :nativecomp)))')
passed 1/4 rendering (0.009750 sec)
passed 2/4 shr-srcset (0.000130 sec)
Test shr-test/zoom-image backtrace:
signal(error ("timed out waiting for condition"))
error("timed out waiting for condition")
shr-test-wait-for(#f(compiled-function () #<bytecode 0x69f1ca74762a>
#f(compiled-function () #<bytecode 0x80079e00685ce6d>)()
#f(compiled-function () #<bytecode -0x1d8127e732d55024>)()
handler-bind-1(#f(compiled-function () #<bytecode -0x1d8127e732d5502
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 (not (or ... ... ...))
ert-run-tests((not (or (tag :expensive-test) (tag :unstable) (tag :n
ert-run-tests-batch((not (or (tag :expensive-test) (tag :unstable) (
ert-run-tests-batch-and-exit((not (or (tag :expensive-test) (tag :un
eval((ert-run-tests-batch-and-exit '(not (or (tag :expensive-test) (
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 condition")
FAILED 3/4 shr-test/zoom-image (5.130112 sec) at lisp/net/shr-tests.el:135
passed 4/4 use-cookies (0.020002 sec)
Ran 4 tests, 3 results as expected, 1 unexpected (2024-06-23 08:17:37+0200, 5.232000 sec)
1 unexpected results:
FAILED shr-test/zoom-image
On Sun, Jun 23, 2024, at 6:14 AM, Jim Porter wrote:
> branch: master
> commit 5f9b5803bea0f360a91e00cd85d72ea7f56d6095
> Author: Jim Porter <jporterbugs@gmail.com>
> Commit: Jim Porter <jporterbugs@gmail.com>
>
> Fix zooming images in SHR
>
> Previously, for images with no alt-text, the zoomed image wouldn't get
> properly inserted. For images with alt-text, both the zoomed and
> unzoomed image would be displayed at once (bug#71666).
>
> * lisp/net/shr.el (shr-sliced-image): New face.
> (shr-zoom-image): Reimplement using
> 'next/previous-single-property-change', and don't bother deleting any of
> the text.
> (shr-image-fetched): Clean up any overlays when deleting the old region.
> (shr-put-image): Ensure we always have a non-empty string to put the
> image on. For sliced images, just use "*", since we'll repeat it, so we
> can't preserve the original buffer text exactly anyway. Apply an
> overlay to sliced images to prevent unsightly text decorations.
> (shr-tag-img): Move the placeholder space insertion where it should be
> and explain what it's doing.
>
> * test/lisp/net/shr-tests.el (shr-test--max-wait-time)
> (shr-test-wait-for): New helper functions.
> (shr-test/zoom-image): New test.
> ---
> lisp/net/shr.el | 94 +++++++++++++++++++++++++---------------------
> test/lisp/net/shr-tests.el | 64 +++++++++++++++++++++++++++++++
> 2 files changed, 116 insertions(+), 42 deletions(-)
>
> diff --git a/lisp/net/shr.el b/lisp/net/shr.el
> index 14b3f7aa163..3dadcb9a09b 100644
> --- a/lisp/net/shr.el
> +++ b/lisp/net/shr.el
> @@ -282,6 +282,14 @@ temporarily blinks with this face."
> "Face used for <mark> elements."
> :version "29.1")
>
> +(defface shr-sliced-image
> + '((t :underline nil :overline nil))
> + "Face used for sliced images.
> +This face should remove any unsightly decorations from sliced images.
> +Otherwise, decorations like underlines from links would normally show on
> +every slice."
> + :version "30.1")
> +
> (defcustom shr-inhibit-images nil
> "If non-nil, inhibit loading images."
> :version "28.1"
> @@ -600,38 +608,34 @@ the URL of the image to the kill buffer instead."
> t))))
>
> (defun shr-zoom-image ()
> - "Toggle the image size.
> -The size will be rotated between the default size, the original
> -size, and full-buffer size."
> + "Cycle the image size.
> +The size will cycle through the default size, the original size, and
> +full-buffer size."
> (interactive)
> - (let ((url (get-text-property (point) 'image-url))
> - (size (get-text-property (point) 'image-size))
> - (buffer-read-only nil))
> + (let ((url (get-text-property (point) 'image-url)))
> (if (not url)
> (message "No image under point")
> - ;; Delete the old picture.
> - (while (get-text-property (point) 'image-url)
> - (forward-char -1))
> - (forward-char 1)
> - (let ((start (point)))
> - (while (get-text-property (point) 'image-url)
> - (forward-char 1))
> - (forward-char -1)
> - (put-text-property start (point) 'display nil)
> - (when (> (- (point) start) 2)
> - (delete-region start (1- (point)))))
> - (message "Inserting %s..." url)
> - (url-retrieve url #'shr-image-fetched
> - (list (current-buffer) (1- (point)) (point-marker)
> - (list (cons 'size
> - (cond ((or (eq size 'default)
> - (null size))
> - 'original)
> - ((eq size 'original)
> - 'full)
> - ((eq size 'full)
> - 'default)))))
> - t))))
> + (let* ((end (or (next-single-property-change (point) 'image-url)
> + (point-max)))
> + (start (or (previous-single-property-change end 'image-url)
> + (point-min)))
> + (size (get-text-property (point) 'image-size))
> + (next-size (cond ((or (eq size 'default)
> + (null size))
> + 'original)
> + ((eq size 'original)
> + 'full)
> + ((eq size 'full)
> + 'default)))
> + (buffer-read-only nil))
> + ;; Delete the old picture.
> + (put-text-property start end 'display nil)
> + (message "Inserting %s..." url)
> + (url-retrieve url #'shr-image-fetched
> + `(,(current-buffer) ,start
> + ,(set-marker (make-marker) end)
> + ((size . ,next-size)))
> + t)))))
>
> ;;; Utility functions.
>
> @@ -1070,6 +1074,7 @@ the mouse click event."
> ;; We don't want to record these changes.
> (buffer-undo-list t)
> (inhibit-read-only t))
> + (remove-overlays start end)
> (delete-region start end)
> (goto-char start)
> (funcall shr-put-image-function data alt flags)
> @@ -1144,7 +1149,8 @@ element is the data blob and the second element
> is the content-type."
> ;; putting any space after inline images.
> ;; ALT may be nil when visiting image URLs in eww
> ;; (bug#67764).
> - (setq alt (if alt (string-trim alt) "*"))
> + (setq alt (string-trim (or alt "")))
> + (when (length= alt 0) (setq alt "*"))
> ;; When inserting big-ish pictures, put them at the
> ;; beginning of the line.
> (let ((inline (shr--inline-image-p image)))
> @@ -1153,7 +1159,16 @@ element is the data blob and the second element
> is the content-type."
> (insert "\n"))
> (let ((image-pos (point)))
> (if (eq size 'original)
> - (insert-sliced-image image alt nil 20 1)
> + ;; Normally, we try to keep the buffer text the same
> + ;; by preserving ALT. With a sliced image, we have
> to
> + ;; repeat the text for each line, so we can't do
> that.
> + ;; Just use "*" for the string to insert instead.
> + (progn
> + (insert-sliced-image image "*" nil 20 1)
> + (let ((overlay (make-overlay start (point))))
> + ;; Avoid displaying unsightly decorations on the
> + ;; image slices.
> + (overlay-put overlay 'face 'shr-sliced-image)))
> (insert-image image alt))
> (put-text-property start (point) 'image-size size)
> (when (and (not inline) shr-max-inline-image-size)
> @@ -1854,17 +1869,12 @@ The preference is a float determined from
> `shr-prefer-media-type'."
> (let ((file (url-cache-create-filename url)))
> (when (file-exists-p file)
> (delete-file file))))
> - (when (image-type-available-p 'svg)
> - (insert-image
> - (shr-make-placeholder-image dom)
> - (or (string-trim alt) "")))
> - ;; Paradoxically this space causes shr not to insert spaces after
> - ;; inline images. Since the image is temporary it seem like there
> - ;; should be no downside to not inserting it but since I don't
> - ;; understand the code well and for the sake of backward
> compatibility
> - ;; we preserve it unless user has set `shr-max-inline-image-size'.
> - (unless shr-max-inline-image-size
> - (insert " "))
> + (if (image-type-available-p 'svg)
> + (insert-image
> + (shr-make-placeholder-image dom)
> + (or (string-trim alt) ""))
> + ;; No SVG support. Just use a space as our placeholder.
> + (insert " "))
> (url-queue-retrieve
> url #'shr-image-fetched
> (list (current-buffer) start (set-marker (make-marker) (point))
> diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
> index 17138053450..b6552674b27 100644
> --- a/test/lisp/net/shr-tests.el
> +++ b/test/lisp/net/shr-tests.el
> @@ -29,6 +29,22 @@
>
> (declare-function libxml-parse-html-region "xml.c")
>
> +(defvar shr-test--max-wait-time 5
> + "The maximum amount of time to wait for a condition to resolve, in seconds.
> +See `shr-test-wait-for'.")
> +
> +(defun shr-test-wait-for (predicate &optional message)
> + "Wait until PREDICATE returns non-nil.
> +If this takes longer than `shr-test--max-wait-time', raise an error.
> +MESSAGE is an optional message to use if this times out."
> + (let ((start (current-time))
> + (message (or message "timed out waiting for condition")))
> + (while (not (funcall predicate))
> + (when (> (float-time (time-since start))
> + shr-test--max-wait-time)
> + (error message))
> + (sit-for 0.1))))
> +
> (defun shr-test--rendering-check (name &optional context)
> "Render NAME.html and compare it to NAME.txt.
> Raise a test failure if the rendered buffer does not match NAME.txt.
> @@ -68,6 +84,8 @@ validate for the NAME testcase.
> The `rendering' testcase will test NAME once without altering any
> settings, then once more for each (OPTION . VALUE) pair.")
>
> +;;; Tests:
> +
> (ert-deftest rendering ()
> (skip-unless (fboundp 'libxml-parse-html-region))
> (dolist (file (directory-files (ert-resource-directory) nil
> "\\.html\\'"))
> @@ -114,6 +132,52 @@ settings, then once more for each (OPTION . VALUE)
> pair.")
> (should (equal (shr--parse-srcset "https://example.org/1,2\n\n 10w ,
> https://example.org/2 20w ")
> '(("https://example.org/2" 20) ("https://example.org/1,2"
> 10)))))
>
> +(ert-deftest shr-test/zoom-image ()
> + "Test that `shr-zoom-image' properly replaces the original image."
> + (let ((image (expand-file-name "data/image/blank-100x200.png"
> + (getenv "EMACS_TEST_DIRECTORY"))))
> + (dolist (alt '(nil "" "nothing to see here"))
> + (with-temp-buffer
> + (ert-info ((format "image with alt=%S" alt))
> + (let ((attrs (if alt (format " alt=\"%s\"" alt) "")))
> + (insert (format "<img src=\"file://%s\" %s" image attrs)))
> + (cl-letf* (;; Pretend we're a graphical display.
> + ((symbol-function 'display-graphic-p) #'always)
> + ((symbol-function 'url-queue-retrieve)
> + (lambda (&rest args)
> + (apply #'run-at-time 0 nil #'url-retrieve args)))
> + (put-image-calls 0)
> + (shr-put-image-function
> + (lambda (&rest args)
> + (cl-incf put-image-calls)
> + (apply #'shr-put-image args)))
> + (shr-width 80)
> + (shr-use-fonts nil)
> + (shr-image-animate nil)
> + (inhibit-message t)
> + (dom (libxml-parse-html-region (point-min) (point-max))))
> + ;; Render the document.
> + (erase-buffer)
> + (shr-insert-document dom)
> + (shr-test-wait-for (lambda () (= put-image-calls 1)))
> + ;; Now zoom the image.
> + (goto-char (point-min))
> + (shr-zoom-image)
> + (shr-test-wait-for (lambda () (= put-image-calls 2)))
> + ;; Check that we got a sliced image.
> + (let ((slice-count 0))
> + (goto-char (point-min))
> + (while (< (point) (point-max))
> + (when-let ((display (get-text-property (point) 'display)))
> + ;; If this is nil, we found a non-sliced image, but we
> + ;; should have replaced that!
> + (should (assq 'slice display))
> + (cl-incf slice-count))
> + (goto-char (or (next-single-property-change (point) 'display)
> + (point-max))))
> + ;; Make sure we actually saw a slice.
> + (should (> slice-count 1)))))))))
> +
> (require 'shr)
>
> ;;; shr-tests.el ends here
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-23 14:36 ` master 5f9b5803bea: Fix zooming images in SHR john muhl
@ 2024-06-23 18:42 ` Jim Porter
2024-06-23 19:23 ` Eli Zaretskii
0 siblings, 1 reply; 14+ messages in thread
From: Jim Porter @ 2024-06-23 18:42 UTC (permalink / raw)
To: john muhl, emacs-devel
On 6/23/2024 7:36 AM, john muhl wrote:
> The zoom-image test added here fails on --without-x builds.
Thanks for noticing this. Fixed on the release branch with 6619aec6bca.
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-23 18:42 ` Jim Porter
@ 2024-06-23 19:23 ` Eli Zaretskii
2024-06-23 22:13 ` Jim Porter
0 siblings, 1 reply; 14+ messages in thread
From: Eli Zaretskii @ 2024-06-23 19:23 UTC (permalink / raw)
To: Jim Porter; +Cc: jm, emacs-devel
> Date: Sun, 23 Jun 2024 11:42:53 -0700
> From: Jim Porter <jporterbugs@gmail.com>
>
> On 6/23/2024 7:36 AM, john muhl wrote:
> > The zoom-image test added here fails on --without-x builds.
>
> Thanks for noticing this. Fixed on the release branch with 6619aec6bca.
Thanks, but the test fails for me on MS-Windows:
Test shr-test/zoom-image condition:
Info: image with alt=nil
(error "timed out waiting for condition")
FAILED 3/4 shr-test/zoom-image (5.053704 sec) at lisp/net/shr-tests.el:136
(The other test failed as well, but I fixed it.)
Frankly, I have no idea why it fails, because I only vaguely
understand the idea of the test. Feel free to ask questions or
suggests what to test.
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-23 19:23 ` Eli Zaretskii
@ 2024-06-23 22:13 ` Jim Porter
2024-06-24 11:51 ` Eli Zaretskii
0 siblings, 1 reply; 14+ messages in thread
From: Jim Porter @ 2024-06-23 22:13 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: jm, emacs-devel
On 6/23/2024 12:23 PM, Eli Zaretskii wrote:
> Thanks, but the test fails for me on MS-Windows:
>
> Test shr-test/zoom-image condition:
> Info: image with alt=nil
> (error "timed out waiting for condition")
> FAILED 3/4 shr-test/zoom-image (5.053704 sec) at lisp/net/shr-tests.el:136
>
> (The other test failed as well, but I fixed it.)
>
> Frankly, I have no idea why it fails, because I only vaguely
> understand the idea of the test. Feel free to ask questions or
> suggests what to test.
Could you try commenting out the "(inhibit-message t)" line in the test
and rerunning it? My guess is that on MS-Windows, something goes wrong
when inserting the image into the buffer, so 'shr-zoom-image' can't find
the image. (For reasons I'm not sure about, when 'shr-zoom-image' fails
to find an image, it just prints a message instead of signaling an error.)
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-23 22:13 ` Jim Porter
@ 2024-06-24 11:51 ` Eli Zaretskii
2024-06-26 5:09 ` Jim Porter
0 siblings, 1 reply; 14+ messages in thread
From: Eli Zaretskii @ 2024-06-24 11:51 UTC (permalink / raw)
To: Jim Porter; +Cc: jm, emacs-devel
> Date: Sun, 23 Jun 2024 15:13:36 -0700
> Cc: jm@pub.pink, emacs-devel@gnu.org
> From: Jim Porter <jporterbugs@gmail.com>
>
> On 6/23/2024 12:23 PM, Eli Zaretskii wrote:
> > Thanks, but the test fails for me on MS-Windows:
> >
> > Test shr-test/zoom-image condition:
> > Info: image with alt=nil
> > (error "timed out waiting for condition")
> > FAILED 3/4 shr-test/zoom-image (5.053704 sec) at lisp/net/shr-tests.el:136
> >
> > (The other test failed as well, but I fixed it.)
> >
> > Frankly, I have no idea why it fails, because I only vaguely
> > understand the idea of the test. Feel free to ask questions or
> > suggests what to test.
>
> Could you try commenting out the "(inhibit-message t)" line in the test
> and rerunning it? My guess is that on MS-Windows, something goes wrong
> when inserting the image into the buffer, so 'shr-zoom-image' can't find
> the image. (For reasons I'm not sure about, when 'shr-zoom-image' fails
> to find an image, it just prints a message instead of signaling an error.)
I don't see any additional info when I delete that line, but maybe I'm
missing something. Here:
passed 1/4 rendering (0.020026 sec)
passed 2/4 shr-srcset (0.000348 sec)
Test shr-test/zoom-image backtrace:
signal(error ("timed out waiting for condition"))
error("timed out waiting for condition")
(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 "" "nothing to see here"))) (while tail (let ((alt
(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 -0x118f7354823f30c9>)()
handler-bind-1(#f(compiled-function () #<bytecode -0x118f7354823f30c
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 condition")
FAILED 3/4 shr-test/zoom-image (5.186791 sec) at lisp/net/shr-tests.el:136
passed 4/4 use-cookies (0.035256 sec)
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-24 11:51 ` Eli Zaretskii
@ 2024-06-26 5:09 ` Jim Porter
2024-06-26 13:49 ` Eli Zaretskii
0 siblings, 1 reply; 14+ messages in thread
From: Jim Porter @ 2024-06-26 5:09 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: jm, emacs-devel
On 6/24/2024 4:51 AM, Eli Zaretskii wrote:
> I don't see any additional info when I delete that line, but maybe I'm
> missing something.
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.)
----------------------------------------
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index 4864fc488e2..c4c861bf958 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -138,7 +138,8 @@ shr-test/zoom-image
(skip-unless (bound-and-true-p image-types))
(let ((image (expand-file-name "data/image/blank-100x200.png"
(getenv "EMACS_TEST_DIRECTORY"))))
- (dolist (alt '(nil "" "nothing to see here"))
+ (dolist (alt '(nil ;; "" "nothing to see here"
+ ))
(with-temp-buffer
(ert-info ((format "image with alt=%S" alt))
(let ((attrs (if alt (format " alt=\"%s\"" alt) "")))
@@ -156,16 +157,21 @@ shr-test/zoom-image
(shr-width 80)
(shr-use-fonts nil)
(shr-image-animate nil)
- (inhibit-message t)
+ ;; (inhibit-message t)
(dom (libxml-parse-html-region (point-min)
(point-max))))
;; Render the document.
(erase-buffer)
(shr-insert-document dom)
- (shr-test-wait-for (lambda () (= put-image-calls 1)))
+ (message "Initial buffer contents:\n%S\n\n" (buffer-string))
+ (shr-test-wait-for (lambda () (= put-image-calls 1))
+ "Timed out waiting for initial load")
+ (message "Fully-loaded buffer contents:\n%S\n\n"
(buffer-string))
;; Now zoom the image.
(goto-char (point-min))
(shr-zoom-image)
- (shr-test-wait-for (lambda () (= put-image-calls 2)))
+ (shr-test-wait-for (lambda () (= put-image-calls 2))
+ "Timed out waiting to zoom image")
+ (message "Final buffer contents:\n%S\n\n" (buffer-string))
;; Check that we got a sliced image.
(let ((slice-count 0))
(goto-char (point-min))
^ permalink raw reply related [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-26 5:09 ` Jim Porter
@ 2024-06-26 13:49 ` Eli Zaretskii
2024-06-26 15:58 ` Jim Porter
0 siblings, 1 reply; 14+ messages in thread
From: Eli Zaretskii @ 2024-06-26 13:49 UTC (permalink / raw)
To: Jim Porter; +Cc: jm, emacs-devel
> Date: Tue, 25 Jun 2024 22:09:20 -0700
> Cc: jm@pub.pink, emacs-devel@gnu.org
> From: Jim Porter <jporterbugs@gmail.com>
>
> On 6/24/2024 4:51 AM, Eli Zaretskii wrote:
> > I don't see any additional info when I delete that line, but maybe I'm
> > missing something.
>
> 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.
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-26 13:49 ` Eli Zaretskii
@ 2024-06-26 15:58 ` Jim Porter
2024-06-26 16:04 ` Eli Zaretskii
0 siblings, 1 reply; 14+ messages in thread
From: Jim Porter @ 2024-06-26 15:58 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: jm, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 387 bytes --]
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.
[-- Attachment #2: shr-test.diff --]
[-- Type: text/plain, Size: 1963 bytes --]
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index 4864fc488e2..c4c861bf958 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -138,7 +138,8 @@ shr-test/zoom-image
(skip-unless (bound-and-true-p image-types))
(let ((image (expand-file-name "data/image/blank-100x200.png"
(getenv "EMACS_TEST_DIRECTORY"))))
- (dolist (alt '(nil "" "nothing to see here"))
+ (dolist (alt '(nil ;; "" "nothing to see here"
+ ))
(with-temp-buffer
(ert-info ((format "image with alt=%S" alt))
(let ((attrs (if alt (format " alt=\"%s\"" alt) "")))
@@ -156,16 +157,21 @@ shr-test/zoom-image
(shr-width 80)
(shr-use-fonts nil)
(shr-image-animate nil)
- (inhibit-message t)
+ ;; (inhibit-message t)
(dom (libxml-parse-html-region (point-min) (point-max))))
;; Render the document.
(erase-buffer)
(shr-insert-document dom)
- (shr-test-wait-for (lambda () (= put-image-calls 1)))
+ (message "Initial buffer contents:\n%S\n\n" (buffer-string))
+ (shr-test-wait-for (lambda () (= put-image-calls 1))
+ "Timed out waiting for initial load")
+ (message "Fully-loaded buffer contents:\n%S\n\n" (buffer-string))
;; Now zoom the image.
(goto-char (point-min))
(shr-zoom-image)
- (shr-test-wait-for (lambda () (= put-image-calls 2)))
+ (shr-test-wait-for (lambda () (= put-image-calls 2))
+ "Timed out waiting to zoom image")
+ (message "Final buffer contents:\n%S\n\n" (buffer-string))
;; Check that we got a sliced image.
(let ((slice-count 0))
(goto-char (point-min))
^ permalink raw reply related [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-26 15:58 ` Jim Porter
@ 2024-06-26 16:04 ` Eli Zaretskii
2024-06-28 3:51 ` Jim Porter
0 siblings, 1 reply; 14+ messages in thread
From: Eli Zaretskii @ 2024-06-26 16:04 UTC (permalink / raw)
To: Jim Porter; +Cc: jm, emacs-devel
> 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")
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-26 16:04 ` Eli Zaretskii
@ 2024-06-28 3:51 ` Jim Porter
2024-06-28 12:04 ` Eli Zaretskii
0 siblings, 1 reply; 14+ messages in thread
From: Jim Porter @ 2024-06-28 3:51 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: jm, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 552 bytes --]
On 6/26/2024 9:04 AM, Eli Zaretskii wrote:
>> Date: Wed, 26 Jun 2024 08:58:29 -0700
>> Cc: jm@pub.pink, emacs-devel@gnu.org
>> From: Jim Porter <jporterbugs@gmail.com>
>>
>> Here you go.
>
> Thanks. The result:
[snip]
> (error "Timed out waiting for initial load")
Odd. It never loaded the first image (we just got the placeholder).
Here's a patch with some additional trace statements. (I'd also be ok
with just disabling these tests on MS-Windows if we can't figure out
what's happening, though I'm not aware of any reason it should fail.)
[-- Attachment #2: shr-test.diff --]
[-- Type: text/plain, Size: 3220 bytes --]
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 3dadcb9a09b..4959001d656 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1057,6 +1057,7 @@ shr-store-contents
directory)))))
(defun shr-image-fetched (status buffer start end &optional flags)
+ (message "shr-image-fetched: status = %S" status)
(let ((image-buffer (current-buffer)))
(when (and (buffer-name buffer)
(not (plist-get status :error)))
@@ -1875,6 +1876,7 @@ shr-tag-img
(or (string-trim alt) ""))
;; No SVG support. Just use a space as our placeholder.
(insert " "))
+ (message "shr-img-tag: calling `url-queue-retrieve'")
(url-queue-retrieve
url #'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (point))
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index 4864fc488e2..f4fbe8de68b 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -138,7 +138,8 @@ shr-test/zoom-image
(skip-unless (bound-and-true-p image-types))
(let ((image (expand-file-name "data/image/blank-100x200.png"
(getenv "EMACS_TEST_DIRECTORY"))))
- (dolist (alt '(nil "" "nothing to see here"))
+ (dolist (alt '(nil ;; "" "nothing to see here"
+ ))
(with-temp-buffer
(ert-info ((format "image with alt=%S" alt))
(let ((attrs (if alt (format " alt=\"%s\"" alt) "")))
@@ -147,6 +148,7 @@ shr-test/zoom-image
((symbol-function 'display-graphic-p) #'always)
((symbol-function 'url-queue-retrieve)
(lambda (&rest args)
+ (message "calling fake `url-queue-retrieve'")
(apply #'run-at-time 0 nil #'url-retrieve args)))
(put-image-calls 0)
(shr-put-image-function
@@ -156,16 +158,21 @@ shr-test/zoom-image
(shr-width 80)
(shr-use-fonts nil)
(shr-image-animate nil)
- (inhibit-message t)
+ ;; (inhibit-message t)
(dom (libxml-parse-html-region (point-min) (point-max))))
;; Render the document.
(erase-buffer)
(shr-insert-document dom)
- (shr-test-wait-for (lambda () (= put-image-calls 1)))
+ (message "Initial buffer contents:\n%S\n\n" (buffer-string))
+ (shr-test-wait-for (lambda () (= put-image-calls 1))
+ "Timed out waiting for initial load")
+ (message "Fully-loaded buffer contents:\n%S\n\n" (buffer-string))
;; Now zoom the image.
(goto-char (point-min))
(shr-zoom-image)
- (shr-test-wait-for (lambda () (= put-image-calls 2)))
+ (shr-test-wait-for (lambda () (= put-image-calls 2))
+ "Timed out waiting to zoom image")
+ (message "Final buffer contents:\n%S\n\n" (buffer-string))
;; Check that we got a sliced image.
(let ((slice-count 0))
(goto-char (point-min))
^ permalink raw reply related [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-28 3:51 ` Jim Porter
@ 2024-06-28 12:04 ` Eli Zaretskii
2024-06-28 17:46 ` Jim Porter
0 siblings, 1 reply; 14+ messages in thread
From: Eli Zaretskii @ 2024-06-28 12:04 UTC (permalink / raw)
To: Jim Porter; +Cc: jm, emacs-devel
> Date: Thu, 27 Jun 2024 20:51:58 -0700
> Cc: jm@pub.pink, emacs-devel@gnu.org
> From: Jim Porter <jporterbugs@gmail.com>
>
> On 6/26/2024 9:04 AM, Eli Zaretskii wrote:
> >> Date: Wed, 26 Jun 2024 08:58:29 -0700
> >> Cc: jm@pub.pink, emacs-devel@gnu.org
> >> From: Jim Porter <jporterbugs@gmail.com>
> >>
> >> Here you go.
> >
> > Thanks. The result:
> [snip]
> > (error "Timed out waiting for initial load")
>
> Odd. It never loaded the first image (we just got the placeholder).
> Here's a patch with some additional trace statements.
Thanks, output below.
> (I'd also be ok with just disabling these tests on MS-Windows if we
> can't figure out what's happening, though I'm not aware of any
> reason it should fail.)
I'd prefer to defer the decision about skipping until we fully
understand what happens here. If the output below doesn't give a
clue, could you perhaps explain to me the idea of this test in more
detail, so I could perhaps also think about the reasons?
Here's the output of running the test
passed 2/4 shr-srcset (0.000304 sec)
shr-img-tag: calling `url-queue-retrieve'
calling fake `url-queue-retrieve'
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" . 34970)] 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) (message "calling fake `url-queu
(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 -0x53fead528cc66be>)()
handler-bind-1(#f(compiled-function () #<bytecode -0x53fead528cc66be
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")
FAILED 3/4 shr-test/zoom-image (5.092988 sec) at lisp/net/shr-tests.el:136
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-28 12:04 ` Eli Zaretskii
@ 2024-06-28 17:46 ` Jim Porter
2024-06-29 11:09 ` Eli Zaretskii
0 siblings, 1 reply; 14+ messages in thread
From: Jim Porter @ 2024-06-28 17:46 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: jm, emacs-devel
[-- Attachment #1: Type: text/plain, Size: 1157 bytes --]
On 6/28/2024 5:04 AM, Eli Zaretskii wrote:
> I'd prefer to defer the decision about skipping until we fully
> understand what happens here. If the output below doesn't give a
> clue, could you perhaps explain to me the idea of this test in more
> detail, so I could perhaps also think about the reasons?
I had a sudden realization about what the problem might be. I *think*
this patch should resolve the issue. Could you try it?
The issue (I believe) is that on MS-Windows, the "file:" URL to the
image we're trying to load wasn't formatted correctly. That meant that
'url-retrieve' never successfully loaded the image, so the test stalled.
If that *doesn't* fix the issue, here's a quick summary of what the test
is doing:
1. Load a simple HTML page with an image (using one from the test directory)
2. Wait for SHR to insert the real image, which happens asynchronously.
3. Put point on the image and call 'shr-zoom-image'.
4. Wait for SHR to insert the updated image.
5. Check that we have a new (sliced) image in the buffer.
(The test repeats the above steps for a few different cases, each with
different values of the HTML "alt" attribute.)
[-- Attachment #2: 0001-Fix-SHR-test-on-MS-Windows.patch --]
[-- Type: text/plain, Size: 1747 bytes --]
From 50301f502c7e32efe34ca3db3bf0c1c64ccd5df8 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Fri, 28 Jun 2024 10:40:05 -0700
Subject: [PATCH] ; Fix SHR test on MS-Windows
* test/lisp/net/shr-tests.el (shr-test/zoom-image): Ensure the image URL
is properly formatted: it should always have 3 slashes after "file:".
---
test/lisp/net/shr-tests.el | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index 4864fc488e2..1f8dcd57cbe 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -136,13 +136,15 @@ shr-srcset
(ert-deftest shr-test/zoom-image ()
"Test that `shr-zoom-image' properly replaces the original image."
(skip-unless (bound-and-true-p image-types))
- (let ((image (expand-file-name "data/image/blank-100x200.png"
- (getenv "EMACS_TEST_DIRECTORY"))))
+ (let* ((image (expand-file-name "data/image/blank-100x200.png"
+ (getenv "EMACS_TEST_DIRECTORY")))
+ (image-url (concat "file://" (if (string-prefix-p "/" image)
+ image (concat "/" image)))))
(dolist (alt '(nil "" "nothing to see here"))
(with-temp-buffer
(ert-info ((format "image with alt=%S" alt))
(let ((attrs (if alt (format " alt=\"%s\"" alt) "")))
- (insert (format "<img src=\"file://%s\" %s" image attrs)))
+ (insert (format "<img src=\"%s\" %s" image-url attrs)))
(cl-letf* (;; Pretend we're a graphical display.
((symbol-function 'display-graphic-p) #'always)
((symbol-function 'url-queue-retrieve)
--
2.25.1
^ permalink raw reply related [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-28 17:46 ` Jim Porter
@ 2024-06-29 11:09 ` Eli Zaretskii
2024-06-29 22:00 ` Jim Porter
0 siblings, 1 reply; 14+ messages in thread
From: Eli Zaretskii @ 2024-06-29 11:09 UTC (permalink / raw)
To: Jim Porter; +Cc: jm, emacs-devel
> Date: Fri, 28 Jun 2024 10:46:14 -0700
> Cc: jm@pub.pink, emacs-devel@gnu.org
> From: Jim Porter <jporterbugs@gmail.com>
>
> On 6/28/2024 5:04 AM, Eli Zaretskii wrote:
> > I'd prefer to defer the decision about skipping until we fully
> > understand what happens here. If the output below doesn't give a
> > clue, could you perhaps explain to me the idea of this test in more
> > detail, so I could perhaps also think about the reasons?
>
> I had a sudden realization about what the problem might be. I *think*
> this patch should resolve the issue. Could you try it?
>
> The issue (I believe) is that on MS-Windows, the "file:" URL to the
> image we're trying to load wasn't formatted correctly. That meant that
> 'url-retrieve' never successfully loaded the image, so the test stalled.
Thanks, this works. It is strange, though, because the first thing I
tried, before reporting this problem, was to fix that file:// URL for
Windows file names, and it didn't help. But maybe I made some mistake
when testing the fix. Anyway, this is evidently the right fix.
^ permalink raw reply [flat|nested] 14+ messages in thread
* Re: master 5f9b5803bea: Fix zooming images in SHR
2024-06-29 11:09 ` Eli Zaretskii
@ 2024-06-29 22:00 ` Jim Porter
0 siblings, 0 replies; 14+ messages in thread
From: Jim Porter @ 2024-06-29 22:00 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: jm, emacs-devel
On 6/29/2024 4:09 AM, Eli Zaretskii wrote:
> Thanks, this works. It is strange, though, because the first thing I
> tried, before reporting this problem, was to fix that file:// URL for
> Windows file names, and it didn't help. But maybe I made some mistake
> when testing the fix. Anyway, this is evidently the right fix.
Thanks for testing. Pushed to the release branch as eaf2dc96c1f.
^ permalink raw reply [flat|nested] 14+ messages in thread
end of thread, other threads:[~2024-06-29 22:00 UTC | newest]
Thread overview: 14+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
[not found] <171912324641.7384.11296304660836747605@vcs2.savannah.gnu.org>
[not found] ` <20240623061407.0C6DDC1FB5C@vcs2.savannah.gnu.org>
2024-06-23 14:36 ` master 5f9b5803bea: Fix zooming images in SHR john muhl
2024-06-23 18:42 ` Jim Porter
2024-06-23 19:23 ` Eli Zaretskii
2024-06-23 22:13 ` Jim Porter
2024-06-24 11:51 ` Eli Zaretskii
2024-06-26 5:09 ` Jim Porter
2024-06-26 13:49 ` Eli Zaretskii
2024-06-26 15:58 ` Jim Porter
2024-06-26 16:04 ` Eli Zaretskii
2024-06-28 3:51 ` Jim Porter
2024-06-28 12:04 ` Eli Zaretskii
2024-06-28 17:46 ` Jim Porter
2024-06-29 11:09 ` Eli Zaretskii
2024-06-29 22:00 ` Jim Porter
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).