;;;; Pop up command windows
;;;;
;;;; Distributed with compile2 version 2.07
;;;; Copyright Nick Duffek, 1993
;;;;
;;;; This file is not part of GNU Emacs.  However, the following applies as
;;;; if it were:
;;;;
;;;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
;;;; ANY WARRANTY.  No author or distributor accepts responsibility to anyone
;;;; for the consequences of using it or for whether it serves any particular
;;;; purpose or works at all, unless he says so in writing.  Refer to the GNU
;;;; Emacs General Public License for full details.
;;;;
;;;; Everyone is granted permission to copy, modify and redistribute GNU
;;;; Emacs, but only under the conditions described in the GNU Emacs General
;;;; Public License.  A copy of this license is supposed to have been given
;;;; to you along with GNU Emacs so you can know your rights and
;;;; responsibilities.  It should be in a file named COPYING.  Among other
;;;; things, the copyright notice and this notice must be preserved on all
;;;; copies.
;;;;
;;;;===========================================================================
;;;;
;;;; Pop up windows with dimensions and positions suitable for "command
;;;; window", i.e. a window in which user enters commands (e.g. to a
;;;; compiler).

(require 'window-manip-fns)

(defvar command-window-height-hook 'default-command-window-height
  "*Function which returns suggested height of command windows.")

(defun default-command-window-height ()
  "Default suggested height of command windows."
  (max 8 (/ (screen-height) 3)))

(defsubst window-spans-screen-vertically (window)
  "Return whether WINDOW extends from top of screen to top of minibuffer
window."
  ;; Cannot simply return (one-window-p), since it becomes false when
  ;; splitting horizontally.
  (= (+ (window-height window)
	(window-height (minibuffer-window)))
     (screen-height)))

(defun pop-to-command-buffer (buffer &optional window-height-hook)
  "Select \"command\" BUFFER \(e.g. compilation window, debugger window\) in
a window and return the window.  Optional second arg WINDOW-HEIGHT-HOOK is a
function which returns a suggested height for the window."
  ;;
  ;; If buffer already has window, select it; otherwise select topmost
  ;; window, and shrink (but don't expand) it to match target height if
  ;; necessary.
  ;;
  (let ((window (get-buffer-window buffer))
	(current-window (selected-window)))
    (if window
	(select-window window)
      (let ((target-height (funcall (or window-height-hook
					command-window-height-hook
					'default-command-window-height))))
	(setq window (top-window))
	(select-window window)
	
	(and (>= (window-height window)
		 target-height)
	     (if (window-spans-screen-vertically window)
		 (split-window-vertically target-height)
	       (shrink-window (- (window-height window)
				 target-height))))
	(switch-to-buffer buffer)))
    window))

(defun pop-up-command-buffer (buffer &optional window-height-hook)
  "Display but don't select BUFFER as an interactive buffer \(e.g.
compilation window, debugger window\) in a window and return the window.
Optional second arg WINDOW-HEIGHT-HOOK is a function which returns a
suggested height for the window."
  (or (get-buffer-window buffer)
      (let* ((orig-window (selected-window))
	     (command-window
	      (pop-to-command-buffer buffer window-height-hook)))
	
	;; Select a window other than command-window, preferably the one that
	;; was selected upon entry to this function:
	(select-window
	 (if (eq command-window orig-window)
	     (next-window command-window)
	   orig-window))
	command-window)))

(provide 'command-window)
