[stamp-cvs] CVS stamp

rstrandh rstrandh at common-lisp.net
Thu Jan 4 10:12:15 UTC 2007


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*))
 




More information about the Stamp-cvs mailing list