added GtkBuilder & gtk builder demo

diff --git a/gtk/demo/demo1.glade b/gtk/demo/demo1.glade
new file mode 100644 (file)
index 0000000..cf1c3f4
--- /dev/null
+++ b/gtk/demo/demo1.glade
@@ -0,0 +1,209 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!DOCTYPE glade-interface SYSTEM "glade-2.0.dtd">
+<!--Generated with glade3 3.4.5 on Wed Mar 18 23:56:40 2009 -->
+<glade-interface>
+  <widget class="GtkWindow" id="window1">
+    <property name="title" translatable="yes">Gtk Builder Demo</property>
+    <property name="window_position">GTK_WIN_POS_CENTER</property>
+    <property name="icon_name">gtk-unindent</property>
+    <child>
+      <widget class="GtkVBox" id="vbox1">
+        <property name="visible">True</property>
+        <child>
+          <widget class="GtkMenuBar" id="menubar1">
+            <property name="visible">True</property>
+            <child>
+              <widget class="GtkMenuItem" id="menuitem1">
+                <property name="visible">True</property>
+                <property name="label" translatable="yes">_File</property>
+                <property name="use_underline">True</property>
+                <child>
+                  <widget class="GtkMenu" id="menu1">
+                    <property name="visible">True</property>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem1">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-new</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                      </widget>
+                    </child>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem2">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-open</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                      </widget>
+                    </child>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem3">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-save</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                      </widget>
+                    </child>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem4">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-save-as</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                      </widget>
+                    </child>
+                    <child>
+                      <widget class="GtkSeparatorMenuItem" id="separatormenuitem1">
+                        <property name="visible">True</property>
+                      </widget>
+                    </child>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem5">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-quit</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                        <signal name="activate" handler="quit_cb"/>
+                      </widget>
+                    </child>
+                  </widget>
+                </child>
+              </widget>
+            </child>
+            <child>
+              <widget class="GtkMenuItem" id="menuitem2">
+                <property name="visible">True</property>
+                <property name="label" translatable="yes">_Edit</property>
+                <property name="use_underline">True</property>
+                <child>
+                  <widget class="GtkMenu" id="menu2">
+                    <property name="visible">True</property>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem6">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-cut</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                      </widget>
+                    </child>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem7">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-copy</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                      </widget>
+                    </child>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem8">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-paste</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                      </widget>
+                    </child>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem9">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-delete</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                      </widget>
+                    </child>
+                  </widget>
+                </child>
+              </widget>
+            </child>
+            <child>
+              <widget class="GtkMenuItem" id="menuitem3">
+                <property name="visible">True</property>
+                <property name="label" translatable="yes">_View</property>
+                <property name="use_underline">True</property>
+              </widget>
+            </child>
+            <child>
+              <widget class="GtkMenuItem" id="menuitem4">
+                <property name="visible">True</property>
+                <property name="label" translatable="yes">_Help</property>
+                <property name="use_underline">True</property>
+                <child>
+                  <widget class="GtkMenu" id="menu3">
+                    <property name="visible">True</property>
+                    <child>
+                      <widget class="GtkImageMenuItem" id="imagemenuitem10">
+                        <property name="visible">True</property>
+                        <property name="label" translatable="yes">gtk-about</property>
+                        <property name="use_underline">True</property>
+                        <property name="use_stock">True</property>
+                        <signal name="activate" handler="about_cb"/>
+                      </widget>
+                    </child>
+                  </widget>
+                </child>
+              </widget>
+            </child>
+          </widget>
+          <packing>
+            <property name="expand">False</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkToolbar" id="toolbar1">
+            <property name="visible">True</property>
+            <child>
+              <widget class="GtkToolButton" id="toolbutton1">
+                <property name="visible">True</property>
+                <property name="label" translatable="yes">Button1</property>
+                <property name="stock_id">gtk-about</property>
+                <signal name="clicked" handler="toolbutton1_clicked_cb"/>
+              </widget>
+              <packing>
+                <property name="homogeneous">True</property>
+              </packing>
+            </child>
+            <child>
+              <widget class="GtkToggleToolButton" id="Red">
+                <property name="visible">True</property>
+                <property name="stock_id">gtk-no</property>
+              </widget>
+              <packing>
+                <property name="homogeneous">True</property>
+              </packing>
+            </child>
+          </widget>
+          <packing>
+            <property name="expand">False</property>
+            <property name="position">1</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkScrolledWindow" id="scrolledwindow1">
+            <property name="visible">True</property>
+            <property name="can_focus">True</property>
+            <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+            <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+            <child>
+              <widget class="GtkTextView" id="textview1">
+                <property name="visible">True</property>
+                <property name="can_focus">True</property>
+              </widget>
+            </child>
+          </widget>
+          <packing>
+            <property name="position">2</property>
+          </packing>
+        </child>
+        <child>
+          <widget class="GtkStatusbar" id="statusbar1">
+            <property name="visible">True</property>
+            <property name="spacing">2</property>
+          </widget>
+          <packing>
+            <property name="expand">False</property>
+            <property name="position">3</property>
+          </packing>
+        </child>
+      </widget>
+    </child>
+  </widget>
+</glade-interface>

