Mercurial > hg > xemacs-beta
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)) |