Subject: bug#71666: 30.0.50; [PATCH] Fix zooming images with SHR

From: Jim Porter <[email-masked]>
Date: Sun, 23 Jun 2024 15:24:47 -0700

On 6/22/2024 11:14 PM, Jim Porter wrote:
> I agree completely, and I'm working on a patch to that effect. :)
> 
> I think the problem you mention is a combination of some bugs I'm 
> working on fixing now, and like you say, 'shr-zoom-image' not providing 
> enough feedback about what's happening. It just says it's fetching the 
> image (this is also probably a bug; why fetch the image from the web 
> when we're just resizing it?).
> 
> Since I'm most of the way done with this additional patch, I'll leave 
> this bug open for now.

This ended up fairly complex, so I've split the patch into sub-parts to 
(I hope) make the changes easier to follow. There are four distinct, but 
related, improvements here:

1. Previously, SHR sliced images whenever you requested "original" zoom. 
But it would really be useful to slice images based on the size they'll 
be displayed at: a tiny image at "original" zoom doesn't need sliced, 
but a tall image at default zoom would benefit from slicing. So now SHR 
checks the height of the image to determine when to slice (you can also 
turn off slicing entirely, since you don't need it if you use 
'pixel-scroll-precision-mode').

2. When zooming, SHR lost track of the width and height of the image 
specified in the HTML like <img src="..." width="M" height="N">. I fixed 
that, and also cleaned up a bit of the code where we had a list that was 
simultaneously an alist and a plist (I converted it to a plist since 
more code used that form).

3. After much archaeology through old Gnus commits, I think I understand 
what each zoom level does, so I've fixed them. I've also added a new 
zoom level that zooms to the image's default size, ignoring HTML 
attributes. That's how the default and "full" zoom levels worked before 
my fix, so if someone wants the old behavior (I'd probably use it), 
there it is. I also made 'shr-zoom-image' display a message telling 
users the new zoom level.

4. Finally, every time you called 'shr-zoom-image', it would reload the 
image from the web. That shouldn't be necessary since there's a local 
cache. Now we use the cache when possible; easy enough.

From 9ccc5c3f5767cc4939869d1116d8fc650a817756 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Sun, 23 Jun 2024 12:18:57 -0700
Subject: [PATCH 1/4] Slice images based on their height in SHR, not their zoom
 level

* lisp/net/shr.el (shr-sliced-image-proportion): New option...
(shr-put-image): ... use it.  Compute the number of slices in relation
to the image height; this way, each slice is roughly the height of a
line of ordinary text.

* test/lisp/net/shr-tests.el (shr-test/zoom-image): Update test, since
zooming no longer necessarily triggers slicing.

* doc/misc/eww.texi (Advanced): Document 'shr-sliced-image-proportion'.

* etc/NEWS: Announce this change.
---
 doc/misc/eww.texi          |  9 +++++++++
 etc/NEWS                   | 11 +++++++++++
 lisp/net/shr.el            | 28 +++++++++++++++++++++++++---
 test/lisp/net/shr-tests.el | 15 ++++++---------
 4 files changed, 51 insertions(+), 12 deletions(-)

diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index eec6b3c3299..5ae10b3f7b7 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -373,6 +373,15 @@ Advanced
 @code{shr-inhibit-images}.  If this variable is @code{nil}, display
 the ``ALT'' text of images instead.
 
+@vindex shr-sliced-image-proportion
+  To make scrolling up/down past images more intuititve, EWW splits
+large images into several rows.  This way, you can scroll individually
+past each slice, instead of jumping past the entire image.  EWW slices
+images that take up more than @code{shr-sliced-image-proportion} of the
+height of the window they are displayed in.  For example, a value of 0.7
+means that images are allowed to take up 70% of the height of the window
+before being sliced.
+
 @vindex shr-color-visible-distance-min
 @vindex shr-color-visible-luminance-min
 @cindex Contrast
diff --git a/etc/NEWS b/etc/NEWS
index af32a93d9c4..3f4969da873 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -36,6 +36,17 @@ applies, and please also update docstrings as needed.
 
 * Changes in Specialized Modes and Packages in Emacs 31.1
 
+** SHR
+
++++
+*** SHR now slices large images into rows by default.
+Sliced images allow for more intuitive scrolling up/down by letting you
+scroll past each slice, instead of jumping past the entire image.
+Previously, SHR only sliced images when zoomed to their original size.
+You can set the maximum size for unsliced images with the option
+'shr-sliced-image-proportion'.  For more information, see the "(eww)
+Advanced" node in the EWW manual.
+
 
 * New Modes and Packages in Emacs 31.1
 
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 3dadcb9a09b..515768e035f 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -58,6 +58,20 @@ shr-max-image-proportion
   :version "24.1"
   :type 'float)
 
+(defcustom shr-sliced-image-proportion 0.3
+  "How tall images can be before slicing in relation to the window they're in.
+A value of 0.7 means that images are allowed to take up 70% of the
+height of the window before being sliced by `insert-sliced-image'.  If
+nil, never slice images.
+
+Sliced images allow for more intuitive scrolling up/down by letting you
+scroll past each slice, instead of jumping past the entire image.
+Alternately, you can use `pixel-scroll-precision-mode' to scroll
+pixel-wise past images, in which case you can set this option to nil."
+  :version "31.1"
+  :type '(choice (const :tag "Never slice images")
+                 float))
+
 (defcustom shr-allowed-images nil
   "If non-nil, only images that match this regexp are displayed.
 If nil, all URLs are allowed.  Also see `shr-blocked-images'."
@@ -1157,14 +1171,22 @@ shr-put-image
 	    (when (and (> (current-column) 0)
 		     (not inline))
 		(insert "\n"))
-	    (let ((image-pos (point)))
-	      (if (eq size 'original)
+	    (let ((image-pos (point))
+                  image-height body-height)
+	      (if (and shr-sliced-image-proportion
+                       (setq image-height (cdr (image-size image t))
+                             body-height (window-body-height
+                                          (get-buffer-window (current-buffer))
+                                          t))
+                       (> (/ image-height body-height 1.0)
+                          shr-sliced-image-proportion))
                   ;; 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)
+                    (insert-sliced-image
+                     image "*" nil (/ image-height (default-line-height)) 1)
                     (let ((overlay (make-overlay start (point))))
                       ;; Avoid displaying unsightly decorations on the
                       ;; image slices.
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index b6552674b27..701e73dc4fe 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -154,6 +154,7 @@ shr-test/zoom-image
                      (shr-width 80)
                      (shr-use-fonts nil)
                      (shr-image-animate nil)
+                     (shr-sliced-image-proportion nil)
                      (inhibit-message t)
                      (dom (libxml-parse-html-region (point-min) (point-max))))
             ;; Render the document.
@@ -164,19 +165,15 @@ shr-test/zoom-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))
+            ;; Check that we have a single image at original size.
+            (let (image-sizes)
               (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))
+                (when (get-text-property (point) 'display)
+                  (push (get-text-property (point) 'image-size) image-sizes))
                 (goto-char (or (next-single-property-change (point) 'display)
                                (point-max))))
-              ;; Make sure we actually saw a slice.
-              (should (> slice-count 1)))))))))
+              (should (equal image-sizes '(original))))))))))
 
 (require 'shr)
 
-- 
2.25.1

From f14c591efdedf312c0e1ed6527ba0fdd4593d26d Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Sun, 23 Jun 2024 12:25:25 -0700
Subject: [PATCH 2/4] In SHR, keep track of image sizes as specified by the
 HTML

Previously, these values got lost when zooming the image.

* lisp/net/shr.el (shr-tag-img): Set 'image-dom-size'...
(shr-zoom-image): ... use it.  Rename 'size' to 'zoom'.
(shr-image-fetched): Rename 'image-size' to 'image-zoom'.
(shr-put-image): Accept the zoom level as ':zoom' and document it.
Previously, FLAGS was a mix of alist and plist(!).

* test/lisp/net/shr-tests.el (shr-test/zoom-image): Rename "size" to
"zoom".
---
 lisp/net/shr.el            | 38 ++++++++++++++++++++++++++------------
 test/lisp/net/shr-tests.el |  6 +++---
 2 files changed, 29 insertions(+), 15 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 515768e035f..af871d7096e 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -633,13 +633,14 @@ shr-zoom-image
                       (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))
+             (dom-size (get-text-property (point) 'image-dom-size))
+             (zoom (get-text-property (point) 'image-zoom))
+             (next-zoom (cond ((or (eq zoom 'default)
+                                   (null zoom))
                                'original)
-                              ((eq size 'original)
+                              ((eq zoom 'original)
                                'full)
-                              ((eq size 'full)
+                              ((eq zoom 'full)
                                'default)))
              (buffer-read-only nil))
         ;; Delete the old picture.
@@ -648,7 +649,9 @@ shr-zoom-image
         (url-retrieve url #'shr-image-fetched
                       `(,(current-buffer) ,start
                         ,(set-marker (make-marker) end)
-                        ((size . ,next-size)))
+                        (:zoom   ,next-zoom
+                         :width  ,(car dom-size)
+                         :height ,(cdr dom-size)))
                       t)))))
 
 ;;; Utility functions.
