* Makefile.in (install-etc): Fix previous change.
[bpt/emacs.git] / lisp / image-mode.el
index 64dcf90..8329c02 100644 (file)
@@ -1,6 +1,6 @@
 ;;; image-mode.el --- support for visiting image files
 ;;
-;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2012 Free Software Foundation, Inc.
 ;;
 ;; Author: Richard Stallman <rms@gnu.org>
 ;; Keywords: multimedia
@@ -163,7 +163,7 @@ Stop if the left edge of the image is reached."
   (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")
@@ -271,7 +271,7 @@ stopping if the top or bottom edge of the image is reached."
 ;; Adjust frame and image size.
 
 (defun image-mode-fit-frame ()
-  "Fit the frame to the current image.
+  "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, ...
@@ -296,8 +296,7 @@ This function assumes the current frame has only one window."
 ;;; Image Mode setup
 
 (defvar image-type nil
-  "Current image type.
-This variable is used to display the current image type in the mode line.")
+  "The image type for the current Image mode buffer.")
 (make-variable-buffer-local 'image-type)
 
 (defvar image-mode-previous-major-mode nil
@@ -309,6 +308,7 @@ This variable is used to display the current image type in the mode line.")
     (define-key map "\C-c\C-c" 'image-toggle-display)
     (define-key map (kbd "SPC")       'image-scroll-up)
     (define-key map (kbd "DEL")       'image-scroll-down)
+    (define-key map (kbd "RET")       'image-toggle-animation)
     (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)
@@ -324,13 +324,13 @@ This variable is used to display the current image type in the mode line.")
     (define-key map [remap beginning-of-buffer] 'image-bob)
     (define-key map [remap end-of-buffer] 'image-eob)
     map)
-  "Major mode keymap for viewing images in Image mode.")
+  "Mode keymap for `image-mode'.")
 
 (defvar image-minor-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "\C-c\C-c" 'image-toggle-display)
     map)
-  "Minor mode keymap for viewing images as text in Image mode.")
+  "Mode keymap for `image-minor-mode'.")
 
 (defvar bookmark-make-record-function)
 
@@ -374,23 +374,36 @@ to toggle between display as an image and display as text."
        (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 ")))
+         (cond
+          ((null image)
+           (message "%s" (concat msg1 "an image.")))
+          ((image-animated-p image)
+           (message "%s"
+                    (concat msg1 "text, or "
+                            (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
@@ -455,7 +468,7 @@ Remove text properties that display the image."
        (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)
@@ -469,6 +482,8 @@ 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)
+    (error "The buffer is not in Image mode"))
   (let* ((filename (buffer-file-name))
         (data-p (not (and filename
                           (file-readable-p filename)
@@ -483,19 +498,21 @@ was inserted."
                            (buffer-substring-no-properties (point-min) (point-max)))
                         filename))
         (type (image-type file-or-data nil data-p))
-         (image0 (create-animated-image file-or-data type data-p))
-        (image (append image0
-                        (image-transform-properties image0)
-                        ))
-        (props
-         `(display ,image
-                   intangible ,image
-                   rear-nonsticky (display intangible)
-                   read-only t front-sticky (read-only)))
+        (image (create-image file-or-data type data-p))
         (inhibit-read-only t)
         (buffer-undo-list t)
-        (modified (buffer-modified-p)))
+        (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
+                   read-only t front-sticky (read-only)))
+
     (let ((buffer-file-truename nil)) ; avoid changing dir mtime by lock_file
       (add-text-properties (point-min) (point-max) props)
       (restore-buffer-modified-p modified))
@@ -515,13 +532,15 @@ 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"))))
 
 (defun image-toggle-display ()
-  "Start or stop displaying an image file as the actual image.
-This command toggles between `image-mode-as-text' showing the text of
-the image file and `image-mode' showing the image as an image."
+  "Toggle between image and text display.
+If the current buffer is displaying an image file as an image,
+call `image-mode-as-text' to switch to text.  Otherwise, display
+the image by calling `image-mode'."
   (interactive)
   (if (image-get-display-property)
       (image-mode-as-text)
@@ -531,10 +550,44 @@ the image file and `image-mode' showing the image as an image."
   (when (image-get-display-property)
     (image-toggle-display-text)
     ;; Update image display.
-    (redraw-frame (selected-frame))
+    (mapc (lambda (window) (redraw-frame (window-frame window)))
+          (get-buffer-window-list (current-buffer) 'nomini 'visible))
     (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-animated-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)))))))))
+
+\f
 ;;; Support for bookmark.el
 (declare-function bookmark-make-record-default
                   "bookmark" (&optional no-file no-context posn))
@@ -555,82 +608,220 @@ the image file and `image-mode' showing the image as an image."
       (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 for transforming the view of images Image mode.")
-
-(define-minor-mode image-transform-mode
-  "minor mode for scaleing and rotation"
-  nil "image-transform"
-  image-transform-minor-mode-map)
-
-(defvar image-transform-resize   nil
-  "The image resize operation. See the command
-  `image-transform-set-scale' for more information." )
-
-(defvar image-transform-rotation 0.0)
-
-
-(defun image-transform-properties (display)
-  "Calculate the display properties for transformations; scaling
-and rotation. "
-  (let*
-      ((size (image-size display t))
-       (height
-        (cond
-         ((and (numberp image-transform-resize) (eq 100 image-transform-resize))
-          nil)
-         ((numberp image-transform-resize)
-          (* image-transform-resize (cdr size)))
-         ((eq image-transform-resize 'fit-height)
-          (- (nth 3 (window-inside-pixel-edges)) (nth 1 (window-inside-pixel-edges))))
-         (t nil)))
-       (width (if (eq image-transform-resize 'fit-width)
-                  (- (nth 2 (window-inside-pixel-edges)) (nth 0 (window-inside-pixel-edges))))))
-
-    `(,@(if height (list :height height))
-      ,@(if width (list :width width))
-      ,@(if (not (equal 0.0 image-transform-rotation))
-            (list :rotation image-transform-rotation))
-      ;;TODO fit-to-* should consider the rotation angle
-      )))
+;; 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)
+
+
+;; 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 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 'bestfit'.
+;;       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)
+        (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)
+        (assert (not (zerop height)) t)
+        (setq image-transform-rotation
+              (float (round image-transform-rotation))
+              image-transform-scale (/ (float length) height))
+        (cons nil length))
+       (t
+        (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."
+  (unless (numberp image-transform-resize)
+    (let ((size (image-display-size (image-get-display-property) t)))
+      (cond ((eq image-transform-resize 'fit-width)
+            (assert (= (car size)
+                       (- (nth 2 (window-inside-pixel-edges))
+                          (nth 0 (window-inside-pixel-edges))))
+                    t))
+           ((eq image-transform-resize 'fit-height)
+            (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."
+  (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)
-  "SCALE sets the scaling for images. "
-  (interactive "nscale:")
-  (image-transform-set-resize (float scale)))
+  "Prompt for a number, and resize the current image by that amount.
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+  (interactive "nScale: ")
+  (setq image-transform-resize scale)
+  (image-toggle-display-image))
 
 (defun image-transform-fit-to-height ()
-  "Fit image height to window height. "
+  "Fit the current image to the height of the current window.
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
   (interactive)
-  (image-transform-set-resize 'fit-height))
+  (setq image-transform-resize 'fit-height)
+  (image-toggle-display-image))
 
 (defun image-transform-fit-to-width ()
-  "Fit image width to window width. "
+  "Fit the current image to the width of the current window.
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
   (interactive)
-  (image-transform-set-resize 'fit-width))
-
-(defun image-transform-set-resize (resize)
-  "Set the resize mode for images. The RESIZE value can be the
-symbol fit-height which fits the image to the window height. The
-symbol fit-width fits the image to the window width.  A number
-indicates a scaling factor. nil indicates scale to 100%. "
-  (setq image-transform-resize resize)
-  (if (eq 'image-mode major-mode) (image-toggle-display-image)))
+  (setq image-transform-resize 'fit-width)
+  (image-toggle-display-image))
 
 (defun image-transform-set-rotation (rotation)
-  "Set the image ROTATION angle. "
-  (interactive "nrotation:")
-  ;;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))
-  (if (eq major-mode 'image-mode) (image-toggle-display-image)))
+  "Prompt for an angle ROTATION, and rotate the 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): ")
+  (setq image-transform-rotation (float (mod rotation 360)))
+  (image-toggle-display-image))
 
 (provide 'image-mode)