Improved UI manager demo

[clg] / examples / testgtk.lisp

diff --git a/examples/testgtk.lisp b/examples/testgtk.lisp
index b688c166ecf11d73bb03f9925c3f9a5053b7d6f0..ab958092419391b3a2314c90f92d3df9c502e974 100644 (file)
--- 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
 
 ;; 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.25 2005-03-13 18:16:08 espen Exp $
+;; $Id: testgtk.lisp,v 1.28 2005-04-19 08:17:06 espen Exp $

 
 (defpackage "TESTGTK"
   (:use "COMMON-LISP" "GTK"))
 
 (defpackage "TESTGTK"
   (:use "COMMON-LISP" "GTK"))


@@ -326,7 +326,7 @@ (define-simple-dialog create-cursors (dialog "Cursors")
   (let ((spinner (make-instance 'spin-button 
                  :adjustment (adjustment-new 
                               0 0 
   (let ((spinner (make-instance 'spin-button 
                  :adjustment (adjustment-new 
                               0 0 

-                              (1- (enum-int :last-cursor 'gdk:cursor-type))
+                              (1- (glib:enum-int :last-cursor 'gdk:cursor-type))

                               2 10 0)))
        (drawing-area (make-instance 'drawing-area
                       :width-request 80 :height-request 80
                               2 10 0)))
        (drawing-area (make-instance 'drawing-area
                       :width-request 80 :height-request 80


@@ -480,29 +480,6 @@ (define-toplevel create-font-selection (window "Font Button" :resizable nil)
            :use-font t :title "Font Selection Dialog")))
 
 
            :use-font t :title "Font Selection Dialog")))
 
 

-;;; Handle box
-
-(define-toplevel create-handle-box (window "Handle Box Test" :border-width 20)
-  (make-instance 'v-box 
-   :parent window
-   :child (create-label "Above")
-   :child (make-instance 'h-separator)
-   :child (make-instance 'h-box 
-          :spacing 10
-          :child (list
-                  (make-instance 'handle-box
-                   :child (create-toolbar window)
-                   :signal (list 'child-attached
-                            #'(lambda (child)
-                                (format t "~A attached~%" child)))
-                   :signal (list 'child-detached
-                            #'(lambda (child)
-                                (format t "~A detached~%" child))))
-                  :expand nil :fill :nil))
-   :child (make-instance 'h-separator)
-   :child (create-label "Below")))
-
-

 ;;; Icon View
 
 #+gtk2.6
 ;;; Icon View
 
 #+gtk2.6


@@ -667,8 +644,9 @@ (define-toplevel create-labels (window "Labels" :border-width 5 :resizable nil)
                       :justify :fill :wrap t)
 
             :child (create-label-in-frame "Underlined label"
                       :justify :fill :wrap t)
 
             :child (create-label-in-frame "Underlined label"

+(#+cmu glib:latin1-to-unicode #+sbcl identity

 "This label is underlined!
 "This label is underlined!

-This one is underlined (こんにちは) in quite a funky fashion"
+This one is underlined (æøåÆØÅ) in quite a funky fashion")

                       :justify :left
                      :pattern  "_________________________ _ _________ _ _____ _ __ __  ___ ____ _____")))))
 
                       :justify :left
                      :pattern  "_________________________ _ _________ _ _____ _ __ __  ___ ____ _____")))))
 


