From eff2cbb537b5ba7bd70800f6d1f51c8e68abee68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 10 Mar 2019 23:35:50 +0100 Subject: Add with-replaced-attrs. --- vcalendar/control.scm | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 vcalendar/control.scm (limited to 'vcalendar/control.scm') diff --git a/vcalendar/control.scm b/vcalendar/control.scm new file mode 100644 index 00000000..a38d678f --- /dev/null +++ b/vcalendar/control.scm @@ -0,0 +1,39 @@ +(define-module (vcalendar control) + #:use-module (util) + #:use-module (vcalendar) + #: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 -- cgit v1.2.3