1 (defpackage :gtk-generation
2 (:use :cl :gobject :cffi)
3 (:export #:gtk-generate))
5 (in-package :gtk-generation)
7 (load-foreign-library "libgtk-x11-2.0.so")
9 (defcfun gtk-init-check :boolean
10 (argc (:pointer :int))
11 (argv (:pointer (:pointer :string))))
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"))
22 (unless (gtk-init-check argc argv)
23 (error "Cannot initialize Gtk+"))
24 (foreign-free (mem-ref argv '(:pointer :string))))))
28 (defcfun gtk-test-register-all-types :void)
30 (gtk-test-register-all-types)
32 (defun gtk-generate (filename)
33 (with-open-file (stream filename :direction :output :if-exists :supersede)
34 (gobject::generate-types-hierarchy-to-file
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"
55 "GtkPrintOperationPreview"
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"))))