1 files changed, 36 insertions, 0 deletions
diff --git a/module/vcomponent/util/control.scm b/module/vcomponent/util/control.scm
new file mode 100644
index 00000000..4cb6c708
--- /dev/null
+++ b/module/vcomponent/util/control.scm
@@ -0,0 +1,36 @@
+(define-module (vcomponent util control)
+  #:use-module (calp util)
+  #:use-module (vcomponent)
+  #:export (with-replaced-properties))
+
+
+(eval-when (expand load)                ; No idea why I must have load here.
+  (define href (make-procedure-with-setter hash-ref hash-set!))
+
+  (define (set-temp-values! table component kvs)
+    (for-each (lambda (kv)
+                (let* (((key val) kv))
+                  (when (prop component key)
+                    (set! (href table key) (prop component key))
+                    (set! (prop component key) val))))
+              kvs))
+
+  (define (restore-values! table component keys)
+    (for-each (lambda (key)
+                (and=> (href table key)
+                       (lambda (val)
+                         (set! (prop component key) val))))
+              keys)))
+
+;; TODO what is this even used for?
+(define-syntax with-replaced-properties
+  (syntax-rules ()
+    [(_ (component (key val) ...)
+        body ...)
+
+     (let ((htable (make-hash-table 10)))
+       (dynamic-wind
+         (lambda () (set-temp-values! htable component (quote ((key val) ...))))  ; In guard
+         (lambda () body ...)
+         (lambda () (restore-values! htable component (quote (key ...))))))]))  ; Out guard
+