[Emacs-diffs] /srv/bzr/emacs/trunk r109887: Provide support for fitting frames to buffers.

[martin rudalics]

------------------------------------------------------------
revno: 109887
committer: martin rudalics <address@hidden>
branch nick: trunk
timestamp: Wed 2012-09-05 11:22:20 +0200
message:
  Provide support for fitting frames to buffers.
  
  * help.el (temp-buffer-max-height): New default value.
  (temp-buffer-resize-frames): New option.
  (resize-temp-buffer-window): Optionally resize frame.
  
  * window.el (fit-frame-to-buffer-bottom-margin): New option.
  (fit-frame-to-buffer): New function.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/help.el
  lisp/window.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2012-09-04 21:21:00 +0000
+++ b/etc/NEWS  2012-09-05 09:22:20 +0000
@@ -645,6 +645,11 @@
 
 *** New macro with-temp-buffer-window.
 
+*** New option temp-buffer-resize-frames.
+
+*** New function fit-frame-to-buffer and new option
+    fit-frame-to-buffer-bottom-margin.
+
 *** New display action function display-buffer-below-selected.
 
 *** New display action alist `inhibit-switch-frame', if non-nil, tells

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-09-05 07:05:56 +0000
+++ b/lisp/ChangeLog    2012-09-05 09:22:20 +0000
@@ -1,3 +1,12 @@
+2012-09-05  Martin Rudalics  <address@hidden>
+
+       * help.el (temp-buffer-max-height): New default value.
+       (temp-buffer-resize-frames): New option.
+       (resize-temp-buffer-window): Optionally resize frame.
+
+       * window.el (fit-frame-to-buffer-bottom-margin): New option.
+       (fit-frame-to-buffer): New function.
+
 2012-09-05  Glenn Morris  <address@hidden>
 
        * emulation/cua-rect.el (cua--init-rectangles):

=== modified file 'lisp/help.el'
--- a/lisp/help.el      2012-09-03 08:54:25 +0000
+++ b/lisp/help.el      2012-09-05 09:22:20 +0000
@@ -962,7 +962,11 @@
     result))
 
 ;;; Automatic resizing of temporary buffers.
-(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
+(defcustom temp-buffer-max-height
+  (lambda (buffer)
+    (if (eq (selected-window) (frame-root-window))
+       (/ (x-display-pixel-height) (frame-char-height) 2)
+      (/ (- (frame-height) 2) 2)))
   "Maximum height of a window displaying a temporary buffer.
 This is effective only when Temp Buffer Resize mode is enabled.
 The value is the maximum height (in lines) which
@@ -973,7 +977,16 @@
 function is called, the window to be resized is selected."
   :type '(choice integer function)
   :group 'help
-  :version "20.4")
+  :version "24.2")
+
+(defcustom temp-buffer-resize-frames nil
+  "Non-nil means `temp-buffer-resize-mode' can resize frames.
+A frame can be resized if and only if its root window is a live
+window.  The height of the root window is subject to the values of
+`temp-buffer-max-height' and `window-min-height'."
+  :type 'boolean
+  :version "24.2"
+  :group 'help)
 
 (define-minor-mode temp-buffer-resize-mode
   "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode).
@@ -1008,9 +1021,21 @@
                    (with-selected-window window
                      (funcall temp-buffer-max-height (window-buffer)))
                  temp-buffer-max-height)))
-    (when (and (pos-visible-in-window-p (point-min) window)
-              (window-combined-p window))
-      (fit-window-to-buffer window height))))
+    (cond
+     ((and (pos-visible-in-window-p (point-min) window)
+          (window-combined-p window))
+      (fit-window-to-buffer window height))
+     ((and temp-buffer-resize-frames
+          (eq window (frame-root-window window))
+          (memq (car (window-parameter window 'quit-restore))
+                ;; If 'same is too strong, we might additionally check
+                ;; whether the second element is 'frame.
+                '(same frame)))
+      (let ((frame (window-frame window)))
+       (fit-frame-to-buffer
+        frame (+ (frame-height frame)
+                 (- (window-total-size window))
+                 height)))))))
 
 ;;; Help windows.
 (defcustom help-window-select 'other

=== modified file 'lisp/window.el'
--- a/lisp/window.el    2012-09-03 08:54:25 +0000
+++ b/lisp/window.el    2012-09-05 09:22:20 +0000
@@ -5918,6 +5918,88 @@
          (error (setq delta nil)))
        delta))))
 
