emacs-29 6a2863ca016: Fix handling of sliced images

[Eli Zaretskii]

branch: emacs-29
commit 6a2863ca0167a1b4a431dfae3640c97a846d4826
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    Fix handling of sliced images
    
    * lisp/image.el (image-slice-map): New keymap, without some
    bindings that make no sense with sliced images.
    (insert-image, insert-sliced-image): Use it.
    (insert-sliced-image): Make the 'keymap' property rear-nonsticky,
    to prevent calling image commands when point is to the right of
    the slice.  (Bug#62679)
    
    * lisp/image/image-crop.el (image-cut, image-crop): Doc fixes.
    (image-crop): Don't try using stock MS-Widows convert.exe
    program.  Use 'image--get-image' to support sliced images.
---
 lisp/image.el            | 21 ++++++++++++++---
 lisp/image/image-crop.el | 59 +++++++++++++++++++++++++++++++++++++-----------
 2 files changed, 64 insertions(+), 16 deletions(-)

diff --git a/lisp/image.el b/lisp/image.el
index 3f878bd4de0..818679a4d7b 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -188,6 +188,19 @@ or \"ffmpeg\") is installed."
   "C-<wheel-up>"   #'image-mouse-increase-size
   "C-<mouse-4>"    #'image-mouse-increase-size)
 
+(defvar-keymap image-slice-map
+  :doc "Map put into text properties on sliced images."
+  "i" (define-keymap
+        "-" #'image-decrease-size
+        "+" #'image-increase-size
+        "o" #'image-save
+        "c" #'image-crop
+        "x" #'image-cut)
+  "C-<wheel-down>" #'image-mouse-decrease-size
+  "C-<mouse-5>"    #'image-mouse-decrease-size
+  "C-<wheel-up>"   #'image-mouse-increase-size
+  "C-<mouse-4>"    #'image-mouse-increase-size)
+
 (defun image-load-path-for-library (library image &optional path no-error)
   "Return a suitable search path for images used by LIBRARY.
 
@@ -665,7 +678,9 @@ is non-nil, this is inhibited."
                                      image)
                                    rear-nonsticky t
                                   inhibit-isearch ,inhibit-isearch
-                                   keymap ,image-map))))
+                                   keymap ,(if slice
+                                               image-slice-map
+                                             image-map)))))
 
 
 ;;;###autoload
@@ -701,8 +716,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)
-                                         keymap ,image-map))
+                                        rear-nonsticky (display keymap)
+                                         keymap ,image-slice-map))
          (setq x (+ x dx))))
       (setq x 0.0
            y (+ y dy))
diff --git a/lisp/image/image-crop.el b/lisp/image/image-crop.el
index be6e22bc606..9ef848c5bc8 100644
--- a/lisp/image/image-crop.el
+++ b/lisp/image/image-crop.el
@@ -35,6 +35,7 @@
 (declare-function image-property "image.el" (image property))
 (declare-function image-size "image.c" (spec &optional pixels frame))
 (declare-function imagep "image.c" (spec))
+(declare-function image--get-image "image.el" (&optional position))
 
 (defgroup image-crop ()
   "Image cropping."
@@ -113,18 +114,36 @@ and the cropped image data.")
 (defun image-cut (&optional color)
   "Cut a rectangle from the image under point, filling it with COLOR.
 COLOR defaults to the value of `image-cut-color'.
-Interactively, with prefix argument, prompt for COLOR to use."
-  (interactive (list (and current-prefix-arg (read-color "Use color: "))))
+Interactively, with prefix argument, prompt for COLOR to use.
+
+This command presents the image with a rectangular area superimposed
+on it, and allows moving and resizing the area to define which
+part of it to cut.
+
+While moving/resizing the cutting area, the following key bindings
+are available:
+
+`q':   Exit without changing anything.
+`RET': Crop/cut the image.
+`m':   Make mouse movements move the rectangle instead of altering the
+       rectangle shape.
+`s':   Same as `m', but make the rectangle into a square first.
+
+After cutting the image, you can save it by `M-x image-save' or
+\\<image-map>\\[image-save] when point is over the image."
+  (interactive (list (and current-prefix-arg
+                          (read-color "Color to use for filling: "))))
   (image-crop (if (zerop (length color)) image-cut-color color)))
 
 ;;;###autoload
 (defun image-crop (&optional cut)
   "Crop the image under point.
-If CUT is non-nil, remove a rectangle from the image instead of
-cropping the image.  In that case CUT should be the name of a
-color to fill the rectangle.
+This command presents the image with a rectangular area superimposed
+on it, and allows moving and resizing the area to define which
+part of it to crop.
 
-While cropping the image, the following key bindings are available:
+While moving/resizing the cropping area, the following key bindings
+are available:
 
 `q':   Exit without changing anything.
 `RET': Crop/cut the image.
@@ -132,15 +151,29 @@ While cropping the image, the following key bindings are 
available:
        rectangle shape.
 `s':   Same as `m', but make the rectangle into a square first.
 
-After cropping an image, you can save it by `M-x image-save' or
-\\<image-map>\\[image-save] when point is over the image."
+After cropping the image, you can save it by `M-x image-save' or
+\\<image-map>\\[image-save] when point is over the image.
+
+When called from Lisp, if CUT is non-nil, remove a rectangle from
+the image instead of cropping the image.  In that case, CUT should
+be the name of a color to fill the rectangle."
   (interactive)
   (unless (image-type-available-p 'svg)
-    (error "SVG support is needed to crop images"))
-  (unless (executable-find (car image-crop-crop-command))
-    (error "Couldn't find %s command to crop the image"
-           (car image-crop-crop-command)))
-  (let ((image (get-text-property (point) 'display)))
+    (error "SVG support is needed to crop and cut images"))
+  (let* ((crop-cmd (car image-crop-crop-command))
+         (found (executable-find crop-cmd)))
+    (unless found
+      (error "Couldn't find `%s' command to crop/cut the image" crop-cmd))
+    (if (and (memq system-type '(windows-nt ms-dos))
+             ;; MS-Windows has an incompatible convert.exe, used to
+             ;; convert filesystems...
+             (string-equal crop-cmd "convert")
+             (= 0 (string-search "Invalid drive specification."
+                                 (shell-command-to-string
+                                  (format "%s %s" crop-cmd null-device)))))
+        (error "The program `%s' is not an image conversion program"
+               found)))
+  (let ((image (image--get-image)))
     (unless (imagep image)
       (user-error "No image under point"))
     (when (overlays-at (point))