bug#69602: 29.1; Image :map should adjust with :scale and :rotation

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Currently, when running `image-increase-size' or `image-decrease-size'
on an image with a :map property, the image scales but the image map
does not.  For example, run the following snippet:

(with-current-buffer (get-buffer-create "*image-properties-test*")
  (let ((svg "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"\n \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">\n<!-- Generated by graphviz version 2.43.0 (0)\n -->\n<!-- Title: orggraphview Pages: 1 -->\n<svg width=\"128pt\" height=\"128pt\"\n viewBox=\"0.00 0.00 127.59 127.59\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\">\n<g id=\"graph0\" class=\"graph\" transform=\"scale(1 1) rotate(0) translate(4 123.59)\">\n<title>orggraphview</title>\n<polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-123.59 123.59,-123.59 123.59,4 -4,4\"/>\n<!-- a -->\n<g id=\"node1\" class=\"node\">\n<title>a</title>\n<g id=\"a_node1\"><a xlink:href=\"1\" xlink:title=\"Hover me!\">\n<ellipse fill=\"none\" stroke=\"black\" cx=\"59.79\" cy=\"-59.79\" rx=\"59.59\" ry=\"59.59\"/>\n<text text-anchor=\"middle\" x=\"59.79\" y=\"-56.09\" font-family=\"Times,serif\" font-size=\"14.00\" fill=\"#000000\">Hover me!</text>\n</a>\n</g>\n</g>\n</g>\n</svg>\n")
        (map '(((circle (85 . 85) . 80) "1" (help-echo "Surprise!"))))
        (inhibit-read-only t))
    (erase-buffer)
    (insert-image (create-image svg 'svg t :map map))
    (goto-char (point-min))
    (pop-to-buffer (current-buffer))))

Hovering the circle alters the pointer style and displays the tooltip.

Now run `M-x image-increase-size' or press "i +".  While the image
becomes larger, the area which activates the tooltip remains the same.

See earlier discussion here:

https://yhetil.org/emacs-devel/87r0gng41l.fsf@ushin.org/T/#t

While a proper solution perhaps belongs on the C side, the following
workaround adds an :unscaled-map property to images and sets :map
according to :unscaled-map and :scale whenever :scale changes.

This workaround does not (yet) handle :rotation.

--8<---------------cut here---------------start------------->8---

(defun image--scale-map (map factor)
  "Scale MAP by FACTOR, destructively modifying it."
  (unless (= 1 factor)
    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
      (pcase-exhaustive type
        ('rect
         (setf (caar coords) (round (* (caar coords) factor)))
         (setf (cdar coords) (round (* (cdar coords) factor)))
         (setf (cadr coords) (round (* (cadr coords) factor)))
         (setf (cddr coords) (round (* (cddr coords) factor))))
        ('circle
         (setf (caar coords) (round (* (caar coords) factor)))
         (setf (cdar coords) (round (* (cdar coords) factor)))
         (setf (cdr coords) (round (* (cdr coords) factor))))
        ('poly
         (dotimes (i (length coords))
           (aset coords i
                 (round (* (aref coords i) factor))))))))
  map)

(defun image--create-image-add-unscaled-map
    (orig-fun file-or-data &optional type data-p &rest props)
  "Add :unscaled-map property to image returned by ORIG-FUN and return it.
Intended to be used as :around advice for `create-image'."
  (let ((image (apply orig-fun file-or-data type data-p props)))
    (when-let ((map (image-property image :map)))
      (setq image (nconc image
                         (list :unscaled-map (copy-tree map t))))
      (when-let* ((props-scale (plist-get props :scale))
                  ((numberp props-scale)))
        (setf (image-property image :unscaled-map)
              (image--scale-map (image-property image :unscaled-map)
                                (/ 1.0 props-scale)))))
    image))

(advice-add #'create-image :around #'image--create-image-add-unscaled-map)

(defun image--change-size-scale-map (_factor &optional position)
  "Scale :map property of image at point to fit its :scale.
Intended to be used as :after advice for `image--change-size'."
  (when-let* ((image (image--get-imagemagick-and-warn position))
              (map (image-property image :map))
              (unscaled-map (image-property image :unscaled-map))
              (scale (image-property image :scale)))
    (setf (image-property image :map)
          ;; TODO: Instead of copying `:unscaled-map', reuse the :map vector?
          (image--scale-map (copy-tree unscaled-map t) scale))))

(advice-add #'image--change-size :after #'image--change-size-scale-map)

--8<---------------cut here---------------end--------------->8---

Thank you!

Joseph




In GNU Emacs 29.1 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.37,
cairo version 1.16.0)
Windowing system distributor 'The X.Org Foundation', version 11.0.12101007
System Description: Debian GNU/Linux 12 (bookworm)

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> Cc: Stephen Berman <stephen.berman@gmx.net>, Juri Linkov <juri@linkov.net>
> Date: Wed, 06 Mar 2024 21:37:50 -0800
> From:  Joseph Turner via "Bug reports for GNU Emacs,
>  the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
> 
> Currently, when running `image-increase-size' or `image-decrease-size'
> on an image with a :map property, the image scales but the image map
> does not.  For example, run the following snippet:
> 
> (with-current-buffer (get-buffer-create "*image-properties-test*")
>   (let ((svg "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"\n \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">\n<!-- Generated by graphviz version 2.43.0 (0)\n -->\n<!-- Title: orggraphview Pages: 1 -->\n<svg width=\"128pt\" height=\"128pt\"\n viewBox=\"0.00 0.00 127.59 127.59\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\">\n<g id=\"graph0\" class=\"graph\" transform=\"scale(1 1) rotate(0) translate(4 123.59)\">\n<title>orggraphview</title>\n<polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-123.59 123.59,-123.59 123.59,4 -4,4\"/>\n<!-- a -->\n<g id=\"node1\" class=\"node\">\n<title>a</title>\n<g id=\"a_node1\"><a xlink:href=\"1\" xlink:title=\"Hover me!\">\n<ellipse fill=\"none\" stroke=\"black\" cx=\"59.79\" cy=\"-59.79\" rx=\"59.59\" ry=\"59.59\"/>\n<text text-anchor=\"middle\" x=\"59.79\" y=\"-56.09\" font-family=\"Times,serif\" font-size=\"14.00\" fill=\"#000000\">Hover me!</text>\n</a>\n</g>\n</g>\n</g>\n</svg>\n")
>         (map '(((circle (85 . 85) . 80) "1" (help-echo "Surprise!"))))
>         (inhibit-read-only t))
>     (erase-buffer)
>     (insert-image (create-image svg 'svg t :map map))
>     (goto-char (point-min))
>     (pop-to-buffer (current-buffer))))
> 
> Hovering the circle alters the pointer style and displays the tooltip.
> 
> Now run `M-x image-increase-size' or press "i +".  While the image
> becomes larger, the area which activates the tooltip remains the same.
> 
> See earlier discussion here:
> 
> https://yhetil.org/emacs-devel/87r0gng41l.fsf@ushin.org/T/#t
> 
> While a proper solution perhaps belongs on the C side, the following
> workaround adds an :unscaled-map property to images and sets :map
> according to :unscaled-map and :scale whenever :scale changes.

The ELisp manual says about :map:

     Note that the map's coordinates should reflect the displayed image
     after all transforms have been done (rotation, scaling and so on),
     and also note that Emacs (by default) performs auto-scaling of
     images, so to make things match up, you should either specify
     ‘:scale 1.0’ when creating the image, or use the result of
     ‘image-compute-scaling-factor’ to compute the elements of the map.

Can this technique help?

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Eli Zaretskii <eliz@gnu.org> writes:
> The ELisp manual says about :map:
>
>      Note that the map's coordinates should reflect the displayed image
>      after all transforms have been done (rotation, scaling and so on),
>      and also note that Emacs (by default) performs auto-scaling of
>      images, so to make things match up, you should either specify
>      ‘:scale 1.0’ when creating the image, or use the result of
>      ‘image-compute-scaling-factor’ to compute the elements of the map.
>
> Can this technique help?

Thank you for your help!

When the user runs `image-increase-size', where should third-party code
recompute :map to fit the new image scale?

There's no `image-after-change-size-hook' nor `image-after-rotate-hook'.

Joseph

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> From: Joseph Turner <joseph@breatheoutbreathe.in>
> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
> Date: Wed, 06 Mar 2024 23:14:21 -0800
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> > The ELisp manual says about :map:
> >
> >      Note that the map's coordinates should reflect the displayed image
> >      after all transforms have been done (rotation, scaling and so on),
> >      and also note that Emacs (by default) performs auto-scaling of
> >      images, so to make things match up, you should either specify
> >      ‘:scale 1.0’ when creating the image, or use the result of
> >      ‘image-compute-scaling-factor’ to compute the elements of the map.
> >
> > Can this technique help?
> 
> Thank you for your help!
> 
> When the user runs `image-increase-size', where should third-party code
> recompute :map to fit the new image scale?
> 
> There's no `image-after-change-size-hook' nor `image-after-rotate-hook'.

I think the idea is to define the value of :map such that it runs
image-compute-scaling-factor as part of computing the coordinates of
the map.

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
>> Date: Wed, 06 Mar 2024 23:14:21 -0800
>>
>> Eli Zaretskii <eliz@gnu.org> writes:
>> > The ELisp manual says about :map:
>> >
>> >      Note that the map's coordinates should reflect the displayed image
>> >      after all transforms have been done (rotation, scaling and so on),
>> >      and also note that Emacs (by default) performs auto-scaling of
>> >      images, so to make things match up, you should either specify
>> >      ‘:scale 1.0’ when creating the image, or use the result of
>> >      ‘image-compute-scaling-factor’ to compute the elements of the map.
>> >
>> > Can this technique help?
>>
>> Thank you for your help!
>>
>> When the user runs `image-increase-size', where should third-party code
>> recompute :map to fit the new image scale?
>>
>> There's no `image-after-change-size-hook' nor `image-after-rotate-hook'.
>
> I think the idea is to define the value of :map such that it runs
> image-compute-scaling-factor as part of computing the coordinates of
> the map.

Sorry, I don't understand.

When creating an image, we set its :map property according to the return
value of `image-compute-scaling-factor'.  Once the image is inserted into
the buffer, the user may run `image-increase-size' or `image-rotate',
which changes how the image is displayed but not its :map.

Now, we need to rerun `image-compute-scaling-factor' and recompute :map.
However, there is no hook which runs after the user runs those commands,
so AFAICT there's no way for our code to know when to recompute :map.

Thanks!

Joseph

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> From: Joseph Turner <joseph@breatheoutbreathe.in>
> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
> Date: Thu, 07 Mar 2024 00:08:57 -0800
> 
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> >      Note that the map's coordinates should reflect the displayed image
> >> >      after all transforms have been done (rotation, scaling and so on),
> >> >      and also note that Emacs (by default) performs auto-scaling of
> >> >      images, so to make things match up, you should either specify
> >> >      ‘:scale 1.0’ when creating the image, or use the result of
> >> >      ‘image-compute-scaling-factor’ to compute the elements of the map.
> >> >
> >> > Can this technique help?
> >>
> >> Thank you for your help!
> >>
> >> When the user runs `image-increase-size', where should third-party code
> >> recompute :map to fit the new image scale?
> >>
> >> There's no `image-after-change-size-hook' nor `image-after-rotate-hook'.
> >
> > I think the idea is to define the value of :map such that it runs
> > image-compute-scaling-factor as part of computing the coordinates of
> > the map.
> 
> Sorry, I don't understand.

I hoped :map allows its value to be a form that is evaluated when the
image is being processed, in which case that form could call
image-compute-scaling-factor when it produces the coordinates.

If that doesn't work, then...

> When creating an image, we set its :map property according to the return
> value of `image-compute-scaling-factor'.  Once the image is inserted into
> the buffer, the user may run `image-increase-size' or `image-rotate',
> which changes how the image is displayed but not its :map.
> 
> Now, we need to rerun `image-compute-scaling-factor' and recompute :map.
> However, there is no hook which runs after the user runs those commands,
> so AFAICT there's no way for our code to know when to recompute :map.

...AFAIU, when an image is rescaled, we call
image-transform-properties to produce the updated image properties.
So I guess you'd like that function to recompute the coordinates in
:map according to the transform?

IOW, I don't understand why you think the problem can only be solved
in C: AFAIK almost all of the machinery that performs image transforms
is implemented in Lisp, and each time an image is rescaled, we
basically re-process the image descriptor anew.

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 5474 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
>> Date: Thu, 07 Mar 2024 00:08:57 -0800
>>
>> Eli Zaretskii <eliz@gnu.org> writes:
> I hoped :map allows its value to be a form that is evaluated when the
> image is being processed, in which case that form could call
> image-compute-scaling-factor when it produces the coordinates.

Thanks!  Would this require a change in C?

> If that doesn't work, then...
>
>> When creating an image, we set its :map property according to the return
>> value of `image-compute-scaling-factor'.  Once the image is inserted into
>> the buffer, the user may run `image-increase-size' or `image-rotate',
>> which changes how the image is displayed but not its :map.
>>
>> Now, we need to rerun `image-compute-scaling-factor' and recompute :map.

What I said here is wrong.  `image-compute-scaling-factor' is not
useful for recomputing :map, but `image--current-scaling' is.

>> However, there is no hook which runs after the user runs those commands,
>> so AFAICT there's no way for our code to know when to recompute :map.
>
> ...AFAIU, when an image is rescaled, we call
> image-transform-properties to produce the updated image properties.

There are two ways to rescale an image, `image-transform-properties'
(defined in image-mode.el; works only on file-backed images in
image-mode) and `image--change-size' (defined in image.el; works
on any image object in any mode).

For now, I'd like to focus on improving `image.el'.

> So I guess you'd like that function to recompute the coordinates in
> :map according to the transform?
>
> IOW, I don't understand why you think the problem can only be solved
> in C: AFAIK almost all of the machinery that performs image transforms
> is implemented in Lisp, and each time an image is rescaled, we
> basically re-process the image descriptor anew.

The attached patch adds two hooks in `image.el' which allow packages to
recompute an image's map after it's rescaled or rotated.

The following demonstrates `image-after-change-size-hooks':

(progn
  (defun image--scale-map (map factor)
    "Scale MAP by FACTOR, destructively modifying it."
    (when (and factor (/= 1 factor))
      (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
        (pcase-exhaustive type
          ('rect
           (setf (caar coords) (round (* (caar coords) factor)))
           (setf (cdar coords) (round (* (cdar coords) factor)))
           (setf (cadr coords) (round (* (cadr coords) factor)))
           (setf (cddr coords) (round (* (cddr coords) factor))))
          ('circle
           (setf (caar coords) (round (* (caar coords) factor)))
           (setf (cdar coords) (round (* (cdar coords) factor)))
           (setf (cdr coords) (round (* (cdr coords) factor))))
          ('poly
           (dotimes (i (length coords))
             (aset coords i
                   (round (* (aref coords i) factor))))))))
    map)

  (defun image-rescale-image-map ()
    "Recalculate and set :map property of image at point.
Assumes that image has an :unscaled-map property."
    (when-let* ((image (image--get-imagemagick-and-warn))
                (unscaled-image (image--image-without-parameters image))
                (unscaled-map (image-property image :unscaled-map))
                (scale (image--current-scaling image unscaled-image)))
      (setf (image-property image :map)
            (image--scale-map (copy-tree unscaled-map t) scale))))

  (with-current-buffer (get-buffer-create "*image-properties-test*")
    (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"\n \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">\n<!-- Generated by graphviz version 2.43.0 (0)\n -->\n<!-- Title: orggraphview Pages: 1 -->\n<svg width=\"128pt\" height=\"128pt\"\n viewBox=\"0.00 0.00 127.59 127.59\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\">\n<g id=\"graph0\" class=\"graph\" transform=\"scale(1 1) rotate(0) translate(4 123.59)\">\n<title>orggraphview</title>\n<polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-123.59 123.59,-123.59 123.59,4 -4,4\"/>\n<!-- a -->\n<g id=\"node1\" class=\"node\">\n<title>a</title>\n<g id=\"a_node1\"><a xlink:href=\"1\" xlink:title=\"Hover me!\">\n<ellipse fill=\"none\" stroke=\"black\" cx=\"59.79\" cy=\"-59.79\" rx=\"59.59\" ry=\"59.59\"/>\n<text text-anchor=\"middle\" x=\"59.79\" y=\"-56.09\" font-family=\"Times,serif\" font-size=\"14.00\" fill=\"#000000\">Hover me!</text>\n</a>\n</g>\n</g>\n</g>\n</svg>\n")
           (scale 0.75)  ; Adjust initial image scale
           (unscaled-map '(((circle (85 . 85) . 80) "1" (help-echo "Surprise!"))))
           (map (image--scale-map (copy-tree unscaled-map t) scale))
           (image
            (create-image svg-string 'svg t
                          :scale scale :map map :unscaled-map unscaled-map)))
      (add-hook 'image-after-change-size-hooks #'image-rescale-image-map nil t)
      (erase-buffer)
      (insert-image image)
      (goto-char (point-min))
      (pop-to-buffer (current-buffer)))))

After applying the attached patch, evaluate the above form, press "i +"
and "i -" repeatedly to see the image and its map scale together.

Thanks!

Joseph


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-image-after-change-size-hooks-image-after-rotate.patch --]
[-- Type: text/x-diff, Size: 1876 bytes --]

From ace6449374eb92f820388c5d111daaa2dbd89835 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Thu, 7 Mar 2024 15:24:49 -0800
Subject: [PATCH] Add image-after-change-size-hooks, image-after-rotate-hooks

With these hooks, image properties, notably :map, may now be
recalculated and set when an image is rotated or rescaled.  See #69602.

* lisp/image.el (image-after-change-size-hooks): Add hooks variable.
(image--change-size): Run hooks at end of function.
(image-after-rotate-hooks): Add hooks variable.
(image-rotate): Run hooks at end of function.
---
 lisp/image.el | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/lisp/image.el b/lisp/image.el
index d2f8868b60e..053fb436cd5 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1286,7 +1286,11 @@ image--change-size
          (new-image (image--image-without-parameters image))
          (scale (image--current-scaling image new-image)))
     (setcdr image (cdr new-image))
-    (plist-put (cdr image) :scale (* scale factor))))
+    (plist-put (cdr image) :scale (* scale factor))
+    (run-hooks 'image-after-change-size-hooks)))
+
+(defvar image-after-change-size-hooks nil
+  "Hooks run after image is rescaled.")
 
 (advice-add #'image--change-size :after #'image--change-size-scale-map)
 
@@ -1355,9 +1359,13 @@ image-rotate
                       ;; We don't want to exceed 360 degrees rotation,
                       ;; because it's not seen as valid in Exif data.
                       360))))
