From 6a2863ca0167a1b4a431dfae3640c97a846d4826 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 8 Apr 2023 12:43:34 +0300 Subject: [PATCH] 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-" #'image-mouse-increase-size "C-" #'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-" #'image-mouse-decrease-size + "C-" #'image-mouse-decrease-size + "C-" #'image-mouse-increase-size + "C-" #'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-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-save] when point is over the image." +After cropping the image, you can save it by `M-x image-save' or +\\\\[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)) -- 2.39.2