diff lisp/window.el @ 4506:bd28481bb0e1

Port #'window-buffer-height, #'fit-window-to-buffer, & window, buf, functions. lisp/ChangeLog addition: 2008-08-31 Aidan Kehoe <kehoea@parhasard.net> * window.el (only-window-p): New. Check if WINDOW is the only window in some context, normally its frame. (one-window-p): Implemented this in terms of #'only-window-p, calling it on the selected window. (window-buffer-height): Uncomment this, make it work. (count-screen-lines): Support a BUFFER argument. (fit-window-to-buffer): Uncomment this, correct its implementation to work with XEmacs. * help.el (temp-buffer-resize-mode): New. Name taken from GNU, implementation our own. * (resize-temp-buffer-window): New. GNU-compatible alias for #'shrink-window-if-larger-than-buffer. * dumped-lisp.el (preloaded-file-list): Move easy-mmode before help, now that the latter uses #'define-minor-mode. * frame.el: Point to #'temp-buffer-resize-mode in a comment. Some of this code is from GNU; help.el CVS version 1.327 of 2007-03-21, window.el CVS version 1.122, of 2007-06-24. Both these are GPLV2 or later.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 31 Aug 2008 12:26:46 +0200
parents cd0abfdb9e9d
children f00192e1cd49 308d34e9f07d
line wrap: on
line diff
--- a/lisp/window.el	Wed Aug 27 21:47:21 2008 +0200
+++ b/lisp/window.el	Sun Aug 31 12:26:46 2008 +0200
@@ -33,16 +33,19 @@
 
 ;;;; Window tree functions.
 
-(defun one-window-p (&optional nomini which-frames which-devices)
-  "Return non-nil if the selected window is the only window (in its frame).
-Optional arg NOMINI non-nil means don't count the minibuffer
-even if it is active.
+;; XEmacs addition, to expose WINDOW. 
+(defun only-window-p (&optional window nomini which-frames which-devices)
+  "Return non-nil if WINDOW is the only window in some context, 
+normally its frame.  Optional arg NOMINI non-nil means don't count the
+minibuffer even if it is active.
 
-By default, only the windows in the selected frame are considered.
-The optional argument WHICH-FRAMES changes this behavior:
-WHICH-FRAMES nil or omitted means count only the selected frame,
+The optional argument WHICH-FRAMES changes the frames that are considered:
+
+WHICH-FRAMES nil or omitted means count only WINDOW's frame,
 plus the minibuffer it uses (which may be on another frame).
-WHICH-FRAMES = `visible' means include windows on all visible frames.
+\(But, for all values of WHICH-FRAMES, see the documentation for the
+WHICH-DEVICES argument.)
+WHICH-FRAMES = `visible' means include windows on all visible frames
 WHICH-FRAMES = 0 means include windows on all visible and iconified frames.
 WHICH-FRAMES = t means include windows on all frames including invisible frames.
 If WHICH-FRAMES is any other value, count only the selected frame.
@@ -56,12 +59,20 @@
 If a device type, search all devices of that type.
 If `window-system', search all devices on window-system consoles.
 Any other non-nil value means search all devices."
-  (let ((base-window (selected-window)))
-    (if (and nomini (eq base-window (minibuffer-window)))
+  (let ((base-window (or window (selected-window))))
+    (if (and nomini (eq base-window
+                        (minibuffer-window (window-frame base-window))))
 	(setq base-window (next-window base-window)))
     (eq base-window
 	(next-window base-window (if nomini 'arg) which-frames which-devices))))
 
+(defun one-window-p (&optional nomini which-frames which-devices)
+  "Return the result of calling `only-window-p' on the selected window. 
+
+See that function's documentation for the meaning of the NOMINI,
+WHICH-FRAMES and WHICH-DEVICES arguments."
+  (only-window-p (selected-window) nomini which-frames which-devices))
+
 (defun walk-windows (function &optional minibuf which-frames which-devices)
   "Cycle through all visible windows, calling FUNCTION for each one.
 FUNCTION is called with a window as argument.
@@ -351,24 +362,18 @@
   (interactive "p")
   (shrink-window arg t))
 
-; (defun window-buffer-height (window)
-;   "Return the height (in screen lines) of the buffer that WINDOW is displaying."
-;   (save-excursion
-;     (set-buffer (window-buffer window))
-;     (goto-char (point-min))
-;     (let ((ignore-final-newline
-;            ;; If buffer ends with a newline, ignore it when counting height
-;            ;; unless point is after it.
-;            (and (not (eobp)) (eq ?\n (char-after (1- (point-max)))))))
-;       (+ 1 (nth 2 (compute-motion (point-min)
-;                                   '(0 . 0)
-;                                   (- (point-max) (if ignore-final-newline 1 0))
-;                                   (cons 0 100000000)
-;                                   (window-width window)
-;                                   nil
-;                                   window))))))
-
-(defun count-screen-lines (&optional beg end count-final-newline window)
+(defun 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))))
+;; XEmacs change; accept BUFFER. 
+(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.
@@ -383,112 +388,120 @@
 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."
+Optional argument BUFFER is the buffer to check, and defaults to the current
+buffer.  See `vertical-motion' for some caveats on the differences between
+this behaviour and that of GNU Emacs."
   (unless beg
-    (setq beg (point-min)))
+    (setq beg (point-min buffer)))
   (unless end
-    (setq end (point-max)))
+    (setq end (point-max buffer)))
+  (unless buffer
+    (setq buffer (current-buffer)))
   (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))))))
+        (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 size 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'.
+(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)
+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))))
+  (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
-; 	       (if header-line-format 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))
-; 	 ;; We do our own height checking, so avoid any restrictions due to
-; 	 ;; window-min-height.
-; 	 (window-min-height 1))
+  (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).
+          ;; XEmacs; it does in GNU, we provide a BUFFER argument, but we're
+          ;; not changing the implementation.
+	  (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))))
+    ;; 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))
+    ;; 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)))))
-; 	(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)))))))
+    ;; 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 nil window)
+        (setq desired-height (1+ desired-height))))))
 
 (defun shrink-window-if-larger-than-buffer (&optional window)
   "Shrink the WINDOW to be as small as possible to display its contents.