: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"
"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"
(: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
(:file "gtk.cell-renderer")
(:file "gtk.combo-box")
(:file "gtk.menu")
+ (:file "gtk.ui-manager")
(:file "gtk.dialog.example")
(defpackage :gtk-demo
- (:use :cl :gtk :gdk :gobject)
+ (:use :cl :gtk :gdk :gobject :anaphora :iter)
(:export #:test
#:test-entry
#:table-packing
#:demo-code-editor
#:test-treeview-list
#:test-combobox
- #:test-toolbar))
+ #:test-toolbar
+ #:test-color-button
+ #:test-ui-manager))
(in-package :gtk-demo)
(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
+ "
+<ui>
+ <toolbar action='toolbar1'>
+ <separator/>
+ <toolitem name='Left' action='justify-left'/>
+ <toolitem name='Center' action='justify-center'/>
+ <toolitem name='Right' action='justify-right'/>
+ <toolitem name='Zoom in' action='zoom-in' />
+ <toolitem name='print-confirm' action='print-confirm' />
+ <separator/>
+ </toolbar>
+</ui>")
+ (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
(: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))
"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))
(: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)
(: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))
(: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))
(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
"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
(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))
(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
((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
: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)))
+
--- /dev/null
+(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
projects / cl-gtk2.git / commitdiff