diff options
author | Tom Willemsen | 2012-08-31 14:45:18 +0200 |
---|---|---|
committer | Tom Willemsen | 2012-08-31 14:45:18 +0200 |
commit | 62cde9b1c8a52097b0191fea1554ab7055532aa8 (patch) | |
tree | 5ca32d507f1f8baca030d52cdc21d6ae15692409 | |
parent | 4124f07fa90f37e41af9cf517cd45b71bcd0977b (diff) | |
download | undone-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.scm | 36 |
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))))))) |