[cells-cvs] CVS cells-gtk/test-gtk
ktilton
ktilton at common-lisp.net
Wed Jan 30 21:13:45 UTC 2008
Update of /project/cells/cvsroot/cells-gtk/test-gtk
In directory clnet:/tmp/cvs-serv5749/test-gtk
Modified Files:
test-buttons.lisp test-dialogs.lisp test-gtk.lisp
test-menus.lisp
Log Message:
fixed submenus
--- /project/cells/cvsroot/cells-gtk/test-gtk/test-buttons.lisp 2008/01/29 00:00:34 1.1
+++ /project/cells/cvsroot/cells-gtk/test-gtk/test-buttons.lisp 2008/01/30 21:13:44 1.2
@@ -26,6 +26,7 @@
(incf (nclics (upper self test-buttons)))))
(mk-button :label "Continuable error"
:on-clicked (callback (widget event data)
+ (trc "issuing continuable error" widget event)
(error 'gtk-continuable-error :text "Oops!")))
(mk-toggle-button :md-name :toggled-button
:markup (c? (with-markup (:foreground (if (value self) :red :blue))
--- /project/cells/cvsroot/cells-gtk/test-gtk/test-dialogs.lisp 2008/01/30 14:21:02 1.2
+++ /project/cells/cvsroot/cells-gtk/test-gtk/test-dialogs.lisp 2008/01/30 21:13:44 1.3
@@ -28,6 +28,7 @@
:kids (kids-list?
(mk-hbox
:kids (kids-list?
+
(append
#-libcellsgtk nil
#+libcellsgtk
@@ -36,19 +37,20 @@
:on-clicked
(callback (w e d)
(with-integrity (:change 'q4text)
- (let ((dialog
- (to-be (mk-message-dialog
- :md-name :rule-name-dialog
- :message "Type something:"
- :title "My Title"
- :message-type :question
- :buttons-type :ok-cancel
- :content-area (mk-entry :auto-aupdate t)))))
- (print 'back)
- (print (list 'value-dialog (value dialog)))
- (setf (text (fm^ :message-response)) (value dialog)))))))
+ (let ((dialog
+ (to-be (mk-message-dialog
+ :md-name :rule-name-dialog
+ :message "Type something:"
+ :title "My Title"
+ :message-type :question
+ :buttons-type :ok-cancel
+ :content-area (mk-entry :auto-aupdate t)))))
+ (print 'back)
+ (print (list 'value-dialog (value dialog)))
+ (setf (text (fm^ :message-response)) (value dialog)))))))
(loop for message-type in '(:info :warning :question :error) collect
(make-kid 'test-message :message-type message-type)))))
+
(mk-label :md-name :message-response)
(mk-hbox
:kids (kids-list?
@@ -62,12 +64,12 @@
:tab-labels (list "Open" "Save" "Select folder" "Create folder")
:kids (kids-list?
(loop for action in '(:open :save :select-folder :create-folder) collect
- (mk-vbox
- :kids (kids-list?
- (mk-file-chooser-widget :md-name action
- :action action
- :expand t :fill t
- :filters '(("All" "*") ("Text" "*.txt" "*.doc") ("Libraries" "*.so" "*.lib"))
- :select-multiple (c? (value (fm^ :multiple))))
- (mk-check-button :label "Select multiple" :md-name :multiple)
- (mk-label :text (c? (format nil "~a ~a" (md-name (psib (psib))) (value (psib (psib))))))))))))))
+ (mk-vbox
+ :kids (kids-list?
+ (mk-file-chooser-widget :md-name action
+ :action action
+ :expand t :fill t
+ :filters '(("All" "*") ("Text" "*.txt" "*.doc") ("Libraries" "*.so" "*.lib"))
+ :select-multiple (c? (value (fm^ :multiple))))
+ (mk-check-button :label "Select multiple" :md-name :multiple)
+ (mk-label :text (c? (format nil "~a ~a" (md-name (psib (psib))) (value (psib (psib))))))))))))))
--- /project/cells/cvsroot/cells-gtk/test-gtk/test-gtk.lisp 2008/01/30 14:21:02 1.2
+++ /project/cells/cvsroot/cells-gtk/test-gtk/test-gtk.lisp 2008/01/30 21:13:44 1.3
@@ -39,15 +39,16 @@
:splash-screen-image (namestring *splash-image*)
:width 650 :height 550
:kids (c? (the-kids
- (let ((tabs '("Buttons"
- "Display"
- "Layout"
+ (let ((tabs '(;"Buttons"
+ ;"Display"
+ ;"Layout"
+
"Menus"
- "Textview"
- "Dialogs"
- "Addon"
- "Entry"
- "Tree-view"
+ ;"Textview"
+ ;"Dialogs"
+ ;"Addon"
+ ;"Entry"
+ ;"Tree-view"
)))
(list (mk-notebook
:tab-labels tabs
@@ -65,7 +66,10 @@
(defun gtk-demo (&optional dbg)
- #-iamnotkenny (ukt:test-prep)
+ #-iamnotkenny
+ (PROGN
+ (dribble "/cells-gtk/demo.log")
+ (ukt:test-prep))
(cells-gtk-init)
(cells-gtk:start-app 'test-gtk::test-gtk :debug dbg))
--- /project/cells/cvsroot/cells-gtk/test-gtk/test-menus.lisp 2008/01/29 00:00:34 1.1
+++ /project/cells/cvsroot/cells-gtk/test-gtk/test-menus.lisp 2008/01/30 21:13:44 1.2
@@ -7,6 +7,7 @@
(mk-menu-bar
:kids (kids-list?
(mk-menu-item
+ :md-name 'menu-1
:label "Menu 1"
:kids (kids-list?
(mk-image-menu-item
@@ -14,28 +15,41 @@
:accel '(#\s :control :shift :alt)
:image (mk-image :stock :save :icon-size :menu)
:on-activate (callback (widget event data)
- (trc nil "TST") (force-output)))
+ (trc "TST SAVE") (force-output)))
(mk-menu-item
+ :md-name (gensym "SUBMENU-MENUITEM")
:label "Submenu"
:kids (kids-list?
- (mk-menu-item :label "subitem1")
- (mk-menu-item :label "subitem2")
- (mk-menu-item :label "subitem3")))
+ (mk-menu-item
+ :md-name (gensym "SUBITEM-1")
+ :label "subitem1"
+ :on-activate (callback (widget event data)
+ (trc "dribble SAVE") (dribble)))
+ (mk-menu-item
+ :md-name (gensym "SUBITEM-2")
+ :label "subitem2")
+ (mk-menu-item :label "subitem3")
+ ))
(mk-image-menu-item
:stock :harddisk
:on-activate (callback (widget event data)
- (trc nil "HARDDISK") (force-output)))
+ (trc "HARDDISK" widget event data)
+ (force-output)))
(mk-image-menu-item
:image (mk-image :stock :dialog-info :icon-size :menu)
:label-widget (mk-label :markup (with-markup (:foreground :blue)
"Blue label")))
(mk-image-menu-item
:stock :my-g
- :label "user stock icon")))
+ :label "user stock icon")
+ ))
(mk-menu-item
+ :md-name 'menu-2
:label "Menu 2"
:visible (c? (value (fm^ :menu2-visible)))
- :sensitive (c? (value (fm^ :menu2-sensitive)))
+ :sensitive (c? (let ((x (fm^ :menu2-sensitive)))
+ (trc "located m2sensi" x)
+ (value x)))
:kids (kids-list?
(mk-tearoff-menu-item)
(mk-check-menu-item
@@ -47,7 +61,8 @@
(mk-check-menu-item
:label "Sub-option 2"
:md-name :sub-option2
- :init t)))
+ :init t))
+ )
(mk-menu-item
:label "Menu 3"
:md-name :menu3
@@ -144,7 +159,7 @@
'("DD/MM/YY" "DD/MM/YYYY" "MM/DD/YY" "YYYY-MM-DD"
"YYYY-MM-DDTHH:MM:SS" "DD/MM/YY HH:MM:SS")))))))
(mk-hseparator :padding 5)
- (mk-hbox
+ (mk-hbox
:kids (kids-list?
(mk-event-box
:popup (mk-menu
More information about the Cells-cvs
mailing list