+(defcustom fit-frame-to-buffer-bottom-margin 4
+  "Bottom margin for `fit-frame-to-buffer'.
+This is the number of lines `fit-frame-to-buffer' leaves free at the
+bottom of the display in order to not obscure the system task bar."
+  :type 'integer
+  :version "24.2"
+  :group 'windows)
+
+(defun fit-frame-to-buffer (&optional frame max-height min-height)
+  "Adjust height of FRAME to display its buffer's contents exactly.
+FRAME can be any live frame and defaults to the selected one.
+
+Optional argument MAX-HEIGHT specifies the maximum height of
+FRAME and defaults to the height of the display below the current
+top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN.
+Optional argument MIN-HEIGHT specifies the minimum height of
+FRAME."
+  (interactive)
+  (setq frame (window-normalize-frame frame))
+  (let* ((root (frame-root-window frame))
+        (frame-min-height
+         (+ (- (frame-height frame) (window-total-size root))
+            window-min-height))
+        (frame-top (frame-parameter frame 'top))
+        (top (if (consp frame-top)
+                 (funcall (car frame-top) (cadr frame-top))
+               frame-top))
+        (frame-max-height
+         (- (/ (- (x-display-pixel-height frame) top)
+               (frame-char-height frame))
+            fit-frame-to-buffer-bottom-margin))
+        (compensate 0)
+        delta)
+    (when (and (window-live-p root) (not (window-size-fixed-p root)))
+      (with-selected-window root
+       (cond
+        ((not max-height)
+         (setq max-height frame-max-height))
+        ((numberp max-height)
+         (setq max-height (min max-height frame-max-height)))
+        (t
+         (error "%s is an invalid maximum height" max-height)))
+       (cond
+        ((not min-height)
+         (setq min-height frame-min-height))
+        ((numberp min-height)
+         (setq min-height (min min-height frame-min-height)))
+        (t
+         (error "%s is an invalid minimum height" min-height)))
+       ;; When tool-bar-mode is enabled and we have just created a new
+       ;; frame, reserve lines for toolbar resizing.  This is needed
+       ;; because for reasons unknown to me Emacs (1) reserves one line
+       ;; for the toolbar when making the initial frame and toolbars
+       ;; are enabled, and (2) later adds the remaining lines needed.
+       ;; Our code runs IN BETWEEN (1) and (2).  YMMV when you're on a
+       ;; system that behaves differently.
+       (let ((quit-restore (window-parameter root 'quit-restore))
+             (lines (tool-bar-lines-needed frame)))
+         (when (and quit-restore (eq (car quit-restore) 'frame)
+                    (not (zerop lines)))
+           (setq compensate (1- lines))))
+       (message "%s" compensate)
+       (setq delta
+             ;; Always count a final newline - we don't do any
+             ;; post-processing, so let's play safe.
+             (+ (count-screen-lines nil nil t)
+                (- (window-body-size))
+                compensate)))
+      ;; Move away from final newline.
+      (when (and (eobp) (bolp) (not (bobp)))
+       (set-window-point root (line-beginning-position 0)))
+      (set-window-start root (point-min))
+      (set-window-vscroll root 0)
+      (condition-case nil
+         (set-frame-height
+          frame
+          (min (max (+ (frame-height frame) delta)
+                    min-height)
+               max-height))
+       (error (setq delta nil))))
+    delta))
+
 (defun window-safely-shrinkable-p (&optional window)
   "Return t if WINDOW can be shrunk without shrinking other windows.
 WINDOW defaults to the selected window."