stamp-cvs December 2007

stamp-cvs@common-lisp.net

1 participants
6 discussions

[stamp-cvs] CVS stamp
by rstrandh 05 Dec '07

05 Dec '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv28173 Modified Files: clim-commands.lisp clim-interface.lisp clim-utilities.lisp config.lisp filters.lisp message-composing.lisp misc-utilities.lisp Log Message: Added declaim with a debug level of 3 for better source tracking. --- /project/stamp/cvsroot/stamp/clim-commands.lisp 2007/04/06 08:58:48 1.1 +++ /project/stamp/cvsroot/stamp/clim-commands.lisp 2007/12/05 12:18:52 1.2 @@ -1,6 +1,8 @@ ;;; stamp commands (in-package :stamp-gui) +(declaim (optimize (debug 3))) + (clim:define-command-table stamp :inherit-from (esa:global-esa-table esa:keyboard-macro-table)) --- /project/stamp/cvsroot/stamp/clim-interface.lisp 2007/04/06 08:58:48 1.1 +++ /project/stamp/cvsroot/stamp/clim-interface.lisp 2007/12/05 12:18:52 1.2 @@ -1,6 +1,8 @@ ;;; stamp-gui (in-package :stamp-gui) +(declaim (optimize (debug 3))) + ;;; stamp-gui parameters (defparameter *show-all-headers* nil) --- /project/stamp/cvsroot/stamp/clim-utilities.lisp 2007/04/06 08:58:48 1.2 +++ /project/stamp/cvsroot/stamp/clim-utilities.lisp 2007/12/05 12:18:52 1.3 @@ -1,12 +1,11 @@ ;;; clim-utilities - (in-package :stamp-gui) +(declaim (optimize (debug 3))) (defparameter *hilight-color* (clim:make-rgb-color 0.8 0.8 1.0)) - (defun redisplay-pane (name) (let ((pane (clim:get-frame-pane clim:*application-frame* name))) (clim:redisplay-frame-pane clim:*application-frame* pane :force-p t))) --- /project/stamp/cvsroot/stamp/config.lisp 2007/04/06 08:58:48 1.1 +++ /project/stamp/cvsroot/stamp/config.lisp 2007/12/05 12:18:52 1.2 @@ -1,5 +1,7 @@ (in-package :stamp-gui) +(declaim (optimize (debug 3))) + ;; Size of minibuffer's pane ;; width (defparameter *width-mbp* 900) --- /project/stamp/cvsroot/stamp/filters.lisp 2007/12/05 06:29:52 1.4 +++ /project/stamp/cvsroot/stamp/filters.lisp 2007/12/05 12:18:52 1.5 @@ -1,6 +1,8 @@ (in-package :stamp-core) +(declaim (optimize (debug 3))) + ;;; List of the present messages in the file tags1. (defparameter *tags* '()) --- /project/stamp/cvsroot/stamp/message-composing.lisp 2007/04/06 08:58:48 1.1 +++ /project/stamp/cvsroot/stamp/message-composing.lisp 2007/12/05 12:18:52 1.2 @@ -2,6 +2,8 @@ (in-package :stamp-gui) +(declaim (optimize (debug 3))) + (defparameter *outbox* '()) (defparameter *mailboxes* '()) (defparameter *address* '()) --- /project/stamp/cvsroot/stamp/misc-utilities.lisp 2007/04/06 08:58:50 1.2 +++ /project/stamp/cvsroot/stamp/misc-utilities.lisp 2007/12/05 12:18:52 1.3 @@ -2,6 +2,8 @@ (in-package :stamp-core) +(declaim (optimize (debug 3))) + (defun format-datetime (time) (multiple-value-bind (second minute hour date month year day daylight-p zone) (decode-universal-time time)

1 0

[stamp-cvs] CVS stamp
by rstrandh 05 Dec '07

05 Dec '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv28078 Modified Files: packages.lisp Log Message: Removed set-user-address. Renamed compare-tags-files. --- /project/stamp/cvsroot/stamp/packages.lisp 2007/04/06 08:58:50 1.4 +++ /project/stamp/cvsroot/stamp/packages.lisp 2007/12/05 12:17:54 1.5 @@ -1,4 +1,3 @@ - ;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*- ;;; Copyright (C) 2006 Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) @@ -22,13 +21,10 @@ (in-package :cl-user) - - (defpackage :stamp-core (:use :cl) (:export #:stamp ;;; Stamp. - #:set-user-address #:set-smtp-parameters #:add-pop3-mailbox @@ -51,7 +47,7 @@ ;;; Files Utilities #:copy-file #:read-file-to-list - #:compare-tags-files + #:compare-tag-files ;;; Filter #:filter-messages @@ -78,7 +74,6 @@ #:set-default-filter #:*default-filter*)) - (defpackage :stamp-gui (:use :cl :stamp-core) (:export #:redisplay-pane @@ -124,6 +119,3 @@ #:set-size-width-sp #:set-size-hp #:set-size-height-mp)) - - -

1 0

[stamp-cvs] CVS stamp
by rstrandh 05 Dec '07

05 Dec '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv27880 Modified Files: stamp.lisp Log Message: Removed set-user-address which wasn't used, and which used a special variable in the wrong package. Added a declaim for high debug level. Renamed compare-tags-files to compare-tag-files which sounds a bit better in English. --- /project/stamp/cvsroot/stamp/stamp.lisp 2007/12/05 06:29:52 1.15 +++ /project/stamp/cvsroot/stamp/stamp.lisp 2007/12/05 12:16:49 1.16 @@ -1,4 +1,4 @@ -;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*- +;;; -*- Mode: Lisp; Package: stamp-core -*- ;;; Copyright (C) 2005-2006 Matthieu Villeneuve (matthieu.villeneuve(a)free.fr) ;;; Copyright (C) 2006 Robert Strandh (strandh(a)labri.fr) @@ -25,8 +25,7 @@ (in-package :stamp-core) -(defun set-user-address (address) - (setf *address* address)) +(declaim (optimize (debug 3))) (defun set-smtp-parameters (host port username password) (setf *outbox* (make-instance 'mel:smtp-relay-folder @@ -76,7 +75,7 @@ (with-open-file (f1 tags2 :direction :output :if-does-not-exist :create :if-exists nil)) (with-open-file (f2 tags1 :direction :output :if-does-not-exist :create :if-exists nil)))) - (compare-tags-files tags1 tags2))) + (compare-tag-files tags1 tags2))) ;;; Filters loading.

1 0

[stamp-cvs] CVS stamp
by rstrandh 05 Dec '07

05 Dec '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv27737 Modified Files: files-utilities.lisp Log Message: Cleanups --- /project/stamp/cvsroot/stamp/files-utilities.lisp 2007/04/06 08:58:48 1.2 +++ /project/stamp/cvsroot/stamp/files-utilities.lisp 2007/12/05 12:14:54 1.3 @@ -4,36 +4,36 @@ (in-package :stamp-core) -;;; Makes a copy bit to bit of the file "from" -;;; into the file "to". +(declaim (optimize (debug 3))) + +;;; Given two file names, copy the bytes in the +;;; first one to the second one. (defun copy-file (from to) - (with-open-file (in from - :direction :input - :element-type 'unsigned-byte - :if-does-not-exist :error - :if-exists :overwrite) + (with-open-file (in from + :direction :input + :element-type 'unsigned-byte + :if-does-not-exist :error + :if-exists :overwrite) (with-open-file (out to - :direction :output - :element-type 'unsigned-byte - :if-does-not-exist :create - :if-exists :overwrite) - (do ((i (read-byte in nil -1) - (read-byte in nil -1))) - ((minusp i)) - (declare (fixnum i)) - (write-byte i out))))) + :direction :output + :element-type 'unsigned-byte + :if-does-not-exist :create + :if-exists :overwrite) + (loop for byte = (read-byte in nil nil) + until (null byte) + do (write-byte byte out))))) -;;; Reads the file take off and send back it in the form of list. +;;; Read a file and return a list of the top-level in it. (defun read-file-to-list (file) (with-open-file (stream file - :direction :input - :if-does-not-exist :error) + :direction :input + :if-does-not-exist :error) (loop for l = (read stream nil nil) - until (null l) - collect l))) + until (null l) + collect l))) ;;; Allows to verify if files tags1 and tags2 are identical. -(defun compare-tags-files (file1 file2) +(defun compare-tag-files (file1 file2) (let ((l1 (read-file-to-list file1)) (l2 (read-file-to-list file2))) (equal l1 l2)))

1 0

[stamp-cvs] CVS stamp
by rstrandh 05 Dec '07

05 Dec '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv27629 Modified Files: skeleton Log Message: More cleanups. --- /project/stamp/cvsroot/stamp/skeleton 2007/12/05 06:29:52 1.2 +++ /project/stamp/cvsroot/stamp/skeleton 2007/12/05 12:14:00 1.3 @@ -1,19 +1,16 @@ (in-package :stamp-core) + (define-filter unread (unread) unread) -(define-filter one-day-ago (date) - (< (- (get-universal-time) 86400) - date)) +(define-filter last-day (date) + (> date (- (get-universal-time) #.(* 24 60 60)))) -(define-filter one-week-ago (date) - (< (- (get-universal-time) 604800) - date)) +(define-filter last-week (date) + (> date (- (get-universal-time) #.(* 7 24 60 60)))) -(define-filter one-month-ago (date) - (< (- (get-universal-time) 2592000) - date)) +(define-filter last-month (date) + (> date (- (get-universal-time) #.(* 30 24 60 60)))) -(define-filter one-year-ago (date) - (< (- (get-universal-time) 31536000) - date)) +(define-filter last-year (date) + (> date (- (get-universal-time) #.(* 365 24 60 60))))

1 0

[stamp-cvs] CVS stamp
by rstrandh 05 Dec '07

05 Dec '07

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 ,@args &allow-other-keys) - ,@body)) + `(progn (defun ,name (&rest tags &key ,@args &allow-other-keys) + (declare (ignorable tags)) + ,@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(a)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*)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

stamp-cvs December 2007