+  (run-hooks 'image-after-rotate-hooks)
   (set-transient-map image--repeat-map nil nil
                      "Use %k for further adjustments"))
 
+(defvar image-after-rotate-hooks nil
+  "Hooks run after image is rotated.")
+
 (defun image-save ()
   "Save the image under point.
 This writes the original image data to a file.  Rotating or
-- 
2.41.0

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 1967 bytes --]

Joseph Turner <joseph@breatheoutbreathe.in> writes:

> The attached patch adds two hooks in `image.el' which allow packages to
> recompute an image's map after it's rescaled or rotated.

In this new attached patch, rescaling image maps is handled within
image.el.  No new hooks are added.  This change should be backwards
compatible, except that :unscaled-map is now a reserved image property.

If we decide to install this patch, I'll work on modifying image maps
inside of `image-rotate', as well as update the manual and NEWS.

Test it out!

(with-current-buffer (get-buffer-create "*image-properties-test*")
  (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"\n \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">\n<!-- Generated by graphviz version 2.43.0 (0)\n -->\n<!-- Title: orggraphview Pages: 1 -->\n<svg width=\"128pt\" height=\"128pt\"\n viewBox=\"0.00 0.00 127.59 127.59\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\">\n<g id=\"graph0\" class=\"graph\" transform=\"scale(1 1) rotate(0) translate(4 123.59)\">\n<title>orggraphview</title>\n<polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-123.59 123.59,-123.59 123.59,4 -4,4\"/>\n<!-- a -->\n<g id=\"node1\" class=\"node\">\n<title>a</title>\n<g id=\"a_node1\"><a xlink:href=\"1\" xlink:title=\"Hover me!\">\n<ellipse fill=\"none\" stroke=\"black\" cx=\"59.79\" cy=\"-59.79\" rx=\"59.59\" ry=\"59.59\"/>\n<text text-anchor=\"middle\" x=\"59.79\" y=\"-56.09\" font-family=\"Times,serif\" font-size=\"14.00\" fill=\"#000000\">Hover me!</text>\n</a>\n</g>\n</g>\n</g>\n</svg>\n")
         (map '(((circle (85 . 85) . 80) "1" (help-echo "Surprise!"))))
         (image (create-image svg-string 'svg t :map map)))
    (erase-buffer)
    (insert-image image)
    (goto-char (point-min))
    (pop-to-buffer (current-buffer))))

Thank you!

Joseph


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Recalculate-map-when-image-scale-changes.patch --]
[-- Type: text/x-diff, Size: 3937 bytes --]

From 7a3d9fa5cc08c40696ad65101d62cb4babb4dc76 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Thu, 7 Mar 2024 21:55:00 -0800
Subject: [PATCH] Recalculate :map when image :scale changes

Now, when rescaling an image with a :map using `image-increase-size' or
`image-decrease-size', the image map scales along with the image.

Image map coordinates are integers, so when scaling :map, coordinates
must be rounded.  To prevent an image from drifting from its map after
repeatedly scaling up and down, `create-image' now stores the original
:unscaled-map, which is combined with the image's scale after resizing
to recalculate :map.

* lisp/image.el (create-image): Add :unscaled-map image property
(image--delayed-change-size): Fix comment
(image--change-size): Also scale image map
(image--scale-map): Add function to scale an image map
---
 lisp/image.el | 38 +++++++++++++++++++++++++++++++++++---
 1 file changed, 35 insertions(+), 3 deletions(-)

diff --git a/lisp/image.el b/lisp/image.el
index 2ebce59a98c..c72332172f0 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -533,6 +533,13 @@ create-image
                                    ('t t)
                                    ('nil nil)
                                    (func (funcall func image)))))))
+      ;; Add unscaled map.
+      (when-let ((map (plist-get props :map)))
+        (setq image (nconc image
+                           (list :unscaled-map
+                                 (image--scale-map
+                                  (copy-tree map t)
+                                  (/ 1.0 (image-property image :scale)))))))
       image)))
 
 (defun image--default-smoothing (image)
@@ -1185,7 +1192,7 @@ image-increase-size
 (defun image--delayed-change-size (size position)
   ;; Wait for a bit of idle-time before actually performing the change,
   ;; so as to batch together sequences of closely consecutive size changes.
-  ;; `image--change-size' just changes one value in a plist.  The actual
+  ;; `image--change-size' just changes :scale and :map.  The actual
   ;; image resizing happens later during redisplay.  So if those
   ;; consecutive calls happen without any redisplay between them,
   ;; the costly operation of image resizing should happen only once.
@@ -1267,9 +1274,34 @@ image--get-imagemagick-and-warn
 (defun image--change-size (factor &optional position)
   (let* ((image (image--get-imagemagick-and-warn position))
          (new-image (image--image-without-parameters image))
-         (scale (image--current-scaling image new-image)))
+         (unscaled-map (image-property image :unscaled-map))
+         (scale (image--current-scaling image new-image))
+         (new-scale (* scale factor)))
     (setcdr image (cdr new-image))
-    (plist-put (cdr image) :scale (* scale factor))))
+    (plist-put (cdr image) :scale new-scale)
+    (when unscaled-map
+      (setf (image-property image :map)
+            (image--scale-map (copy-tree unscaled-map t) new-scale)))))
+
+(defun image--scale-map (map factor)
+  "Scale MAP by FACTOR, destructively modifying it."
+  (unless (= 1 factor)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (setf (caar coords) (round (* (caar coords) factor)))
+         (setf (cdar coords) (round (* (cdar coords) factor)))
+         (setf (cadr coords) (round (* (cadr coords) factor)))
+         (setf (cddr coords) (round (* (cddr coords) factor))))
+        ('circle
+         (setf (caar coords) (round (* (caar coords) factor)))
+         (setf (cdar coords) (round (* (cdar coords) factor)))
+         (setf (cdr coords) (round (* (cdr coords) factor))))
+        ('poly
+         (dotimes (i (length coords))
+           (aset coords i
+                 (round (* (aref coords i) factor))))))))
+  map)
 
 (defun image--image-without-parameters (image)
   (cons (pop image)
-- 
2.41.0

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> From: Joseph Turner <joseph@breatheoutbreathe.in>
> Date: Thu, 07 Mar 2024 23:02:24 -0800
> 
> Joseph Turner <joseph@breatheoutbreathe.in> writes:
> 
> > The attached patch adds two hooks in `image.el' which allow packages to
> > recompute an image's map after it's rescaled or rotated.
> 
> In this new attached patch, rescaling image maps is handled within
> image.el.  No new hooks are added.  This change should be backwards
> compatible, except that :unscaled-map is now a reserved image property.

Are we sure no Lisp program out there would want the coordinates in
:map to remain unchanged under these transformation?  Maybe we should
add a variable to control this, so that the change could be truly
backward-compatible?

> If we decide to install this patch, I'll work on modifying image maps
> inside of `image-rotate', as well as update the manual and NEWS.

Thanks.

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 1078 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Date: Thu, 07 Mar 2024 23:02:24 -0800
>>
>> Joseph Turner <joseph@breatheoutbreathe.in> writes:
>>
>> > The attached patch adds two hooks in `image.el' which allow packages to
>> > recompute an image's map after it's rescaled or rotated.
>>
>> In this new attached patch, rescaling image maps is handled within
>> image.el.  No new hooks are added.  This change should be backwards
>> compatible, except that :unscaled-map is now a reserved image property.
>
> Are we sure no Lisp program out there would want the coordinates in
> :map to remain unchanged under these transformation?  Maybe we should
> add a variable to control this, so that the change could be truly
> backward-compatible?

Good point.  Thanks!

What if explicitly passing :unscaled-map 'no-recalculate in
`create-image' prevented :map from being recalculated later?

If not, what kind of variable did you have in mind?  A special variable
let-bound the call?  Or another argument to `create-image'?

See patches.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-Allow-map-to-not-be-recalculated-after-image-rescali.patch --]
[-- Type: text/x-diff, Size: 1472 bytes --]

From feafa5a4e967254fc58c2ad223cd7033d4c4be02 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Fri, 8 Mar 2024 00:53:44 -0800
Subject: [PATCH 2/2] Allow :map to not be recalculated after image rescaling

* lisp/image.el (create-image): Don't append :unscaled-map if passed in.
(image--image-without-parameters): Don't rescale :map when :unscaled-map
is 'no-recalculate.
---
 lisp/image.el | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/lisp/image.el b/lisp/image.el
index c72332172f0..b7de9817009 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -534,7 +534,8 @@ create-image
                                    ('nil nil)
                                    (func (funcall func image)))))))
       ;; Add unscaled map.
