[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 6d082f3c792 2/4: In SHR, keep track of image sizes as specified b
From: |
Jim Porter |
Subject: |
master 6d082f3c792 2/4: In SHR, keep track of image sizes as specified by the HTML |
Date: |
Thu, 4 Jul 2024 15:17:28 -0400 (EDT) |
branch: master
commit 6d082f3c79269f00308d6e8b7d31d6a119376fe2
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>
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 fe061adae29..7e9a8c6d1c0 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -633,13 +633,14 @@ full-buffer size."
(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 @@ full-buffer size."
(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 @@ the mouse click event."
(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 @@ the mouse click event."
(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 @@ element is the data blob and the second element is the
content-type."
(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 @@ element is the data blob and the second element is the
content-type."
;; 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 @@ The preference is a float determined from
`shr-prefer-media-type'."
(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 c813103b408..f8559df5272 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -172,14 +172,14 @@ settings, then once more for each (OPTION . VALUE) pair.")
(shr-test-wait-for (lambda () (= put-image-calls 2))
"Timed out waiting to zoom image")
;; 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)
- master updated (fa6f088a483 -> f91387cce8f), Jim Porter, 2024/07/04
- master 3ce7e4ee3f1 1/4: Slice images based on their height in SHR, not their zoom level, Jim Porter, 2024/07/04
- master 208207c1c07 3/4: Fix the different image zoom levels in SHR to work as expected, Jim Porter, 2024/07/04
- master 6d082f3c792 2/4: In SHR, keep track of image sizes as specified by the HTML,
Jim Porter <=
- master f91387cce8f 4/4: In SHR, load from URL cache if possible when zooming images, Jim Porter, 2024/07/04