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      :flags '("GtkTextSearchFlags" "GtkAccelFlags" "GtkArgFlags" "GtkAttachOptions"
  74               "GtkButtonAction" "GtkCalendarDisplayOptions" "GtkCellRendererState"
  75               "GtkDebugFlag" "GtkDestDefaults" "GtkDialogFlags" "GtkFileFilterFlags"
  76               "GtkIconLookupFlags" "GtkObjectFlags" "GtkPrivateFlags" "GtkRcFlags"
  77               "GtkRecentFilterFlags" "GtkSignalRunType" "GtkTargetFlags"
  78               "GtkTreeModelFlags" "GtkUIManagerItemType" "GtkWidgetFlags")
  79      :enums '("GtkTextDirection" "GtkSizeGroupMode" "GtkUnit" "GtkPrintStatus"
  80               "GtkRecentSortType" "GtkFileChooserAction" "GtkCellRendererAccelMode"
  81               "GtkCellRendererMode" "GtkTreeViewColumnSizing"
  82               "GtkProgressBarOrientation" "GtkProgressBarStyle" "GtkUpdateType"
  83               "GtkMetricType" "GtkSpinButtonUpdatePolicy" "GtkCurveType" "GtkImageType"
  84               "GtkArrowType" "GtkSortType" "GtkToolbarStyle" "GtkWrapMode"
  85               "GtkJustification" "GtkButtonBoxStyle" "GtkSelectionMode"
  86               "GtkTreeViewGridLines" "GtkPackDirection" "GtkPolicyType" "GtkCornerType"
  87               "GtkSensitivityType" "GtkShadowType" "GtkIconSize" "GtkOrientation"
  88               "GtkPositionType" "GtkReliefStyle" "GtkMessageType" "GtkButtonsType"
  89               "GtkWindowType" "GtkWindowPosition" "GtkResizeMode"
  90               "GtkTextBufferTargetInfo" "GtkStateType" "GtkDirectionType"
  91               "GtkDragResult" "GtkWidgetHelpType" "GtkPackType" "GtkNotebookTab"
  92               "GtkMovementStep" "GtkAnchorType" "GtkAssistantPageType"
  93               "GtkBuilderError" "GtkCellType" "GtkCListDragPos" "GtkCTreeExpanderStyle"
  94               "GtkCTreeExpansionType" "GtkCTreeLineStyle" "GtkCTreePos" "GtkDeleteType"
  95               "GtkExpanderStyle" "GtkFileChooserConfirmation" "GtkFileChooserError"
  96               "GtkIconThemeError" "GtkIconViewDropPosition" "GtkIMPreeditStyle"
  97               "GtkIMStatusStyle" "GtkMatchType" "GtkMenuDirectionType"
  98               "GtkNumberUpLayout" "GtkPageOrientation" "GtkPageSet"
  99               "GtkPathPriorityType" "GtkPathType" "GtkPreviewType" "GtkPrintDuplex"
 100               "GtkPrintError" "GtkPrintOperationAction" "GtkPrintOperationResult"
 101               "GtkPrintPages" "GtkPrintQuality" "GtkRcTokenType"
 102               "GtkRecentChooserError" "GtkRecentManagerError" "GtkResponseType"
 103               "GtkScrollStep" "GtkScrollType" "GtkSideType" "GtkSpinType"
 104               "GtkSubmenuDirection" "GtkSubmenuPlacement" "GtkTextWindowType"
 105               "GtkToolbarChildType" "GtkToolbarSpaceStyle" "GtkTreeViewDropPosition"
 106               "GtkTreeViewMode" "GtkVisibility")
 107      :exclusions '("PangoStretch" "PangoVariant" "PangoStyle" "PangoUnderline" "GtkGLDrawingArea")
 108      :additional-properties
 109      '(("GtkTreeViewColumn"
 110         (:cffi gtk::tree-view gtk::tree-view-column-tree-view g-object "gtk_tree_view_column_get_tree_view" nil)
 111         (:cffi gtk::sort-column-id gtk::tree-view-column-sort-column-id :int "gtk_tree_view_column_get_sort_column_id" "gtk_tree_view_column_set_sort_column_id")
 112         (:cffi gtk::cell-renderers gtk::tree-view-column-cell-renderers (glist g-object  :free-from-foreign t) "gtk_tree_view_column_get_cell_renderers" nil))
 113        ("GtkTreeSelection"
 114         (:cffi gtk::mode gtk::tree-selection-mode gtk::selection-mode "gtk_tree_selection_get_mode" "gtk_tree_selection_set_mode")
 115         (:cffi gtk::select-function gtk::tree-selection-select-function nil gtk::tree-selection-get-selection-function gtk::tree-selection-set-select-function))
 116        ("GtkTreeView"
 117         (:cffi gtk::selection gtk::tree-view-selection g-object "gtk_tree_view_get_selection" nil)
 118         (:cffi gtk::column-drag-function gtk::tree-view-column-drag-function nil nil gtk::tree-view-set-column-drag-function)
 119         (:cffi gtk::bin-window gtk::tree-view-bin-window g-object "gtk_tree_view_get_bin_window" nil)
 120         (:cffi gtk::search-equal-func gtk::tree-view-search-equal-func nil nil gtk::tree-view-set-search-equal-func)
 121         (:cffi gtk::search-entry gtk::tree-view-search-entry g-object "gtk_tree_view_get_search_entry" "gtk_tree_view_set_search_entry")
 122         (:cffi gtk::search-position-func gtk::tree-view-search-position-func nil nil gtk::tree-view-set-search-position-func)
 123         (:cffi gtk::row-separator-func gtk::tree-view-row-separator-func nil nil gtk::tree-view-set-row-separartor-func))
 124        ("GtkCellView"
 125         (:cffi gtk::displayed-row gtk::cell-view-displayed-row (g-boxed-foreign gtk::tree-path) "gtk_cell_view_get_displayed_row" "gtk_cell_view_set_displayed_row"))
 126        ("GtkComboBox"
 127         (:cffi gtk::active-iter gtk::combo-box-active-iter (g-boxed-foreign gtk::tree-iter) gtk::combo-box-get-active-iter "gtk_combo_box_set_active_iter")
 128         (:cffi gtk::row-separator-func gtk::combo-box-separator-func nil nil gtk::combo-box-set-separator-func))
 129        ("GtkMenu"
 130         (:cffi gtk::screen gtk::menu-screen g-object nil "gtk_menu_set_screen"))
 131        ("GtkToolItem"
 132         (:cffi gtk::expand gtk::tool-item-expand :boolean "gtk_tool_item_get_expand" "gtk_tool_item_set_expand")
 133         (:cffi gtk::use-drag-window gtk::tool-item-use-drag-window :boolean "gtk_tool_item_get_use_drag_window" "gtk_tool_item_set_use_drag_window")
 134         (:cffi gtk::icon-size gtk::tool-item-icon-size gtk::icon-size "gtk_tool_item_get_icon_size" nil)
 135         (:cffi gtk::orientation gtk::tool-item-orientation gtk::orientation "gtk_tool_item_get_orientation" nil)
 136         (:cffi gtk::toolbar-style gtk::tool-item-toolbar-style gtk::toolbar-style "gtk_tool_item_get_toolbar_style" nil)
 137         (:cffi gtk::relief-style gtk::tool-item-relief-style gtk::relief-style "gtk_tool_item_get_relief_style" nil))
 138        ("GtkMenuToolButton"
 139         (:cffi gtk::arrow-tooltip-text gtk::menu-tool-button-arrow-tooltip-text :string nil "gtk_menu_tool_button_set_arrow_tooltip_text")
 140         (:cffi gtk::arrow-tooltip-markup gtk::menu-tool-button-arrow-tooltip-markup :string nil "gtk_menu_tool_button_set_arrow_tooltip_markup"))
 141        ("GtkUIManager"
 142         (:cffi gtk::accel-group gtk::ui-manager-accel-group g-object "gtk_ui_manager_get_accel_group" nil))
 143        ("GtkActionGroup"
 144         (:cffi gtk::translate-function gtk::action-group-translate-function nil nil gtk::action-group-set-translate-func)
 145         (:cffi gtk::translation-domain gtk::action-group-translation-domain nil nil gtk::gtk-action-group-set-translation-domain))
 146        ("GtkAction"
 147         (: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")
 148         (:cffi gtk::accel-group gtk::action-accel-group g-object nil "gtk_action_set_accel_group"))
 149        ("GtkFileChooser"
 150         (:cffi gtk::current-name gtk::file-chooser-current-name (:string :free-to-foreign t :encoding :utf-8) nil "gtk_file_chooser_set_current_name")
 151         (:cffi gtk::filename gtk::file-chooser-filename (glib:g-string :free-from-foreign t :free-to-foreign t) "gtk_file_chooser_get_filename" "gtk_file_chooser_set_filename")
 152         (:cffi gtk::current-folder gtk::file-chooser-current-folder (glib:g-string :free-from-foreign t :free-to-foreign t) "gtk_file_chooser_get_current_folder" "gtk_file_chooser_set_current_folder")
 153         (:cffi gtk::uri gtk::file-chooser-uri (glib:g-string :free-from-foreign t :free-to-foreign t) "gtk_file_chooser_get_uri" "gtk_file_chooser_set_uri")
 154         (:cffi gtk::current-folder-uri gtk::file-chooser-current-folder-uri (glib:g-string :free-from-foreign t :free-to-foreign t) "gtk_file_chooser_get_current_folder_uri" "gtk_file_chooser_set_current_folder_uri")
 155         (:cffi gtk::preview-filename gtk::file-chooser-preview-filename (glib:g-string :free-from-foreign t :free-to-foreign t) "gtk_file_chooser_get_preview_filename" nil)
 156         (:cffi gtk::preview-uri gtk::file-chooser-preview-uri (glib:g-string :free-from-foreign t :free-to-foreign t) "gtk_file_chooser_get_preview_uri" nil))
 157        ("GtkFileFilter"
 158         (:cffi gtk::name gtk::file-filter-name :string "gtk_file_filter_get_name" "gtk_file_filter_set_name"))
 159        ("GtkFontSelectionDialog"
 160         (:cffi gtk::font-name gtk::font-selection-dialog-font-name (glib:g-string :free-from-foreign t :free-to-foreign t) "gtk_font_selection_dialog_get_font_name" "gtk_font_selection_dialog_set_font_name")
 161         (:cffi gtk::preview-text gtk::font-selection-dialog-preview-text :string "gtk_font_selection_dialog_get_preview_text" "gtk_font_selection_dialog_set_preview_text")
 162         (:cffi gtk::apply-button gtk::font-selection-dialog-apply-button g-object "gtk_font_selection_dialog_get_apply_button" nil)
 163         (:cffi gtk::cancel-button gtk::font-selection-dialog-cancel-button g-object "gtk_font_selection_dialog_get_cancel_button" nil)
 164         (:cffi gtk::ok-button gtk::font-selection-dialog-ok-button g-object "gtk_font_selection_dialog_get_ok_button" nil))
 165        ("GtkFixed"
 166         (:cffi gtk::has-window gtk::fixed-has-window :boolean "gtk_fixed_get_has_window" "gtk_fixed_set_has_window"))
 167        ("GtkLayout"
 168         (:cffi gtk::bin-window gtk::layout-bin-window g-object "gtk_layout_get_bin_window" nil))
 169        ("GtkCalendar"
 170         (:cffi gtk::detail-function gtk::calendar-detail-function nil nil gtk::calendar-set-detail-function))
 171        ("GtkContainer"
 172         (:cffi gtk::focus-child gtk::container-focus-child g-object "gtk_container_get_focus_child" "gtk_container_set_focus_child")
 173         (:cffi gtk::focus-vadjustment gtk::container-focus-vadjustment g-object "gtk_container_get_focus_vadjustment" "gtk_container_set_focus_vadjustment")
 174         (:cffi gtk::focus-hadjustment gtk::container-focus-hadjustment g-object "gtk_container_get_focus_hadjustment" "gtk_container_set_focus_hadjustment"))
 175        ("GtkWidget"
 176         (:cffi gtk::direction gtk::widget-direction gtk::text-direction "gtk_widget_get_direction" "gtk_widget_set_direction")
 177         (:cffi gtk::composite-name gtk::widget-composite-name (glib:g-string :free-from-foreign t :free-to-foreign t) "gtk_widget_get_composite_name" "gtk_widget_set_composite_name")
 178         (:cffi gtk::redraw-on-allocate gtk::widget-redraw-on-allocate :boolean nil "gtk_widget_set_redraw_on_allocate")
 179         (:cffi gtk::accessible gtk::widget-accessible g-object "gtk_widget_get_accessible" nil)
 180         (:cffi gtk::tooltip-window gtk::widget-tooltip-window g-object "gtk_widget_get_tooltip_window" "gtk_widget_set_tooltip_window"))
 181        ("GtkWindow"
 182         (:cffi gtk::default-widget gtk::window-default-widget (g-object gtk::widget) "gtk_window_get_default_widget" "gtk_window_set_default")
 183         (:cffi gtk::focus gtk::window-focus (g-object gtk::widget) "gtk_window_get_focus" "gtk_window_set_focus"))
 184        ("GtkWindowGroup"
 185         (:cffi gtk::windows gtk::window-group-windows (glist (g-object gtk::window)) "gtk_window_group_list_windows" nil))
 186        ("GtkTextTag"
 187         (:cffi gtk::priority gtk::text-tag-priority :int "gtk_text_tag_get_priority" "gtk_text_tag_set_priority"))
 188        ("GtkDialog"
 189         (:cffi gtk::content-area gtk::dialog-content-area (g-object gtk::v-box) "gtk_dialog_get_content_area" nil)
 190         (:cffi gtk::action-area gtk::dialog-action-area (g-object gtk::widget) "gtk_dialog_get_action_area" nil)
 191         (:cffi gtk::default-response gtk::dialog-default-response gtk::response-type nil "gtk_dialog_set_default_response"))))))
 192
 193 (defun gtk-generate-child-properties (filename)
 194   (with-open-file (stream filename :direction :output :if-exists :supersede)
 195     (let ((*package* (find-package :gtk))
 196           (*print-case* :downcase))
 197      (write-string "(in-package :gtk)" stream)
 198      (terpri stream)
 199      (format stream "~{~S~%~%~}" (gtk:generate-child-properties)))))