comparison lisp/prim/window.el @ 155:43dd3413c7c7 r20-3b4

Import from CVS: tag r20-3b4
author cvs
date Mon, 13 Aug 2007 09:39:39 +0200
parents 538048ae2ab8
children 3bb7ccffb0c0
comparison
equal deleted inserted replaced
154:94141801dd7e 155:43dd3413c7c7
1 ;;; window.el --- XEmacs window commands aside from those written in C. 1 ;;; window.el --- XEmacs window commands aside from those written in C.
2
3 ;; Copyright (C) 1985, 1989, 1993-94, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996 Ben Wing.
5
6 ;; Maintainer: XEmacs Development Team
2 ;; Keywords: extensions 7 ;; Keywords: extensions
3
4 ;; Copyright (C) 1985, 1989, 1993, 1994 Free Software Foundation, Inc.
5 ;; Copyright (C) 1995, 1996 Ben Wing.
6 8
7 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
8 10
9 ;; XEmacs is free software; you can redistribute it and/or modify it 11 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by 12 ;; under the terms of the GNU General Public License as published by
19 ;; You should have received a copy of the GNU General Public License 21 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the 22 ;; along with XEmacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
23 25
24 ;;; Synched up with: FSF 19.30. 26 ;;; Synched up with: Emacs/Mule zeta.
27
28 ;;; Commentary:
29
30 ;; This file is dumped with XEmacs.
31
32 ;;; Code:
25 33
26 ;;;; Window tree functions. 34 ;;;; Window tree functions.
27 35
28 (defun one-window-p (&optional nomini all-frames device) 36 (defun one-window-p (&optional nomini all-frames device)
29 "Returns non-nil if the selected window is the only window (in its frame). 37 "Returns non-nil if the selected window is the only window (in its frame).
114 "Execute BODY, then select the window that was selected before BODY." 122 "Execute BODY, then select the window that was selected before BODY."
115 (list 'let 123 (list 'let
116 '((save-selected-window-window (selected-window))) 124 '((save-selected-window-window (selected-window)))
117 (list 'unwind-protect 125 (list 'unwind-protect
118 (cons 'progn body) 126 (cons 'progn body)
119 (list 'and 127 (list 'and ; XEmacs
120 (list 'window-live-p 'save-selected-window-window) 128 (list 'window-live-p 'save-selected-window-window)
121 (list 'select-window 'save-selected-window-window))))) 129 (list 'select-window 'save-selected-window-window)))))
122 130
123 (defun count-windows (&optional minibuf) 131 (defun count-windows (&optional minibuf)
124 "Returns the number of visible windows. 132 "Returns the number of visible windows.
125 Optional arg NO-MINI non-nil means don't count the minibuffer 133 Optional arg MINIBUF non-nil means count the minibuffer
126 even if it is active." 134 even if it is inactive."
127 (let ((count 0)) 135 (let ((count 0))
128 (walk-windows (function (lambda (w) 136 (walk-windows (function (lambda (w)
129 (setq count (+ count 1)))) 137 (setq count (+ count 1))))
130 minibuf) 138 minibuf)
131 count)) 139 count))
155 (setq tops (cdr tops))) 163 (setq tops (cdr tops)))
156 (setq count (1+ count)))) 164 (setq count (1+ count))))
157 ;; Subdivide the frame into that many vertical levels. 165 ;; Subdivide the frame into that many vertical levels.
158 ;FSFmacs (setq size (/ (- (frame-height) mbl) count)) 166 ;FSFmacs (setq size (/ (- (frame-height) mbl) count))
159 (setq size (/ (window-pixel-height (frame-root-window)) count)) 167 (setq size (/ (window-pixel-height (frame-root-window)) count))
160 (walk-windows (function (lambda (w) 168 (walk-windows (function
169 (lambda (w)
161 (select-window w) 170 (select-window w)
162 (let ((newtop (cdr (assq (nth 1 (window-pixel-edges)) 171 (let ((newtop (cdr (assq (nth 1 (window-pixel-edges))
163 levels))) 172 levels)))
164 (newbot (or (cdr (assq 173 (newbot (or (cdr (assq
165 (+ (window-pixel-height) 174 (+ (window-pixel-height)
198 207
199 Otherwise, we chose window starts so as to minimize the amount of 208 Otherwise, we chose window starts so as to minimize the amount of
200 redisplay; this is convenient on slow terminals. The new selected 209 redisplay; this is convenient on slow terminals. The new selected
201 window is the one that the current value of point appears in. The 210 window is the one that the current value of point appears in. The
202 value of point can change if the text around point is hidden by the 211 value of point can change if the text around point is hidden by the
203 new modeline. 212 new mode line.
204 213
205 Programs should probably use split-window instead of this." 214 Programs should probably use split-window instead of this."
206 (interactive "P") 215 (interactive "P")
207 (let ((old-w (selected-window)) 216 (let ((old-w (selected-window))
208 (old-point (point)) 217 (old-point (point))
209 (size (and arg (prefix-numeric-value arg))) 218 (size (and arg (prefix-numeric-value arg)))
210 new-w bottom) 219 (window-full-p nil)
220 new-w bottom moved)
211 (and size (< size 0) (setq size (+ (window-height) size))) 221 (and size (< size 0) (setq size (+ (window-height) size)))
212 (setq new-w (split-window nil size)) 222 (setq new-w (split-window nil size))
213 (or split-window-keep-point 223 (or split-window-keep-point
214 (progn 224 (progn
215 (save-excursion 225 (save-excursion
216 (set-buffer (window-buffer)) 226 (set-buffer (window-buffer))
217 (goto-char (window-start)) 227 (goto-char (window-start))
218 (vertical-motion (window-height)) 228 (setq moved (vertical-motion (window-height)))
219 (set-window-start new-w (point)) 229 (set-window-start new-w (point))
220 (if (> (point) (window-point new-w)) 230 (if (> (point) (window-point new-w))
221 (set-window-point new-w (point))) 231 (set-window-point new-w (point)))
222 (vertical-motion -1) 232 (and (= moved (window-height))
233 (progn
234 (setq window-full-p t)
235 (vertical-motion -1)))
223 (setq bottom (point))) 236 (setq bottom (point)))
224 (if (<= bottom (point)) 237 (and window-full-p
225 (set-window-point old-w (1- bottom))) 238 (<= bottom (point))
226 (if (< (window-start new-w) old-point) 239 (set-window-point old-w (1- bottom)))
227 (progn 240 (and window-full-p
228 (set-window-point new-w old-point) 241 (<= (window-start new-w) old-point)
229 (select-window new-w))))) 242 (progn
243 (set-window-point new-w old-point)
244 (select-window new-w)))))
230 new-w)) 245 new-w))
231 246
232 (defun split-window-horizontally (&optional arg) 247 (defun split-window-horizontally (&optional arg)
233 "Split current window into two windows side by side. 248 "Split current window into two windows side by side.
234 This window becomes the leftmost of the two, and gets ARG columns. 249 This window becomes the leftmost of the two, and gets ARG columns.
311 nil 326 nil
312 shrinkee))) 327 shrinkee)))
313 (delete-region (point-min) (point)) 328 (delete-region (point-min) (point))
314 (set-buffer-modified-p modified) 329 (set-buffer-modified-p modified)
315 (goto-char p) 330 (goto-char p)
331 ;; (select-window w) ; Emacs
316 ;; Make sure we unbind buffer-read-only 332 ;; Make sure we unbind buffer-read-only
317 ;; with the proper current buffer. 333 ;; with the proper current buffer.
318 (set-buffer buffer)))))) 334 (set-buffer buffer))))))
319 335
320 (defun backward-other-window (arg &optional all-frames device) 336 (defun kill-buffer-and-window ()
321 "Select the ARG'th different window on this frame, going backwards. 337 "Kill the current buffer and delete the selected window."
322 This is just like calling `other-window' with the arg negated."
323 (interactive "p")
324 (other-window (- arg) all-frames device))
325
326 (defun windows-of-buffer (&optional buffer)
327 "Returns a list of windows that have BUFFER in them.
328 If BUFFER is not specified, the current buffer will be used."
329 (or (bufferp buffer)
330 (if (stringp buffer)
331 (setq buffer (or (get-buffer buffer)
332 (get-file-buffer buffer)))
333 (setq buffer (current-buffer))))
334 (let* ((firstwin (next-window nil nil t))
335 (wind firstwin)
336 (done nil)
337 window-list)
338 (while (not done)
339 (if (eq (window-buffer wind) buffer)
340 (setq window-list (append window-list (list wind))))
341 (setq wind (next-window wind nil t))
342 (setq done (eq wind firstwin)))
343 window-list))
344
345 (defun buffer-in-multiple-windows-p (&optional buffer)
346 "Return t if BUFFER is in multiple windows.
347 If BUFFER is not specified, the current buffer will be used."
348 (setq buffer (or buffer
349 (get-buffer buffer)
350 (get-file-buffer buffer)
351 (current-buffer)))
352 (> (length (windows-of-buffer buffer)) 1))
353
354 (defun window-list (&optional frame minibuf window)
355 "Return a list of windows on FRAME, beginning with WINDOW.
356 FRAME and WINDOW default to the selected ones.
357 Optional second arg MINIBUF t means count the minibuffer window
358 even if not active. If MINIBUF is neither t nor nil it means
359 not to count the minibuffer even if it is active."
360 (setq window (or window (selected-window))
361 frame (or frame (selected-frame)))
362 (if (not (eq (window-frame window) frame))
363 (error "Window must be on frame."))
364 (let ((current-frame (selected-frame))
365 list)
366 (unwind-protect
367 (save-window-excursion
368 (select-frame frame)
369 (walk-windows
370 (function (lambda (cur-window)
371 (if (not (eq window cur-window))
372 (setq list (cons cur-window list)))))
373 minibuf)
374 (setq list (cons window list)))
375 (select-frame current-frame))))
376
377 ;; We used to have set-window-dedicated-p as an obsolete version
378 ;; of set-window-buffer-dedicated, but it really makes more sense
379 ;; this way.
380
381 (make-obsolete 'set-window-buffer-dedicated 'set-window-dedicated-p)
382 (defun set-window-buffer-dedicated (window buffer)
383 "Make WINDOW display BUFFER and be dedicated to that buffer.
384 Then Emacs will not automatically change which buffer appears in WINDOW.
385 If BUFFER is nil, make WINDOW not be dedicated (but don't change which
386 buffer appears in it currently)."
387 (if (bufferp buffer)
388 (set-window-buffer window (get-buffer-create buffer)))
389 (set-window-dedicated-p window (not (null buffer))))
390
391
392 ;; The window-config stack is stored as a list in frame property
393 ;; 'window-config-stack, with the most recent element at the front.
394 ;; When you pop off an element, the popped off element gets put at the
395 ;; front of frame property 'window-config-unpop-stack, so you can
396 ;; retrieve it using unpop-window-configuration.
397
398 (defvar window-config-stack-max 16
399 "*Maximum size of window configuration stack.
400 Start discarding off end if it gets this big.")
401
402 (defun window-config-stack (&optional frame)
403 (or frame (setq frame (selected-frame)))
404 (let ((stack (frame-property frame 'window-config-stack)))
405 (if stack
406 (set-undoable-stack-max stack window-config-stack-max)
407 (progn
408 (setq stack (make-undoable-stack window-config-stack-max))
409 (set-frame-property frame 'window-config-stack stack)))
410 stack))
411
412 (defun push-window-configuration (&optional config)
413 "Push the current window configuration onto the window-config stack.
414 If CONFIG is specified, push it instead of the current window configuration.
415 Each frame has its own window-config stack."
416 (interactive) 338 (interactive)
417 (let ((wc (or config (current-window-configuration))) 339 (if (yes-or-no-p (format "Kill buffer `%s'? " (buffer-name)))
418 (stack (window-config-stack))) 340 (let ((buffer (current-buffer)))
419 (if (or (= 0 (undoable-stack-a-length stack)) 341 (delete-window (selected-window))
420 (not (equal (undoable-stack-a-top stack) wc))) 342 (kill-buffer buffer))
421 (progn 343 (error "Aborted")))
422 (undoable-stack-push stack wc) 344
423 ;; kludge. 345 ;;; window.el ends here
424 (if (featurep 'toolbar)
425 (set-specifier-dirty-flag default-toolbar))))))
426
427 (defun pop-window-configuration ()
428 "Pop the top window configuration off the window-config stack and set it.
429 Before setting the new window configuration, the current window configuration
430 is pushed onto the \"unpop\" stack.
431 `unpop-window-configuration' undoes what this function does.
432 Each frame has its own window-config and \"unpop\" stack."
433 (interactive)
434 (let ((stack (window-config-stack))
435 (wc (current-window-configuration))
436 popped)
437 (condition-case nil
438 (progn
439 (setq popped (undoable-stack-pop stack))
440 (while (equal popped wc)
441 (setq popped (undoable-stack-pop stack)))
442 (undoable-stack-push stack wc)
443 (undoable-stack-undo stack)
444 (set-window-configuration popped)
445 ;; probably not necessary:
446 (if (featurep 'toolbar)
447 (set-specifier-dirty-flag default-toolbar))
448 popped)
449 (trunc-stack-bottom
450 (error "Bottom of window config stack")))))
451
452 (defun unpop-window-configuration ()
453 "Undo the effect of the most recent `pop-window-configuration'.
454 This does exactly the inverse of what `pop-window-configuration' does:
455 i.e. it pops a window configuration off of the \"unpop\" stack and
456 pushes the current window configuration onto the window-config stack.
457 Each frame has its own window-config and \"unpop\" stack."
458 (interactive)
459 (let ((stack (window-config-stack))
460 (wc (current-window-configuration))
461 popped)
462 (condition-case nil
463 (progn
464 (setq popped
465 (progn
466 (undoable-stack-redo stack)
467 (undoable-stack-pop stack)))
468 (while (equal popped wc)
469 (setq popped
470 (progn
471 (undoable-stack-redo stack)
472 (undoable-stack-pop stack))))
473 (undoable-stack-push stack wc)
474 (set-window-configuration popped)
475 ;; probably not necessary:
476 (if (featurep 'toolbar)
477 (set-specifier-dirty-flag default-toolbar))
478 popped)
479 (trunc-stack-bottom
480 (error "Top of window config stack")))))
481
482
483 ;;;;;;;;;;;;; display-buffer, moved here from C. Hallelujah.
484
485 (defvar display-buffer-function nil
486 "If non-nil, function to call to handle `display-buffer'.
487 It will receive three args: the same as those to `display-buffer'.")
488
489 (defvar pre-display-buffer-function nil
490 "If non-nil, function that will be called from `display-buffer'
491 as the first action. It will receive three args: the same as those
492 to `display-buffer'.
493 This function may be used to select an appropriate frame for the buffer,
494 for example. See also the variable `display-buffer-function', which may
495 be used to completely replace the `display-buffer' function.
496 If the return value of this function is non-nil, it should be a frame,
497 and that frame will be used to display the buffer.")
498
499 (defvar pop-up-frames nil
500 "*Non-nil means `display-buffer' should make a separate frame.")
501
502 (defvar pop-up-frame-function nil
503 "Function to call to handle automatic new frame creation.
504 It is called with no arguments and should return a newly created frame.
505
506 A typical value might be `(lambda () (new-frame pop-up-frame-alist))'
507 where `pop-up-frame-alist' would hold the default frame parameters.")
508
509 (defvar special-display-buffer-names nil
510 "*List of buffer names that should have their own special frames.
511 Displaying a buffer whose name is in this list makes a special frame for it
512 using `special-display-function'.
513
514 An element of the list can be a cons cell instead of just a string.
515 Then the car should be a buffer name, and the cdr specifies frame
516 parameters for creating the frame for that buffer.
517 More precisely, the cdr is passed as the second argument to
518 the function found in `special-display-function', when making that frame.
519 See also `special-display-regexps'.")
520
521 (defvar special-display-regexps nil
522 "*List of regexps saying which buffers should have their own special frames.
523 If a buffer name matches one of these regexps, it gets its own frame.
524 Displaying a buffer whose name is in this list makes a special frame for it
525 using `special-display-function'.
526
527 An element of the list can be a cons cell instead of just a string.
528 Then the car should be the regexp, and the cdr specifies frame
529 parameters for creating the frame for buffers that match.
530 More precisely, the cdr is passed as the second argument to
531 the function found in `special-display-function', when making that frame.
532 See also `special-display-buffer-names'.")
533
534 (defvar special-display-function nil
535 "Function to call to make a new frame for a special buffer.
536 It is called with two arguments, the buffer and optional buffer specific
537 data, and should return a window displaying that buffer.
538 The default value makes a separate frame for the buffer,
539 using `special-display-frame-alist' to specify the frame parameters.
540
541 A buffer is special if its is listed in `special-display-buffer-names'
542 or matches a regexp in `special-display-regexps'.")
543
544 (defvar same-window-buffer-names nil
545 "*List of buffer names that should appear in the selected window.
546 Displaying one of these buffers using `display-buffer' or `pop-to-buffer'
547 switches to it in the selected window, rather than making it appear
548 in some other window.
549
550 An element of the list can be a cons cell instead of just a string.
551 Then the car must be a string, which specifies the buffer name.
552 This is for compatibility with `special-display-buffer-names';
553 the cdr of the cons cell is ignored.
554
555 See also `same-window-regexps'.")
556
557 (defvar same-window-regexps nil
558 "*List of regexps saying which buffers should appear in the selected window.
559 If a buffer name matches one of these regexps, then displaying it
560 using `display-buffer' or `pop-to-buffer' switches to it
561 in the selected window, rather than making it appear in some other window.
562
563 An element of the list can be a cons cell instead of just a string.
564 Then the car must be a string, which specifies the buffer name.
565 This is for compatibility with `special-display-buffer-names';
566 the cdr of the cons cell is ignored.
567
568 See also `same-window-buffer-names'.")
569
570 (defvar pop-up-windows t
571 "*Non-nil means display-buffer should make new windows.")
572
573 (defvar split-height-threshold 500
574 "*display-buffer would prefer to split the largest window if this large.
575 If there is only one window, it is split regardless of this value.")
576
577 (defvar split-width-threshold 500
578 "*display-buffer would prefer to split the largest window if this large.
579 If there is only one window, it is split regardless of this value.")
580
581 ;; Deiconify the frame containing the window WINDOW, then return WINDOW.
582
583 (defun display-buffer-1 (window)
584 (if (frame-iconified-p (window-frame window))
585 (make-frame-visible (window-frame window)))
586 window)
587
588 ;; Can you believe that all of this crap was formerly in C?
589 ;; Praise Jesus that it's not there any more.
590
591 (defun display-buffer (buffer &optional not-this-window-p override-frame)
592 "Make BUFFER appear in some window on the current frame, but don't select it.
593 BUFFER can be a buffer or a buffer name.
594 If BUFFER is shown already in some window in the current frame,
595 just uses that one, unless the window is the selected window and
596 NOT-THIS-WINDOW-P is non-nil (interactively, with prefix arg).
597
598 If BUFFER has a dedicated frame, display on that frame instead of
599 the current frame, unless OVERRIDE-FRAME is non-nil.
600
601 If OVERRIDE-FRAME is non-nil, display on that frame instead of
602 the current frame (or the dedicated frame).
603
604 If `pop-up-windows' is non-nil, always use the
605 current frame and create a new window regardless of whether the
606 buffer has a dedicated frame, and regardless of whether
607 OVERRIDE-FRAME was specified.
608
609 If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER.
610
611 Returns the window displaying BUFFER."
612 (interactive "BDisplay buffer:\nP")
613
614 (let ((wconfig (current-window-configuration))
615 (result
616 ;; We just simulate a `return' in C. This function is way ugly
617 ;; and does `returns' all over the place and there's no sense
618 ;; in trying to rewrite it to be more Lispy.
619 (catch 'done
620 (let (window old-frame target-frame explicit-frame)
621 (setq old-frame (or (last-nonminibuf-frame) (selected-frame)))
622 (setq buffer (get-buffer buffer))
623 (check-argument-type 'bufferp buffer)
624
625 (setq explicit-frame
626 (if pre-display-buffer-function
627 (funcall pre-display-buffer-function buffer
628 not-this-window-p
629 override-frame)))
630
631 ;; Give the user the ability to completely reimplement
632 ;; this function via the `display-buffer-function'.
633 (if display-buffer-function
634 (throw 'done
635 (funcall display-buffer-function buffer
636 not-this-window-p
637 override-frame)))
638
639 ;; If the buffer has a dedicated frame, that takes
640 ;; precedence over the current frame, and over what the
641 ;; pre-display-buffer-function did.
642 (let ((dedi (buffer-dedicated-frame buffer)))
643 (if (frame-live-p dedi) (setq explicit-frame dedi)))
644
645 ;; if override-frame is supplied, that takes precedence over
646 ;; everything. This is gonna look bad if the
647 ;; pre-display-buffer-function raised some other frame
648 ;; already.
649 (if override-frame
650 (progn
651 (check-argument-type 'frame-live-p override-frame)
652 (setq explicit-frame override-frame)))
653
654 (setq target-frame
655 (or explicit-frame
656 (last-nonminibuf-frame)
657 (selected-frame)))
658
659 ;; If we have switched frames, then set not-this-window-p
660 ;; to false. Switching frames means that selected-window
661 ;; is no longer the same as it was on entry -- it's the
662 ;; selected-window of target_frame instead of old_frame,
663 ;; so it's a fine candidate for display.
664 (if (not (eq old-frame target-frame))
665 (setq not-this-window-p nil))
666
667 ;; if it's in the selected window, and that's ok, then we're done.
668 (if (and (not not-this-window-p)
669 (eq buffer (window-buffer (selected-window))))
670 (throw 'done (display-buffer-1 (selected-window))))
671
672 ;; See if the user has specified this buffer should appear
673 ;; in the selected window.
674
675 (if not-this-window-p
676 nil
677
678 (if (or (member (buffer-name buffer) same-window-buffer-names)
679 (assoc (buffer-name buffer) same-window-buffer-names))
680 (progn
681 (switch-to-buffer buffer)
682 (throw 'done (display-buffer-1 (selected-window)))))
683
684 (let ((tem same-window-regexps))
685 (while tem
686 (let ((car (car tem)))
687 (if (or
688 (and (stringp car)
689 (string-match car (buffer-name buffer)))
690 (and (consp car) (stringp (car car))
691 (string-match (car car) (buffer-name buffer))))
692 (progn
693 (switch-to-buffer buffer)
694 (throw 'done (display-buffer-1
695 (selected-window))))))
696 (setq tem (cdr tem)))))
697
698 ;; If pop-up-frames, look for a window showing BUFFER on
699 ;; any visible or iconified frame. Otherwise search only
700 ;; the current frame.
701 (if (and (not explicit-frame)
702 (or pop-up-frames (not (last-nonminibuf-frame))))
703 (setq target-frame 0))
704
705 ;; Otherwise, find some window that it's already in, and
706 ;; return that, unless that window is the selected window
707 ;; and that isn't ok. What a contorted mess!
708 (setq window (get-buffer-window buffer target-frame))
709 (if (and window
710 (or (not not-this-window-p)
711 (not (eq window (selected-window)))))
712 (throw 'done (display-buffer-1 window)))
713
714 ;; Certain buffer names get special handling.
715 (if special-display-function
716 (progn
717 (if (member (buffer-name buffer)
718 special-display-buffer-names)
719 (throw 'done (funcall special-display-function buffer)))
720
721 (let ((tem (assoc (buffer-name buffer)
722 special-display-buffer-names)))
723 (if tem
724 (throw 'done (funcall special-display-function
725 buffer (cdr tem)))))
726
727 (let ((tem special-display-regexps))
728 (while tem
729 (let ((car (car tem)))
730 (if (and (stringp car)
731 (string-match car (buffer-name buffer)))
732 (throw 'done
733 (funcall special-display-function buffer)))
734 (if (and (consp car)
735 (stringp (car car))
736 (string-match (car car)
737 (buffer-name buffer)))
738 (throw 'done (funcall
739 special-display-function buffer
740 (cdr car)))))
741 (setq tem (cdr tem))))))
742
743 ;; If there are no frames open that have more than a minibuffer,
744 ;; we need to create a new frame.
745 (if (or pop-up-frames
746 (null (last-nonminibuf-frame)))
747 (progn
748 (setq window (frame-selected-window
749 (funcall pop-up-frame-function)))
750 (set-window-buffer window buffer)
751 (throw 'done (display-buffer-1 window))))
752
753 ;; Otherwise, make it be in some window, splitting if
754 ;; appropriate/possible. Do not split a window if we are
755 ;; displaying the buffer in a different frame than that which
756 ;; was current when we were called. (It is already in a
757 ;; different window by virtue of being in another frame.)
758 (if (or (and pop-up-windows (eq target-frame old-frame))
759 (eq 'only (frame-property (selected-frame) 'minibuffer))
760 ;; If the current frame is a special display frame,
761 ;; don't try to reuse its windows.
762 (window-dedicated-p (frame-root-window (selected-frame))))
763 (progn
764 (if (eq 'only (frame-property (selected-frame) 'minibuffer))
765 (setq target-frame (last-nonminibuf-frame)))
766
767 ;; Don't try to create a window if would get an error with
768 ;; height.
769 (if (< split-height-threshold (* 2 window-min-height))
770 (setq split-height-threshold (* 2 window-min-height)))
771
772 ;; Same with width.
773 (if (< split-width-threshold (* 2 window-min-width))
774 (setq split-width-threshold (* 2 window-min-width)))
775
776 ;; If the frame we would try to split cannot be split,
777 ;; try other frames.
778 (if (frame-property (if (null target-frame)
779 (selected-frame)
780 (last-nonminibuf-frame))
781 'unsplittable)
782 (setq window
783 ;; Try visible frames first.
784 (or (get-largest-window 'visible)
785 ;; If that didn't work, try iconified frames.
786 (get-largest-window 0)
787 (get-largest-window t)))
788 (setq window (get-largest-window target-frame)))
789
790 ;; If we got a tall enough full-width window that
791 ;; can be split, split it.
792 (if (and window
793 (not (frame-property (window-frame window)
794 'unsplittable))
795 (>= (window-height window) split-height-threshold)
796 (or (>= (window-width window)
797 split-width-threshold)
798 (and (window-leftmost-p window)
799 (window-rightmost-p window))))
800 (setq window (split-window window))
801 (let (upper lower other)
802 (setq window (get-lru-window target-frame))
803 ;; If the LRU window is selected, and big enough,
804 ;; and can be split, split it.
805 (if (and window
806 (not (frame-property (window-frame window)
807 'unsplittable))
808 (or (eq window (selected-window))
809 (not (window-parent window)))
810 (>= (window-height window)
811 (* 2 window-min-height)))
812 (setq window (split-window window)))
813 ;; If get-lru-window returned nil, try other approaches.
814 ;; Try visible frames first.
815 (or window
816 (setq window (or (get-largest-window 'visible)
817 ;; If that didn't work, try
818 ;; iconified frames.
819 (get-largest-window 0)
820 ;; Try invisible frames.
821 (get-largest-window t)
822 ;; As a last resort, make
823 ;; a new frame.
824 (frame-selected-window
825 (funcall
826 pop-up-frame-function)))))
827 ;; If window appears above or below another,
828 ;; even out their heights.
829 (if (window-previous-child window)
830 (setq other (window-previous-child window)
831 upper other
832 lower window))
833 (if (window-next-child window)
834 (setq other (window-next-child window)
835 lower other
836 upper window))
837 ;; Check that OTHER and WINDOW are vertically arrayed.
838 (if (and other
839 (not (= (nth 1 (window-pixel-edges other))
840 (nth 1 (window-pixel-edges window))))
841 (> (window-pixel-height other)
842 (window-pixel-height window)))
843 (enlarge-window (- (/ (+ (window-height other)
844 (window-height window))
845 2)
846 (window-height upper))
847 nil upper)))))
848
849 (setq window (get-lru-window target-frame)))
850
851 ;; Bring the window's previous buffer to the top of the MRU chain.
852 (if (window-buffer window)
853 (save-excursion
854 (save-selected-window
855 (select-window window)
856 (record-buffer (window-buffer window)))))
857
858 (set-window-buffer window buffer)
859
860 (display-buffer-1 window)))))
861 (or (equal wconfig (current-window-configuration))
862 (push-window-configuration wconfig))
863 result))