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