generating.lisp

   1 (defpackage :gtk-generation
   2   (:use :cl :gobject :cffi :glib)
   3   (:export #:gtk-generate
   4            #:gtk-generate-child-properties))
   5
   6 (in-package :gtk-generation)
   7
   8 (load-foreign-library "libgtk-x11-2.0.so")
   9
  10 (defcfun gtk-init-check :boolean
  11   (argc (:pointer :int))
  12   (argv (:pointer (:pointer :string))))
  13
  14 (defun gtk-init ()
  15   (gtk-init-check (foreign-alloc :int :initial-element 0)
  16                   (foreign-alloc :string :initial-contents '("/usr/bin/sbcl")))
  17   #+nil(with-foreign-objects ((argc :int)
  18                          (argv '(:pointer :string) 1))
  19     (setf (mem-ref argc :int) 0
  20           (mem-ref argv '(:pointer :string)) (foreign-alloc :string :count 1
  21                                                             :initial-element "/usr/bin/sbcl"))
  22     (unwind-protect
  23          (unless (gtk-init-check argc argv)
  24            (error "Cannot initialize Gtk+"))
  25       (foreign-free (mem-ref argv '(:pointer :string))))))
  26
  27 (gtk-init)
  28
  29 (defcfun gtk-test-register-all-types :void)
  30
  31 (gtk-test-register-all-types)
  32
  33 (defun gtk-generate (filename)
  34   (with-open-file (stream filename :direction :output :if-exists :supersede)
  35     (generate-types-hierarchy-to-file
  36      stream
  37      "GtkObject"
  38      :include-referenced t
  39      :prefix "Gtk"
  40      :package (or (find-package :gtk) (make-package :gtk))
  41      :exceptions `(("GObject" gobject:g-object)
  42                    ("GtkObject" ,(intern "GTK-OBJECT" (find-package :gtk)))
  43                    ("GInitiallyUnowned" gobject::g-initially-unowned)
  44                    ("GtkWindow" ,(intern "GTK-WINDOW" (find-package :gtk)))
  45                    ("GtkUIManager" ,(intern "UI-MANAGER" (find-package :gtk)))
  46                    ("GtkUIManagerItemType" ,(intern "UI-MANAGER-ITEM-TYPE" (find-package :gtk))))
  47      :prologue (format nil "(in-package :gtk)")
  48      :interfaces '("GtkBuildable"
  49                    "GtkCellEditable"
  50                    "GtkCellLayout"
  51                    "GtkEditable"
  52                    "GtkFileChooser"
  53                    "GtkFileChooserEmbed"
  54                    "GtkTreeModel"
  55                    "GtkTreeDragSource"
  56                    "GtkTreeDragDest"
  57                    "GtkTreeSortable"
  58                    "GtkPrintOperationPreview"
  59                    "GtkRecentChooser"
  60                    "GtkToolShell"
  61                    "GtkOrientable"
  62                    "GtkActivatable"
  63                    "AtkImplementorIface")
  64      :objects '("GtkSettings" "GtkRcStyle" "GtkStyle" "GtkTooltip" "GtkAccelGroup"
  65                 "GtkAccelMap" "GtkAction" "GtkActionGroup" "GtkBuilder" "GtkClipboard"
  66                 "GtkEntryCompletion" "GtkIconFactory" "GtkIconTheme" "GtkIMContext"
  67                 "GtkListStore" "GtkPageSetup" "GtkPrintContext" "GtkPrintOperation"
  68                 "GtkPrintSettings" "GtkRecentManager" "GtkSizeGroup" "GtkStatusIcon"
  69                 "GtkTextBuffer" "GtkTextChildAnchor" "GtkTextMark" "GtkTextTag"
  70                 "GtkTextTagTable" "GtkTreeModelFilter" "GtkTreeModelSort"
  71                 "GtkTreeSelection" "GtkTreeStore" "GtkUIManager" "GtkWindowGroup"
  72                 "GtkToggleAction" "GtkRecentAction" "GtkRadioAction" "GtkItemFactory"
  73                 "GtkFileSelection" "GtkPageSetupUnixDialog" "GtkPrintUnixDialog")
  74      :flags '("GtkTextSearchFlags" "GtkAccelFlags" "GtkArgFlags" "GtkAttachOptions"
  75               "GtkButtonAction" "GtkCalendarDisplayOptions" "GtkCellRendererState"
  76               "GtkDebugFlag" "GtkDestDefaults" "GtkDialogFlags" "GtkFileFilterFlags"
  77               "GtkIconLookupFlags" "GtkObjectFlags" "GtkPrivateFlags" "GtkRcFlags"
  78               "GtkRecentFilterFlags" "GtkSignalRunType" "GtkTargetFlags"
  79               "GtkTreeModelFlags" "GtkUIManagerItemType" "GtkWidgetFlags")
  80      :enums '("GtkTextDirection" "GtkSizeGroupMode" "GtkUnit" "GtkPrintStatus"
  81               "GtkRecentSortType" "GtkFileChooserAction" "GtkCellRendererAccelMode"
  82               "GtkCellRendererMode" "GtkTreeViewColumnSizing"
  83               "GtkProgressBarOrientation" "GtkProgressBarStyle" "GtkUpdateType"
  84               "GtkMetricType" "GtkSpinButtonUpdatePolicy" "GtkCurveType" "GtkImageType"
  85               "GtkArrowType" "GtkSortType" "GtkToolbarStyle" "GtkWrapMode"
  86               "GtkJustification" "GtkButtonBoxStyle" "GtkSelectionMode"
  87               "GtkTreeViewGridLines" "GtkPackDirection" "GtkPolicyType" "GtkCornerType"
  88               "GtkSensitivityType" "GtkShadowType" "GtkIconSize" "GtkOrientation"
  89               "GtkPositionType" "GtkReliefStyle" "GtkMessageType" "GtkButtonsType"
  90               "GtkWindowType" "GtkWindowPosition" "GtkResizeMode"
  91               "GtkTextBufferTargetInfo" "GtkStateType" "GtkDirectionType"
  92               "GtkDragResult" "GtkWidgetHelpType" "GtkPackType" "GtkNotebookTab"
  93               "GtkMovementStep" "GtkAnchorType" "GtkAssistantPageType"
  94               "GtkBuilderError" "GtkCellType" "GtkCListDragPos" "GtkCTreeExpanderStyle"
  95               "GtkCTreeExpansionType" "GtkCTreeLineStyle" "GtkCTreePos" "GtkDeleteType"
  96               "GtkExpanderStyle" "GtkFileChooserConfirmation" "GtkFileChooserError"
  97               "GtkIconThemeError" "GtkIconViewDropPosition" "GtkIMPreeditStyle"
  98               "GtkIMStatusStyle" "GtkMatchType" "GtkMenuDirectionType"
  99               "GtkNumberUpLayout" "GtkPageOrientation" "GtkPageSet"
 100               "GtkPathPriorityType" "GtkPathType" "GtkPreviewType" "GtkPrintDuplex"
 101               "GtkPrintError" "GtkPrintOperationAction" "GtkPrintOperationResult"
 102               "GtkPrintPages" "GtkPrintQuality" "GtkRcTokenType"
 103               "GtkRecentChooserError" "GtkRecentManagerError" "GtkResponseType"
 104               "GtkScrollStep" "GtkScrollType" "GtkSideType" "GtkSpinType"
 105               "GtkSubmenuDirection" "GtkSubmenuPlacement" "GtkTextWindowType"
 106               "GtkToolbarChildType" "GtkToolbarSpaceStyle" "GtkTreeViewDropPosition"
 107               "GtkTreeViewMode" "GtkVisibility" "GtkEntryIconPosition")
 108      :exclusions '("PangoStretch" "PangoVariant" "PangoStyle" "PangoUnderline" "GtkGLDrawingArea")
 109      :additional-properties
 110      '(("GtkWindow"
 111         (:cffi gtk::focus gtk::gtk-window-focus (g-object gtk::widget)
 112          "gtk_window_get_focus" "gtk_window_set_focus")
 113         (:cffi gtk::default-widget gtk::gtk-window-default-widget (g-object gtk::widget)
 114          "gtk_window_get_default_widget" "gtk_window_set_default")
 115         (:cffi gtk::has-frame gtk::gtk-window-has-frame :boolean
 116          "gtk_window_get_has_frame" "gtk_window_set_has_frame")
 117         (:cffi gtk::mnemonic-modifier gtk::gtk-window-mnemonic-modifier (g-object gdk::modifier-type)
 118          "gtk_window_get_mnemonic_modifier" "gtk_window_set_mnemonic_modifier")
 119         (:cffi gtk::icon-list gtk::gtk-window-icon-list (glist gtk::pixbuf :free-from-foreign t :free-to-foreign t)
 120          "gtk_window_get_icon_list" "gtk_window_set_icon_list")
 121         (:cffi gtk::group gtk::gtk-window-group (g-object gtk::window-group)
 122          "gtk_window_get_group" nil))
 123        ("GtkTreeViewColumn"
 124         (:cffi gtk::tree-view gtk::tree-view-column-tree-view g-object
 125          "gtk_tree_view_column_get_tree_view" nil)
 126         (:cffi gtk::sort-column-id gtk::tree-view-column-sort-column-id :int
 127          "gtk_tree_view_column_get_sort_column_id" "gtk_tree_view_column_set_sort_column_id")
 128         (:cffi gtk::cell-renderers gtk::tree-view-column-cell-renderers (glist g-object  :free-from-foreign t)
 129          "gtk_tree_view_column_get_cell_renderers" nil))
 130        ("GtkTreeSelection"
 131         (:cffi gtk::mode gtk::tree-selection-mode gtk::selection-mode
 132          "gtk_tree_selection_get_mode" "gtk_tree_selection_set_mode")
 133         (:cffi gtk::select-function gtk::tree-selection-select-function nil
 134          gtk::tree-selection-get-selection-function gtk::tree-selection-set-select-function))
 135        ("GtkTreeView"
 136         (:cffi gtk::selection gtk::tree-view-selection g-object
 137          "gtk_tree_view_get_selection" nil)
 138         (:cffi gtk::column-drag-function gtk::tree-view-column-drag-function nil
 139          nil gtk::tree-view-set-column-drag-function)
 140         (:cffi gtk::bin-window gtk::tree-view-bin-window g-object
 141          "gtk_tree_view_get_bin_window" nil)
 142         (:cffi gtk::search-equal-func gtk::tree-view-search-equal-func nil
 143          nil gtk::tree-view-set-search-equal-func)
 144         (:cffi gtk::search-entry gtk::tree-view-search-entry g-object
 145          "gtk_tree_view_get_search_entry" "gtk_tree_view_set_search_entry")
 146         (:cffi gtk::search-position-func gtk::tree-view-search-position-func nil
 147          nil gtk::tree-view-set-search-position-func)
 148         (:cffi gtk::row-separator-func gtk::tree-view-row-separator-func nil
 149          nil gtk::tree-view-set-row-separartor-func))
 150        ("GtkCellView"
 151         (:cffi gtk::displayed-row gtk::cell-view-displayed-row (g-boxed-foreign gtk::tree-path)
 152          "gtk_cell_view_get_displayed_row" "gtk_cell_view_set_displayed_row"))
 153        ("GtkComboBox"
 154         (:cffi gtk::active-iter gtk::combo-box-active-iter (g-boxed-foreign gtk::tree-iter)
 155          gtk::combo-box-get-active-iter "gtk_combo_box_set_active_iter")
 156         (:cffi gtk::row-separator-func gtk::combo-box-separator-func nil
 157          nil gtk::combo-box-set-separator-func))
 158        ("GtkMenu"
 159         (:cffi gtk::screen gtk::menu-screen g-object
 160          nil "gtk_menu_set_screen"))
 161        ("GtkToolItem"
 162         (:cffi gtk::expand gtk::tool-item-expand :boolean
 163          "gtk_tool_item_get_expand" "gtk_tool_item_set_expand")
 164         (:cffi gtk::use-drag-window gtk::tool-item-use-drag-window :boolean
 165          "gtk_tool_item_get_use_drag_window" "gtk_tool_item_set_use_drag_window")
 166         (:cffi gtk::icon-size gtk::tool-item-icon-size gtk::icon-size
 167          "gtk_tool_item_get_icon_size" nil)
 168         (:cffi gtk::orientation gtk::tool-item-orientation gtk::orientation
 169          "gtk_tool_item_get_orientation" nil)
 170         (:cffi gtk::toolbar-style gtk::tool-item-toolbar-style gtk::toolbar-style
 171          "gtk_tool_item_get_toolbar_style" nil)
 172         (:cffi gtk::relief-style gtk::tool-item-relief-style gtk::relief-style
 173          "gtk_tool_item_get_relief_style" nil))
 174        ("GtkMenuToolButton"
 175         (:cffi gtk::arrow-tooltip-text gtk::menu-tool-button-arrow-tooltip-text :string
 176          nil "gtk_menu_tool_button_set_arrow_tooltip_text")
 177         (:cffi gtk::arrow-tooltip-markup gtk::menu-tool-button-arrow-tooltip-markup :string
 178          nil "gtk_menu_tool_button_set_arrow_tooltip_markup"))
 179        ("GtkUIManager"
 180         (:cffi gtk::accel-group gtk::ui-manager-accel-group g-object
 181          "gtk_ui_manager_get_accel_group" nil))
 182        ("GtkActionGroup"
 183         (:cffi gtk::translate-function gtk::action-group-translate-function nil
 184          nil gtk::action-group-set-translate-func)
 185         (:cffi gtk::translation-domain gtk::action-group-translation-domain nil
 186          nil gtk::gtk-action-group-set-translation-domain))
 187        ("GtkAction"
 188         (:cffi gtk::accel-path gtk::action-accel-path (:string :free-from-foreign nil :free-to-foreign t)
 189          "gtk_action_get_accel_path" "gtk_action_set_accel_path")
 190         (:cffi gtk::accel-group gtk::action-accel-group g-object
 191          nil "gtk_action_set_accel_group"))
 192        ("GtkFileChooser"
 193         (:cffi gtk::current-name gtk::file-chooser-current-name (:string :free-to-foreign t :encoding :utf-8)
 194          nil "gtk_file_chooser_set_current_name")
 195         (:cffi gtk::filename gtk::file-chooser-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
 196          "gtk_file_chooser_get_filename" "gtk_file_chooser_set_filename")
 197         (:cffi gtk::current-folder gtk::file-chooser-current-folder (glib:g-string :free-from-foreign t :free-to-foreign t)
 198          "gtk_file_chooser_get_current_folder" "gtk_file_chooser_set_current_folder")
 199         (:cffi gtk::uri gtk::file-chooser-uri (glib:g-string :free-from-foreign t :free-to-foreign t)
 200          "gtk_file_chooser_get_uri" "gtk_file_chooser_set_uri")
 201         (:cffi gtk::current-folder-uri gtk::file-chooser-current-folder-uri (glib:g-string :free-from-foreign t :free-to-foreign t)
 202          "gtk_file_chooser_get_current_folder_uri" "gtk_file_chooser_set_current_folder_uri")
 203         (:cffi gtk::preview-filename gtk::file-chooser-preview-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
 204          "gtk_file_chooser_get_preview_filename" nil)
 205         (:cffi gtk::preview-uri gtk::file-chooser-preview-uri (glib:g-string :free-from-foreign t :free-to-foreign t)
 206          "gtk_file_chooser_get_preview_uri" nil))
 207        ("GtkFileFilter"
 208         (:cffi gtk::name gtk::file-filter-name :string
 209          "gtk_file_filter_get_name" "gtk_file_filter_set_name"))
 210        ("GtkFontSelectionDialog"
 211         (:cffi gtk::font-name gtk::font-selection-dialog-font-name (glib:g-string :free-from-foreign t :free-to-foreign t)
 212          "gtk_font_selection_dialog_get_font_name" "gtk_font_selection_dialog_set_font_name")
 213         (:cffi gtk::preview-text gtk::font-selection-dialog-preview-text :string
 214          "gtk_font_selection_dialog_get_preview_text" "gtk_font_selection_dialog_set_preview_text")
 215         (:cffi gtk::apply-button gtk::font-selection-dialog-apply-button g-object
 216          "gtk_font_selection_dialog_get_apply_button" nil)
 217         (:cffi gtk::cancel-button gtk::font-selection-dialog-cancel-button g-object
 218          "gtk_font_selection_dialog_get_cancel_button" nil)
 219         (:cffi gtk::ok-button gtk::font-selection-dialog-ok-button g-object
 220          "gtk_font_selection_dialog_get_ok_button" nil))
 221        ("GtkFixed"
 222         (:cffi gtk::has-window gtk::fixed-has-window :boolean
 223          "gtk_fixed_get_has_window" "gtk_fixed_set_has_window"))
 224        ("GtkLayout"
 225         (:cffi gtk::bin-window gtk::layout-bin-window g-object
 226          "gtk_layout_get_bin_window" nil))
 227        ("GtkCalendar"
 228         (:cffi gtk::detail-function gtk::calendar-detail-function nil
 229          nil gtk::calendar-set-detail-function))
 230        ("GtkContainer"
 231         (:cffi gtk::focus-child gtk::container-focus-child g-object
 232          "gtk_container_get_focus_child" "gtk_container_set_focus_child")
 233         (:cffi gtk::focus-vadjustment gtk::container-focus-vadjustment g-object
 234          "gtk_container_get_focus_vadjustment" "gtk_container_set_focus_vadjustment")
 235         (:cffi gtk::focus-hadjustment gtk::container-focus-hadjustment g-object
 236          "gtk_container_get_focus_hadjustment" "gtk_container_set_focus_hadjustment"))
 237        ("GtkWidget"
 238         (:cffi gtk::parent-window gtk::widget-parent-window (g-object gdk::gdk-window)
 239          "gtk_widget_get_parent_window" "gtk_widget_set_parent_window")
 240         (:cffi gtk::toplevel gtk::widget-toplevel (g-object gtk::widget)
 241          "gtk_widget_get_toplevel" nil)
 242         (:cffi gtk::colormap gtk::widget-colormap (g-object gdk::gdk-colormap)
 243          "gtk_widget_get_colormap" "gtk_widget_set_colormap")
 244         (:cffi gtk::visual gtk::widget-visual (g-object gdk::visual)
 245          "gtk_widget_get_visual" nil)
 246         (:cffi gtk::modifier-style gtk::widget-modifier-style (g-object gtk::rc-style)
 247          "gtk_widget_get_modifier_style" "gtk_widget_modify_style")
 248         (:cffi gtk::pango-context gtk::widget-pango-context g-object
 249          "gtk_widget_get_pango_context" nil)
 250         (:cffi gtk::child-visible gtk::widget-child-visible :boolean
 251          "gtk_widget_get_child_visible" "gtk_widget_set_child_visible")
 252         (:cffi gtk::direction gtk::widget-direction gtk::text-direction
 253          "gtk_widget_get_direction" "gtk_widget_set_direction")
 254         (:cffi gtk::composite-name gtk::widget-composite-name (glib:g-string :free-from-foreign t :free-to-foreign t)
 255          "gtk_widget_get_composite_name" "gtk_widget_set_composite_name")
 256         (:cffi gtk::redraw-on-allocate gtk::widget-redraw-on-allocate :boolean
 257          nil "gtk_widget_set_redraw_on_allocate")
 258         (:cffi gtk::accessible gtk::widget-accessible g-object
 259          "gtk_widget_get_accessible" nil)
 260         (:cffi gtk::tooltip-window gtk::widget-tooltip-window g-object
 261          "gtk_widget_get_tooltip_window" "gtk_widget_set_tooltip_window"))
 262        ("GtkWindowGroup"
 263         (:cffi gtk::windows gtk::window-group-windows (glist (g-object gtk::gtk-window))
 264          "gtk_window_group_list_windows" nil))
 265        ("GtkTextTag"
 266         (:cffi gtk::priority gtk::text-tag-priority :int
 267          "gtk_text_tag_get_priority" "gtk_text_tag_set_priority"))
 268        ("GtkDialog"
 269         (:cffi gtk::content-area gtk::dialog-content-area (g-object gtk::v-box)
 270          "gtk_dialog_get_content_area" nil)
 271         (:cffi gtk::action-area gtk::dialog-action-area (g-object gtk::widget)
 272          "gtk_dialog_get_action_area" nil)
 273         (:cffi gtk::default-response gtk::dialog-default-response gtk::response-type
 274          nil "gtk_dialog_set_default_response"))
 275        ("GtkAssistant"
 276         (:cffi gtk::current-page gtk::assistant-current-page :int
 277          "gtk_assistant_get_current_page" "gtk_assistant_set_current_page")
 278         (:cffi gtk::n-pages gtk::assistant-n-pages :int
 279          "gtk_assistant_get_n_pages" nil)
 280         (:cffi gtk::forward-page-function gtk::assistant-forward-page-function nil
 281          nil gtk::set-assistant-forward-page-function))
 282        ("GtkLabel"
 283         (:cffi gtk::line-wrap gtk::label-line-wrap :boolean
 284          "gtk_label_get_line_wrap" "gtk_label_set_line_wrap")
 285         (:cffi gtk::line-wrap-mode gtk::label-line-wrap-mode gtk::pango-wrap-mode
 286          "gtk_label_get_line_wrap_mode" "gtk_label_set_line_wrap_mode")
 287         (:cffi gtk::layout gtk::label-layout g-object
 288          "gtk_label_get_layout" nil)
 289         (:cffi gtk::selection-bounds gtk::label-selection-bounds nil
 290          gtk::gtk-label-get-selection-bounds nil)
 291         (:cffi gtk::layout-offsets gtk::label-layout-offsets nil
 292          gtk::gtk-label-get-layout-offsets nil))
 293        ("GtkEntry"
 294         (:cffi gtk::layout gtk::entry-layout g-object
 295          "gtk_entry_get_layout" nil)
 296         (:cffi gtk::completion gtk::entry-completion (g-object gtk::entry-completion)
 297          "gtk_entry_get_completion" "gtk_entry_set_completion")
 298         (:cffi gtk::cursor-hadjustment gtk::entry-cursor-hadjustment (g-object gtk::adjustment)
 299          "gtk_entry_get_cursor_hadjustment" "gtk_entry_set_cursor_hadjustment")
 300         (:cffi gtk::layout-offset gtk::entry-layout-offset nil
 301          gtk::gtk-entry-layout-offset nil))
 302        ("GtkPageSetupUnixDialog"
 303         (:cffi gtk::page-setup gtk::page-setup-unix-dialog-page-setup (g-object gtk::page-setup)
 304          "gtk_page_setup_unix_dialog_get_page_setup" "gtk_page_setup_unix_dialog_set_page_setup")
 305         (:cffi gtk::print-settings gtk::page-setup-unix-dialog-print-settings (g-object gtk::print-settings)
 306          "gtk_page_setup_unix_dialog_get_print_settings" "gtk_page_setup_unix_dialog_set_print_settings"))
 307        ("GtkEntryCompletion"
 308         (:cffi gtk::entry gtk::entry-completion-entry (g-object gtk::entry)
 309          "gtk_entry_completion_get_entry" nil)
 310         (:cffi gtk::match-function gtk::entry-completion-match-function nil
 311          nil gtk::gtk-entry-completion-set-match-function))))))
 312
 313 (defun gtk-generate-child-properties (filename)
 314   (with-open-file (stream filename :direction :output :if-exists :supersede)
 315     (let ((*package* (find-package :gtk))
 316           (*print-case* :downcase))
 317      (write-string "(in-package :gtk)" stream)
 318      (terpri stream)
 319      (format stream "~{~S~%~%~}" (gtk:generate-child-properties)))))