-;;; image-mode.el --- support for visiting image files
+;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2005-2012 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)
;;; 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.
;; Adjust frame and image size.
-(defun image-mode-fit-frame ()
- "Toggle whether to 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
(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 [remap forward-char] 'image-forward-hscroll)
(define-key map [remap backward-char] 'image-backward-hscroll)
(define-key map [remap right-char] 'image-forward-hscroll)
(run-mode-hooks 'image-mode-hook)
(let ((image (image-get-display-property))
(msg1 (substitute-command-keys
- "Type \\[image-toggle-display] to view the image as ")))
+ "Type \\[image-toggle-display] to view the image as "))
+ animated)
(cond
((null image)
(message "%s" (concat msg1 "an image.")))
- ((image-animated-p image)
+ ((setq animated (image-animated-p image))
+ (setq image-current-frame (or (plist-get (cdr image) :index) 0)
+ mode-line-process
+ `(:eval (propertize (format " [%s/%s]"
+ (1+ image-current-frame)
+ ,(car animated))
+ 'help-echo "Frame number")))
(message "%s"
(concat msg1 "text, or "
(substitute-command-keys
(image-animate image index
(if image-animate-loop t)))))))))
+(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))
+ animation)
+ (cond
+ ((null image)
+ (error "No image is present"))
+ ((null image-current-frame)
+ (message "No image animation."))
+ (t
+ (image-nth-frame image (if relative (+ n image-current-frame) (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
h)))))
(defun image-transform-check-size ()
- "Check that the image exactly fits the width/height of the window."
- (unless (numberp image-transform-resize)
+ "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)