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" "GtkEntryIconPosition")
 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
 112          "gtk_tree_view_column_get_sort_column_id" "gtk_tree_view_column_set_sort_column_id")
 113         (:cffi gtk::cell-renderers gtk::tree-view-column-cell-renderers (glist g-object  :free-from-foreign t)
 114          "gtk_tree_view_column_get_cell_renderers" nil))
 115        ("GtkTreeSelection"
 116         (:cffi gtk::mode gtk::tree-selection-mode gtk::selection-mode
 117          "gtk_tree_selection_get_mode" "gtk_tree_selection_set_mode")
 118         (:cffi gtk::select-function gtk::tree-selection-select-function nil
 119          gtk::tree-selection-get-selection-function gtk::tree-selection-set-select-function))
 120        ("GtkTreeView"
 121         (:cffi gtk::selection gtk::tree-view-selection g-object
 122          "gtk_tree_view_get_selection" nil)
 123         (:cffi gtk::column-drag-function gtk::tree-view-column-drag-function nil
 124          nil gtk::tree-view-set-column-drag-function)
 125         (:cffi gtk::bin-window gtk::tree-view-bin-window g-object
 126          "gtk_tree_view_get_bin_window" nil)
 127         (:cffi gtk::search-equal-func gtk::tree-view-search-equal-func nil
 128          nil gtk::tree-view-set-search-equal-func)
 129         (:cffi gtk::search-entry gtk::tree-view-search-entry g-object
 130          "gtk_tree_view_get_search_entry" "gtk_tree_view_set_search_entry")
 131         (:cffi gtk::search-position-func gtk::tree-view-search-position-func nil
 132          nil gtk::tree-view-set-search-position-func)
 133         (:cffi gtk::row-separator-func gtk::tree-view-row-separator-func nil
 134          nil gtk::tree-view-set-row-separartor-func))
 135        ("GtkCellView"
 136         (:cffi gtk::displayed-row gtk::cell-view-displayed-row (g-boxed-foreign gtk::tree-path)
 137          "gtk_cell_view_get_displayed_row" "gtk_cell_view_set_displayed_row"))
 138        ("GtkComboBox"
 139         (:cffi gtk::active-iter gtk::combo-box-active-iter (g-boxed-foreign gtk::tree-iter)
 140          gtk::combo-box-get-active-iter "gtk_combo_box_set_active_iter")
 141         (:cffi gtk::row-separator-func gtk::combo-box-separator-func nil
 142          nil gtk::combo-box-set-separator-func))
 143        ("GtkMenu"
 144         (:cffi gtk::screen gtk::menu-screen g-object
 145          nil "gtk_menu_set_screen"))
 146        ("GtkToolItem"
 147         (:cffi gtk::expand gtk::tool-item-expand :boolean
 148          "gtk_tool_item_get_expand" "gtk_tool_item_set_expand")
 149         (:cffi gtk::use-drag-window gtk::tool-item-use-drag-window :boolean
 150          "gtk_tool_item_get_use_drag_window" "gtk_tool_item_set_use_drag_window")
 151         (:cffi gtk::icon-size gtk::tool-item-icon-size gtk::icon-size
 152          "gtk_tool_item_get_icon_size" nil)
 153         (:cffi gtk::orientation gtk::tool-item-orientation gtk::orientation
 154          "gtk_tool_item_get_orientation" nil)
 155         (:cffi gtk::toolbar-style gtk::tool-item-toolbar-style gtk::toolbar-style
 156          "gtk_tool_item_get_toolbar_style" nil)
 157         (:cffi gtk::relief-style gtk::tool-item-relief-style gtk::relief-style
 158          "gtk_tool_item_get_relief_style" nil))
 159        ("GtkMenuToolButton"
 160         (:cffi gtk::arrow-tooltip-text gtk::menu-tool-button-arrow-tooltip-text :string
 161          nil "gtk_menu_tool_button_set_arrow_tooltip_text")
 162         (:cffi gtk::arrow-tooltip-markup gtk::menu-tool-button-arrow-tooltip-markup :string
 163          nil "gtk_menu_tool_button_set_arrow_tooltip_markup"))
 164        ("GtkUIManager"
 165         (:cffi gtk::accel-group gtk::ui-manager-accel-group g-object
 166          "gtk_ui_manager_get_accel_group" nil))
 167        ("GtkActionGroup"
 168         (:cffi gtk::translate-function gtk::action-group-translate-function nil
 169          nil gtk::action-group-set-translate-func)
 170         (:cffi gtk::translation-domain gtk::action-group-translation-domain nil
 171          nil gtk::gtk-action-group-set-translation-domain))
 172        ("GtkAction"
 173         (:cffi gtk::accel-path gtk::action-accel-path (:string :free-from-foreign nil :free-to-foreign t)
 174          "gtk_action_get_accel_path" "gtk_action_set_accel_path")
 175         (:cffi gtk::accel-group gtk::action-accel-group g-object
 176          nil "gtk_action_set_accel_group"))
 177        ("GtkFileChooser"
 178         (:cffi gtk::current-name gtk::file-chooser-current-name (:string :free-to-foreign t :encoding :utf-8)
 179          nil "gtk_file_chooser_set_current_name")
 180         (:cffi gtk::filename gtk::file-chooser-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
 181          "gtk_file_chooser_get_filename" "gtk_file_chooser_set_filename")
 182         (:cffi gtk::current-folder gtk::file-chooser-current-folder (glib:g-string :free-from-foreign t :free-to-foreign t)
 183          "gtk_file_chooser_get_current_folder" "gtk_file_chooser_set_current_folder")
 184         (:cffi gtk::uri gtk::file-chooser-uri (glib:g-string :free-from-foreign t :free-to-foreign t)
 185          "gtk_file_chooser_get_uri" "gtk_file_chooser_set_uri")
 186         (:cffi gtk::current-folder-uri gtk::file-chooser-current-folder-uri (glib:g-string :free-from-foreign t :free-to-foreign t)
 187          "gtk_file_chooser_get_current_folder_uri" "gtk_file_chooser_set_current_folder_uri")
 188         (:cffi gtk::preview-filename gtk::file-chooser-preview-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
 189          "gtk_file_chooser_get_preview_filename" nil)
 190         (:cffi gtk::preview-uri gtk::file-chooser-preview-uri (glib:g-string :free-from-foreign t :free-to-foreign t)
 191          "gtk_file_chooser_get_preview_uri" nil))
 192        ("GtkFileFilter"
 193         (:cffi gtk::name gtk::file-filter-name :string
 194          "gtk_file_filter_get_name" "gtk_file_filter_set_name"))
 195        ("GtkFontSelectionDialog"
 196         (:cffi gtk::font-name gtk::font-selection-dialog-font-name (glib:g-string :free-from-foreign t :free-to-foreign t)
 197          "gtk_font_selection_dialog_get_font_name" "gtk_font_selection_dialog_set_font_name")
 198         (:cffi gtk::preview-text gtk::font-selection-dialog-preview-text :string
 199          "gtk_font_selection_dialog_get_preview_text" "gtk_font_selection_dialog_set_preview_text")
 200         (:cffi gtk::apply-button gtk::font-selection-dialog-apply-button g-object
 201          "gtk_font_selection_dialog_get_apply_button" nil)
 202         (:cffi gtk::cancel-button gtk::font-selection-dialog-cancel-button g-object
 203          "gtk_font_selection_dialog_get_cancel_button" nil)
 204         (:cffi gtk::ok-button gtk::font-selection-dialog-ok-button g-object
 205          "gtk_font_selection_dialog_get_ok_button" nil))
 206        ("GtkFixed"
 207         (:cffi gtk::has-window gtk::fixed-has-window :boolean
 208          "gtk_fixed_get_has_window" "gtk_fixed_set_has_window"))
 209        ("GtkLayout"
 210         (:cffi gtk::bin-window gtk::layout-bin-window g-object
 211          "gtk_layout_get_bin_window" nil))
 212        ("GtkCalendar"
 213         (:cffi gtk::detail-function gtk::calendar-detail-function nil
 214          nil gtk::calendar-set-detail-function))
 215        ("GtkContainer"
 216         (:cffi gtk::focus-child gtk::container-focus-child g-object
 217          "gtk_container_get_focus_child" "gtk_container_set_focus_child")
 218         (:cffi gtk::focus-vadjustment gtk::container-focus-vadjustment g-object
 219          "gtk_container_get_focus_vadjustment" "gtk_container_set_focus_vadjustment")
 220         (:cffi gtk::focus-hadjustment gtk::container-focus-hadjustment g-object
 221          "gtk_container_get_focus_hadjustment" "gtk_container_set_focus_hadjustment"))
 222        ("GtkWidget"
 223         (:cffi gtk::direction gtk::widget-direction gtk::text-direction
 224          "gtk_widget_get_direction" "gtk_widget_set_direction")
 225         (:cffi gtk::composite-name gtk::widget-composite-name (glib:g-string :free-from-foreign t :free-to-foreign t)
 226          "gtk_widget_get_composite_name" "gtk_widget_set_composite_name")
 227         (:cffi gtk::redraw-on-allocate gtk::widget-redraw-on-allocate :boolean
 228          nil "gtk_widget_set_redraw_on_allocate")
 229         (:cffi gtk::accessible gtk::widget-accessible g-object
 230          "gtk_widget_get_accessible" nil)
 231         (:cffi gtk::tooltip-window gtk::widget-tooltip-window g-object
 232          "gtk_widget_get_tooltip_window" "gtk_widget_set_tooltip_window"))
 233        ("GtkWindow"
 234         (:cffi gtk::default-widget gtk::window-default-widget (g-object gtk::widget)
 235          "gtk_window_get_default_widget" "gtk_window_set_default")
 236         (:cffi gtk::focus gtk::window-focus (g-object gtk::widget)
 237          "gtk_window_get_focus" "gtk_window_set_focus"))
 238        ("GtkWindowGroup"
 239         (:cffi gtk::windows gtk::window-group-windows (glist (g-object gtk::window))
 240          "gtk_window_group_list_windows" nil))
 241        ("GtkTextTag"
 242         (:cffi gtk::priority gtk::text-tag-priority :int
 243          "gtk_text_tag_get_priority" "gtk_text_tag_set_priority"))
 244        ("GtkDialog"
 245         (:cffi gtk::content-area gtk::dialog-content-area (g-object gtk::v-box)
 246          "gtk_dialog_get_content_area" nil)
 247         (:cffi gtk::action-area gtk::dialog-action-area (g-object gtk::widget)
 248          "gtk_dialog_get_action_area" nil)
 249         (:cffi gtk::default-response gtk::dialog-default-response gtk::response-type
 250          nil "gtk_dialog_set_default_response"))
 251        ("GtkAssistant"
 252         (:cffi gtk::current-page gtk::assistant-current-page :int
 253          "gtk_assistant_get_current_page" "gtk_assistant_set_current_page")
 254         (:cffi gtk::n-pages gtk::assistant-n-pages :int
 255          "gtk_assistant_get_n_pages" nil)
 256         (:cffi gtk::forward-page-function gtk::assistant-forward-page-function nil
 257          nil gtk::set-assistant-forward-page-function))
 258        ("GtkLabel"
 259         (:cffi gtk::line-wrap gtk::label-line-wrap :boolean
 260          "gtk_label_get_line_wrap" "gtk_label_set_line_wrap")
 261         (:cffi gtk::line-wrap-mode gtk::label-line-wrap-mode gtk::pango-wrap-mode
 262          "gtk_label_get_line_wrap_mode" "gtk_label_set_line_wrap_mode")
 263         (:cffi gtk::layout gtk::label-layout g-object
 264          "gtk_label_get_layout" nil)
 265         (:cffi gtk::selection-bounds gtk::label-selection-bounds nil
 266          gtk::gtk-label-get-selection-bounds nil)
 267         (:cffi gtk::layout-offsets gtk::label-layout-offsets nil
 268          gtk::gtk-label-get-layout-offsets nil))
 269        ("GtkEntry"
 270         (:cffi gtk::layout gtk::entry-layout g-object
 271          "gtk_entry_get_layout" nil)
 272         (:cffi gtk::completion gtk::entry-completion (g-object gtk::entry-completion)
 273          "gtk_entry_get_completion" "gtk_entry_set_completion")
 274         (:cffi gtk::cursor-hadjustment gtk::entry-cursor-hadjustment (g-object gtk::adjustment)
 275          "gtk_entry_get_cursor_hadjustment" "gtk_entry_set_cursor_hadjustment")
 276         (:cffi gtk::layout-offset gtk::entry-layout-offset nil
 277          gtk::gtk-entry-layout-offset nil))
 278        ("GtkEntryCompletion"
 279         (:cffi gtk::entry gtk::entry-completion-entry (g-object gtk::entry)
 280          "gtk_entry_completion_get_entry" nil)
 281         (:cffi gtk::match-function gtk::entry-completion-match-function nil
 282          nil gtk::gtk-entry-completion-set-match-function))))))
 283
 284 (defun gtk-generate-child-properties (filename)
 285   (with-open-file (stream filename :direction :output :if-exists :supersede)
 286     (let ((*package* (find-package :gtk))
 287           (*print-case* :downcase))
 288      (write-string "(in-package :gtk)" stream)
 289      (terpri stream)
 290      (format stream "~{~S~%~%~}" (gtk:generate-child-properties)))))