January 2007 - stamp-cvs@common-lisp.net - mailman3.common-lisp.net

[stamp-cvs] CVS stamp
by mvilleneuve 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv6366 Modified Files: stamp.lisp Log Message: Fix Climacs usage for message composing --- /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 12:01:51 1.9 +++ /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 13:37:53 1.10 @@ -413,10 +413,10 @@ (clim:layout-frame *climacs-frame* 800 600) (clim:execute-frame-command *climacs-frame* - `(climacs-gui::com-find-file ,filename)) + `(climacs-core::find-file ,filename)) (clim:execute-frame-command *climacs-frame* - `(climacs-gui::com-insert-file ,content-filename)) + `(climacs-commands::com-insert-file ,content-filename)) (delete-file content-filename))) (*climacs-frame* (clim:make-application-frame 'climacs-gui:climacs)))

1 0

[stamp-cvs] CVS stamp/Spec
by rstrandh 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp/Spec In directory clnet:/tmp/cvs-serv23863 Modified Files: priorities.text Log Message: Update priorites according to what has been done so far. --- /project/stamp/cvsroot/stamp/Spec/priorities.text 2007/01/04 06:18:40 1.2 +++ /project/stamp/cvsroot/stamp/Spec/priorities.text 2007/01/04 12:47:33 1.3 @@ -23,7 +23,8 @@ probably happen before the students start working. This is very high priority, and could take some time to do. -* convert Stamp to an ESA. This is high priority and not too hard to +* [this is done] + convert Stamp to an ESA. This is high priority and not too hard to do. * modify Stamp to use the tags files instead of asking mel-base for @@ -36,10 +37,12 @@ extremely high. It could take a while to get it right because it involves manipulating the file system. -* define a class or a presentation type for messages. This is fairly +* [this is done] + define a class or a presentation type for messages. This is fairly high priority and not too hard. -* implement a Select Message command. Fairly high priority. Not too +* [this is done] + implement a Select Message command. Fairly high priority. Not too hard. * implement the define-filter macro and some default filters. Fairly @@ -58,20 +61,24 @@ priority. A bit tricky because the sequence has to be searched, and there are edge cases (first and last) -* use CLIM presentations for the message headers. Fairly high +* [this is done] + use CLIM presentations for the message headers. Fairly high priority. Not too hard. -* use CLIM presentations for the filter names. Fairly high priority. +* [this is done for folders] + use CLIM presentations for the filter names. Fairly high priority. Not too hard. * write a CLIM completer for the filter names. Medium priority. A bit tricky if you haven't written completers before. -* write a presentation-to-command translator for messages that selects +* [this is done (through the use of :gesture :select)] + write a presentation-to-command translator for messages that selects the message being clicked on. Low priority. A bit tricky if you don't know how to do it. -* write a presentation-to-command translator for filters that selects +* [this is done for folders] + write a presentation-to-command translator for filters that selects the filter being clicked on. Low priority. A bit tricky if you don't know how to do it. @@ -105,3 +112,6 @@ * if necessary, fix mel-base so that it doesn't use base-string and base-char where inappropriate. Medium priority. Easy. +* implement a second layout that does not have the filters pane. + Implement a command for switching between layouts. This is low + priority, but not hard to do.

1 0

[stamp-cvs] CVS stamp
by rstrandh 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv12711 Modified Files: stamp.lisp Log Message: Stamp now has an info pane in which currently the current folder is shown. Other information can go here later. At the moment is just means that we could potentially introduce another layout without the "folders" and still be able to know the current one. --- /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 10:12:15 1.8 +++ /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 12:01:51 1.9 @@ -64,6 +64,16 @@ :height 20 :max-height 20 :min-height 20)) +(defclass stamp-info-pane (esa:info-pane) + () + (:default-initargs + :height 20 :max-height 20 :min-height 20 + :display-function 'display-info + :incremental-redisplay t)) + +(defun display-info (frame pane) + (format pane "Folder: ~a" (car (current-folder frame)))) + (clim:define-application-frame stamp (esa:esa-frame-mixin clim:standard-application-frame) ((folders :initform (list (cons "Inbox" *inbox-folder*)) @@ -88,6 +98,7 @@ :height 450)) (adjuster1 (clim:make-pane 'clim-extensions:box-adjuster-gadget)) (adjuster2 (clim:make-pane 'clim-extensions:box-adjuster-gadget)) + (info (clim:make-pane 'stamp-info-pane)) (minibuffer (clim:make-pane 'stamp-minibuffer-pane :width 900))) (:layouts (default-layout (clim:vertically () @@ -99,6 +110,7 @@ (clim:scrolling (:width 800 :height 150) headers-pane) adjuster2 (clim:scrolling (:height 450) message-pane))) + info minibuffer))) (:top-level (esa:esa-top-level)))

1 0

[stamp-cvs] CVS stamp
by rstrandh 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv21054 Modified Files: stamp.lisp Log Message: Stamp is now an ESA. --- /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 09:08:30 1.7 +++ /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 10:12:15 1.8 @@ -58,7 +58,14 @@ (defclass headers-pane (esa:esa-pane-mixin clim:application-pane) ()) (defclass message-pane (esa:esa-pane-mixin clim:application-pane) ()) -(clim:define-application-frame stamp () +(defclass stamp-minibuffer-pane (esa:minibuffer-pane) + () + (:default-initargs + :height 20 :max-height 20 :min-height 20)) + + +(clim:define-application-frame stamp (esa:esa-frame-mixin + clim:standard-application-frame) ((folders :initform (list (cons "Inbox" *inbox-folder*)) :accessor folders) (current-folder :initform nil :accessor current-folder) @@ -67,17 +74,21 @@ :display-function '(display-folders) :display-time nil :width 150 :min-width 150 :max-width 150)) - (headers-pane (clim:make-pane 'headers-pane - :display-function '(display-headers) - :display-time nil - :width 800 :height 150)) + (headers-pane (let ((pane (clim:make-pane 'headers-pane + :display-function '(display-headers) + :display-time nil + :command-table 'stamp + :width 800 :height 150))) + (setf (esa:windows clim:*application-frame*) + (list pane)) + pane)) (message-pane (clim:make-pane 'message-pane :display-function '(display-message) :display-time nil :height 450)) - (interactor :interactor :height 20 :max-height 20 :min-height 20) (adjuster1 (clim:make-pane 'clim-extensions:box-adjuster-gadget)) - (adjuster2 (clim:make-pane 'clim-extensions:box-adjuster-gadget))) + (adjuster2 (clim:make-pane 'clim-extensions:box-adjuster-gadget)) + (minibuffer (clim:make-pane 'stamp-minibuffer-pane :width 900))) (:layouts (default-layout (clim:vertically () (clim:horizontally () @@ -88,7 +99,8 @@ (clim:scrolling (:width 800 :height 150) headers-pane) adjuster2 (clim:scrolling (:height 450) message-pane))) - interactor)))) + minibuffer))) + (:top-level (esa:esa-top-level))) (defmethod clim:adopt-frame :after (frame-manager (frame stamp)) (setf (current-folder frame) (first (folders frame)))) @@ -230,6 +242,9 @@ (declare (ignore super-type sub-type)) (second (member :name properties)))) +(clim:define-command-table stamp + :inherit-from (esa:global-esa-table esa:keyboard-macro-table)) + (define-stamp-command (com-quit :name t) () (clim:frame-exit clim:*application-frame*))

