From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 6 Mar 1989 19:59:05 +0000 (+0000)
Subject: Add new operation `object-component-binder'.
X-Git-Tag: 20090517-FFI~12251
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6e62efa5b3a9b3b5e84a8c11af20038d02bc54b4;p=mit-scheme.git

Add new operation `object-component-binder'.
---

diff --git a/v7/src/runtime/wind.scm b/v7/src/runtime/wind.scm
index ddbc042d1..0cbc7e5ce 100644
--- a/v7/src/runtime/wind.scm
+++ b/v7/src/runtime/wind.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/wind.scm,v 14.2 1988/06/22 21:24:34 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/wind.scm,v 14.3 1989/03/06 19:59:05 cph Rel $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -91,8 +91,23 @@ MIT in each case. |#
   ((ucode-primitive current-dynamic-state)
    (if (default-object? state-space) system-state-space state-space)))
 
-;;; NOTE: the "before" thunk is executed IN THE NEW STATE, the "after"
-;;; thunk is executed IN THE OLD STATE.  Your programs should not
-;;; depend on this if it can be avoided.
 (define (dynamic-wind before during after)
-  (execute-at-new-state-point system-state-space before during after))
\ No newline at end of file
+  ;; NOTE: the "before" thunk is executed IN THE NEW STATE, the
+  ;; "after" thunk is executed IN THE OLD STATE.  Your programs should
+  ;; not depend on this if it can be avoided.
+  (execute-at-new-state-point system-state-space before during after))
+
+(define (object-component-binder get-component set-component!)
+  (lambda (object new-value thunk)
+    (let ((old-value))
+      (dynamic-wind (lambda ()
+		      (set! old-value (get-component object))
+		      (set-component! object new-value)
+		      (set! new-value false)
+		      unspecific)
+		    thunk
+		    (lambda ()
+		      (set! new-value (get-component object))
+		      (set-component! object old-value)
+		      (set! old-value false)
+		      unspecific)))))
\ No newline at end of file