From 62cde9b1c8a52097b0191fea1554ab7055532aa8 Mon Sep 17 00:00:00 2001
From: Tom Willemsen <tom@ryuslash.org>
Date: Fri, 31 Aug 2012 14:45:18 +0200
Subject: [PATCH] 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.
---
 undone/main.scm | 36 +++++++++++++++++++++++++-----------
 1 file 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)))))))