Commit f7405a09 authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

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.
parent 6c54541f
......@@ -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
......
......@@ -823,11 +823,6 @@ In `visual-line-mode' it will look for the true beginning of a header
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
......@@ -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
---
......
......@@ -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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment