[PATCH] Add window-utils.el with resize-temp-buffer-window to xemacs-base.

Ar an naoú lá is fiche de mí Lúnasa, scríobh It's me FKtPp ;): Soon. This is a first draught, with the bug that temp-buffer-show-hook is normally ignored in both 21.4 and 21.5; it seems to be necessary to set a new value for temp-buffer-show-function, probably with the contents ofs #'show-temp-buffer-in-current-frame included. 2008-08-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; * window-utils.el: New. Import some functions from window.el and help.el in GNU. In particular window-buffer-height, count-screen-lines, fit-window-to-buffer, temp-buffer-resize-mode, resize-temp-buffer-window. Also the customizable variable temp-buffer-show-height. * Makefile: Add window-utils.elc. XEmacs Packages source patch: Diff command: cvs -q diff -Nu Files affected: xemacs-packages/xemacs-base/window-utils.el =================================================================== RCS xemacs-packages/xemacs-base/Makefile =================================================================== RCS Index: xemacs-packages/xemacs-base/Makefile =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xemacs-base/Makefile,v retrieving revision 1.124 diff -u -u -r1.124 Makefile --- xemacs-packages/xemacs-base/Makefile 2008/07/23 18:12:32 1.124 +++ xemacs-packages/xemacs-base/Makefile 2008/08/28 22:39:58 ＠＠ -38,7 +38,7 ＠＠ helper.elc imenu.elc iso-syntax.elc macros.elc novice.elc outline.elc \ passwd.elc pp.elc regexp-opt.elc regi.elc ring.elc shell.elc \ skeleton.elc sort.elc thing.elc time-stamp.elc timer-funcs.elc \ - timezone.elc tq.elc xbm-button.elc xpm-button.elc + timezone.elc tq.elc xbm-button.elc xpm-button.elc window-utils.elc DATA_FILES = etc/enriched.doc DATA_DEST = . Index: xemacs-packages/xemacs-base/window-utils.el =================================================================== RCS file: window-utils.el diff -N window-utils.el --- /dev/null Fri Aug 29 00:39:56 2008 +++ window-utils.el Fri Aug 29 00:39:58 2008 ＠＠ -0,0 +1,216 ＠＠ +;;; 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: from + +(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-when-void count-screen-lines (&optional beg end count-final-newline + window) + "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))) + (unless end + (setq end (point-max))) + (if (= beg end) + 0 + (save-excursion + (save-restriction + (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)))))) + +(defun-when-void 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))) + + ;; 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)))) + + (save-selected-window + (select-window 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)) + + ;; 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) + (while (and (< desired-height max-height) + (= desired-height (window-height window)) + (not (pos-visible-in-window-p end window))) + (enlarge-window 1) + (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" + ) + +(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 + (if temp-buffer-resize-mode + ;; `help-make-xrefs' 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) + (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window))) + +(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))) + (fit-window-to-buffer + (selected-window) + (if (functionp temp-buffer-max-height) + (funcall temp-buffer-max-height (current-buffer)) + temp-buffer-max-height)))) + -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches