X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fwindow-xemacs.el;h=4af77205d7dc9c4cd1141e725f464786565ef7cf;hp=554ec53f4a9c7e4c24417a66f9ff50f37c554e81;hb=0298dde5c47a900f2542bc7ec6c9dafc92ce3015;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/lisp/window-xemacs.el b/lisp/window-xemacs.el index 554ec53..4af7720 100644 --- a/lisp/window-xemacs.el +++ b/lisp/window-xemacs.el @@ -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." ;;;;;;;;;;;;; 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 : 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))