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.
This commit is contained in:
parent
5be79fd05a
commit
6a2863ca01
2 changed files with 67 additions and 19 deletions
|
@ -188,6 +188,19 @@ or \"ffmpeg\") is installed."
|
||||||
"C-<wheel-up>" #'image-mouse-increase-size
|
"C-<wheel-up>" #'image-mouse-increase-size
|
||||||
"C-<mouse-4>" #'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)
|
(defun image-load-path-for-library (library image &optional path no-error)
|
||||||
"Return a suitable search path for images used by LIBRARY.
|
"Return a suitable search path for images used by LIBRARY.
|
||||||
|
|
||||||
|
@ -665,7 +678,9 @@ is non-nil, this is inhibited."
|
||||||
image)
|
image)
|
||||||
rear-nonsticky t
|
rear-nonsticky t
|
||||||
inhibit-isearch ,inhibit-isearch
|
inhibit-isearch ,inhibit-isearch
|
||||||
keymap ,image-map))))
|
keymap ,(if slice
|
||||||
|
image-slice-map
|
||||||
|
image-map)))))
|
||||||
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
|
@ -701,8 +716,8 @@ The image is automatically split into ROWS x COLS slices."
|
||||||
(insert string)
|
(insert string)
|
||||||
(add-text-properties start (point)
|
(add-text-properties start (point)
|
||||||
`(display ,(list (list 'slice x y dx dy) image)
|
`(display ,(list (list 'slice x y dx dy) image)
|
||||||
rear-nonsticky (display)
|
rear-nonsticky (display keymap)
|
||||||
keymap ,image-map))
|
keymap ,image-slice-map))
|
||||||
(setq x (+ x dx))))
|
(setq x (+ x dx))))
|
||||||
(setq x 0.0
|
(setq x 0.0
|
||||||
y (+ y dy))
|
y (+ y dy))
|
||||||
|
|
|
@ -35,6 +35,7 @@
|
||||||
(declare-function image-property "image.el" (image property))
|
(declare-function image-property "image.el" (image property))
|
||||||
(declare-function image-size "image.c" (spec &optional pixels frame))
|
(declare-function image-size "image.c" (spec &optional pixels frame))
|
||||||
(declare-function imagep "image.c" (spec))
|
(declare-function imagep "image.c" (spec))
|
||||||
|
(declare-function image--get-image "image.el" (&optional position))
|
||||||
|
|
||||||
(defgroup image-crop ()
|
(defgroup image-crop ()
|
||||||
"Image cropping."
|
"Image cropping."
|
||||||
|
@ -113,18 +114,14 @@ and the cropped image data.")
|
||||||
(defun image-cut (&optional color)
|
(defun image-cut (&optional color)
|
||||||
"Cut a rectangle from the image under point, filling it with COLOR.
|
"Cut a rectangle from the image under point, filling it with COLOR.
|
||||||
COLOR defaults to the value of `image-cut-color'.
|
COLOR defaults to the value of `image-cut-color'.
|
||||||
Interactively, with prefix argument, prompt for COLOR to use."
|
Interactively, with prefix argument, prompt for COLOR to use.
|
||||||
(interactive (list (and current-prefix-arg (read-color "Use color: "))))
|
|
||||||
(image-crop (if (zerop (length color)) image-cut-color color)))
|
|
||||||
|
|
||||||
;;;###autoload
|
This command presents the image with a rectangular area superimposed
|
||||||
(defun image-crop (&optional cut)
|
on it, and allows moving and resizing the area to define which
|
||||||
"Crop the image under point.
|
part of it to cut.
|
||||||
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.
|
|
||||||
|
|
||||||
While cropping the image, the following key bindings are available:
|
While moving/resizing the cutting area, the following key bindings
|
||||||
|
are available:
|
||||||
|
|
||||||
`q': Exit without changing anything.
|
`q': Exit without changing anything.
|
||||||
`RET': Crop/cut the image.
|
`RET': Crop/cut the image.
|
||||||
|
@ -132,15 +129,51 @@ While cropping the image, the following key bindings are available:
|
||||||
rectangle shape.
|
rectangle shape.
|
||||||
`s': Same as `m', but make the rectangle into a square first.
|
`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
|
After cutting the image, you can save it by `M-x image-save' or
|
||||||
\\<image-map>\\[image-save] when point is over the image."
|
\\<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.
|
||||||
|
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 moving/resizing the cropping 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 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)
|
(interactive)
|
||||||
(unless (image-type-available-p 'svg)
|
(unless (image-type-available-p 'svg)
|
||||||
(error "SVG support is needed to crop images"))
|
(error "SVG support is needed to crop and cut images"))
|
||||||
(unless (executable-find (car image-crop-crop-command))
|
(let* ((crop-cmd (car image-crop-crop-command))
|
||||||
(error "Couldn't find %s command to crop the image"
|
(found (executable-find crop-cmd)))
|
||||||
(car image-crop-crop-command)))
|
(unless found
|
||||||
(let ((image (get-text-property (point) 'display)))
|
(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)
|
(unless (imagep image)
|
||||||
(user-error "No image under point"))
|
(user-error "No image under point"))
|
||||||
(when (overlays-at (point))
|
(when (overlays-at (point))
|
||||||
|
|
Loading…
Add table
Reference in a new issue