blob: 38199161e6084231ed35fda6c976f5d1b7a01320 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
(define-module (vcomponent control)
#:use-module (util)
#:use-module (vcomponent)
#:export (with-replaced-attrs))
(eval-when (expand load) ; No idea why I must have load here.
(define href (make-procedure-with-setter hashq-ref hashq-set!))
(define (set-temp-values! table component kvs)
(for-each (lambda (kv)
(let* (((key val) kv))
(when (attr component key)
(set! (href table key) (attr component key))
(set! (attr component key) val))))
kvs))
(define (restore-values! table component keys)
(for-each (lambda (key)
(and=> (href table key)
(lambda (val)
(set! (attr component key) val))))
keys)))
;;; TODO with-added-attributes
(define-syntax with-replaced-attrs
(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
;;; TODO test that restore works, at all
;;; Test that non-local exit and return works
|