From bea9cfc60ab5a792256e6e02794d39cef3c6fbcd Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 13 Nov 1992 22:59:28 +0000 Subject: [PATCH] Add optional argument to pop-up-buffer, which disables use of current window. --- v7/src/edwin/wincom.scm | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/v7/src/edwin/wincom.scm b/v7/src/edwin/wincom.scm index 431cf572b..08f4cbd74 100644 --- a/v7/src/edwin/wincom.scm +++ b/v7/src/edwin/wincom.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: wincom.scm,v 1.112 1992/09/10 02:44:25 cph Exp $ +;;; $Id: wincom.scm,v 1.113 1992/11/13 22:59:28 cph Exp $ ;;; ;;; Copyright (c) 1987, 1989-92 Massachusetts Institute of Technology ;;; @@ -442,10 +442,13 @@ Also kills any pop up window it may have created." (define *previous-popped-up-window* (object-hash false)) (define *minibuffer-scroll-window* (object-hash false)) -(define (pop-up-buffer buffer #!optional select?) +(define (pop-up-buffer buffer #!optional select? not-current-window) ;; If some new window is created by this procedure, it is returned ;; as the value. Otherwise the value is false. - (let ((select? (and (not (default-object? select?)) select?))) + (let ((select? (and (not (default-object? select?)) select?)) + (current-window-ok? + (not (and (not (default-object? not-current-window?)) + not-current-window?)))) (define (pop-up-window window) (let ((window (window-split-vertically! window false))) @@ -462,10 +465,19 @@ Also kills any pop up window it may have created." (and (eq? window (object-unhash *previous-popped-up-window*)) window)) + (define (find-visible-window buffer) + (let loop ((windows (buffer-windows buffer))) + (and (not (null? windows)) + (let ((window (car windows))) + (if (and (window-visible? window) + (or current-window-ok? (not (current-window? window)))) + window + (loop (cdr windows))))))) + (if (< (ref-variable window-min-height) 2) (set-variable! window-min-height 2)) (let ((window - (let ((window (get-buffer-window buffer))) + (let ((window (find-visible-window buffer))) (if window (begin (set-window-point! window (buffer-point buffer)) -- 2.25.1