1 0

[stamp-cvs] CVS stamp
by rstrandh 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv8576 Modified Files: stamp.lisp Log Message: A small step in the direction of an ESA. --- /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 06:13:08 1.6 +++ /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 09:08:30 1.7 @@ -54,35 +54,40 @@ ;;;(defparameter *folder-image* ;;; (image:read-image-file "folder.ppm")) +(defclass folders-pane (esa:esa-pane-mixin clim:application-pane) ()) +(defclass headers-pane (esa:esa-pane-mixin clim:application-pane) ()) +(defclass message-pane (esa:esa-pane-mixin clim:application-pane) ()) + (clim:define-application-frame stamp () ((folders :initform (list (cons "Inbox" *inbox-folder*)) :accessor folders) (current-folder :initform nil :accessor current-folder) (current-message :initform nil :accessor current-message)) - (:panes (folders-pane :application - :display-function '(display-folders) - :display-time nil - :width 150 :min-width 150 :max-width 150) - (headers-pane :application - :display-function '(display-headers) - :display-time nil - :width 800 :height 150) - (message-pane :application - :display-function '(display-message) - :display-time nil - :height 450) + (:panes (folders-pane (clim:make-pane 'folders-pane + :display-function '(display-folders) + :display-time nil + :width 150 :min-width 150 :max-width 150)) + (headers-pane (clim:make-pane 'headers-pane + :display-function '(display-headers) + :display-time nil + :width 800 :height 150)) + (message-pane (clim:make-pane 'message-pane + :display-function '(display-message) + :display-time nil + :height 450)) (interactor :interactor :height 20 :max-height 20 :min-height 20) (adjuster1 (clim:make-pane 'clim-extensions:box-adjuster-gadget)) (adjuster2 (clim:make-pane 'clim-extensions:box-adjuster-gadget))) (:layouts (default-layout (clim:vertically () (clim:horizontally () - folders-pane + (clim:scrolling (:width 150 :min-width 150 :max-width 150) + folders-pane) adjuster1 (clim:vertically () - headers-pane + (clim:scrolling (:width 800 :height 150) headers-pane) adjuster2 - message-pane)) + (clim:scrolling (:height 450) message-pane))) interactor)))) (defmethod clim:adopt-frame :after (frame-manager (frame stamp))

1 0

[stamp-cvs] CVS stamp/Spec
by rstrandh 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp/Spec In directory clnet:/tmp/cvs-serv6522 Modified Files: priorities.text Log Message: Modified the priorities to reflect what has been done at this point. Added new priorities. --- /project/stamp/cvsroot/stamp/Spec/priorities.text 2006/12/31 07:03:25 1.1 +++ /project/stamp/cvsroot/stamp/Spec/priorities.text 2007/01/04 06:18:40 1.2 @@ -6,7 +6,8 @@ annotations that give a rough priority and an indication of the difficulty. -* create a Maildir folder for testing purposes. Each message in the +* [this is done] + create a Maildir folder for testing purposes. Each message in the test suite should contain only ASCII characters so as to get around current mel-base problems. We could put that folder in Test/Folders/ASCII for example. It should contain a few dozen @@ -16,11 +17,19 @@ (identical) tag files (see the spec). This is high priority and easy to do, though it might be tedious. -* make sure Stamp actually runs, that it displays all the panes, and +* [this is done] + make sure Stamp actually runs, that it displays all the panes, and (initially) all the messages in the default folder. This should probably happen before the students start working. This is very high priority, and could take some time to do. +* convert Stamp to an ESA. This is high priority and not too hard to + do. + +* modify Stamp to use the tags files instead of asking mel-base for + the contents of the folder. This is hight priority and not too hard + to do. + * make the Stamp startup sequence work (creating configuration directories, reading configuration files, etc). The configuration files could be empty initially. This is high priority, but not

1 0

[stamp-cvs] CVS stamp
by rstrandh 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv5849 Modified Files: stamp.asd stamp.lisp Added Files: mel-extra.lisp Log Message: Modified mel-base slightly so that we can get hold of the unique filename that is generated when a message is copied into a maildir folder. Made com-get-mail add a line to the tags files whenever a message is copied. --- /project/stamp/cvsroot/stamp/stamp.asd 2007/01/04 03:41:04 1.2 +++ /project/stamp/cvsroot/stamp/stamp.asd 2007/01/04 06:13:08 1.3 @@ -27,4 +27,5 @@ (defsystem :stamp :depends-on (:mcclim :mel-base :climacs :split-sequence) :components ((:file "packages") + (:file "mel-extra") (:file "stamp" :depends-on ("packages")))) --- /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 03:55:16 1.5 +++ /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 06:13:08 1.6 @@ -307,6 +307,34 @@ (when message (send-message message headers body)))))) +(defun address-string-or-nil (address) + (if (null address) + nil + (mel:address-spec address))) + +(defun standard-tags (message) + "Return a list of standard tags for the message" + (list :subject (mel:subject message) + :date (mel:date message) + :from (address-string-or-nil (mel:from message)) + :to (mapcar #'address-string-or-nil (mel:to message)) + :sender (address-string-or-nil (mel:sender message)))) + +(defun copy-message-and-process-standard-tags (message folder) + (let ((folder-name (mel:name folder)) + (message-name (mel:copy-message message folder)) + (tags (standard-tags message))) + (with-open-file (stream (concatenate 'string folder-name "tags1") + :direction :output + :if-does-not-exist :create + :if-exists :append) + (print (cons message-name tags) stream)) + (with-open-file (stream (concatenate 'string folder-name "tags2") + :direction :output + :if-does-not-exist :create + :if-exists :append) + (print (cons message-name tags) stream)))) + (define-stamp-command (com-get-mail :name t) () (loop for mailbox in *mailboxes* do (loop for message in (mel:messages mailbox) @@ -314,7 +342,7 @@ (mel:messages *inbox-folder*) :key #'mel:message-id :test #'string=) - do (mel:copy-message message *inbox-folder*))) + do (copy-message-and-process-standard-tags message *inbox-folder*))) (redisplay-pane 'headers-pane)) (define-stamp-command (com-show-all-headers :name t) () --- /project/stamp/cvsroot/stamp/mel-extra.lisp 2007/01/04 06:13:08 NONE +++ /project/stamp/cvsroot/stamp/mel-extra.lisp 2007/01/04 06:13:08 1.1 (in-package :mel.internal) ;;; modify this method so that it returns the unique filename of the sink #+(or sbcl cmu) (defmethod copy-message-using-folders ((message message) message-folder (sink-folder folder)) "Copy a message (contained in some folder) into another folder" (declare (ignore message-folder)) (with-open-stream (source (open-message-input-stream message)) (with-open-stream (sink (open-message-storing-stream sink-folder message)) (loop for c = (read-char source nil nil) while c do (write-char c sink) finally (return (mel.folders.maildir::unique-message-name sink))))))

1 0

[stamp-cvs] CVS stamp/Test/maildir
by rstrandh 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp/Test/maildir In directory clnet:/tmp/cvs-serv5672 Added Files: tags Log Message: Created tags file for existing messages. --- /project/stamp/cvsroot/stamp/Test/maildir/tags 2007/01/04 06:10:10 NONE +++ /project/stamp/cvsroot/stamp/Test/maildir/tags 2007/01/04 06:10:10 1.1 ("1167748389.13017_80.localhost" :SUBJECT "[stamp-devel] Some initial thoughts" :DATE 3376533938 :FROM "strandh(a)labri.fr" :TO ("stamp-devel(a)common-lisp.net") :SENDER "stamp-devel-bounces(a)common-lisp.net") ("1167748390.13017_105.localhost" :SUBJECT "Imago" :DATE 3376078653 :FROM "dherring(a)tentpost.com" :TO ("matthieu.villeneuve(a)free.fr") :SENDER NIL) ("1167748390.13017_113.localhost" :SUBJECT "[stamp-devel] what language?" :DATE 3374549516 :FROM "strandh(a)labri.fr" :TO ("stamp-devel(a)common-lisp.net") :SENDER "stamp-devel-bounces(a)common-lisp.net") ("1167748391.13017_125.localhost" :SUBJECT "[mcclim-devel] Drei - a replacement for Goatee" :DATE 3371666129 :FROM "athas(a)sigkill.dk" :TO ("mcclim-devel(a)common-lisp.net") :SENDER "mcclim-devel-bounces(a)common-lisp.net") ("1167748391.13017_135.localhost" :SUBJECT "Re: [CLSQL-Help] Character encoding problem" :DATE 3353243896 :FROM "kevin(a)rosenberg.net" :TO ("matthieu.villeneuve(a)free.fr") :SENDER NIL) ("1167748392.13017_140.localhost" :SUBJECT "unetwork asdf ..." :DATE 3329141146 :FROM "lam(a)perave.org" :TO ("matthieu.villeneuve(a)free.fr") :SENDER NIL) ("1167748392.13017_146.localhost" :SUBJECT "bilinear" :DATE 3306557523 :FROM "mickael.gilabert(a)in-fusio.com" :TO ("matthieu.villeneuve(a)free.fr") :SENDER NIL) ("1167748392.13017_149.localhost" :SUBJECT "Re: zlib.cl" :DATE 3298054490 :FROM "musum(a)pvv.org" :TO ("matthieu.villeneuve(a)free.fr") :SENDER NIL) ("1167748392.13017_150.localhost" :SUBJECT "Fw: Which Emacs CL mode?" :DATE 3284972065 :FROM "mvilleneuve(a)betomorrow.com" :TO ("matthieu.villeneuve(a)free.fr") :SENDER NIL)

1 0

[stamp-cvs] CVS stamp
by rstrandh 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv12112 Modified Files: stamp.lisp Log Message: Avoid warnings from the compiler by using `frame' rather than clim:*application-frame* when appropriate, and by declaring unused variables to be ignored. --- /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 03:37:26 1.4 +++ /project/stamp/cvsroot/stamp/stamp.lisp 2007/01/04 03:55:16 1.5 @@ -105,11 +105,12 @@ (clim:with-text-face (pane :bold) (write-string "Folders" pane)) (terpri pane) - (loop with current-folder = (current-folder clim:*application-frame*) - for folder in (folders clim:*application-frame*) + (loop with current-folder = (current-folder frame) + for folder in (folders frame) do (when (eq folder current-folder) (multiple-value-bind (cursor-x cursor-y) (clim:stream-cursor-position pane) + (declare (ignore cursor-x)) (hilight-line pane cursor-y))) (write-string " " pane) ;;(clim-clx::draw-image pane *folder-image* 0 0) @@ -120,10 +121,9 @@ (defun display-headers (frame pane) (clim:with-text-family (pane :sans-serif) (let* ((messages (sort (copy-list (mel:messages - (cdr (current-folder - clim:*application-frame*)))) + (cdr (current-folder frame)))) #'< :key #'mel:date)) - (current-message (current-message clim:*application-frame*)) + (current-message (current-message frame)) (pane-region (clim:pane-viewport-region pane)) (pane-width (- (clim:bounding-rectangle-width pane-region) 20)) (index-width (clim:stream-string-width @@ -145,6 +145,7 @@ do (when (eq message current-message) (multiple-value-bind (cursor-x cursor-y) (clim:stream-cursor-position pane) + (declare (ignore cursor-x)) (hilight-line pane cursor-y))) (print-fixed-width-string pane (princ-to-string index) @@ -165,7 +166,7 @@ (terpri pane))))) (defun display-message (frame pane) - (let ((message (current-message clim:*application-frame*))) + (let ((message (current-message frame))) (when message (clim:with-text-family (pane :sans-serif) (print-properties-as-table @@ -191,6 +192,7 @@ (loop for part in (mel:parts message) do (multiple-value-bind (super-type sub-type) (mel:content-type part) + (declare (ignore sub-type)) (if (eq super-type :text) (let ((length (mel:content-octets part))) (push (get-body-string part length) text-parts)) @@ -220,6 +222,7 @@ (defun get-attached-file-name (part) (multiple-value-bind (super-type sub-type properties) (mel:content-type part) + (declare (ignore super-type sub-type)) (second (member :name properties)))) (define-stamp-command (com-quit :name t) () @@ -323,6 +326,8 @@ (let ((filename (concatenate 'string (namestring (user-homedir-pathname)) (get-attached-file-name part)))) + ;; avoid warnings + (declare (ignore filename)) )) ;;; Message composing @@ -482,6 +487,7 @@ (defun hilight-line (pane y) (multiple-value-bind (pane-x1 pane-y1 pane-x2 pane-y2) (clim:bounding-rectangle* pane) + (declare (ignore pane-y1 pane-y2)) (let ((height (clim:text-style-height clim:*default-text-style* pane))) (clim:draw-rectangle* pane pane-x1 y pane-x2 (+ y height 1)

1 0

[stamp-cvs] CVS stamp
by rstrandh 04 Jan '07

04 Jan '07

Update of /project/stamp/cvsroot/stamp In directory clnet:/tmp/cvs-serv10709 Modified Files: stamp.asd Log Message: Make stamp depend on split-sequence --- /project/stamp/cvsroot/stamp/stamp.asd 2007/01/03 11:27:56 1.1 +++ /project/stamp/cvsroot/stamp/stamp.asd 2007/01/04 03:41:04 1.2 @@ -25,6 +25,6 @@ (in-package :stamp.system) (defsystem :stamp - :depends-on (:mcclim :mel-base :climacs) + :depends-on (:mcclim :mel-base :climacs :split-sequence) :components ((:file "packages") (:file "stamp" :depends-on ("packages"))))

1 0