@@ -1095,7 +1098,7 @@ shr-image-fetched
 		  (while properties
 		    (let ((type (pop properties))
 			  (value (pop properties)))
-		      (unless (memq type '(display image-size))
+		      (unless (memq type '(display image-zoom))
 			(put-text-property start (point) type value)))))))))))
     (kill-buffer image-buffer)))
 
@@ -1132,9 +1135,19 @@ shr--inline-image-p
 (defun shr-put-image (spec alt &optional flags)
   "Insert image SPEC with a string ALT.  Return image.
 SPEC is either an image data blob, or a list where the first
-element is the data blob and the second element is the content-type."
+element is the data blob and the second element is the content-type.
+
+FLAGS is a property list specifying optional parameters for the image.
+You can specify the following optional properties:
+
+* `:zoom': The zoom level for the image.  One of `default', `original',
+  or `full'.
+* `:width': The width of the image as specified by the HTML \"width\"
+  attribute.
+* `:height': The height of the image as specified by the HTML
+  \"height\" attribute."
   (if (display-graphic-p)
-      (let* ((size (cdr (assq 'size flags)))
+      (let* ((zoom (plist-get flags :zoom))
 	     (data (if (consp spec)
 		       (car spec)
 		     spec))
@@ -1142,13 +1155,13 @@ shr-put-image
 				(cadr spec)))
 	     (start (point))
 	     (image (cond
-		     ((eq size 'original)
+		     ((eq zoom 'original)
 		      (create-image data nil t :ascent shr-image-ascent
 				    :format content-type))
 		     ((eq content-type 'image/svg+xml)
                       (when (image-type-available-p 'svg)
 		        (create-image data 'svg t :ascent shr-image-ascent)))
-		     ((eq size 'full)
+		     ((eq zoom 'full)
 		      (ignore-errors
 			(shr-rescale-image data content-type
                                            (plist-get flags :width)
@@ -1192,7 +1205,7 @@ shr-put-image
                       ;; image slices.
                       (overlay-put overlay 'face 'shr-sliced-image)))
 		(insert-image image alt))
-	      (put-text-property start (point) 'image-size size)
+	      (put-text-property start (point) 'image-zoom zoom)
 	      (when (and (not inline) shr-max-inline-image-size)
 		(insert "\n"))
 	      (when (and shr-image-animate
@@ -1907,6 +1920,7 @@ shr-tag-img
 	  (put-text-property start (point) 'keymap shr-image-map)
 	  (put-text-property start (point) 'shr-alt alt)
 	  (put-text-property start (point) 'image-url url)
+	  (put-text-property start (point) 'image-dom-size (cons width height))
 	  (put-text-property start (point) 'image-displayer
 			     (shr-image-displayer shr-content-function))
 	  (put-text-property start (point) 'help-echo
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index 701e73dc4fe..542e940a4b9 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -166,14 +166,14 @@ shr-test/zoom-image
             (shr-zoom-image)
             (shr-test-wait-for (lambda () (= put-image-calls 2)))
             ;; Check that we have a single image at original size.
-            (let (image-sizes)
+            (let (image-zooms)
               (goto-char (point-min))
               (while (< (point) (point-max))
                 (when (get-text-property (point) 'display)
-                  (push (get-text-property (point) 'image-size) image-sizes))
+                  (push (get-text-property (point) 'image-zoom) image-zooms))
                 (goto-char (or (next-single-property-change (point) 'display)
                                (point-max))))
-              (should (equal image-sizes '(original))))))))))
+              (should (equal image-zooms '(original))))))))))
 
 (require 'shr)
 
-- 
2.25.1

From 0767dce5b931f653e1d742c1b1b7c2575c8d9e42 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Sun, 23 Jun 2024 14:48:32 -0700
Subject: [PATCH 3/4] Fix the different image zoom levels in SHR to work as
 expected

* lisp/net/shr.el (shr-image-zoom-levels): New option.
(shr-image-zoom-level-alist): New variable.
(shr-zoom-image): Take POSITION and ZOOM-LEVEL arguments.  Consult
'shr-image-zoom-levels'.
(shr-put-image): Use 'shr-image-zoom-level-alist'.
(shr-rescale-image): Only reset width *or* height when either is too
large.
(shr--image-zoom-original-size, shr--image-zoom-image-size)
(shr--image-zoom-fill-height): New functions.

* etc/NEWS: Announce this change.
---
 etc/NEWS        |   5 ++
 lisp/net/shr.el | 139 ++++++++++++++++++++++++++++++------------------
 2 files changed, 93 insertions(+), 51 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 3f4969da873..7bfb1379574 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -47,6 +47,11 @@ You can set the maximum size for unsliced images with the option
 'shr-sliced-image-proportion'.  For more information, see the "(eww)
 Advanced" node in the EWW manual.
 
+---
+*** You can now customize the image zoom levels to cycle through.
+By customizing 'shr-image-zoom-levels', you can change the list of zoom
+levels that SHR cycles through when calling 'shr-zoom-image'.
+
 
 * New Modes and Packages in Emacs 31.1
 
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index af871d7096e..59dd2c032ed 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -219,6 +219,25 @@ shr-max-inline-image-size
   :version "30.1"
   :type '(choice (const nil) (cons number number)))
 
+(defcustom shr-image-zoom-levels '(fit original fill-height)
+  "A list of image zoom levels to cycle through with `shr-zoom-image'.
+The first element in the list is the initial zoom level.  Each element
+can be one of the following symbols:
+
+* `fit': Display the image at its original size as requested by the
+  page, shrinking it to fit in the current window if necessary.
+* `original': Display the image at its original size as requested by the
+  page.
+* `image': Display the image at its full size (ignoring the width/height
+  specified by the HTML).
+* `fill-height': Display the image zoomed to fill the height of the
+current window."
+  :version "31.1"
+  :type '(set (choice (const :tag "Fit to window size" fit)
+                      (const :tag "Original size" original)
+                      (const :tag "Full image size" image)
+                      (const :tag "Fill window height" fill-height))))
+
 (defvar shr-content-function nil
   "If bound, this should be a function that will return the content.
 This is used for cid: URLs, and the function is called with the
@@ -621,35 +640,52 @@ shr-insert-image
 		    (list (current-buffer) (1- (point)) (point-marker))
 		    t))))
 
