Put a keymap on images created with insert-image and friends

* lisp/image.el (image-save): New command.
(image-rotate): Ditto.
(image-map): New keymap.
(insert-image): Put the image-map on all images.
(insert-sliced-image): Ditto.
* doc/lispref/display.texi (Showing Images): Document the
image map.

3 files changed, 89 insertions, 11 deletions

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index c8e7e4fa5c1..26f3de40e91 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -5508,6 +5508,26 @@ cache, it can always be displayed, even if the value of
 @code{max-image-size} is subsequently changed (@pxref{Image Cache}).
 @end defvar
 
+Images inserted with the insertion functions above also get a local
+keymap installed in the text properties (or overlays) that span the
+displayed image.  This keymap defines the following commands:
+
+@table @kbd
+@item +
+Increase the image size (@code{image-increase-size}).  A prefix value
+of @samp{4} means to increase the size by 40%.  The default is 20%.
+
+@item -
+Decrease the image size (@code{image-increase-size}).  A prefix value
+of @samp{4} means to decrease the size by 40%.  The default is 20%.
+
+@item r
+Rotate the image by 90 degrees (@code{image-rotate}).
+
+@item o
+Save the image to a file (@code{image-save}).
+@end table
+
 @node Multi-Frame Images
 @subsection Multi-Frame Images
 @cindex multi-frame images
diff --git a/etc/NEWS b/etc/NEWS
index 750d671cc63..957b0c24791 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -824,11 +824,6 @@ while in non-`visual-line-mode' it will move the point to the indented
 header’s value.
 
 +++
-** Images are automatically scaled before displaying based on the
-`image-scaling-factor' variable (if Emacs supports scaling the images
-in question).
-
-+++
 ** In Show Paren Mode, a parenthesis can be highlighted when point
 stands inside it, and certain parens can be highlighted when point is
 at BOL or EOL, or in whitespace there.  To enable these, customize,
@@ -839,6 +834,18 @@ respectively, `show-paren-when-point-inside-paren' or
 ** If gpg2 exists on the system, it is now used as the default value
 of `epg-gpg-program' (instead of gpg).
 
+** Images
+
++++
+*** Images are automatically scaled before displaying based on the
+`image-scaling-factor' variable (if Emacs supports scaling the images
+in question).
+
+*** Images inserted with `insert-image' and related functions get a
+keymap put into the text properties (or overlays) that span the
+image.  This keymap binds keystrokes for manipulating size and
+rotation, as well as saving the image to a file.
+
 ** Lisp mode
 
 ---
diff --git a/lisp/image.el b/lisp/image.el
index b69d3b15a43..4f2733adb7e 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -139,6 +139,15 @@ based on the font pixel size."
   :group 'image
   :version "25.2")
 
+;; Map put into text properties on images.
+(defvar image-map
+  (let ((map (make-keymap)))
+    (define-key map "-" 'image-decrease-size)
+    (define-key map "+" 'image-increase-size)
+    (define-key map "r" 'image-rotate)
+    (define-key map "o" 'image-save)
+    map))
+
 (defun image-load-path-for-library (library image &optional path no-error)
   "Return a suitable search path for images used by LIBRARY.
 
@@ -466,6 +475,7 @@ means display it in the right marginal area."
       (put-text-property 0 (length string) 'display prop string)
       (overlay-put overlay 'put-image t)
       (overlay-put overlay 'before-string string)
+      (overlay-put overlay 'map image-map)
       overlay)))
 
 
@@ -505,7 +515,9 @@ height of the image; integer values are taken as pixel values."
     (add-text-properties start (point)
                          `(display ,(if slice
                                         (list (cons 'slice slice) image)
-                                      image) rear-nonsticky (display)))))
+                                      image)
+                                   rear-nonsticky (display)
+                                   keymap ,image-map))))
 
 
 ;;;###autoload
@@ -541,7 +553,8 @@ The image is automatically split into ROWS x COLS slices."
           (insert string)
           (add-text-properties start (point)
                                `(display ,(list (list 'slice x y dx dy) image)
-                                         rear-nonsticky (display)))
+                                         rear-nonsticky (display)
+                                         keymap ,image-map))
           (setq x (+ x dx))))
       (setq x 0.0
             y (+ y dy))
@@ -931,17 +944,55 @@ default is 20%."
                          (- 1 (/ n 10))
                        0.8)))
 
-(defun image-change-size (factor)
-  (unless (fboundp 'imagemagick-types)
-    (error "Can't rescale images without ImageMagick support"))
-  (let ((image (get-text-property (point) 'display)))
+(defun image--get-image ()
+  (let ((image (or (get-text-property (point) 'display)
+                   ;; `put-image' uses overlays, so find an image in
+                   ;; the overlays.
+                   (seq-find (lambda (overlay)
+                               (overlay-get overlay 'display))
+                             (overlays-at (point))))))
     (when (or (not (consp image))
               (not (eq (car image) 'image)))
       (error "No image under point"))
+    image))
+
+(defun image--get-imagemagick-and-warn ()
+  (unless (fboundp 'imagemagick-types)
+    (error "Can't rescale images without ImageMagick support"))
+  (let ((image (image--get-image)))
+    (image-flush image)
     (plist-put (cdr image) :type 'imagemagick)
+    image))
+
+(defun image-change-size (factor)
+  (let ((image (image--get-imagemagick-and-warn)))
     (plist-put (cdr image) :scale
                (* (or (plist-get (cdr image) :scale) 1) factor))))
 
+(defun image-rotate ()
+  "Rotate the image under point by 90 degrees clockwise."
+  (interactive)
+  (let ((image (image--get-imagemagick-and-warn)))
+    (plist-put (cdr image) :rotation
+               (float (+ (or (plist-get (cdr image) :rotation) 0) 90)))))
+
+(defun image-save ()
+  "Save the image under point."
+  (interactive)
+  (let ((image (get-text-property (point) 'display)))
+    (when (or (not (consp image))
+              (not (eq (car image) 'image)))
+      (error "No image under point"))
+    (with-temp-buffer
+      (let ((file (plist-get (cdr image) :file)))
+        (if file
+            (if (not (file-exists-p file))
+                (error "File %s no longer exists" file)
+              (insert-file-contents-literally file))
+          (insert (plist-get (cdr image) :data))))
+      (write-region (point-min) (point-max)
+                    (read-file-name "Write image to file: ")))))
+
 (provide 'image)
 
 ;;; image.el ends here