-      (when-let ((map (plist-get props :map)))
+      (when-let ((map (plist-get props :map))
+                 ((not (plist-member props :unscaled-map))))
         (setq image (nconc image
                            (list :unscaled-map
                                  (image--scale-map
@@ -1279,7 +1280,8 @@ image--change-size
          (new-scale (* scale factor)))
     (setcdr image (cdr new-image))
     (plist-put (cdr image) :scale new-scale)
-    (when unscaled-map
+    (when (and unscaled-map
+               (not (eq 'no-recalculate unscaled-map)))
       (setf (image-property image :map)
             (image--scale-map (copy-tree unscaled-map t) new-scale)))))
 
-- 
2.41.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Recalculate-map-when-image-scale-changes.patch --]
[-- Type: text/x-diff, Size: 3941 bytes --]

From 7a3d9fa5cc08c40696ad65101d62cb4babb4dc76 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Thu, 7 Mar 2024 21:55:00 -0800
Subject: [PATCH 1/2] Recalculate :map when image :scale changes

Now, when rescaling an image with a :map using `image-increase-size' or
`image-decrease-size', the image map scales along with the image.

Image map coordinates are integers, so when scaling :map, coordinates
must be rounded.  To prevent an image from drifting from its map after
repeatedly scaling up and down, `create-image' now stores the original
:unscaled-map, which is combined with the image's scale after resizing
to recalculate :map.

* lisp/image.el (create-image): Add :unscaled-map image property
(image--delayed-change-size): Fix comment
(image--change-size): Also scale image map
(image--scale-map): Add function to scale an image map
---
 lisp/image.el | 38 +++++++++++++++++++++++++++++++++++---
 1 file changed, 35 insertions(+), 3 deletions(-)

diff --git a/lisp/image.el b/lisp/image.el
index 2ebce59a98c..c72332172f0 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -533,6 +533,13 @@ create-image
                                    ('t t)
                                    ('nil nil)
                                    (func (funcall func image)))))))
+      ;; Add unscaled map.
+      (when-let ((map (plist-get props :map)))
+        (setq image (nconc image
+                           (list :unscaled-map
+                                 (image--scale-map
+                                  (copy-tree map t)
+                                  (/ 1.0 (image-property image :scale)))))))
       image)))
 
 (defun image--default-smoothing (image)
@@ -1185,7 +1192,7 @@ image-increase-size
 (defun image--delayed-change-size (size position)
   ;; Wait for a bit of idle-time before actually performing the change,
   ;; so as to batch together sequences of closely consecutive size changes.
-  ;; `image--change-size' just changes one value in a plist.  The actual
+  ;; `image--change-size' just changes :scale and :map.  The actual
   ;; image resizing happens later during redisplay.  So if those
   ;; consecutive calls happen without any redisplay between them,
   ;; the costly operation of image resizing should happen only once.
@@ -1267,9 +1274,34 @@ image--get-imagemagick-and-warn
 (defun image--change-size (factor &optional position)
   (let* ((image (image--get-imagemagick-and-warn position))
          (new-image (image--image-without-parameters image))
-         (scale (image--current-scaling image new-image)))
+         (unscaled-map (image-property image :unscaled-map))
+         (scale (image--current-scaling image new-image))
+         (new-scale (* scale factor)))
     (setcdr image (cdr new-image))
-    (plist-put (cdr image) :scale (* scale factor))))
+    (plist-put (cdr image) :scale new-scale)
+    (when unscaled-map
+      (setf (image-property image :map)
+            (image--scale-map (copy-tree unscaled-map t) new-scale)))))
+
+(defun image--scale-map (map factor)
+  "Scale MAP by FACTOR, destructively modifying it."
+  (unless (= 1 factor)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (setf (caar coords) (round (* (caar coords) factor)))
+         (setf (cdar coords) (round (* (cdar coords) factor)))
+         (setf (cadr coords) (round (* (cadr coords) factor)))
+         (setf (cddr coords) (round (* (cddr coords) factor))))
+        ('circle
+         (setf (caar coords) (round (* (caar coords) factor)))
+         (setf (cdar coords) (round (* (cdar coords) factor)))
+         (setf (cdr coords) (round (* (cdr coords) factor))))
+        ('poly
+         (dotimes (i (length coords))
+           (aset coords i
+                 (round (* (aref coords i) factor))))))))
+  map)
 
 (defun image--image-without-parameters (image)
   (cons (pop image)
-- 
2.41.0

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> From: Joseph Turner <joseph@breatheoutbreathe.in>
> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
> Date: Fri, 08 Mar 2024 00:39:16 -0800
> 
> > Are we sure no Lisp program out there would want the coordinates in
> > :map to remain unchanged under these transformation?  Maybe we should
> > add a variable to control this, so that the change could be truly
> > backward-compatible?
> 
> Good point.  Thanks!
> 
> What if explicitly passing :unscaled-map 'no-recalculate in
> `create-image' prevented :map from being recalculated later?

I think that's less desirable, since some images could be created
outside of control of a Lisp program that wants to control the
coordinates.

> If not, what kind of variable did you have in mind?  A special variable
> let-bound the call?  Or another argument to `create-image'?

I had in mind a special variable (we'd need to mention it in NEWS and
in the doc string of the relevant functions).  Adding an argument is a
heavier change, and I think it is not justified in this case, because
I do agree with you that most, if not all, applications would want the
coordinates to scale together with the image.

Thanks.

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 1319 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
>> Date: Fri, 08 Mar 2024 00:39:16 -0800
>>
>> > Are we sure no Lisp program out there would want the coordinates in
>> > :map to remain unchanged under these transformation?  Maybe we should
>> > add a variable to control this, so that the change could be truly
>> > backward-compatible?
>>
>> Good point.  Thanks!
>>
>> What if explicitly passing :unscaled-map 'no-recalculate in
>> `create-image' prevented :map from being recalculated later?
>
> I think that's less desirable, since some images could be created
> outside of control of a Lisp program that wants to control the
> coordinates.
>
>> If not, what kind of variable did you have in mind?  A special variable
>> let-bound the call?  Or another argument to `create-image'?
>
> I had in mind a special variable (we'd need to mention it in NEWS and
> in the doc string of the relevant functions).  Adding an argument is a
> heavier change, and I think it is not justified in this case, because
> I do agree with you that most, if not all, applications would want the
> coordinates to scale together with the image.

Thanks for your feedback and your patience!

Please see attached patch.

Joseph


[-- Attachment #2: 0001-Recompute-map-when-image-scale-rotation-or-flip-chan.patch --]
[-- Type: text/x-diff, Size: 26184 bytes --]

From 7b454df8f7335751c96c946ca09711b16c1de193 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Thu, 7 Mar 2024 21:55:00 -0800
Subject: [PATCH] Recompute :map when image :scale, :rotation, or :flip changes

Now, when transforming an image, its :map is recomputed to fit.

Image map coordinates are integers, so when computing :map, coordinates
are rounded.  To prevent an image from drifting from its map after
repeated transformations, `create-image' now adds a new image property
:original-map, which is combined with the image's transformation
parameters to recompute :map.

* lisp/image.el (image-recompute-map-p): Add user option to control
whether :map is recomputed when an image is transformed.
(create-image): Create :map from :original-map and vice versa.
(image--delayed-change-size): Fix comment.
(image--change-size, image-rotate, image-flip-horizontally,
image-flip-vertically): Recompute image map after transformation and
mention image-recompute-map-p in docstring.
(image--compute-map): Add function to compute a map from original map.
(image--compute-map): Add function to compute an original map from map.
(image--scale-map): Add function to scale a map based on :scale.
(image--rotate-map): Add function to rotate a map based on :rotation.
(image--rotate-coord): Add function to rotate a map coordinate pair.
(image--flip-map): Add function to flip a map based on :flip.
(image-increase-size, image-decrease-size, image-mouse-increase-size,
image-mouse-decrease-size): Mention image-recompute-map-p in docstring.
* etc/NEWS: Add NEWS entry.
* doc/lispref/display.texi (Image Descriptors): Document :original-map
and new user option image-recompute-map-p.
* test/lisp/image-tests.el (image--compute-map-and-original-map): Test
`image--compute-map' and `image--compute-original-map'.
(image-create-image-with-map): Test that `create-image' adds :map and/or
:original-map as appropriate.
(image-transform-map): Test functions related to transforming maps.
---
 doc/lispref/display.texi |  24 +++++
 etc/NEWS                 |  12 +++
 lisp/image.el            | 221 ++++++++++++++++++++++++++++++++++++---
 test/lisp/image-tests.el | 111 ++++++++++++++++++++
 4 files changed, 356 insertions(+), 12 deletions(-)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 10cf5ce89e2..8335a02b5c5 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6055,6 +6055,30 @@ Image Descriptors
 when creating the image, or use the result of
 @code{image-compute-scaling-factor} to compute the elements of the
 map.
+
+When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is
+changed, @code{:map} will be recomputed based on the value of
+@code{:original-map} and the values of those transformation.
+
+@item :original-map @var{original-map}
+@cindex original image map
+This specifies the untransformed image map which will be used to
+recompute @code{:map} after the image's @code{:scale}, @code{:rotation},
+or @code{:flip} is changed.
+
+If @code{:original-map} is not specified when creating an image with
+@code{create-image}, it will be computed based on the supplied
+@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or
+@code{:flip} which are non-nil.
+
+Conversely, if @code{:original-map} is specified but @code{:map} is not,
+@code{:map} will be computed based on @code{:original-map},
+@code{:scale}, @code{:rotation}, and @code{:flip}.
+
+@defopt image-recompute-map-p
+Set this user option to nil to prevent Emacs from automatically
+recomputing an image @code{:map} based on its @code{:original-map}.
+@end defopt
 @end table
 
 @defun image-mask-p spec &optional frame
diff --git a/etc/NEWS b/etc/NEWS
index 06856602ea8..cbd97b495b2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1292,6 +1292,18 @@ without specifying a file, like this:
     (notifications-notify
       :title "I am playing music" :app-icon 'multimedia-player)
 
+** Image
+
++++
+*** Image :map property is now recomputed when image is transformed.
+Now images with clickable maps work as expected after you run commands
+such as `image-increase-size', `image-decrease-size', `image-rotate',
+`image-flip-horizontally', and `image-flip-vertically'.
+
++++
+*** New user option 'image-recompute-map-p'
+Set this option to nil to prevent Emacs from recomputing image maps.
+
 ** Image Dired
 
 *** New user option 'image-dired-thumb-naming'.
diff --git a/lisp/image.el b/lisp/image.el
index 2ebce59a98c..ed94b9eb621 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -533,6 +533,16 @@ create-image
                                    ('t t)
                                    ('nil nil)
                                    (func (funcall func image)))))))
+      ;; Add original map from map.
+      (when (and (plist-get props :map)
+                 (not (plist-get props :original-map)))
+        (setq image (nconc image (list :original-map
+                                       (image--compute-original-map image)))))
+      ;; Add map from original map.
+      (when (and (plist-get props :original-map)
+                 (not (plist-get props :map)))
+        (setq image (nconc image (list :map
+                                       (image--compute-map image)))))
       image)))
 
 (defun image--default-smoothing (image)
@@ -1173,7 +1183,10 @@ image-increase-size
 If N is 3, then the image size will be increased by 30%.  More
 generally, the image size is multiplied by 1 plus N divided by 10.
 N defaults to 2, which increases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "P")
   (image--delayed-change-size (if n
                                   (1+ (/ (prefix-numeric-value n) 10.0))
@@ -1185,7 +1198,7 @@ image-increase-size
 (defun image--delayed-change-size (size position)
   ;; Wait for a bit of idle-time before actually performing the change,
   ;; so as to batch together sequences of closely consecutive size changes.
-  ;; `image--change-size' just changes one value in a plist.  The actual
+  ;; `image--change-size' just changes two values in a plist.  The actual
   ;; image resizing happens later during redisplay.  So if those
   ;; consecutive calls happen without any redisplay between them,
   ;; the costly operation of image resizing should happen only once.
@@ -1196,7 +1209,10 @@ image-decrease-size
 If N is 3, then the image size will be decreased by 30%.  More
 generally, the image size is multiplied by 1 minus N divided by 10.
 N defaults to 2, which decreases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "P")
   (image--delayed-change-size (if n
                                   (- 1 (/ (prefix-numeric-value n) 10.0))
@@ -1208,7 +1224,10 @@ image-decrease-size
 (defun image-mouse-increase-size (&optional event)
   "Increase the image size using the mouse-gesture EVENT.
 This increases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-increase-size'."
+EVENT, if any, by the default factor used by `image-increase-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "e")
   (when (listp event)
     (save-window-excursion
@@ -1218,7 +1237,10 @@ image-mouse-increase-size
 (defun image-mouse-decrease-size (&optional event)
   "Decrease the image size using the mouse-gesture EVENT.
 This decreases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-decrease-size'."
+EVENT, if any, by the default factor used by `image-decrease-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "e")
   (when (listp event)
     (save-window-excursion
@@ -1269,7 +1291,9 @@ image--change-size
          (new-image (image--image-without-parameters image))
          (scale (image--current-scaling image new-image)))
     (setcdr image (cdr new-image))
-    (plist-put (cdr image) :scale (* scale factor))))
+    (plist-put (cdr image) :scale (* scale factor))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (defun image--image-without-parameters (image)
   (cons (pop image)
@@ -1296,7 +1320,10 @@ image-rotate
 If nil, ANGLE defaults to 90.  Interactively, rotate the image 90
 degrees clockwise with no prefix argument, and counter-clockwise
 with a prefix argument.  Note that most image types support
-rotations by only multiples of 90 degrees."
+rotations by only multiples of 90 degrees.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive (and current-prefix-arg '(-90)))
   (let ((image (image--get-imagemagick-and-warn)))
     (setf (image-property image :rotation)
@@ -1304,7 +1331,9 @@ image-rotate
                          (or angle 90))
                       ;; We don't want to exceed 360 degrees rotation,
                       ;; because it's not seen as valid in Exif data.
-                      360))))
+                      360)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image))))
   (set-transient-map image--repeat-map nil nil
                      "Use %k for further adjustments"))
 
