;; Snarfed from Barry Jaspan bjaspan@mit.edu

(provide 'window-lib)

;;; Random utilities.
(defun cadr (c) (car (cdr c)))

(defun filter (pred lst)
  "Applies PREDICATE to each element of LIST, returning the list of
all elemenets for which the predicate returns non-nil."
  (cond ((null lst) nil)
	((funcall pred (car lst))
	 (cons (car lst) (filter pred (cdr lst))))
	(t (filter pred (cdr lst)))))
;;; End of random utilities.

(defvar delete-window-builtin nil
  "Symbol whose variable cell is t if the function cell has been set
to 'delete-window.  Used to prevent the function cell being set more
than once.")

(if delete-window-builtin
    nil
  (fset 'delete-window-builtin (symbol-function 'delete-window))
  (setq delete-window-builtin t))

(defun delete-window-v19 (&optional window)
  "Removes WINDOW from the display.  WINDOW's space is given entirely
to the window above it, unless WINDOW is the top window in which
case the space is given to the window below it.  WINDOW defaults to
the current window."
  (interactive)
  (if window nil (setq window (selected-window)))

  (let* ((winlist (filter (function (lambda (c) (not (eq (car c) window))))
			 (window-config-info)))
	;; Grow the window below the window to be deleted unless its
	;; the bottom window, in which case grow the window above it.
	(grow-window (if (eq (car (car winlist)) window)
			 (next-window window)
		       (previous-window window)))
	(win-height (window-height window))
	)

    ;; winlist is (window-config-list) modulo the window to be
    ;; deleted.  First produce a new winlist in which grow-window's
    ;; height includes the deleted window's height, then set each
    ;; window's height.
    
    (delete-window-builtin window)
    (mapcar (function (lambda (c) (set-window-height-by-1 (cadr c) (car c))))
	    (mapcar (function (lambda (c)
				(if (eq (car c) grow-window)
				    (setcar (cdr c) (+ (cadr c) win-height)))
				c))
		    winlist))
    ))

(defun delete-windows-on-v19 (buffer)
  "Delete windows showing BUFFER using delete-window-v19."
  (interactive "bDelete windows on buffer: ")
  (if (stringp buffer) (setq buffer (get-buffer buffer)))
  (let ((buf))
    (while (setq buf (get-buffer-window buffer))
      (delete-window-v19 buf))))

(defun set-window-height-by-1 (height &optional window)
  "Set the HEIGHT of WINDOW.  WINDOW defaults to the current window."
  ;; Emacs behaves predictably when changing window sizes by 1, but
  ;; not by any other size.
  (interactive "nHeight: ")
  (if window nil (setq window (selected-window)))
  (let ((curwin (selected-window)))
    (select-window window)
    (if (> (window-height window) height)
	(while (> (window-height window) height)
	  (shrink-window 1))
      (while (< (window-height window) height)
	(enlarge-window 1)))
    (select-window curwin))
  )

(defun window-config-info (&optional miniwin curwin winfo)
  "Returns a list describing the current window configuration in the
canonical order; the first element is the window after the minibuffer (ie:
the topmost window).  Each element is a list (WINDOW-OBJ HEIGHT).  The
minibuffer itself is not in the returned list."
  (cond ((null curwin)
	 (let ((mwin (minibuffer-window)))
	   (window-config-info mwin (next-window mwin t) nil)))
	((eq curwin miniwin) (reverse winfo))
	(t (window-config-info miniwin (next-window curwin t)
			       (cons (list curwin (window-height curwin))
					   winfo)))
	))