Change OTHER-WINDOW to consider windows on other visible screens as
authorChris Hanson <org/chris-hanson/cph>
Wed, 12 Feb 1992 23:52:51 +0000 (23:52 +0000)
committerChris Hanson <org/chris-hanson/cph>
Wed, 12 Feb 1992 23:52:51 +0000 (23:52 +0000)
possible alternatives.  Fix WINDOW-LIVE? to work correctly for windows
in screens that aren't selected.

v7/src/edwin/curren.scm

index 3b1506fd7ff5bfc343d5bf18b5f69bedd6034456..91dfebc0d83b4c652bb8fececbd39f7deef4a444 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.97 1992/02/11 22:35:09 bal Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.98 1992/02/12 23:52:51 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 (define (select-screen screen)
   (without-interrupts
    (lambda ()
-     (let ((message (current-message)))
-       (clear-current-message!)
-       (screen-exit! (selected-screen))
-       (let ((window (screen-selected-window screen)))
-        (undo-leave-window! window)
-        (change-selected-buffer (window-buffer window) true
-          (lambda ()
-            (set-editor-selected-screen! current-editor screen))))
-       (set-current-message! message)
-       (screen-enter! screen)))))
+     (let ((screen* (selected-screen)))
+       (if (not (eq? screen screen*))
+          (let ((message (current-message)))
+            (clear-current-message!)
+            (screen-exit! screen*)
+            (let ((window (screen-selected-window screen)))
+              (undo-leave-window! window)
+              (change-selected-buffer (window-buffer window) true
+                (lambda ()
+                  (set-editor-selected-screen! current-editor screen))))
+            (set-current-message! message)
+            (screen-enter! screen)
+            (update-screen! screen false)))))))
 \f
 (define (update-screens! display-style)
   (if display-style
        (screen-visible? (window-screen window))))
 
 (define (window-live? window)
-  (or (typein-window? window)
-      (let ((window0 (window0)))
-       (let loop ((window* (window1+ window0)))
-         (or (eq? window window*)
-             (and (not (eq? window* window0))
-                  (loop (window1+ window*))))))))
+  (let ((screen (window-screen window)))
+    (or (eq? window (screen-typein-window screen))
+       (let ((window0 (screen-window0 screen)))
+         (let loop ((window* (window1+ window0)))
+           (or (eq? window window*)
+               (and (not (eq? window* window0))
+                    (loop (window1+ window*)))))))))
 
+(define (global-window-modeline-event!)
+  (let ((window0 (window0)))
+    (let loop ((window (window1+ window0)))
+      (window-modeline-event! window 'GLOBAL-MODELINE)
+      (if (not (eq? window window0))
+         (loop (window1+ window))))))
+\f
 (define (other-window #!optional n)
   (let ((n (if (or (default-object? n) (not n)) 1 n))
-       (window (current-window)))
+       (selected-window (current-window))
+       (typein-ok? (within-typein-edit?)))
     (cond ((positive? n)
-          (let loop ((n n) (window window))
+          (let loop ((n n) (window selected-window))
             (if (zero? n)
                 window
-                (loop (-1+ n)
-                      (if (typein-window? window)
-                          (window0)
-                          (let ((window (window1+ window)))
-                            (if (and (within-typein-edit?)
-                                     (eq? window (window0)))
-                                (typein-window)
-                                window)))))))
+                (let ((window (next-visible-window window typein-ok?)))
+                  (if window
+                      (loop (-1+ n) window)
+                      selected-window)))))
          ((negative? n)
-          (let loop ((n n) (window window))
+          (let loop ((n n) (window selected-window))
             (if (zero? n)
                 window
-                (loop (1+ n)
-                      (if (and (within-typein-edit?)
-                               (eq? window (window0)))
-                          (typein-window)
-                          (window-1+ (if (typein-window? window)
-                                         (window0)
-                                         window)))))))
+                (let ((window (previous-visible-window window typein-ok?)))
+                  (if window
+                      (loop (1+ n) window)
+                      selected-window)))))
          (else
-          window))))
-
-(define (global-window-modeline-event!)
-  (let ((window0 (window0)))
-    (let loop ((window (window1+ window0)))
-      (window-modeline-event! window 'GLOBAL-MODELINE)
-      (if (not (eq? window window0))
-         (loop (window1+ window))))))
+          selected-window))))
+
+(define (next-visible-window first-window typein-ok?)
+  (let ((first-screen (window-screen first-window)))
+    (letrec
+       ((next-screen
+         (lambda (screen)
+           (let ((screen (screen1+ screen)))
+             (let ((window (screen-window0 screen)))
+               (if (screen-visible? screen)
+                   (and (not (and (eq? screen first-screen)
+                                  (eq? window first-window)))
+                        window)
+                   (and (not (eq? screen first-screen))
+                        (next-screen screen))))))))
+      (if (or (not (screen-visible? first-screen))
+             (eq? first-window (screen-typein-window first-screen)))
+         (next-screen first-screen)
+         (let ((window (window1+ first-window)))
+           (if (eq? window (screen-window0 first-screen))
+               (or (and typein-ok? (screen-typein-window first-screen))
+                   (next-screen first-screen))
+               window))))))
+
+(define (previous-visible-window first-window typein-ok?)
+  (let ((first-screen (window-screen first-window)))
+    (letrec
+       ((previous-screen
+         (lambda (screen)
+           (let ((screen (screen-1+ screen)))
+             (let ((window
+                    (or (and typein-ok? (screen-typein-window screen))
+                        (window-1+ (screen-window0 screen)))))
+               (if (screen-visible? screen)
+                   (and (not (and (eq? screen first-screen)
+                                  (eq? window first-window)))
+                        window)
+                   (and (not (eq? screen first-screen))
+                        (previous-screen screen))))))))
+      (if (or (not (screen-visible? first-screen))
+             (eq? first-window (screen-window0 first-screen)))
+         (previous-screen first-screen)
+         (window-1+ first-window)))))
 \f
 (define (typein-window)
   (screen-typein-window (selected-screen)))