[stamp-cvs] CVS stamp
rstrandh
rstrandh at common-lisp.net
Wed Dec 5 06:29:54 UTC 2007
Update of /project/stamp/cvsroot/stamp
In directory clnet:/tmp/cvs-serv24699
Modified Files:
filters.lisp skeleton stamp.lisp
Log Message:
Added IGNORABLE declaration of TAGS in DEFINE-FILTER.
Removed IGNORE declaration in each filter of skeleton.
Cleaned up the skeleton file.
Made the DEFINE-FILTER macro generate code to compile each individual
filter. This makes it unnecessary to compile the file, which is bound
to give us stale fasls at some point. Removed the code to compile the
default-filters file.
--- /project/stamp/cvsroot/stamp/filters.lisp 2007/04/06 08:58:48 1.3
+++ /project/stamp/cvsroot/stamp/filters.lisp 2007/12/05 06:29:52 1.4
@@ -1,8 +1,3 @@
-;;; filters
-
-;;; Functions which allow to generate functions of filter and
-;;; to apply them to all the present messages in our directory
-;;; of e-mails.
(in-package :stamp-core)
@@ -20,8 +15,10 @@
;;; Macro for the definition of filters.
(defmacro define-filter (name args &body body)
- `(defun ,name (&rest tags &key , at args &allow-other-keys)
- , at body))
+ `(progn (defun ,name (&rest tags &key , at args &allow-other-keys)
+ (declare (ignorable tags))
+ , at body)
+ (compile ',name)))
;;; To get back the filtered messages.
(defun filter-messages (filter)
--- /project/stamp/cvsroot/stamp/skeleton 2007/04/06 08:58:50 1.1
+++ /project/stamp/cvsroot/stamp/skeleton 2007/12/05 06:29:52 1.2
@@ -1,26 +1,19 @@
(in-package :stamp-core)
(define-filter unread (unread)
- (declare (ignore tags))
- (eq unread t))
-(define-filter strandh (from)
- (declare (ignore tags))
- (equal "strandh at labri.fr" from))
+ unread)
+
(define-filter one-day-ago (date)
- (declare (ignore tags))
(< (- (get-universal-time) 86400)
date))
+
(define-filter one-week-ago (date)
- (declare (ignore tags))
(< (- (get-universal-time) 604800)
date))
+
(define-filter one-month-ago (date)
- (declare (ignore tags))
(< (- (get-universal-time) 2592000)
date))
+
(define-filter one-year-ago (date)
- (declare (ignore tags))
(< (- (get-universal-time) 31536000)
date))
-(define-filter two-filters ()
- (and (apply #'unread tags)
- (apply #'strandh tags)))
--- /project/stamp/cvsroot/stamp/stamp.lisp 2007/04/06 09:24:14 1.14
+++ /project/stamp/cvsroot/stamp/stamp.lisp 2007/12/05 06:29:52 1.15
@@ -81,8 +81,7 @@
;;; Filters loading.
(defun load-filters ()
- (compile-file (concatenate 'string *config-folder* "default-filters.lisp"))
- (load (concatenate 'string *config-folder* "default-filters.fasl"))
+ (load (concatenate 'string *config-folder* "default-filters.lisp"))
(if (eq *current-filters-mails* nil)
(setf *current-filters-mails* (filter-messages-for-id
(find-symbol (string-upcase *default-filter*)
More information about the Stamp-cvs
mailing list