mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-06 11:55:48 +00:00
Code Issues Releases Activity

* lisp/image.el: Support image scaling with mouse in other buffer.

Browse Source 
* lisp/image.el (image-increase-size, image-decrease-size):
Add optional arg position.
(image-mouse-increase-size, image-mouse-decrease-size):
Use '(point-marker)' for arg position.
(image--get-image): Use get-char-property from position if non-nil,
and its buffer.
(image--get-imagemagick-and-warn, image--change-size):
Add optional arg position.
This commit is contained in:
Juri Linkov 2019-11-30 23:21:00 +02:00
parent d64ea182fb
commit 3c278b4999
1 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
lisp/image.el
View File

@ -1012,7 +1012,7 @@ has no effect."
(imagemagick-register-types) (imagemagick-register-types)
(defun image-increase-size (&optional n) (defun image-increase-size (&optional n position)
"Increase the image size by a factor of N. "Increase the image size by a factor of N.
If N is 3, then the image size will be increased by 30%. The If N is 3, then the image size will be increased by 30%. The
default is 20%." default is 20%."
@ -1027,9 +1027,10 @@ default is 20%."
#'image--change-size #'image--change-size
(if n (if n
(1+ (/ (prefix-numeric-value n) 10.0)) (1+ (/ (prefix-numeric-value n) 10.0))
1.2))) 1.2)
position))
(defun image-decrease-size (&optional n) (defun image-decrease-size (&optional n position)
"Decrease the image size by a factor of N. "Decrease the image size by a factor of N.
If N is 3, then the image size will be decreased by 30%. The If N is 3, then the image size will be decreased by 30%. The
default is 20%." default is 20%."
@ -1044,7 +1045,8 @@ default is 20%."
#'image--change-size #'image--change-size
(if n (if n
(- 1 (/ (prefix-numeric-value n) 10.0)) (- 1 (/ (prefix-numeric-value n) 10.0))
0.8))) 0.8)
position))
(defun image-mouse-increase-size (&optional event) (defun image-mouse-increase-size (&optional event)
"Increase the image size using the mouse." "Increase the image size using the mouse."
@ -1052,7 +1054,7 @@ default is 20%."
(when (listp event) (when (listp event)
(save-window-excursion (save-window-excursion
(posn-set-point (event-start event)) (posn-set-point (event-start event))
(image-increase-size)))) (image-increase-size nil (point-marker)))))
(defun image-mouse-decrease-size (&optional event) (defun image-mouse-decrease-size (&optional event)
"Decrease the image size using the mouse." "Decrease the image size using the mouse."
@ -1060,27 +1062,29 @@ default is 20%."
(when (listp event) (when (listp event)
(save-window-excursion (save-window-excursion
(posn-set-point (event-start event)) (posn-set-point (event-start event))
(image-decrease-size)))) (image-decrease-size nil (point-marker)))))
(defun image--get-image () (defun image--get-image (&optional position)
"Return the image at point." "Return the image at point."
(let ((image (get-char-property (point) 'display))) (let ((image (get-char-property (or position (point)) 'display
(when (markerp position)
(marker-buffer position)))))
(unless (eq (car-safe image) 'image) (unless (eq (car-safe image) 'image)
(error "No image under point")) (error "No image under point"))
image)) image))
(defun image--get-imagemagick-and-warn () (defun image--get-imagemagick-and-warn (&optional position)
(unless (or (fboundp 'imagemagick-types) (image-transforms-p)) (unless (or (fboundp 'imagemagick-types) (image-transforms-p))
(error "Cannot rescale images on this terminal")) (error "Cannot rescale images on this terminal"))
(let ((image (image--get-image))) (let ((image (image--get-image position)))
(image-flush image) (image-flush image)
(when (and (fboundp 'imagemagick-types) (when (and (fboundp 'imagemagick-types)
(not (image-transforms-p))) (not (image-transforms-p)))
(plist-put (cdr image) :type 'imagemagick)) (plist-put (cdr image) :type 'imagemagick))
image)) image))
(defun image--change-size (factor) (defun image--change-size (factor &optional position)
(let* ((image (image--get-imagemagick-and-warn)) (let* ((image (image--get-imagemagick-and-warn position))
(new-image (image--image-without-parameters image)) (new-image (image--image-without-parameters image))
(scale (image--current-scaling image new-image))) (scale (image--current-scaling image new-image)))
(setcdr image (cdr new-image)) (setcdr image (cdr new-image))