X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/e1ac4066d1bf11c7d1d9c3419fcf983aa743721e..929aeac608c271b2448dffec29aeea85c69d6bff:/lisp/image-mode.el diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 63241f4fe7..ac090f020b 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -1,6 +1,6 @@ -;;; 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 ;; Keywords: multimedia @@ -31,15 +31,19 @@ ;; 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. @@ -47,16 +51,21 @@ It is called with one argument, the initial WINPROPS.") (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. @@ -70,12 +79,11 @@ A winprops object has the shape (WINDOW . 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) @@ -270,28 +278,50 @@ stopping if the top or bottom edge of the image is reached." ;; 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 @@ -299,6 +329,9 @@ This function assumes the current frame has only one window." "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.") @@ -307,8 +340,14 @@ This function assumes the current frame has only one window." (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) @@ -323,6 +362,59 @@ This function assumes the current frame has only one window." (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) +;;; (make-variable-buffer-local 'image-animate-loop) + (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?"] + ["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'.") @@ -376,15 +468,34 @@ to toggle between display as an image and display as text." (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-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, or " - (substitute-command-keys - "\\[image-toggle-animation] to animate.")))) + (concat msg1 "text. This image has multiple frames."))) +;;; (substitute-command-keys +;;; "\\[image-toggle-animation] to animate.")))) (t (message "%s" (concat msg1 "text.")))))) @@ -532,6 +643,7 @@ was inserted." (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")))) @@ -572,7 +684,7 @@ Otherwise it plays once, then stops." (cond ((null image) (error "No image is present")) - ((null (setq animation (image-animated-p image))) + ((null (setq animation (image-multi-frame-p image))) (message "No image animation.")) (t (let ((timer (image-animate-timer image))) @@ -586,6 +698,85 @@ Otherwise it plays once, then stops." (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))) + (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))) + + +;;; 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))) + ;;; Support for bookmark.el (declare-function bookmark-make-record-default @@ -607,35 +798,157 @@ Otherwise it plays once, then stops." (image-toggle-display)))) -(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. -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) +;; 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).") + - 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 @@ -644,27 +957,35 @@ return value is suitable for appending to an image spec. Rescaling and rotation properties only take effect if Emacs is compiled with ImageMagick support." + (setq image-transform-scale 1.0) (when (or image-transform-resize - (not (equal image-transform-rotation 0.0))) + (/= 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)) - (height + (resized (cond ((numberp image-transform-resize) - (unless (= image-transform-resize 100) - (* image-transform-resize (cdr size)))) + (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) - (- (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)))))) + (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. @@ -695,9 +1016,7 @@ ImageMagick support." 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)