diff --git a/gtk/demo/demo1.ui b/gtk/demo/demo1.ui
new file mode 100644 (file)
index 0000000..1aa87e1
--- /dev/null
+++ b/gtk/demo/demo1.ui
@@ -0,0 +1,192 @@
+<?xml version="1.0"?>
+<!--Generated with glade3 3.4.5 on Wed Mar 18 23:56:40 2009 -->
+<interface>
+  <object class="GtkUIManager" id="uimanager1">
+    <child>
+      <object class="GtkActionGroup" id="actiongroup1">
+        <child>
+          <object class="GtkAction" id="menuitem1">
+            <property name="name">menuitem1</property>
+            <property name="label" translatable="yes">_File</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem1">
+            <property name="stock_id" translatable="yes">gtk-new</property>
+            <property name="name">imagemenuitem1</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem2">
+            <property name="stock_id" translatable="yes">gtk-open</property>
+            <property name="name">imagemenuitem2</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem3">
+            <property name="stock_id" translatable="yes">gtk-save</property>
+            <property name="name">imagemenuitem3</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem4">
+            <property name="stock_id" translatable="yes">gtk-save-as</property>
+            <property name="name">imagemenuitem4</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem5">
+            <property name="stock_id" translatable="yes">gtk-quit</property>
+            <property name="name">imagemenuitem5</property>
+            <signal handler="quit_cb" name="activate"/>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="menuitem2">
+            <property name="name">menuitem2</property>
+            <property name="label" translatable="yes">_Edit</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem6">
+            <property name="stock_id" translatable="yes">gtk-cut</property>
+            <property name="name">imagemenuitem6</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem7">
+            <property name="stock_id" translatable="yes">gtk-copy</property>
+            <property name="name">imagemenuitem7</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem8">
+            <property name="stock_id" translatable="yes">gtk-paste</property>
+            <property name="name">imagemenuitem8</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem9">
+            <property name="stock_id" translatable="yes">gtk-delete</property>
+            <property name="name">imagemenuitem9</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="menuitem3">
+            <property name="name">menuitem3</property>
+            <property name="label" translatable="yes">_View</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="menuitem4">
+            <property name="name">menuitem4</property>
+            <property name="label" translatable="yes">_Help</property>
+          </object>
+        </child>
+        <child>
+          <object class="GtkAction" id="imagemenuitem10">
+            <property name="stock_id" translatable="yes">gtk-about</property>
+            <property name="name">imagemenuitem10</property>
+            <signal handler="about_cb" name="activate"/>
+          </object>
+        </child>
+      </object>
+    </child>
+    <ui>
+      <menubar name="menubar1">
+        <menu action="menuitem1">
+          <menuitem action="imagemenuitem1"/>
+          <menuitem action="imagemenuitem2"/>
+          <menuitem action="imagemenuitem3"/>
+          <menuitem action="imagemenuitem4"/>
+          <separator/>
+          <menuitem action="imagemenuitem5"/>
+        </menu>
+        <menu action="menuitem2">
+          <menuitem action="imagemenuitem6"/>
+          <menuitem action="imagemenuitem7"/>
+          <menuitem action="imagemenuitem8"/>
+          <menuitem action="imagemenuitem9"/>
+        </menu>
+        <menuitem action="menuitem3"/>
+        <menu action="menuitem4">
+          <menuitem action="imagemenuitem10"/>
+        </menu>
+      </menubar>
+    </ui>
+  </object>
+  <object class="GtkWindow" id="window1">
+    <property name="title" translatable="yes">Gtk Builder Demo</property>
+    <property name="window_position">GTK_WIN_POS_CENTER</property>
+    <property name="icon_name">gtk-unindent</property>
+    <child>
+      <object class="GtkVBox" id="vbox1">
+        <property name="visible">True</property>
+        <child>
+          <object class="GtkMenuBar" constructor="uimanager1" id="menubar1">
+            <property name="visible">True</property>
+          </object>
+          <packing>
+            <property name="expand">False</property>
+          </packing>
+        </child>
+        <child>
+          <object class="GtkToolbar" id="toolbar1">
+            <property name="visible">True</property>
+            <child>
+              <object class="GtkToolButton" id="toolbutton1">
+                <property name="visible">True</property>
+                <property name="label" translatable="yes">Button1</property>
+                <property name="stock_id">gtk-about</property>
+                <signal handler="toolbutton1_clicked_cb" name="clicked"/>
+              </object>
+              <packing>
+                <property name="homogeneous">True</property>
+              </packing>
+            </child>
+            <child>
+              <object class="GtkToggleToolButton" id="Red">
+                <property name="visible">True</property>
+                <property name="stock_id">gtk-no</property>
+              </object>
+              <packing>
+                <property name="homogeneous">True</property>
+              </packing>
+            </child>
+          </object>
+          <packing>
+            <property name="expand">False</property>
+            <property name="position">1</property>
+          </packing>
+        </child>
+        <child>
+          <object class="GtkScrolledWindow" id="scrolledwindow1">
+            <property name="visible">True</property>
+            <property name="can_focus">True</property>
+            <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+            <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>
+            <child>
+              <object class="GtkTextView" id="textview1">
+                <property name="visible">True</property>
+                <property name="can_focus">True</property>
+              </object>
+            </child>
+          </object>
+          <packing>
+            <property name="position">2</property>
+          </packing>
+        </child>
+        <child>
+          <object class="GtkStatusbar" id="statusbar1">
+            <property name="visible">True</property>
+            <property name="spacing">2</property>
+          </object>
+          <packing>
+            <property name="expand">False</property>
+            <property name="position">3</property>
+          </packing>
+        </child>
+      </object>
+    </child>
+  </object>
+</interface>

