[stamp-cvs] CVS stamp

fwillemain fwillemain at common-lisp.net
Thu Mar 22 17:13:37 UTC 2007


Update of /project/stamp/cvsroot/stamp
In directory clnet:/tmp/cvs-serv3756

Modified Files:
	filters.lisp 
Log Message:
filter-messages

--- /project/stamp/cvsroot/stamp/filters.lisp	2007/03/21 18:21:37	1.1
+++ /project/stamp/cvsroot/stamp/filters.lisp	2007/03/22 17:13:37	1.2
@@ -6,49 +6,37 @@
 		(namestring (user-homedir-pathname)) 
 		"Mail/inbox/tags")))
 
-(defmacro define-filter (name args &body body)
-  `(defun ,name (&rest tags &key , at args &allow-other-keys)
-     , at body))
-
-;(defun apply-filter (name)
-;  (let (tmp *tags*))
-;  (loop for l = (car tmp)
-;     until (null l)
-;       (if (#'name l)
-;	   (collect l))
-;      (setq tmp (cdr tmp))
-;       (print l)))
-
-(defun apply-filter (name)
-  (do ((tmp (car *tags*) (cdr tmp))
-       (res '() (when (funcall name (car tmp)
-			       (cons (car tmp) res)))))
-      ((endp tmp) (nreverse res))))
-
-(list (apply-filter #'unread))
-      
-(car *tags*)
-
-;(defun load-info-list (file)
-;  (with-open-file (stream file)
-;    (loop for l = (read stream nil nil)
-;	 until (null l)
-;	 do (print l))))
-
 (defun load-info-list (file)
   (with-open-file (stream file)
     (loop for l = (read stream nil nil)
 	 until (null l)
 	 collect l))) 
 
-(getf (cdr *tags*) :unread)
+(defmacro define-filter (name args &body body)
+  `(defun ,name (&rest tags &key , at args &allow-other-keys)
+     , at body))
+
+(defun filter-messages (filter)
+  (loop for tag in *tags*
+       when (funcall filter :field tag)
+       collect tag))
 
-(print (list *tags*))
+(filter-messages #'unread)
 
 (define-filter unread (field)
+  (declare (ignore tags))
   (getf (cdr field) :unread))
 
+;(unread)
+
+;(define-filter recent-unread ()
+;  (and (apply #'recent tags)
+;       (apply #'unread tags)))
+
 
-(define-filter recent-unread ()
-  (and (apply #'recent tags)
-       (apply #'unread tags)))
+;(defun filter-messages (filter-name)
+;  (do ((tmp *tags* (cdr tmp))
+;       (res '() (if (funcall filter-name :field (car tmp))
+;			       (cons (car tmp) res)
+;			       res)))
+;      ((endp tmp) (nreverse res))))
\ No newline at end of file




More information about the Stamp-cvs mailing list