XEmacs 21.4.18 (Social Property).
[chise/xemacs-chise.git.1] / lisp / window-xemacs.el
index 554ec53..4af7720 100644 (file)
@@ -51,11 +51,11 @@ If WINDOW is nil, the selected window is used."
   (when (null n)
     (redraw-frame (window-frame window) t)))
 
-(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."
+(defun backward-other-window (count &optional which-frames which-devices)
+  "Select the COUNT'th different window on this frame, going backwards.
+This is just like calling `other-window' with COUNT negated."
   (interactive "p")
-  (other-window (- arg) all-frames device))
+  (other-window (- count) which-frames which-devices))
 
 (defalias 'windows-of-buffer 'get-buffer-window-list)
 
@@ -191,13 +191,36 @@ Each frame has its own window-config and \"unpop\" stack."
 \f
 ;;;;;;;;;;;;; display-buffer, moved here from C.  Hallelujah.
 
+(make-variable-buffer-local '__buffer-dedicated-frame)
+
+(defun buffer-dedicated-frame (&optional buffer)
+  "Return the frame dedicated to this BUFFER, or nil if there is none.
+No argument or nil as argument means use current buffer as BUFFER."
+  (let ((buffer (decode-buffer buffer)))
+    (let ((frame (symbol-value-in-buffer '__buffer-dedicated-frame buffer)))
+      ;; XEmacs addition: if the frame is dead, silently make it go away.
+      (when (and (framep frame) (not (frame-live-p frame)))
+           (with-current-buffer buffer
+             (setq __buffer-dedicated-frame nil))
+           (setq frame nil))
+      frame)))
+
+(defun set-buffer-dedicated-frame (buffer frame)
+  "For this BUFFER, set the FRAME dedicated to it.
+FRAME must be a frame or nil."
+  (let ((buffer (decode-buffer buffer)))
+    (and frame
+        (check-argument-type #'frame-live-p frame))
+    (with-current-buffer buffer
+      (setq __buffer-dedicated-frame frame))))
+
 (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'.")
+It will receive four 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
+as the first action.  It will receive four 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
@@ -329,7 +352,8 @@ If there is only one window, it is split regardless of this value."
 ;; 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)
+(defun display-buffer (buffer &optional not-this-window-p override-frame
+                             shrink-to-fit)
   "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,
@@ -342,6 +366,9 @@ 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 SHRINK-TO-FIT is non-nil and splitting the window is appropriate, give
+the new buffer less than half the space if it is small enough to fit.
+
 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
@@ -349,6 +376,10 @@ OVERRIDE-FRAME was specified.
 
 If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER.
 
+If the buffer name is a member of the `same-window-buffer-names' list,
+or matches one of the `same-window-regexps' expressions, display the
+buffer in the currently selected window.
+
 Returns the window displaying BUFFER."
   (interactive "BDisplay buffer:\nP")
 
@@ -358,7 +389,7 @@ Returns the window displaying BUFFER."
         ;; 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)
+          (let (window old-frame target-frame explicit-frame shrink-it)
             (setq old-frame (or (last-nonminibuf-frame) (selected-frame)))
             (setq buffer (get-buffer buffer))
             (check-argument-type 'bufferp buffer)
@@ -367,7 +398,8 @@ Returns the window displaying BUFFER."
                   (if pre-display-buffer-function
                       (funcall pre-display-buffer-function buffer
                                not-this-window-p
-                               override-frame)))
+                               override-frame
+                               shrink-to-fit)))
 
             ;; Give the user the ability to completely reimplement
             ;; this function via the `display-buffer-function'.
@@ -375,7 +407,8 @@ Returns the window displaying BUFFER."
                 (throw 'done
                        (funcall display-buffer-function buffer
                                 not-this-window-p
-                                override-frame)))
+                                override-frame
+                                shrink-to-fit)))
 
             ;; If the buffer has a dedicated frame, that takes
             ;; precedence over the current frame, and over what the
@@ -544,9 +577,7 @@ Returns the window displaying BUFFER."
                                (and (window-leftmost-p window)
                                     (window-rightmost-p window))))
                       (setq window (split-window window))
-                    (let (upper
-;;                        lower
-                          other)
+                    (let (upper other)
                       (setq window (get-lru-window target-frame))
                       ;; If the LRU window is selected, and big enough,
                       ;; and can be split, split it.
@@ -576,11 +607,9 @@ Returns the window displaying BUFFER."
                       ;; 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
@@ -592,7 +621,12 @@ Returns the window displaying BUFFER."
                                                    (window-height window))
                                                 2)
                                              (window-height upper))
-                                          nil upper)))))
+                                          nil upper))
+                       ;; Klaus Berndl <klaus.berndl@sdm.de>: Only in
+                       ;; this situation we shrink-to-fit but we can do
+                       ;; this first after we have displayed buffer in
+                       ;; window (s.b. (set-window-buffer window buffer))
+                       (setq shrink-it shrink-to-fit))))
 
               (setq window (get-lru-window target-frame)))
 
@@ -605,6 +639,12 @@ Returns the window displaying BUFFER."
 
             (set-window-buffer window buffer)
 
+             ;; Now window's previous buffer has been brought to the top
+             ;; of the MRU chain and window displays buffer - now we can
+             ;; shrink-to-fit if necessary
+             (if shrink-it
+                 (shrink-window-if-larger-than-buffer window))
+
             (display-buffer-1 window)))))
     (or (equal wconfig (current-window-configuration))
        (push-window-configuration wconfig))