[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