From: Dmitry Kalyanov Date: Tue, 17 Mar 2009 19:06:18 +0000 (+0300) Subject: added ui-manager and related stuff X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b638875984a67b3c43341cdf17607d981c7903ae;p=cl-gtk2.git added ui-manager and related stuff --- diff --git a/generating.lisp b/generating.lisp index 2793b88..f08e1e4 100644 --- a/generating.lisp +++ b/generating.lisp @@ -40,7 +40,9 @@ :exceptions `(("GObject" gobject:g-object) ("GtkObject" ,(intern "GTK-OBJECT" (find-package :gtk))) ("GInitiallyUnowned" gobject::g-initially-unowned) - ("GtkWindow" ,(intern "GTK-WINDOW" (find-package :gtk)))) + ("GtkWindow" ,(intern "GTK-WINDOW" (find-package :gtk))) + ("GtkUIManager" ,(intern "UI-MANAGER" (find-package :gtk))) + ("GtkUIManagerItemType" ,(intern "UI-MANAGER-ITEM-TYPE" (find-package :gtk)))) :prologue (format nil "(in-package :gtk)") :interfaces '("GtkBuildable" "GtkCellEditable" @@ -63,7 +65,8 @@ "GtkPrintSettings" "GtkRecentManager" "GtkSizeGroup" "GtkStatusIcon" "GtkTextBuffer" "GtkTextChildAnchor" "GtkTextMark" "GtkTextTag" "GtkTextTagTable" "GtkTreeModelFilter" "GtkTreeModelSort" - "GtkTreeSelection" "GtkTreeStore" "GtkUIManager" "GtkWindowGroup") + "GtkTreeSelection" "GtkTreeStore" "GtkUIManager" "GtkWindowGroup" + "GtkToggleAction" "GtkRecentAction" "GtkRadioAction") :flags '("GtkTextSearchFlags" "GtkAccelFlags" "GtkArgFlags" "GtkAttachOptions" "GtkButtonAction" "GtkCalendarDisplayOptions" "GtkCellRendererState" "GtkDebugFlag" "GtkDestDefaults" "GtkDialogFlags" "GtkFileFilterFlags" @@ -131,4 +134,12 @@ (:cffi gtk::relief-style gtk::tool-item-relief-style gtk::relief-style "gtk_tool_item_get_relief_style" nil)) ("GtkMenuToolButton" (:cffi gtk::arrow-tooltip-text gtk::menu-tool-button-arrow-tooltip-text :string nil "gtk_menu_tool_button_set_arrow_tooltip_text") - (:cffi gtk::arrow-tooltip-markup gtk::menu-tool-button-arrow-tooltip-markup :string nil "gtk_menu_tool_button_set_arrow_tooltip_markup")))))) \ No newline at end of file + (:cffi gtk::arrow-tooltip-markup gtk::menu-tool-button-arrow-tooltip-markup :string nil "gtk_menu_tool_button_set_arrow_tooltip_markup")) + ("GtkUIManager" + (:cffi gtk::accel-group gtk::ui-manager-accel-group g-object "gtk_ui_manager_get_accel_group" nil)) + ("GtkActionGroup" + (:cffi gtk::translate-function gtk::action-group-translate-function nil nil gtk::action-group-set-translate-func) + (:cffi gtk::translation-domain gtk::action-group-translation-domain nil nil gtk::gtk-action-group-set-translation-domain)) + ("GtkAction" + (:cffi gtk::accel-path gtk::action-accel-path (:string :free-from-foreign nil :free-to-foreign t) "gtk_action_get_accel_path" "gtk_action_set_accel_path") + (:cffi gtk::accel-group gtk::action-accel-group g-object nil "gtk_action_set_accel_group")))))) \ No newline at end of file diff --git a/gtk/gtk.asd b/gtk/gtk.asd index 81dd144..b2b157a 100644 --- a/gtk/gtk.asd +++ b/gtk/gtk.asd @@ -28,6 +28,7 @@ (:file "gtk.cell-renderer") (:file "gtk.combo-box") (:file "gtk.menu") + (:file "gtk.ui-manager") (:file "gtk.dialog.example") diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp index 8df755e..98577a0 100644 --- a/gtk/gtk.demo.lisp +++ b/gtk/gtk.demo.lisp @@ -1,5 +1,5 @@ (defpackage :gtk-demo - (:use :cl :gtk :gdk :gobject) + (:use :cl :gtk :gdk :gobject :anaphora :iter) (:export #:test #:test-entry #:table-packing @@ -12,7 +12,9 @@ #:demo-code-editor #:test-treeview-list #:test-combobox - #:test-toolbar)) + #:test-toolbar + #:test-color-button + #:test-ui-manager)) (in-package :gtk-demo) @@ -319,4 +321,50 @@ (toolbar-insert toolbar (make-instance 'tool-button :stock-id "gtk-undo" :sensitive nil) -1) (toolbar-insert toolbar (make-instance 'tool-button :stock-id "gtk-redo") -1) (gtk-widget-show-all window) + (gtk-main))) + +(defun test-color-button () + (let* ((window (make-instance 'gtk-window :type :toplevel :title "Color button" :width-request 200 :height-request 100 :window-position :center)) + (button (make-instance 'color-button :label "Choose your color" :use-alpha t))) + (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit))) + (container-add window button) + (setf (color-button-color button) + (make-color :red (random 65536) :green (random 65536) :blue (random 65536))) + (gtk-widget-show-all window) + (gtk-main))) + +(defun test-ui-manager () + (let* ((window (make-instance 'gtk-window :type :toplevel :title "UI Manager" :default-width 200 :default-height 100 :window-position :center)) + (ui-manager (make-instance 'ui-manager)) + (print-confirmation t)) + (ui-manager-add-ui-from-string ui-manager + " + + + + + + + + + + +") + (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit))) + (iter (with fn = (lambda (action) (when print-confirmation (format t "Action ~A with name ~A activated~%" action (action-name action))))) + (with action-group = (make-instance 'action-group :name "Actions")) + (finally (let ((a (make-instance 'toggle-action :name "print-confirm" :label "Print" :stock-id "gtk-print-report" :active t))) + (g-signal-connect a "toggled" (lambda (action) (setf print-confirmation (toggle-action-active action)))) + (action-group-add-action action-group a)) + (ui-manager-insert-action-group ui-manager action-group 0)) + (for (name stock-id) in '(("justify-left" "gtk-justify-left") + ("justify-center" "gtk-justify-center") + ("justify-right" "gtk-justify-right") + ("zoom-in" "gtk-zoom-in"))) + (for action = (make-instance 'action :name name :stock-id stock-id)) + (g-signal-connect action "activate" fn) + (action-group-add-action action-group action)) + (awhen (ui-manager-widget ui-manager "/toolbar1") + (container-add window it)) + (gtk-widget-show-all window) (gtk-main))) \ No newline at end of file diff --git a/gtk/gtk.generated-classes.lisp b/gtk/gtk.generated-classes.lisp index 529964e..2075e12 100644 --- a/gtk/gtk.generated-classes.lisp +++ b/gtk/gtk.generated-classes.lisp @@ -7,15 +7,15 @@ (:export t :type-initializer "gtk_size_group_mode_get_type") (:none 0) (:horizontal 1) (:vertical 2) (:both 3)) +(define-g-enum "GtkUnit" unit (:export t :type-initializer "gtk_unit_get_type") + (:pixel 0) (:points 1) (:inch 2) (:mm 3)) + (define-g-enum "GtkPrintStatus" print-status (:export t :type-initializer "gtk_print_status_get_type") (:initial 0) (:preparing 1) (:generating-data 2) (:sending-data 3) (:pending 4) (:pending-issue 5) (:printing 6) (:finished 7) (:finished-aborted 8)) -(define-g-enum "GtkUnit" unit (:export t :type-initializer "gtk_unit_get_type") - (:pixel 0) (:points 1) (:inch 2) (:mm 3)) - (define-g-enum "GtkRecentSortType" recent-sort-type (:export t :type-initializer "gtk_recent_sort_type_get_type") (:none 0) (:mru 1) (:lru 2) (:custom 3)) @@ -38,16 +38,16 @@ "gtk_tree_view_column_sizing_get_type") (:grow-only 0) (:autosize 1) (:fixed 2)) -(define-g-enum "GtkProgressBarStyle" progress-bar-style - (:export t :type-initializer "gtk_progress_bar_style_get_type") - (:continuous 0) (:discrete 1)) - (define-g-enum "GtkProgressBarOrientation" progress-bar-orientation (:export t :type-initializer "gtk_progress_bar_orientation_get_type") (:left-to-right 0) (:right-to-left 1) (:bottom-to-top 2) (:top-to-bottom 3)) +(define-g-enum "GtkProgressBarStyle" progress-bar-style + (:export t :type-initializer "gtk_progress_bar_style_get_type") + (:continuous 0) (:discrete 1)) + (define-g-enum "GtkUpdateType" update-type (:export t :type-initializer "gtk_update_type_get_type") (:continuous 0) (:discontinuous 1) (:delayed 2)) @@ -82,14 +82,14 @@ (:export t :type-initializer "gtk_toolbar_style_get_type") (:icons 0) (:text 1) (:both 2) (:both-horiz 3)) -(define-g-enum "GtkJustification" justification - (:export t :type-initializer "gtk_justification_get_type") - (:left 0) (:right 1) (:center 2) (:fill 3)) - (define-g-enum "GtkWrapMode" wrap-mode (:export t :type-initializer "gtk_wrap_mode_get_type") (:none 0) (:char 1) (:word 2) (:word-char 3)) +(define-g-enum "GtkJustification" justification + (:export t :type-initializer "gtk_justification_get_type") + (:left 0) (:right 1) (:center 2) (:fill 3)) + (define-g-enum "GtkButtonBoxStyle" button-box-style (:export t :type-initializer "gtk_button_box_style_get_type") (:default-style 0) (:spread 1) (:edge 2) (:start 3) (:end 4) @@ -108,14 +108,14 @@ (:export t :type-initializer "gtk_pack_direction_get_type") (:ltr 0) (:rtl 1) (:ttb 2) (:btt 3)) -(define-g-enum "GtkPolicyType" policy-type - (:export t :type-initializer "gtk_policy_type_get_type") - (:always 0) (:automatic 1) (:never 2)) - (define-g-enum "GtkCornerType" corner-type (:export t :type-initializer "gtk_corner_type_get_type") (:top-left 0) (:bottom-left 1) (:top-right 2) (:bottom-right 3)) +(define-g-enum "GtkPolicyType" policy-type + (:export t :type-initializer "gtk_policy_type_get_type") + (:always 0) (:automatic 1) (:never 2)) + (define-g-enum "GtkSensitivityType" sensitivity-type (:export t :type-initializer "gtk_sensitivity_type_get_type") (:auto 0) (:on 1) (:off 2)) @@ -533,7 +533,7 @@ (:export t :type-initializer "gtk_tree_model_flags_get_type") (:iters-persist 1) (:list-only 2)) -(define-g-flags "GtkUIManagerItemType" u-i-manager-item-type (:export t) +(define-g-flags "GtkUIManagerItemType" ui-manager-item-type (:export t) (:auto 0) (:menubar 1) (:menu 2) (:toolbar 4) (:placeholder 8) (:popup 16) (:menuitem 32) (:toolitem 64) (:separator 128) (:accelerator 256)) @@ -562,13 +562,6 @@ (define-g-interface "GtkFileChooser" file-chooser (:export t :type-initializer "gtk_file_chooser_get_type") - (local-only file-chooser-local-only "local-only" "gboolean" - t t) - (preview-widget-active file-chooser-preview-widget-active - "preview-widget-active" "gboolean" t t) - (use-preview-label file-chooser-use-preview-label - "use-preview-label" "gboolean" t t) - (filter file-chooser-filter "filter" "GtkFileFilter" t t) (show-hidden file-chooser-show-hidden "show-hidden" "gboolean" t t) (select-multiple file-chooser-select-multiple @@ -579,6 +572,13 @@ "preview-widget" "GtkWidget" t t) (file-system-backend file-chooser-file-system-backend "file-system-backend" "gchararray" nil nil) + (use-preview-label file-chooser-use-preview-label + "use-preview-label" "gboolean" t t) + (filter file-chooser-filter "filter" "GtkFileFilter" t t) + (preview-widget-active file-chooser-preview-widget-active + "preview-widget-active" "gboolean" t t) + (local-only file-chooser-local-only "local-only" "gboolean" + t t) (extra-widget file-chooser-extra-widget "extra-widget" "GtkWidget" t t) (do-overwrite-confirmation @@ -606,23 +606,23 @@ (define-g-interface "GtkRecentChooser" recent-chooser (:export t :type-initializer "gtk_recent_chooser_get_type") + (limit recent-chooser-limit "limit" "gint" t t) (recent-manager recent-chooser-recent-manager "recent-manager" "GtkRecentManager" nil nil) - (show-tips recent-chooser-show-tips "show-tips" "gboolean" - t t) - (sort-type recent-chooser-sort-type "sort-type" - "GtkRecentSortType" t t) - (limit recent-chooser-limit "limit" "gint" t t) (show-not-found recent-chooser-show-not-found "show-not-found" "gboolean" t t) - (filter recent-chooser-filter "filter" "GtkRecentFilter" t - t) - (show-private recent-chooser-show-private "show-private" - "gboolean" t t) (show-icons recent-chooser-show-icons "show-icons" "gboolean" t t) (local-only recent-chooser-local-only "local-only" "gboolean" t t) + (show-tips recent-chooser-show-tips "show-tips" "gboolean" + t t) + (show-private recent-chooser-show-private "show-private" + "gboolean" t t) + (filter recent-chooser-filter "filter" "GtkRecentFilter" t + t) + (sort-type recent-chooser-sort-type "sort-type" + "GtkRecentSortType" t t) (select-multiple recent-chooser-select-multiple "select-multiple" "gboolean" t t)) @@ -2471,7 +2471,13 @@ (sensitive action-sensitive "sensitive" "gboolean" t t) (visible action-visible "visible" "gboolean" t t) (action-group action-action-group "action-group" - "GtkActionGroup" t t))) + "GtkActionGroup" t t) + (:cffi accel-path action-accel-path + (:string :free-from-foreign nil :free-to-foreign t) + "gtk_action_get_accel_path" + "gtk_action_set_accel_path") + (:cffi accel-group action-accel-group g-object nil + "gtk_action_set_accel_group"))) (define-g-object-class "GtkActionGroup" action-group (:superclass g-object :export t :interfaces @@ -2480,8 +2486,13 @@ ((name action-group-name "name" "gchararray" t nil) (sensitive action-group-sensitive "sensitive" "gboolean" t t) - (visible action-group-visible "visible" "gboolean" t - t))) + (visible action-group-visible "visible" "gboolean" t t) + (:cffi translate-function + action-group-translate-function nil nil + action-group-set-translate-func) + (:cffi translation-domain + action-group-translation-domain nil nil + gtk-action-group-set-translation-domain))) (define-g-object-class "GtkBuilder" builder (:superclass g-object :export t :interfaces nil @@ -2805,15 +2816,42 @@ :type-initializer "gtk_tree_store_get_type") nil) -(define-g-object-class "GtkUIManager" u-i-manager +(define-g-object-class "GtkUIManager" ui-manager (:superclass g-object :export t :interfaces ("GtkBuildable")) - ((add-tearoffs u-i-manager-add-tearoffs "add-tearoffs" + ((add-tearoffs ui-manager-add-tearoffs "add-tearoffs" "gboolean" t t) - (ui u-i-manager-ui "ui" "gchararray" t nil))) + (ui ui-manager-ui "ui" "gchararray" t nil) + (:cffi accel-group ui-manager-accel-group g-object + "gtk_ui_manager_get_accel_group" nil))) (define-g-object-class "GtkWindowGroup" window-group (:superclass g-object :export t :interfaces nil :type-initializer "gtk_window_group_get_type") nil) +(define-g-object-class "GtkToggleAction" toggle-action + (:superclass action :export t :interfaces + ("GtkBuildable") :type-initializer + "gtk_toggle_action_get_type") + ((draw-as-radio toggle-action-draw-as-radio + "draw-as-radio" "gboolean" t t) + (active toggle-action-active "active" "gboolean" t t))) + +(define-g-object-class "GtkRecentAction" recent-action + (:superclass action :export t :interfaces + ("GtkBuildable" "GtkRecentChooser") :type-initializer + "gtk_recent_action_get_type") + ((show-numbers recent-action-show-numbers "show-numbers" + "gboolean" t t))) + +(define-g-object-class "GtkRadioAction" radio-action + (:superclass toggle-action :export t :interfaces + ("GtkBuildable") :type-initializer + "gtk_radio_action_get_type") + ((value radio-action-value "value" "gint" t t) + (group radio-action-group "group" "GtkRadioAction" nil + t) + (current-value radio-action-current-value + "current-value" "gint" t t))) + diff --git a/gtk/gtk.ui-manager.lisp b/gtk/gtk.ui-manager.lisp new file mode 100644 index 0000000..d7af264 --- /dev/null +++ b/gtk/gtk.ui-manager.lisp @@ -0,0 +1,213 @@ +(in-package :gtk) + +(defcfun (ui-manager-insert-action-group "gtk_ui_manager_insert_action_group") :void + (ui-manager g-object) + (action-group g-object) + (pos :int)) + +(export 'ui-manager-insert-action-group) + +(defcfun (ui-manager-remove-action-group "gtk_ui_manager_remove_action_group") :void + (ui-manager g-object) + (action-group g-object)) + +(export 'ui-manager-remove-action-group) + +(defcfun (ui-manager-action-groups "gtk_ui_manager_get_action_groups") (glist g-object :free-from-foreign nil) + (ui-manager g-object)) + +(export 'ui-manager-action-groups) + +(defcfun (ui-manager-widget "gtk_ui_manager_get_widget") g-object + (ui-manager g-object) + (path :string)) + +(export 'ui-manager-widget) + +(defcfun (ui-manager-toplevels "gtk_ui_manager_get_toplevels") (gslist g-object :free-from-foreign t) + (ui-manager g-object) + (types ui-manager-item-type)) + +(export 'ui-manager-toplevels) + +(defcfun (ui-manager-action "gtk_ui_manager_get_action") g-object + (ui-manager g-object) + (path :string)) + +(export 'ui-manager-action) + +(defcfun gtk-ui-manager-add-ui-from-string :uint + (ui-manager g-object) + (buffer :string) + (length gssize) + (error :pointer)) + +; TODO: add handling of error + +(defun ui-manager-add-ui-from-string (ui-manager string) + (gtk-ui-manager-add-ui-from-string ui-manager string -1 (null-pointer))) + +(export 'ui-manager-add-ui-from-string) + +(defcfun gtk-ui-manager-add-ui-from-file :uint + (ui-manager g-object) + (file-name :string) + (error :pointer)) + +(defun ui-manager-add-ui-from-file (ui-manager file-name) + (gtk-ui-manager-add-ui-from-file ui-manager file-name (null-pointer))) + +(export 'ui-manager-add-ui-from-file) + +(defcfun (ui-manager-new-merge-id "gtk_ui_manager_new_merge_id") :uint + (ui-manager g-object)) + +(export 'ui-manager-new-merge-id) + +(defcfun (ui-manager-add-ui "gtk_ui_manager_add_ui") :void + (ui-manager g-object) + (merge-id :uint) + (path :string) + (name :string) + (action :string) + (type ui-manager-item-type) + (top :boolean)) + +(export 'ui-manager-add-ui) + +(defcfun (ui-manager-remove-ui "gtk_ui_manager_remove_ui") :void + (ui-manager g-object) + (merge-id :uint)) + +(export 'ui-manager-remove-ui) + +(defcfun (ui-manager-ensure-update "gtk_ui_manager_ensure_update") :void + (ui-manager g-object)) + +(export 'ui-manager-remove-ui) + +(defcfun (action-group-action "gtk_action_group_get_action") g-object + (action-group g-object) + (action-name :string)) + +(export 'action-group-action) + +(defcfun (action-group-actions "gtk_action_group_actions") (glist g-object :free-from-foreign t) + (action-group g-object)) + +(export 'action-group-actions) + +(defcfun gtk-action-group-add-action-with-accel :void + (action-group g-object) + (action g-object) + (accelerator :string)) + +(defun action-group-add-action (action-group action &key accelerator) + (gtk-action-group-add-action-with-accel action-group action (if accelerator accelerator (null-pointer)))) + +(export 'action-group-add-action) + +(defcfun (action-remove-action "gtk_action_remove_action") :void + (action-group g-object) + (action g-object)) + +(export 'action-remove-action) + +(defcallback gtk-translate-func-callback (:string :free-to-foreign nil :free-from-foreign nil) + ((path (:string :free-from-foreign nil)) (data :pointer)) + (restart-case + (funcall (get-stable-pointer-value data) + path) + (return-untranslated () path))) + +(defcfun gtk-action-group-set-translate-func :void + (action-group g-object) + (func :pointer) + (data :pointer) + (destroy-notify :pointer)) + +(defun action-group-set-translate-func (action-group func) + (gtk-action-group-set-translate-func action-group + (callback gtk-translate-func-callback) + (allocate-stable-pointer func) + (callback stable-pointer-free-destroy-notify-callback))) + +(defcfun gtk-action-group-set-translation-domain :void + (action-group g-object) + (domain :string)) + +(defcfun (action-group-translate-string "gtk_action_group_translate_string") (:string :free-from-foreign nil) + (action-group g-object) + (string (:string :free-to-foreign nil))) + +(export 'action-group-translate-string) + +(defcfun (action-is-sensitive "gtk_action_is_sensitive") :boolean + (action g-object)) + +(export 'action-is-sensitive) + +(defcfun (action-is-visible "gtk_action_is_visible") :boolean + (action g-object)) + +(export 'action-is-visible) + +(defcfun (action-create-icon "gtk_action_create_icon") g-object + (action g-object) + (icon-size icon-size)) + +(export 'action-create-icon) + +(defcfun (action-create-menu-item "gtk_action_create_menu-item") g-object + (action g-object)) + +(export 'action-create-menu-item) + +(defcfun (action-create-tool-item "gtk_action_create_tool-item") g-object + (action g-object)) + +(export 'action-create-tool-item) + +(defcfun (action-create-menu "gtk_action_create_menu") g-object + (action g-object)) + +(export 'action-create-menu) + +(defcfun (action-connect-proxy "gtk_action_connect_proxy") :void + (action g-object) + (proxy g-object)) + +(export 'action-connect-proxy) + +(defcfun (action-disconnect-proxy "gtk_action_disconnect_proxy") :void + (action g-object) + (proxy g-object)) + +(export 'action-disconnect-proxy) + +(defcfun (action-proxies "gtk_action_get_proxies") (gslist g-object :free-from-foreign nil) + (action g-object)) + +(export 'action-proxies) + +(defcfun (action-connect-accelerator "gtk_action_connect_accelerator") :void + (action g-object)) + +(export 'action-connect-accelerator) + +(defcfun (action-disconnect-accelerator "gtk_action_disconnect_accelerator") :void + (action g-object)) + +(export 'action-disconnect-accelerator) + +(defcfun (action-block-activate-from "gtk_action_block_activate_from") :void + (action g-object) + (proxy g-object)) + +(export 'action-block-activate-from) + +(defcfun (action-unblock-activate-from "gtk_action_unblock_activate_from") :void + (action g-object) + (proxy g-object)) + +(export 'action-unblock-activate-from) \ No newline at end of file