-(defun shr-zoom-image ()
-  "Cycle the image size.
+(defvar shr-image-zoom-level-alist
+  `((fit         "Zoom to fit"                shr-rescale-image)
+    (original    "Zoom to original size"      shr--image-zoom-original-size)
+    (image       "Zoom to full image size"    shr--image-zoom-image-size)
+    (fill-height "Zoom to fill window height" shr--image-zoom-fill-height))
+  "An alist of possible image zoom levels.
+Each element is of the form (SYMBOL DESC FUNCTION).  SYMBOL is the
+symbol identifying this level, as used by `shr-image-zoom-levels' (which
+see).  DESC is a string describing the level.
+
+FUNCTION is a function that returns a properly-zoomed image; it takes
+the following arguments:
+
+* DATA: The image data in string form.
+* CONTENT-TYPE: The content-type of the image, if any.
+* WIDTH: The width as specified by the HTML \"width\" attribute, if any.
+* HEIGHT: The height as specified by the HTML \"height\" attribute, if
+  any.")
+
+(defun shr-zoom-image (&optional position zoom-level)
+  "Change the zoom level of the image at POSITION.
+
 The size will cycle through the default size, the original size, and
 full-buffer size."
-  (interactive)
-  (let ((url (get-text-property (point) 'image-url)))
+  (interactive "d")
+  (unless position (setq position (point)))
+  (let ((url (get-text-property position 'image-url)))
     (if (not url)
 	(message "No image under point")
-      (let* ((end (or (next-single-property-change (point) 'image-url)
+      (unless zoom-level
+        (let ((last-zoom (get-text-property position 'image-zoom)))
+          (setq zoom-level (or (cadr (memq last-zoom shr-image-zoom-levels))
+                               (car shr-image-zoom-levels)))))
+      (let* ((end (or (next-single-property-change position 'image-url)
                       (point-max)))
              (start (or (previous-single-property-change end 'image-url)
                         (point-min)))
-             (dom-size (get-text-property (point) 'image-dom-size))
-             (zoom (get-text-property (point) 'image-zoom))
-             (next-zoom (cond ((or (eq zoom 'default)
-                                   (null zoom))
-                               'original)
-                              ((eq zoom 'original)
-                               'full)
-                              ((eq zoom 'full)
-                               'default)))
+             (dom-size (get-text-property position 'image-dom-size))
              (buffer-read-only nil))
         ;; Delete the old picture.
         (put-text-property start end 'display nil)
-        (message "Inserting %s..." url)
+        (message "%s" (cadr (assq zoom-level shr-image-zoom-level-alist)))
         (url-retrieve url #'shr-image-fetched
                       `(,(current-buffer) ,start
                         ,(set-marker (make-marker) end)
-                        (:zoom   ,next-zoom
+                        (:zoom   ,zoom-level
                          :width  ,(car dom-size)
                          :height ,(cdr dom-size)))
                       t)))))
@@ -1147,7 +1183,9 @@ shr-put-image
 * `:height': The height of the image as specified by the HTML
   \"height\" attribute."
   (if (display-graphic-p)
-      (let* ((zoom (plist-get flags :zoom))
+      (let* ((zoom (or (plist-get flags :zoom)
+                       (car shr-image-zoom-levels)))
+             (zoom-function (nth 2 (assq zoom shr-image-zoom-level-alist)))
 	     (data (if (consp spec)
 		       (car spec)
 		     spec))
@@ -1155,22 +1193,15 @@ shr-put-image
 				(cadr spec)))
 	     (start (point))
 	     (image (cond
-		     ((eq zoom 'original)
-		      (create-image data nil t :ascent shr-image-ascent
-				    :format content-type))
 		     ((eq content-type 'image/svg+xml)
                       (when (image-type-available-p 'svg)
 		        (create-image data 'svg t :ascent shr-image-ascent)))
-		     ((eq zoom 'full)
-		      (ignore-errors
-			(shr-rescale-image data content-type
-                                           (plist-get flags :width)
-                                           (plist-get flags :height))))
-		     (t
-		      (ignore-errors
-			(shr-rescale-image data content-type
-                                           (plist-get flags :width)
-                                           (plist-get flags :height)))))))
+                     (zoom-function
+                      (ignore-errors
+                        (funcall zoom-function data content-type
+                                 (plist-get flags :width)
+                                 (plist-get flags :height))))
+                     (t (error "Unrecognized zoom level %s" zoom)))))
         (when image
           ;; The trailing space can confuse shr-insert into not
           ;; putting any space after inline images.
@@ -1243,27 +1274,33 @@ shr-rescale-image
                                     (or max-height
                                         (- (nth 3 edges) (nth 1 edges))))))
            (scaling (image-compute-scaling-factor image-scaling-factor)))
-      (when (or (and width
-                     (> width max-width))
-                (and height
-                     (> height max-height)))
-        (setq width nil
-              height nil))
-      (if (and width height
-               (< (* width scaling) max-width)
-               (< (* height scaling) max-height))
-          (create-image
-           data (shr--image-type) t
-           :ascent shr-image-ascent
-           :width width
-           :height height
-           :format content-type)
-        (create-image
-         data (shr--image-type) t
-         :ascent shr-image-ascent
-         :max-width max-width
-         :max-height max-height
-         :format content-type)))))
+      (when (and width (> (* width scaling) max-width))
+        (setq width nil))
+      (when (and height (> (* height scaling) max-height))
+        (setq height nil))
+      (create-image
+       data (shr--image-type) t
+       :ascent shr-image-ascent
+       :width width
+       :height height
+       :max-width max-width
+       :max-height max-height
+       :format content-type))))
+
+(defun shr--image-zoom-original-size (data content-type width height)
+  (create-image data (shr--image-type) t :ascent shr-image-ascent
+                :width width :height height :format content-type))
+
+(defun shr--image-zoom-image-size (data content-type _width _height)
+  (create-image data nil t :ascent shr-image-ascent :format content-type))
+
+(defun shr--image-zoom-fill-height (data content-type _width _height)
+  (let* ((edges (window-inside-pixel-edges
+                 (get-buffer-window (current-buffer))))
+         (height (truncate (* shr-max-image-proportion
+                              (- (nth 3 edges) (nth 1 edges))))))
+    (create-image data (shr--image-type) t :ascent shr-image-ascent
+                  :height height :format content-type)))
 
 ;; url-cache-extract autoloads url-cache.
 (declare-function url-cache-create-filename "url-cache" (url))
-- 
2.25.1

From d35dd4ac07b46068fd306691c25544c4af7a34d0 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Sun, 23 Jun 2024 14:53:49 -0700
Subject: [PATCH 4/4] In SHR, load from URL cache if possible when zooming
 images

* lisp/net/shr.el (shr-replace-image): New function extracted from...
(shr-image-fetched): ... here.
(shr-zoom-image): Check URL cache and call 'shr-replace-image' if we
can.
---
 lisp/net/shr.el | 56 ++++++++++++++++++++++++++++---------------------
 1 file changed, 32 insertions(+), 24 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 59dd2c032ed..f01761874bf 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -678,17 +678,22 @@ shr-zoom-image
              (start (or (previous-single-property-change end 'image-url)
                         (point-min)))
              (dom-size (get-text-property position 'image-dom-size))
+             (flags `( :zoom   ,zoom-level
+                       :width  ,(car dom-size)
+                       :height ,(cdr dom-size)))
              (buffer-read-only nil))
         ;; Delete the old picture.
         (put-text-property start end 'display nil)
         (message "%s" (cadr (assq zoom-level shr-image-zoom-level-alist)))
-        (url-retrieve url #'shr-image-fetched
-                      `(,(current-buffer) ,start
-                        ,(set-marker (make-marker) end)
-                        (:zoom   ,zoom-level
-                         :width  ,(car dom-size)
-                         :height ,(cdr dom-size)))
-                      t)))))
+        (if (and (not shr-ignore-cache)
+                 (url-is-cached url))
+            (shr-replace-image (shr-get-image-data url) start
+                               (set-marker (make-marker) end) flags)
+          (url-retrieve url #'shr-image-fetched
+                        `(,(current-buffer) ,start
+                          ,(set-marker (make-marker) end)
+                          ,flags)
+                        t))))))
 
 ;;; Utility functions.
 
@@ -1109,6 +1114,25 @@ shr-store-contents
 		    (expand-file-name (file-name-nondirectory url)
 				      directory)))))
 
+(defun shr-replace-image (data start end &optional flags)
+  (save-excursion
+    (save-restriction
+      (widen)
+      (let ((alt (buffer-substring start end))
+	    (properties (text-properties-at start))
+            ;; 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)
+	(while properties
+	  (let ((type (pop properties))
+		(value (pop properties)))
+	    (unless (memq type '(display image-zoom))
+	      (put-text-property start (point) type value))))))))
+
 (defun shr-image-fetched (status buffer start end &optional flags)
   (let ((image-buffer (current-buffer)))
     (when (and (buffer-name buffer)
@@ -1119,23 +1143,7 @@ shr-image-fetched
 		(search-forward "\r\n\r\n" nil t))
 	(let ((data (shr-parse-image-data)))
 	  (with-current-buffer buffer
-	    (save-excursion
-	      (save-restriction
-		(widen)
-		(let ((alt (buffer-substring start end))
-		      (properties (text-properties-at start))
-                      ;; 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)
-		  (while properties
-		    (let ((type (pop properties))
-			  (value (pop properties)))
-		      (unless (memq type '(display image-zoom))
-			(put-text-property start (point) type value)))))))))))
+	    (shr-replace-image data start end flags)))))
     (kill-buffer image-buffer)))
 
 (defun shr-image-from-data (data)
-- 
2.25.1