From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 23 Jun 2024 21:53:49 +0000 (-0700)
Subject: In SHR, load from URL cache if possible when zooming images
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=cca57efc5f1d85a12d88531d04939013eb8d1f3f;p=emacs.git

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.

(cherry picked from commit f91387cce8f6f1dced427ad44686ffcc69574ef6)
---

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 8b62691bfb6..ea3d8deeff8 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -678,17 +678,22 @@ full-buffer size."
              (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 @@ the mouse click event."
 		    (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 @@ the mouse click event."
 		(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)