summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGravatar Tom Willemsen2012-08-31 14:45:18 +0200
committerGravatar Tom Willemsen2012-08-31 14:45:18 +0200
commit62cde9b1c8a52097b0191fea1554ab7055532aa8 (patch)
tree5ca32d507f1f8baca030d52cdc21d6ae15692409
parent4124f07fa90f37e41af9cf517cd45b71bcd0977b (diff)
downloadundone-62cde9b1c8a52097b0191fea1554ab7055532aa8.tar.gz
undone-62cde9b1c8a52097b0191fea1554ab7055532aa8.zip
Don't fail when an item doesn't have a property
* 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.
-rw-r--r--undone/main.scm36
1 files changed, 25 insertions, 11 deletions
diff --git a/undone/main.scm b/undone/main.scm
index 863e6bb..5ac6b2c 100644
--- a/undone/main.scm
+++ b/undone/main.scm
@@ -7,7 +7,13 @@
(lambda (x)
(syntax-case x ()
((_ 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
(lambda (x)
@@ -17,28 +23,36 @@
sort-by sort-predicate sort-field)
(with-syntax ((viewname
(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
(define (viewname)
doc
(for-each
(lambda (item)
- (let (#,@(map (lambda (field)
- #`(#,field
- (cdr (assq (quote #,field) item))))
- #'(fields fields* ...)))
+ (let (#,@(map
+ (lambda (field)
+ #`(#,field (get-field-value #,field item)))
+ #'(fields fields* ...)))
(if predicate
(format #t fmt
#,@(map (lambda (field)
field)
#'(fields fields* ...))))))
#,(if (syntax->datum #'sort-predicate)
- #'(stable-sort
- todo-list
+ #`(stable-sort
+ filtered-list
(lambda (a b)
- (sort-predicate (get-field sort-field a)
- (get-field sort-field b))))
- #'todo-list)))
+ (sort-predicate
+ (get-field-value sort-field a)
+ (get-field-value sort-field b))))
+ #'filtered-list)))
(set! view-list
(append view-list
(list (cons 'name viewname)))))))