From dddfc3338780b2ab9e093bfeb79d039bad02d7f9 Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Sat, 4 Dec 2004 18:41:31 +0000 Subject: [PATCH] Adding text and UI manager Organization: Straylight/Edgeware From: espen --- examples/testgtk.lisp | 95 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 89 insertions(+), 6 deletions(-) diff --git a/examples/testgtk.lisp b/examples/testgtk.lisp index fa01312..aa04e11 100644 --- a/examples/testgtk.lisp +++ b/examples/testgtk.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: testgtk.lisp,v 1.7 2004-11-21 17:58:28 espen Exp $ +;; $Id: testgtk.lisp,v 1.8 2004-12-04 18:41:31 espen Exp $ ;;; Some of the code in this file are really outdatet, but it is @@ -184,9 +184,9 @@ (defun create-bbox-in-frame (class frame-label spacing width height layout) :child (make-instance class :border-width 5 :layout-style layout :spacing spacing ; :child-min-width width :child-min-height height - :child (make-instance 'button :label "OK") - :child (make-instance 'button :label "Cancel") - :child (make-instance 'button :label "Help")))) + :child (make-instance 'button :label "gtk-ok" :use-stock t) + :child (make-instance 'button :label "gtk-cancel" :use-stock t) + :child (make-instance 'button :label "gtk-help" :use-stock t)))) (define-toplevel create-button-box (window "Button Boxes") (make-instance 'v-box @@ -1514,7 +1514,13 @@ (define-toplevel create-statusbar (window "Statusbar") ;; (when timer ;; (timeout-remove timer) ;; (setq timer nil)))))))) - + + +;;; Text + +(define-simple-dialog create-text (dialog "Text" :default-width 400 + :default-height 400) + (make-instance 'text-view :border-width 10 :parent dialog :visible t)) ;;; Toggle buttons @@ -1699,6 +1705,82 @@ (define-toplevel create-toolbar (window "Toolbar test" :resizable nil) ;; (tooltips-set-tip ;; tooltips close-button "Push this button to close window" ;; "ContextHelp/buttons/Close"))))) + + +;;; UI Manager + +(defvar *ui-description* + '((:menubar "MenuBar" + (:menu "FileMenu" + (:menuitem "New") + (:menuitem "Open") + (:menuitem "Save") + (:menuitem "SaveAs") + :separator + (:menuitem "Quit")) + (:menu "PreferencesMenu" + (:menu "ColorMenu" + (:menuitem "Red") + (:menuitem "Green") + (:menuitem "Blue")) + (:menu "ShapeMenu" + (:menuitem "Square") + (:menuitem "Rectangle") + (:menuitem "Oval")) + (:menuitem "Bold")) + (:menu "HelpMenu" + (:menuitem "About"))) + (:toolbar "ToolBar" + (:toolitem "Open") + (:toolitem "Quit") + (:separator "Sep1") + (:toolitem "Logo")))) + +(define-simple-dialog create-ui-manager (dialog "UI Manager") + (let ((actions + (make-instance 'action-group + :name "Actions" + :action (create-action "FileMenu" nil "_File") + :action (create-action "PreferencesMenu" nil "_Preferences") + :action (create-action "ColorMenu" nil "_Color") + :action (create-action "ShapeMenu" nil "_Shape") + :action (create-action "HelpMenu" nil "_Help") + :action (create-action "New" "gtk-new" "_New" "N" "Create a new file") + :action (create-action "Open" "gtk-open" "_Open" "O" "Open a file") + :action (create-action "Save" "gtk-save" "_Save" "S" "Save current file") + :action (create-action "SaveAs" "gtk-save" "Save _As..." "" "Save to a file") + :action (create-action "Quit" "gtk-quit" "_Quit" "Q" "Quit") + :action (create-action "About" nil "_About" "A" "About") + :action (create-action "Logo" "demo-gtk-logo" "" nil "GTK+") + :action (create-toggle-action "Bold" "gtk-bold" "_Bold" "B" "Bold" t) + :actions (create-radio-actions + '(("Red" nil "_Red" "R" "Blood") + ("Green" nil "_Green" "G" "Grass") + ("Blue" nil "_Blue" "B" "Sky")) + "Green") + :actions (create-radio-actions + '(("Square" nil "_Square" "S" "Square") + ("Rectangle" nil "_Rectangle" "R" "Rectangle") + ("Oval" nil "_Oval" "O" "Egg"))))) + (ui (make-instance 'ui-manager))) + + (ui-manager-insert-action-group ui actions) + (ui-manager-add-ui ui *ui-description*) + + (window-add-accel-group dialog (ui-manager-accel-group ui)) + + (make-instance 'v-box + :parent dialog :show-all t + :child (list + (ui-manager-get-widget ui "/MenuBar") + :expand nil :fill nil) + :child (list + (ui-manager-get-widget ui "/ToolBar") + :expand nil :fill nil) + :child (make-instance 'label + :label "Type to start" + :xalign 0.5 :yalign 0.5 + :width-request 200 :height-request 200)))) @@ -1747,11 +1829,12 @@ (defun create-main-window () ;; ("test scrolling") ;; ("test selection") ;; ("test timeout" create-timeout-test) -;; ("text" #|create-text|#) + ("text" create-text) ("toggle buttons" create-toggle-buttons) ("toolbar" create-toolbar) ;; ("tooltips" create-tooltips) ;; ("tree" #|create-tree|#) + ("UI manager" create-ui-manager) )) (main-window (make-instance 'window :title "testgtk.lisp" :name "main_window" -- [mdw]