@@ -733,7 +711,7 @@ (define-toplevel create-layout (window "Layout" :default-width 200
     
 (define-simple-dialog create-list (dialog "List" :default-height 400)
   (let* ((store (make-instance 'list-store 
     
 (define-simple-dialog create-list (dialog "List" :default-height 400)
   (let* ((store (make-instance 'list-store 

-                :column-types '(string int boolean)
+                :column-types '(string integer boolean)

                 :column-names '(:foo :bar :baz)
                 :initial-content '(#("First" 12321 nil)
                                    (:foo "Yeah" :baz t))))
                 :column-names '(:foo :bar :baz)
                 :initial-content '(#("First" 12321 nil)
                                    (:foo "Yeah" :baz t))))


@@ -1569,23 +1547,25 @@ (define-simple-dialog create-text (dialog "Text" :default-width 400
 
       (let* ((actions 
              (make-instance 'action-group 
 
       (let* ((actions 
              (make-instance 'action-group 

-              :action (create-toggle-action 
-                       "Bold" "gtk-bold" "Bold" "<control>B" "Bold" nil
-                       (create-toggle-callback "Bold"))
-              :action (create-toggle-action 
-                       "Italic" "gtk-italic" "Italic" "<control>I" "Italic" nil
-                       (create-toggle-callback "Italic"))
-              :action (create-toggle-action 
-                       "Underline" "gtk-underline" "Underline" "<control>U" "Underline" nil
-                       (create-toggle-callback "Underline"))))
-            (ui (make-instance 'ui-manager)))
-      
-       (ui-manager-insert-action-group ui actions)
-       (ui-manager-add-ui ui 
-        '((:toolbar "ToolBar"
-           (:toolitem "Bold")
-           (:toolitem "Italic")
-           (:toolitem "Underline"))))
+              :action (make-instance 'toggle-action 
+                       :name "Bold" :stock-id "gtk-bold" :label "Bold" 
+                       :accelerator "<control>B" :tooltip "Bold"
+                       :callback (create-toggle-callback "Bold"))
+              :action (make-instance 'toggle-action 
+                       :name "Italic" :stock-id "gtk-italic" :label "Italic" 
+                       :accelerator "<control>I" :tooltip "Italic"
+                       :callback (create-toggle-callback "Italic"))
+              :action (make-instance 'toggle-action 
+                       :name "Underline" :stock-id "gtk-underline" 
+                       :label "Underline" :accelerator "<control>U" 
+                       :tooltip "Underline"
+                       :callback (create-toggle-callback "Underline"))))
+            (ui (make-instance 'ui-manager
+                 :action-group actions
+                 :ui '((:toolbar "ToolBar"
+                        (:toolitem "Bold")
+                        (:toolitem "Italic")
+                        (:toolitem "Underline"))))))

 
        ;; Callback to activate/deactivate toolbar buttons when cursor
        ;; is moved
 
        ;; Callback to activate/deactivate toolbar buttons when cursor
        ;; is moved


@@ -1728,6 +1708,28 @@ (define-toplevel create-toolbar-window (window "Toolbar test" :resizable nil)
   (container-add window (create-toolbar window)))
 
 
   (container-add window (create-toolbar window)))
 
 

+;;; Handle box
+
+(define-toplevel create-handle-box (window "Handle Box Test" :border-width 20)
+  (make-instance 'v-box 
+   :parent window
+   :child (create-label "Above")
+   :child (make-instance 'h-separator)
+   :child (make-instance 'h-box 
+          :spacing 10
+          :child (list
+                  (make-instance 'handle-box
+                   :child (create-toolbar window)
+                   :signal (list 'child-attached
+                            #'(lambda (child)
+                                (format t "~A attached~%" child)))
+                   :signal (list 'child-detached
+                            #'(lambda (child)
+                                (format t "~A detached~%" child))))
+                  :expand nil :fill :nil))
+   :child (make-instance 'h-separator)
+   :child (create-label "Below")))
+

 
 ;;; Tooltips test
 
 
 ;;; Tooltips test
 


@@ -1769,42 +1771,63 @@ (defvar *ui-description*
     (:toolbar "ToolBar"
      (:toolitem "Open")
      (:toolitem "Quit")
     (:toolbar "ToolBar"
      (:toolitem "Open")
      (:toolitem "Quit")

-     (:separator "Sep1")
+     :separator

      (:toolitem "Logo"))))
 
 (define-toplevel create-ui-manager (window "UI Manager")
      (:toolitem "Logo"))))
 
 (define-toplevel create-ui-manager (window "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" "<control>N" "Create a new file")
-         :action (create-action "Open" "gtk-open" "_Open" "<control>O" "Open a file" #'create-file-chooser)
-         :action (create-action "Save" "gtk-save" "_Save" "<control>S" "Save current file")
-         :action (create-action "SaveAs" "gtk-save" "Save _As..." "" "Save to a file")
-         :action (create-action "Quit" "gtk-quit" "_Quit" "<control>Q" "Quit" (list #'widget-destroy :object window))
-         :action (create-action "About" nil "_About" "<control>A" "About")
-         :action (create-action "Logo" "demo-gtk-logo" "" nil "GTK+")
-         :action (create-toggle-action "Bold" "gtk-bold" "_Bold" "<control>B" "Bold" t)
-         :actions (create-radio-actions
-                   '(("Red" nil "_Red" "<control>R" "Blood")
-                     ("Green" nil "_Green" "<control>G" "Grass")
-                     ("Blue" nil "_Blue" "<control>B" "Sky"))
-                   "Green")
-         :actions (create-radio-actions
-                   '(("Square" nil "_Square" "<control>S" "Square")
-                     ("Rectangle" nil "_Rectangle" "<control>R" "Rectangle")
-                     ("Oval" nil "_Oval" "<control>O" "Egg")))))
-       (ui (make-instance 'ui-manager)))
-  
-    (ui-manager-insert-action-group ui actions)
+  (let ((ui (make-instance 'ui-manager)))
+    (window-add-accel-group window (ui-manager-accel-group ui))
+    (ui-manager-insert-action-group ui
+     (make-instance 'action-group :name "Actions"
+      :action (make-instance 'action :name "FileMenu" :label "_File")
+      :action (make-instance 'action :name "PreferencesMenu" :label "_Preferences")
+      :action (make-instance 'action :name "ColorMenu" :label "_Color")
+      :action (make-instance 'action :name "ShapeMenu" :label "_Shape")
+      :action (make-instance 'action :name "HelpMenu" :label "_Help")
+      :action (make-instance 'action 
+              :name "New" :stock-id "gtk-new" :label "_New" 
+              :accelerator "<control>N" :tooltip "Create a new file")
+      :action (make-instance 'action 
+              :name "Open" :stock-id "gtk-open" :label "_Open" 
+              :accelerator "<control>O" :tooltip "Open a file" 
+              :callback #'create-file-chooser)
+      :action (make-instance 'action 
+              :name "Save" :stock-id "gtk-save" :label "_Save" 
+              :accelerator "<control>S" :tooltip "Save current file")
+      :action (make-instance 'action 
+              :name "SaveAs" :stock-id "gtk-save" :label "Save _As..." 
+              :tooltip "Save to a file")
+      :action (make-instance 'action 
+              :name "Quit" :stock-id "gtk-quit" :label "_Quit" 
+              :accelerator "<control>Q" :tooltip "Quit" 
+              :callback (list #'widget-destroy :object window))
+      :action (make-instance 'action 
+              :name "About" :label "_About" 
+              :accelerator "<control>A" :tooltip "About")
+      :action (make-instance 'action 
+              :name "Logo" :stock-id "demo-gtk-logo" :tooltip "GTK+")
+      :action (make-instance 'toggle-action 
+              :name "Bold" :stock-id "gtk-bold" :label "_Bold" 
+              :accelerator "<control>B" :tooltip "Bold" :active t)
+      :actions (make-radio-group 'radio-action
+               '((:name "Red" :value :red :label "_Red" 
+                  :accelerator "<control>R" :tooltip "Blood")
+                 (:name "Green" :value :green :label "_Green" 
+                  :accelerator "<control>G" :tooltip "Grass" :active t)
+                 (:name "Blue" :value :blue :label "_Blue" 
+                  :accelerator "<control>B" :tooltip "Sky"))
+               #'(lambda (active) (print active)))
+      :actions (make-radio-group 'radio-action
+               '((:name "Square" :value :square :label "_Square" 
+                  :accelerator "<control>S" :tooltip "Square")
+                 (:name "Rectangle" :value :rectangle :label "_Rectangle" 
+                  :accelerator "<control>R" :tooltip "Rectangle")
+                 (:name "Oval" :value :oval :label "_Oval" 
+                  :accelerator "<control>O" :tooltip "Egg"))
+               #'(lambda (active) (print active)))))    
+

     (ui-manager-add-ui ui *ui-description*)
 
     (ui-manager-add-ui ui *ui-description*)
 

-    (window-add-accel-group window (ui-manager-accel-group ui))
-    

     (make-instance 'v-box 
      :parent window
      :child (list 
     (make-instance 'v-box 
      :parent window
      :child (list