(image-mode-fit-frame): New command.

2 files changed, 27 insertions, 0 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2ad26207d6d..4bb89f6bc21 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,7 @@
 2008-04-03  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        * image-mode.el (image-mode-fit-frame): New command.
+
         * simple.el (beginning-of-buffer, end-of-buffer, goto-line, undo)
         (copy-region-as-kill, kill-ring-save, use-region-p, mark-word)
         (keyboard-escape-quit): Check region-active-p i.s.o transient-mark-mode.
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index fc38f045ff9..2fe1cdc88e6 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -244,6 +244,31 @@ stopping if the top or bottom edge of the image is reached."
     (image-set-window-hscroll (max 0 (- img-width win-width)))
     (image-set-window-vscroll (max 0 (- img-height win-height)))))
 
+;; 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))
+         (display (image-get-display-property))
+         (size (image-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))))
+
 ;;; Image Mode setup
 
 (defvar image-type nil