From e6666346b0c892c7dc8c702f63bbc1e554ad5211 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Wed, 18 Mar 2009 23:57:45 +0300 Subject: [PATCH] added GtkBuilder & gtk builder demo --- gtk/demo/demo1.glade | 209 ++++++++++++++++++++++++++++++++++++++++++++++++++ gtk/demo/demo1.ui | 192 ++++++++++++++++++++++++++++++++++++++++++++++ gtk/gtk.builder.lisp | 113 +++++++++++++++++++++++++++ gtk/gtk.demo.lisp | 36 ++++++++- 4 files changed, 549 insertions(+), 1 deletion(-) create mode 100644 gtk/demo/demo1.glade create mode 100644 gtk/demo/demo1.ui diff --git a/gtk/demo/demo1.glade b/gtk/demo/demo1.glade new file mode 100644 index 0000000..cf1c3f4 --- /dev/null +++ b/gtk/demo/demo1.glade @@ -0,0 +1,209 @@ + + + + + + Gtk Builder Demo + GTK_WIN_POS_CENTER + gtk-unindent + + + True + + + True + + + True + _File + True + + + True + + + True + gtk-new + True + True + + + + + True + gtk-open + True + True + + + + + True + gtk-save + True + True + + + + + True + gtk-save-as + True + True + + + + + True + + + + + True + gtk-quit + True + True + + + + + + + + + + True + _Edit + True + + + True + + + True + gtk-cut + True + True + + + + + True + gtk-copy + True + True + + + + + True + gtk-paste + True + True + + + + + True + gtk-delete + True + True + + + + + + + + + True + _View + True + + + + + True + _Help + True + + + True + + + True + gtk-about + True + True + + + + + + + + + + False + + + + + True + + + True + Button1 + gtk-about + + + + True + + + + + True + gtk-no + + + True + + + + + False + 1 + + + + + True + True + GTK_POLICY_AUTOMATIC + GTK_POLICY_AUTOMATIC + + + True + True + + + + + 2 + + + + + True + 2 + + + False + 3 + + + + + + diff --git a/gtk/demo/demo1.ui b/gtk/demo/demo1.ui new file mode 100644 index 0000000..1aa87e1 --- /dev/null +++ b/gtk/demo/demo1.ui @@ -0,0 +1,192 @@ + + + + + + + + + menuitem1 + _File + + + + + gtk-new + imagemenuitem1 + + + + + gtk-open + imagemenuitem2 + + + + + gtk-save + imagemenuitem3 + + + + + gtk-save-as + imagemenuitem4 + + + + + gtk-quit + imagemenuitem5 + + + + + + menuitem2 + _Edit + + + + + gtk-cut + imagemenuitem6 + + + + + gtk-copy + imagemenuitem7 + + + + + gtk-paste + imagemenuitem8 + + + + + gtk-delete + imagemenuitem9 + + + + + menuitem3 + _View + + + + + menuitem4 + _Help + + + + + gtk-about + imagemenuitem10 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Gtk Builder Demo + GTK_WIN_POS_CENTER + gtk-unindent + + + True + + + True + + + False + + + + + True + + + True + Button1 + gtk-about + + + + True + + + + + True + gtk-no + + + True + + + + + False + 1 + + + + + True + True + GTK_POLICY_AUTOMATIC + GTK_POLICY_AUTOMATIC + + + True + True + + + + + 2 + + + + + True + 2 + + + False + 3 + + + + + + diff --git a/gtk/gtk.builder.lisp b/gtk/gtk.builder.lisp index 0d38a0d..659d8af 100644 --- 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 --- 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 -- 1.7.10.4