@@ -1325,23 +1354,191 @@ image-save
                     (read-file-name "Write image to file: ")))))
 
 (defun image-flip-horizontally ()
-  "Horizontally flip the image under point."
+  "Horizontally flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive)
   (let ((image (image--get-image)))
     (image-flush image)
     (setf (image-property image :flip)
-          (not (image-property image :flip)))))
+          (not (image-property image :flip)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (defun image-flip-vertically ()
-  "Vertically flip the image under point."
+  "Vertically flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive)
   (let ((image (image--get-image)))
     (image-rotate 180)
     (setf (image-property image :flip)
-          (not (image-property image :flip)))))
+          (not (image-property image :flip)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (define-obsolete-function-alias 'image-refresh #'image-flush "29.1")
 
+;;; Map transformation
+
+(defcustom image-recompute-map-p t
+  "Recompute image map when scaling, rotating, or flipping an image."
+  :type 'boolean
+  :version "30.1")
+
+(defun image--compute-map (image)
+  "Compute map for IMAGE suitable to be used as its :map property.
+Return a copy of :original-image transformed based on IMAGE's :scale,
+:rotation, and :flip.  When IMAGE's :original-map is nil, return nil.
+When :rotation is not a multiple of 90, return copy of :original-map."
+  (pcase-let* ((original-map (image-property image :original-map))
+               (map (copy-tree original-map t))
+               (scale (or (image-property image :scale) 1))
+               (rotation (or (image-property image :rotation) 0))
+               (flip (image-property image :flip))
+               ((and size `(,width . ,height)) (image-size image t)))
+    (when (and ; Handle only 90-degree rotations
+           (zerop (mod rotation 1))
+           (zerop (% (truncate rotation) 90)))
+      ;; SIZE fits MAP after transformations.  Scale MAP before
+      ;; flip and rotate operations, since both need MAP to fit SIZE.
+      (image--scale-map map scale)
+      ;; In rendered images, rotation is always applied before flip.
+      (image--rotate-map
+       map rotation (if (or (= 90 rotation) (= 270 rotation))
+                        ;; If rotated ±90°, swap width and height.
+                        (cons height width)
+                      size))
+      ;; After rotation, there's no need to swap width and height.
+      (image--flip-map map flip size))
+    map))
+
+(defun image--compute-original-map (image)
+  "Return original map for IMAGE.
+If IMAGE lacks :map property, return nil.
+When :rotation is not a multiple of 90, return copy of :map."
+  (when (image-property image :map)
+    (let* ((image-copy (copy-tree image t))
+           (map (image-property image-copy :map))
+           (scale (or (image-property image-copy :scale) 1))
+           (rotation (or (image-property image-copy :rotation) 0))
+           (flip (image-property image-copy :flip))
+           (size (image-size image-copy t)))
+      (when (and ; Handle only 90-degree rotations
+             (zerop (mod rotation 1))
+             (zerop (% (truncate rotation) 90)))
+        ;; In rendered images, rotation is always applied before flip.
+        ;; To undo the transformation, flip before rotating.
+        ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP.
+        ;; Therefore, scale MAP after flip and rotate operations, since
+        ;; both need MAP to fit SIZE.
+        (image--flip-map map flip size)
+        (image--rotate-map map (- rotation) size)
+        (image--scale-map map (/ 1.0 scale)))
+      map)))
+
+(defun image--scale-map (map scale)
+  "Scale MAP according to SCALE.
+Destructively modifies and returns MAP."
+  (unless (= 1 scale)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (setf (caar coords) (round (* (caar coords) scale)))
+         (setf (cdar coords) (round (* (cdar coords) scale)))
+         (setf (cadr coords) (round (* (cadr coords) scale)))
+         (setf (cddr coords) (round (* (cddr coords) scale))))
+        ('circle
+         (setf (caar coords) (round (* (caar coords) scale)))
+         (setf (cdar coords) (round (* (cdar coords) scale)))
+         (setcdr coords (round (* (cdr coords) scale))))
+        ('poly
+         (dotimes (i (length coords))
+           (aset coords i
+                 (round (* (aref coords i) scale))))))))
+  map)
+
+(defun image--rotate-map (map rotation size)
+  "Rotate MAP according to ROTATION and SIZE.
+Destructively modifies and returns MAP."
+  (unless (zerop rotation)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (let ( x0 y0  ; New upper left corner
+                x1 y1) ; New bottom right corner
+           (pcase (truncate (mod rotation 360)) ; Set new corners to...
+             (90 ; ...old bottom left and upper right
+              (setq x0 (caar coords) y0 (cddr coords)
+                    x1 (cadr coords) y1 (cdar coords)))
+             (180 ; ...old bottom right and upper left
+              (setq x0 (cadr coords) y0 (cddr coords)
+                    x1 (caar coords) y1 (cdar coords)))
+             (270 ; ...old upper right and bottom left
+              (setq x0 (cadr coords) y0 (cdar coords)
+                    x1 (caar coords) y1 (cddr coords))))
+           (setcar coords (image--rotate-coord x0 y0 rotation size))
+           (setcdr coords (image--rotate-coord x1 y1 rotation size))))
+        ('circle
+         (setcar coords (image--rotate-coord
+                         (caar coords) (cdar coords) rotation size)))
+        ('poly
+         (dotimes (i (length coords))
+           (when (= 0 (% i 2))
+             (pcase-let ((`(,x . ,y)
+                          (image--rotate-coord
+                           (aref coords i) (aref coords (1+ i)) rotation size)))
+               (aset coords i x)
+               (aset coords (1+ i) y))))))))
+  map)
+
+(defun image--rotate-coord (x y angle size)
+  "Rotate coordinates X and Y by ANGLE in image of SIZE.
+ANGLE must be a multiple of 90.  Returns a cons cell of rounded
+coordinates (X1 Y1)."
+  (pcase-let* ((radian (thread-first angle (* float-pi) (/ 180.0)))
+               (`(,width . ,height) size)
+               ;; y is positive, but we are in the bottom-right quadrant
+               (y (- y))
+               ;; Rotate clockwise
+               (x1 (+ (* (sin radian) y) (* (cos radian) x)))
+               (y1 (- (* (cos radian) y) (* (sin radian) x)))
+               ;; Translate image back into bottom-right quadrant
+               (`(,x1 . ,y1)
+                (pcase (truncate (mod angle 360))
+                  (90 ; Translate right by height
+                   (cons (+ x1 height) y1))
+                  (180 ; Translate right by width and down by height
+                   (cons (+ x1 width) (- y1 height)))
+                  (270 ; Translate down by width
+                   (cons x1 (- y1 width)))))
+               ;; Invert y1 to make both x1 and y1 positive
+               (y1 (- y1)))
+    (cons (round x1) (round y1))))
+
+(defun image--flip-map (map flip size)
+  "Horizontally flip MAP according to FLIP and SIZE.
+Destructively modifies and returns MAP."
+  (when flip
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (let ((x0 (- (car size) (cadr coords)))
+               (y0 (cdar coords))
+               (x1 (- (car size) (caar coords)))
+               (y1 (cddr coords)))
+           (setcar coords (cons x0 y0))
+           (setcdr coords (cons x1 y1))))
+        ('circle
+         (setf (caar coords) (- (car size) (caar coords))))
+        ('poly
+         (dotimes (i (length coords))
+           (when (= 0 (% i 2))
+             (aset coords i (- (car size) (aref coords i)))))))))
+  map)
+
 (provide 'image)
 
 ;;; image.el ends here
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index 80142d6d6de..1e409190865 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -153,4 +153,115 @@ image-rotate
     (image-rotate -154.5)
     (should (equal image '(image :rotation 91.0)))))
 
+;;;; Transforming maps
+
+(ert-deftest image-create-image-with-map ()
+  "Test that `create-image' correctly adds :map and/or :original-map."
+  (let ((data "foo")
+        (map '(((circle (1 .  1) .  1) a)))
+        (original-map '(((circle (2 .  2) .  2) a)))
+        (original-map-other '(((circle (3 . 3) . 3) a))))
+    ;; Generate :original-map from :map.
+    (let* ((image (create-image data 'svg t :map map :scale 0.5))
+           (got-original-map (image-property image :original-map)))
+      (should (equal got-original-map original-map)))
+    ;; Generate :map from :original-map.
+    (let* ((image (create-image
+                   data 'svg t :original-map original-map :scale 0.5))
+           (got-map (image-property image :map)))
+      (should (equal got-map map)))
+    ;; Use :original-map if both it and :map are specified.
+    (let* ((image (create-image
+                   data 'svg t :map map
+                   :original-map original-map-other :scale 0.5))
+           (got-original-map (image-property image :original-map)))
+      (should (equal got-original-map original-map-other)))))
+
+(ert-deftest image--compute-map-and-original-map ()
+  "Test `image--compute-map' and `image--compute-original-map'."
+  (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?><svg width=\"125pt\" height=\"116pt\" viewBox=\"0.00 0.00 125.00 116.00\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><g transform=\"scale(1 1) rotate(0) translate(4 112)\"><polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-112 121,-112 121,4 -4,4\"/><a xlink:href=\"a\"><ellipse fill=\"none\" stroke=\"black\" cx=\"27\" cy=\"-90\" rx=\"18\" ry=\"18\"/><text text-anchor=\"middle\" x=\"27\" y=\"-86.3\" fill=\"#000000\">A</text></a><a xlink:href=\"b\"><polygon fill=\"none\" stroke=\"black\" points=\"54,-36 0,-36 0,0 54,0 54,-36\"/><text text-anchor=\"middle\" x=\"27\" y=\"-14.3\" fill=\"#000000\">B</text></a><a xlink:href=\"c\"><ellipse fill=\"none\" stroke=\"black\" cx=\"90\" cy=\"-90\" rx=\"27\" ry=\"18\"/><text text-anchor=\"middle\" x=\"90\" y=\"-86.3\" fill=\"#000000\">C</text></a></g></svg>")
+         (original-map
+          '(((circle (41 . 29) . 24) "a" (help-echo "A"))
+            ((rect (5 . 101) 77 . 149) "b" (help-echo "B"))
+            ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96 15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37]) "c" (help-echo "C"))))
+         (scaled-map
+          '(((circle (82 . 58) . 48) "a" (help-echo "A"))
+            ((rect (10 . 202) 154 . 298) "b" (help-echo "B"))
+            ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20 192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86 320 74]) "c" (help-echo "C"))))
+         (flipped-map
+          '(((circle (125 . 29) . 24) "a" (help-echo "A"))
+            ((rect (89 . 101) 161 . 149) "b" (help-echo "B"))
+            ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22 77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo "C"))))
+         (rotated-map
+          '(((circle (126 . 41) . 24) "a" (help-echo "A"))
+            ((rect (6 . 5) 54 . 77) "b" (help-echo "B"))
+            ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114 145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106 146 112 154 118 160]) "c" (help-echo "C"))))
+         (scaled-rotated-flipped-map
+          '(((circle (58 . 82) . 48) "a" (help-echo "A"))
+            ((rect (202 . 10) 298 . 154) "b" (help-echo "B"))
+            ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208 30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308 74 320]) "c" (help-echo "C"))))
+         (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map
+                              :scale 2 :rotation 90 :flip t)))
+    ;; Test that `image--compute-original-map' correctly generates
+    ;; original-map when creating an already transformed image.
+    (should (equal (image-property image :original-map)
+                   original-map))
+    (setf (image-property image :flip) nil)
+    (setf (image-property image :rotation) 0)
+    (setf (image-property image :scale) 2)
+    (should (equal (image--compute-map image)
+                   scaled-map))
+    (setf (image-property image :scale) 1)
+    (setf (image-property image :rotation) 90)
+    (should (equal (image--compute-map image)
+                   rotated-map))
+    (setf (image-property image :rotation) 0)
+    (setf (image-property image :flip) t)
+    (should (equal (image--compute-map image)
+                   flipped-map))
+    (setf (image-property image :scale) 2)
+    (setf (image-property image :rotation) 90)
+    (should (equal (image--compute-map image)
+                   scaled-rotated-flipped-map))
+
+    ;; Uncomment to test manually by interactively transforming the
+    ;; image and checking the map boundaries by hovering them.
+
+    ;; (with-current-buffer (get-buffer-create "*test image map*")
+    ;;   (erase-buffer)
+    ;;   (insert-image image)
+    ;;   (goto-char (point-min))
+    ;;   (pop-to-buffer (current-buffer)))
+    ))
+
+(ert-deftest image-transform-map ()
+  "Test functions related to transforming image maps."
+  (let ((map '(((circle (4 . 3) . 2) "circle")
+               ((rect (3 . 6) 8 . 8) "rect")
+               ((poly . [6 11 7 13 2 14]) "poly")))
+        (width 10)
+        (height 15))
+    (should (equal (image--scale-map (copy-tree map t) 2)
+                   '(((circle (8 . 6) . 4) "circle")
+                     ((rect (6 . 12) 16 . 16) "rect")
+                     ((poly . [12 22 14 26 4 28]) "poly"))))
+    (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height))
+                   '(((circle (12 . 4) . 2) "circle")
+                     ((rect (7 . 3) 9 . 8) "rect")
+                     ((poly . [4 6 2 7 1 2]) "poly"))))
+    (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height))
+                   '(((circle (6 . 3) . 2) "circle")
+                     ((rect (2 . 6) 7 . 8) "rect")
+                     ((poly . [4 11 3 13 8 14]) "poly"))))
+    (let ((copy (copy-tree map t)))
+      (image--scale-map copy 2)
+      ;; Scale size because the map has been scaled.
+      (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height)))
+      ;; Swap width and height because the map has been flipped.
+      (image--flip-map copy t `(,(* 2 height) . ,(* 2 width)))
+      (should (equal copy
+                     '(((circle (6 . 8) . 4) "circle")
+                       ((rect (12 . 6) 16 . 16) "rect")
+                       ((poly . [22 12 26 14 28 4]) "poly")))))))
+
 ;;; image-tests.el ends here
-- 
2.41.0

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> From: Joseph Turner <joseph@breatheoutbreathe.in>
> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
> Date: Wed, 20 Mar 2024 23:45:34 -0700
> 
> > I had in mind a special variable (we'd need to mention it in NEWS and
> > in the doc string of the relevant functions).  Adding an argument is a
> > heavier change, and I think it is not justified in this case, because
> > I do agree with you that most, if not all, applications would want the
> > coordinates to scale together with the image.
> 
> Thanks for your feedback and your patience!
> 
> Please see attached patch.

Thanks.  The tests you added have some problems:

 . you use thread-first, but don't require subr-x when compiling
 . the tests fail when run in batch mode
 . when invoked interactively in a GUI session, one test fails:

    F image--compute-map-and-original-map
	Test ‘image--compute-map’ and ‘image--compute-original-map’.
	(ert-test-failed
	 ((should (equal (image--compute-map image) flipped-map)) :form
	  (equal
	   (((circle ... . 24) "a" (help-echo "A"))
	    ((rect ... 162 . 149) "b" (help-echo "B"))
	    ((poly . [6 29 7 22 13 15 21 10 31 7 ...]) "c" (help-echo "C")))
	   (((circle ... . 24) "a" (help-echo "A"))
	    ((rect ... 161 . 149) "b" (help-echo "B"))
	    ((poly . [5 29 6 22 12 15 20 10 30 7 ...]) "c" (help-echo "C"))))
	  :value nil :explanation (list-elt 0 (list-elt 0 (cdr (car ...))))))

It looks like some pixels do not match exactly?  Perhaps some
tolerances need to be allowed?

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 2009 bytes --]


Eli Zaretskii <eliz@gnu.org> writes:

>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
>> Date: Wed, 20 Mar 2024 23:45:34 -0700
>>
>> > I had in mind a special variable (we'd need to mention it in NEWS and
>> > in the doc string of the relevant functions).  Adding an argument is a
>> > heavier change, and I think it is not justified in this case, because
>> > I do agree with you that most, if not all, applications would want the
>> > coordinates to scale together with the image.
>>
>> Thanks for your feedback and your patience!
>>
>> Please see attached patch.
>
> Thanks.  The tests you added have some problems:
>
>  . you use thread-first, but don't require subr-x when compiling

I removed thread-first.

>  . the tests fail when run in batch mode

I added (skip-unless (display-images-p)) to the two problematic tests,
and it solved the issue on my machine.

