X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6e9ddbb313cf7db66550f93a74cbba12e39e93c0..db19bba331efadd37cec1298be2c28f0742a7379:/lisp/image-mode.el

diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index a9a8d15e6a..a95dde1d99 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 <rms@gnu.org>
 ;; 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)
@@ -482,7 +490,7 @@ Remove text properties that display the image."
   "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
@@ -532,6 +540,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"))))
 
@@ -557,13 +566,15 @@ the image by calling `image-mode'."
 ;;; Animated images
 
 (defcustom image-animate-loop nil
-  "Whether to play animated images on a loop in Image mode."
+  "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."
+  "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)
@@ -605,33 +616,157 @@ the image by calling `image-mode'."
       (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.
-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).")
+ - 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
@@ -640,27 +775,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.
@@ -691,9 +834,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)