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

Don't fail when an item doesn't have a property

Browse source 
* undone/main.scm (get-field): Only get a cons cell, don't get its
  cdr.

  (get-field-value): New macro.

  (define-view): Add filtered list syntax, which filters items that
  don't have the needed properties.  Filter results before looking
  through them.
This commit is contained in:
Tom Willemsen 2012-08-31 14:45:18 +02:00
parent 4124f07fa9
commit 62cde9b1c8
1 changed files with 25 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
undone/main.scm
View file

@ -7,7 +7,13 @@
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
((_ key alist) ((_ key alist)
#'(cdr (assq (quote key) alist)))))) #'(assq (quote key) alist)))))
(define-syntax get-field-value
(lambda (x)
(syntax-case x ()
((_ key alist)
#'(cdr (get-field key alist))))))
(define-syntax define-view (define-syntax define-view
(lambda (x) (lambda (x)
@ -17,15 +23,22 @@
sort-by sort-predicate sort-field) sort-by sort-predicate sort-field)
(with-syntax ((viewname (with-syntax ((viewname
(datum->syntax (datum->syntax
x (symbol-append (syntax->datum #'name) '-view)))) x (symbol-append (syntax->datum #'name) '-view)))
(filtered-list
#`(filter (lambda (elm)
(and #,@(map
(lambda (field)
#`(get-field #,field elm))
#'(fields fields* ...))))
todo-list)))
#`(begin #`(begin
(define (viewname) (define (viewname)
doc doc
(for-each (for-each
(lambda (item) (lambda (item)
(let (#,@(map (lambda (field) (let (#,@(map
#`(#,field (lambda (field)
(cdr (assq (quote #,field) item)))) #`(#,field (get-field-value #,field item)))
#'(fields fields* ...))) #'(fields fields* ...)))
(if predicate (if predicate
(format #t fmt (format #t fmt
@ -33,12 +46,13 @@
field) field)
#'(fields fields* ...)))))) #'(fields fields* ...))))))
#,(if (syntax->datum #'sort-predicate) #,(if (syntax->datum #'sort-predicate)
#'(stable-sort #`(stable-sort
todo-list filtered-list
(lambda (a b) (lambda (a b)
(sort-predicate (get-field sort-field a) (sort-predicate
(get-field sort-field b)))) (get-field-value sort-field a)
#'todo-list))) (get-field-value sort-field b))))
#'filtered-list)))
(set! view-list (set! view-list
(append view-list (append view-list
(list (cons 'name viewname))))))) (list (cons 'name viewname)))))))