;;; window-util.el 

;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002,
;;   2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: help, windows

;; XEmacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Synched up with: help.el revision 1.327 in GNU Emacs, of 2007-03-21, the
;;; last GPLV2 version. The initial defun-when-void functions are from their
;;; window.el, version 1.122, also the last GPLV2 version.

;;; Commentary:

;; This is some code that's in help.el in GNU. That file is in core in
;; XEmacs, and this functionality is nothing complex and should be available
;; to both stable and beta XEmacs.

;; Supporting code is taken from their window.el.

;;; Code:

;; XEmacs: this code is from from help.el and window.el. 

(require 'bytedecl)

(defun-when-void window-buffer-height (window)
  "Return the height (in screen lines) of the buffer that WINDOW is displaying."
  (with-current-buffer (window-buffer window)
    (max 1
	 (count-screen-lines (point-min) (point-max)
			     ;; If buffer ends with a newline, ignore it when
			     ;; counting height unless point is after it.
			     (eobp)
			     window))))

(defun count-screen-lines (&optional beg end count-final-newline
                                     window buffer)
  "Return the number of screen lines in the region.
The number of screen lines may be different from the number of actual lines,
due to line breaking, display table, etc.

Optional arguments BEG and END default to `point-min' and `point-max'
respectively.

If region ends with a newline, ignore it unless optional third argument
COUNT-FINAL-NEWLINE is non-nil.

The optional fourth argument WINDOW specifies the window used for obtaining
parameters such as width, horizontal scrolling, and so on.  The default is
to use the selected window's parameters.

Like `vertical-motion', `count-screen-lines' always uses the current buffer,
regardless of which buffer is displayed in WINDOW.  This makes possible to use
`count-screen-lines' in any buffer, whether or not it is currently displayed
in some window."
  (unless beg
    (setq beg (point-min buffer)))
  (unless end
    (setq end (point-max buffer)))
  (unless buffer
    (setq buffer (current-buffer)))
  (if (= beg end)
      0
    (message "current-buffer is %S" (current-buffer))
    (save-excursion
      (save-restriction
        (let ((old-window-buffer (window-buffer window)))
          (unwind-protect
              (progn
                (set-window-buffer window buffer)
                (set-buffer buffer)
                (widen)
                (narrow-to-region (min beg end)
                                  (if (and (not count-final-newline)
                                           (= ?\n (char-before (max beg end))))
                                      (1- (max beg end))
                                    (max beg end)))
                (goto-char (point-min))
                (1+ (vertical-motion (buffer-size) window)))
            (set-window-buffer window old-window-buffer)))))))

(defun fit-window-to-buffer (&optional window max-height min-height)
  "Make WINDOW the right height to display its contents exactly.
If WINDOW is omitted or nil, it defaults to the selected window.
If the optional argument MAX-HEIGHT is supplied, it is the maximum height
  the window is allowed to be, defaulting to the frame height.
If the optional argument MIN-HEIGHT is supplied, it is the minimum
  height the window is allowed to be, defaulting to `window-min-height'.

The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or
header-line."
  (interactive)

  (when (null window)
    (setq window (selected-window)))
  (when (null max-height)
    (setq max-height (frame-height (window-frame window))))

  (let* ((buf
	  ;; Buffer that is displayed in WINDOW
	  (window-buffer window))
	 (window-height
	  ;; The current height of WINDOW
	  (window-height window))
	 (desired-height
	  ;; The height necessary to show the buffer displayed by WINDOW
	  ;; (`count-screen-lines' always works on the current buffer).
	  (with-current-buffer buf
	    (+ (count-screen-lines)
	       ;; If the buffer is empty, (count-screen-lines) is
	       ;; zero.  But, even in that case, we need one text line
	       ;; for cursor.
	       (if (= (point-min) (point-max))
		   1 0)
	       ;; For non-minibuffers, count the mode-line, if any
	       (if (and (not (window-minibuffer-p window))
			mode-line-format)
		   1 0)
	       ;; Count the header-line, if any
               ;; XEmacs change; we don't have header-line-format. 
	       ;; (if header-line-format 1 0))))
	       (if (specifier-instance top-gutter) 1 0))))
	 (delta
	  ;; Calculate how much the window height has to change to show
	  ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT.
	  (- (max (min desired-height max-height)
		  (or min-height window-min-height))
	     window-height)))

    (message "delta desired-height max-height min-height window-min-height buf (current-buffer) %S"
             (list delta desired-height max-height min-height
                   window-min-height buf (current-buffer)))
    (message "in fit-window-to-buffer (selected-window) %S" (selected-window))
    ;; Don't try to redisplay with the cursor at the end
    ;; on its own line--that would force a scroll and spoil things.
    (when (with-current-buffer buf
	    (and (eobp) (bolp) (not (bobp))))
      (set-window-point window (1- (window-point window))))

    ;; Adjust WINDOW to the nominally correct size (which may actually
    ;; be slightly off because of variable height text, etc).
    (unless (zerop delta)
      (enlarge-window delta nil window))

    ;; Check if the last line is surely fully visible.  If not,
    ;; enlarge the window.
    (let ((end (with-current-buffer buf
                 (save-excursion
                   (goto-char (point-max))
                   (when (and (bolp) (not (bobp)))
                     ;; Don't include final newline
                     (backward-char 1))
                   (when truncate-lines
                     ;; If line-wrapping is turned off, test the
                     ;; beginning of the last line for visibility
                     ;; instead of the end, as the end of the line
                     ;; could be invisible by virtue of extending past
                     ;; the edge of the window.
                     (forward-line 0))
                   (point))))
          ;; XEmacs change; bind window-pixel-vscroll-increment, we don't
          ;; have #'set-window-vscroll.
          (window-pixel-scroll-increment 0))
      ; (set-window-vscroll window 0)
      (message "about to scroll, (selected-window) (current-buffer) %S"
               (list (selected-window) (current-buffer)))
      (while (and (< desired-height max-height)
                  (= desired-height (window-height window))
                  (not (pos-visible-in-window-p end window)))
        (message "doing the scrolling, (selected-window) (current-buffer) %S"
                 (list (selected-window) (current-buffer)))
        (enlarge-window 1 nil window)
        (setq desired-height (1+ desired-height))))))


;;; Automatic resizing of temporary buffers.

(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (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 `resize-temp-buffer-window'
will give to a window displaying a temporary buffer.
It can also be a function to be called to choose the height for such a buffer.
It gets one argumemt, the buffer, and should return a positive integer."
  :type '(choice integer function)
  :group 'help
  ;; :version "20.4"
  )

;; XEmacs: added.
(defvar temp-buffer-resize-mode-original-show-function nil
  "Saved `temp-buffer-show-function' from `temp-buffer-resize-mode'.
See `temp-buffer-resize-mode' and `temp-buffer-show-function'.")

;; XEmacs: added.
(defun temp-buffer-resize-mode-show-temp-buffer (buffer)
  "For use as the value of `temp-buffer-show-function':
always displays the buffer in the selected frame, regardless of the behavior
that would otherwise be introduced by the `pre-display-buffer-function', which
is normally set to `get-frame-for-buffer' (which see).

Also makes the window smaller for temporary buffers; see
`temp-buffer-resize-mode'. "
  (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is
    (let ((window (display-buffer buffer nil nil temp-buffer-shrink-to-fit)))
      (if (not (eq (last-nonminibuf-frame) (window-frame window)))
	  ;; only the pre-display-buffer-function should ever do this.
	  (error 'invalid-state
                 "display-buffer switched frames on its own!!"))
      (setq minibuffer-scroll-window window)
      (set-window-start window 1) ; obeys narrowing
      (set-window-point window 1)
      (resize-temp-buffer-window window)
      (message "finishing t-b-r-m-s-t-b (selected-window) %S (current-buffer)\
 %S" (selected-window) (current-buffer))
      nil)))

(define-minor-mode temp-buffer-resize-mode
  "Toggle the mode which makes windows smaller for temporary buffers.
With prefix argument ARG, turn the resizing of windows displaying temporary
buffers on if ARG is positive or off otherwise.
This makes the window the right height for its contents, but never
more than `temp-buffer-max-height' nor less than `window-min-height'.
This applies to `help', `apropos' and `completion' buffers, and some others."
  :global t :group 'help
  ;; XEmacs: temp-buffer-show-hook is unavailable, we have to override
  ;; temp-buffer-show-function.
  (if temp-buffer-resize-mode
      (unless (eq temp-buffer-show-function
		  'temp-buffer-resize-mode-show-temp-buffer)
	(setq temp-buffer-resize-mode-original-show-function
	      temp-buffer-show-function
	      temp-buffer-show-function
              'temp-buffer-resize-mode-show-temp-buffer))
    (if (eq temp-buffer-show-function
            'temp-buffer-resize-mode-show-temp-buffer)
	(setq temp-buffer-show-function
	      temp-buffer-resize-mode-original-show-function))))

;; XEmacs: added.
(defun resize-temp-buffer-one-window-p (&optional nomini window)
  "Call `one-window-p' on WINDOW with NOMINI as its NOMINI argument."
  (if-fboundp 'only-window-p
      (only-window-p window nomini)
    ;; Hack hack hack hack hack. 
    (let ((selected-window-definition `(lambda ()
					 ,(or window (selected-window)))))
      (flet ((selected-window () (funcall selected-window-definition)))
	(one-window-p nomini nil nil)))))

(defun resize-temp-buffer-window (&optional window)
  "Resize WINDOW to fit its contents.
Will not make it higher than `temp-buffer-max-height' nor smaller than
`window-min-height'.  Do nothing if it is the only window on its frame, if it
is not as wide as the frame or if some of the window's contents are scrolled
out of view.

If WINDOW is nil, assume the selected window."
  ;; XEmacs: added support for windows besides the selected window. 
  (or window (setq window (selected-window)))
  (unless (or (resize-temp-buffer-one-window-p 'nomini window)
              (not (pos-visible-in-window-p (point-min) window))
              (/=  (frame-width (window-frame window)) (window-width window)))
    (message "(selected-window) %S (current-buffer) %S"
             (selected-window) (current-buffer))
    (fit-window-to-buffer
     window
     (if (functionp temp-buffer-max-height)
	 (funcall temp-buffer-max-height (current-buffer))
       temp-buffer-max-height))))