>  . when invoked interactively in a GUI session, one test fails:
>
>     F image--compute-map-and-original-map
> 	Test ‘image--compute-map’ and ‘image--compute-original-map’.
> 	(ert-test-failed
> 	 ((should (equal (image--compute-map image) flipped-map)) :form
> 	  (equal
> 	   (((circle ... . 24) "a" (help-echo "A"))
> 	    ((rect ... 162 . 149) "b" (help-echo "B"))
> 	    ((poly . [6 29 7 22 13 15 21 10 31 7 ...]) "c" (help-echo "C")))
> 	   (((circle ... . 24) "a" (help-echo "A"))
> 	    ((rect ... 161 . 149) "b" (help-echo "B"))
> 	    ((poly . [5 29 6 22 12 15 20 10 30 7 ...]) "c" (help-echo "C"))))
> 	  :value nil :explanation (list-elt 0 (list-elt 0 (cdr (car ...))))))
>
> It looks like some pixels do not match exactly?  Perhaps some
> tolerances need to be allowed?

Interesting - does the result of `image-size` vary per machine?

In any case, I added `image-tests--map-equal' to compare image maps with
some tolerance. Do the tests pass on your machine now?

Thank you!

Joseph


[-- Attachment #2: 0001-Recompute-map-when-image-scale-rotation-or-flip-chan.patch --]
[-- Type: text/x-diff, Size: 28039 bytes --]

From 4a0c7fc0d0354f60ee856cc50e743ee3034ac2a7 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Thu, 7 Mar 2024 21:55:00 -0800
Subject: [PATCH] Recompute :map when image :scale, :rotation, or :flip changes

Now, when transforming an image, its :map is recomputed to fit.

Image map coordinates are integers, so when computing :map, coordinates
are rounded.  To prevent an image from drifting from its map after
repeated transformations, `create-image' now adds a new image property
:original-map, which is combined with the image's transformation
parameters to recompute :map.

* lisp/image.el (image-recompute-map-p): Add user option to control
whether :map is recomputed when an image is transformed.
(create-image): Create :map from :original-map and vice versa.
(image--delayed-change-size): Fix comment.
(image--change-size, image-rotate, image-flip-horizontally,
image-flip-vertically): Recompute image map after transformation and
mention image-recompute-map-p in docstring.
(image--compute-map): Add function to compute a map from original map.
(image--compute-map): Add function to compute an original map from map.
(image--scale-map): Add function to scale a map based on :scale.
(image--rotate-map): Add function to rotate a map based on :rotation.
(image--rotate-coord): Add function to rotate a map coordinate pair.
(image--flip-map): Add function to flip a map based on :flip.
(image-increase-size, image-decrease-size, image-mouse-increase-size,
image-mouse-decrease-size): Mention image-recompute-map-p in docstring.
* etc/NEWS: Add NEWS entry.
* doc/lispref/display.texi (Image Descriptors): Document :original-map
and new user option image-recompute-map-p.
* test/lisp/image-tests.el (image--compute-map-and-original-map): Test
`image--compute-map' and `image--compute-original-map'.
(image-tests--map-equal): Add equality predicate to compare image maps.
(image-create-image-with-map): Test that `create-image' adds :map and/or
:original-map as appropriate.
(image-transform-map): Test functions related to transforming maps.
---
 doc/lispref/display.texi |  24 +++++
 etc/NEWS                 |  12 +++
 lisp/image.el            | 221 ++++++++++++++++++++++++++++++++++++---
 test/lisp/image-tests.el | 143 +++++++++++++++++++++++++
 4 files changed, 388 insertions(+), 12 deletions(-)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 10cf5ce89e2..8335a02b5c5 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6055,6 +6055,30 @@ Image Descriptors
 when creating the image, or use the result of
 @code{image-compute-scaling-factor} to compute the elements of the
 map.
+
+When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is
+changed, @code{:map} will be recomputed based on the value of
+@code{:original-map} and the values of those transformation.
+
+@item :original-map @var{original-map}
+@cindex original image map
+This specifies the untransformed image map which will be used to
+recompute @code{:map} after the image's @code{:scale}, @code{:rotation},
+or @code{:flip} is changed.
+
+If @code{:original-map} is not specified when creating an image with
+@code{create-image}, it will be computed based on the supplied
+@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or
+@code{:flip} which are non-nil.
+
+Conversely, if @code{:original-map} is specified but @code{:map} is not,
+@code{:map} will be computed based on @code{:original-map},
+@code{:scale}, @code{:rotation}, and @code{:flip}.
+
+@defopt image-recompute-map-p
+Set this user option to nil to prevent Emacs from automatically
+recomputing an image @code{:map} based on its @code{:original-map}.
+@end defopt
 @end table
 
 @defun image-mask-p spec &optional frame
diff --git a/etc/NEWS b/etc/NEWS
index 06856602ea8..cbd97b495b2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1292,6 +1292,18 @@ without specifying a file, like this:
     (notifications-notify
       :title "I am playing music" :app-icon 'multimedia-player)
 
+** Image
+
++++
+*** Image :map property is now recomputed when image is transformed.
+Now images with clickable maps work as expected after you run commands
+such as `image-increase-size', `image-decrease-size', `image-rotate',
+`image-flip-horizontally', and `image-flip-vertically'.
+
++++
+*** New user option 'image-recompute-map-p'
+Set this option to nil to prevent Emacs from recomputing image maps.
+
 ** Image Dired
 
 *** New user option 'image-dired-thumb-naming'.
diff --git a/lisp/image.el b/lisp/image.el
index 2ebce59a98c..c5082c78b75 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -533,6 +533,16 @@ create-image
                                    ('t t)
                                    ('nil nil)
                                    (func (funcall func image)))))))
+      ;; Add original map from map.
+      (when (and (plist-get props :map)
+                 (not (plist-get props :original-map)))
+        (setq image (nconc image (list :original-map
+                                       (image--compute-original-map image)))))
+      ;; Add map from original map.
+      (when (and (plist-get props :original-map)
+                 (not (plist-get props :map)))
+        (setq image (nconc image (list :map
+                                       (image--compute-map image)))))
       image)))
 
 (defun image--default-smoothing (image)
@@ -1173,7 +1183,10 @@ image-increase-size
 If N is 3, then the image size will be increased by 30%.  More
 generally, the image size is multiplied by 1 plus N divided by 10.
 N defaults to 2, which increases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "P")
   (image--delayed-change-size (if n
                                   (1+ (/ (prefix-numeric-value n) 10.0))
@@ -1185,7 +1198,7 @@ image-increase-size
 (defun image--delayed-change-size (size position)
   ;; Wait for a bit of idle-time before actually performing the change,
   ;; so as to batch together sequences of closely consecutive size changes.
-  ;; `image--change-size' just changes one value in a plist.  The actual
+  ;; `image--change-size' just changes two values in a plist.  The actual
   ;; image resizing happens later during redisplay.  So if those
   ;; consecutive calls happen without any redisplay between them,
   ;; the costly operation of image resizing should happen only once.
@@ -1196,7 +1209,10 @@ image-decrease-size
 If N is 3, then the image size will be decreased by 30%.  More
 generally, the image size is multiplied by 1 minus N divided by 10.
 N defaults to 2, which decreases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "P")
   (image--delayed-change-size (if n
                                   (- 1 (/ (prefix-numeric-value n) 10.0))
@@ -1208,7 +1224,10 @@ image-decrease-size
 (defun image-mouse-increase-size (&optional event)
   "Increase the image size using the mouse-gesture EVENT.
 This increases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-increase-size'."
+EVENT, if any, by the default factor used by `image-increase-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "e")
   (when (listp event)
     (save-window-excursion
@@ -1218,7 +1237,10 @@ image-mouse-increase-size
 (defun image-mouse-decrease-size (&optional event)
   "Decrease the image size using the mouse-gesture EVENT.
 This decreases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-decrease-size'."
+EVENT, if any, by the default factor used by `image-decrease-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "e")
   (when (listp event)
     (save-window-excursion
@@ -1269,7 +1291,9 @@ image--change-size
          (new-image (image--image-without-parameters image))
          (scale (image--current-scaling image new-image)))
     (setcdr image (cdr new-image))
-    (plist-put (cdr image) :scale (* scale factor))))
+    (plist-put (cdr image) :scale (* scale factor))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (defun image--image-without-parameters (image)
   (cons (pop image)
@@ -1296,7 +1320,10 @@ image-rotate
 If nil, ANGLE defaults to 90.  Interactively, rotate the image 90
 degrees clockwise with no prefix argument, and counter-clockwise
 with a prefix argument.  Note that most image types support
-rotations by only multiples of 90 degrees."
+rotations by only multiples of 90 degrees.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive (and current-prefix-arg '(-90)))
   (let ((image (image--get-imagemagick-and-warn)))
     (setf (image-property image :rotation)
@@ -1304,7 +1331,9 @@ image-rotate
                          (or angle 90))
                       ;; We don't want to exceed 360 degrees rotation,
                       ;; because it's not seen as valid in Exif data.
-                      360))))
+                      360)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image))))
   (set-transient-map image--repeat-map nil nil
                      "Use %k for further adjustments"))
 
