ryuslash/undone
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Improve macro

Browse source
This commit is contained in:
Tom Willemsen 2012-08-14 22:40:40 +02:00
parent 17d9c17d9f
commit 8681daf54a
1 changed files with 7 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
undone/main.scm
View file

@ -5,7 +5,7 @@
(define-syntax define-view (define-syntax define-view
(lambda (x) (lambda (x)
(syntax-case x (with) (syntax-case x ()
((_ name doc fmt fields fields* ...) ((_ name doc fmt fields fields* ...)
(with-syntax ((viewname (with-syntax ((viewname
(datum->syntax (datum->syntax
@ -14,11 +14,13 @@
(define (viewname) (define (viewname)
doc doc
(map (lambda (item) (map (lambda (item)
(let (#,@(map (lambda (field)
#`(#,field (cdr (assq (quote #,field) item))))
#'(fields fields* ...)))
(format #t fmt (format #t fmt
#,@(map #,@(map (lambda (field)
(lambda (field) field)
#`(cdr (assq (quote #,field) item))) #'(fields fields* ...)))))
#'(fields fields* ...))))
todo-list)) todo-list))
(set! view-list (set! view-list
(append view-list (append view-list