-;;; image-mode.el --- support for visiting image files
+;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
;;
;; Author: Richard Stallman <rms@gnu.org>
;; Keywords: multimedia
;; resulting buffer file is saved to another name it will correctly save
;; the image data to the new file.
+;; Todo:
+
+;; Consolidate with doc-view to make them work on directories of images or on
+;; image files containing various "pages".
+
;;; Code:
(require 'image)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Image mode window-info management.
-(defvar image-mode-winprops-alist t)
-(make-variable-buffer-local 'image-mode-winprops-alist)
+(defvar-local image-mode-winprops-alist t)
(defvar image-mode-new-window-functions nil
"Special hook run when image data is requested in a new window.
(defun image-mode-winprops (&optional window cleanup)
"Return winprops of WINDOW.
-A winprops object has the shape (WINDOW . ALIST)."
+A winprops object has the shape (WINDOW . ALIST).
+WINDOW defaults to `selected-window' if it displays the current buffer, and
+otherwise it defaults to t, used for times when the buffer is not displayed."
(cond ((null window)
- (setq window (selected-window)))
+ (setq window
+ (if (eq (current-buffer) (window-buffer)) (selected-window) t)))
+ ((eq window t))
((not (windowp window))
(error "Not a window: %s" window)))
(when cleanup
(setq image-mode-winprops-alist
(delq nil (mapcar (lambda (winprop)
- (if (window-live-p (car-safe winprop))
- winprop))
+ (let ((w (car-safe winprop)))
+ (if (or (not (windowp w)) (window-live-p w))
+ winprop)))
image-mode-winprops-alist))))
(let ((winprops (assq window image-mode-winprops-alist)))
;; For new windows, set defaults from the latest.
- (unless winprops
+ (if winprops
+ ;; Move window to front.
+ (setq image-mode-winprops-alist
+ (cons winprops (delq winprops image-mode-winprops-alist)))
(setq winprops (cons window
(copy-alist (cdar image-mode-winprops-alist))))
+ ;; Add winprops before running the hook, to avoid inf-loops if the hook
+ ;; triggers window-configuration-change-hook.
+ (setq image-mode-winprops-alist
+ (cons winprops image-mode-winprops-alist))
(run-hook-with-args 'image-mode-new-window-functions winprops))
- ;; Move window to front.
- (setq image-mode-winprops-alist
- (cons winprops (delq winprops image-mode-winprops-alist)))
winprops))
(defun image-mode-window-get (prop &optional winprops)
+ (declare (gv-setter (lambda (val)
+ `(image-mode-window-put ,prop ,val ,winprops))))
(unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
(cdr (assq prop (cdr winprops))))
-(defsetf image-mode-window-get (prop &optional winprops) (val)
- `(image-mode-window-put ,prop ,val ,winprops))
-
(defun image-mode-window-put (prop val &optional winprops)
(unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
(setcdr winprops (cons (cons prop val)
(defun image-mode-reapply-winprops ()
;; When set-window-buffer, set hscroll and vscroll to what they were
;; last time the image was displayed in this window.
- (when (and (image-get-display-property)
- (listp image-mode-winprops-alist))
+ (when (listp image-mode-winprops-alist)
+ ;; Beware: this call to image-mode-winprops can't be optimized away,
+ ;; because it not only gets the winprops data but sets it up if needed
+ ;; (e.g. it's used by doc-view to display the image in a new window).
(let* ((winprops (image-mode-winprops nil t))
(hscroll (image-mode-window-get 'hscroll winprops))
(vscroll (image-mode-window-get 'vscroll winprops)))
- (if hscroll (set-window-hscroll (selected-window) hscroll))
- (if vscroll (set-window-vscroll (selected-window) vscroll)))))
+ (when (image-get-display-property) ;Only do it if we display an image!
+ (if hscroll (set-window-hscroll (selected-window) hscroll))
+ (if vscroll (set-window-vscroll (selected-window) vscroll))))))
(defun image-mode-setup-winprops ()
;; Record current scroll settings.
(interactive "p")
(image-forward-hscroll (- n)))
-(defun image-next-line (&optional n)
+(defun image-next-line (n)
"Scroll image in current window upward by N lines.
Stop if the bottom edge of the image is reached."
(interactive "p")
;; Adjust frame and image size.
-(defun image-mode-fit-frame ()
- "Fit the frame to the current image.
-This function assumes the current frame has only one window."
- ;; FIXME: This does not take into account decorations like mode-line,
- ;; minibuffer, header-line, ...
- (interactive)
- (let* ((saved (frame-parameter nil 'image-mode-saved-size))
+(defun image-mode-fit-frame (&optional frame toggle)
+ "Fit FRAME to the current image.
+If FRAME is omitted or nil, it defaults to the selected frame.
+All other windows on the frame are deleted.
+
+If called interactively, or if TOGGLE is non-nil, toggle between
+fitting FRAME to the current image and restoring the size and
+window configuration prior to the last `image-mode-fit-frame'
+call."
+ (interactive (list nil t))
+ (let* ((buffer (current-buffer))
(display (image-get-display-property))
- (size (image-display-size display)))
- (if (and saved
- (eq (caar saved) (frame-width))
- (eq (cdar saved) (frame-height)))
- (progn ;; Toggle back to previous non-fitted size.
- (set-frame-parameter nil 'image-mode-saved-size nil)
- (setq size (cdr saved)))
- ;; Round up size, and save current size so we can toggle back to it.
- (setcar size (ceiling (car size)))
- (setcdr size (ceiling (cdr size)))
- (set-frame-parameter nil 'image-mode-saved-size
- (cons size (cons (frame-width) (frame-height)))))
- (set-frame-width (selected-frame) (car size))
- (set-frame-height (selected-frame) (cdr size))))
+ (size (image-display-size display))
+ (saved (frame-parameter frame 'image-mode-saved-params))
+ (window-configuration (current-window-configuration frame))
+ (width (frame-width frame))
+ (height (frame-height frame)))
+ (with-selected-frame (or frame (selected-frame))
+ (if (and toggle saved
+ (= (caar saved) width)
+ (= (cdar saved) height))
+ (progn
+ (set-frame-width frame (car (nth 1 saved)))
+ (set-frame-height frame (cdr (nth 1 saved)))
+ (set-window-configuration (nth 2 saved))
+ (set-frame-parameter frame 'image-mode-saved-params nil))
+ (delete-other-windows)
+ (switch-to-buffer buffer t t)
+ (let* ((edges (window-inside-edges))
+ (inner-width (- (nth 2 edges) (nth 0 edges)))
+ (inner-height (- (nth 3 edges) (nth 1 edges))))
+ (set-frame-width frame (+ (ceiling (car size))
+ width (- inner-width)))
+ (set-frame-height frame (+ (ceiling (cdr size))
+ height (- inner-height)))
+ ;; The frame size after the above `set-frame-*' calls may
+ ;; differ from what we specified, due to window manager
+ ;; interference. We have to call `frame-width' and
+ ;; `frame-height' to get the actual results.
+ (set-frame-parameter frame 'image-mode-saved-params
+ (list (cons (frame-width)
+ (frame-height))
+ (cons width height)
+ window-configuration)))))))
;;; Image Mode setup
-(defvar image-type nil
+(defvar-local image-type nil
"The image type for the current Image mode buffer.")
-(make-variable-buffer-local 'image-type)
+
+(defvar-local image-multi-frame nil
+ "Non-nil if image for the current Image mode buffer has multiple frames.")
(defvar image-mode-previous-major-mode nil
"Internal variable to keep the previous non-image major mode.")
(set-keymap-parent map special-mode-map)
(define-key map "\C-c\C-c" 'image-toggle-display)
(define-key map (kbd "SPC") 'image-scroll-up)
+ (define-key map (kbd "S-SPC") 'image-scroll-down)
(define-key map (kbd "DEL") 'image-scroll-down)
+ (define-key map (kbd "RET") 'image-toggle-animation)
+ (define-key map "F" 'image-goto-frame)
+ (define-key map "f" 'image-next-frame)
+ (define-key map "b" 'image-previous-frame)
+ (define-key map "n" 'image-next-file)
+ (define-key map "p" 'image-previous-file)
+ (define-key map "a+" 'image-increase-speed)
+ (define-key map "a-" 'image-decrease-speed)
+ (define-key map "a0" 'image-reset-speed)
+ (define-key map "ar" 'image-reverse-speed)
(define-key map [remap forward-char] 'image-forward-hscroll)
(define-key map [remap backward-char] 'image-backward-hscroll)
(define-key map [remap right-char] 'image-forward-hscroll)
(define-key map [remap move-end-of-line] 'image-eol)
(define-key map [remap beginning-of-buffer] 'image-bob)
(define-key map [remap end-of-buffer] 'image-eob)
+ (easy-menu-define image-mode-menu map "Menu for Image mode."
+ '("Image"
+ ["Show as Text" image-toggle-display :active t
+ :help "Show image as text"]
+ "--"
+ ["Fit Frame to Image" image-mode-fit-frame :active t
+ :help "Resize frame to match image"]
+ ["Fit to Window Height" image-transform-fit-to-height
+ :visible (eq image-type 'imagemagick)
+ :help "Resize image to match the window height"]
+ ["Fit to Window Width" image-transform-fit-to-width
+ :visible (eq image-type 'imagemagick)
+ :help "Resize image to match the window width"]
+ ["Rotate Image..." image-transform-set-rotation
+ :visible (eq image-type 'imagemagick)
+ :help "Rotate the image"]
+ "--"
+ ["Show Thumbnails"
+ (lambda ()
+ (interactive)
+ (image-dired default-directory))
+ :active default-directory
+ :help "Show thumbnails for all images in this directory"]
+ ["Next Image" image-next-file :active buffer-file-name
+ :help "Move to next image in this directory"]
+ ["Previous Image" image-previous-file :active buffer-file-name
+ :help "Move to previous image in this directory"]
+ "--"
+ ["Animate Image" image-toggle-animation :style toggle
+ :selected (let ((image (image-get-display-property)))
+ (and image (image-animate-timer image)))
+ :active image-multi-frame
+ :help "Toggle image animation"]
+ ["Loop Animation"
+ (lambda () (interactive)
+ (setq image-animate-loop (not image-animate-loop))
+ ;; FIXME this is a hacky way to make it affect a currently
+ ;; animating image.
+ (when (let ((image (image-get-display-property)))
+ (and image (image-animate-timer image)))
+ (image-toggle-animation)
+ (image-toggle-animation)))
+ :style toggle :selected image-animate-loop
+ :active image-multi-frame
+ :help "Animate images once, or forever?"]
+ ["Reverse Animation" image-reverse-speed
+ :style toggle :selected (let ((image (image-get-display-property)))
+ (and image (<
+ (image-animate-get-speed image)
+ 0)))
+ :active image-multi-frame
+ :help "Reverse direction of this image's animation?"]
+ ["Speed Up Animation" image-increase-speed
+ :active image-multi-frame
+ :help "Speed up this image's animation"]
+ ["Slow Down Animation" image-decrease-speed
+ :active image-multi-frame
+ :help "Slow down this image's animation"]
+ ["Reset Animation Speed" image-reset-speed
+ :active image-multi-frame
+ :help "Reset the speed of this image's animation"]
+ ["Next Frame" image-next-frame :active image-multi-frame
+ :help "Show the next frame of this image"]
+ ["Previous Frame" image-previous-frame :active image-multi-frame
+ :help "Show the previous frame of this image"]
+ ["Goto Frame..." image-goto-frame :active image-multi-frame
+ :help "Show a specific frame of this image"]
+ ))
map)
"Mode keymap for `image-mode'.")
(defun image-mode ()
"Major mode for image files.
You can use \\<image-mode-map>\\[image-toggle-display]
-to toggle between display as an image and display as text."
+to toggle between display as an image and display as text.
+
+Key bindings:
+\\{image-mode-map}"
(interactive)
(condition-case err
(progn
(use-local-map image-mode-map)
;; Use our own bookmarking function for images.
- (set (make-local-variable 'bookmark-make-record-function)
- 'image-bookmark-make-record)
+ (setq-local bookmark-make-record-function
+ #'image-bookmark-make-record)
;; Keep track of [vh]scroll when switching buffers
(image-mode-setup-winprops)
(add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
(add-hook 'after-revert-hook 'image-after-revert-hook nil t)
(run-mode-hooks 'image-mode-hook)
- (message "%s" (concat
- (substitute-command-keys
- "Type \\[image-toggle-display] to view the image as ")
- (if (image-get-display-property)
- "text" "an image") ".")))
+ (let ((image (image-get-display-property))
+ (msg1 (substitute-command-keys
+ "Type \\[image-toggle-display] to view the image as "))
+ animated)
+ (cond
+ ((null image)
+ (message "%s" (concat msg1 "an image.")))
+ ((setq animated (image-multi-frame-p image))
+ (setq image-multi-frame t
+ mode-line-process
+ `(:eval
+ (concat " "
+ (propertize
+ (format "[%s/%s]"
+ (1+ (image-current-frame ',image))
+ ,(car animated))
+ 'help-echo "Frames
+mouse-1: Next frame
+mouse-3: Previous frame"
+ 'mouse-face 'mode-line-highlight
+ 'local-map
+ '(keymap
+ (mode-line
+ keymap
+ (down-mouse-1 . image-next-frame)
+ (down-mouse-3 . image-previous-frame)))))))
+ (message "%s"
+ (concat msg1 "text. This image has multiple frames.")))
+;;; (substitute-command-keys
+;;; "\\[image-toggle-animation] to animate."))))
+ (t
+ (message "%s" (concat msg1 "text."))))))
+
(error
(image-mode-as-text)
(funcall
(if (called-interactively-p 'any) 'error 'message)
"Cannot display image: %s" (cdr err)))))
+
;;;###autoload
(define-minor-mode image-minor-mode
- "Toggle Image minor mode.
-With arg, turn Image minor mode on if arg is positive, off otherwise.
-It provides the key \\<image-mode-map>\\[image-toggle-display] \
-to switch back to `image-mode'
-to display an image file as the actual image."
+ "Toggle Image minor mode in this buffer.
+With a prefix argument ARG, enable Image minor mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
+to switch back to `image-mode' and display an image file as the
+actual image."
nil (:eval (if image-type (format " Image[%s]" image-type) " Image"))
image-minor-mode-map
:group 'image
elt))
magic-fallback-mode-alist))))
(normal-mode)
- (set (make-local-variable 'image-mode-previous-major-mode) major-mode)))
+ (setq-local image-mode-previous-major-mode major-mode)))
;; Restore `image-type' after `kill-all-local-variables' in `normal-mode'.
(setq image-type previous-image-type)
;; Enable image minor mode with `C-c C-c'.
(buffer-undo-list t)
(modified (buffer-modified-p)))
(remove-list-of-text-properties (point-min) (point-max)
- '(display intangible read-nonsticky
+ '(display read-nonsticky ;; intangible
read-only front-sticky))
(set-buffer-modified-p modified)
(if (called-interactively-p 'any)
"Show the image of the image file.
Turn the image data into a real image, but only if the whole file
was inserted."
- (unless (derived-mode-p 'image-mode major-mode)
+ (unless (derived-mode-p 'image-mode)
(error "The buffer is not in Image mode"))
(let* ((filename (buffer-file-name))
(data-p (not (and filename
(buffer-substring-no-properties (point-min) (point-max)))
filename))
(type (image-type file-or-data nil data-p))
- ;; Don't use create-animated-image here; that would start the
- ;; timer, which works by altering the spec destructively.
- ;; But we still need to append the transformation properties,
- ;; which would make a new list.
(image (create-image file-or-data type data-p))
(inhibit-read-only t)
(buffer-undo-list t)
(modified (buffer-modified-p))
props)
+ ;; Discard any stale image data before looking it up again.
+ (image-flush image)
(setq image (append image (image-transform-properties image)))
(setq props
`(display ,image
- intangible ,image
- rear-nonsticky (display intangible)
+ ;; intangible ,image
+ rear-nonsticky (display) ;; intangible
read-only t front-sticky (read-only)))
- (image-flush image)
- ;; Begin the animation, if any.
- (image-animate-start image)
(let ((buffer-file-truename nil)) ; avoid changing dir mtime by lock_file
(add-text-properties (point-min) (point-max) props)
;; is written with, e.g., C-x C-w.
(if (coding-system-equal (coding-system-base buffer-file-coding-system)
'no-conversion)
- (set (make-local-variable 'find-file-literally) t))
- ;; Allow navigation of large images
- (set (make-local-variable 'auto-hscroll-mode) nil)
+ (setq-local find-file-literally t))
+ ;; Allow navigation of large images.
+ (setq-local auto-hscroll-mode nil)
(setq image-type type)
(if (eq major-mode 'image-mode)
(setq mode-name (format "Image[%s]" type)))
+ (image-transform-check-size)
(if (called-interactively-p 'any)
(message "Repeat this command to go back to displaying the file as text"))))
(image-toggle-display-image)))
\f
+;;; Animated images
+
+(defcustom image-animate-loop nil
+ "Non-nil means animated images loop forever, rather than playing once."
+ :type 'boolean
+ :version "24.1"
+ :group 'image)
+
+(defun image-toggle-animation ()
+ "Start or stop animating the current image.
+If `image-animate-loop' is non-nil, animation loops forever.
+Otherwise it plays once, then stops."
+ (interactive)
+ (let ((image (image-get-display-property))
+ animation)
+ (cond
+ ((null image)
+ (error "No image is present"))
+ ((null (setq animation (image-multi-frame-p image)))
+ (message "No image animation."))
+ (t
+ (let ((timer (image-animate-timer image)))
+ (if timer
+ (cancel-timer timer)
+ (let ((index (plist-get (cdr image) :index)))
+ ;; If we're at the end, restart.
+ (and index
+ (>= index (1- (car animation)))
+ (setq index nil))
+ (image-animate image index
+ (if image-animate-loop t)))))))))
+
+(defun image--set-speed (speed &optional multiply)
+ "Set speed of an animated image to SPEED.
+If MULTIPLY is non-nil, treat SPEED as a multiplication factor.
+If SPEED is `reset', reset the magnitude of the speed to 1."
+ (let ((image (image-get-display-property)))
+ (cond
+ ((null image)
+ (error "No image is present"))
+ ((null image-multi-frame)
+ (message "No image animation."))
+ (t
+ (if (eq speed 'reset)
+ (setq speed (if (< (image-animate-get-speed image) 0)
+ -1 1)
+ multiply nil))
+ (image-animate-set-speed image speed multiply)
+ ;; FIXME Hack to refresh an active image.
+ (when (image-animate-timer image)
+ (image-toggle-animation)
+ (image-toggle-animation))
+ (message "Image speed is now %s" (image-animate-get-speed image))))))
+
+(defun image-increase-speed ()
+ "Increase the speed of current animated image by a factor of 2."
+ (interactive)
+ (image--set-speed 2 t))
+
+(defun image-decrease-speed ()
+ "Decrease the speed of current animated image by a factor of 2."
+ (interactive)
+ (image--set-speed 0.5 t))
+
+(defun image-reverse-speed ()
+ "Reverse the animation of the current image."
+ (interactive)
+ (image--set-speed -1 t))
+
+(defun image-reset-speed ()
+ "Reset the animation speed of the current image."
+ (interactive)
+ (image--set-speed 'reset))
+
+(defun image-goto-frame (n &optional relative)
+ "Show frame N of a multi-frame image.
+Optional argument OFFSET non-nil means interpret N as relative to the
+current frame. Frames are indexed from 1."
+ (interactive
+ (list (or current-prefix-arg
+ (read-number "Show frame number: "))))
+ (let ((image (image-get-display-property)))
+ (cond
+ ((null image)
+ (error "No image is present"))
+ ((null image-multi-frame)
+ (message "No image animation."))
+ (t
+ (image-show-frame image
+ (if relative
+ (+ n (image-current-frame image))
+ (1- n)))))))
+
+(defun image-next-frame (&optional n)
+ "Switch to the next frame of a multi-frame image.
+With optional argument N, switch to the Nth frame after the current one.
+If N is negative, switch to the Nth frame before the current one."
+ (interactive "p")
+ (image-goto-frame n t))
+
+(defun image-previous-frame (&optional n)
+ "Switch to the previous frame of a multi-frame image.
+With optional argument N, switch to the Nth frame before the current one.
+If N is negative, switch to the Nth frame after the current one."
+ (interactive "p")
+ (image-next-frame (- n)))
+
+\f
+;;; Switching to the next/previous image
+
+(defun image-next-file (&optional n)
+ "Visit the next image in the same directory as the current image file.
+With optional argument N, visit the Nth image file after the
+current one, in cyclic alphabetical order.
+
+This command visits the specified file via `find-alternate-file',
+replacing the current Image mode buffer."
+ (interactive "p")
+ (unless (derived-mode-p 'image-mode)
+ (error "The buffer is not in Image mode"))
+ (unless buffer-file-name
+ (error "The current image is not associated with a file"))
+ (let* ((file (file-name-nondirectory buffer-file-name))
+ (images (image-mode--images-in-directory file))
+ (idx 0))
+ (catch 'image-visit-next-file
+ (dolist (f images)
+ (if (string= f file)
+ (throw 'image-visit-next-file (1+ idx)))
+ (setq idx (1+ idx))))
+ (setq idx (mod (+ idx (or n 1)) (length images)))
+ (find-alternate-file (nth idx images))))
+
+(defun image-previous-file (&optional n)
+ "Visit the preceding image in the same directory as the current file.
+With optional argument N, visit the Nth image file preceding the
+current one, in cyclic alphabetical order.
+
+This command visits the specified file via `find-alternate-file',
+replacing the current Image mode buffer."
+ (interactive "p")
+ (image-next-file (- n)))
+
+(defun image-mode--images-in-directory (file)
+ (let* ((dir (file-name-directory buffer-file-name))
+ (files (directory-files dir nil
+ (image-file-name-regexp) t)))
+ ;; Add the current file to the list of images if necessary, in
+ ;; case it does not match `image-file-name-regexp'.
+ (unless (member file files)
+ (push file files))
+ (sort files 'string-lessp)))
+
+\f
;;; Support for bookmark.el
(declare-function bookmark-make-record-default
"bookmark" (&optional no-file no-context posn))
(image-toggle-display))))
\f
-(defvar image-transform-minor-mode-map
- (let ((map (make-sparse-keymap)))
- ;; (define-key map [(control ?+)] 'image-scale-in)
- ;; (define-key map [(control ?-)] 'image-scale-out)
- ;; (define-key map [(control ?=)] 'image-scale-none)
- ;; (define-key map "c f h" 'image-scale-fit-height)
- ;; (define-key map "c ]" 'image-rotate-right)
- map)
- "Minor mode keymap `image-transform-mode'.")
+;; Not yet implemented.
+;; (defvar image-transform-minor-mode-map
+;; (let ((map (make-sparse-keymap)))
+;; ;; (define-key map [(control ?+)] 'image-scale-in)
+;; ;; (define-key map [(control ?-)] 'image-scale-out)
+;; ;; (define-key map [(control ?=)] 'image-scale-none)
+;; ;; (define-key map "c f h" 'image-scale-fit-height)
+;; ;; (define-key map "c ]" 'image-rotate-right)
+;; map)
+;; "Minor mode keymap `image-transform-mode'.")
+;;
+;; (define-minor-mode image-transform-mode
+;; "Minor mode for scaling and rotating images.
+;; With a prefix argument ARG, enable the mode if ARG is positive,
+;; and disable it otherwise. If called from Lisp, enable the mode
+;; if ARG is omitted or nil. This minor mode requires Emacs to have
+;; been compiled with ImageMagick support."
+;; nil "image-transform" image-transform-minor-mode-map)
-(define-minor-mode image-transform-mode
- "Minor mode for scaling and rotating images.
-This minor mode has no effect unless Emacs is compiled with
-ImageMagick support."
- nil "image-transform" image-transform-minor-mode-map)
+;; FIXME this doesn't seem mature yet. Document in manual when it is.
(defvar image-transform-resize nil
"The image resize operation.
Its value should be one of the following:
- nil, meaning no resizing.
- `fit-height', meaning to fit the image to the window height.
- `fit-width', meaning to fit the image to the window width.
- - A number, which is a scale factor (the default size is 100).")
-
-(defvar image-transform-rotation 0.0)
-
-(defun image-transform-properties (display)
- "Return rescaling/rotation properties for the Image mode buffer.
-These properties are suitable for appending to an image spec;
-they are determined by the variables `image-transform-resize' and
-`image-transform-rotation'.
-
-Recaling and rotation properties only take effect if Emacs is
+ - A number, which is a scale factor (the default size is 1).")
+
+(defvar image-transform-scale 1.0
+ "The scale factor of the image being displayed.")
+
+(defvar image-transform-rotation 0.0
+ "Rotation angle for the image in the current Image mode buffer.")
+
+(defvar image-transform-right-angle-fudge 0.0001
+ "Snap distance to a multiple of a right angle.
+There's no deep theory behind the default value, it should just
+be somewhat larger than ImageMagick's MagickEpsilon.")
+
+(defsubst image-transform-width (width height)
+ "Return the bounding box width of a rotated WIDTH x HEIGHT rectangle.
+The rotation angle is the value of `image-transform-rotation' in degrees."
+ (let ((angle (degrees-to-radians image-transform-rotation)))
+ ;; Assume, w.l.o.g., that the vertices of the rectangle have the
+ ;; coordinates (+-w/2, +-h/2) and that (0, 0) is the center of the
+ ;; rotation by the angle A. The projections onto the first axis
+ ;; of the vertices of the rotated rectangle are +- (w/2) cos A +-
+ ;; (h/2) sin A, and the difference between the largest and the
+ ;; smallest of the four values is the expression below.
+ (+ (* width (abs (cos angle))) (* height (abs (sin angle))))))
+
+;; The following comment and code snippet are from
+;; ImageMagick-6.7.4-4/magick/distort.c
+
+;; /* Set the output image geometry to calculated 'best fit'.
+;; Yes this tends to 'over do' the file image size, ON PURPOSE!
+;; Do not do this for DePolar which needs to be exact for virtual tiling.
+;; */
+;; if ( fix_bounds ) {
+;; geometry.x = (ssize_t) floor(min.x-0.5);
+;; geometry.y = (ssize_t) floor(min.y-0.5);
+;; geometry.width=(size_t) ceil(max.x-geometry.x+0.5);
+;; geometry.height=(size_t) ceil(max.y-geometry.y+0.5);
+;; }
+
+;; Other parts of the same file show that here the origin is in the
+;; left lower corner of the image rectangle, the center of the
+;; rotation is the center of the rectangle and min.x and max.x
+;; (resp. min.y and max.y) are the smallest and the largest of the
+;; projections of the vertices onto the first (resp. second) axis.
+
+(defun image-transform-fit-width (width height length)
+ "Return (w . h) so that a rotated w x h image has exactly width LENGTH.
+The rotation angle is the value of `image-transform-rotation'.
+Write W for WIDTH and H for HEIGHT. Then the w x h rectangle is
+an \"approximately uniformly\" scaled W x H rectangle, which
+currently means that w is one of floor(s W) + {0, 1, -1} and h is
+floor(s H), where s can be recovered as the value of `image-transform-scale'.
+The value of `image-transform-rotation' may be replaced by
+a slightly different angle. Currently this is done for values
+close to a multiple of 90, see `image-transform-right-angle-fudge'."
+ (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90))
+ image-transform-right-angle-fudge)
+ (cl-assert (not (zerop width)) t)
+ (setq image-transform-rotation
+ (float (round image-transform-rotation))
+ image-transform-scale (/ (float length) width))
+ (cons length nil))
+ ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45))
+ image-transform-right-angle-fudge)
+ (cl-assert (not (zerop height)) t)
+ (setq image-transform-rotation
+ (float (round image-transform-rotation))
+ image-transform-scale (/ (float length) height))
+ (cons nil length))
+ (t
+ (cl-assert (not (and (zerop width) (zerop height))) t)
+ (setq image-transform-scale
+ (/ (float (1- length)) (image-transform-width width height)))
+ ;; Assume we have a w x h image and an angle A, and let l =
+ ;; l(w, h) = w |cos A| + h |sin A|, which is the actual width
+ ;; of the bounding box of the rotated image, as calculated by
+ ;; `image-transform-width'. The code snippet quoted above
+ ;; means that ImageMagick puts the rotated image in
+ ;; a bounding box of width L = 2 ceil((w+l+1)/2) - w.
+ ;; Elementary considerations show that this is equivalent to
+ ;; L - w being even and L-3 < l(w, h) <= L-1. In our case, L is
+ ;; the given `length' parameter and our job is to determine
+ ;; reasonable values for w and h which satisfy these
+ ;; conditions.
+ (let ((w (floor (* image-transform-scale width)))
+ (h (floor (* image-transform-scale height))))
+ ;; Let w and h as bound above. Then l(w, h) <= l(s W, s H)
+ ;; = L-1 < l(w+1, h+1) = l(w, h) + l(1, 1) <= l(w, h) + 2,
+ ;; hence l(w, h) > (L-1) - 2 = L-3.
+ (cons
+ (cond ((= (mod w 2) (mod length 2))
+ w)
+ ;; l(w+1, h) >= l(w, h) > L-3, but does l(w+1, h) <=
+ ;; L-1 hold?
+ ((<= (image-transform-width (1+ w) h) (1- length))
+ (1+ w))
+ ;; No, it doesn't, but this implies that l(w-1, h) =
+ ;; l(w+1, h) - l(2, 0) >= l(w+1, h) - 2 > (L-1) -
+ ;; 2 = L-3. Clearly, l(w-1, h) <= l(w, h) <= L-1.
+ (t
+ (1- w)))
+ h)))))
+
+(defun image-transform-check-size ()
+ "Check that the image exactly fits the width/height of the window.
+
+Do this for an image of type `imagemagick' to make sure that the
+elisp code matches the way ImageMagick computes the bounding box
+of a rotated image."
+ (when (and (not (numberp image-transform-resize))
+ (boundp 'image-type)
+ (eq image-type 'imagemagick))
+ (let ((size (image-display-size (image-get-display-property) t)))
+ (cond ((eq image-transform-resize 'fit-width)
+ (cl-assert (= (car size)
+ (- (nth 2 (window-inside-pixel-edges))
+ (nth 0 (window-inside-pixel-edges))))
+ t))
+ ((eq image-transform-resize 'fit-height)
+ (cl-assert (= (cdr size)
+ (- (nth 3 (window-inside-pixel-edges))
+ (nth 1 (window-inside-pixel-edges))))
+ t))))))
+
+(defun image-transform-properties (spec)
+ "Return rescaling/rotation properties for image SPEC.
+These properties are determined by the Image mode variables
+`image-transform-resize' and `image-transform-rotation'. The
+return value is suitable for appending to an image spec.
+
+Rescaling and rotation properties only take effect if Emacs is
compiled with ImageMagick support."
- (let* ((size (image-size display t))
- (height
- (cond
- ((numberp image-transform-resize)
- (unless (= image-transform-resize 100)
- (* image-transform-resize (cdr size))))
- ((eq image-transform-resize 'fit-height)
- (- (nth 3 (window-inside-pixel-edges))
- (nth 1 (window-inside-pixel-edges))))))
- (width (if (eq image-transform-resize 'fit-width)
- (- (nth 2 (window-inside-pixel-edges))
- (nth 0 (window-inside-pixel-edges))))))
- ;;TODO fit-to-* should consider the rotation angle
- `(,@(if height (list :height height))
- ,@(if width (list :width width))
- ,@(if (not (equal 0.0 image-transform-rotation))
- (list :rotation image-transform-rotation)))))
+ (setq image-transform-scale 1.0)
+ (when (or image-transform-resize
+ (/= image-transform-rotation 0.0))
+ ;; Note: `image-size' looks up and thus caches the untransformed
+ ;; image. There's no easy way to prevent that.
+ (let* ((size (image-size spec t))
+ (resized
+ (cond
+ ((numberp image-transform-resize)
+ (unless (= image-transform-resize 1)
+ (setq image-transform-scale image-transform-resize)
+ (cons nil (floor (* image-transform-resize (cdr size))))))
+ ((eq image-transform-resize 'fit-width)
+ (image-transform-fit-width
+ (car size) (cdr size)
+ (- (nth 2 (window-inside-pixel-edges))
+ (nth 0 (window-inside-pixel-edges)))))
+ ((eq image-transform-resize 'fit-height)
+ (let ((res (image-transform-fit-width
+ (cdr size) (car size)
+ (- (nth 3 (window-inside-pixel-edges))
+ (nth 1 (window-inside-pixel-edges))))))
+ (cons (cdr res) (car res)))))))
+ `(,@(when (car resized)
+ (list :width (car resized)))
+ ,@(when (cdr resized)
+ (list :height (cdr resized)))
+ ,@(unless (= 0.0 image-transform-rotation)
+ (list :rotation image-transform-rotation))))))
(defun image-transform-set-scale (scale)
"Prompt for a number, and resize the current image by that amount.
ROTATION should be in degrees. This command has no effect unless
Emacs is compiled with ImageMagick support."
(interactive "nRotation angle (in degrees): ")
- ;;TODO 0 90 180 270 degrees are the only reasonable angles here
- ;;otherwise combining with rescaling will get very awkward
- (setq image-transform-rotation (float rotation))
+ (setq image-transform-rotation (float (mod rotation 360)))
(image-toggle-display-image))
(provide 'image-mode)