diff --git a/gtk/gtk.builder.lisp b/gtk/gtk.builder.lisp
index 0d38a0d..659d8af 100644 (file)
--- a/gtk/gtk.builder.lisp
+++ b/gtk/gtk.builder.lisp
@@ -1,2 +1,115 @@
 (in-package :gtk)
 
+(defcfun gtk-builder-add-from-file :uint
+  (builder g-object)
+  (filename :string)
+  (error :pointer))
+
+(defun builder-add-from-file (builder filename)
+  (gtk-builder-add-from-file builder filename (null-pointer)))
+
+(export 'builder-add-from-file)
+
+(defcfun gtk-builder-add-from-string :uint
+  (builder g-object)
+  (string :string)
+  (length :int)
+  (error :pointer))
+
+(defun builder-add-from-string (builder string)
+  (gtk-builder-add-from-string builder string -1 (null-pointer)))
+
+(export 'builder-add-from-string)
+
+(defcfun gtk-builder-add-objects-from-file :uint
+  (builder g-object)
+  (filename :string)
+  (object-ids :pointer)
+  (error :pointer))
+
+(defun builder-add-objects-from-file (builder filename object-ids)
+  (let ((l (foreign-alloc :pointer :count (1+ (length object-ids)))))
+    (loop
+       for i from 0
+       for object-id in object-ids
+       do (setf (mem-aref l :pointer i) (foreign-string-alloc object-id)))
+    (unwind-protect
+         (gtk-builder-add-objects-from-file builder filename l (null-pointer))
+      (loop
+         for i from 0
+         repeat (1- (length object-ids))
+         do (foreign-string-free (mem-aref l :pointer i)))
+      (foreign-free l))))
+
+(export 'builder-add-objects-from-file)
+
+(defcfun gtk-builder-add-objects-from-string :uint
+  (builder g-object)
+  (string :string)
+  (length :int)
+  (object-ids :pointer)
+  (error :pointer))
+
+(defun builder-add-objects-from-string (builder string object-ids)
+  (let ((l (foreign-alloc :pointer :count (1+ (length object-ids)))))
+    (loop
+       for i from 0
+       for object-id in object-ids
+       do (setf (mem-aref l :pointer i) (foreign-string-alloc object-id)))
+    (unwind-protect
+         (gtk-builder-add-objects-from-string builder string -1 l (null-pointer))
+      (loop
+         for i from 0
+         repeat (1- (length object-ids))
+         do (foreign-string-free (mem-aref l :pointer i)))
+      (foreign-free l))))
+
+(export 'builder-add-objects-from-string)
+
+(defcfun (builder-get-object "gtk_builder_get_object") g-object
+  (builder g-object)
+  (name :string))
+
+(export 'builder-get-object)
+
+; TODO: gtk_builder_get_objects
+
+; TOOD: move connect-flags to gobject
+
+(defbitfield connect-flags :after :swapped)
+
+(defcallback builder-connect-func-callback :void
+    ((builder g-object) (object g-object) (signal-name (:string :free-from-foreign nil))
+     (handler-name (:string :free-from-foreign nil)) (connect-object g-object)
+     (flags connect-flags) (data :pointer))
+  (restart-case
+      (funcall (get-stable-pointer-value data)
+               builder object signal-name handler-name connect-object flags)
+    (return () nil)))
+
+(defcfun gtk-builder-connect-signals-full :void
+  (builder g-object)
+  (func :pointer)
+  (data :pointer))
+
+(defun builder-connect-signals-full (builder func)
+  (with-stable-pointer (ptr func)
+    (gtk-builder-connect-signals-full builder (callback builder-connect-func-callback) ptr)))
+
+(export 'builder-connect-signals-full)
+
+(defun builder-connect-signals-simple (builder handlers-list)
+  (flet ((connect-func (builder object signal-name handler-name connect-object flags)
+           (declare (ignore builder connect-object))
+           (awhen (find handler-name handlers-list :key 'first :test 'string=)
+      (g-signal-connect object signal-name (second it) :after (member :after flags)))))
+    (builder-connect-signals-full builder #'connect-func)))
+
+(export 'builder-connect-signals-simple)
+
+; TODO: gtk_builder_get_type_from_name
+
+; TODO: gtk_builder_value_from_string
+
+; TODO: gtk_builder_value_from_string_type
+

diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp
index bd7c519..978a3d1 100644 (file)
--- a/gtk/gtk.demo.lisp
+++ b/gtk/gtk.demo.lisp
@@ -20,10 +20,13 @@
            #:test-font-chooser
            #:test-notebook
            #:test-calendar
-           #:test-box-child-property))
+           #:test-box-child-property
+           #:test-builder))
 
 (in-package :gtk-demo)
 
+(defparameter *src-location* (asdf:component-pathname (asdf:find-system :gtk)))
+
 (defun test ()
   (let ((window (make-instance 'gtk-window :type :toplevel :app-paintable t))
         x y)
@@ -480,4 +483,35 @@
     (container-add window box)
     (box-pack-start box button)
     (widget-show window)
+    (gtk-main)))
+
+(defun test-builder ()
+  (let ((builder (make-instance 'builder)))
+    (builder-add-from-file builder (namestring (merge-pathnames "demo/demo1.ui" *src-location*)))
+    (let ((text-view (builder-get-object builder "textview1"))
+          (c 0))
+      (builder-connect-signals-simple builder `(("toolbutton1_clicked_cb" ,(lambda (b)
+                                                                                   (declare (ignore b))
+                                                                                   (setf (text-buffer-text (text-view-buffer text-view))
+                                                                                         (format nil "Clicked ~A times~%" (incf c)))
+                                                                                   (status-bar-pop (builder-get-object builder "statusbar1")
+                                                                                                   "times")
+                                                                                   (status-bar-push (builder-get-object builder "statusbar1")
+                                                                                                    "times"
+                                                                                                    (format nil "~A times" c))))
+                                                ("quit_cb" ,(lambda (&rest args)
+                                                                    (print args)
+                                                                    (object-destroy (builder-get-object builder "window1"))))
+                                                ("about_cb" ,(lambda (&rest args)
+                                                                     (print args)
+                                                                     (let ((d (make-instance 'about-dialog
+                                                                                             :program-name "GtkBuilder text"
+                                                                                             :version "0.00001"
+                                                                                             :authors '("Dmitry Kalyanov")
+                                                                                             :logo-icon-name "gtk-apply")))
+                                                                       (dialog-run d)
+                                                                       (object-destroy d)))))))
+    (g-signal-connect (builder-get-object builder "window1") "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+    (status-bar-push (builder-get-object builder "statusbar1") "times" "0 times")
+    (widget-show (builder-get-object builder "window1"))
     (gtk-main)))
\ No newline at end of file