--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/prim/window-xemacs.el	Mon Aug 13 09:39:39 2007 +0200
@@ -0,0 +1,583 @@
+;;; window-xemacs.el --- XEmacs window commands aside from those written in C.
+
+;; Copyright (C) 1985, 1989, 1993-94, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996 Ben Wing.
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: extensions
+
+;; This file is part of XEmacs.
+
+;; 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; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not synched.
+
+;;; Commentary:
+
+;; slb - 5/29/97
+;; Split apart from window.el in order to keep that file better in synch
+;; with Emacs.
+
+;;; Code:
+
+(defun backward-other-window (arg &optional all-frames device)
+  "Select the ARG'th different window on this frame, going backwards.
+This is just like calling `other-window' with the arg negated."
+  (interactive "p")
+  (other-window (- arg) all-frames device))
+
+(defun windows-of-buffer (&optional buffer)
+  "Returns a list of windows that have BUFFER in them.
+If BUFFER is not specified, the current buffer will be used."
+  (or (bufferp buffer)
+      (if (stringp buffer)
+	  (setq buffer (or (get-buffer buffer)
+			   (get-file-buffer buffer)))
+	(setq buffer (current-buffer))))
+  (let* ((firstwin (next-window nil nil t))
+	 (wind firstwin) 
+	 (done nil)
+	 window-list)
+    (while (not done)
+      (if (eq (window-buffer wind) buffer)
+	  (setq window-list (append window-list (list wind))))
+      (setq wind (next-window wind nil t))
+      (setq done (eq wind firstwin)))
+    window-list))
+
+(defun buffer-in-multiple-windows-p (&optional buffer)
+  "Return t if BUFFER is in multiple windows.
+If BUFFER is not specified, the current buffer will be used."
+  (setq buffer (or buffer
+		   (get-buffer buffer)
+		   (get-file-buffer buffer)
+		   (current-buffer)))
+  (> (length (windows-of-buffer buffer)) 1))
+
+(defun window-list (&optional frame minibuf window)
+  "Return a list of windows on FRAME, beginning with WINDOW.
+FRAME and WINDOW default to the selected ones.  
+Optional second arg MINIBUF t means count the minibuffer window
+even if not active.  If MINIBUF is neither t nor nil it means
+not to count the minibuffer even if it is active."
+  (setq window (or window (selected-window))
+	frame (or frame (selected-frame)))
+  (if (not (eq (window-frame window) frame))
+      (error "Window must be on frame."))
+  (let ((current-frame (selected-frame))
+	list)
+    (unwind-protect
+	(save-window-excursion
+	  (select-frame frame)
+	  (walk-windows
+	   (function (lambda (cur-window)
+		       (if (not (eq window cur-window))
+			   (setq list (cons cur-window list)))))
+	   minibuf)
+	  (setq list (cons window list)))
+      (select-frame current-frame))))
+
+;; We used to have set-window-dedicated-p as an obsolete version
+;; of set-window-buffer-dedicated, but it really makes more sense
+;; this way.
+
+(make-obsolete 'set-window-buffer-dedicated 'set-window-dedicated-p)
+(defun set-window-buffer-dedicated (window buffer)
+  "Make WINDOW display BUFFER and be dedicated to that buffer.
+Then Emacs will not automatically change which buffer appears in WINDOW.
+If BUFFER is nil, make WINDOW not be dedicated (but don't change which
+buffer appears in it currently)."
+  (if (bufferp buffer)
+      (set-window-buffer window (get-buffer-create buffer)))
+  (set-window-dedicated-p window (not (null buffer))))
+
+
+;; The window-config stack is stored as a list in frame property
+;; 'window-config-stack, with the most recent element at the front.
+;; When you pop off an element, the popped off element gets put at the
+;; front of frame property 'window-config-unpop-stack, so you can
+;; retrieve it using unpop-window-configuration.
+
+(defvar window-config-stack-max 16
+  "*Maximum size of window configuration stack.
+Start discarding off end if it gets this big.")
+
+(defun window-config-stack (&optional frame)
+  (or frame (setq frame (selected-frame)))
+  (let ((stack (frame-property frame 'window-config-stack)))
+    (if stack
+	(set-undoable-stack-max stack window-config-stack-max)
+      (progn
+	(setq stack (make-undoable-stack window-config-stack-max))
+	(set-frame-property frame 'window-config-stack stack)))
+    stack))
+
+(defun push-window-configuration (&optional config)
+  "Push the current window configuration onto the window-config stack.
+If CONFIG is specified, push it instead of the current window configuration.
+Each frame has its own window-config stack."
+  (interactive)
+  (let ((wc (or config (current-window-configuration)))
+	(stack (window-config-stack)))
+    (if (or (= 0 (undoable-stack-a-length stack))
+	    (not (equal (undoable-stack-a-top stack) wc)))
+	(progn
+	  (undoable-stack-push stack wc)
+	  ;; kludge.
+	  (if (featurep 'toolbar)
+	      (set-specifier-dirty-flag default-toolbar))))))
+
+(defun pop-window-configuration ()
+  "Pop the top window configuration off the window-config stack and set it.
+Before setting the new window configuration, the current window configuration
+ is pushed onto the \"unpop\" stack.
+`unpop-window-configuration' undoes what this function does.
+Each frame has its own window-config and \"unpop\" stack."
+  (interactive)
+  (let ((stack (window-config-stack))
+	(wc (current-window-configuration))
+	popped)
+    (condition-case nil
+	(progn
+	  (setq popped (undoable-stack-pop stack))
+	  (while (equal popped wc)
+	    (setq popped (undoable-stack-pop stack)))
+	  (undoable-stack-push stack wc)
+	  (undoable-stack-undo stack)
+	  (set-window-configuration popped)
+	  ;; probably not necessary:
+	  (if (featurep 'toolbar)
+	      (set-specifier-dirty-flag default-toolbar))
+	  popped)
+      (trunc-stack-bottom
+       (error "Bottom of window config stack")))))
+
+(defun unpop-window-configuration ()
+  "Undo the effect of the most recent `pop-window-configuration'.
+This does exactly the inverse of what `pop-window-configuration' does:
+ i.e. it pops a window configuration off of the \"unpop\" stack and
+ pushes the current window configuration onto the window-config stack.
+Each frame has its own window-config and \"unpop\" stack."
+  (interactive)
+  (let ((stack (window-config-stack))
+	(wc (current-window-configuration))
+	popped)
+    (condition-case nil
+	(progn
+	  (setq popped
+		(progn
+		  (undoable-stack-redo stack)
+		  (undoable-stack-pop stack)))
+	  (while (equal popped wc)
+	    (setq popped
+		  (progn
+		    (undoable-stack-redo stack)
+		    (undoable-stack-pop stack))))
+	  (undoable-stack-push stack wc)
+	  (set-window-configuration popped)
+	  ;; probably not necessary:
+	  (if (featurep 'toolbar)
+	      (set-specifier-dirty-flag default-toolbar))
+	  popped)
+      (trunc-stack-bottom
+       (error "Top of window config stack")))))
+
+
+;;;;;;;;;;;;; display-buffer, moved here from C.  Hallelujah.
+
+(defvar display-buffer-function nil
+  "If non-nil, function to call to handle `display-buffer'.
+It will receive three args: the same as those to `display-buffer'.")
+
+(defvar pre-display-buffer-function nil
+  "If non-nil, function that will be called from `display-buffer'
+as the first action.  It will receive three args: the same as those
+to `display-buffer'.
+This function may be used to select an appropriate frame for the buffer,
+for example.  See also the variable `display-buffer-function', which may
+be used to completely replace the `display-buffer' function.
+If the return value of this function is non-nil, it should be a frame,
+and that frame will be used to display the buffer.")
+
+(defvar pop-up-frames nil
+  "*Non-nil means `display-buffer' should make a separate frame.")
+
+(defvar pop-up-frame-function nil
+  "Function to call to handle automatic new frame creation.
+It is called with no arguments and should return a newly created frame.
+
+A typical value might be `(lambda () (new-frame pop-up-frame-alist))'
+where `pop-up-frame-alist' would hold the default frame parameters.")
+
+(defvar special-display-buffer-names nil
+  "*List of buffer names that should have their own special frames.
+Displaying a buffer whose name is in this list makes a special frame for it
+using `special-display-function'.
+
+An element of the list can be a cons cell instead of just a string.
+Then the car should be a buffer name, and the cdr specifies frame
+parameters for creating the frame for that buffer.
+More precisely, the cdr is passed as the second argument to
+the function found in `special-display-function', when making that frame.
+See also `special-display-regexps'.")
+
+(defvar special-display-regexps nil
+  "*List of regexps saying which buffers should have their own special frames.
+If a buffer name matches one of these regexps, it gets its own frame.
+Displaying a buffer whose name is in this list makes a special frame for it
+using `special-display-function'.
+
+An element of the list can be a cons cell instead of just a string.
+Then the car should be the regexp, and the cdr specifies frame
+parameters for creating the frame for buffers that match.
+More precisely, the cdr is passed as the second argument to
+the function found in `special-display-function', when making that frame.
+See also `special-display-buffer-names'.")
+
+(defvar special-display-function nil
+  "Function to call to make a new frame for a special buffer.
+It is called with two arguments, the buffer and optional buffer specific
+data, and should return a window displaying that buffer.
+The default value makes a separate frame for the buffer,
+using `special-display-frame-alist' to specify the frame parameters.
+
+A buffer is special if its is listed in `special-display-buffer-names'
+or matches a regexp in `special-display-regexps'.")
+
+(defvar same-window-buffer-names nil
+  "*List of buffer names that should appear in the selected window.
+Displaying one of these buffers using `display-buffer' or `pop-to-buffer'
+switches to it in the selected window, rather than making it appear
+in some other window.
+
+An element of the list can be a cons cell instead of just a string.
+Then the car must be a string, which specifies the buffer name.
+This is for compatibility with `special-display-buffer-names';
+the cdr of the cons cell is ignored.
+
+See also `same-window-regexps'.")
+
+(defvar same-window-regexps nil
+  "*List of regexps saying which buffers should appear in the selected window.
+If a buffer name matches one of these regexps, then displaying it
+using `display-buffer' or `pop-to-buffer' switches to it
+in the selected window, rather than making it appear in some other window.
+
+An element of the list can be a cons cell instead of just a string.
+Then the car must be a string, which specifies the buffer name.
+This is for compatibility with `special-display-buffer-names';
+the cdr of the cons cell is ignored.
+
+See also `same-window-buffer-names'.")
+
+(defvar pop-up-windows t
+  "*Non-nil means display-buffer should make new windows.")
+
+(defvar split-height-threshold 500
+ "*display-buffer would prefer to split the largest window if this large.
+If there is only one window, it is split regardless of this value.")
+
+(defvar split-width-threshold 500
+  "*display-buffer would prefer to split the largest window if this large.
+If there is only one window, it is split regardless of this value.")
+
+;; Deiconify the frame containing the window WINDOW, then return WINDOW.
+
+(defun display-buffer-1 (window)
+  (if (frame-iconified-p (window-frame window))
+      (make-frame-visible (window-frame window)))
+  window)
+
+;; Can you believe that all of this crap was formerly in C?
+;; Praise Jesus that it's not there any more.
+
+(defun display-buffer (buffer &optional not-this-window-p override-frame)
+  "Make BUFFER appear in some window on the current frame, but don't select it.
+BUFFER can be a buffer or a buffer name.
+If BUFFER is shown already in some window in the current frame,
+just uses that one, unless the window is the selected window and
+NOT-THIS-WINDOW-P is non-nil (interactively, with prefix arg).
+
+If BUFFER has a dedicated frame, display on that frame instead of
+the current frame, unless OVERRIDE-FRAME is non-nil.
+
+If OVERRIDE-FRAME is non-nil, display on that frame instead of
+the current frame (or the dedicated frame).
+
+If `pop-up-windows' is non-nil, always use the
+current frame and create a new window regardless of whether the
+buffer has a dedicated frame, and regardless of whether
+OVERRIDE-FRAME was specified.
+
+If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER.
+
+Returns the window displaying BUFFER."
+  (interactive "BDisplay buffer:\nP")
+
+  (let ((wconfig (current-window-configuration))
+	(result
+	 ;; We just simulate a `return' in C.  This function is way ugly
+	 ;; and does `returns' all over the place and there's no sense
+	 ;; in trying to rewrite it to be more Lispy.
+	 (catch 'done
+	   (let (window old-frame target-frame explicit-frame)
+	     (setq old-frame (or (last-nonminibuf-frame) (selected-frame)))
+	     (setq buffer (get-buffer buffer))
+	     (check-argument-type 'bufferp buffer)
+
+	     (setq explicit-frame
+		   (if pre-display-buffer-function
+		       (funcall pre-display-buffer-function buffer
+				not-this-window-p
+				override-frame)))
+
+	     ;; Give the user the ability to completely reimplement
+	     ;; this function via the `display-buffer-function'.
+	     (if display-buffer-function
+		 (throw 'done
+			(funcall display-buffer-function buffer
+				 not-this-window-p
+				 override-frame)))
+
+	     ;; If the buffer has a dedicated frame, that takes
+	     ;; precedence over the current frame, and over what the
+	     ;; pre-display-buffer-function did.
+	     (let ((dedi (buffer-dedicated-frame buffer)))
+	       (if (frame-live-p dedi) (setq explicit-frame dedi)))
+
+	     ;; if override-frame is supplied, that takes precedence over
+	     ;; everything.  This is gonna look bad if the
+	     ;; pre-display-buffer-function raised some other frame
+	     ;; already.
+	     (if override-frame
+		 (progn
+		   (check-argument-type 'frame-live-p override-frame)
+		   (setq explicit-frame override-frame)))
+
+	     (setq target-frame
+		   (or explicit-frame
+		       (last-nonminibuf-frame)
+		       (selected-frame)))
+
+	     ;; If we have switched frames, then set not-this-window-p
+	     ;; to false.  Switching frames means that selected-window
+	     ;; is no longer the same as it was on entry -- it's the
+	     ;; selected-window of target_frame instead of old_frame,
+	     ;; so it's a fine candidate for display.
+	     (if (not (eq old-frame target-frame))
+		 (setq not-this-window-p nil))
+	
+	     ;; if it's in the selected window, and that's ok, then we're done.
+	     (if (and (not not-this-window-p)
+		      (eq buffer (window-buffer (selected-window))))
+		 (throw 'done (display-buffer-1 (selected-window))))
+
+	     ;; See if the user has specified this buffer should appear
+	     ;; in the selected window.
+	
+	     (if not-this-window-p
+		 nil
+	  
+	       (if (or (member (buffer-name buffer) same-window-buffer-names)
+		       (assoc (buffer-name buffer) same-window-buffer-names))
+		   (progn
+		     (switch-to-buffer buffer)
+		     (throw 'done (display-buffer-1 (selected-window)))))
+	  
+	       (let ((tem same-window-regexps))
+		 (while tem
+		   (let ((car (car tem)))
+		     (if (or
+			  (and (stringp car)
+			       (string-match car (buffer-name buffer)))
+			  (and (consp car) (stringp (car car))
+			       (string-match (car car) (buffer-name buffer))))
+			 (progn
+			   (switch-to-buffer buffer)
+			   (throw 'done (display-buffer-1
+					 (selected-window))))))
+		   (setq tem (cdr tem)))))
+	
+	     ;; If pop-up-frames, look for a window showing BUFFER on
+	     ;; any visible or iconified frame.  Otherwise search only
+	     ;; the current frame.
+	     (if (and (not explicit-frame)
+		      (or pop-up-frames (not (last-nonminibuf-frame))))
+		 (setq target-frame 0))
+	
+	     ;; Otherwise, find some window that it's already in, and
+	     ;; return that, unless that window is the selected window
+	     ;; and that isn't ok.  What a contorted mess!
+	     (setq window (get-buffer-window buffer target-frame))
+	     (if (and window
+		      (or (not not-this-window-p)
+			  (not (eq window (selected-window)))))
+		 (throw 'done (display-buffer-1 window)))
+
+	     ;; Certain buffer names get special handling.
+	     (if special-display-function
+		 (progn
+		   (if (member (buffer-name buffer)
+			       special-display-buffer-names)
+		       (throw 'done (funcall special-display-function buffer)))
+
+		   (let ((tem (assoc (buffer-name buffer)
+				     special-display-buffer-names)))
+		     (if tem
+			 (throw 'done (funcall special-display-function
+					       buffer (cdr tem)))))
+
+		   (let ((tem special-display-regexps))
+		     (while tem
+		       (let ((car (car tem)))
+			 (if (and (stringp car)
+				  (string-match car (buffer-name buffer)))
+			     (throw 'done
+				    (funcall special-display-function buffer)))
+			 (if (and (consp car)
+				  (stringp (car car))
+				  (string-match (car car)
+						(buffer-name buffer)))
+			     (throw 'done (funcall
+					   special-display-function buffer
+					   (cdr car)))))
+		       (setq tem (cdr tem))))))
+
+	     ;; If there are no frames open that have more than a minibuffer,
+	     ;; we need to create a new frame.
+	     (if (or pop-up-frames
+		     (null (last-nonminibuf-frame)))
+		 (progn
+		   (setq window (frame-selected-window
+				 (funcall pop-up-frame-function)))
+		   (set-window-buffer window buffer)
+		   (throw 'done (display-buffer-1 window))))
+
+	     ;; Otherwise, make it be in some window, splitting if
+	     ;; appropriate/possible.  Do not split a window if we are
+	     ;; displaying the buffer in a different frame than that which
+	     ;; was current when we were called.  (It is already in a
+	     ;; different window by virtue of being in another frame.)
+	     (if (or (and pop-up-windows (eq target-frame old-frame))
+		     (eq 'only (frame-property (selected-frame) 'minibuffer))
+		     ;; If the current frame is a special display frame,
+		     ;; don't try to reuse its windows.
+		     (window-dedicated-p (frame-root-window (selected-frame))))
+		 (progn
+		   (if (eq 'only (frame-property (selected-frame) 'minibuffer))
+		       (setq target-frame (last-nonminibuf-frame)))
+
+		   ;; Don't try to create a window if would get an error with
+		   ;; height.
+		   (if (< split-height-threshold (* 2 window-min-height))
+		       (setq split-height-threshold (* 2 window-min-height)))
+
+		   ;; Same with width.
+		   (if (< split-width-threshold (* 2 window-min-width))
+		       (setq split-width-threshold (* 2 window-min-width)))
+
+		   ;; If the frame we would try to split cannot be split,
+		   ;; try other frames.
+		   (if (frame-property (if (null target-frame)
+					   (selected-frame)
+					 (last-nonminibuf-frame))
+				       'unsplittable)
+		       (setq window
+			     ;; Try visible frames first.
+			     (or (get-largest-window 'visible)
+				 ;; If that didn't work, try iconified frames.
+				 (get-largest-window 0)
+				 (get-largest-window t)))
+		     (setq window (get-largest-window target-frame)))
+
+		   ;; If we got a tall enough full-width window that
+		   ;; can be split, split it.
+		   (if (and window
+			    (not (frame-property (window-frame window)
+						 'unsplittable))
+			    (>= (window-height window) split-height-threshold)
+			    (or (>= (window-width window)
+				    split-width-threshold)
+				(and (window-leftmost-p window)
+				     (window-rightmost-p window))))
+		       (setq window (split-window window))
+		     (let (upper
+;;			   lower
+			   other)
+		       (setq window (get-lru-window target-frame))
+		       ;; If the LRU window is selected, and big enough,
+		       ;; and can be split, split it.
+		       (if (and window
+				(not (frame-property (window-frame window) 
+						     'unsplittable))
+				(or (eq window (selected-window))
+				    (not (window-parent window)))
+				(>= (window-height window)
+				    (* 2 window-min-height)))
+			   (setq window (split-window window)))
+		       ;; If get-lru-window returned nil, try other approaches.
+		       ;; Try visible frames first.
+		       (or window
+			   (setq window (or (get-largest-window 'visible)
+					    ;; If that didn't work, try
+					    ;; iconified frames.
+					    (get-largest-window 0)
+					    ;; Try invisible frames.
+					    (get-largest-window t)
+					    ;; As a last resort, make
+					    ;; a new frame.
+					    (frame-selected-window
+					     (funcall
+					      pop-up-frame-function)))))
+		       ;; If window appears above or below another,
+		       ;; even out their heights.
+		       (if (window-previous-child window)
+			   (setq other (window-previous-child window)
+;;				 lower window
+				 upper other))
+		       (if (window-next-child window)
+			   (setq other (window-next-child window)
+;;				 lower other
+				 upper window))
+		       ;; Check that OTHER and WINDOW are vertically arrayed.
+		       (if (and other
+				(not (= (nth 1 (window-pixel-edges other))
+					(nth 1 (window-pixel-edges window))))
+				(> (window-pixel-height other)
+				   (window-pixel-height window)))
+			   (enlarge-window (- (/ (+ (window-height other)
+						    (window-height window))
+						 2)
+					      (window-height upper))
+					   nil upper)))))
+
+	       (setq window (get-lru-window target-frame)))
+
+	     ;; Bring the window's previous buffer to the top of the MRU chain.
+	     (if (window-buffer window)
+		 (save-excursion
+		   (save-selected-window
+		     (select-window window)
+		     (record-buffer (window-buffer window)))))
+
+	     (set-window-buffer window buffer)
+
+	     (display-buffer-1 window)))))
+    (or (equal wconfig (current-window-configuration))
+	(push-window-configuration wconfig))
+    result))
+
+;;; window-xemacs.el ends here