commit 1ba50a0d8cbef6686ecf752583832e7bbb9137ef (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Sat Feb 20 18:48:40 2016 +1100 Add a frame around the placeholder image in shr * lisp/net/shr.el (shr-make-placeholder-image): Add a frame around the image. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 78862b3..6352d38 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1548,7 +1548,8 @@ The preference is a float determined from `shr-prefer-media-type'." height max-height)) (setq svg (svg-create width height)) (svg-gradient svg "background" 'linear '((0 . "#b0b0b0") (100 . "#808080"))) - (svg-rectangle svg 0 0 width height :gradient "background") + (svg-rectangle svg 0 0 width height :gradient "background" + :stroke-width 2 :stroke-color "black") (let ((image (svg-image svg))) (image-set-property image :ascent 100)))) commit 80852f843e69b81618f29cfb9aa4b074946cb3c4 Author: Lars Ingebrigtsen Date: Sat Feb 20 18:01:52 2016 +1100 Use placeholder images in shr to avoid text moving around * lisp/net/shr.el (shr-rescale-image): Pass in width/height from the HTML. (shr-tag-img): Ditto. (shr-string-number): New function. (shr-make-placeholder-image): Make placeholder images. (shr-tag-img): Insert them if we have SVG support. diff --git a/etc/NEWS b/etc/NEWS index 95ca8d3..33c1b13 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -779,6 +779,13 @@ textual parts of a web page and display only that, leaving menus and the like off the page. --- +*** Images that are being loaded are now marked with grey +"placeholder" images of the size specified by the HTML. They are then +replaced by the real images asynchronously, which will also now +respect width/height HTML specs (unless they specify widths/heights +bigger than the current window). + +--- *** You can now use several eww buffers in parallel by renaming eww buffers you want to keep separate. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 46aea79..78862b3 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -36,6 +36,7 @@ (require 'subr-x) (require 'dom) (require 'seq) +(require 'svg) (defgroup shr nil "Simple HTML Renderer" @@ -963,10 +964,14 @@ element is the data blob and the second element is the content-type." (create-image data 'svg t :ascent 100)) ((eq size 'full) (ignore-errors - (shr-rescale-image data content-type))) + (shr-rescale-image data content-type + (plist-get flags :width) + (plist-get flags :height)))) (t (ignore-errors - (shr-rescale-image data content-type)))))) + (shr-rescale-image data content-type + (plist-get flags :width) + (plist-get flags :height))))))) (when image ;; When inserting big-ish pictures, put them at the ;; beginning of the line. @@ -989,21 +994,37 @@ element is the data blob and the second element is the content-type." image) (insert (or alt "")))) -(defun shr-rescale-image (data &optional content-type) - "Rescale DATA, if too big, to fit the current buffer." +(defun shr-rescale-image (data content-type width height) + "Rescale DATA, if too big, to fit the current buffer. +WIDTH and HEIGHT are the sizes given in the HTML data, if any." (if (not (and (fboundp 'imagemagick-types) (get-buffer-window (current-buffer)))) (create-image data nil t :ascent 100) - (let ((edges (window-inside-pixel-edges - (get-buffer-window (current-buffer))))) - (create-image - data 'imagemagick t - :ascent 100 - :max-width (truncate (* shr-max-image-proportion - (- (nth 2 edges) (nth 0 edges)))) - :max-height (truncate (* shr-max-image-proportion - (- (nth 3 edges) (nth 1 edges)))) - :format content-type)))) + (let* ((edges (window-inside-pixel-edges + (get-buffer-window (current-buffer)))) + (max-width (truncate (* shr-max-image-proportion + (- (nth 2 edges) (nth 0 edges))))) + (max-height (truncate (* shr-max-image-proportion + (- (nth 3 edges) (nth 1 edges)))))) + (when (or (and width + (> width max-width)) + (and height + (> height max-height))) + (setq width nil + height nil)) + (if (and width height) + (create-image + data 'imagemagick t + :ascent 100 + :width width + :height height + :format content-type) + (create-image + data 'imagemagick t + :ascent 100 + :max-width max-width + :max-height max-height + :format content-type))))) ;; url-cache-extract autoloads url-cache. (declare-function url-cache-create-filename "url-cache" (url)) @@ -1427,6 +1448,8 @@ The preference is a float determined from `shr-prefer-media-type'." (when (> (current-column) 0) (insert "\n")) (let ((alt (dom-attr dom 'alt)) + (width (shr-string-number (dom-attr dom 'width))) + (height (shr-string-number (dom-attr dom 'height))) (url (shr-expand-url (or url (dom-attr dom 'src))))) (let ((start (point-marker))) (when (zerop (length alt)) @@ -1440,7 +1463,8 @@ The preference is a float determined from `shr-prefer-media-type'." (string-match "\\`data:" url)) (let ((image (shr-image-from-data (substring url (match-end 0))))) (if image - (funcall shr-put-image-function image alt) + (funcall shr-put-image-function image alt + (list :width width :height height)) (insert alt)))) ((and (not shr-inhibit-images) (string-match "\\`cid:" url)) @@ -1449,7 +1473,8 @@ The preference is a float determined from `shr-prefer-media-type'." (if (or (not shr-content-function) (not (setq image (funcall shr-content-function url)))) (insert alt) - (funcall shr-put-image-function image alt)))) + (funcall shr-put-image-function image alt + (list :width width :height height))))) ((or shr-inhibit-images (and shr-blocked-images (string-match shr-blocked-images url))) @@ -1457,17 +1482,23 @@ The preference is a float determined from `shr-prefer-media-type'." (shr-insert alt)) ((and (not shr-ignore-cache) (url-is-cached (shr-encode-url url))) - (funcall shr-put-image-function (shr-get-image-data url) alt)) + (funcall shr-put-image-function (shr-get-image-data url) alt + (list :width width :height height))) (t - (insert alt " ") (when (and shr-ignore-cache (url-is-cached (shr-encode-url url))) (let ((file (url-cache-create-filename (shr-encode-url url)))) (when (file-exists-p file) (delete-file file)))) + (when (image-type-available-p 'svg) + (insert-image + (shr-make-placeholder-image dom) + (or alt ""))) + (insert " ") (url-queue-retrieve (shr-encode-url url) 'shr-image-fetched - (list (current-buffer) start (set-marker (make-marker) (1- (point)))) + (list (current-buffer) start (set-marker (make-marker) (1- (point))) + (list :width width :height height)) t t))) (when (zerop shr-table-depth) ;; We are not in a table. (put-text-property start (point) 'keymap shr-image-map) @@ -1479,6 +1510,48 @@ The preference is a float determined from `shr-prefer-media-type'." (shr-fill-text (or (dom-attr dom 'title) alt)))))))) +(defun shr-string-number (string) + (if (null string) + nil + (setq string (replace-regexp-in-string "[^0-9]" "" string)) + (if (zerop (length string)) + nil + (string-to-number string)))) + +(defun shr-make-placeholder-image (dom) + (let* ((edges (and + (get-buffer-window (current-buffer)) + (window-inside-pixel-edges + (get-buffer-window (current-buffer))))) + (scaling (image-compute-scaling-factor image-scaling-factor)) + (width (truncate + (* (or (shr-string-number (dom-attr dom 'width)) 100) + scaling))) + (height (truncate + (* (or (shr-string-number (dom-attr dom 'height)) 100) + scaling))) + (max-width + (and edges + (truncate (* shr-max-image-proportion + (- (nth 2 edges) (nth 0 edges)))))) + (max-height (and edges + (truncate (* shr-max-image-proportion + (- (nth 3 edges) (nth 1 edges)))))) + svg image) + (when (and max-width + (> width max-width)) + (setq height (truncate (* (/ (float max-width) width) height)) + width max-width)) + (when (and max-height + (> height max-height)) + (setq width (truncate (* (/ (float max-height) height) width)) + height max-height)) + (setq svg (svg-create width height)) + (svg-gradient svg "background" 'linear '((0 . "#b0b0b0") (100 . "#808080"))) + (svg-rectangle svg 0 0 width height :gradient "background") + (let ((image (svg-image svg))) + (image-set-property image :ascent 100)))) + (defun shr-tag-pre (dom) (let ((shr-folding-mode 'none) (shr-current-font 'default)) commit ad1951dbfb7e289553c25474efdfa02f83c16e71 Author: Lars Ingebrigtsen Date: Sat Feb 20 17:55:43 2016 +1100 Get explicit width/height + scale computations right * src/image.c (compute_image_size): :scale should also be taken into account when :width and :height are explicitly names. diff --git a/src/image.c b/src/image.c index af65fde..9ba1a79 100644 --- a/src/image.c +++ b/src/image.c @@ -8075,18 +8075,21 @@ compute_image_size (size_t width, size_t height, int desired_width, desired_height; double scale = 1; + value = image_spec_value (spec, QCscale, NULL); + if (NUMBERP (value)) + scale = extract_float (value); + /* If width and/or height is set in the display spec assume we want to scale to those values. If either h or w is unspecified, the unspecified should be calculated from the specified to preserve aspect ratio. */ value = image_spec_value (spec, QCwidth, NULL); - desired_width = NATNUMP (value) ? min (XFASTINT (value), INT_MAX) : -1; + desired_width = NATNUMP (value) ? + min (XFASTINT (value) * scale, INT_MAX) : -1; value = image_spec_value (spec, QCheight, NULL); - desired_height = NATNUMP (value) ? min (XFASTINT (value), INT_MAX) : -1; + desired_height = NATNUMP (value) ? + min (XFASTINT (value) * scale, INT_MAX) : -1; - value = image_spec_value (spec, QCscale, NULL); - if (NUMBERP (value)) - scale = extract_float (value); width = width * scale; height = height * scale; commit 0883e988ac950b2da2893e64822041ca0e6133a0 Author: Lars Ingebrigtsen Date: Sat Feb 20 17:54:05 2016 +1100 New functions for getting and setting image properties * doc/lispref/display.texi (Defining Images): Document image-get/set-property. * lisp/image.el (image-set-property): New function. (image-get-property): Ditto. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 17025cd..3758ddf 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5205,7 +5205,9 @@ the size, and lower means to decrease the size. For instance, a value of 0.25 will make the image a quarter size of what it originally was. If the scaling makes the image larger than specified by @code{:max-width} or @code{:max-height}, the resulting size will not -exceed those two values. +exceed those two values. If both @code{:scale} and +@code{:height}/@code{:width} are specified, the height/width will be +adjusted by the specified scaling factor. @item :format @var{type} The value, @var{type}, should be a symbol specifying the type of the @@ -5442,6 +5444,19 @@ If none of the alternatives will work, then @var{symbol} is defined as @code{nil}. @end defmac +@defun image-set-property image property value +Set the value of @var{property} in @var{image} to @var{value}. If +@var{value} is @code{nil}, the property is removed completely. + +@lisp +(image-set-property image :height 300) +@end lisp +@end defun + +@defun image-get-property image property +Return the value of @var{property} in @var{image}. +@end defun + @defun find-image specs This function provides a convenient way to find an image satisfying one of a list of image specifications @var{specs}. diff --git a/etc/NEWS b/etc/NEWS index c3c3eba..95ca8d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -846,6 +846,7 @@ of `epg-gpg-program' (instead of gpg). `image-scaling-factor' variable (if Emacs supports scaling the images in question). ++++ *** Images inserted with `insert-image' and related functions get a keymap put into the text properties (or overlays) that span the image. This keymap binds keystrokes for manipulating size and @@ -853,7 +854,13 @@ rotation, as well as saving the image to a file. +++ *** A new library for creating and manipulating SVG images has been -added. See the "SVG Images" section in the lispref manual for details. +added. See the "SVG Images" section in the lispref manual for +details. + ++++ +*** New functions to access and set image parameters are provided: +`image-get-property' and `image-set-property'. + ** Lisp mode diff --git a/lisp/image.el b/lisp/image.el index 855dffa..3522c5b 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -435,6 +435,26 @@ Image file names that are not absolute are searched for in the (image-compute-scaling-factor image-scaling-factor))) props))) +(defun image-set-property (image property value) + "Set PROPERTY in IMAGE to VALUE. +If VALUE is nil, PROPERTY is removed from IMAGE. IMAGE is +returned." + (if (null value) + (while (cdr image) + ;; IMAGE starts with the symbol `image', and the rest is a + ;; plist. Decouple plist entries where the key matches + ;; the property. + (if (eq (cadr image) property) + (setcdr image (cddr image)) + (setq image (cddr image)))) + ;; Just enter the new value. + (plist-put (cdr image) property value)) + image) + +(defun image-get-property (image property) + "Return the value of PROPERTY in IMAGE." + (plist-get (cdr image) property)) + (defun image-compute-scaling-factor (scaling) (cond ((numberp image-scaling-factor)