@@ -1325,23 +1354,191 @@ image-save
                     (read-file-name "Write image to file: ")))))
 
 (defun image-flip-horizontally ()
-  "Horizontally flip the image under point."
+  "Horizontally flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive)
   (let ((image (image--get-image)))
     (image-flush image)
     (setf (image-property image :flip)
-          (not (image-property image :flip)))))
+          (not (image-property image :flip)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (defun image-flip-vertically ()
-  "Vertically flip the image under point."
+  "Vertically flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive)
   (let ((image (image--get-image)))
     (image-rotate 180)
     (setf (image-property image :flip)
-          (not (image-property image :flip)))))
+          (not (image-property image :flip)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (define-obsolete-function-alias 'image-refresh #'image-flush "29.1")
 
+;;; Map transformation
+
+(defcustom image-recompute-map-p t
+  "Recompute image map when scaling, rotating, or flipping an image."
+  :type 'boolean
+  :version "30.1")
+
+(defun image--compute-map (image)
+  "Compute map for IMAGE suitable to be used as its :map property.
+Return a copy of :original-image transformed based on IMAGE's :scale,
+:rotation, and :flip.  When IMAGE's :original-map is nil, return nil.
+When :rotation is not a multiple of 90, return copy of :original-map."
+  (pcase-let* ((original-map (image-property image :original-map))
+               (map (copy-tree original-map t))
+               (scale (or (image-property image :scale) 1))
+               (rotation (or (image-property image :rotation) 0))
+               (flip (image-property image :flip))
+               ((and size `(,width . ,height)) (image-size image t)))
+    (when (and ; Handle only 90-degree rotations
+           (zerop (mod rotation 1))
+           (zerop (% (truncate rotation) 90)))
+      ;; SIZE fits MAP after transformations.  Scale MAP before
+      ;; flip and rotate operations, since both need MAP to fit SIZE.
+      (image--scale-map map scale)
+      ;; In rendered images, rotation is always applied before flip.
+      (image--rotate-map
+       map rotation (if (or (= 90 rotation) (= 270 rotation))
+                        ;; If rotated ±90°, swap width and height.
+                        (cons height width)
+                      size))
+      ;; After rotation, there's no need to swap width and height.
+      (image--flip-map map flip size))
+    map))
+
+(defun image--compute-original-map (image)
+  "Return original map for IMAGE.
+If IMAGE lacks :map property, return nil.
+When :rotation is not a multiple of 90, return copy of :map."
+  (when (image-property image :map)
+    (let* ((image-copy (copy-tree image t))
+           (map (image-property image-copy :map))
+           (scale (or (image-property image-copy :scale) 1))
+           (rotation (or (image-property image-copy :rotation) 0))
+           (flip (image-property image-copy :flip))
+           (size (image-size image-copy t)))
+      (when (and ; Handle only 90-degree rotations
+             (zerop (mod rotation 1))
+             (zerop (% (truncate rotation) 90)))
+        ;; In rendered images, rotation is always applied before flip.
+        ;; To undo the transformation, flip before rotating.
+        ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP.
+        ;; Therefore, scale MAP after flip and rotate operations, since
+        ;; both need MAP to fit SIZE.
+        (image--flip-map map flip size)
+        (image--rotate-map map (- rotation) size)
+        (image--scale-map map (/ 1.0 scale)))
+      map)))
+
+(defun image--scale-map (map scale)
+  "Scale MAP according to SCALE.
+Destructively modifies and returns MAP."
+  (unless (= 1 scale)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (setf (caar coords) (round (* (caar coords) scale)))
+         (setf (cdar coords) (round (* (cdar coords) scale)))
+         (setf (cadr coords) (round (* (cadr coords) scale)))
+         (setf (cddr coords) (round (* (cddr coords) scale))))
+        ('circle
+         (setf (caar coords) (round (* (caar coords) scale)))
+         (setf (cdar coords) (round (* (cdar coords) scale)))
+         (setcdr coords (round (* (cdr coords) scale))))
+        ('poly
+         (dotimes (i (length coords))
+           (aset coords i
+                 (round (* (aref coords i) scale))))))))
+  map)
+
+(defun image--rotate-map (map rotation size)
+  "Rotate MAP according to ROTATION and SIZE.
+Destructively modifies and returns MAP."
+  (unless (zerop rotation)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (let ( x0 y0  ; New upper left corner
+                x1 y1) ; New bottom right corner
+           (pcase (truncate (mod rotation 360)) ; Set new corners to...
+             (90 ; ...old bottom left and upper right
+              (setq x0 (caar coords) y0 (cddr coords)
+                    x1 (cadr coords) y1 (cdar coords)))
+             (180 ; ...old bottom right and upper left
+              (setq x0 (cadr coords) y0 (cddr coords)
+                    x1 (caar coords) y1 (cdar coords)))
+             (270 ; ...old upper right and bottom left
+              (setq x0 (cadr coords) y0 (cdar coords)
+                    x1 (caar coords) y1 (cddr coords))))
+           (setcar coords (image--rotate-coord x0 y0 rotation size))
+           (setcdr coords (image--rotate-coord x1 y1 rotation size))))
+        ('circle
+         (setcar coords (image--rotate-coord
+                         (caar coords) (cdar coords) rotation size)))
+        ('poly
+         (dotimes (i (length coords))
+           (when (= 0 (% i 2))
+             (pcase-let ((`(,x . ,y)
+                          (image--rotate-coord
+                           (aref coords i) (aref coords (1+ i)) rotation size)))
+               (aset coords i x)
+               (aset coords (1+ i) y))))))))
+  map)
+
+(defun image--rotate-coord (x y angle size)
+  "Rotate coordinates X and Y by ANGLE in image of SIZE.
+ANGLE must be a multiple of 90.  Returns a cons cell of rounded
+coordinates (X1 Y1)."
+  (pcase-let* ((radian (* (/ angle 180.0) float-pi))
+               (`(,width . ,height) size)
+               ;; y is positive, but we are in the bottom-right quadrant
+               (y (- y))
+               ;; Rotate clockwise
+               (x1 (+ (* (sin radian) y) (* (cos radian) x)))
+               (y1 (- (* (cos radian) y) (* (sin radian) x)))
+               ;; Translate image back into bottom-right quadrant
+               (`(,x1 . ,y1)
+                (pcase (truncate (mod angle 360))
+                  (90 ; Translate right by height
+                   (cons (+ x1 height) y1))
+                  (180 ; Translate right by width and down by height
+                   (cons (+ x1 width) (- y1 height)))
+                  (270 ; Translate down by width
+                   (cons x1 (- y1 width)))))
+               ;; Invert y1 to make both x1 and y1 positive
+               (y1 (- y1)))
+    (cons (round x1) (round y1))))
+
+(defun image--flip-map (map flip size)
+  "Horizontally flip MAP according to FLIP and SIZE.
+Destructively modifies and returns MAP."
+  (when flip
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (let ((x0 (- (car size) (cadr coords)))
+               (y0 (cdar coords))
+               (x1 (- (car size) (caar coords)))
+               (y1 (cddr coords)))
+           (setcar coords (cons x0 y0))
+           (setcdr coords (cons x1 y1))))
+        ('circle
+         (setf (caar coords) (- (car size) (caar coords))))
+        ('poly
+         (dotimes (i (length coords))
+           (when (= 0 (% i 2))
+             (aset coords i (- (car size) (aref coords i)))))))))
+  map)
+
 (provide 'image)
 
 ;;; image.el ends here
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index 80142d6d6de..46b1704f25a 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -153,4 +153,147 @@ image-rotate
     (image-rotate -154.5)
     (should (equal image '(image :rotation 91.0)))))
 
+;;;; Transforming maps
+
+(ert-deftest image-create-image-with-map ()
+  "Test that `create-image' correctly adds :map and/or :original-map."
+  (skip-unless (display-images-p))
+  (let ((data "foo")
+        (map '(((circle (1 .  1) .  1) a)))
+        (original-map '(((circle (2 .  2) .  2) a)))
+        (original-map-other '(((circle (3 . 3) . 3) a))))
+    ;; Generate :original-map from :map.
+    (let* ((image (create-image data 'svg t :map map :scale 0.5))
+           (got-original-map (image-property image :original-map)))
+      (should (equal got-original-map original-map)))
+    ;; Generate :map from :original-map.
+    (let* ((image (create-image
+                   data 'svg t :original-map original-map :scale 0.5))
+           (got-map (image-property image :map)))
+      (should (equal got-map map)))
+    ;; Use :original-map if both it and :map are specified.
+    (let* ((image (create-image
+                   data 'svg t :map map
+                   :original-map original-map-other :scale 0.5))
+           (got-original-map (image-property image :original-map)))
+      (should (equal got-original-map original-map-other)))))
+
+(defun image-tests--map-equal (a b &optional tolerance)
+  "Return t if maps A and B have the same coordinates within TOLERANCE.
+Since image sizes calculations vary on different machines, this function
+allows for each image map coordinate in A to be within TOLERANCE to the
+corresponding coordinate in B.  When nil, TOLERANCE defaults to 5."
+  (unless tolerance (setq tolerance 5))
+  (catch 'different
+    (cl-labels ((check-tolerance
+                  (coord-a coord-b)
+                  (unless (>= tolerance (abs (- coord-a coord-b)))
+                    (throw 'different nil))))
+      (dotimes (i (length a) t)
+        (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a))
+                    (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b)))
+          (unless (eq type-a type-b)
+            (throw 'different nil))
+          (pcase-exhaustive type-a
+            ('rect
+             (check-tolerance (caar coords-a) (caar coords-b))
+             (check-tolerance (cdar coords-a) (cdar coords-b))
+             (check-tolerance (cadr coords-a) (cadr coords-b))
+             (check-tolerance (cddr coords-a) (cddr coords-b)))
+            ('circle
+             (check-tolerance (caar coords-a) (caar coords-b))
+             (check-tolerance (cdar coords-a) (cdar coords-b))
+             (check-tolerance (cdar coords-a) (cdar coords-b)))
+            ('poly
+             (dotimes (i (length coords-a))
+               (check-tolerance (aref coords-a i) (aref coords-b i))))))))))
+
+(ert-deftest image--compute-map-and-original-map ()
+  "Test `image--compute-map' and `image--compute-original-map'."
+  (skip-unless (display-images-p))
+  (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?><svg width=\"125pt\" height=\"116pt\" viewBox=\"0.00 0.00 125.00 116.00\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><g transform=\"scale(1 1) rotate(0) translate(4 112)\"><polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-112 121,-112 121,4 -4,4\"/><a xlink:href=\"a\"><ellipse fill=\"none\" stroke=\"black\" cx=\"27\" cy=\"-90\" rx=\"18\" ry=\"18\"/><text text-anchor=\"middle\" x=\"27\" y=\"-86.3\" fill=\"#000000\">A</text></a><a xlink:href=\"b\"><polygon fill=\"none\" stroke=\"black\" points=\"54,-36 0,-36 0,0 54,0 54,-36\"/><text text-anchor=\"middle\" x=\"27\" y=\"-14.3\" fill=\"#000000\">B</text></a><a xlink:href=\"c\"><ellipse fill=\"none\" stroke=\"black\" cx=\"90\" cy=\"-90\" rx=\"27\" ry=\"18\"/><text text-anchor=\"middle\" x=\"90\" y=\"-86.3\" fill=\"#000000\">C</text></a></g></svg>")
+         (original-map
+          '(((circle (41 . 29) . 24) "a" (help-echo "A"))
+            ((rect (5 . 101) 77 . 149) "b" (help-echo "B"))
+            ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96 15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37]) "c" (help-echo "C"))))
+         (scaled-map
+          '(((circle (82 . 58) . 48) "a" (help-echo "A"))
+            ((rect (10 . 202) 154 . 298) "b" (help-echo "B"))
+            ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20 192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86 320 74]) "c" (help-echo "C"))))
+         (flipped-map
+          '(((circle (125 . 29) . 24) "a" (help-echo "A"))
+            ((rect (89 . 101) 161 . 149) "b" (help-echo "B"))
+            ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22 77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo "C"))))
+         (rotated-map
+          '(((circle (126 . 41) . 24) "a" (help-echo "A"))
+            ((rect (6 . 5) 54 . 77) "b" (help-echo "B"))
+            ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114 145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106 146 112 154 118 160]) "c" (help-echo "C"))))
+         (scaled-rotated-flipped-map
+          '(((circle (58 . 82) . 48) "a" (help-echo "A"))
+            ((rect (202 . 10) 298 . 154) "b" (help-echo "B"))
+            ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208 30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308 74 320]) "c" (help-echo "C"))))
+         (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map
+                              :scale 2 :rotation 90 :flip t)))
+    ;; Test that `image--compute-original-map' correctly generates
+    ;; original-map when creating an already transformed image.
+    (should (image-tests--map-equal (image-property image :original-map)
+                                    original-map))
+    (setf (image-property image :flip) nil)
+    (setf (image-property image :rotation) 0)
+    (setf (image-property image :scale) 2)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    scaled-map))
+    (setf (image-property image :scale) 1)
+    (setf (image-property image :rotation) 90)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    rotated-map))
+    (setf (image-property image :rotation) 0)
+    (setf (image-property image :flip) t)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    flipped-map))
+    (setf (image-property image :scale) 2)
+    (setf (image-property image :rotation) 90)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    scaled-rotated-flipped-map))
+
+    ;; Uncomment to test manually by interactively transforming the
+    ;; image and checking the map boundaries by hovering them.
+
+    ;; (with-current-buffer (get-buffer-create "*test image map*")
+    ;;   (erase-buffer)
+    ;;   (insert-image image)
+    ;;   (goto-char (point-min))
+    ;;   (pop-to-buffer (current-buffer)))
+    ))
+
+(ert-deftest image-transform-map ()
+  "Test functions related to transforming image maps."
+  (let ((map '(((circle (4 . 3) . 2) "circle")
+               ((rect (3 . 6) 8 . 8) "rect")
+               ((poly . [6 11 7 13 2 14]) "poly")))
+        (width 10)
+        (height 15))
+    (should (equal (image--scale-map (copy-tree map t) 2)
+                   '(((circle (8 . 6) . 4) "circle")
+                     ((rect (6 . 12) 16 . 16) "rect")
+                     ((poly . [12 22 14 26 4 28]) "poly"))))
+    (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height))
+                   '(((circle (12 . 4) . 2) "circle")
+                     ((rect (7 . 3) 9 . 8) "rect")
+                     ((poly . [4 6 2 7 1 2]) "poly"))))
+    (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height))
+                   '(((circle (6 . 3) . 2) "circle")
+                     ((rect (2 . 6) 7 . 8) "rect")
+                     ((poly . [4 11 3 13 8 14]) "poly"))))
+    (let ((copy (copy-tree map t)))
+      (image--scale-map copy 2)
+      ;; Scale size because the map has been scaled.
+      (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height)))
+      ;; Swap width and height because the map has been flipped.
+      (image--flip-map copy t `(,(* 2 height) . ,(* 2 width)))
+      (should (equal copy
+                     '(((circle (6 . 8) . 4) "circle")
+                       ((rect (12 . 6) 16 . 16) "rect")
+                       ((poly . [22 12 26 14 28 4]) "poly")))))))
+
 ;;; image-tests.el ends here
-- 
2.41.0

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> From: Joseph Turner <joseph@breatheoutbreathe.in>
> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
> Date: Fri, 22 Mar 2024 17:11:17 -0700
> 
> > Thanks.  The tests you added have some problems:
> >
> >  . you use thread-first, but don't require subr-x when compiling
> 
> I removed thread-first.
> 
> >  . the tests fail when run in batch mode
> 
> I added (skip-unless (display-images-p)) to the two problematic tests,
> and it solved the issue on my machine.

Solves it here as well.

> >  . when invoked interactively in a GUI session, one test fails:
> >
> >     F image--compute-map-and-original-map
> > 	Test ‘image--compute-map’ and ‘image--compute-original-map’.
> > 	(ert-test-failed
> > 	 ((should (equal (image--compute-map image) flipped-map)) :form
> > 	  (equal
> > 	   (((circle ... . 24) "a" (help-echo "A"))
> > 	    ((rect ... 162 . 149) "b" (help-echo "B"))
> > 	    ((poly . [6 29 7 22 13 15 21 10 31 7 ...]) "c" (help-echo "C")))
> > 	   (((circle ... . 24) "a" (help-echo "A"))
> > 	    ((rect ... 161 . 149) "b" (help-echo "B"))
> > 	    ((poly . [5 29 6 22 12 15 20 10 30 7 ...]) "c" (help-echo "C"))))
> > 	  :value nil :explanation (list-elt 0 (list-elt 0 (cdr (car ...))))))
> >
> > It looks like some pixels do not match exactly?  Perhaps some
> > tolerances need to be allowed?
> 
> Interesting - does the result of `image-size` vary per machine?

I guess so.  The transformations are AFAIK done in floating-point
arithmetics, so some minor inaccuracies are possible.

> In any case, I added `image-tests--map-equal' to compare image maps with
> some tolerance. Do the tests pass on your machine now?

Yes, they do now, thanks.  However, there's a warning when compiling
the tests:

  In image-tests--map-equal:
  lisp/image-tests.el:192:17: Warning: Unused lexical variable `i'

Can you fix this, please?

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 2138 bytes --]


Eli Zaretskii <eliz@gnu.org> writes:

>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
>> Date: Fri, 22 Mar 2024 17:11:17 -0700
>>
>> > Thanks.  The tests you added have some problems:
>> >
>> >  . you use thread-first, but don't require subr-x when compiling
>>
>> I removed thread-first.
>>
>> >  . the tests fail when run in batch mode
>>
>> I added (skip-unless (display-images-p)) to the two problematic tests,
>> and it solved the issue on my machine.
>
> Solves it here as well.
>
>> >  . when invoked interactively in a GUI session, one test fails:
>> >
>> >     F image--compute-map-and-original-map
>> > 	Test ‘image--compute-map’ and ‘image--compute-original-map’.
>> > 	(ert-test-failed
>> > 	 ((should (equal (image--compute-map image) flipped-map)) :form
>> > 	  (equal
>> > 	   (((circle ... . 24) "a" (help-echo "A"))
>> > 	    ((rect ... 162 . 149) "b" (help-echo "B"))
>> > 	    ((poly . [6 29 7 22 13 15 21 10 31 7 ...]) "c" (help-echo "C")))
>> > 	   (((circle ... . 24) "a" (help-echo "A"))
>> > 	    ((rect ... 161 . 149) "b" (help-echo "B"))
>> > 	    ((poly . [5 29 6 22 12 15 20 10 30 7 ...]) "c" (help-echo "C"))))
>> > 	  :value nil :explanation (list-elt 0 (list-elt 0 (cdr (car ...))))))
>> >
>> > It looks like some pixels do not match exactly?  Perhaps some
>> > tolerances need to be allowed?
>>
>> Interesting - does the result of `image-size` vary per machine?
>
> I guess so.  The transformations are AFAIK done in floating-point
> arithmetics, so some minor inaccuracies are possible.
>
>> In any case, I added `image-tests--map-equal' to compare image maps with
>> some tolerance. Do the tests pass on your machine now?
>
> Yes, they do now, thanks.  However, there's a warning when compiling
> the tests:
>
>   In image-tests--map-equal:
>   lisp/image-tests.el:192:17: Warning: Unused lexical variable `i'
>
> Can you fix this, please?

Oops!  I just re-read the dotimes docstring to discover that the RESULT
arg is deprecated.  Fixed.  Thank you!

Joseph


