generating.lisp

   1 (defpackage :gtk-generation
   2   (:use :cl :gobject :cffi)
   3   (:export #:gtk-generate))
   4
   5 (in-package :gtk-generation)
   6
   7 (load-foreign-library "libgtk-x11-2.0.so")
   8
   9 (defcfun gtk-init-check :boolean
  10   (argc (:pointer :int))
  11   (argv (:pointer (:pointer :string))))
  12
  13 (defun gtk-init ()
  14   (gtk-init-check (foreign-alloc :int :initial-element 0)
  15                   (foreign-alloc :string :initial-contents '("/usr/bin/sbcl")))
  16   #+nil(with-foreign-objects ((argc :int)
  17                          (argv '(:pointer :string) 1))
  18     (setf (mem-ref argc :int) 0
  19           (mem-ref argv '(:pointer :string)) (foreign-alloc :string :count 1
  20                                                             :initial-element "/usr/bin/sbcl"))
  21     (unwind-protect
  22          (unless (gtk-init-check argc argv)
  23            (error "Cannot initialize Gtk+"))
  24       (foreign-free (mem-ref argv '(:pointer :string))))))
  25
  26 (gtk-init)
  27
  28 (defcfun gtk-test-register-all-types :void)
  29
  30 (gtk-test-register-all-types)
  31
  32 (defun gtk-generate (filename)
  33   (with-open-file (stream filename :direction :output :if-exists :supersede)
  34     (gobject::generate-types-hierarchy-to-file
  35      stream
  36      "GtkObject"
  37      :include-referenced t
  38      :prefix "Gtk"
  39      :package (or (find-package :gtk) (make-package :gtk))
  40      :exceptions `(("GObject" gobject:g-object)
  41                    ("GtkObject" ,(intern "GTK-OBJECT" (find-package :gtk)))
  42                    ("GInitiallyUnowned" gobject::g-initially-unowned)
  43                    ("GtkWindow" ,(intern "GTK-WINDOW" (find-package :gtk))))
  44      :prologue (format nil "(in-package :gtk)")
  45      :interfaces '("GtkBuildable"
  46                    "GtkCellEditable"
  47                    "GtkCellLayout"
  48                    "GtkEditable"
  49                    "GtkFileChooser"
  50                    "GtkFileChooserEmbed"
  51                    "GtkTreeModel"
  52                    "GtkTreeDragSource"
  53                    "GtkTreeDragDest"
  54                    "GtkTreeSortable"
  55                    "GtkPrintOperationPreview"
  56                    "GtkRecentChooser"
  57                    "GtkToolShell"
  58                    "AtkImplementorIface")
  59      :objects '("GtkSettings" "GtkRcStyle" "GtkStyle" "GtkTooltip" "GtkAccelGroup"
  60                 "GtkAccelMap" "GtkAction" "GtkActionGroup" "GtkBuilder" "GtkClipboard"
  61                 "GtkEntryCompletion" "GtkIconFactory" "GtkIconTheme" "GtkIMContext"
  62                 "GtkListStore" "GtkPageSetup" "GtkPrintContext" "GtkPrintOperation"
  63                 "GtkPrintSettings" "GtkRecentManager" "GtkSizeGroup" "GtkStatusIcon"
  64                 "GtkTextBuffer" "GtkTextChildAnchor" "GtkTextMark" "GtkTextTag"
  65                 "GtkTextTagTable" "GtkTreeModelFilter" "GtkTreeModelSort"
  66                 "GtkTreeSelection" "GtkTreeStore" "GtkUIManager" "GtkWindowGroup")
  67      :flags '("GtkTextSearchFlags")
  68      :enums '("GtkTextBufferTargetInfo")
  69      :exclusions '("PangoStretch" "PangoVariant" "PangoStyle" "PangoUnderline"))))