Change: (ement-room-image-scale-mouse) Toggle scale

This commit is contained in:
Adam Porter 2021-08-01 00:16:44 -05:00
parent baed04d5d5
commit ec0c324823
2 changed files with 12 additions and 6 deletions

View file

@ -121,7 +121,7 @@ If you want to install it manually, it's simple enough, but you should know what
*Viewing images* *Viewing images*
+ Resize image to window: ~mouse-1~ + Toggle scale of image at point (between fit-to-window and thumbnail): ~mouse-1~
+ Show image in new buffer at full size: ~double-mouse-1~ + Show image in new buffer at full size: ~double-mouse-1~
*** Room list buffer *** Room list buffer

View file

@ -1719,21 +1719,27 @@ For use as a `help-echo' function on `ement-user' headings."
(display-warning 'ement "This Emacs was not built with ImageMagick support, nor does it support Cairo/XRender scaling, so images can't be displayed in Ement"))))) (display-warning 'ement "This Emacs was not built with ImageMagick support, nor does it support Cairo/XRender scaling, so images can't be displayed in Ement")))))
(defun ement-room-image-scale-mouse (event) (defun ement-room-image-scale-mouse (event)
"Scale image at mouse EVENT to fit in window." "Toggle scale of image at mouse EVENT.
Scale image to fit within the window's body. If image is already
fit to the window, reduce its max-height to 10% of the window's
height."
(interactive "e") (interactive "e")
(pcase-let* ((`(,_type ,position ,_count) event) (pcase-let* ((`(,_type ,position ,_count) event)
(window (posn-window position)) (window (posn-window position))
(pos (event-start position))) (pos (event-start position)))
(with-selected-window window (with-selected-window window
(pcase-let* ((image (get-text-property pos 'display)) (pcase-let* ((image (get-text-property pos 'display))
(width (window-body-width nil t)) (window-width (window-body-width nil t))
(height (window-body-height nil t))) (window-height (window-body-height nil t))
(new-height (if (= window-height (image-property image :max-height))
(/ window-height 10)
window-height)))
(when (fboundp 'imagemagick-types) (when (fboundp 'imagemagick-types)
;; Only do this when ImageMagick is supported. ;; Only do this when ImageMagick is supported.
;; FIXME: When requiring Emacs 27+, remove this (I guess?). ;; FIXME: When requiring Emacs 27+, remove this (I guess?).
(setf (image-property image :type) 'imagemagick)) (setf (image-property image :type) 'imagemagick))
(setf (image-property image :max-width) width (setf (image-property image :max-width) window-width
(image-property image :max-height) height))))) (image-property image :max-height) new-height)))))
(defun ement-room-image-show (event) (defun ement-room-image-show (event)
"Show image at mouse EVENT in a new buffer." "Show image at mouse EVENT in a new buffer."