[-- Attachment #2: 0001-Recompute-map-when-image-scale-rotation-or-flip-chan.patch --]
[-- Type: text/x-diff, Size: 28045 bytes --]

From 0b6f90a1ba757426ff429693914828ce0d93d839 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Thu, 7 Mar 2024 21:55:00 -0800
Subject: [PATCH] Recompute :map when image :scale, :rotation, or :flip changes

Now, when transforming an image, its :map is recomputed to fit.

Image map coordinates are integers, so when computing :map, coordinates
are rounded.  To prevent an image from drifting from its map after
repeated transformations, `create-image' now adds a new image property
:original-map, which is combined with the image's transformation
parameters to recompute :map.

* lisp/image.el (image-recompute-map-p): Add user option to control
whether :map is recomputed when an image is transformed.
(create-image): Create :map from :original-map and vice versa.
(image--delayed-change-size): Fix comment.
(image--change-size, image-rotate, image-flip-horizontally,
image-flip-vertically): Recompute image map after transformation and
mention image-recompute-map-p in docstring.
(image--compute-map): Add function to compute a map from original map.
(image--compute-map): Add function to compute an original map from map.
(image--scale-map): Add function to scale a map based on :scale.
(image--rotate-map): Add function to rotate a map based on :rotation.
(image--rotate-coord): Add function to rotate a map coordinate pair.
(image--flip-map): Add function to flip a map based on :flip.
(image-increase-size, image-decrease-size, image-mouse-increase-size,
image-mouse-decrease-size): Mention image-recompute-map-p in docstring.
* etc/NEWS: Add NEWS entry.
* doc/lispref/display.texi (Image Descriptors): Document :original-map
and new user option image-recompute-map-p.
* test/lisp/image-tests.el (image--compute-map-and-original-map): Test
`image--compute-map' and `image--compute-original-map'.
(image-tests--map-equal): Add equality predicate to compare image maps.
(image-create-image-with-map): Test that `create-image' adds :map and/or
:original-map as appropriate.
(image-transform-map): Test functions related to transforming maps.
---
 doc/lispref/display.texi |  24 +++++
 etc/NEWS                 |  12 +++
 lisp/image.el            | 221 ++++++++++++++++++++++++++++++++++++---
 test/lisp/image-tests.el | 144 +++++++++++++++++++++++++
 4 files changed, 389 insertions(+), 12 deletions(-)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 10cf5ce89e2..8335a02b5c5 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6055,6 +6055,30 @@ Image Descriptors
 when creating the image, or use the result of
 @code{image-compute-scaling-factor} to compute the elements of the
 map.
+
+When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is
+changed, @code{:map} will be recomputed based on the value of
+@code{:original-map} and the values of those transformation.
+
+@item :original-map @var{original-map}
+@cindex original image map
+This specifies the untransformed image map which will be used to
+recompute @code{:map} after the image's @code{:scale}, @code{:rotation},
+or @code{:flip} is changed.
+
+If @code{:original-map} is not specified when creating an image with
+@code{create-image}, it will be computed based on the supplied
+@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or
+@code{:flip} which are non-nil.
+
+Conversely, if @code{:original-map} is specified but @code{:map} is not,
+@code{:map} will be computed based on @code{:original-map},
+@code{:scale}, @code{:rotation}, and @code{:flip}.
+
+@defopt image-recompute-map-p
+Set this user option to nil to prevent Emacs from automatically
+recomputing an image @code{:map} based on its @code{:original-map}.
+@end defopt
 @end table
 
 @defun image-mask-p spec &optional frame
diff --git a/etc/NEWS b/etc/NEWS
index 06856602ea8..cbd97b495b2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1292,6 +1292,18 @@ without specifying a file, like this:
     (notifications-notify
       :title "I am playing music" :app-icon 'multimedia-player)
 
+** Image
+
++++
+*** Image :map property is now recomputed when image is transformed.
+Now images with clickable maps work as expected after you run commands
+such as `image-increase-size', `image-decrease-size', `image-rotate',
+`image-flip-horizontally', and `image-flip-vertically'.
+
++++
+*** New user option 'image-recompute-map-p'
+Set this option to nil to prevent Emacs from recomputing image maps.
+
 ** Image Dired
 
 *** New user option 'image-dired-thumb-naming'.
diff --git a/lisp/image.el b/lisp/image.el
index 2ebce59a98c..c5082c78b75 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -533,6 +533,16 @@ create-image
                                    ('t t)
                                    ('nil nil)
                                    (func (funcall func image)))))))
+      ;; Add original map from map.
+      (when (and (plist-get props :map)
+                 (not (plist-get props :original-map)))
+        (setq image (nconc image (list :original-map
+                                       (image--compute-original-map image)))))
+      ;; Add map from original map.
+      (when (and (plist-get props :original-map)
+                 (not (plist-get props :map)))
+        (setq image (nconc image (list :map
+                                       (image--compute-map image)))))
       image)))
 
 (defun image--default-smoothing (image)
@@ -1173,7 +1183,10 @@ image-increase-size
 If N is 3, then the image size will be increased by 30%.  More
 generally, the image size is multiplied by 1 plus N divided by 10.
 N defaults to 2, which increases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "P")
   (image--delayed-change-size (if n
                                   (1+ (/ (prefix-numeric-value n) 10.0))
@@ -1185,7 +1198,7 @@ image-increase-size
 (defun image--delayed-change-size (size position)
   ;; Wait for a bit of idle-time before actually performing the change,
   ;; so as to batch together sequences of closely consecutive size changes.
-  ;; `image--change-size' just changes one value in a plist.  The actual
+  ;; `image--change-size' just changes two values in a plist.  The actual
   ;; image resizing happens later during redisplay.  So if those
   ;; consecutive calls happen without any redisplay between them,
   ;; the costly operation of image resizing should happen only once.
@@ -1196,7 +1209,10 @@ image-decrease-size
 If N is 3, then the image size will be decreased by 30%.  More
 generally, the image size is multiplied by 1 minus N divided by 10.
 N defaults to 2, which decreases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "P")
   (image--delayed-change-size (if n
                                   (- 1 (/ (prefix-numeric-value n) 10.0))
@@ -1208,7 +1224,10 @@ image-decrease-size
 (defun image-mouse-increase-size (&optional event)
   "Increase the image size using the mouse-gesture EVENT.
 This increases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-increase-size'."
+EVENT, if any, by the default factor used by `image-increase-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "e")
   (when (listp event)
     (save-window-excursion
@@ -1218,7 +1237,10 @@ image-mouse-increase-size
 (defun image-mouse-decrease-size (&optional event)
   "Decrease the image size using the mouse-gesture EVENT.
 This decreases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-decrease-size'."
+EVENT, if any, by the default factor used by `image-decrease-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive "e")
   (when (listp event)
     (save-window-excursion
@@ -1269,7 +1291,9 @@ image--change-size
          (new-image (image--image-without-parameters image))
          (scale (image--current-scaling image new-image)))
     (setcdr image (cdr new-image))
-    (plist-put (cdr image) :scale (* scale factor))))
+    (plist-put (cdr image) :scale (* scale factor))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (defun image--image-without-parameters (image)
   (cons (pop image)
@@ -1296,7 +1320,10 @@ image-rotate
 If nil, ANGLE defaults to 90.  Interactively, rotate the image 90
 degrees clockwise with no prefix argument, and counter-clockwise
 with a prefix argument.  Note that most image types support
-rotations by only multiples of 90 degrees."
+rotations by only multiples of 90 degrees.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive (and current-prefix-arg '(-90)))
   (let ((image (image--get-imagemagick-and-warn)))
     (setf (image-property image :rotation)
@@ -1304,7 +1331,9 @@ image-rotate
                          (or angle 90))
                       ;; We don't want to exceed 360 degrees rotation,
                       ;; because it's not seen as valid in Exif data.
-                      360))))
+                      360)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image))))
   (set-transient-map image--repeat-map nil nil
                      "Use %k for further adjustments"))
 
@@ -1325,23 +1354,191 @@ image-save
                     (read-file-name "Write image to file: ")))))
 
 (defun image-flip-horizontally ()
-  "Horizontally flip the image under point."
+  "Horizontally flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive)
   (let ((image (image--get-image)))
     (image-flush image)
     (setf (image-property image :flip)
-          (not (image-property image :flip)))))
+          (not (image-property image :flip)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (defun image-flip-vertically ()
-  "Vertically flip the image under point."
+  "Vertically flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
   (interactive)
   (let ((image (image--get-image)))
     (image-rotate 180)
     (setf (image-property image :flip)
-          (not (image-property image :flip)))))
+          (not (image-property image :flip)))
+    (when (and (image-property image :original-map) image-recompute-map-p)
+      (setf (image-property image :map) (image--compute-map image)))))
 
 (define-obsolete-function-alias 'image-refresh #'image-flush "29.1")
 
