Change select-buffer hooks to take a second argument, the window that
authorChris Hanson <org/chris-hanson/cph>
Sun, 30 Apr 1995 07:02:18 +0000 (07:02 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sun, 30 Apr 1995 07:02:18 +0000 (07:02 +0000)
the buffer is being selected in.  This is often useful, and if it's
not passed in there's no way to get it.

v7/src/edwin/curren.scm
v7/src/edwin/intmod.scm

index 017c9eace3839f66a8d8a8c9403848bca0d5ab7d..3d17ba0bd1716b37e23a82b38b0ee604cd91bce7 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: curren.scm,v 1.115 1995/04/27 20:33:28 cph Exp $
+;;;    $Id: curren.scm,v 1.116 1995/04/30 07:02:10 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-95 Massachusetts Institute of Technology
 ;;;
@@ -466,7 +466,7 @@ The screen is guaranteed to be deselected at that time."
   (set-buffer-point! buffer (window-point window))
   (if record?
       (bufferset-select-buffer! (current-bufferset) buffer))
-  (for-each (lambda (hook) (hook buffer))
+  (for-each (lambda (hook) (hook buffer window))
            (get-buffer-hooks buffer 'SELECT-BUFFER-HOOKS))
   (if (not (minibuffer? buffer))
       (event-distributor/invoke!
index b9467684bdb5395a5ef4ee9eabbca8933ae983ba..81dd53ad900470bd9b7eb867d0b5900b49d88095 100644 (file)
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: intmod.scm,v 1.85 1994/11/01 23:12:09 adams Exp $
+;;;    $Id: intmod.scm,v 1.86 1995/04/30 07:02:18 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-94 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-95 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -916,11 +916,11 @@ If this is an error, the debugger examines the error condition."
 (define (when-buffer-selected buffer thunk)
   (if (current-buffer? buffer)
       (thunk)
-      (letrec
-         ((hook
-           (lambda (buffer)
-             (thunk)
-             (remove-select-buffer-hook buffer hook))))
+      (letrec ((hook (lambda (buffer window)
+                      (if (current-window? window)
+                          (begin
+                            (thunk)
+                            (remove-select-buffer-hook buffer hook))))))
        (add-select-buffer-hook buffer hook))))
 
 (define (operation/prompt-for-command-expression port prompt level)