Add GtkAssistant widget

diff --git a/generating.lisp b/generating.lisp
index 44b404b..887b6a9 100644 (file)
--- a/generating.lisp
+++ b/generating.lisp
@@ -188,7 +188,11 @@
        ("GtkDialog"
         (:cffi gtk::content-area gtk::dialog-content-area (g-object gtk::v-box) "gtk_dialog_get_content_area" nil)
         (:cffi gtk::action-area gtk::dialog-action-area (g-object gtk::widget) "gtk_dialog_get_action_area" nil)
-        (:cffi gtk::default-response gtk::dialog-default-response gtk::response-type nil "gtk_dialog_set_default_response"))))))
+        (:cffi gtk::default-response gtk::dialog-default-response gtk::response-type nil "gtk_dialog_set_default_response"))
+       ("GtkAssistant"
+        (:cffi gtk::current-page gtk::assistant-current-page :int "gtk_assistant_get_current_page" "gtk_assistant_set_current_page")
+        (:cffi gtk::n-pages gtk::assistant-n-pages :int "gtk_assistant_get_n_pages" nil)
+        (:cffi gtk::forward-page-function gtk::assistant-forward-page-function nil nil gtk::set-assistant-forward-page-function))))))
 
 (defun gtk-generate-child-properties (filename)
   (with-open-file (stream filename :direction :output :if-exists :supersede)

diff --git a/gtk/cl-gtk2-gtk.asd b/gtk/cl-gtk2-gtk.asd
index dcb58b1..38710c4 100644 (file)
--- a/gtk/cl-gtk2-gtk.asd
+++ b/gtk/cl-gtk2-gtk.asd
@@ -46,7 +46,8 @@
                (:file "gtk.child-properties")
                (:file "gtk.widget")
                (:file "gtk.builder")
-
+               (:file "gtk.assistant")
+               
                (:file "gtk.main-loop-events")
                
 

diff --git a/gtk/gtk.assistant.lisp b/gtk/gtk.assistant.lisp
new file mode 100644 (file)
index 0000000..97fa483
--- /dev/null
+++ b/gtk/gtk.assistant.lisp
@@ -0,0 +1,80 @@
+(in-package :gtk)
+
+(defcfun (assistant-nth-page "gtk_assistant_get_nth_page") (g-object widget)
+  (assistant (g-object assistant))
+  (page-num :int))
+
+(export 'assistant-nth-page)
+
+(defcfun (assistant-append-page "gtk_assistant_append_page") :int
+  (assistant (g-object assistant))
+  (page (g-object widget)))
+
+(export 'assistant-append-page)
+
+(defcfun (assistant-prepend-page "gtk_assistant_prepend_page") :int
+  (assistant (g-object assistant))
+  (page (g-object widget)))
+
+(export 'assistant-prepend-page)
+
+(defcfun (assistant-insert-page "gtk_assistant_insert_page") :int
+  (assistant (g-object assistant))
+  (page (g-object widget))
+  (position :int))
+
+(export 'assistant-insert-page)
+
+(defcstruct assistant-page-func-ref
+  (object :pointer)
+  (fn-id :int))
+
+(defcallback assistant-page-func-cb :int
+    ((current-page :int) (data :pointer))
+  (let* ((object (convert-from-foreign (foreign-slot-value data 'assistant-page-func-ref 'object) '(g-object assistant)))
+         (fn-id (foreign-slot-value data 'assistant-page-func-ref 'fn-id))
+         (fn (retrieve-handler-from-object object fn-id)))
+    (funcall fn current-page)))
+
+(defcallback assistant-page-func-destroy-notify-cb :void
+    ((data :pointer))
+  (let* ((object (convert-from-foreign (foreign-slot-value data 'assistant-page-func-ref 'object) '(g-object assistant)))
+         (fn-id (foreign-slot-value data 'assistant-page-func-ref 'fn-id)))
+    (delete-handler-from-object object fn-id)))
+
+(defcfun gtk-assistant-set-forward-page-func :void
+  (assistant (g-object assistant))
+  (page-func :pointer)
+  (data :pointer)
+  (destroy-notify :pointer))
+
+(defun set-assistant-forward-page-function (assistant function)
+  (if function
+      (let ((ref (foreign-alloc 'assistant-page-func-ref))
+            (fn-id (save-handler-to-object assistant function)))
+        (setf (foreign-slot-value ref 'assistant-page-func-ref 'object)
+              (pointer assistant)
+              (foreign-slot-value ref 'assistant-page-func-ref 'fn-id)
+              fn-id)
+        (gtk-assistant-set-forward-page-func assistant (callback assistant-page-func-cb)
+                                             ref (callback assistant-page-func-destroy-notify-cb)))
+      (gtk-assistant-set-forward-page-func assistant (null-pointer) (null-pointer) (null-pointer))))
+
+(defcfun (assistant-add-action-widget "gtk_assistant_add_action_widget") :void
+  (assistant (g-object assistant))
+  (widget (g-object widget)))
+
+(export 'assistant-add-action-widget)
+
+(defcfun (assistant-remove-action-widget "gtk_assistant_remove_action_widget") :void
+  (assistant (g-object assistant))
+  (widget (g-object widget)))
+
+(export 'assistant-remove-action-widget)
+
+(defcfun (assistant-update-buttons-state "gtk_assistant_update_buttons_state") :void
+  (assistant (g-object assistant)))
+
+(export 'assistant-update-buttons-state)
+
+

diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp
index fa7b74a..9118d1a 100644 (file)
--- a/gtk/gtk.demo.lisp
+++ b/gtk/gtk.demo.lisp
@@ -24,7 +24,8 @@
            #:demo-text-editor
            #:demo-class-browser
            #:demo-treeview-tree
-           #:test-custom-window))
+           #:test-custom-window
+           #:test-assistant))
 
 (in-package :gtk-demo)
 
@@ -796,3 +797,46 @@
   (within-main-loop
     (let ((w (make-instance 'custom-window)))
       (widget-show w))))
+
+(defun test-assistant ()
+  (let ((output *standard-output*))
+    (within-main-loop
+      (let ((d (make-instance 'assistant :title "Username wizard"))
+            (p-1 (make-instance 'h-box))
+            (entry (make-instance 'entry))
+            (p-2 (make-instance 'label :label "Click Apply to close this wizard")))
+        (box-pack-start p-1 (make-instance 'label :label "Enter your name:") :expand nil)
+        (box-pack-start p-1 entry)
+        (assistant-append-page d p-1)
+        (assistant-append-page d p-2)
+        (setf (assistant-child-title d p-1) "Username wizard"
+              (assistant-child-title d p-2) "Username wizard"
+              (assistant-child-complete d p-1) nil
+              (assistant-child-complete d p-2) t
+              (assistant-child-page-type d p-1) :intro
+              (assistant-child-page-type d p-2) :confirm
+              (assistant-forward-page-function d) (lambda (i)
+                                                    (format output "(assistant-forward-page-function ~A)~%" i)
+                                                    (ecase i
+                                                      (0 1)
+                                                      (1 -1))))
+        (connect-signal entry "notify::text" (lambda (object pspec)
+                                               (declare (ignore object pspec))
+                                               (setf (assistant-child-complete d p-1)
+                                                     (plusp (length (entry-text entry))))))
+        (let ((w (make-instance 'label :label "A label in action area")))
+          (widget-show w)
+          (assistant-add-action-widget d w))
+        (connect-signal d "cancel" (lambda (assistant)
+                                     (declare (ignore assistant))
+                                     (object-destroy d)
+                                     (format output "Canceled~%")))
+        (connect-signal d "close" (lambda (assistant)
+                                    (declare (ignore assistant))
+                                    (object-destroy d)
+                                    (format output "Thank you, ~A~%" (entry-text entry))))
+        (connect-signal d "prepare" (lambda (assistant page-widget)
+                                      (declare (ignore assistant page-widget))
+                                      (format output "Assistant ~A has ~A pages and is on ~Ath page~%"
+                                              d (assistant-n-pages d) (assistant-current-page d))))
+        (widget-show d)))))

diff --git a/gtk/gtk.generated-classes.lisp b/gtk/gtk.generated-classes.lisp
index 2cd35d4..6507cc1 100644 (file)
--- a/gtk/gtk.generated-classes.lisp
+++ b/gtk/gtk.generated-classes.lisp
@@ -1503,7 +1503,14 @@
                        (:superclass gtk-window :export t :interfaces
                         ("AtkImplementorIface" "GtkBuildable")
                         :type-initializer "gtk_assistant_get_type")
-                       nil)
+                       ((:cffi current-page assistant-current-page :int
+                         "gtk_assistant_get_current_page"
+                         "gtk_assistant_set_current_page")
+                        (:cffi n-pages assistant-n-pages :int
+                         "gtk_assistant_get_n_pages" nil)
+                        (:cffi forward-page-function
+                         assistant-forward-page-function nil nil
+                         set-assistant-forward-page-function)))
 
 (define-g-object-class "GtkDialog" dialog
                        (:superclass gtk-window :export t :interfaces