From 443a49501d16653d96a884fc062c678ea1b59ead Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sun, 13 Sep 2009 01:20:20 +0400 Subject: [PATCH] Add GtkAssistant widget --- generating.lisp | 6 ++- gtk/cl-gtk2-gtk.asd | 3 +- gtk/gtk.assistant.lisp | 80 ++++++++++++++++++++++++++++++++++++++++ gtk/gtk.demo.lisp | 46 ++++++++++++++++++++++- gtk/gtk.generated-classes.lisp | 9 ++++- 5 files changed, 140 insertions(+), 4 deletions(-) create mode 100644 gtk/gtk.assistant.lisp diff --git a/generating.lisp b/generating.lisp index 44b404b..887b6a9 100644 --- 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 --- 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 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 --- 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 --- 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 -- 1.7.10.4