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

Simplify call to define-view

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

22
undone/main.scm
View file

@ -5,15 +5,21 @@
(define-syntax define-view (define-syntax define-view
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x (with)
((_ name doc exps exps* ...) ((_ name doc fmt fields fields* ...)
(with-syntax ((viewname (with-syntax ((viewname
(datum->syntax (datum->syntax
x (symbol-append (syntax->datum #'name) '-view)))) x (symbol-append (syntax->datum #'name) '-view))))
#'(begin #`(begin
(define (viewname) (define (viewname)
doc doc
exps exps* ...) (map (lambda (item)
(format #t fmt
#,@(map
(lambda (field)
#`(cdr (assq (quote #,field) item)))
#'(fields fields* ...))))
todo-list))
(set! view-list (set! view-list
(append view-list (append view-list
(list (cons 'name viewname)))))))))) (list (cons 'name viewname))))))))))
@ -77,13 +83,7 @@
(define-view default (define-view default
"Default todo-list view, show only the title." "Default todo-list view, show only the title."
(map (lambda (todo) "~a" content)
(display (cdr (assq 'content todo))))
todo-list))
(define-view raw
"Just a test view, see everything in todo-list."
(format #t "~y" todo-list))
(define (view args) (define (view args)
"Show a list of todo items." "Show a list of todo items."