+;;; Map transformation
+
+(defcustom image-recompute-map-p t
+  "Recompute image map when scaling, rotating, or flipping an image."
+  :type 'boolean
+  :version "30.1")
+
+(defun image--compute-map (image)
+  "Compute map for IMAGE suitable to be used as its :map property.
+Return a copy of :original-image transformed based on IMAGE's :scale,
+:rotation, and :flip.  When IMAGE's :original-map is nil, return nil.
+When :rotation is not a multiple of 90, return copy of :original-map."
+  (pcase-let* ((original-map (image-property image :original-map))
+               (map (copy-tree original-map t))
+               (scale (or (image-property image :scale) 1))
+               (rotation (or (image-property image :rotation) 0))
+               (flip (image-property image :flip))
+               ((and size `(,width . ,height)) (image-size image t)))
+    (when (and ; Handle only 90-degree rotations
+           (zerop (mod rotation 1))
+           (zerop (% (truncate rotation) 90)))
+      ;; SIZE fits MAP after transformations.  Scale MAP before
+      ;; flip and rotate operations, since both need MAP to fit SIZE.
+      (image--scale-map map scale)
+      ;; In rendered images, rotation is always applied before flip.
+      (image--rotate-map
+       map rotation (if (or (= 90 rotation) (= 270 rotation))
+                        ;; If rotated ±90°, swap width and height.
+                        (cons height width)
+                      size))
+      ;; After rotation, there's no need to swap width and height.
+      (image--flip-map map flip size))
+    map))
+
+(defun image--compute-original-map (image)
+  "Return original map for IMAGE.
+If IMAGE lacks :map property, return nil.
+When :rotation is not a multiple of 90, return copy of :map."
+  (when (image-property image :map)
+    (let* ((image-copy (copy-tree image t))
+           (map (image-property image-copy :map))
+           (scale (or (image-property image-copy :scale) 1))
+           (rotation (or (image-property image-copy :rotation) 0))
+           (flip (image-property image-copy :flip))
+           (size (image-size image-copy t)))
+      (when (and ; Handle only 90-degree rotations
+             (zerop (mod rotation 1))
+             (zerop (% (truncate rotation) 90)))
+        ;; In rendered images, rotation is always applied before flip.
+        ;; To undo the transformation, flip before rotating.
+        ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP.
+        ;; Therefore, scale MAP after flip and rotate operations, since
+        ;; both need MAP to fit SIZE.
+        (image--flip-map map flip size)
+        (image--rotate-map map (- rotation) size)
+        (image--scale-map map (/ 1.0 scale)))
+      map)))
+
+(defun image--scale-map (map scale)
+  "Scale MAP according to SCALE.
+Destructively modifies and returns MAP."
+  (unless (= 1 scale)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (setf (caar coords) (round (* (caar coords) scale)))
+         (setf (cdar coords) (round (* (cdar coords) scale)))
+         (setf (cadr coords) (round (* (cadr coords) scale)))
+         (setf (cddr coords) (round (* (cddr coords) scale))))
+        ('circle
+         (setf (caar coords) (round (* (caar coords) scale)))
+         (setf (cdar coords) (round (* (cdar coords) scale)))
+         (setcdr coords (round (* (cdr coords) scale))))
+        ('poly
+         (dotimes (i (length coords))
+           (aset coords i
+                 (round (* (aref coords i) scale))))))))
+  map)
+
+(defun image--rotate-map (map rotation size)
+  "Rotate MAP according to ROTATION and SIZE.
+Destructively modifies and returns MAP."
+  (unless (zerop rotation)
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (let ( x0 y0  ; New upper left corner
+                x1 y1) ; New bottom right corner
+           (pcase (truncate (mod rotation 360)) ; Set new corners to...
+             (90 ; ...old bottom left and upper right
+              (setq x0 (caar coords) y0 (cddr coords)
+                    x1 (cadr coords) y1 (cdar coords)))
+             (180 ; ...old bottom right and upper left
+              (setq x0 (cadr coords) y0 (cddr coords)
+                    x1 (caar coords) y1 (cdar coords)))
+             (270 ; ...old upper right and bottom left
+              (setq x0 (cadr coords) y0 (cdar coords)
+                    x1 (caar coords) y1 (cddr coords))))
+           (setcar coords (image--rotate-coord x0 y0 rotation size))
+           (setcdr coords (image--rotate-coord x1 y1 rotation size))))
+        ('circle
+         (setcar coords (image--rotate-coord
+                         (caar coords) (cdar coords) rotation size)))
+        ('poly
+         (dotimes (i (length coords))
+           (when (= 0 (% i 2))
+             (pcase-let ((`(,x . ,y)
+                          (image--rotate-coord
+                           (aref coords i) (aref coords (1+ i)) rotation size)))
+               (aset coords i x)
+               (aset coords (1+ i) y))))))))
+  map)
+
+(defun image--rotate-coord (x y angle size)
+  "Rotate coordinates X and Y by ANGLE in image of SIZE.
+ANGLE must be a multiple of 90.  Returns a cons cell of rounded
+coordinates (X1 Y1)."
+  (pcase-let* ((radian (* (/ angle 180.0) float-pi))
+               (`(,width . ,height) size)
+               ;; y is positive, but we are in the bottom-right quadrant
+               (y (- y))
+               ;; Rotate clockwise
+               (x1 (+ (* (sin radian) y) (* (cos radian) x)))
+               (y1 (- (* (cos radian) y) (* (sin radian) x)))
+               ;; Translate image back into bottom-right quadrant
+               (`(,x1 . ,y1)
+                (pcase (truncate (mod angle 360))
+                  (90 ; Translate right by height
+                   (cons (+ x1 height) y1))
+                  (180 ; Translate right by width and down by height
+                   (cons (+ x1 width) (- y1 height)))
+                  (270 ; Translate down by width
+                   (cons x1 (- y1 width)))))
+               ;; Invert y1 to make both x1 and y1 positive
+               (y1 (- y1)))
+    (cons (round x1) (round y1))))
+
+(defun image--flip-map (map flip size)
+  "Horizontally flip MAP according to FLIP and SIZE.
+Destructively modifies and returns MAP."
+  (when flip
+    (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+      (pcase-exhaustive type
+        ('rect
+         (let ((x0 (- (car size) (cadr coords)))
+               (y0 (cdar coords))
+               (x1 (- (car size) (caar coords)))
+               (y1 (cddr coords)))
+           (setcar coords (cons x0 y0))
+           (setcdr coords (cons x1 y1))))
+        ('circle
+         (setf (caar coords) (- (car size) (caar coords))))
+        ('poly
+         (dotimes (i (length coords))
+           (when (= 0 (% i 2))
+             (aset coords i (- (car size) (aref coords i)))))))))
+  map)
+
 (provide 'image)
 
 ;;; image.el ends here
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index 80142d6d6de..6a5f03e38a0 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -153,4 +153,148 @@ image-rotate
     (image-rotate -154.5)
     (should (equal image '(image :rotation 91.0)))))
 
+;;;; Transforming maps
+
+(ert-deftest image-create-image-with-map ()
+  "Test that `create-image' correctly adds :map and/or :original-map."
+  (skip-unless (display-images-p))
+  (let ((data "foo")
+        (map '(((circle (1 .  1) .  1) a)))
+        (original-map '(((circle (2 .  2) .  2) a)))
+        (original-map-other '(((circle (3 . 3) . 3) a))))
+    ;; Generate :original-map from :map.
+    (let* ((image (create-image data 'svg t :map map :scale 0.5))
+           (got-original-map (image-property image :original-map)))
+      (should (equal got-original-map original-map)))
+    ;; Generate :map from :original-map.
+    (let* ((image (create-image
+                   data 'svg t :original-map original-map :scale 0.5))
+           (got-map (image-property image :map)))
+      (should (equal got-map map)))
+    ;; Use :original-map if both it and :map are specified.
+    (let* ((image (create-image
+                   data 'svg t :map map
+                   :original-map original-map-other :scale 0.5))
+           (got-original-map (image-property image :original-map)))
+      (should (equal got-original-map original-map-other)))))
+
+(defun image-tests--map-equal (a b &optional tolerance)
+  "Return t if maps A and B have the same coordinates within TOLERANCE.
+Since image sizes calculations vary on different machines, this function
+allows for each image map coordinate in A to be within TOLERANCE to the
+corresponding coordinate in B.  When nil, TOLERANCE defaults to 5."
+  (unless tolerance (setq tolerance 5))
+  (catch 'different
+    (cl-labels ((check-tolerance
+                  (coord-a coord-b)
+                  (unless (>= tolerance (abs (- coord-a coord-b)))
+                    (throw 'different nil))))
+      (dotimes (i (length a))
+        (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a))
+                    (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b)))
+          (unless (eq type-a type-b)
+            (throw 'different nil))
+          (pcase-exhaustive type-a
+            ('rect
+             (check-tolerance (caar coords-a) (caar coords-b))
+             (check-tolerance (cdar coords-a) (cdar coords-b))
+             (check-tolerance (cadr coords-a) (cadr coords-b))
+             (check-tolerance (cddr coords-a) (cddr coords-b)))
+            ('circle
+             (check-tolerance (caar coords-a) (caar coords-b))
+             (check-tolerance (cdar coords-a) (cdar coords-b))
+             (check-tolerance (cdar coords-a) (cdar coords-b)))
+            ('poly
+             (dotimes (i (length coords-a))
+               (check-tolerance (aref coords-a i) (aref coords-b i))))))))
+    t))
+
+(ert-deftest image--compute-map-and-original-map ()
+  "Test `image--compute-map' and `image--compute-original-map'."
+  (skip-unless (display-images-p))
+  (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?><svg width=\"125pt\" height=\"116pt\" viewBox=\"0.00 0.00 125.00 116.00\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\"><g transform=\"scale(1 1) rotate(0) translate(4 112)\"><polygon fill=\"white\" stroke=\"transparent\" points=\"-4,4 -4,-112 121,-112 121,4 -4,4\"/><a xlink:href=\"a\"><ellipse fill=\"none\" stroke=\"black\" cx=\"27\" cy=\"-90\" rx=\"18\" ry=\"18\"/><text text-anchor=\"middle\" x=\"27\" y=\"-86.3\" fill=\"#000000\">A</text></a><a xlink:href=\"b\"><polygon fill=\"none\" stroke=\"black\" points=\"54,-36 0,-36 0,0 54,0 54,-36\"/><text text-anchor=\"middle\" x=\"27\" y=\"-14.3\" fill=\"#000000\">B</text></a><a xlink:href=\"c\"><ellipse fill=\"none\" stroke=\"black\" cx=\"90\" cy=\"-90\" rx=\"27\" ry=\"18\"/><text text-anchor=\"middle\" x=\"90\" y=\"-86.3\" fill=\"#000000\">C</text></a></g></svg>")
+         (original-map
+          '(((circle (41 . 29) . 24) "a" (help-echo "A"))
+            ((rect (5 . 101) 77 . 149) "b" (help-echo "B"))
+            ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96 15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37]) "c" (help-echo "C"))))
+         (scaled-map
+          '(((circle (82 . 58) . 48) "a" (help-echo "A"))
+            ((rect (10 . 202) 154 . 298) "b" (help-echo "B"))
+            ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20 192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86 320 74]) "c" (help-echo "C"))))
+         (flipped-map
+          '(((circle (125 . 29) . 24) "a" (help-echo "A"))
+            ((rect (89 . 101) 161 . 149) "b" (help-echo "B"))
+            ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22 77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo "C"))))
+         (rotated-map
+          '(((circle (126 . 41) . 24) "a" (help-echo "A"))
+            ((rect (6 . 5) 54 . 77) "b" (help-echo "B"))
+            ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114 145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106 146 112 154 118 160]) "c" (help-echo "C"))))
+         (scaled-rotated-flipped-map
+          '(((circle (58 . 82) . 48) "a" (help-echo "A"))
+            ((rect (202 . 10) 298 . 154) "b" (help-echo "B"))
+            ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208 30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308 74 320]) "c" (help-echo "C"))))
+         (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map
+                              :scale 2 :rotation 90 :flip t)))
+    ;; Test that `image--compute-original-map' correctly generates
+    ;; original-map when creating an already transformed image.
+    (should (image-tests--map-equal (image-property image :original-map)
+                                    original-map))
+    (setf (image-property image :flip) nil)
+    (setf (image-property image :rotation) 0)
+    (setf (image-property image :scale) 2)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    scaled-map))
+    (setf (image-property image :scale) 1)
+    (setf (image-property image :rotation) 90)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    rotated-map))
+    (setf (image-property image :rotation) 0)
+    (setf (image-property image :flip) t)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    flipped-map))
+    (setf (image-property image :scale) 2)
+    (setf (image-property image :rotation) 90)
+    (should (image-tests--map-equal (image--compute-map image)
+                                    scaled-rotated-flipped-map))
+
+    ;; Uncomment to test manually by interactively transforming the
+    ;; image and checking the map boundaries by hovering them.
+
+    ;; (with-current-buffer (get-buffer-create "*test image map*")
+    ;;   (erase-buffer)
+    ;;   (insert-image image)
+    ;;   (goto-char (point-min))
+    ;;   (pop-to-buffer (current-buffer)))
+    ))
+
+(ert-deftest image-transform-map ()
+  "Test functions related to transforming image maps."
+  (let ((map '(((circle (4 . 3) . 2) "circle")
+               ((rect (3 . 6) 8 . 8) "rect")
+               ((poly . [6 11 7 13 2 14]) "poly")))
+        (width 10)
+        (height 15))
+    (should (equal (image--scale-map (copy-tree map t) 2)
+                   '(((circle (8 . 6) . 4) "circle")
+                     ((rect (6 . 12) 16 . 16) "rect")
+                     ((poly . [12 22 14 26 4 28]) "poly"))))
+    (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height))
+                   '(((circle (12 . 4) . 2) "circle")
+                     ((rect (7 . 3) 9 . 8) "rect")
+                     ((poly . [4 6 2 7 1 2]) "poly"))))
+    (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height))
+                   '(((circle (6 . 3) . 2) "circle")
+                     ((rect (2 . 6) 7 . 8) "rect")
+                     ((poly . [4 11 3 13 8 14]) "poly"))))
+    (let ((copy (copy-tree map t)))
+      (image--scale-map copy 2)
+      ;; Scale size because the map has been scaled.
+      (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height)))
+      ;; Swap width and height because the map has been flipped.
+      (image--flip-map copy t `(,(* 2 height) . ,(* 2 width)))
+      (should (equal copy
+                     '(((circle (6 . 8) . 4) "circle")
+                       ((rect (12 . 6) 16 . 16) "rect")
+                       ((poly . [22 12 26 14 28 4]) "poly")))))))
+
 ;;; image-tests.el ends here
-- 
2.41.0

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> From: Joseph Turner <joseph@breatheoutbreathe.in>
> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
> Date: Sat, 23 Mar 2024 10:41:59 -0700
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >   In image-tests--map-equal:
> >   lisp/image-tests.el:192:17: Warning: Unused lexical variable `i'
> >
> > Can you fix this, please?
> 
> Oops!  I just re-read the dotimes docstring to discover that the RESULT
> arg is deprecated.  Fixed.  Thank you!

Thanks, installed on master, and closing the bug.

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Thank you!

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
>> Date: Sat, 23 Mar 2024 10:41:59 -0700
>>
>> Eli Zaretskii <eliz@gnu.org> writes:
>>
>> >   In image-tests--map-equal:
>> >   lisp/image-tests.el:192:17: Warning: Unused lexical variable `i'
>> >
>> > Can you fix this, please?
>>
>> Oops!  I just re-read the dotimes docstring to discover that the RESULT
>> arg is deprecated.  Fixed.  Thank you!
>
> Thanks, installed on master, and closing the bug.

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 620 bytes --]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Joseph Turner <joseph@breatheoutbreathe.in>
>> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
>> Date: Sat, 23 Mar 2024 10:41:59 -0700
>>
>> Eli Zaretskii <eliz@gnu.org> writes:
>>
>> >   In image-tests--map-equal:
>> >   lisp/image-tests.el:192:17: Warning: Unused lexical variable `i'
>> >
>> > Can you fix this, please?
>>
>> Oops!  I just re-read the dotimes docstring to discover that the RESULT
>> arg is deprecated.  Fixed.  Thank you!
>
> Thanks, installed on master, and closing the bug.

Another minor improvement.  Please see patch.

Joseph


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-copy-tree-just-image-map-not-entire-image.patch --]
[-- Type: text/x-diff, Size: 2443 bytes --]

From 359f9f889c2cad5e2f49aa4efd16bb18fe98e0a1 Mon Sep 17 00:00:00 2001
From: Joseph Turner <joseph@breatheoutbreathe.in>
Date: Sat, 23 Mar 2024 13:29:17 -0700
Subject: [PATCH] copy-tree just image map, not entire image.

* lisp/image.el (image--compute-original-map):
---
 lisp/image.el | 27 +++++++++++++--------------
 1 file changed, 13 insertions(+), 14 deletions(-)

diff --git a/lisp/image.el b/lisp/image.el
index 55340ea03dc..d7496485aca 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1455,24 +1455,23 @@ image--compute-original-map
 If IMAGE lacks :map property, return nil.
 When :rotation is not a multiple of 90, return copy of :map."
   (when (image-property image :map)
-    (let* ((image-copy (copy-tree image t))
-           (map (image-property image-copy :map))
-           (scale (or (image-property image-copy :scale) 1))
-           (rotation (or (image-property image-copy :rotation) 0))
-           (flip (image-property image-copy :flip))
-           (size (image-size image-copy t)))
+    (let* ((original-map (copy-tree (image-property image :map) t))
+           (scale (or (image-property image :scale) 1))
+           (rotation (or (image-property image :rotation) 0))
+           (flip (image-property image :flip))
+           (size (image-size image t)))
       (when (and ; Handle only 90-degree rotations
              (zerop (mod rotation 1))
              (zerop (% (truncate rotation) 90)))
         ;; In rendered images, rotation is always applied before flip.
-        ;; To undo the transformation, flip before rotating.
-        ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP.
-        ;; Therefore, scale MAP after flip and rotate operations, since
-        ;; both need MAP to fit SIZE.
-        (image--flip-map map flip size)
-        (image--rotate-map map (- rotation) size)
-        (image--scale-map map (/ 1.0 scale)))
-      map)))
+        ;; To undo the transformation, flip before rotating.  SIZE fits
+        ;; ORIGINAL-MAP before transformations are applied.  Therefore,
+        ;; scale ORIGINAL-MAP after flip and rotate operations, since
+        ;; both need ORIGINAL-MAP to fit SIZE.
+        (image--flip-map original-map flip size)
+        (image--rotate-map original-map (- rotation) size)
+        (image--scale-map original-map (/ 1.0 scale)))
+      original-map)))
 
 (defun image--scale-map (map scale)
   "Scale MAP according to SCALE.
-- 
2.41.0

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> From: Joseph Turner <joseph@breatheoutbreathe.in>
> Cc: 69602-done@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
> Date: Sat, 23 Mar 2024 13:32:05 -0700
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> From: Joseph Turner <joseph@breatheoutbreathe.in>
> >> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
> >> Date: Sat, 23 Mar 2024 10:41:59 -0700
> >>
> >> Eli Zaretskii <eliz@gnu.org> writes:
> >>
> >> >   In image-tests--map-equal:
> >> >   lisp/image-tests.el:192:17: Warning: Unused lexical variable `i'
> >> >
> >> > Can you fix this, please?
> >>
> >> Oops!  I just re-read the dotimes docstring to discover that the RESULT
> >> arg is deprecated.  Fixed.  Thank you!
> >
> > Thanks, installed on master, and closing the bug.
> 
> Another minor improvement.  Please see patch.

Thanks, installed.

bug#69602: 29.1; Image :map should adjust with :scale and :rotation

[Eli Zaretskii]

> From: Joseph Turner <joseph@breatheoutbreathe.in>
> Cc: 69602@debbugs.gnu.org, stephen.berman@gmx.net, juri@linkov.net
> Date: Thu, 07 Mar 2024 05:53:11 -0800
> 
> > IOW, I don't understand why you think the problem can only be solved
> > in C: AFAIK almost all of the machinery that performs image transforms
> > is implemented in Lisp, and each time an image is rescaled, we
> > basically re-process the image descriptor anew.
> 
> The attached patch adds two hooks in `image.el' which allow packages to
> recompute an image's map after it's rescaled or rotated.

Thanks, but please accompany the code change with suitable changes for
NEWS and the ELisp manual.  Bonus points for adding tests for this to
our test suite.

Also, I think we don't need the "after" part in the names of these two
hooks: their doc strings explicitly document that they are run after
the transformation, and image-change-size-hook is easier to remember,
since the name basically says "a hook run when image is resized".

And finally, please mention the hooks in the doc strings of public
functions that perform size-changes and rotations of images, as we
usually do with other hooks.