+\f
+;;; Automatic resizing of temporary buffers.
+
+(defcustom temp-buffer-resize-mode nil
+ "Non-nil means resize windows displaying temporary buffers.
+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.
+
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `temp-buffer-resize-mode'."
+ :get (lambda (symbol)
+ (and (memq 'resize-temp-buffer-window temp-buffer-show-hook) t))
+ :set (lambda (symbol value)
+ (temp-buffer-resize-mode (if value 1 -1)))
+ :initialize 'custom-initialize-default
+ :type 'boolean
+ :group 'help
+ :version "20.4")
+
+(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
+ "*Maximum height of a window displaying a temporary buffer.
+This is the maximum height (in text lines) which `resize-temp-buffer-window'
+will give to a window displaying a temporary buffer.
+It can also be a function which will be called with the object corresponding
+to the buffer to be displayed as argument and should return an integer
+positive number."
+ :type '(choice integer function)
+ :group 'help
+ :version "20.4")
+
+(defun temp-buffer-resize-mode (arg)
+ "Toggle the mode which that 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.
+See the documentation of the variable `temp-buffer-resize-mode' for
+more information."
+ (interactive "P")
+ (let ((turn-it-on
+ (if (null arg)
+ (not (memq 'resize-temp-buffer-window temp-buffer-show-hook))
+ (> (prefix-numeric-value arg) 0))))
+ (if turn-it-on
+ (progn
+ ;; `help-mode-maybe' may add a `back' button and thus increase the
+ ;; text size, so `resize-temp-buffer-window' must be run *after* it.
+ (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
+ (setq temp-buffer-resize-mode t))
+ (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)
+ (setq temp-buffer-resize-mode nil))))
+
+(defun resize-temp-buffer-window ()
+ "Resize the current 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."
+ (unless (or (one-window-p 'nomini)
+ (not (pos-visible-in-window-p (point-min)))
+ (/= (frame-width) (window-width)))
+ (let* ((max-height (if (functionp temp-buffer-max-height)
+ (funcall temp-buffer-max-height (current-buffer))
+ temp-buffer-max-height))
+ (win-height (1- (window-height)))
+ (min-height (1- window-min-height))
+ (text-height (count-screen-lines))
+ (new-height (max (min text-height max-height) min-height)))
+ (enlarge-window (- new-height win-height)))))
+
+;; `help-manyarg-func-alist' is defined primitively (in doc.c).
+;; New primitives with `MANY' or `UNEVALLED' arglists should be added
+;; to this alist.
+;; The parens and function name are redundant, but it's messy to add
+;; them in `documentation'.
+(defconst help-manyarg-func-alist
+ (purecopy
+ '((list . "(list &rest OBJECTS)")
+ (vector . "(vector &rest OBJECTS)")
+ (make-byte-code . "(make-byte-code &rest ELEMENTS)")
+ (call-process
+ . "(call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)")
+ (call-process-region
+ . "(call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS)")
+ (string . "(string &rest CHARACTERS)")
+ (+ . "(+ &rest NUMBERS-OR-MARKERS)")
+ (- . "(- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS)")
+ (* . "(* &rest NUMBERS-OR-MARKERS)")
+ (/ . "(/ DIVIDEND DIVISOR &rest DIVISORS)")
+ (max . "(max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)")
+ (min . "(min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)")
+ (logand . "(logand &rest INTS-OR-MARKERS)")
+ (logior . "(logior &rest INTS-OR-MARKERS)")
+ (logxor . "(logxor &rest INTS-OR-MARKERS)")
+ (encode-time
+ . "(encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)")
+ (insert . "(insert &rest ARGS)")
+ (insert-before-markers . "(insert-before-markers &rest ARGS)")
+ (message . "(message STRING &rest ARGUMENTS)")
+ (message-box . "(message-box STRING &rest ARGUMENTS)")
+ (message-or-box . "(message-or-box STRING &rest ARGUMENTS)")
+ (propertize . "(propertize STRING &rest PROPERTIES)")
+ (format . "(format STRING &rest OBJECTS)")
+ (apply . "(apply FUNCTION &rest ARGUMENTS)")
+ (run-hooks . "(run-hooks &rest HOOKS)")
+ (run-hook-with-args . "(run-hook-with-args HOOK &rest ARGS)")
+ (run-hook-with-args-until-failure
+ . "(run-hook-with-args-until-failure HOOK &rest ARGS)")
+ (run-hook-with-args-until-success
+ . "(run-hook-with-args-until-success HOOK &rest ARGS)")
+ (funcall . "(funcall FUNCTION &rest ARGUMENTS)")
+ (append . "(append &rest SEQUENCES)")
+ (concat . "(concat &rest SEQUENCES)")
+ (vconcat . "(vconcat vconcat)")
+ (nconc . "(nconc &rest LISTS)")
+ (widget-apply . "(widget-apply WIDGET PROPERTY &rest ARGS)")
+ (make-hash-table . "(make-hash-table &rest KEYWORD-ARGS)")
+ (insert-string . "(insert-string &rest ARGS)")
+ (start-process . "(start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)")
+ (setq-default . "(setq-default SYMBOL VALUE [SYMBOL VALUE...])")
+ (save-excursion . "(save-excursion &rest BODY)")
+ (save-current-buffer . "(save-current-buffer &rest BODY)")
+ (save-restriction . "(save-restriction &rest BODY)")
+ (or . "(or CONDITIONS ...)")
+ (and . "(and CONDITIONS ...)")
+ (if . "(if COND THEN ELSE...)")
+ (cond . "(cond CLAUSES...)")
+ (progn . "(progn BODY ...)")
+ (prog1 . "(prog1 FIRST BODY...)")
+ (prog2 . "(prog2 X Y BODY...)")
+ (setq . "(setq SYM VAL SYM VAL ...)")
+ (quote . "(quote ARG)")
+ (function . "(function ARG)")
+ (defun . "(defun NAME ARGLIST [DOCSTRING] BODY...)")
+ (defmacro . "(defmacro NAME ARGLIST [DOCSTRING] BODY...)")
+ (defvar . "(defvar SYMBOL [INITVALUE DOCSTRING])")
+ (defconst . "(defconst SYMBOL INITVALUE [DOCSTRING])")
+ (let* . "(let* VARLIST BODY...)")
+ (let . "(let VARLIST BODY...)")
+ (while . "(while TEST BODY...)")
+ (catch . "(catch TAG BODY...)")
+ (unwind-protect . "(unwind-protect BODYFORM UNWINDFORMS...)")
+ (condition-case . "(condition-case VAR BODYFORM HANDLERS...)")
+ (track-mouse . "(track-mouse BODY ...)")
+ (ml-if . "(ml-if COND THEN ELSE...)")
+ (ml-provide-prefix-argument . "(ml-provide-prefix-argument ARG1 ARG2)")
+ (with-output-to-temp-buffer
+ . "(with-output-to-temp-buffer BUFFNAME BODY ...)")
+ (save-window-excursion . "(save-window-excursion BODY ...)"))))
+