--- /dev/null
+(defsystem :gdk
+ :name "gdk"
+ :serial t
+ :components ((:file "gdk.package")
+ (:file "gdk.objects")
+ (:file "gdk.functions"))
+ :depends-on (:glib :cffi))
\ No newline at end of file
--- /dev/null
+(in-package :gdk)
+
+(defcfun gdk-window-get-events event-mask
+ (window (g-object gdk-window)))
+
+(defcfun gdk-window-set-events :void
+ (window (g-object gdk-window))
+ (flags event-mask))
+
+(defun gdk-window-events (window)
+ (gdk-window-get-events window))
+
+(defun (setf gdk-window-events) (new-value window)
+ (gdk-window-set-events window new-value))
+
+(defcfun gdk-gc-new (g-object graphics-context)
+ (drawable (g-object drawable)))
+
+(defcfun gdk-draw-line :void
+ (drawable (g-object drawable))
+ (gc (g-object graphics-context))
+ (x1 :int)
+ (y1 :int)
+ (x2 :int)
+ (y2 :int))
+
+(defcfun gdk-gc-set-rgb-fg-color :void
+ (gc (g-object graphics-context))
+ (color (g-boxed-ptr color)))
+
+(defcfun gdk-drawable-get-size :void
+ (drawable (g-object drawable))
+ (width (:pointer :int))
+ (height (:pointer :int)))
+
+(defun drawable-get-size (drawable)
+ (with-foreign-objects ((x :int)
+ (y :int))
+ (gdk-drawable-get-size drawable x y)
+ (values (mem-ref x :int) (mem-ref y :int))))
+
+(define-g-object-class "PangoLayout" pango-layout () ())
+
+(defcfun gdk-draw-layout :void
+ (drawable (g-object drawable))
+ (gc (g-object graphics-context))
+ (x :int)
+ (y :int)
+ (layout (g-object pango-layout)))
--- /dev/null
+(in-package :gdk)
+
+(define-g-enum "GdkGrabStatus" grab-status (t) :success :already-grabbed :invalid-time :not-viewable :frozen)
+
+(define-g-object-class "GdkDisplay" display () ())
+
+(define-g-object-class "GdkDisplayManager" display-manager () ()
+ (default-display display-manager-default-display "default-display" "GdkDisplay" t t))
+
+(define-g-object-class "GdkScreen" screen () ()
+ (font-options screen-font-options "font-options" "gpointer" t t)
+ (resolution screen-resolution "resolution" "gdouble" t t))
+
+(define-g-object-class "GdkGC" graphics-context () ())
+
+(define-g-object-class "GdkDrawable" drawable () ())
+
+(define-g-object-class "GdkPixmap" pixmap (drawable) ())
+
+(define-g-object-class "GdkWindow" gdk-window (drawable) ())
+
+(define-g-object-class "GdkKeymap" keymap () ())
+
+(define-g-enum "GdkEventType" event-type (t)
+ (:nothing -1) (:delete 0)
+ (:destroy 1) (:expose 2) (:motion-notify 3)
+ (:button-press 4) (:2button-press 5) (:3button-press 6)
+ (:button-release 7) (:key-press 8) (:key-release 9)
+ (:enter-notify 10) (:leave-notify 11) (:focus-change 12)
+ (:configure 13) (:map 14) (:unmap 15) (:property-notify 16)
+ (:selection-clear 17) (:selection-request 18)
+ (:selection-notify 19) (:proximity-in 20)
+ (:proximity-out 21) (:drag-enter 22) (:drag-leave 23)
+ (:drag-motion 24) (:drag-status 25) (:drop-start 26)
+ (:drop-finished 27) (:client-event 28)
+ (:visibility-notify 29) (:no-expose 30) (:scroll 31)
+ (:window-state 32) (:setting 33) (:owner-change 34)
+ (:grab-broken 35) (:damage 36))
+
+(gobject::define-g-flags "GdkModifierType" modifier-type (t)
+ (:shift-mask 1) (:lock-mask 2) (:control-mask 4)
+ (:mod1-mask 8) (:mod2-mask 16) (:mod3-mask 32)
+ (:mod4-mask 64) (:mod5-mask 128)
+ (:button1-mask 256) (:button2-mask 512)
+ (:button3-mask 1024) (:button4-mask 2048)
+ (:button5-mask 4096) (:super-mask 67108864)
+ (:hyper-mask 134217728) (:meta-mask 268435456)
+ (:release-mask 1073741824)
+ (:modifier-mask 1543512063))
+
+(define-g-enum "GdkScrollDirection" scroll-direction (t)
+ (:up 0) (:down 1)
+ (:left 2) (:right 3))
+
+(define-g-enum "GdkVisibilityState" visibility-state (t)
+ (:unobscured 0)
+ (:partial 1) (:fully-obscured 2))
+
+(define-g-enum "GdkPropertyState" property-state (t)
+ :new-value :delete)
+
+(define-g-flags "GdkWindowState" window-state (t)
+ (:withdrawn 1)
+ (:iconified 2) (:maximized 4) (:sticky 8) (:fullscreen 16)
+ (:above 32) (:below 64))
+
+(define-g-enum "GdkSettingAction" setting-action (t)
+ (:new 0) (:changed 1)
+ (:deleted 2))
+
+(define-g-enum "GdkOwnerChange" owner-change (t)
+ (:new-owner 0)
+ (:destroy 1) (:close 2))
+
+(define-g-flags "GdkEventMask" event-mask (t)
+ (:exposure-mask 2)
+ (:pointer-motion-mask 4) (:pointer-motion-hint-mask 8)
+ (:button-motion-mask 16) (:button1-motion-mask 32)
+ (:button2-motion-mask 64) (:button3-motion-mask 128)
+ (:button-press-mask 256) (:button-release-mask 512)
+ (:key-press-mask 1024) (:key-release-mask 2048)
+ (:enter-notify-mask 4096) (:leave-notify-mask 8192)
+ (:focus-change-mask 16384) (:structure-mask 32768)
+ (:property-change-mask 65536)
+ (:visibility-notify-mask 131072)
+ (:proximity-in-mask 262144) (:proximity-out-mask 524288)
+ (:substructure-mask 1048576) (:scroll-mask 2097152)
+ (:all-events-mask 4194302))
+
+(define-g-boxed-class ("GdkEvent" event-struct) event ()
+ (type event-type)
+ (window (g-object gdk-window))
+ (send-event (:boolean :int8)))
+
+(define-g-boxed-class nil event-key ((event type (:key-press :key-release)))
+ (time :uint32)
+ (state modifier-type)
+ (keyval :uint)
+ (length :int)
+ (string (:string :free-from-foreign nil :free-to-foreign nil))
+ (hardware-keycode :uint16)
+ (group :uint8)
+ (is-modifier :uint))
+
+(define-g-boxed-class nil event-button ((event type (:button-press :2button-press :3button-press :button-release)))
+ (time :uint32)
+ (x :double)
+ (y :double)
+ (axes (fixed-array :double 2))
+ (state :uint)
+ (button :uint)
+ (deviced (g-object device))
+ (x-root :double)
+ (y-root :double))
+
+(define-g-boxed-class nil event-scroll ((event type :scroll))
+ (time :uint32)
+ (x :double)
+ (y :double)
+ (state modifier-type)
+ (direction scroll-direction)
+ (device (g-object device))
+ (x-root :double)
+ (y-root :double))
+
+(define-g-boxed-class nil event-motion ((event type :motion-notify))
+ (time :uint32)
+ (x :double)
+ (y :double)
+ (axes (fixed-array :double 2))
+ (state modifier-type)
+ (is-hint :int)
+ (device (g-object device))
+ (x-root :double)
+ (y-root :double))
+
+(define-g-boxed-class "GdkRectangle" rectangle ()
+ (x :int)
+ (y :int)
+ (width :int)
+ (height :int))
+
+(define-g-boxed-class nil event-expose ((event type :expose))
+ (area (g-boxed-inline rectangle))
+ (region :pointer)
+ (count :int))
+
+(define-g-boxed-class nil event-visibility ((event type :visibility-notify))
+ (state visibility-state))
+
+(define-g-boxed-class nil event-crossing ((event type (:enter-notify :leave-notify)))
+ (sub-window (g-object gdk-window))
+ (time :uint32)
+ (x :double)
+ (y :double)
+ (x-root :double)
+ (y-root :double))
+
+(define-g-boxed-class nil event-focus ((event type :focus-change))
+ (in :int16))
+
+(define-g-boxed-class nil event-configure ((event type :configure))
+ (x :int)
+ (y :int)
+ (width :int)
+ (height :int))
+
+(defctype gdk-atom :pointer)
+
+(define-g-boxed-class nil event-property ((event type :property-notify))
+ (atom gdk-atom)
+ (time :uint32)
+ (state property-state))
+
+;;;FIXME: Check correct type
+(defctype native-window :uint32)
+
+(define-g-boxed-class nil event-selection ((event type (:selection-clear :selection-notify :selection-request)))
+ (selection gdk-atom)
+ (target gdk-atom)
+ (property gdk-atom)
+ (time :uint32)
+ (requestor native-window))
+
+(define-g-object-class "GdkDragContext" drag-context () ())
+
+(define-g-boxed-class nil event-dnd ((event type (:drag-enter :drag-leave :drag-motion :drag-status :drop-start :drop-finished)))
+ (drag-context :pointer)
+ (time :uint32)
+ (x-root :short)
+ (y-root :short))
+
+(define-g-boxed-class nil event-proximity ((event type (:proximity-in :proximity-out)))
+ (time :uint32)
+ (device (g-object device)))
+
+(defcunion event-client-data-union
+ (b :char :count 20)
+ (s :short :count 10)
+ (l :long :count 5))
+
+(define-g-boxed-class nil event-client ((event type :client-event))
+ (message-time gdk-atom)
+ (data-format :ushort)
+ (data event-client-data-union :parser 'event-client-data-union-parser :unparser 'event-client-data-union-unparser))
+
+(defun event-client-data-union-parser (name pointer)
+ (declare (ignore name))
+ (ecase (foreign-slot-value pointer 'event-client 'data-format)
+ (8 (convert-from-foreign (foreign-slot-pointer pointer 'event-client 'data) '(fixed-array :uchar 20)))
+ (16 (convert-from-foreign (foreign-slot-pointer pointer 'event-client 'data) '(fixed-array :ushort 20)))
+ (32 (convert-from-foreign (foreign-slot-pointer pointer 'event-client 'data) '(fixed-array :ulong 20)))))
+
+(defun event-client-data-union-unparser (name pointer object)
+ (declare (ignore name))
+ (ecase (event-client-data-format object)
+ (8 (loop
+ with array-ptr = (foreign-slot-pointer pointer 'event-client 'data)
+ for i from 0 below 20
+ do (setf (mem-aref array-ptr :uchar i) (aref (event-client-data object) i))))
+ (16 (loop
+ with array-ptr = (foreign-slot-pointer pointer 'event-client 'data)
+ for i from 0 below 20
+ do (setf (mem-aref array-ptr :ushort i) (aref (event-client-data object) i))))
+ (32 (loop
+ with array-ptr = (foreign-slot-pointer pointer 'event-client 'data)
+ for i from 0 below 20
+ do (setf (mem-aref array-ptr :ulong i) (aref (event-client-data object) i))))))
+
+(define-g-boxed-class nil event-no-expose ((event type :no-expose)))
+
+(define-g-boxed-class nil event-window-state ((event type :window-state))
+ (changed-mask window-state)
+ (new-window-state window-state))
+
+(define-g-boxed-class nil event-setting ((event type :setting))
+ (action setting-action)
+ (name (:string :free-from-foreign nil :free-to-foreign nil)))
+
+(define-g-boxed-class nil event-owner-change ((event type :owner-change))
+ (owner native-window)
+ (reason owner-change)
+ (selection gdk-atom)
+ (time :uint32)
+ (selection-time :uint32))
+
+(define-g-boxed-class nil event-grab-broken ((event type :grab-broken))
+ (keyboard :boolean)
+ (implicit :boolean)
+ (grab-window (g-object gdk-window)))
+
+(define-g-enum "GdkFontType" font-type () :font :fontset)
+
+(define-g-boxed-class "GdkFont" font ()
+ (type font-type)
+ (ascent :int)
+ (descent :int))
+
+(define-g-boxed-class "GdkColor" color ()
+ (pixel :uint32 :initform 0)
+ (red :uint16 :initform 0)
+ (green :uint16 :initform 0)
+ (blue :uint16 :initform 0))
+
+(define-g-enum "GdkGravity" gravity ()
+ (:north-west 1)
+ :north
+ :north-east
+ :west
+ :center
+ :east
+ :south-west
+ :south
+ :south-east
+ :static)
+
+(define-g-boxed-class "GdkGeometry" geometry ()
+ (min-width :int :initform 0)
+ (min-height :int :initform 0)
+ (max-width :int :initform 0)
+ (max-height :int :initform 0)
+ (base-width :int :initform 0)
+ (base-height :int :initform 0)
+ (width-increment :int :initform 0)
+ (height-increment :int :initform 0)
+ (min-aspect :double :initform 0.0d0)
+ (max-aspect :double :initform 0.0d0)
+ (gravity gravity :initform :north-west))
+
+(define-g-flags "GdkWindowHints" window-hints ()
+ :pos :min-size :max-size :base-size :aspect
+ :resize-inc :win-gravity :user-pos :user-size)
+
+(define-g-enum "GdkWindowEdge" window-edge (t)
+ (:north-west 0) (:north 1) (:north-east 2) (:west 3)
+ (:east 4) (:south-west 5) (:south 6) (:south-east 7))
+
+(define-g-object-class "GdkPixbuf" pixbuf (g-object t) nil
+ (colorspace pixbuf-colorspace "colorspace" "GdkColorspace" t nil)
+ (n-channels pixbuf-n-channels "n-channels" "gint" t nil)
+ (has-alpha pixbuf-has-alpha "has-alpha" "gboolean" t nil)
+ (bits-per-sample pixbuf-bits-per-sample "bits-per-sample" "gint" t nil)
+ (width pixbuf-width "width" "gint" t nil)
+ (height pixbuf-height "height" "gint" t nil)
+ (rowstride pixbuf-rowstride "rowstride" "gint" t nil)
+ (pixels pixbuf-pixels "pixels" "gpointer" t nil))
+
+(define-g-object-class "GdkPixbufAnimation" pixbuf-animation (g-object t)
+ nil)
\ No newline at end of file
--- /dev/null
+(defpackage :gdk
+ (:use :cl :gobject :cffi)
+ (:export #:gdk-window-events
+ #:gdk-gc-set-rgb-fg-color
+ #:gdk-drawable-get-size
+ #:gdk-draw-line
+ #:gdk-gc-new
+ #:drawable-get-size
+ #:gdk-draw-layout
+ ))
+
+(in-package :gdk)
+
+(load-foreign-library "libgdk-x11-2.0.so")
\ No newline at end of file
--- /dev/null
+(defpackage :gtk-generation
+ (:use :cl :gobject :cffi)
+ (:export #:gtk-generate))
+
+(in-package :gtk-generation)
+
+(load-foreign-library "libgtk-x11-2.0.so")
+
+(defcfun gtk-init-check :boolean
+ (argc (:pointer :int))
+ (argv (:pointer (:pointer :string))))
+
+(defun gtk-init ()
+ (gtk-init-check (foreign-alloc :int :initial-element 0)
+ (foreign-alloc :string :initial-contents '("/usr/bin/sbcl")))
+ #+nil(with-foreign-objects ((argc :int)
+ (argv '(:pointer :string) 1))
+ (setf (mem-ref argc :int) 0
+ (mem-ref argv '(:pointer :string)) (foreign-alloc :string :count 1
+ :initial-element "/usr/bin/sbcl"))
+ (unwind-protect
+ (unless (gtk-init-check argc argv)
+ (error "Cannot initialize Gtk+"))
+ (foreign-free (mem-ref argv '(:pointer :string))))))
+
+(gtk-init)
+
+(defcfun gtk-test-register-all-types :void)
+
+(gtk-test-register-all-types)
+
+(defun gtk-generate (filename)
+ (with-open-file (stream filename :direction :output :if-exists :supersede)
+ (gobject::generate-types-hierarchy-to-file
+ stream
+ "GtkObject"
+ :include-referenced t
+ :prefix "Gtk"
+ :package (or (find-package :gtk) (make-package :gtk))
+ :exceptions `(("GObject" gobject:g-object)
+ ("GtkObject" ,(intern "GTK-OBJECT" (find-package :gtk)))
+ ("GInitiallyUnowned" gobject::g-initially-unowned)
+ ("GtkWindow" ,(intern "GTK-WINDOW" (find-package :gtk))))
+ :prologue (format nil "(in-package :gtk)")
+ :interfaces '("GtkBuildable"
+ "GtkCellEditable"
+ "GtkCellLayout"
+ "GtkEditable"
+ "GtkFileChooser"
+ "GtkFileChooserEmbed"
+ "GtkTreeModel"
+ "GtkTreeDragSource"
+ "GtkTreeDragDest"
+ "GtkTreeSortable"
+ "GtkPrintOperationPreview"
+ "GtkRecentChooser"
+ "GtkToolShell"
+ "AtkImplementorIface")
+ :objects '("GtkSettings" "GtkRcStyle" "GtkStyle" "GtkTooltip" "GtkAccelGroup"
+ "GtkAccelMap" "GtkAction" "GtkActionGroup" "GtkBuilder" "GtkClipboard"
+ "GtkEntryCompletion" "GtkIconFactory" "GtkIconTheme" "GtkIMContext"
+ "GtkListStore" "GtkPageSetup" "GtkPrintContext" "GtkPrintOperation"
+ "GtkPrintSettings" "GtkRecentManager" "GtkSizeGroup" "GtkStatusIcon"
+ "GtkTextBuffer" "GtkTextChildAnchor" "GtkTextMark" "GtkTextTag"
+ "GtkTextTagTable" "GtkTreeModelFilter" "GtkTreeModelSort"
+ "GtkTreeSelection" "GtkTreeStore" "GtkUIManager" "GtkWindowGroup")
+ :flags '("GtkTextSearchFlags")
+ :enums '("GtkTextBufferTargetInfo")
+ :exclusions '("PangoStretch" "PangoVariant" "PangoStyle" "PangoUnderline"))))
\ No newline at end of file
--- /dev/null
+(defsystem :glib
+ :name "glib"
+ :author "Kalyanov Dmitry"
+ :serial t
+ :components ((:file "glib")
+ (:file "glib.glist")
+ (:file "glib.gstrv")
+ (:file "glib.string")
+ (:file "gobject.package")
+ (:file "gobject.structs")
+ (:file "gobject.type")
+ (:file "gobject.enum")
+ (:file "gobject.boxed")
+ (:file "gobject.gvalue")
+ (:file "gobject.gparams")
+ (:file "gobject.closures")
+ (:file "gobject.signals")
+ (:file "gobject.object")
+ (:file "gobject.foreign")
+ (:file "gobject.foreign-gobject")
+ (:file "gobject.foreign-closures")
+ (:file "gobject.foreign-gboxed")
+ (:file "gobject.gvalue-parser")
+ (:file "gobject.gobject-query")
+ (:file "gobject.generating")
+ (:file "gobject.object-defs"))
+ :depends-on (:cffi :trivial-garbage :metabang-bind :iterate :anaphora))
\ No newline at end of file
--- /dev/null
+(in-package :glib)
+
+(define-foreign-type glist-type ()
+ ((type :reader glist-type-type :initarg :type :initform :pointer)
+ (free-from-foreign :reader glist-type-free-from-foreign :initarg :free-from-foreign :initform t)
+ (free-to-foreign :reader glist-type-free-to-foreign :initarg :free-to-foreign :initform t))
+ (:actual-type :pointer))
+
+(define-parse-method glist (type &key (free-from-foreign t) (free-to-foreign t))
+ (make-instance 'glist-type
+ :type type
+ :free-from-foreign free-from-foreign
+ :free-to-foreign free-to-foreign))
+
+(defcstruct g-list
+ (data :pointer)
+ (next :pointer)
+ (prev :pointer))
+
+(defcfun g-list-first (:pointer g-list) (list (:pointer g-list)))
+
+(defcfun g-list-free :void (list (:pointer g-list)))
+
+(defun g-list-next (list)
+ (if (null-pointer-p list)
+ (null-pointer)
+ (foreign-slot-value list 'g-list 'next)))
+
+(defmethod translate-from-foreign (pointer (type glist-type))
+ (prog1
+ (iter (for c initially pointer then (g-list-next c))
+ (until (null-pointer-p c))
+ (collect (convert-from-foreign (foreign-slot-value c 'g-list 'data) (glist-type-type type))))
+ (when (glist-type-free-from-foreign type)
+ (g-list-free pointer))))
+
+
+(define-foreign-type gslist-type ()
+ ((type :reader gslist-type-type :initarg :type :initform :pointer)
+ (free-from-foreign :reader gslist-type-free-from-foreign :initarg :free-from-foreign :initform t)
+ (free-to-foreign :reader gslist-type-free-to-foreign :initarg :free-to-foreign :initform t))
+ (:actual-type :pointer))
+
+(define-parse-method gslist (type &key (free-from-foreign t) (free-to-foreign t))
+ (make-instance 'gslist-type
+ :type type
+ :free-from-foreign free-from-foreign
+ :free-to-foreign free-to-foreign))
+
+(defcstruct g-slist
+ (data :pointer)
+ (next :pointer))
+
+(defcfun g-slist-free :void (list (:pointer g-slist)))
+
+(defun g-slist-next (list)
+ (if (null-pointer-p list)
+ (null-pointer)
+ (foreign-slot-value list 'g-slist 'next)))
+
+(defmethod translate-from-foreign (pointer (type gslist-type))
+ (prog1
+ (iter (for c initially pointer then (g-slist-next c))
+ (until (null-pointer-p c))
+ (collect (convert-from-foreign (foreign-slot-value c 'g-slist 'data) (glist-type-type type))))
+ (when (gslist-type-free-from-foreign type)
+ (g-slist-free pointer))))
\ No newline at end of file
--- /dev/null
+(in-package :glib)
+
+(define-foreign-type gstrv-type ()
+ ((free-from-foreign :initarg :free-from-foreign :initform t :reader gstrv-type-fff)
+ (free-to-foreign :initarg :free-to-foreign :initform t :reader gstrv-type-ftf))
+ (:actual-type :pointer))
+
+(define-parse-method gstrv (&key (free-from-foreign t) (free-to-foreign t))
+ (make-instance 'gstrv-type :free-from-foreign free-from-foreign :free-to-foreign free-to-foreign))
+
+(defmethod translate-from-foreign (value (type gstrv-type))
+ (unless (null-pointer-p value)
+ (prog1
+ (iter (for i from 0)
+ (for str-ptr = (mem-aref value :pointer i))
+ (until (null-pointer-p str-ptr))
+ (collect (convert-from-foreign str-ptr '(:string :free-from-foreign nil)))
+ (when (gstrv-type-fff type)
+ (g-free str-ptr)))
+ (when (gstrv-type-fff type)
+ (g-free value)))))
+
+(defmethod translate-to-foreign (str-list (type gstrv-type))
+ (let* ((n (length str-list))
+ (result (g-malloc (* (1+ n) (foreign-type-size :pointer)))))
+ (iter (for i from 0)
+ (for str in str-list)
+ (setf (mem-aref result :pointer i) (g-strdup str)))
+ (setf (mem-aref result :pointer n) (null-pointer))
+ result))
\ No newline at end of file
--- /dev/null
+(defpackage :glib
+ (:use :cl :cffi :iter)
+ (:export #:gsize
+ #:gssize
+ #:goffset
+ #:*glib-major-version*
+ #:*glib-minor-version*
+ #:*glib-micro-version*
+ #:*glib-binary-age*
+ #:*glib-interface-age*
+ #:g-free
+ #:glist
+ #:gstrv
+ #:g-malloc
+ #:g-strdup
+ #:g-string
+ #:gslist))
+
+(in-package :glib)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (define-foreign-library glib
+ (:unix "libglib-2.0.so")
+ (t "glib-2.0")))
+
+(use-foreign-library glib)
+
+(load-foreign-library "libgthread-2.0.so")
+
+;;
+;; Glib Fundamentals
+;;
+
+;;
+;; Fundamentals - Basic types
+;;
+
+
+;; TODO: not sure about these: for amd64 they are ok
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (if (cffi-features:cffi-feature-p :x86-64)
+ (defctype gsize :uint64)
+ (error "Unknown type 'gsize'")))
+
+(defctype gssize :long)
+
+(defctype goffset :uint64)
+
+
+;;
+;; Fundamentals - Version information
+;;
+
+(defcvar (*glib-major-version* "glib_major_version" :read-only t :library glib) :uint)
+(defcvar (*glib-minor-version* "glib_minor_version" :read-only t :library glib) :uint)
+(defcvar (*glib-micro-version* "glib_micro_version" :read-only t :library glib) :uint)
+(defcvar (*glib-binary-age* "glib_binary_age" :read-only t :library glib) :uint)
+(defcvar (*glib-interface-age* "glib_interface_age" :read-only t :library glib) :uint)
+
+;;
+;; Omitted:
+;; Limits of Basic Types, Standard Macros, Type Conversion Macros, Byte Order Macros,
+;; Numerical Definitions, Miscellaneous Macros, Atomic operations
+;;
+
+;; Core Application Support - The Main Event Loop
+
+(defcstruct g-main-loop)
+(defcstruct g-main-context)
+(defcstruct g-source)
+(defcstruct g-source-funcs
+ (prepare :pointer)
+ (check :pointer)
+ (dispatch :pointer)
+ (finalize :pointer)
+ (closure-callback :pointer)
+ (closure-marshal :pointer))
+(defcstruct g-source-callback-funcs
+ (ref :pointer)
+ (unref :pointer)
+ (get :pointer))
+(defcstruct g-cond)
+(defcstruct g-mutex)
+
+(defcstruct g-poll-fd
+ (fd :int) ;; TODO: #if defined (G_OS_WIN32) && GLIB_SIZEOF_VOID_P == 8
+ (events :ushort)
+ (revent :ushort))
+
+(defcstruct g-time-val
+ (seconds :long)
+ (microseconds :long))
+
+(defcstruct g-thread)
+
+(defcfun (g-main-loop-new "g_main_loop_new" :library glib) (:pointer g-main-loop)
+ (context (:pointer g-main-context))
+ (is-running :boolean))
+
+(defcfun (g-main-loop-ref "g_main_loop_ref" :library glib) (:pointer g-main-loop)
+ (loop (:pointer g-main-loop)))
+
+(defcfun (g-main-loop-unref "g_main_loop_unref" :library glib) (:pointer g-main-loop)
+ (loop (:pointer g-main-loop)))
+
+(defcfun (g-main-loop-run "g_main_loop_run" :library glib) :void
+ (loop (:pointer g-main-loop)))
+
+(defcfun (g-main-loop-quit "g_main_loop_quit" :library glib) :void
+ (loop (:pointer g-main-loop)))
+
+(defcfun (g-main-loop-is-running "g_main_loop_is_running" :library glib) :boolean
+ (loop (:pointer g-main-loop)))
+
+(defcfun (g-main-loop-get-context "g_main_loop_get_context" :library glib) (:pointer g-main-context)
+ (loop (:pointer g-main-loop)))
+
+(defconstant +g-priority-high+ -100)
+(defconstant +g-priority-default+ 0)
+(defconstant +g-priority-high-idle+ 100)
+(defconstant +g-priority-default-idle+ 200)
+(defconstant +g-priority-low+ 300)
+
+(defcfun (g-main-context-new "g_main_context_new" :library glib) (:pointer g-main-context))
+
+(defcfun (g-main-context-ref "g_main_context_ref" :library glib) (:pointer g-main-context)
+ (context (:pointer g-main-context)))
+
+(defcfun (g-main-context-unref "g_main_context_unref" :library glib) (:pointer g-main-context)
+ (context (:pointer g-main-context)))
+
+(defcfun (g-main-context-default "g_main_context_default" :library glib) (:pointer g-main-context))
+
+(defcfun (g-main-context-iteration "g_main_context_iteration" :library glib) :boolean
+ (context (:pointer g-main-context))
+ (may-block :boolean))
+
+(defcfun (g-main-context-pending "g_main_context_pending" :library glib) :boolean
+ (context (:pointer g-main-context)))
+
+(defcfun (g-main-context-find-source-by-id "g_main_context_find_source_by_id" :library glib) (:pointer g-source)
+ (context (:pointer g-main-context))
+ (source-id :uint))
+
+(defcfun (g-main-context-find-source-by-user-data "g_main_context_find_source_by_user_data" :library glib) (:pointer g-source)
+ (context (:pointer g-main-context))
+ (user-data :pointer))
+
+(defcfun (g-main-context-find-source-by-funcs-user-data "g_main_context_find_source_by_funcs_user_data" :library glib) (:pointer g-source)
+ (context (:pointer g-main-context))
+ (funcs (:pointer g-source-funcs))
+ (user-data :pointer))
+
+(defcfun (g-main-context-wakeup "g_main_context_wakeup" :library glib) :void
+ (context (:pointer g-main-context)))
+
+(defcfun (g-main-context-acquire "g_main_context_acquire" :library glib) :boolean
+ (context (:pointer g-main-context)))
+
+(defcfun (g-main-context-release "g_main_context_release" :library glib) :void
+ (context (:pointer g-main-context)))
+
+(defcfun (g-main-context-is-owner "g_main_context_is_owner" :library glib) :boolean
+ (context (:pointer g-main-context)))
+
+(defcfun (g-main-context-wait "g_main_context_wait" :library glib) :boolean
+ (context (:pointer g-main-context))
+ (cond (:pointer g-cond))
+ (mutex (:pointer g-mutex)))
+
+(defcfun (g_main_context_prepare "g_main_context_prepare" :library glib) :boolean
+ (context (:pointer g-main-context))
+ (priority-ret (:pointer :int)))
+
+(defcfun (g_main_context_query "g_main_context_query" :library glib) :int
+ (context (:pointer g-main-context))
+ (max-priority :int)
+ (timeout-ret (:pointer :int))
+ (fds-ret (:pointer g-poll-fd))
+ (n-dfs :int))
+
+(defcfun (g-main-context-check "g_main_context_check" :library glib) :int
+ (context (:pointer g-main-context))
+ (max-priority :int)
+ (fds (:pointer g-poll-fd))
+ (n-fds :int))
+
+(defcfun (g-main-context-dispatch "g_main_context_dispatch" :library glib) :void
+ (context (:pointer g-main-context)))
+
+(defcfun (g-main-context-set-poll-func "g_main_context_set_poll_func" :library glib) :void
+ (context (:pointer g-main-context))
+ (func :pointer))
+
+(defcfun (g-main-context-get-poll-func "g_main_context_get_poll_func" :library glib) :pointer
+ (context (:pointer g-main-context)))
+
+(defcfun (g-main-context-add-poll "g_main_context_add_poll" :library glib) :void
+ (context (:pointer g-main-context))
+ (fd (:pointer g-poll-fd))
+ (priority :int))
+
+(defcfun (g-main-context-remove-poll "g_main_context_remove_poll" :library glib) :void
+ (context (:pointer g-main-context))
+ (fd (:pointer g-poll-fd)))
+
+(defcfun (g-main-depth "g_main_depth" :library glib) :int)
+
+(defcfun (g-main-current-source "g_main_current_source" :library glib) (:pointer g-source))
+
+(defcfun (g-timeout-source-new "g_timeout_source_new" :library glib) (:pointer g-source)
+ (interval-milliseconds :int))
+
+(defcfun (g-timeout-source-new-seconds "g_timeout_source_new_seconds" :library glib) (:pointer g-source)
+ (interval-seconds :int))
+
+(defcfun (g-timeout-add "g_timeout_add" :library glib) :uint
+ (interval-milliseconds :uint)
+ (function :pointer)
+ (data :pointer))
+
+(defcfun (g-timeout-add-full "g_timeout_add_full" :library glib) :uint
+ (priority :int)
+ (interval-milliseconds :uint)
+ (function :pointer)
+ (data :pointer)
+ (destroy-notify :pointer))
+
+(defcfun (g-timeout-add-seconds "g_timeout_add_seconds" :library glib) :uint
+ (interval-seconds :uint)
+ (function :pointer)
+ (data :pointer))
+
+(defcfun (g-timeout-add-seconds-full "g_timeout_add_seconds_full" :library glib) :uint
+ (priority :int)
+ (interval-seconds :uint)
+ (function :pointer)
+ (data :pointer)
+ (destroy-notify :pointer))
+
+(defcfun (g-idle-source-new "g_idle_source_new" :library glib) (:pointer g-source))
+
+(defcfun (g-idle-add "g_idle_add" :library glib) :uint
+ (function :pointer)
+ (data :pointer))
+
+(defcfun (g-idle-add-full "g_idle_add_full" :library glib) :uint
+ (priority :uint)
+ (function :pointer)
+ (data :pointer)
+ (notify :pointer))
+
+(defcfun (g-idle-remove-by-data "g_idle_remove_by_data" :library glib) :boolean
+ (data :pointer))
+
+;(defctype g-pid :int) ;;TODO: might work on amd64 linux, but on others
+
+;; Omitted GPid, g_child_add_watch, g_child_add_watch_full
+
+(defcfun (g-source-new "g_source_new" :library glib) (:pointer g-source)
+ (source-funcs (:pointer g-source-funcs))
+ (struct-size :uint))
+
+(defcfun (g-source-ref "g_source_ref" :library glib) (:pointer g-source)
+ (source (:pointer g-source)))
+
+(defcfun (g-source-unref "g_source_unref" :library glib) :void
+ (source (:pointer g-source)))
+
+(defcfun (g-source-set-funcs "g_source_set_funcs" :library glib) :void
+ (source (:pointer g-source))
+ (funcs (:pointer g-source-funcs)))
+
+(defcfun (g-source-attach "g_source_attach" :library glib) :uint
+ (source (:pointer g-source))
+ (context (:pointer g-main-context)))
+
+(defcfun (g-source-destroy "g_source_destroy" :library glib) :void
+ (source (:pointer g-source)))
+
+(defcfun (g-source-is-destroyed "g_source_is_destroyed" :library glib) :boolean
+ (source (:pointer g-source)))
+
+(defcfun (g-source-set-priority "g_source_set_priority" :library glib) :void
+ (source (:pointer g-source))
+ (priority :int))
+
+(defcfun (g-source-get-priority "g_source_get_priority" :library glib) :int
+ (source (:pointer g-source)))
+
+(defcfun (g-source-set-can-recurse "g_source_set_can_recurse" :library glib) :void
+ (source (:pointer g-source))
+ (can-recurse :boolean))
+
+(defcfun (g-source-get-can-recurse "g_source_get_can_recurse" :library glib) :boolean
+ (source (:pointer g-source)))
+
+(defcfun (g-source-get-id "g_source_get_id" :library glib) :uint
+ (source (:pointer g-source)))
+
+(defcfun (g-source-get-context "g_source_get_context" :library glib) (:pointer g-main-context)
+ (source (:pointer g-source)))
+
+(defcfun (g-source-set-callback "g_source_set_callback" :library glib) :void
+ (source (:pointer g-source))
+ (func :pointer)
+ (data :pointer)
+ (notify :pointer))
+
+(defcfun (g-source-add-poll "g_source_add_poll" :library glib) :void
+ (source (:pointer g-source))
+ (fd (:pointer g-poll-fd)))
+
+(defcfun (g-source-remove-poll "g_source_remove_poll" :library glib) :void
+ (source (:pointer g-source))
+ (fd (:pointer g-poll-fd)))
+
+(defcfun (g-source-get-current-time "g_source_get_current_time" :library glib) :void
+ (source (:pointer g-source))
+ (timeval-ret (:pointer g-time-val)))
+
+(defcfun (g-source-remove "g_source_remove" :library glib) :boolean
+ (id :uint))
+
+(defcfun (g-source-remove-by-funcs-user-data "g_source_remove_by_funcs_user_data" :library glib) :boolean
+ (funcs (:pointer g-source-funcs))
+ (data :pointer))
+
+(defcfun (g-source-remove-by-user-data "g_source_remove_by_user_data" :library glib) :boolean
+ (data :pointer))
+
+;;
+;; Core Application Support - Threads
+;;
+
+(defcenum g-thread-error
+ :g-thread-error-again)
+
+;omitted: struct GThreadFunctions
+
+(defcfun (g-thread-init "g_thread_init") :void
+ (vtable :pointer))
+
+(g-thread-init (null-pointer))
+
+(defcenum g-thread-priority
+ :g-thread-priority-low
+ :g-thread-priority-normal
+ :g-thread-priority-hight
+ :g-thread-priority-urgent)
+
+;omitted: g_thread_create, g_thread_create_full, g_thread_yield, g_thread_exit, g_thread_foreach
+
+(defcfun (g-thread-self "g_thread_self" :library glib) (:pointer g-thread))
+
+(defcfun (g-thread-join "g_thread_join" :library glib) :pointer
+ (thread (:pointer g-thread)))
+
+(defcfun (g-thread-priority "g_thread_set_priority" :library glib) :void
+ (thread (:pointer g-thread))
+ (priority g-thread-priority))
+
+(defcfun (g-mutex-new "g_mutex_new" :library glib) (:pointer g-mutex))
+
+(defcfun (g-mutex-lock "g_mutex_lock" :library glib) :void
+ (mutex (:pointer g-mutex)))
+
+(defcfun (g-mutex-try-lock "g_mutex_trylock" :library glib) :boolean
+ (mutex (:pointer g-mutex)))
+
+(defcfun (g-mutex-free "g_mutex_free" :library glib) :void
+ (mutex (:pointer g-mutex)))
+
+;omitted: GStaticMutex, GStaticRWLock stuff
+
+(defcfun (g-cond-new "g_cond_new" :library glib) (:pointer g-cond))
+
+(defcfun (g-cond-signal "g_cond_signal" :library glib) :void
+ (cond (:pointer g-cond)))
+
+(defcfun (g-cond-broadcast "g_cond_broadcast" :library glib) :void
+ (cond (:pointer g-cond)))
+
+(defcfun (g-cond-wait "g_cond_wait" :library glib) :void
+ (cond (:pointer g-cond))
+ (mutex (:pointer g-mutex)))
+
+(defcfun (g-cond-timed-wait "g_cond_timed_wait" :library glib) :boolean
+ (cond (:pointer g-cond))
+ (mutex (:pointer g-mutex))
+ (abs-time (:pointer g-time-val)))
+
+(defcfun (g-cond-free "g_cond_free" :library glib) :void
+ (cond (:pointer g-cond)))
+
+;omitted: GPrivate, GOnce stuff
+
+;omitted: Thread pools, Asynchronous queues, Dynamic Loading of Modules,
+; Memory Allocation, IO Channels, Error Reporting, Message Output and Debugging Functions, Message Logging
+
+(defcfun g-free :void
+ (ptr :pointer))
+
+(defcfun (g-malloc "g_malloc0") :pointer
+ (n-bytes gsize))
+
+(defcfun g-strdup :pointer
+ (str (:string :free-to-foreign t)))
+
+;omitted all GLib Utilites
+;TODO: omitted Date and Time Functions
+
--- /dev/null
+(in-package :glib)
+
+;; A type that it almost like :string but uses g_malloc and g_free
+
+(define-foreign-type g-string-type ()
+ ((free-from-foreign :initarg :fff :reader g-string-type-fff :initform nil)
+ (free-to-foreign :initarg :ftf :reader g-string-type-ftf :initform t))
+ (:actual-type :pointer))
+
+(define-parse-method g-string (&key (free-from-foreign nil) (free-to-foreign t))
+ (make-instance 'g-string-type :fff free-from-foreign :ftf free-to-foreign))
+
+(defmethod translate-to-foreign (value (type g-string-type))
+ (g-strdup value))
+
+(defmethod translate-from-foreign (value (type g-string-type))
+ (prog1
+ (convert-from-foreign value '(:string :free-from-foreign nil))
+ (when (g-string-type-fff type)
+ (g-free value))))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defcfun g-boxed-copy :pointer
+ (boxed-type g-type)
+ (src-boxed :pointer))
+
+(defcfun g-boxed-free :void
+ (boxed-type g-type)
+ (boxed :pointer))
+
+(defcfun g-boxed-type-register-static g-type
+ (name :string)
+ (copy-fn :pointer)
+ (free-fn :pointer))
+
+(defcfun g-pointer-type-register-static g-type
+ (name :string))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defcfun g-closure-ref (:pointer g-closure)
+ (closure (:pointer g-closure)))
+
+(defcfun g-closure-sink :void
+ (closure (:pointer g-closure)))
+
+(defcfun g-closure-unref :void
+ (closure (:pointer g-closure)))
+
+(defcfun g-closure-invalidate :void
+ (closure (:pointer g-closure)))
+
+(defcfun g-closure-add-finalize-notifier :void
+ (closure (:pointer g-closure))
+ (notify-data :pointer)
+ (notify-func :pointer))
+
+(defcfun g-closure-add-invalidate-notifier :void
+ (closure (:pointer g-closure))
+ (notify-data :pointer)
+ (notify-func :pointer))
+
+(defcfun g-closure-new-simple (:pointer g-closure)
+ (sizeof-closure :uint)
+ (data :pointer))
+
+(defcfun g-closure-set-marshal :void
+ (closure (:pointer g-closure))
+ (marshal :pointer))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defcfun g-enum-register-static g-type
+ (name :string)
+ (static-values (:pointer g-enum-value)))
+
+(defcfun g-flags-register-static g-type
+ (name :string)
+ (static-values (:pointer g-flags-value)))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defcstruct lisp-closure
+ (parent-instance g-closure)
+ (function-id :pointer))
+
+(defcallback lisp-closure-finalize :void ((data :pointer)
+ (closure (:pointer lisp-closure)))
+ (declare (ignore data))
+ (finalize-lisp-closure closure))
+
+(defcallback lisp-closure-marshal :void ((closure (:pointer lisp-closure))
+ (return-value (:pointer g-value))
+ (count-of-args :uint)
+ (args (:pointer g-value))
+ (invocation-hint :pointer)
+ (marshal-data :pointer))
+ (declare (ignore invocation-hint marshal-data))
+ (let* ((args (parse-closure-arguments count-of-args args))
+ (function-id (foreign-slot-value closure 'lisp-closure 'function-id))
+ (return-type (and (not (null-pointer-p return-value))
+ (gvalue-type return-value)))
+ (fn (get-stable-pointer-value function-id))
+ (fn-result (apply fn args)))
+ (when return-type
+ (set-g-value return-value fn-result return-type))))
+
+(defun parse-closure-arguments (count-of-args args)
+ (loop
+ for i from 0 below count-of-args
+ collect (parse-gvalue (mem-aref args 'g-value i))))
+
+(defun create-closure (fn)
+ (let ((function-id (allocate-stable-pointer fn))
+ (closure (g-closure-new-simple (foreign-type-size 'lisp-closure)
+ (null-pointer))))
+ (setf (foreign-slot-value closure 'lisp-closure 'function-id) function-id)
+ (g-closure-add-finalize-notifier closure (null-pointer)
+ (callback lisp-closure-finalize))
+ (g-closure-set-marshal closure (callback lisp-closure-marshal))
+ closure))
+
+(defun g-signal-connect (object signal handler &key after)
+ (g-signal-connect-closure (ensure-object-pointer object)
+ signal
+ (create-closure handler)
+ after))
+
+(defun finalize-lisp-closure (closure)
+ (let ((function-id (foreign-slot-value closure 'lisp-closure 'function-id)))
+ (free-stable-pointer function-id)))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defun ensure-list (thing)
+ (if (listp thing) thing (list thing)))
+
+(defun slot->cstruct-slot (slot)
+ (destructuring-bind (name type &key &allow-other-keys) slot
+ `(,name ,type)))
+
+(defun slot->slot-name (slot)
+ (destructuring-bind (name type &key &allow-other-keys) slot
+ (declare (ignore type))
+ name))
+
+(defun cstruct-definition (name slots)
+ `(defcstruct ,name ,@(mapcar #'slot->cstruct-slot slots)))
+
+(defun maybe-unlist (thing)
+ (if (or (not (listp thing)) (cdr thing))
+ thing
+ (car thing)))
+
+(defun slot->struct-slot (slot)
+ (destructuring-bind (name type &key initform &allow-other-keys) slot
+ (declare (ignore type))
+ (maybe-unlist `(,name ,@(when initform (list initform))))))
+
+(defun struct-definition (name superclass slots)
+ `(defstruct ,@(if superclass
+ (list `(,name (:include ,superclass)))
+ (list name))
+ ,@(mapcar #'slot->struct-slot slots)))
+
+(define-foreign-type g-boxed-pointer-type ()
+ ((name :accessor g-boxed-pointer-type-name :initarg :name)
+ (outp :accessor g-boxed-pointer-type-outp :initarg :outp)))
+
+(define-parse-method g-boxed-ptr (name &optional (type :in))
+ (make-instance 'g-boxed-pointer-type :name name :actual-type :pointer :outp (ecase type
+ (:in nil)
+ (:in-out t))))
+
+(defmethod translate-from-foreign (value (type g-boxed-pointer-type))
+ (unless (null-pointer-p value)
+ (parse-g-boxed value (g-boxed-pointer-type-name type))))
+
+(defmethod translate-to-foreign (value (type g-boxed-pointer-type))
+ (let ((ptr (foreign-alloc (boxed-c-structure-name (g-boxed-pointer-type-name type)))))
+ (real-unparse-g-boxed ptr value)
+ (values ptr value)))
+
+(defmethod free-translated-object (ptr (type g-boxed-pointer-type) param)
+ (when (g-boxed-pointer-type-outp type)
+ (let ((original-object param)
+ (new-real-name (g-boxed-real-name ptr (g-boxed-pointer-type-name type))))
+ (if (eq new-real-name (type-of original-object))
+ (real-parse-g-boxed ptr original-object)
+ (error "Type has changed!"))))
+ (foreign-free ptr))
+
+(defmethod expand-to-foreign-dyn (value var body (type g-boxed-pointer-type))
+ (let ((value-var (gensym)))
+ `(with-foreign-object (,var ',(boxed-c-structure-name (g-boxed-pointer-type-name type)))
+ (let ((,value-var ,value))
+ (real-unparse-g-boxed ,var ,value-var)
+ ,@body
+ ,@(when (g-boxed-pointer-type-outp type)
+ (list `(let ((new-real-name (g-boxed-real-name ,var ',(g-boxed-pointer-type-name type))))
+ (if (eq new-real-name (type-of ,value-var))
+ (real-parse-g-boxed ,var ,value-var)
+ (error "Type has changed from ~A to ~A" (type-of ,value-var) new-real-name)))))))))
+
+(define-foreign-type g-boxed-inline-type ()
+ ((name :accessor g-boxed-inline-type :initarg :name)))
+
+(define-parse-method g-boxed-inline (name)
+ (make-instance 'g-boxed-inline-type :name name :actual-type name))
+
+(defgeneric real-parse-g-boxed (pointer object))
+(defgeneric real-unparse-g-boxed (pointer object))
+
+(defun parse-g-boxed (pointer name)
+ (let* ((real-name (g-boxed-real-name pointer name))
+ (object (make-instance real-name)))
+ (real-parse-g-boxed pointer object)
+ object))
+
+(defun g-boxed->cstruct (object)
+ (let ((pointer (foreign-alloc (type-of object))))
+ (real-unparse-g-boxed pointer object)
+ pointer))
+
+(defun g-boxed-real-name (pointer name)
+ (or (loop
+ for (sub-name slot values) in (get name 'boxed-dispatch)
+ do (debugf "Checking ~A ~A ~A against ~A.~A = ~A~%" sub-name slot values name slot (foreign-slot-value pointer name slot))
+ when (member (foreign-slot-value pointer name slot) values :test 'equalp)
+ return (g-boxed-real-name pointer sub-name))
+ name))
+
+(defun slot->slot-parser (class-name pointer-var slot)
+ (bind (((slot-name slot-type &key parser &allow-other-keys) slot))
+ (cond
+ (parser
+ `(setf ,slot-name (funcall ,parser ',class-name ,pointer-var)))
+ ((and (listp slot-type) (eq 'g-boxed-inline (first slot-type)))
+ `(setf ,slot-name (parse-g-boxed (foreign-slot-pointer ,pointer-var ',class-name ',slot-name) ',(second slot-type))))
+ (t
+ `(setf ,slot-name (foreign-slot-value ,pointer-var ',class-name ',slot-name))))))
+
+(defun parse-method-definition (name slots)
+ (let ((slot-names (mapcar #'slot->slot-name slots)))
+ `(defmethod real-parse-g-boxed (pointer (object ,name))
+ (with-slots (,@slot-names) object
+ ,@(mapcar (lambda (slot) (slot->slot-parser name 'pointer slot)) slots)))))
+
+(defun slot->slot-unparser (class-name pointer-var slot object)
+ (bind (((slot-name slot-type &key unparser &allow-other-keys) slot))
+ (cond
+ (unparser
+ `(funcall ,unparser ',class-name ,pointer-var ,object))
+ ((and (listp slot-type) (eq 'g-boxed-inline (first slot-type)))
+ `(real-unparse-g-boxed (foreign-slot-pointer ,pointer-var ',class-name ',slot-name) ,slot-name))
+ (t
+ `(setf (foreign-slot-value ,pointer-var ',class-name ',slot-name) ,slot-name)))))
+
+(defun unparse-method-definition (name slots)
+ (let ((slot-names (mapcar #'slot->slot-name slots)))
+ `(defmethod real-unparse-g-boxed (pointer (object ,name))
+ (with-slots (,@slot-names) object
+ ,@(mapcar (lambda (slot) (slot->slot-unparser name 'pointer slot 'object)) slots)))))
+
+(defun slot->export-accessor (class-name slot)
+ (destructuring-bind (slot-name slot-type &key &allow-other-keys) slot
+ (declare (ignore slot-type))
+ (let ((accessor-name (intern (format nil "~A-~A" (symbol-name class-name) (symbol-name slot-name))
+ (symbol-package class-name))))
+ `(export ',accessor-name (symbol-package ',accessor-name)))))
+
+(defun struct-constructor-name (name)
+ (intern (format nil "MAKE-~A" (symbol-name name)) (symbol-package name)))
+
+(defun get-g-boxed-direct-subclasses (name)
+ (mapcar (lambda (spec) (bind (((name slot values) spec))
+ (declare (ignore slot values))
+ name))
+ (get name 'boxed-dispatch)))
+
+(defun map-append (f &rest lists)
+ (reduce #'append (apply #'mapcar f lists)))
+
+(defun get-g-boxed-all-subclasses (name)
+ (cons name
+ (map-append #'get-g-boxed-all-subclasses (get-g-boxed-direct-subclasses name))))
+
+(defun get-g-boxed-completed-c-definition (name union-name)
+ `(defcunion ,union-name
+ ,@(mapcar (lambda (sub-name)
+ `(,sub-name ,sub-name))
+ (get-g-boxed-all-subclasses name))))
+
+(defun g-boxed-root (name)
+ (if (get name 'superclass)
+ (g-boxed-root (get name 'superclass))
+ name))
+
+(defmacro update-g-boxed-root-c-class (name)
+ (when (get name 'c-name)
+ (get-g-boxed-completed-c-definition (g-boxed-root name) (get name 'c-name))))
+
+(defmacro define-g-boxed-class (g-name-and-c-name name (&optional superclass-and-dispatch (export t)) &body slots)
+ (bind (((&optional g-name c-name) (ensure-list g-name-and-c-name))
+ ((&optional superclass dispatch-slot dispatch-values) superclass-and-dispatch)
+ (superclass-slots (get superclass 'boxed-combined-slots))
+ (combined-slots (append superclass-slots slots)))
+ (setf c-name (or c-name (gensym "C-UNION-")))
+ `(progn ,(cstruct-definition name combined-slots)
+ ,(struct-definition name superclass slots)
+ ,(parse-method-definition name combined-slots)
+ ,(unparse-method-definition name combined-slots)
+ (eval-when (:load-toplevel :compile-toplevel :execute)
+ (setf (get ',name 'boxed-slots) ',slots
+ (get ',name 'boxed-combined-slots) ',combined-slots
+ (get ',name 'superclass) ',superclass
+ (get ',name 'c-name) (or (get ',name 'c-name) ',c-name))
+ ,@(when superclass
+ (list `(pushnew '(,name ,dispatch-slot ,(ensure-list dispatch-values)) (get ',superclass 'boxed-dispatch) :test 'equalp))))
+ (update-g-boxed-root-c-class ,name)
+ ,@(when g-name
+ (list `(register-boxed-type ,g-name ',name)))
+ ,@(when export
+ (append (list `(export ',name (symbol-package ',name))
+ `(export ',(struct-constructor-name name) (symbol-package ',(struct-constructor-name name))))
+ (mapcar (lambda (slot) (slot->export-accessor name slot)) slots))))))
+
+(defun boxed-c-structure-name (name)
+ (get (g-boxed-root name) 'c-name))
+
+(defclass g-boxed-ref () ((pointer :accessor pointer :initarg :pointer)))
+
+(defvar *known-boxed-refs* (tg:make-weak-hash-table :test 'equal :weakness :value))
+(defvar *boxed-ref-count* (make-hash-table :test 'equal))
+
+(defun boxed-ref-free-function (name)
+ (or (get name 'free-function)
+ (error "g-boxed-ref class ~A has no free-function" name)))
+
+(defun dispose-boxed-ref (type pointer)
+ (debugf "disposing g-boxed-ref ~A~%" pointer)
+ (unless (gethash (pointer-address pointer) *boxed-ref-count*)
+ (error "g-boxed-ref ~A is already disposed from lisp-side" pointer))
+ (unless (zerop (gethash (pointer-address pointer) *boxed-ref-count*))
+ (error "g-boxed-ref ~A is being disposed too early, it has still ~A references from lisp-side"
+ (pointer-address pointer)
+ (gethash (pointer-address pointer) *boxed-ref-count*)))
+ (aif (gethash (pointer-address pointer) *known-boxed-refs*)
+ (tg:cancel-finalization it))
+ (funcall (boxed-ref-free-function type) pointer)
+ (remhash (pointer-address pointer) *known-boxed-refs*)
+ (remhash (pointer-address pointer) *boxed-ref-count*))
+
+(defmethod initialize-instance :after ((object g-boxed-ref) &key)
+ (setf (gethash (pointer-address (pointer object)) *known-boxed-refs*) object)
+ (setf (gethash (pointer-address (pointer object)) *boxed-ref-count*) 1)
+ (debugf "setting g-boxed-ref-count of ~A to 1~%" (pointer object))
+ (let ((p (pointer object))
+ (type (type-of object)))
+ (tg:finalize object (lambda ()
+ (dispose-boxed-ref type p)))))
+
+(defmethod release ((object g-boxed-ref))
+ (debugf "releasing g-boxed-ref ~A~%" (pointer object))
+ (unless (gethash (pointer-address (pointer object)) *boxed-ref-count*)
+ (error "g-boxed-ref ~A is already disposed from lisp-side" (pointer object)))
+ (decf (gethash (pointer-address (pointer object)) *boxed-ref-count*))
+ (when (zerop (gethash (pointer-address (pointer object)) *boxed-ref-count*))
+ (dispose-boxed-ref (type-of object) (pointer object))))
+
+(define-foreign-type g-boxed-ref-type ()
+ ((class-name :reader g-boxed-ref-class-name :initarg :class-name))
+ (:actual-type :pointer))
+
+(define-parse-method g-boxed-ref (class-name)
+ (unless (get class-name 'is-g-boxed-ref)
+ (error "~A is not a subtype of G-BOXED-REF (~A: ~S)" class-name class-name (symbol-plist class-name)))
+ (make-instance 'g-boxed-ref-type :class-name class-name))
+
+(defmethod translate-to-foreign (value (type g-boxed-ref-type))
+ (if value
+ (pointer value)
+ (null-pointer)))
+
+(defun convert-g-boxed-ref-from-pointer (pointer name)
+ (unless (null-pointer-p pointer)
+ (or (gethash (pointer-address pointer) *known-boxed-refs*)
+ (make-instance name :pointer pointer))))
+
+(defmethod translate-from-foreign (value (type g-boxed-ref-type))
+ (convert-g-boxed-ref-from-pointer value (g-boxed-ref-class-name type)))
+
+(defun g-boxed-ref-slot->methods (class slot)
+ (bind (((slot-name &key reader writer type) slot))
+ `(progn ,@(when reader
+ (list `(defmethod ,slot-name ((object ,class))
+ ,(if (stringp reader)
+ `(foreign-funcall ,reader :pointer (pointer object) ,type)
+ `(,reader object)))))
+ ,@(when writer
+ (list `(defmethod (setf ,slot-name) (new-value (object ,class))
+ ,(if (stringp writer)
+ `(foreign-funcall ,writer :pointer (pointer object) ,type new-value)
+ `(,writer new-value object))))))))
+
+(defmacro define-g-boxed-ref (gobject-name name &rest properties)
+ (let ((free-fn (second (find :free-function properties :key 'first)))
+ (alloc-fn (second (find :alloc-function properties :key 'first)))
+ (slots (rest (find :slots properties :key 'first))))
+ (unless (and free-fn alloc-fn) (error "All of :free-function, :alloc-function must be specified"))
+ `(progn (defclass ,name (g-boxed-ref) ())
+ (defmethod initialize-instance ((object ,name) &key)
+ (unless (slot-boundp object 'pointer)
+ (setf (pointer object) (,alloc-fn))))
+ (setf (get ',name 'free-function) ',free-fn)
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf (get ',name 'is-g-boxed-ref) t))
+ ,@(mapcar (lambda (slot)
+ (g-boxed-ref-slot->methods name slot))
+ slots)
+ (register-boxed-type ,gobject-name ',name))))
+
+(define-foreign-type fixed-array ()
+ ((element-type :reader fixed-array-element-type :initarg :element-type :initform (error "Element type must be specified"))
+ (array-size :reader fixed-array-array-size :initarg :array-size :initform (error "Array size must be specified")))
+ (:actual-type :pointer))
+
+(define-parse-method fixed-array (element-type array-size)
+ (make-instance 'fixed-array :element-type element-type :array-size array-size))
+
+(defmethod translate-from-foreign (ptr (type fixed-array))
+ (when (not (null-pointer-p ptr))
+ (let ((result (make-array (fixed-array-array-size type)))
+ (el-type (fixed-array-element-type type)))
+ (loop
+ for i from 0 below (fixed-array-array-size type)
+ do (setf (aref result i) (mem-aref ptr el-type i)))
+ result)))
+
+(defvar *registered-boxed-types* (make-hash-table :test 'equal))
+(defun register-boxed-type (name type)
+ (setf (gethash name *registered-boxed-types*) type))
+(defun get-registered-boxed-type (name)
+ (gethash name *registered-boxed-types*))
+
+(defun set-gvalue-boxed (gvalue value)
+ (declare (ignore gvalue value))
+ (error "Can not set GBoxed!"))
+
+(defun parse-gvalue-boxed (gvalue)
+ (let* ((g-type (gvalue-type gvalue))
+ (type-name (g-type-name g-type))
+ (boxed-type (get-registered-boxed-type type-name)))
+ (unless boxed-type
+ (warn t "Type ~A is a not registered GBoxed~%" type-name)
+ (return-from parse-gvalue-boxed nil))
+ (unless (null-pointer-p (g-value-get-boxed gvalue))
+ (cond
+ ((subtypep boxed-type 'g-boxed-ref) (convert-g-boxed-ref-from-pointer (g-value-get-boxed gvalue) boxed-type))
+ (t (parse-g-boxed (g-value-get-boxed gvalue) boxed-type))))))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defclass g-object ()
+ ((pointer
+ :type cffi:foreign-pointer
+ :initarg :pointer
+ :accessor pointer
+ :initform nil)
+ (has-reference
+ :type boolean
+ :accessor g-object-has-reference
+ :initform nil)))
+
+(defvar *foreign-gobjects* (make-weak-hash-table :test 'equal :weakness :value))
+(defvar *foreign-gobjects-ref-count* (make-hash-table :test 'equal))
+
+(defcstruct g-object-struct
+ (type-instance g-type-instance)
+ (ref-count :uint)
+ (qdata :pointer))
+
+(defun ref-count (pointer)
+ (foreign-slot-value (if (pointerp pointer) pointer (pointer pointer)) 'g-object-struct 'ref-count))
+
+(defmethod initialize-instance :after ((obj g-object) &key &allow-other-keys)
+ (unless (slot-boundp obj 'pointer)
+ (error "Pointer slot is not initialized for ~A" obj))
+ (let ((pointer (pointer obj)))
+ #+ (or) (finalize obj
+ (lambda ()
+ (g-object-dispose pointer))))
+ (register-g-object obj))
+
+(defcallback weak-notify-print :void ((data :pointer) (object-pointer :pointer))
+ (debugf "g-object has disposed ~A ~A~%" (g-type-name (g-type-from-object object-pointer)) object-pointer))
+
+(defun register-g-object (obj)
+ (debugf "registered GObject ~A with ref-count ~A~%" (pointer obj) (ref-count obj))
+ (when (or t ;; Do not understand
+ (not (g-object-has-reference obj))
+ (g-object-is-floating (pointer obj)))
+ (debugf "g_object_ref_sink(~A)~%" (pointer obj))
+ (g-object-ref-sink (pointer obj)))
+ (g-object-weak-ref (pointer obj) (callback weak-notify-print) (null-pointer))
+ (setf (g-object-has-reference obj) t)
+ (setf (gethash (pointer-address (pointer obj)) *foreign-gobjects*)
+ obj)
+ (setf (gethash (pointer-address (pointer obj)) *foreign-gobjects-ref-count*) 1))
+
+(defun g-object-dispose (pointer)
+ (debugf "g_object_unref(~A) (of type ~A, lisp-value ~A) (lisp ref-count ~A, gobject ref-count ~A)~%"
+ pointer
+ (g-type-name (g-type-from-object pointer))
+ (gethash (pointer-address pointer) *foreign-gobjects*)
+ (gethash (pointer-address pointer) *foreign-gobjects-ref-count*)
+ (ref-count pointer))
+ (awhen (gethash (pointer-address pointer) *foreign-gobjects*)
+ (setf (pointer it) nil)
+ (cancel-finalization it))
+ (remhash (pointer-address pointer) *foreign-gobjects*)
+ (remhash (pointer-address pointer) *foreign-gobjects-ref-count*)
+ (g-object-unref pointer))
+
+(defmethod release ((object g-object))
+ (debugf "Releasing object ~A (type ~A, lisp-value ~A)~%" (pointer object) (when (pointer object) (g-type-name (g-type-from-object (pointer object)))) object)
+ (unless (and (pointer object) (gethash (pointer-address (pointer object)) *foreign-gobjects-ref-count*))
+ (error "Object ~A already disposed of from lisp side" object))
+ (decf (gethash (pointer-address (pointer object)) *foreign-gobjects-ref-count*))
+ (when (zerop (gethash (pointer-address (pointer object)) *foreign-gobjects-ref-count*))
+ (g-object-dispose (pointer object))))
+
+(defvar *registered-object-types* (make-hash-table :test 'equal))
+(defun register-object-type (name type)
+ (setf (gethash name *registered-object-types*) type))
+(defun get-g-object-lisp-type (g-type)
+ (loop
+ while (not (zerop g-type))
+ for lisp-type = (gethash (g-type-name g-type) *registered-object-types*)
+ when lisp-type do (return lisp-type)
+ do (setf g-type (g-type-parent g-type))))
+
+(defun make-g-object-from-pointer (pointer)
+ (let* ((g-type (g-type-from-instance pointer))
+ (lisp-type (get-g-object-lisp-type g-type)))
+ (unless lisp-type
+ (error "Type ~A is not registered with REGISTER-OBJECT-TYPE"
+ (g-type-name g-type)))
+ (make-instance lisp-type :pointer pointer)))
+
+(define-foreign-type foreign-g-object-type ()
+ ((sub-type :reader sub-type :initarg :sub-type :initform 'g-object))
+ (:actual-type :pointer))
+
+(define-parse-method g-object (&optional (sub-type 'g-object))
+ (make-instance 'foreign-g-object-type :sub-type sub-type))
+
+(defmethod translate-to-foreign (object (type foreign-g-object-type))
+ (cond
+ ((null (pointer object))
+ (error "Object ~A has been disposed" object))
+ ((typep object 'g-object)
+ (assert (typep object (sub-type type))
+ nil
+ "Object ~A is not a subtype of ~A" object (sub-type type))
+ (pointer object))
+ ((pointerp object) object)
+ (t (error "Object ~A is not translatable as GObject*" object))))
+
+(defun get-g-object-for-pointer (pointer)
+ (unless (null-pointer-p pointer)
+ (aif (gethash (pointer-address pointer) *foreign-gobjects*)
+ (prog1 it
+ (incf (gethash (pointer-address pointer) *foreign-gobjects-ref-count*))
+ (debugf "increfering object ~A~%" pointer))
+ (make-g-object-from-pointer pointer))))
+
+(defmethod translate-from-foreign (pointer (type foreign-g-object-type))
+ (get-g-object-for-pointer pointer))
+
+(register-object-type "GObject" 'g-object)
+
+(defun ensure-g-type (type)
+ (etypecase type
+ (integer type)
+ (string (or (g-type-from-name type)
+ (error "Type ~A is invalid" type)))))
+
+(defun ensure-object-pointer (object)
+ (if (pointerp object)
+ object
+ (etypecase object
+ (g-object (pointer object)))))
+
+(defun g-object-type-property-type (object-type property-name
+ &key assert-readable assert-writable)
+ (let* ((object-class (g-type-class-ref object-type))
+ (param-spec (g-object-class-find-property object-class property-name)))
+ (unwind-protect
+ (progn
+ (when (null-pointer-p param-spec)
+ (error "Property ~A on type ~A is not found"
+ property-name
+ (g-type-name object-type)))
+ (when (and assert-readable
+ (not (member :readable
+ (foreign-slot-value param-spec
+ 'g-param-spec
+ 'flags))))
+ (error "Property ~A on type ~A is not readable"
+ property-name
+ (g-type-name object-type)))
+ (when (and assert-writable
+ (not (member :writable
+ (foreign-slot-value param-spec
+ 'g-param-spec
+ 'flags))))
+ (error "Property ~A on type ~A is not writable"
+ property-name
+ (g-type-name object-type)))
+ (foreign-slot-value param-spec 'g-param-spec 'value-type))
+ (g-type-class-unref object-class))))
+
+(defun g-object-property-type (object property-name
+ &key assert-readable assert-writable)
+ (g-object-type-property-type (g-type-from-object (ensure-object-pointer object))
+ property-name
+ :assert-readable assert-readable
+ :assert-writable assert-writable))
+
+(defun g-object-call-constructor (object-type args-names args-values
+ &optional args-types)
+ (setf object-type (ensure-g-type object-type))
+ (unless args-types
+ (setf args-types
+ (mapcar (lambda (name)
+ (g-object-type-property-type object-type name))
+ args-names)))
+ (let ((args-count (length args-names)))
+ (with-foreign-object (parameters 'g-parameter args-count)
+ (loop
+ for i from 0 below args-count
+ for arg-name in args-names
+ for arg-value in args-values
+ for arg-type in args-types
+ for arg-g-type = (ensure-g-type arg-type)
+ for parameter = (mem-aref parameters 'g-parameter i)
+ do (setf (foreign-slot-value parameter 'g-parameter 'name) arg-name)
+ do (set-g-value (foreign-slot-value parameter 'g-parameter 'value)
+ arg-value arg-g-type
+ :zero-g-value t))
+ (unwind-protect
+ (g-object-newv object-type args-count parameters)
+ (loop
+ for i from 0 below args-count
+ for parameter = (mem-aref parameters 'g-parameter i)
+ do (foreign-free
+ (mem-ref (foreign-slot-pointer parameter 'g-parameter 'name)
+ :pointer))
+ do (g-value-unset
+ (foreign-slot-pointer parameter 'g-parameter 'value)))))))
+
+(defun g-object-call-get-property (object property-name &optional property-type)
+ (unless property-type
+ (setf property-type
+ (g-object-property-type object property-name :assert-readable t)))
+ (setf property-type (ensure-g-type property-type))
+ (with-foreign-object (value 'g-value)
+ (g-value-zero value)
+ (g-value-init value property-type)
+ (g-object-get-property (ensure-object-pointer object)
+ property-name value)
+ (unwind-protect
+ (parse-gvalue value)
+ (g-value-unset value))))
+
+(defun g-object-call-set-property (object property-name new-value
+ &optional property-type)
+ (unless property-type
+ (setf property-type
+ (g-object-property-type object property-name :assert-writable t)))
+ (setf property-type (ensure-g-type property-type))
+ (with-foreign-object (value 'g-value)
+ (set-g-value value new-value property-type :zero-g-value t)
+ (unwind-protect
+ (g-object-set-property (ensure-object-pointer object)
+ property-name value)
+ (g-value-unset value))))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defgeneric release (object))
+
+(defun release* (&rest objects)
+ (declare (dynamic-extent objects))
+ (loop
+ for object in objects
+ do (release object)))
+
+(defmacro using ((var expr) &body body)
+ `(let ((,var ,expr))
+ (unwind-protect
+ (progn ,@body)
+ (release ,var))))
+
+(defun using-expand (bindings body)
+ (if bindings
+ (destructuring-bind (var expr) (first bindings)
+ `(let ((,var ,expr))
+ (unwind-protect
+ ,(using-expand (rest bindings) body)
+ (release ,var))))
+ `(progn ,@body)))
+
+(defmacro using* ((&rest bindings) &body body)
+ (using-expand bindings body))
+
+(defvar *registered-stable-pointers* (make-array 0 :adjustable t :fill-pointer t))
+
+(defun allocate-stable-pointer (thing)
+ (let ((id (find-fresh-id)))
+ (setf (aref *registered-stable-pointers* id) thing)
+ (make-pointer id)))
+
+(defun free-stable-pointer (stable-pointer)
+ (setf (aref *registered-stable-pointers* (pointer-address stable-pointer)) nil))
+
+(defun get-stable-pointer-value (stable-pointer)
+ (aref *registered-stable-pointers* (pointer-address stable-pointer)))
+
+(defun find-fresh-id ()
+ (or (position nil *registered-stable-pointers*)
+ (progn (vector-push-extend nil *registered-stable-pointers*)
+ (1- (length *registered-stable-pointers*)))))
+
+(defmacro with-stable-pointer ((ptr expr) &body body)
+ `(let ((,ptr (allocate-stable-pointer ,expr)))
+ (unwind-protect
+ (progn ,@body)
+ (free-stable-pointer ,ptr))))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defvar *lisp-name-package* (find-package :gobject))
+(defvar *strip-prefix* "")
+(defvar *lisp-name-exceptions* nil)
+(defvar *generation-exclusions* nil)
+(defvar *known-interfaces* (make-hash-table :test 'equal))
+
+(defun name->supplied-p (name)
+ (intern (format nil "~A-SUPPLIED-P" (symbol-name name))
+ *lisp-name-package*))
+
+(defun property->method-arg (property)
+ (destructuring-bind (name accessor-name g-name type readable writable) property
+ (declare (ignore accessor-name g-name type readable writable))
+ `(,name nil ,(name->supplied-p name))))
+
+(defun property->arg-push (property)
+ (destructuring-bind (name accessor-name g-name type readable writable) property
+ (declare (ignore accessor-name readable writable))
+ `(when ,(name->supplied-p name)
+ (push ,g-name arg-names)
+ (push ,type arg-types)
+ (push ,name arg-values))))
+
+(defun accessor-name (class-name property-name)
+ (intern (format nil "~A-~A" (symbol-name class-name)
+ (lispify-name property-name))
+ *lisp-name-package*))
+
+(defun property->reader (property)
+ (let ((name (nth 1 property))
+ (prop-name (nth 2 property))
+ (prop-type (nth 3 property)))
+ `(defun ,name (object)
+ (g-object-call-get-property object ,prop-name ,prop-type))))
+
+(defun property->writer (property)
+ (let ((name (nth 1 property))
+ (prop-name (nth 2 property))
+ (prop-type (nth 3 property)))
+ `(defun (setf ,name) (new-value object)
+ (g-object-call-set-property object ,prop-name new-value ,prop-type)
+ new-value)))
+
+(defun property->accessors (property export)
+ (append (when (nth 4 property)
+ (list (property->reader property)))
+ (when (nth 5 property)
+ (list (property->writer property)))
+ (when export
+ (list `(export ',(nth 1 property)
+ (find-package ,(package-name (symbol-package (nth 1 property)))))))))
+
+(defun interface->lisp-class-name (interface)
+ (etypecase interface
+ (symbol interface)
+ (string (or (gethash interface *known-interfaces*)
+ (error "Unknown interface ~A" interface)))))
+
+(defmacro define-g-object-class (g-type-name name (&optional (superclass 'g-object) (export t)) (&rest interfaces)
+ &body properties)
+ (let* ((superclass-properties (get superclass 'properties))
+ (combined-properties (append superclass-properties properties)))
+ `(progn
+ (defclass ,name (,superclass ,@(mapcar #'interface->lisp-class-name interfaces)) ())
+ (register-object-type ,g-type-name ',name)
+ ,@(when export
+ (list `(export ',name (find-package ,(package-name (symbol-package name))))))
+ (defmethod initialize-instance :before
+ ((object ,name) &key pointer
+ ,@(mapcar #'property->method-arg
+ combined-properties))
+ (unless (or pointer (and (slot-boundp object 'pointer)
+ (not (null-pointer-p (pointer object)))))
+ (let (arg-names arg-values arg-types)
+ ,@(mapcar #'property->arg-push combined-properties)
+ (setf (pointer object)
+ (g-object-call-constructor ,g-type-name
+ arg-names
+ arg-values
+ arg-types)
+ (g-object-has-reference object) t))))
+ ,@(loop
+ for property in properties
+ append (property->accessors property export))
+
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf (get ',name 'superclass) ',superclass
+ (get ',name 'properties) ',combined-properties)))))
+
+(defmacro define-g-interface (g-name name (&optional (export t)) &body properties)
+ `(progn
+ (defclass ,name () ())
+ ,@(when export
+ (list `(export ',name (find-package ,(package-name (symbol-package name))))))
+ ,@(loop
+ for property in properties
+ append (property->accessors property export))
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf (get ',name 'properties) ',properties)
+ (setf (gethash ,g-name *known-interfaces*) ',name))))
+
+(defun starts-with (name prefix)
+ (and prefix (> (length name) (length prefix)) (string= (subseq name 0 (length prefix)) prefix)))
+
+(defun strip-start (name prefix)
+ (if (starts-with name prefix)
+ (subseq name (length prefix))
+ name))
+
+(defun lispify-name (name)
+ (with-output-to-string (stream)
+ (loop for c across (strip-start name *strip-prefix*)
+ for firstp = t then nil
+ do (when (and (not firstp) (upper-case-p c)) (write-char #\- stream))
+ do (write-char (char-upcase c) stream))))
+
+(defun g-name->name (name)
+ (or (second (assoc name *lisp-name-exceptions* :test 'equal))
+ (intern (string-upcase (lispify-name name)) *lisp-name-package*)))
+
+(defun property->property-definition (class-name property)
+ (let ((name (g-name->name (g-class-property-definition-name property)))
+ (accessor-name (accessor-name class-name (g-class-property-definition-name property)))
+ (g-name (g-class-property-definition-name property))
+ (type (g-type-name (g-class-property-definition-type property)))
+ (readable (g-class-property-definition-readable property))
+ (writable (and (g-class-property-definition-writable property)
+ (not (g-class-property-definition-constructor-only property)))))
+ `(,name ,accessor-name ,g-name ,type ,readable ,writable)))
+
+(defun get-g-class-definition (type)
+ (let* ((g-type (ensure-g-type type))
+ (g-name (g-type-name g-type))
+ (name (g-name->name g-name))
+ (superclass-g-type (g-type-parent g-type))
+ (superclass-name (g-name->name (g-type-name superclass-g-type)))
+ (interfaces (g-type-interfaces g-type))
+ (properties (class-properties g-type))
+ (own-properties
+ (remove-if-not (lambda (property)
+ (= g-type
+ (g-class-property-definition-owner-type property)))
+ properties)))
+ `(define-g-object-class ,g-name ,name (,superclass-name t) (,@(mapcar #'g-type-name interfaces))
+ ,@(mapcar (lambda (property)
+ (property->property-definition name property))
+ own-properties))))
+
+(defun get-g-interface-definition (interface)
+ (let* ((type (ensure-g-type interface))
+ (g-name (g-type-name type))
+ (name (g-name->name g-name))
+ (properties (interface-properties type)))
+ `(define-g-interface ,g-name ,name (t)
+ ,@(mapcar (lambda (property)
+ (property->property-definition name property))
+ properties))))
+
+(defun get-g-class-definitions-for-root-1 (type)
+ (unless (member (ensure-g-type type) *generation-exclusions* :test '=)
+ (cons (get-g-class-definition type)
+ (reduce #'append
+ (mapcar #'get-g-class-definitions-for-root-1
+ (g-type-children type))))))
+
+(defun get-g-class-definitions-for-root (type)
+ (setf type (ensure-g-type type))
+ (get-g-class-definitions-for-root-1 type))
+
+(defvar *referenced-types*)
+
+(defun class-or-interface-properties (type)
+ (setf type (ensure-g-type type))
+ (cond
+ ((= (g-type-fundamental type) +g-type-object+) (class-properties type))
+ ((= (g-type-fundamental type) +g-type-interface+) (interface-properties type))))
+
+(defun get-shallow-referenced-types (type)
+ (setf type (ensure-g-type type))
+ (remove-duplicates (sort (loop
+ for property in (class-or-interface-properties type)
+ when (= type (g-class-property-definition-owner-type property))
+ collect (g-class-property-definition-type property))
+ #'<)
+ :test 'equal))
+
+(defun get-referenced-types-1 (type)
+ (setf type (ensure-g-type type))
+ (loop
+ for property-type in (get-shallow-referenced-types type)
+ do (pushnew property-type *referenced-types* :test '=))
+ (loop
+ for type in (g-type-children type)
+ do (get-referenced-types-1 type)))
+
+(defun get-referenced-types (root-type)
+ (let (*referenced-types*)
+ (get-referenced-types-1 (ensure-g-type root-type))
+ *referenced-types*))
+
+(defun filter-types-by-prefix (types prefix)
+ (remove-if-not
+ (lambda (type)
+ (starts-with (g-type-name (ensure-g-type type)) prefix))
+ types))
+
+(defun filter-types-by-fund-type (types fund-type)
+ (setf fund-type (ensure-g-type fund-type))
+ (remove-if-not
+ (lambda (type)
+ (equal (g-type-fundamental (ensure-g-type type)) fund-type))
+ types))
+
+(defmacro define-g-enum (g-name name (&optional (export t)) &body values)
+ `(progn
+ (defcenum ,name ,@values)
+ (register-enum-type ,g-name ',name)
+ ,@(when export
+ (list `(export ',name (find-package ,(package-name (symbol-package name))))))))
+
+(defun enum-value->definition (enum-value)
+ (let ((value-name (intern (lispify-name (enum-item-nick enum-value))
+ (find-package :keyword)))
+ (numeric-value (enum-item-value enum-value)))
+ `(,value-name ,numeric-value)))
+
+(defun get-g-enum-definition (type)
+ (let* ((g-type (ensure-g-type type))
+ (g-name (g-type-name g-type))
+ (name (g-name->name g-name))
+ (items (get-enum-items g-type)))
+ `(define-g-enum ,g-name ,name (t) ,@(mapcar #'enum-value->definition items))))
+
+(defmacro define-g-flags (g-name name (&optional (export t)) &body values)
+ `(progn
+ (defbitfield ,name ,@values)
+ (register-enum-type ,g-name ',name)
+ ,@(when export
+ (list `(export ',name (find-package ,(package-name (symbol-package name))))))))
+
+(defun flags-value->definition (flags-value)
+ (let ((value-name (intern (lispify-name (flags-item-nick flags-value))
+ (find-package :keyword)))
+ (numeric-value (flags-item-value flags-value)))
+ `(,value-name ,numeric-value)))
+
+(defun get-g-flags-definition (type)
+ (let* ((g-type (ensure-g-type type))
+ (g-name (g-type-name g-type))
+ (name (g-name->name g-name))
+ (items (get-flags-items g-type)))
+ `(define-g-flags ,g-name ,name (t) ,@(mapcar #'flags-value->definition items))))
+
+(defun generate-types-hierarchy-to-file (file root-type &key include-referenced prefix package exceptions prologue interfaces enums flags objects exclusions)
+ (if (not (streamp file))
+ (with-open-file (stream file :direction :output :if-exists :supersede)
+ (generate-types-hierarchy-to-file stream root-type
+ :prefix prefix
+ :package package
+ :exceptions exceptions
+ :prologue prologue
+ :include-referenced include-referenced
+ :interfaces interfaces
+ :enums enums
+ :flags flags
+ :objects objects
+ :exclusions exclusions))
+ (let* ((*generation-exclusions* (mapcar #'ensure-g-type exclusions))
+ (*lisp-name-package* (or package *package*))
+ (*package* *lisp-name-package*)
+ (*strip-prefix* (or prefix ""))
+ (*lisp-name-exceptions* exceptions)
+ (*print-case* :downcase)
+ (referenced-types (and include-referenced
+ (filter-types-by-prefix
+ (get-referenced-types root-type)
+ prefix))))
+ (setf exclusions (mapcar #'ensure-g-type exclusions))
+ (when prologue
+ (write-string prologue file)
+ (terpri file))
+ (when include-referenced
+ (loop
+ for interface in interfaces
+ do (loop
+ for referenced-type in (get-shallow-referenced-types interface)
+ do (pushnew referenced-type referenced-types :test 'equal)))
+ (loop
+ for object in objects
+ do (loop
+ for referenced-type in (get-shallow-referenced-types object)
+ do (pushnew referenced-type referenced-types :test 'equal)))
+ (loop
+ for enum-type in (filter-types-by-fund-type
+ referenced-types "GEnum")
+ for def = (get-g-enum-definition enum-type)
+ unless (member (ensure-g-type enum-type) exclusions :test '=)
+ do (format file "~S~%~%" def))
+
+ (loop
+ for flags-type in (filter-types-by-fund-type
+ referenced-types "GFlags")
+ for def = (get-g-flags-definition flags-type)
+ unless (member (ensure-g-type flags-type) exclusions :test '=)
+ do (format file "~S~%~%" def)))
+ (loop
+ with auto-enums = (and include-referenced
+ (filter-types-by-fund-type
+ referenced-types "GEnum"))
+ for enum in enums
+ for def = (get-g-enum-definition enum)
+ unless (find (ensure-g-type enum) auto-enums :test 'equal)
+ do (format file "~S~%~%" def))
+ (loop
+ with auto-flags = (and include-referenced
+ (filter-types-by-fund-type
+ referenced-types "GFlags"))
+ for flags-type in flags
+ for def = (get-g-flags-definition flags-type)
+ unless (find (ensure-g-type flags-type) auto-flags :test 'equal)
+ do (format file "~S~%~%" def))
+ (loop
+ for interface in interfaces
+ for def = (get-g-interface-definition interface)
+ do (format file "~S~%~%" def))
+ (loop
+ for def in (get-g-class-definitions-for-root root-type)
+ do (format file "~S~%~%" def))
+ (loop
+ for object in objects
+ for def = (get-g-class-definition object)
+ do (format file "~S~%~%" def)))))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defstruct g-class-property-definition
+ name
+ type
+ readable
+ writable
+ constructor
+ constructor-only
+ owner-type)
+
+(defun class-properties (g-type)
+ (setf g-type (ensure-g-type g-type))
+ (let ((g-class (g-type-class-ref g-type)))
+ (unwind-protect
+ (with-foreign-object (n-properties :uint)
+ (let ((params (g-object-class-list-properties g-class n-properties)))
+ (unwind-protect
+ (loop
+ for i from 0 below (mem-ref n-properties :uint)
+ for param = (mem-aref params :pointer i)
+ for flags = (foreign-slot-value param 'g-param-spec 'flags)
+ collect (make-g-class-property-definition
+ :name (foreign-slot-value param 'g-param-spec
+ 'name)
+ :type (foreign-slot-value param 'g-param-spec
+ 'value-type)
+ :readable (not (null (member :readable flags)))
+ :writable (not (null (member :writable flags)))
+ :constructor (not (null (member :construct flags)))
+ :constructor-only (not (null (member :construct-only flags)))
+ :owner-type (foreign-slot-value param 'g-param-spec
+ 'owner-type)))
+ (g-free params))))
+ (g-type-class-unref g-class))))
+
+(defun class-parent (type)
+ (g-type-parent (ensure-g-type type)))
+
+(defun interface-properties (g-type)
+ (setf g-type (ensure-g-type g-type))
+ (let ((g-iface (g-type-default-interface-ref g-type)))
+ (unwind-protect
+ (with-foreign-object (n-properties :uint)
+ (let ((params (g-object-interface-list-properties g-iface n-properties)))
+ (unwind-protect
+ (loop
+ for i from 0 below (mem-ref n-properties :uint)
+ for param = (mem-aref params :pointer i)
+ for flags = (foreign-slot-value param 'g-param-spec 'flags)
+ collect (make-g-class-property-definition
+ :name (foreign-slot-value param 'g-param-spec
+ 'name)
+ :type (foreign-slot-value param 'g-param-spec
+ 'value-type)
+ :readable (not (null (member :readable flags)))
+ :writable (not (null (member :writable flags)))
+ :constructor (not (null (member :construct flags)))
+ :constructor-only (not (null (member :construct-only flags)))
+ :owner-type (foreign-slot-value param 'g-param-spec
+ 'owner-type)))
+ (g-free params))))
+ (g-type-default-interface-unref g-iface))))
+
+(defstruct enum-item
+ name value nick)
+
+(defun get-enum-items (type)
+ (let ((g-class (g-type-class-ref (ensure-g-type type))))
+ (unwind-protect
+ (loop
+ with n = (foreign-slot-value g-class 'g-enum-class 'n-values)
+ with values = (foreign-slot-value g-class 'g-enum-class 'values)
+ for i from 0 below n
+ for enum-value = (mem-aref values 'g-enum-value i)
+ collect (make-enum-item
+ :name (foreign-slot-value enum-value 'g-enum-value
+ 'name)
+ :value (foreign-slot-value enum-value 'g-enum-value
+ 'value)
+ :nick (foreign-slot-value enum-value 'g-enum-value
+ 'nick)))
+ (g-type-class-unref g-class))))
+
+(defstruct flags-item
+ name value nick)
+
+(defun get-flags-items (type)
+ (let ((g-class (g-type-class-ref (ensure-g-type type))))
+ (unwind-protect
+ (loop
+ with n = (foreign-slot-value g-class 'g-flags-class 'n-values)
+ with values = (foreign-slot-value g-class 'g-flags-class 'values)
+ for i from 0 below n
+ for flags-value = (mem-aref values 'g-flags-value i)
+ collect (make-flags-item
+ :name (foreign-slot-value flags-value 'g-flags-value
+ 'name)
+ :value (foreign-slot-value flags-value 'g-flags-value
+ 'value)
+ :nick (foreign-slot-value flags-value 'g-flags-value
+ 'nick)))
+ (g-type-class-unref g-class))))
--- /dev/null
+(in-package :gobject)
+
+(defcfun g-param-spec-boolean (:pointer g-param-spec-boolean)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (default-value :boolean)
+ (flags g-param-flags))
+
+(defcfun g-value-set-boolean :void
+ (g-value (:pointer g-value))
+ (new-value :boolean))
+
+(defcfun g-value-get-boolean :boolean
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-char (:pointer g-param-spec-char)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :int8)
+ (maximum :int8)
+ (default-value :int8)
+ (flags g-param-flags))
+
+(defcfun g-value-set-char :void
+ (g-value (:pointer g-value))
+ (new-value :char))
+
+(defcfun g-value-get-char :char
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-uchar (:pointer g-param-spec-uchar)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :uint8)
+ (maximum :uint8)
+ (default-value :uint8)
+ (flags g-param-flags))
+
+(defcfun g-value-set-uchar :void
+ (g-value (:pointer g-value))
+ (new-value :uchar))
+
+(defcfun g-value-get-uchar :uchar
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-int (:pointer g-param-spec-int)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :int)
+ (maximum :int)
+ (default-value :int)
+ (flags g-param-flags))
+
+(defcfun g-value-set-int :void
+ (g-value (:pointer g-value))
+ (new-value :int))
+
+(defcfun g-value-get-int :int
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-uint (:pointer g-param-spec-uint)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :uint)
+ (maximum :uint)
+ (default-value :uint)
+ (flags g-param-flags))
+
+(defcfun g-value-set-uint :void
+ (g-value (:pointer g-value))
+ (new-value :uint))
+
+(defcfun g-value-get-uint :uint
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-long (:pointer g-param-spec-long)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :long)
+ (maximum :long)
+ (default-value :long)
+ (flags g-param-flags))
+
+(defcfun g-value-set-long :void
+ (g-value (:pointer g-value))
+ (new-value :long))
+
+(defcfun g-value-get-long :long
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-ulong (:pointer g-param-spec-ulong)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :ulong)
+ (maximum :ulong)
+ (default-value :ulong)
+ (flags g-param-flags))
+
+(defcfun g-value-set-ulong :void
+ (g-value (:pointer g-value))
+ (new-value :ulong))
+
+(defcfun g-value-get-ulong :ulong
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-int64 (:pointer g-param-spec-int64)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :int64)
+ (maximum :int64)
+ (default-value :int64)
+ (flags g-param-flags))
+
+(defcfun g-value-set-int64 :void
+ (g-value (:pointer g-value))
+ (new-value :int64))
+
+(defcfun g-value-get-int64 :int64
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-uint64 (:pointer g-param-spec-uint64)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :uint64)
+ (maximum :uint64)
+ (default-value :uint64)
+ (flags g-param-flags))
+
+(defcfun g-value-set-uint64 :void
+ (g-value (:pointer g-value))
+ (new-value :uint64))
+
+(defcfun g-value-get-uint64 :uint64
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-float (:pointer g-param-spec-float)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :float)
+ (maximum :float)
+ (default-value :float)
+ (flags g-param-flags))
+
+(defcfun g-value-set-float :void
+ (g-value (:pointer g-value))
+ (new-value :float))
+
+(defcfun g-value-get-float :float
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-double (:pointer g-param-spec-double)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (minimum :double)
+ (maximum :double)
+ (default-value :double)
+ (flags g-param-flags))
+
+(defcfun g-value-set-double :void
+ (g-value (:pointer g-value))
+ (new-value :double))
+
+(defcfun g-value-get-double :double
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-enum (:pointer g-param-spec-enum)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (enum-type g-type)
+ (default-value :int)
+ (flags g-param-flags))
+
+(defcfun g-value-set-enum :void
+ (g-value (:pointer g-value))
+ (new-value :int))
+
+(defcfun g-value-get-enum :int
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-flags (:pointer g-param-spec-flags)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (flags-type g-type)
+ (default-value :int)
+ (flags g-param-flags))
+
+(defcfun g-value-set-flags :void
+ (g-value (:pointer g-value))
+ (new-value :int))
+
+(defcfun g-value-get-flags :int
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-string (:pointer g-param-spec-string)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (default-value :string)
+ (flags g-param-flags))
+
+(defcfun g-value-set-string :void
+ (g-value (:pointer g-value))
+ (new-value :string))
+
+(defcfun g-value-get-string (:string :free-from-foreign nil)
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-param (:pointer g-param-spec-param)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (param-type g-type)
+ (flags g-param-flags))
+
+(defcfun g-value-set-param :void
+ (g-value (:pointer g-value))
+ (new-value (:pointer g-param-spec)))
+
+(defcfun g-value-get-param (:pointer g-param-spec)
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-boxed (:pointer g-param-spec-boxed)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (boxed-type g-type)
+ (flags g-param-flags))
+
+(defcfun g-value-set-boxed :void
+ (g-value (:pointer g-value))
+ (new-value :pointer))
+
+(defcfun g-value-get-boxed :pointer
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-pointer (:pointer g-param-spec-pointer)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (flags g-param-flags))
+
+(defcfun g-value-set-pointer :void
+ (g-value (:pointer g-value))
+ (new-value :pointer))
+
+(defcfun g-value-get-pointer :pointer
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-object (:pointer g-param-spec-object)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (object-type g-type)
+ (flags g-param-flags))
+
+(defcfun g-value-set-object :void
+ (g-value (:pointer g-value))
+ (new-value :pointer))
+
+(defcfun g-value-get-object :pointer
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-value-array (:pointer g-param-spec-value-array)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (element-spec (:pointer g-param-spec))
+ (flags g-param-flags))
+
+(defcfun g-param-spec-g-type (:pointer g-param-spec-g-type)
+ (name :string)
+ (nick :string)
+ (blurb :string)
+ (types-root g-type)
+ (flags g-param-flags))
+
+(defcfun (g-value-set-g-type "g_value_set_gtype") :void
+ (g-value (:pointer g-value))
+ (new-value g-type))
+
+(defcfun (g-value-get-g-type "g_value_get_gtype") g-type
+ (g-value (:pointer g-value)))
+
+(defcfun g-param-spec-ref-sink (:pointer g-param-spec)
+ (param-spec (:pointer g-param-spec)))
+
+(defcfun g-param-spec-unref :void
+ (param-spec (:pointer g-param-spec)))
+
+(defcfun g-param-value-set-default :void
+ (param-spec (:pointer g-param-spec))
+ (value (:pointer g-value)))
+
+(defcfun g-param-value-defaults :boolean
+ (param-spec (:pointer g-param-spec))
+ (value (:pointer g-value)))
+
+(defcfun g-param-value-validate :boolean
+ (param-spec (:pointer g-param-spec))
+ (value (:pointer g-value)))
+
+(defcfun g-param-spec-get-name :string
+ (param-spec (:pointer g-param-spec)))
+
+(defcfun g-param-spec-get-nick :string
+ (param-spec (:pointer g-param-spec)))
+
+(defcfun g-param-spec-get-blurb :string
+ (param-spec (:pointer g-param-spec)))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defun gvalue-type (gvalue)
+ (foreign-slot-value gvalue 'g-value 'type))
+
+(defmacro ev-case (keyform &body clauses)
+ "Macro that is an analogue of CASE except that it evaluates keyforms"
+ (let ((value (gensym)))
+ `(let ((,value ,keyform))
+ (cond
+ ,@(loop
+ for (key . forms) in clauses
+ collect
+ (if (eq key t)
+ `(t ,@forms)
+ `((equalp ,key ,value) ,@forms)))))))
+
+(defun parse-gvalue (gvalue)
+ (let* ((type (gvalue-type gvalue))
+ (fundamental-type (g-type-fundamental type)))
+ (cond
+ ((= type (g-strv-get-type)) (convert-from-foreign (g-value-get-boxed gvalue) '(glib:gstrv :free-from-foreign nil)))
+ (t (ev-case fundamental-type
+ (+g-type-invalid+ (error "GValue is of invalid type (~A)" (g-type-name type)))
+ (+g-type-void+ nil)
+ (+g-type-char+ (g-value-get-char gvalue))
+ (+g-type-uchar+ (g-value-get-uchar gvalue))
+ (+g-type-boolean+ (g-value-get-boolean gvalue))
+ (+g-type-int+ (g-value-get-int gvalue))
+ (+g-type-uint+ (g-value-get-uint gvalue))
+ (+g-type-long+ (g-value-get-long gvalue))
+ (+g-type-ulong+ (g-value-get-ulong gvalue))
+ (+g-type-int64+ (g-value-get-int64 gvalue))
+ (+g-type-uint64+ (g-value-get-uint64 gvalue))
+ (+g-type-enum+ (parse-gvalue-enum gvalue))
+ (+g-type-flags+ (parse-gvalue-flags gvalue))
+ (+g-type-float+ (g-value-get-float gvalue))
+ (+g-type-double+ (g-value-get-double gvalue))
+ (+g-type-string+ (g-value-get-string gvalue))
+ (+g-type-pointer+ (g-value-get-pointer gvalue))
+ (+g-type-boxed+ (parse-gvalue-boxed gvalue))
+ ;(+g-type-param+ (parse-gvalue-param gvalue))
+ (+g-type-object+ (parse-gvalue-object gvalue))
+ (+g-type-interface+ (parse-gvalue-object gvalue))
+ (t (error "Unknown type: ~A (~A)" type (g-type-name type))))))))
+
+(defun set-g-value (gvalue value type &key zero-g-value)
+ (if zero-g-value
+ (g-value-zero gvalue)
+ (g-value-unset gvalue))
+ (g-value-init gvalue type)
+ (let ((fundamental-type (g-type-fundamental type)))
+ (cond
+ ((= type (g-strv-get-type)) (g-value-set-boxed gvalue (convert-to-foreign value 'glib:gstrv)))
+ (t (ev-case fundamental-type
+ (+g-type-invalid+ (error "Invalid type (~A)" type))
+ (+g-type-void+ nil)
+ (+g-type-char+ (g-value-set-char gvalue value))
+ (+g-type-uchar+ (g-value-set-uchar gvalue value))
+ (+g-type-boolean+ (g-value-set-boolean gvalue value))
+ (+g-type-int+ (g-value-set-int gvalue value))
+ (+g-type-uint+ (g-value-set-uint gvalue value))
+ (+g-type-long+ (g-value-set-long gvalue value))
+ (+g-type-ulong+ (g-value-set-ulong gvalue value))
+ (+g-type-int64+ (g-value-set-int64 gvalue value))
+ (+g-type-uint64+ (g-value-set-uint64 gvalue value))
+ (+g-type-enum+ (set-gvalue-enum gvalue value))
+ (+g-type-flags+ (set-gvalue-flags gvalue value))
+ (+g-type-float+ (unless (realp value) (error "~A is not a real number" value)) (g-value-set-float gvalue (coerce value 'single-float)))
+ (+g-type-double+ (unless (realp value) (error "~A is not a real number" value)) (g-value-set-double gvalue (coerce value 'double-float)))
+ (+g-type-string+ (g-value-set-string gvalue value))
+ (+g-type-pointer+ (g-value-set-pointer gvalue value))
+ (+g-type-boxed+ (set-gvalue-boxed gvalue value))
+ ;(+g-type-param+ (set-gvalue-param gvalue value))
+ (+g-type-object+ (set-gvalue-object gvalue value))
+ (+g-type-interface+ (set-gvalue-object gvalue value))
+ (t (error "Unknown type: ~A (~A)" type (g-type-name type))))))))
+
+;;Enums
+
+(defvar *registered-enum-types* (make-hash-table :test 'equal))
+(defun register-enum-type (name type)
+ (setf (gethash name *registered-enum-types*) type))
+(defun registered-enum-type (name)
+ (gethash name *registered-enum-types*))
+
+(defun parse-gvalue-enum (gvalue)
+ (let* ((g-type (gvalue-type gvalue))
+ (type-name (g-type-name g-type))
+ (enum-type (registered-enum-type type-name)))
+ (unless enum-type
+ (error "Enum ~A is not registered" type-name))
+ (convert-from-foreign (g-value-get-enum gvalue) enum-type)))
+
+(defun set-gvalue-enum (gvalue value)
+ (let* ((g-type (gvalue-type gvalue))
+ (type-name (g-type-name g-type))
+ (enum-type (registered-enum-type type-name)))
+ (unless enum-type
+ (error "Enum ~A is not registered" type-name))
+ (g-value-set-enum gvalue (convert-to-foreign value enum-type))))
+
+
+;;Flags
+
+(defvar *registered-flags-types* (make-hash-table :test 'equal))
+(defun register-flags-type (name type)
+ (setf (gethash name *registered-flags-types*) type))
+(defun registered-flags-type (name)
+ (gethash name *registered-flags-types*))
+
+(defun parse-gvalue-flags (gvalue)
+ (let* ((g-type (gvalue-type gvalue))
+ (type-name (g-type-name g-type))
+ (flags-type (registered-flags-type type-name)))
+ (unless flags-type
+ (error "Flags ~A is not registered" type-name))
+ (convert-from-foreign (g-value-get-flags gvalue) flags-type)))
+
+(defun set-gvalue-flags (gvalue value)
+ (let* ((g-type (gvalue-type gvalue))
+ (type-name (g-type-name g-type))
+ (flags-type (registered-flags-type type-name)))
+ (unless flags-type
+ (error "Flags ~A is not registered" type-name))
+ (g-value-set-flags gvalue (convert-to-foreign value flags-type))))
+
+;;Objects
+
+(defun parse-gvalue-object (gvalue)
+ (get-g-object-for-pointer (g-value-get-object gvalue)))
+
+(defun set-gvalue-object (gvalue value)
+ (g-value-set-object gvalue (if value (pointer value) (null-pointer))))
--- /dev/null
+(in-package :gobject)
+
+(defcfun g-value-init (:pointer g-value)
+ (value (:pointer g-value))
+ (type g-type))
+
+(defun g-value-zero (g-value)
+ (loop
+ for i from 0 below (foreign-type-size 'g-value)
+ do (setf (mem-ref g-value :uchar i) 0)))
+
+(defcfun g-value-copy :void
+ (src-value (:pointer g-value))
+ (dst-value (:pointer g-value)))
+
+(defcfun g-value-reset (:pointer g-value)
+ (value (:pointer g-value)))
+
+(defcfun g-value-unset (:pointer g-value)
+ (value (:pointer g-value)))
+
+(defcfun g-value-set-instance :void
+ (value (:pointer g-value))
+ (instance :pointer))
+
+(defcfun g-strdup-value-contents :string
+ (value (:pointer g-value)))
+
--- /dev/null
+(in-package :gobject)
+
+(define-g-object-class "GInitiallyUnowned" g-initially-unowned (g-object) ())
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defcfun g-object-class-install-property :void
+ (class (:pointer g-object-class))
+ (property-id :uint)
+ (param-spec (:pointer g-param-spec)))
+
+(defcfun g-object-class-find-property (:pointer g-param-spec)
+ (class (:pointer g-object-class))
+ (property-name :string))
+
+(defcfun g-object-class-list-properties (:pointer (:pointer g-param-spec))
+ (class (:pointer g-object-class))
+ (n-properties (:pointer :uint)))
+
+(defcfun g-object-class-override-property :void
+ (class (:pointer g-object-class))
+ (property-id :uint)
+ (name :string))
+
+(defcfun g-object-interface-install-property :void
+ (interface :pointer)
+ (param-spec (:pointer g-param-spec)))
+
+(defcfun g-object-interface-find-property (:pointer g-param-spec)
+ (interface :pointer)
+ (property-name :string))
+
+(defcfun g-object-interface-list-properties (:pointer g-param-spec)
+ (interface :pointer)
+ (n-properties (:pointer :uint)))
+
+(defcfun g-object-newv :pointer
+ (object-type g-type)
+ (n-parameter :uint)
+ (parameters (:pointer g-parameter)))
+
+(defcfun g-object-ref :pointer
+ (object :pointer))
+
+(defcfun g-object-unref :void
+ (object :pointer))
+
+(defcfun g-object-ref-sink :pointer
+ (object :pointer))
+
+(defcfun g-object-is-floating :boolean
+ (object :pointer))
+
+(defcfun g-object-force-floating :void
+ (object :pointer))
+
+(defcfun g-object-weak-ref :void
+ (object :pointer)
+ (notify :pointer)
+ (data :pointer))
+
+(defcfun g-object-weak-unref :void
+ (object :pointer)
+ (notify :pointer)
+ (data :pointer))
+
+(defcfun g-object-add-toggle-ref :void
+ (object :pointer)
+ (notifty :pointer)
+ (data :pointer))
+
+(defcfun g-object-remove-toggle-ref :void
+ (object :pointer)
+ (notifty :pointer)
+ (data :pointer))
+
+(defcfun g-object-notify :void
+ (object :pointer)
+ (property-name :string))
+
+(defcfun g-object-freeze-notify :void
+ (object :pointer))
+
+(defcfun g-object-thaw-notify :void
+ (object :pointer))
+
+(defcfun g-object-get-data :pointer
+ (object :pointer)
+ (key :string))
+
+(defcfun g-object-set-data :void
+ (object :pointer)
+ (key :string)
+ (new-value :pointer))
+
+(defcfun g-object-set-data-full :void
+ (object :pointer)
+ (key :string)
+ (data :pointer)
+ (destory :pointer))
+
+(defcfun g-object-steal-data :pointer
+ (object :pointer)
+ (key :string))
+
+(defcfun g-object-set-property :void
+ (object :pointer)
+ (property-name :string)
+ (value (:pointer g-value)))
+
+(defcfun g-object-get-property :void
+ (object :pointer)
+ (property-name :string)
+ (value (:pointer g-value)))
\ No newline at end of file
--- /dev/null
+(defpackage :gobject
+ (:use :cl :glib :cffi :tg :bind :anaphora)
+ (:export #:g-object
+ #:register-object-type
+ #:g-object-call-constructor
+ #:register-flags-type
+ #:register-enum-type
+ #:g-type-from-object
+ #:g-type-name
+ #:g-type-from-name
+ #:g-signal-connect
+ #:define-g-object-class
+ #:g-initially-unowned
+ #:define-g-enum
+ #:*lisp-name-package*
+ #:define-g-boxed-class
+ #:define-g-flags
+ #:fixed-array
+ #:g-boxed-inline
+ #:g-boxed-ptr
+ #:boxed-c-structure-name
+ #:define-g-interface
+ #:release
+ #:using
+ #:using*
+ #:define-g-boxed-ref
+ #:g-boxed-ref
+ #:allocate-stable-pointer
+ #:free-stable-pointer
+ #:get-stable-pointer-value
+ #:with-stable-pointer
+ #:release*))
+
+(in-package :gobject)
+
+(load-foreign-library "libgobject-2.0.so")
+
+(defvar *gobject-debug* nil)
+
+(defun debugf (&rest args)
+ (when *gobject-debug*
+ (apply 'format t args)))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defcfun g-signal-connect-closure :ulong
+ (instance :pointer)
+ (detailed-signal :string)
+ (closure (:pointer g-closure))
+ (after :boolean))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defctype g-type gsize)
+
+(defcstruct g-type-interface
+ (type g-type)
+ (instance-type g-type))
+
+(defcstruct g-type-class
+ (type g-type))
+
+(defcstruct g-type-instance
+ (class (:pointer g-type-class)))
+
+(defcstruct g-type-info
+ (class-size :uint16)
+ (base-init-fn :pointer)
+ (base-finalize-fn :pointer)
+ (class-init-fn :pointer)
+ (class-finalize-fn :pointer)
+ (class-data :pointer)
+ (instance-size :uint16)
+ (n-preallocs :uint16)
+ (instance-init-fn :pointer)
+ (value-table :pointer))
+
+(defbitfield g-type-fundamental-flags
+ :classed
+ :instantiatable
+ :derivable
+ :deep-derivable)
+
+(defcstruct g-type-fundamental-info
+ (type-flags g-type-fundamental-flags))
+
+(defcstruct g-interface-info
+ (interface-init :pointer)
+ (interface-finalize :pointer)
+ (interface-data :pointer))
+
+(defcstruct g-type-value-table
+ (value-init :pointer)
+ (value-free :pointer)
+ (value-copy :pointer)
+ (value-peek-pointer :pointer)
+ (collect-format (:string :free-from-foreign nil :free-to-foreign nil))
+ (collect-value :pointer)
+ (lcopy-format (:string :free-from-foreign nil :free-to-foreign nil))
+ (lcopy-value :pointer))
+
+(defbitfield g-type-flags
+ (:abstract #. (ash 1 4))
+ :value-abstract)
+
+(eval-when (:load-toplevel :compile-toplevel)
+ (defun gtype-make-fundamental-type (x)
+ (ash x 2)))
+
+(defconstant +g-type-invalid+ (gtype-make-fundamental-type 0))
+(defconstant +g-type-void+ (gtype-make-fundamental-type 1))
+(defconstant +g-type-interface+ (gtype-make-fundamental-type 2))
+(defconstant +g-type-char+ (gtype-make-fundamental-type 3))
+(defconstant +g-type-uchar+ (gtype-make-fundamental-type 4))
+(defconstant +g-type-boolean+ (gtype-make-fundamental-type 5))
+(defconstant +g-type-int+ (gtype-make-fundamental-type 6))
+(defconstant +g-type-uint+ (gtype-make-fundamental-type 7))
+(defconstant +g-type-long+ (gtype-make-fundamental-type 8))
+(defconstant +g-type-ulong+ (gtype-make-fundamental-type 9))
+(defconstant +g-type-int64+ (gtype-make-fundamental-type 10))
+(defconstant +g-type-uint64+ (gtype-make-fundamental-type 11))
+(defconstant +g-type-enum+ (gtype-make-fundamental-type 12))
+(defconstant +g-type-flags+ (gtype-make-fundamental-type 13))
+(defconstant +g-type-float+ (gtype-make-fundamental-type 14))
+(defconstant +g-type-double+ (gtype-make-fundamental-type 15))
+(defconstant +g-type-string+ (gtype-make-fundamental-type 16))
+(defconstant +g-type-pointer+ (gtype-make-fundamental-type 17))
+(defconstant +g-type-boxed+ (gtype-make-fundamental-type 18))
+(defconstant +g-type-param+ (gtype-make-fundamental-type 19))
+(defconstant +g-type-object+ (gtype-make-fundamental-type 20))
+
+(defcstruct %g-object
+ (type-instance g-type-instance)
+ (ref-count :uint)
+ (data :pointer))
+
+(defcstruct g-object-class
+ (type-class g-type-class)
+ (constructor :pointer)
+ (set-property :pointer)
+ (get-property :pointer)
+ (dispose :pointer)
+ (finalize :pointer)
+ (dispatch-properties-changed :pointer)
+ (notify :pointer)
+ (constructed :pointer))
+
+(defbitfield g-param-flags
+ :readable
+ :writable
+ :construct
+ :construct-only
+ :lax-validation
+ :static-name
+ :nick
+ :blurb)
+
+(defcstruct g-param-spec
+ (type-instance g-type-instance)
+ (name (:string :free-from-foreign nil :free-to-foreign nil))
+ (flags g-param-flags)
+ (value-type g-type)
+ (owner-type g-type))
+
+(defcunion g-value-data
+ (int :int)
+ (uint :uint)
+ (long :long)
+ (ulong :ulong)
+ (int64 :int64)
+ (uint64 :uint64)
+ (float :float)
+ (double :double)
+ (pointer :pointer))
+
+(defcstruct g-value
+ (type g-type)
+ (data g-value-data :count 2))
+
+(defcstruct g-object-construct-param
+ (param-spec (:pointer g-param-spec))
+ (value (:pointer g-value)))
+
+(defcstruct g-parameter
+ (name (:string :free-from-foreign nil :free-to-foreign nil))
+ (value g-value))
+
+(defcstruct g-enum-value
+ (value :int)
+ (name (:string :free-from-foreign nil :free-to-foreign nil))
+ (nick (:string :free-from-foreign nil :free-to-foreign nil)))
+
+(defcstruct g-enum-class
+ (type-class g-type-class)
+ (minimum :int)
+ (maximum :int)
+ (n-values :uint)
+ (values (:pointer g-enum-value)))
+
+(defcstruct g-flags-value
+ (value :uint)
+ (name (:string :free-from-foreign nil :free-to-foreign nil))
+ (nick (:string :free-from-foreign nil :free-to-foreign nil)))
+
+(defcstruct g-flags-class
+ (type-class g-type-class)
+ (mask :uint)
+ (n-values :uint)
+ (values (:pointer g-flags-value)))
+
+(defcstruct g-param-spec-boolean
+ (parent-instance g-param-spec)
+ (default-value :boolean))
+
+(defcstruct g-param-spec-char
+ (parent-instance g-param-spec)
+ (minimum :int8)
+ (maximum :int8)
+ (default-value :int8))
+
+(defcstruct g-param-spec-uchar
+ (parent-instance g-param-spec)
+ (minimum :uint8)
+ (maximum :uint8)
+ (default-value :uint8))
+
+(defcstruct g-param-spec-int
+ (parent-instance g-param-spec)
+ (minimum :int)
+ (maximum :int)
+ (default-value :int))
+
+(defcstruct g-param-spec-uint
+ (parent-instance g-param-spec)
+ (minimum :uint)
+ (maximum :uint)
+ (default-value :uint))
+
+(defcstruct g-param-spec-long
+ (parent-instance g-param-spec)
+ (minimum :long)
+ (maximum :long)
+ (default-value :ulong))
+
+(defcstruct g-param-spec-ulong
+ (parent-instance g-param-spec)
+ (minimum :ulong)
+ (maximum :ulong)
+ (default-value :ulong))
+
+(defcstruct g-param-spec-int64
+ (parent-instance g-param-spec)
+ (minimum :uint64)
+ (maximum :uint64)
+ (default-value :uint64))
+
+(defcstruct g-param-spec-uint64
+ (parent-instance g-param-spec)
+ (minimum :uint64)
+ (maximum :uint64)
+ (default-value :uint64))
+
+(defcstruct g-param-spec-float
+ (parent-instance g-param-spec)
+ (minimum :float)
+ (maximum :float)
+ (default-value :float)
+ (epsilon :float))
+
+(defcstruct g-param-spec-double
+ (parent-instance g-param-spec)
+ (minimum :double)
+ (maximum :double)
+ (default-value :double)
+ (epsilon :double))
+
+(defcstruct g-param-spec-enum
+ (parent-instance g-param-spec)
+ (enum-class (:pointer g-enum-class))
+ (default-value :int))
+
+(defcstruct g-param-spec-flags
+ (parent-instance g-param-spec)
+ (flags-class (:pointer g-flags-class))
+ (default-value :uint))
+
+(defcstruct g-param-spec-string
+ (parent-instance g-param-spec)
+ (default-value (:string :free-to-foreign nil :free-from-foreign nil))
+ (cset-first (:string :free-to-foreign nil :free-from-foreign nil))
+ (cset-nth (:string :free-to-foreign nil :free-from-foreign nil))
+ (substitutor :char)
+ (flags-for-null :uint))
+
+(defcstruct g-param-spec-param
+ (parent-instance g-param-spec))
+
+(defcstruct g-param-spec-boxed
+ (parent-instance g-param-spec))
+
+(defcstruct g-param-spec-pointer
+ (parent-instance g-param-spec))
+
+(defcstruct g-param-spec-object
+ (parent-instance g-param-spec))
+
+(defcstruct g-param-spec-value-array
+ (parent-instance g-param-spec)
+ (element-spec (:pointer g-param-spec))
+ (fixed-n-elements :uint))
+
+(defcstruct g-param-spec-g-type
+ (parent-instance g-param-spec)
+ (types-root g-type))
+
+(defcstruct g-param-spec-class
+ (type-class g-type-class)
+ (value-type g-type)
+ (finalize :pointer)
+ (value-set-default :pointer)
+ (value-validate :pointer)
+ (values-cmp :pointer))
+
+(defcstruct g-closure
+ (private-data :uint32)
+ (marshal :pointer)
+ (data :pointer)
+ (notifiers :pointer))
\ No newline at end of file
--- /dev/null
+(in-package :gobject)
+
+(defcfun (g-type-fundamental "g_type_fundamental") g-type
+ (type-id g-type))
+
+(defcfun (%g-type-init "g_type_init") :void)
+
+(%g-type-init)
+
+(defcfun (g-type-name "g_type_name") :string
+ (type g-type))
+
+(defcfun (g-type-from-name "g_type_from_name") g-type
+ (name :string))
+
+(defcfun g-type-parent g-type
+ (type g-type))
+
+(defcfun g-type-depth :uint
+ (type g-type))
+
+(defcfun g-type-next-base g-type
+ (leaf-type g-type)
+ (root-type g-type))
+
+(defcfun g-type-is-a :boolean
+ (type g-type)
+ (is-a-type g-type))
+
+(defcfun g-type-class-ref (:pointer g-type-class)
+ (type g-type))
+
+(defcfun g-type-class-unref :void
+ (class (:pointer g-type-class)))
+
+(defcfun g-type-class-add-private :void
+ (class (:pointer g-type-class))
+ (private-size gsize))
+
+(defcfun g-type-default-interface-ref :pointer
+ (type g-type))
+
+(defcfun g-type-default-interface-unref :void
+ (interface :pointer))
+
+(defcfun (%g-type-children "g_type_children") (:pointer g-type)
+ (type g-type)
+ (n-children (:pointer :uint)))
+
+(defun g-type-children (g-type)
+ (with-foreign-object (n-children :uint)
+ (let ((g-types-ptr (%g-type-children g-type n-children)))
+ (prog1
+ (loop
+ for i from 0 below (mem-ref n-children :uint)
+ collect (mem-aref g-types-ptr 'g-type i))
+ (g-free g-types-ptr)))))
+
+(defcfun (%g-type-interfaces "g_type_interfaces") (:pointer g-type)
+ (type g-type)
+ (n-interfaces (:pointer :uint)))
+
+(defun g-type-interfaces (g-type)
+ (setf g-type (ensure-g-type g-type))
+ (with-foreign-object (n-interfaces :uint)
+ (let ((g-types-ptr (%g-type-interfaces g-type n-interfaces)))
+ (prog1
+ (loop
+ for i from 0 below (mem-ref n-interfaces :uint)
+ collect (mem-aref g-types-ptr 'g-type i))
+ (g-free g-types-ptr)))))
+
+(defcfun (%g-type-interface-prerequisites "g_type_interface_prerequisites") (:pointer g-type)
+ (type g-type)
+ (n-interface-prerequisites (:pointer :uint)))
+
+(defun g-type-interface-prerequisites (g-type)
+ (with-foreign-object (n-interface-prerequisites :uint)
+ (let ((g-types-ptr (%g-type-interface-prerequisites g-type n-interface-prerequisites)))
+ (prog1
+ (loop
+ for i from 0 below (mem-ref n-interface-prerequisites :uint)
+ collect (mem-aref g-types-ptr 'g-type i))
+ (g-free g-types-ptr)))))
+
+(defcfun g-type-register-static g-type
+ (parent-type g-type)
+ (type-name :string)
+ (info (:pointer g-type-info))
+ (flags g-type-flags))
+
+(defcfun g-type-add-interface-static :void
+ (instance-type g-type)
+ (interface-type g-type)
+ (info (:pointer g-interface-info)))
+
+(defcfun g-type-interface-add-prerequisite :void
+ (interface-type g-type)
+ (prerequisite-type g-type))
+
+(defun g-type-from-object (object)
+ (g-type-from-instance object))
+
+(defun g-type-from-class (g-class)
+ (foreign-slot-value g-class 'g-type-class 'type))
+
+(defun g-type-from-instance (type-instance)
+ (g-type-from-class (foreign-slot-value type-instance 'g-type-instance 'class)))
+
+(defun g-type-from-interface (type-interface)
+ (foreign-slot-value type-interface 'g-type-interface 'type))
+
+(defcfun g-strv-get-type g-type)
+
+(g-strv-get-type)
+
+(defcfun g-closure-get-type g-type)
+
+(g-closure-get-type)
\ No newline at end of file
--- /dev/null
+(defsystem :gtk
+ :name "gtk"
+ :serial t
+ :components ((:file "gtk.package")
+ (:file "gtk.generated-classes")
+ (:file "gtk.objects")
+ (:file "gtk.main_loop_events")
+ (:file "gtk.functions")
+ (:file "gtk.base-classes")
+ (:file "gtk.dialog")
+ (:file "gtk.window")
+ (:file "gtk.image")
+ (:file "gtk.label")
+ (:file "gtk.progress-bar")
+ (:file "gtk.status-bar")
+ (:file "gtk.status-icon")
+ (:file "gtk.scale-button")
+ (:file "gtk.entry")
+ (:file "gtk.spin-button")
+ (:file "gtk.text")
+
+ (:file "gtk.dialog.example")
+
+ (:file "gtk.demo"))
+ :depends-on (:glib :cffi :gdk :anaphora))
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
--- /dev/null
+(defpackage :gtk-demo
+ (:use :cl :gtk :gdk :gobject)
+ (:export #:test
+ #:test-entry
+ #:table-packing
+ #:test-pixbuf
+ #:test-image
+ #:test-progress-bar
+ #:test-status-bar
+ #:test-scale-button
+ #:test-text-view
+ #:demo-code-editor))
+
+(in-package :gtk-demo)
+
+(defun test ()
+ (let ((window (make-instance 'gtk-window :type :toplevel :app-paintable t))
+ x y)
+ (g-signal-connect window "destroy" (lambda (widget)
+ (release widget)
+ (gtk-main-quit)))
+ (g-signal-connect window "motion-notify-event" (lambda (widget event)
+ (release widget)
+ (setf x (event-motion-x event)
+ y (event-motion-y event))
+ (gtk-widget-queue-draw window)))
+ (g-signal-connect window "expose-event"
+ (lambda (widget event)
+ (declare (ignore event))
+ (release widget)
+ ;(print event)
+ (using* ((gdk-window (widget-window window))
+ (gc (gdk-gc-new gdk-window))
+ (layout (gtk-widget-create-pango-layout window (format nil "X: ~F~%Y: ~F" x y))))
+ (gdk-draw-layout gdk-window gc 0 0 layout)
+ (gdk-gc-set-rgb-fg-color gc (make-color :red 65535 :green 0 :blue 0))
+ (multiple-value-bind (x y) (drawable-get-size gdk-window)
+ (gdk-draw-line gdk-window gc 0 0 x y)))))
+ (g-signal-connect window "configure-event"
+ (lambda (widget event)
+ (declare (ignore event))
+ (release widget)
+ (gtk-widget-queue-draw window)))
+ (gtk-widget-show-all window)
+ (push :pointer-motion-mask (gdk-window-events (widget-window window)))
+ (gtk-main)
+ (release window)))
+
+(defun test-entry ()
+ (using* ((window (make-instance 'gtk-window :type :toplevel :title "Testing entry" :border-width 10))
+ (box (make-instance 'v-box))
+ (entry (make-instance 'entry))
+ (button (make-instance 'button :label "OK"))
+ (text-buffer (make-instance 'text-buffer))
+ (text-view (make-instance 'text-view :buffer text-buffer))
+ (button-select (make-instance 'button :label "Select"))
+ (button-insert (make-instance 'button :label "Insert")))
+ (box-pack-start box (make-instance 'label :label "Enter <b>anything</b> you wish:" :use-markup t) :expand nil)
+ (box-pack-start box entry :expand nil)
+ (box-pack-start box button :expand nil)
+ (box-pack-start box button-select :expand nil)
+ (box-pack-start box button-insert :expand nil)
+ (using* ((w (make-instance 'scrolled-window)))
+ (box-pack-start box w)
+ (container-add w text-view))
+ (container-add window box)
+ (g-signal-connect window "destroy" (lambda (widget) (release widget) (gtk-main-quit)))
+ (g-signal-connect window "delete-event" (lambda (widget event)
+ (declare (ignore event))
+ (release widget)
+ (using (dlg (make-instance 'message-dialog :text "Are you sure?" :buttons :yes-no))
+ (let ((response (dialog-run dlg)))
+ (object-destroy dlg)
+ (not (eq :yes response))))))
+ (g-signal-connect button "clicked" (lambda (button) (release button)
+ (setf (text-buffer-text text-buffer)
+ (format nil "~A~%~A" (text-buffer-text text-buffer) (entry-text entry))
+ (entry-text entry) "")))
+ (g-signal-connect button-select "clicked" (lambda (button) (release button)
+ (editable-select-region entry 5 10)))
+ (g-signal-connect button-insert "clicked" (lambda (button) (release button)
+ (editable-insert-text entry "hello" 2)))
+ (gtk-widget-show-all window)
+ (gtk-main)))
+
+(defun table-packing ()
+ (using* ((window (make-instance 'gtk-window :type :toplevel :title "Table packing" :border-width 20))
+ (table (make-instance 'table :n-rows 2 :n-columns 2 :homogeneous t))
+ (button-1 (make-instance 'button :label "Button 1"))
+ (button-2 (make-instance 'button :label "Button 2"))
+ (button-q (make-instance 'button :label "Quit")))
+ (container-add window table)
+ (table-attach table button-1 0 1 0 1)
+ (table-attach table button-2 1 2 0 1)
+ (table-attach table button-q 0 2 1 2)
+ (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
+ (g-signal-connect button-q "clicked" (lambda (b) (release b) (object-destroy window)))
+ (gtk-widget-show-all window)
+ (gtk-main)))
+
+(defun test-pixbuf ()
+ (using* ((window (make-instance 'gtk-window :title "Test pixbuf" :request-width 600 :request-height 240))
+ (vbox (make-instance 'v-box))
+ (eventbox (make-instance 'event-box))
+ (vbox-1 (make-instance 'v-box)))
+ (container-add window vbox)
+ (box-pack-start vbox (make-instance 'label :text "Placing bg image" :font "Times New Roman Italic 10" :color "#00f" :request-height 40))
+ (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
+ (box-pack-start vbox eventbox)
+ (container-add eventbox vbox-1)
+ (box-pack-start vbox-1 (make-instance 'label :text "This is the eventbox"))
+ (box-pack-start vbox-1 (make-instance 'label :text "The green ball is the bg"))
+ (gtk-widget-show-all window)
+ (gtk-main)))
+
+(defun test-image ()
+ (using*((window (make-instance 'gtk-window :title "Test images"))
+ (image (make-instance 'image :icon-name "applications-development" :icon-size 6)))
+ (container-add window image)
+ (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
+ (gtk-widget-show-all window)
+ (gtk-main)))
+
+(defun test-progress-bar ()
+ (using* ((window (make-instance 'gtk-window :title "Test progress bar"))
+ (v-box (make-instance 'v-box))
+ (p-bar (make-instance 'progress-bar :test "A process"))
+ (button-pulse (make-instance 'button :label "Pulse"))
+ (button-set (make-instance 'button :label "Set"))
+ (entry (make-instance 'entry)))
+ (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
+ (container-add window v-box)
+ (box-pack-start v-box p-bar)
+ (box-pack-start v-box button-pulse)
+ (box-pack-start v-box button-set)
+ (box-pack-start v-box entry)
+ (g-signal-connect button-pulse "clicked" (lambda (w) (release w) (progress-bar-pulse p-bar)))
+ (g-signal-connect button-set "clicked" (lambda (w) (release w)
+ (setf (progress-bar-fraction p-bar)
+ (coerce (read-from-string (entry-text entry)) 'real))))
+ (gtk-widget-show-all window)
+ (gtk-main)))
+
+(defun test-status-bar ()
+ (using* ((window (make-instance 'gtk-window :title "Text status bar"))
+ (v-box (make-instance 'v-box))
+ (h-box (make-instance 'h-box))
+ (label (make-instance 'label :label "Test of status bar" :xalign 0.5 :yalign 0.5))
+ (status-bar (make-instance 'statusbar :has-resize-grip t))
+ (button-push (make-instance 'button :label "Push"))
+ (button-pop (make-instance 'button :label "Pop"))
+ (entry (make-instance 'entry))
+ (icon (make-instance 'status-icon :icon-name "applications-development")))
+ (set-status-icon-tooltip icon "An icon from lisp program")
+ (g-signal-connect window "destroy" (lambda (w) (release w)
+ #+ (or) (setf (status-icon-visible icon) nil)
+ (gtk-main-quit)))
+ (g-signal-connect button-push "clicked" (lambda (b) (release b) (status-bar-push status-bar "lisp-prog" (entry-text entry))))
+ (g-signal-connect button-pop "clicked" (lambda (b) (release b) (status-bar-pop status-bar "lisp-prog")))
+ (g-signal-connect icon "activate" (lambda (i) (release i)
+ (using (message-dialog (make-instance 'message-dialog :buttons :ok :text "You clicked on icon!"))
+ (dialog-run message-dialog)
+ (object-destroy message-dialog))))
+ (container-add window v-box)
+ (box-pack-start v-box h-box :expand nil)
+ (box-pack-start h-box entry)
+ (box-pack-start h-box button-push :expand nil)
+ (box-pack-start h-box button-pop :expand nil)
+ (box-pack-start v-box label)
+ (box-pack-start v-box status-bar :expand nil)
+ (gtk-widget-show-all window)
+ (setf (status-icon-screen icon) (gtk-window-screen window))
+ (gtk-main)))
+
+(defun test-scale-button ()
+ (using* ((window (make-instance 'gtk-window :type :toplevel :title "Testing scale button"))
+ (button (make-instance 'scale-button :icons (list "media-seek-backward" "media-seek-forward" "media-playback-stop" "media-playback-start") :adjustment (make-instance 'adjustment :lower -40 :upper 50 :value 20))))
+ (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
+ (container-add window button)
+ (gtk-widget-show-all window)
+ (gtk-main)))
+
+(defun test-text-view ()
+ (using* ((window (make-instance 'gtk-window :type :toplevel :title "Testing text view" :width-request 400 :height-request 300))
+ (button (make-instance 'button :label "Do"))
+ (bold-btn (make-instance 'button :label "Bold"))
+ (buffer (make-instance 'text-buffer :text "Some text buffer with some text inside"))
+ (v (make-instance 'text-view :buffer buffer :wrap-mode :word))
+ (box (make-instance 'v-box))
+ (scrolled (make-instance 'scrolled-window :hscrollbar-policy :automatic :vscrollbar-policy :automatic)))
+ (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
+ (g-signal-connect button "clicked" (lambda (b)
+ (release b)
+ (using* ((i1 (make-instance 'text-iter))
+ (i2 (make-instance 'text-iter)))
+ (multiple-value-bind (i1 i2) (text-buffer-get-selection-bounds buffer)
+ (when (and i1 i2)
+ (using* ((i1 i1) (i2 i2)
+ (dialog (make-instance 'message-dialog :buttons :ok)))
+ (setf (message-dialog-text dialog) (format nil "selection: from (~A,~A) to (~A,~A)"
+ (text-iter-line i1) (text-iter-line-offset i1)
+ (text-iter-line i2) (text-iter-line-offset i2)))
+ (dialog-run dialog)
+ (object-destroy dialog)))))))
+ (g-signal-connect bold-btn "clicked" (Lambda (b)
+ (release b)
+ (multiple-value-bind (start end) (text-buffer-get-selection-bounds buffer)
+ (when (and start end)
+ (using* ((start start) (end end) (tag (text-tag-table-lookup (text-buffer-tag-table buffer) "bold")))
+ (if (text-iter-has-tag start tag)
+ (text-buffer-remove-tag buffer tag start end)
+ (text-buffer-apply-tag buffer tag start end)))))))
+ (let ((tag (make-instance 'text-tag :name "bold" :weight 700)))
+ (text-tag-table-add (text-buffer-tag-table buffer) tag)
+ (g-signal-connect tag "event"
+ (lambda (tag object event iter)
+ (declare (ignore tag object iter))
+ (when (eq (event-type event) :button-release)
+ (using (dlg (make-instance 'message-dialog :text "You clicked on bold text." :buttons :ok))
+ (dialog-run dlg)
+ (object-destroy dlg))))))
+ (container-add window box)
+ (container-add scrolled v)
+ (box-pack-start box button :expand nil)
+ (box-pack-start box bold-btn :expand nil)
+ (box-pack-start box scrolled)
+ (gtk-widget-show-all window)
+ (gtk-main)))
+
+(defun demo-code-editor ()
+ (using* ((window (make-instance 'gtk-window :type :toplevel :title "Code editor" :width-request 400 :height-request 400 :window-position :center))
+ (scrolled (make-instance 'scrolled-window :hscrollbar-policy :automatic :vscrollbar-policy :automatic))
+ (buffer (make-instance 'text-buffer))
+ (view (make-instance 'text-view :buffer buffer)))
+ (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit)))
+ (container-add window scrolled)
+ (container-add scrolled view)
+ (gtk-widget-show-all window)
+ (g-signal-connect buffer "insert-text" (lambda (buffer location text len)
+ (using* ((buffer buffer) (location location))
+ (format t "~A~%" (list buffer location text len)))))
+ (gtk-main)))
\ No newline at end of file
--- /dev/null
+(in-package :gtk-examples)
+
+(defun test-dialog ()
+ (let ((window (make-instance 'gtk-window :type :toplevel :title "Testing dialogs"))
+ (v-box (make-instance 'v-box)))
+ (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+ (container-add window v-box)
+
+ (let ((button (make-instance 'button :label "Dialog 1")))
+ (box-pack-start v-box button)
+ (g-signal-connect button "clicked" (lambda (b) (declare (ignore b))
+ (let ((dialog (make-instance 'dialog)))
+ (dialog-add-button dialog "OK" :ok)
+ (dialog-add-button dialog "Yes" :yes)
+ (dialog-add-button dialog "Cancel" :cancel)
+ (setf (dialog-default-response dialog) :cancel)
+ (setf (dialog-alternative-button-order dialog) (list :yes :cancel :ok))
+ (format t "Response was: ~S~%" (dialog-run dialog))
+ (object-destroy dialog)))))
+ (let ((button (make-instance 'button :label "About")))
+ (box-pack-start v-box button)
+ (g-signal-connect button "clicked" (lambda (b) (declare (ignore b))
+ (let ((dialog (make-instance 'about-dialog :program-name "Dialogs examples" :version "0.01" :copyright "(c) Kalyanov Dmitry"
+ :website "http://common-lisp.net/project/cl-gtk+" :website-label "Project web site"
+ :license "LLGPL" :authors '("Kalyanov Dmitry") :documenters '("Kalyanov Dmitry")
+ :artists '("None")
+ :logo-icon-name "applications-development" :wrap-license t)))
+ (format t "Response was: ~S~%" (dialog-run dialog))
+ (object-destroy dialog)))))
+
+ (gtk-widget-show-all window)
+ (gtk-main)))
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(define-g-enum "GtkResponseType" response-type ()
+ (:none -1)
+ (:reject -2)
+ (:accept -3)
+ (:delete-event -4)
+ (:ok -5)
+ (:cancel -6)
+ (:close -7)
+ (:yes -8)
+ (:no -9)
+ (:apply -10)
+ (:help -11))
+
+(defcfun (dialog-run "gtk_dialog_run") response-type
+ (dialog (g-object dialog)))
+
+(export 'dialog-run)
+
+(defcfun (dialog-respose "gtk_dialog_response") :void
+ (dialog (g-object dialog))
+ (response response-type))
+
+(export 'dialog-response)
+
+(defcfun (dialog-add-button "gtk_dialog_add_button") (g-object widget)
+ (dialog (g-object dialog))
+ (button-text :string)
+ (response response-type))
+
+(export 'dialog-add-button)
+
+(defcfun (dialog-add-action-widget "gtk_dialog_add_action_widget") :void
+ (dialog (g-object dialog))
+ (child (g-object widget))
+ (response response-type))
+
+(export 'dialog-add-action-widget)
+
+(defcfun (dialog-set-default-response "gtk_dialog_set_default_response") :void
+ (dialog (g-object dialog))
+ (response response-type))
+
+(defun (setf dialog-default-response) (response dialog)
+ (dialog-set-default-response dialog response)
+ response)
+
+(export 'dialog-default-response)
+
+(defcfun (dialog-set-response-sensitive "gtk_dialog_set_response_sensitive") :void
+ (dialog (g-object dialog))
+ (response response-type)
+ (setting :boolean))
+
+(defcfun (dialog-response-for-widget "gtk_dialog_get_response_for_widget") :int
+ (dialog (g-object dialog))
+ (widget (g-object widget)))
+
+(export 'dialog-response-for-widget)
+
+(defcfun (dialog-action-area "gtk_dialog_get_action_area") (g-object widget)
+ (dialog (g-object dialog)))
+
+(export 'dialog-action-area)
+
+(defcfun (dialog-content-area "gtk_dialog_get_content_area") (g-object widget)
+ (dialog (g-object dialog)))
+
+(export 'dialog-content-area)
+
+(defcfun (dialog-alternative-button-order-on-screen "gtk_alternative_dialog_button_order") :boolean
+ (screen (g-object screen)))
+
+(export 'dialog-alternative-button-order-on-screen)
+
+(defcfun (dialog-set-alternative-button-order-from-array "gtk_dialog_set_alternative_button_order_from_array") :void
+ (dialog (g-object dialog))
+ (n-params :int)
+ (new-order (:pointer response-type)))
+
+(defun (setf dialog-alternative-button-order) (response-list dialog)
+ (with-foreign-object (new-order 'response-type (length response-list))
+ (loop
+ for i from 0
+ for response in response-list
+ do (setf (mem-aref new-order 'response-type i) response))
+ (dialog-set-alternative-button-order-from-array dialog (length response-list) new-order))
+ response-list)
+
+(export 'dialog-alternative-button-order)
+
--- /dev/null
+(in-package :gtk)
+
+;; GtkEntry
+
+(defcfun (entry-layout "gtk_entry_get_layout") g-object ;;PangoLayout
+ (entry (g-object entry)))
+
+(export 'entry-layout)
+
+(defcfun gtk-entry-get-layout-offsets :void
+ (entry (g-object entry))
+ (x (:pointer :int))
+ (y (:pointer :int)))
+
+(defun entry-layout-offset (entry)
+ (with-foreign-objects ((x :int) (y :int))
+ (gtk-entry-get-layout-offsets entry x y)
+ (values (mem-ref x :int) (mem-ref y :int))))
+
+(export 'entry-layout-offset)
+
+(defcfun (entry-layout-index-to-text-index "gtk_entry_layout_index_to_text_index") :int
+ (entry (g-object entry))
+ (layout-index :int))
+
+(defcfun (entry-text-index-to-layout-index "gtk_entry_text_index_to_layout_index") :int
+ (entry (g-object entry))
+ (text-index :int))
+
+(defcfun gtk-entry-set-completion :void
+ (entry (g-object entry))
+ (completion (g-object entry-completion)))
+
+(defcfun gtk-entry-get-completion (g-object entry-completion)
+ (entry (g-object entry)))
+
+(defun entry-completion (entry)
+ (gtk-entry-get-completion entry))
+
+(defun (setf entry-completion) (completion entry)
+ (gtk-entry-set-completion entry completion))
+
+(export 'entry-completion)
+
+(defcfun gtk-entry-set-cursor-hadjustment :void
+ (entry (g-object entry))
+ (adjustment (g-object adjustment)))
+
+(defcfun (entry-cursor-hadjustment "gtk_entry_get_cursor_hadjustment") (g-object adjustment)
+ (entry (g-object entry)))
+
+(defun (setf entry-cursor-hadjustment) (adjustment entry)
+ (gtk-entry-set-cursor-hadjustment entry adjustment))
+
+(export 'entry-cursor-hadjustment)
+
+;; GtkEditable
+
+(defcfun (editable-select-region "gtk_editable_select_region") :void
+ (editable (g-object editable))
+ (start :int)
+ (end :int))
+
+(export 'editable-select-region)
+
+(defcfun gtk-editable-get-selection-bounds :boolean
+ (editable (g-object editable))
+ (start (:pointer :int))
+ (end (:pointer :int)))
+
+(defun editable-selection (editable)
+ (with-foreign-objects ((start :int) (end :int))
+ (let ((selected-p (gtk-editable-get-selection-bounds editable start end)))
+ (values selected-p (mem-ref start :int) (mem-ref end :int)))))
+
+(export 'editable-selection)
+
+(defcfun gtk-editable-insert-text :void
+ (editable (g-object editable))
+ (new-text :string)
+ (new-text-length :int)
+ (position (:pointer :int)))
+
+(defun editable-insert-text (editable text position)
+ (with-foreign-object (pos :int)
+ (setf (mem-ref pos :int) position)
+ (gtk-editable-insert-text editable text (length text) pos)
+ (mem-ref pos :int)))
+
+(export 'editable-insert-text)
+
+(defcfun gtk-editable-delete-text :void
+ (editable (g-object editable))
+ (start-pos :int)
+ (end-pos :int))
+
+(defun editable-delete-text (editable &key start-pos end-pos)
+ (gtk-editable-delete-text editable (or start-pos -1) (or end-pos -1)))
+
+(export 'editable-delete-text)
+
+(defcfun gtk-editable-get-chars g-string
+ (editable (g-object editable))
+ (start-pos :int)
+ (end-pos :int))
+
+(defun editable-get-chars (editable &key (start -1) (end -1))
+ (gtk-editable-get-chars editable start end))
+
+(export 'editable-get-chars)
+
+(defcfun (editable-cut-clipboard "gtk_editable_cut_clipboard") :void
+ (editable (g-object editable)))
+
+(export 'editable-cut-clipboard)
+
+(defcfun (editable-copy-clipboard "gtk_editable_copy_clipboard") :void
+ (editable (g-object editable)))
+
+(export 'editable-copy-clipboard)
+
+(defcfun (editable-paste-clipboard "gtk_editable_paste_clipboard") :void
+ (editable (g-object editable)))
+
+(export 'editable-paste-clipboard)
+
+(defcfun (editable-delete-selection "gtk_editable_delete_selection") :void
+ (editable (g-object editable)))
+
+(export 'editable-delete-selection)
+
+(defcfun (editable-position "gtk_editable_get_position") :int
+ (editable (g-object editable)))
+
+(defcfun gtk-editable-set-position :void
+ (editable (g-object editable))
+ (pos :int))
+
+(defun (setf editable-position) (position editable)
+ (gtk-editable-set-position editable position))
+
+(export 'editable-position)
+
+(defcfun (editable-editable "gtk_editable_get_editable") :boolean
+ (editable (g-object editable)))
+
+(defcfun gtk-editable-set-editable :void
+ (editable (g-object editable))
+ (is-editable :boolean))
+
+(defun (setf editable-editable) (is-editable editable)
+ (gtk-editable-set-editable editable is-editable))
+
+(export 'editable-editable)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun gtk-widget-show-all :void
+ (widget (g-object widget)))
+
+(defcfun gtk-widget-queue-draw :void
+ (widget (g-object widget)))
+
+(defcfun gtk-widget-create-pango-layout (g-object gdk::pango-layout)
+ (widget (g-object widget))
+ (text :string))
+
+(defcfun gtk-box-pack-start :void
+ (box (g-object box))
+ (child (g-object widget))
+ (expand :boolean)
+ (fill :boolean)
+ (padding :uint))
+
+(defun box-pack-start (box child &key (expand t) (fill t) (padding 0))
+ (gtk-box-pack-start box child expand fill padding))
+
+(defcfun (container-add "gtk_container_add") :void
+ (container (g-object container))
+ (widget (g-object widget)))
+
+(defcfun (object-destroy "gtk_object_destroy") :void
+ (object (g-object gtk-object)))
+
+(defcfun gtk-text-buffer-insert :void
+ (buffer (g-object text-buffer))
+ (iter :pointer)
+ (text :string)
+ (len :int))
+
+(defun text-buffer-insert (buffer iter text)
+ (declare (ignore iter))
+ (gtk-text-buffer-insert buffer (null-pointer) text (length text)))
+
+(define-g-flags "GtkAttachOptions" attach-options () :expand :shrink :fill)
+
+(defcfun gtk-table-attach :void
+ (table (g-object table))
+ (child (g-object widget))
+ (left-attach :uint)
+ (right-attach :uint)
+ (top-attach :uint)
+ (bottom-attach :uint)
+ (x-options attach-options)
+ (y-options attach-options)
+ (x-padding :uint)
+ (y-padding :uint))
+
+(defun table-attach (table widget left right top bottom &key (x-options '(:expand :fill)) (y-options '(:expand :fill)) (x-padding 0) (y-padding 0))
+ (gtk-table-attach table widget left right top bottom x-options y-options x-padding y-padding))
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+(define-g-enum "GtkTextDirection" text-direction (t) (:none 0) (:ltr 1)
+ (:rtl 2))
+
+(define-g-enum "GtkSizeGroupMode" size-group-mode (t) (:none 0) (:horizontal 1)
+ (:vertical 2) (:both 3))
+
+(define-g-enum "GtkUnit" unit (t) (:pixel 0) (:points 1) (:inch 2) (:mm 3))
+
+(define-g-enum "GtkPrintStatus" print-status (t) (:initial 0) (:preparing 1)
+ (:generating-data 2) (:sending-data 3) (:pending 4)
+ (:pending-issue 5) (:printing 6) (:finished 7)
+ (:finished-aborted 8))
+
+(define-g-enum "GtkRecentSortType" recent-sort-type (t) (:none 0) (:mru 1)
+ (:lru 2) (:custom 3))
+
+(define-g-enum "GtkFileChooserAction" file-chooser-action (t) (:open 0)
+ (:save 1) (:select-folder 2) (:create-folder 3))
+
+(define-g-enum "GtkCellRendererAccelMode" cell-renderer-accel-mode (t) (:gtk 0)
+ (:other 1))
+
+(define-g-enum "GtkCellRendererMode" cell-renderer-mode (t) (:inert 0)
+ (:activatable 1) (:editable 2))
+
+(define-g-enum "GtkTreeViewColumnSizing" tree-view-column-sizing (t)
+ (:grow-only 0) (:autosize 1) (:fixed 2))
+
+(define-g-enum "GtkProgressBarOrientation" progress-bar-orientation (t)
+ (:left-to-right 0) (:right-to-left 1) (:bottom-to-top 2)
+ (:top-to-bottom 3))
+
+(define-g-enum "GtkProgressBarStyle" progress-bar-style (t) (:continuous 0)
+ (:discrete 1))
+
+(define-g-enum "GtkUpdateType" update-type (t) (:continuous 0)
+ (:discontinuous 1) (:delayed 2))
+
+(define-g-enum "GtkMetricType" metric-type (t) (:pixels 0) (:inches 1)
+ (:centimeters 2))
+
+(define-g-enum "GtkSpinButtonUpdatePolicy" spin-button-update-policy (t)
+ (:always 0) (:if-valid 1))
+
+(define-g-enum "GtkCurveType" curve-type (t) (:linear 0) (:spline 1) (:free 2))
+
+(define-g-enum "GtkImageType" image-type (t) (:empty 0) (:pixmap 1) (:image 2)
+ (:pixbuf 3) (:stock 4) (:icon-set 5) (:animation 6)
+ (:icon-name 7) (:gicon 8))
+
+(define-g-enum "GtkArrowType" arrow-type (t) (:up 0) (:down 1) (:left 2)
+ (:right 3) (:none 4))
+
+(define-g-enum "GtkSortType" sort-type (t) (:ascending 0) (:descending 1))
+
+(define-g-enum "GtkToolbarStyle" toolbar-style (t) (:icons 0) (:text 1)
+ (:both 2) (:both-horiz 3))
+
+(define-g-enum "GtkWrapMode" wrap-mode (t) (:none 0) (:char 1) (:word 2)
+ (:word-char 3))
+
+(define-g-enum "GtkJustification" justification (t) (:left 0) (:right 1)
+ (:center 2) (:fill 3))
+
+(define-g-enum "GtkButtonBoxStyle" button-box-style (t) (:default-style 0)
+ (:spread 1) (:edge 2) (:start 3) (:end 4) (:center 5))
+
+(define-g-enum "GtkSelectionMode" selection-mode (t) (:none 0) (:single 1)
+ (:browse 2) (:multiple 3) (:extended 3))
+
+(define-g-enum "GtkTreeViewGridLines" tree-view-grid-lines (t) (:none 0)
+ (:horizontal 1) (:vertical 2) (:both 3))
+
+(define-g-enum "GtkPackDirection" pack-direction (t) (:ltr 0) (:rtl 1) (:ttb 2)
+ (:btt 3))
+
+(define-g-enum "GtkPolicyType" policy-type (t) (:always 0) (:automatic 1)
+ (:never 2))
+
+(define-g-enum "GtkCornerType" corner-type (t) (:top-left 0) (:bottom-left 1)
+ (:top-right 2) (:bottom-right 3))
+
+(define-g-enum "GtkSensitivityType" sensitivity-type (t) (:auto 0) (:on 1)
+ (:off 2))
+
+(define-g-enum "GtkShadowType" shadow-type (t) (:none 0) (:in 1) (:out 2)
+ (:etched-in 3) (:etched-out 4))
+
+(define-g-enum "GtkIconSize" icon-size (t) (:invalid 0) (:menu 1)
+ (:small-toolbar 2) (:large-toolbar 3) (:button 4) (:dnd 5)
+ (:dialog 6))
+
+(define-g-enum "GtkOrientation" orientation (t) (:horizontal 0) (:vertical 1))
+
+(define-g-enum "GtkPositionType" position-type (t) (:left 0) (:right 1)
+ (:top 2) (:bottom 3))
+
+(define-g-enum "GtkReliefStyle" relief-style (t) (:normal 0) (:half 1)
+ (:none 2))
+
+(define-g-enum "GtkMessageType" message-type (t) (:info 0) (:warning 1)
+ (:question 2) (:error 3) (:other 4))
+
+(define-g-enum "GtkButtonsType" buttons-type (t) (:none 0) (:ok 1) (:close 2)
+ (:cancel 3) (:yes-no 4) (:ok-cancel 5))
+
+(define-g-enum "GtkWindowPosition" window-position (t) (:none 0) (:center 1)
+ (:mouse 2) (:center-always 3) (:center-on-parent 4))
+
+(define-g-enum "GtkWindowType" window-type (t) (:toplevel 0) (:popup 1))
+
+(define-g-enum "GtkResizeMode" resize-mode (t) (:parent 0) (:queue 1)
+ (:immediate 2))
+
+(define-g-flags "GdkModifierType" gdk-modifier-type (t) (:shift-mask 1)
+ (:lock-mask 2) (:control-mask 4) (:mod1-mask 8) (:mod2-mask 16)
+ (:mod3-mask 32) (:mod4-mask 64) (:mod5-mask 128)
+ (:button1-mask 256) (:button2-mask 512) (:button3-mask 1024)
+ (:button4-mask 2048) (:button5-mask 4096)
+ (:super-mask 67108864) (:hyper-mask 134217728)
+ (:meta-mask 268435456) (:release-mask 1073741824)
+ (:modifier-mask 1543512063))
+
+(define-g-enum "GtkTextBufferTargetInfo" text-buffer-target-info (t)
+ (:buffer-contents -1) (:rich-text -2) (:text -3))
+
+(define-g-flags "GtkTextSearchFlags" text-search-flags (t) (:visible-only 1)
+ (:text-only 2))
+
+(define-g-interface "GtkBuildable" buildable (t))
+
+(define-g-interface "GtkCellEditable" cell-editable (t))
+
+(define-g-interface "GtkCellLayout" cell-layout (t))
+
+(define-g-interface "GtkEditable" editable (t))
+
+(define-g-interface "GtkFileChooser" file-chooser (t)
+ (extra-widget file-chooser-extra-widget "extra-widget"
+ "GtkWidget" t t)
+ (use-preview-label file-chooser-use-preview-label
+ "use-preview-label" "gboolean" t t)
+ (file-system-backend file-chooser-file-system-backend
+ "file-system-backend" "gchararray" nil nil)
+ (filter file-chooser-filter "filter" "GtkFileFilter" t t)
+ (action file-chooser-action "action" "GtkFileChooserAction"
+ t t)
+ (show-hidden file-chooser-show-hidden "show-hidden"
+ "gboolean" t t)
+ (do-overwrite-confirmation
+ file-chooser-do-overwrite-confirmation
+ "do-overwrite-confirmation" "gboolean" t t)
+ (preview-widget file-chooser-preview-widget
+ "preview-widget" "GtkWidget" t t)
+ (select-multiple file-chooser-select-multiple
+ "select-multiple" "gboolean" t t)
+ (local-only file-chooser-local-only "local-only" "gboolean"
+ t t)
+ (preview-widget-active file-chooser-preview-widget-active
+ "preview-widget-active" "gboolean" t t))
+
+(define-g-interface "GtkFileChooserEmbed" file-chooser-embed (t))
+
+(define-g-interface "GtkTreeModel" tree-model (t))
+
+(define-g-interface "GtkTreeDragSource" tree-drag-source (t))
+
+(define-g-interface "GtkTreeDragDest" tree-drag-dest (t))
+
+(define-g-interface "GtkTreeSortable" tree-sortable (t))
+
+(define-g-interface "GtkPrintOperationPreview" print-operation-preview (t))
+
+(define-g-interface "GtkRecentChooser" recent-chooser (t)
+ (filter recent-chooser-filter "filter" "GtkRecentFilter" t
+ t)
+ (show-not-found recent-chooser-show-not-found
+ "show-not-found" "gboolean" t t)
+ (show-tips recent-chooser-show-tips "show-tips" "gboolean"
+ t t)
+ (show-icons recent-chooser-show-icons "show-icons"
+ "gboolean" t t)
+ (select-multiple recent-chooser-select-multiple
+ "select-multiple" "gboolean" t t)
+ (local-only recent-chooser-local-only "local-only"
+ "gboolean" t t)
+ (sort-type recent-chooser-sort-type "sort-type"
+ "GtkRecentSortType" t t)
+ (show-private recent-chooser-show-private "show-private"
+ "gboolean" t t)
+ (limit recent-chooser-limit "limit" "gint" t t)
+ (recent-manager recent-chooser-recent-manager
+ "recent-manager" "GtkRecentManager" nil nil))
+
+(define-g-interface "GtkToolShell" tool-shell (t))
+
+(define-g-interface "AtkImplementorIface" atk-implementor-iface (t))
+
+(define-g-object-class "GtkObject" gtk-object (g-initially-unowned t) nil
+ (user-data gtk-object-user-data "user-data" "gpointer" t
+ t))
+
+(define-g-object-class "GtkWidget" widget (gtk-object t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (name widget-name "name" "gchararray" t t)
+ (parent widget-parent "parent" "GtkContainer" t t)
+ (width-request widget-width-request "width-request"
+ "gint" t t)
+ (height-request widget-height-request "height-request"
+ "gint" t t)
+ (visible widget-visible "visible" "gboolean" t t)
+ (sensitive widget-sensitive "sensitive" "gboolean" t t)
+ (app-paintable widget-app-paintable "app-paintable"
+ "gboolean" t t)
+ (can-focus widget-can-focus "can-focus" "gboolean" t t)
+ (has-focus widget-has-focus "has-focus" "gboolean" t t)
+ (is-focus widget-is-focus "is-focus" "gboolean" t t)
+ (can-default widget-can-default "can-default" "gboolean"
+ t t)
+ (has-default widget-has-default "has-default" "gboolean"
+ t t)
+ (receives-default widget-receives-default
+ "receives-default" "gboolean" t t)
+ (composite-child widget-composite-child
+ "composite-child" "gboolean" t nil)
+ (style widget-style "style" "GtkStyle" t t)
+ (events widget-events "events" "GdkEventMask" t t)
+ (extension-events widget-extension-events
+ "extension-events" "GdkExtensionMode" t t)
+ (no-show-all widget-no-show-all "no-show-all" "gboolean"
+ t t)
+ (has-tooltip widget-has-tooltip "has-tooltip" "gboolean"
+ t t)
+ (tooltip-markup widget-tooltip-markup "tooltip-markup"
+ "gchararray" t t)
+ (tooltip-text widget-tooltip-text "tooltip-text"
+ "gchararray" t t)
+ (window widget-window "window" "GdkWindow" t nil))
+
+(define-g-object-class "GtkContainer" container (widget t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (border-width container-border-width "border-width"
+ "guint" t t)
+ (resize-mode container-resize-mode "resize-mode"
+ "GtkResizeMode" t t)
+ (child container-child "child" "GtkWidget" nil t))
+
+(define-g-object-class "GtkBin" bin (container t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkWindow" gtk-window (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (type gtk-window-type "type" "GtkWindowType" t nil)
+ (title gtk-window-title "title" "gchararray" t t)
+ (startup-id gtk-window-startup-id "startup-id"
+ "gchararray" nil t)
+ (role gtk-window-role "role" "gchararray" t t)
+ (allow-shrink gtk-window-allow-shrink "allow-shrink"
+ "gboolean" t t)
+ (allow-grow gtk-window-allow-grow "allow-grow"
+ "gboolean" t t)
+ (resizable gtk-window-resizable "resizable" "gboolean" t
+ t)
+ (modal gtk-window-modal "modal" "gboolean" t t)
+ (window-position gtk-window-window-position
+ "window-position" "GtkWindowPosition" t t)
+ (default-width gtk-window-default-width "default-width"
+ "gint" t t)
+ (default-height gtk-window-default-height
+ "default-height" "gint" t t)
+ (destroy-with-parent gtk-window-destroy-with-parent
+ "destroy-with-parent" "gboolean" t t)
+ (icon gtk-window-icon "icon" "GdkPixbuf" t t)
+ (icon-name gtk-window-icon-name "icon-name" "gchararray"
+ t t)
+ (screen gtk-window-screen "screen" "GdkScreen" t t)
+ (type-hint gtk-window-type-hint "type-hint"
+ "GdkWindowTypeHint" t t)
+ (skip-taskbar-hint gtk-window-skip-taskbar-hint
+ "skip-taskbar-hint" "gboolean" t t)
+ (skip-pager-hint gtk-window-skip-pager-hint
+ "skip-pager-hint" "gboolean" t t)
+ (urgency-hint gtk-window-urgency-hint "urgency-hint"
+ "gboolean" t t)
+ (accept-focus gtk-window-accept-focus "accept-focus"
+ "gboolean" t t)
+ (focus-on-map gtk-window-focus-on-map "focus-on-map"
+ "gboolean" t t)
+ (decorated gtk-window-decorated "decorated" "gboolean" t
+ t)
+ (deletable gtk-window-deletable "deletable" "gboolean" t
+ t)
+ (gravity gtk-window-gravity "gravity" "GdkGravity" t t)
+ (transient-for gtk-window-transient-for "transient-for"
+ "GtkWindow" t t)
+ (opacity gtk-window-opacity "opacity" "gdouble" t t)
+ (is-active gtk-window-is-active "is-active" "gboolean" t
+ nil)
+ (has-toplevel-focus gtk-window-has-toplevel-focus
+ "has-toplevel-focus" "gboolean" t nil))
+
+(define-g-object-class "GtkDialog" dialog (gtk-window t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (has-separator dialog-has-separator "has-separator"
+ "gboolean" t t))
+
+(define-g-object-class "GtkAboutDialog" about-dialog (dialog t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (program-name about-dialog-program-name "program-name"
+ "gchararray" t t)
+ (version about-dialog-version "version" "gchararray" t
+ t)
+ (copyright about-dialog-copyright "copyright"
+ "gchararray" t t)
+ (comments about-dialog-comments "comments" "gchararray"
+ t t)
+ (website about-dialog-website "website" "gchararray" t
+ t)
+ (website-label about-dialog-website-label
+ "website-label" "gchararray" t t)
+ (license about-dialog-license "license" "gchararray" t
+ t)
+ (authors about-dialog-authors "authors" "GStrv" t t)
+ (documenters about-dialog-documenters "documenters"
+ "GStrv" t t)
+ (translator-credits about-dialog-translator-credits
+ "translator-credits" "gchararray" t t)
+ (artists about-dialog-artists "artists" "GStrv" t t)
+ (logo about-dialog-logo "logo" "GdkPixbuf" t t)
+ (logo-icon-name about-dialog-logo-icon-name
+ "logo-icon-name" "gchararray" t t)
+ (wrap-license about-dialog-wrap-license "wrap-license"
+ "gboolean" t t))
+
+(define-g-object-class "GtkColorSelectionDialog" color-selection-dialog
+ (dialog t) ("AtkImplementorIface" "GtkBuildable")
+ (color-selection color-selection-dialog-color-selection
+ "color-selection" "GtkWidget" t nil)
+ (ok-button color-selection-dialog-ok-button "ok-button"
+ "GtkWidget" t nil)
+ (cancel-button color-selection-dialog-cancel-button
+ "cancel-button" "GtkWidget" t nil)
+ (help-button color-selection-dialog-help-button
+ "help-button" "GtkWidget" t nil))
+
+(define-g-object-class "GtkFileChooserDialog" file-chooser-dialog (dialog t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkFileChooser"))
+
+(define-g-object-class "GtkFontSelectionDialog" font-selection-dialog
+ (dialog t) ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkInputDialog" input-dialog (dialog t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkMessageDialog" message-dialog (dialog t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (message-type message-dialog-message-type "message-type"
+ "GtkMessageType" t t)
+ (buttons message-dialog-buttons "buttons"
+ "GtkButtonsType" nil nil)
+ (text message-dialog-text "text" "gchararray" t t)
+ (use-markup message-dialog-use-markup "use-markup"
+ "gboolean" t t)
+ (secondary-text message-dialog-secondary-text
+ "secondary-text" "gchararray" t t)
+ (secondary-use-markup
+ message-dialog-secondary-use-markup
+ "secondary-use-markup" "gboolean" t t)
+ (image message-dialog-image "image" "GtkWidget" t t))
+
+(define-g-object-class "GtkRecentChooserDialog" recent-chooser-dialog
+ (dialog t)
+ ("AtkImplementorIface" "GtkBuildable"
+ "GtkRecentChooser"))
+
+(define-g-object-class "GtkAssistant" assistant (gtk-window t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkPlug" plug (gtk-window t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (embedded plug-embedded "embedded" "gboolean" t nil)
+ (socket-window plug-socket-window "socket-window"
+ "GdkWindow" t nil))
+
+(define-g-object-class "GtkItem" item (bin t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkMenuItem" menu-item (item t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (right-justified menu-item-right-justified
+ "right-justified" "gboolean" t t)
+ (submenu menu-item-submenu "submenu" "GtkMenu" t t)
+ (accel-path menu-item-accel-path "accel-path"
+ "gchararray" t t))
+
+(define-g-object-class "GtkCheckMenuItem" check-menu-item (menu-item t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (active check-menu-item-active "active" "gboolean" t t)
+ (inconsistent check-menu-item-inconsistent
+ "inconsistent" "gboolean" t t)
+ (draw-as-radio check-menu-item-draw-as-radio
+ "draw-as-radio" "gboolean" t t))
+
+(define-g-object-class "GtkRadioMenuItem" radio-menu-item (check-menu-item t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (group radio-menu-item-group "group" "GtkRadioMenuItem"
+ nil t))
+
+(define-g-object-class "GtkImageMenuItem" image-menu-item (menu-item t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (image image-menu-item-image "image" "GtkWidget" t t))
+
+(define-g-object-class "GtkSeparatorMenuItem" separator-menu-item (menu-item t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkTearoffMenuItem" tearoff-menu-item (menu-item t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkTreeItem" tree-item (item t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkButton" button (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (label button-label "label" "gchararray" t t)
+ (image button-image "image" "GtkWidget" t t)
+ (relief button-relief "relief" "GtkReliefStyle" t t)
+ (use-underline button-use-underline "use-underline"
+ "gboolean" t t)
+ (use-stock button-use-stock "use-stock" "gboolean" t t)
+ (focus-on-click button-focus-on-click "focus-on-click"
+ "gboolean" t t)
+ (xalign button-xalign "xalign" "gfloat" t t)
+ (yalign button-yalign "yalign" "gfloat" t t)
+ (image-position button-image-position "image-position"
+ "GtkPositionType" t t))
+
+(define-g-object-class "GtkToggleButton" toggle-button (button t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (active toggle-button-active "active" "gboolean" t t)
+ (inconsistent toggle-button-inconsistent "inconsistent"
+ "gboolean" t t)
+ (draw-indicator toggle-button-draw-indicator
+ "draw-indicator" "gboolean" t t))
+
+(define-g-object-class "GtkCheckButton" check-button (toggle-button t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkRadioButton" radio-button (check-button t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (group radio-button-group "group" "GtkRadioButton" nil
+ t))
+
+(define-g-object-class "GtkColorButton" color-button (button t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (use-alpha color-button-use-alpha "use-alpha" "gboolean"
+ t t)
+ (title color-button-title "title" "gchararray" t t)
+ (color color-button-color "color" "GdkColor" t t)
+ (alpha color-button-alpha "alpha" "guint" t t))
+
+(define-g-object-class "GtkFontButton" font-button (button t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (title font-button-title "title" "gchararray" t t)
+ (font-name font-button-font-name "font-name"
+ "gchararray" t t)
+ (use-font font-button-use-font "use-font" "gboolean" t
+ t)
+ (use-size font-button-use-size "use-size" "gboolean" t
+ t)
+ (show-style font-button-show-style "show-style"
+ "gboolean" t t)
+ (show-size font-button-show-size "show-size" "gboolean"
+ t t))
+
+(define-g-object-class "GtkLinkButton" link-button (button t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (uri link-button-uri "uri" "gchararray" t t)
+ (visited link-button-visited "visited" "gboolean" t t))
+
+(define-g-object-class "GtkScaleButton" scale-button (button t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (orientation scale-button-orientation "orientation"
+ "GtkOrientation" t t)
+ (value scale-button-value "value" "gdouble" t t)
+ (size scale-button-size "size" "GtkIconSize" t t)
+ (adjustment scale-button-adjustment "adjustment"
+ "GtkAdjustment" t t)
+ (icons scale-button-icons "icons" "GStrv" t t))
+
+(define-g-object-class "GtkVolumeButton" volume-button (scale-button t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkAlignment" alignment (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (xalign alignment-xalign "xalign" "gfloat" t t)
+ (yalign alignment-yalign "yalign" "gfloat" t t)
+ (xscale alignment-xscale "xscale" "gfloat" t t)
+ (yscale alignment-yscale "yscale" "gfloat" t t)
+ (top-padding alignment-top-padding "top-padding" "guint"
+ t t)
+ (bottom-padding alignment-bottom-padding
+ "bottom-padding" "guint" t t)
+ (left-padding alignment-left-padding "left-padding"
+ "guint" t t)
+ (right-padding alignment-right-padding "right-padding"
+ "guint" t t))
+
+(define-g-object-class "GtkFrame" frame (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (label frame-label "label" "gchararray" t t)
+ (label-xalign frame-label-xalign "label-xalign" "gfloat"
+ t t)
+ (label-yalign frame-label-yalign "label-yalign" "gfloat"
+ t t)
+ (shadow frame-shadow "shadow" "GtkShadowType" t t)
+ (shadow-type frame-shadow-type "shadow-type"
+ "GtkShadowType" t t)
+ (label-widget frame-label-widget "label-widget"
+ "GtkWidget" t t))
+
+(define-g-object-class "GtkAspectFrame" aspect-frame (frame t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (xalign aspect-frame-xalign "xalign" "gfloat" t t)
+ (yalign aspect-frame-yalign "yalign" "gfloat" t t)
+ (ratio aspect-frame-ratio "ratio" "gfloat" t t)
+ (obey-child aspect-frame-obey-child "obey-child"
+ "gboolean" t t))
+
+(define-g-object-class "GtkComboBox" combo-box (bin t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkCellLayout"
+ "GtkCellEditable")
+ (model combo-box-model "model" "GtkTreeModel" t t)
+ (wrap-width combo-box-wrap-width "wrap-width" "gint" t
+ t)
+ (row-span-column combo-box-row-span-column
+ "row-span-column" "gint" t t)
+ (column-span-column combo-box-column-span-column
+ "column-span-column" "gint" t t)
+ (active combo-box-active "active" "gint" t t)
+ (add-tearoffs combo-box-add-tearoffs "add-tearoffs"
+ "gboolean" t t)
+ (tearoff-title combo-box-tearoff-title "tearoff-title"
+ "gchararray" t t)
+ (has-frame combo-box-has-frame "has-frame" "gboolean" t
+ t)
+ (focus-on-click combo-box-focus-on-click
+ "focus-on-click" "gboolean" t t)
+ (popup-shown combo-box-popup-shown "popup-shown"
+ "gboolean" t nil)
+ (button-sensitivity combo-box-button-sensitivity
+ "button-sensitivity" "GtkSensitivityType" t t))
+
+(define-g-object-class "GtkComboBoxEntry" combo-box-entry (combo-box t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkCellLayout"
+ "GtkCellEditable")
+ (text-column combo-box-entry-text-column "text-column"
+ "gint" t t))
+
+(define-g-object-class "GtkEventBox" event-box (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (visible-window event-box-visible-window
+ "visible-window" "gboolean" t t)
+ (above-child event-box-above-child "above-child"
+ "gboolean" t t))
+
+(define-g-object-class "GtkExpander" expander (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (expanded expander-expanded "expanded" "gboolean" t t)
+ (label expander-label "label" "gchararray" t t)
+ (use-underline expander-use-underline "use-underline"
+ "gboolean" t t)
+ (use-markup expander-use-markup "use-markup" "gboolean"
+ t t)
+ (spacing expander-spacing "spacing" "gint" t t)
+ (label-widget expander-label-widget "label-widget"
+ "GtkWidget" t t))
+
+(define-g-object-class "GtkHandleBox" handle-box (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (shadow handle-box-shadow "shadow" "GtkShadowType" t t)
+ (shadow-type handle-box-shadow-type "shadow-type"
+ "GtkShadowType" t t)
+ (handle-position handle-box-handle-position
+ "handle-position" "GtkPositionType" t t)
+ (snap-edge handle-box-snap-edge "snap-edge"
+ "GtkPositionType" t t)
+ (snap-edge-set handle-box-snap-edge-set "snap-edge-set"
+ "gboolean" t t)
+ (child-detached handle-box-child-detached
+ "child-detached" "gboolean" t nil))
+
+(define-g-object-class "GtkToolItem" tool-item (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (visible-horizontal tool-item-visible-horizontal
+ "visible-horizontal" "gboolean" t t)
+ (visible-vertical tool-item-visible-vertical
+ "visible-vertical" "gboolean" t t)
+ (is-important tool-item-is-important "is-important"
+ "gboolean" t t))
+
+(define-g-object-class "GtkToolButton" tool-button (tool-item t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (label tool-button-label "label" "gchararray" t t)
+ (use-underline tool-button-use-underline "use-underline"
+ "gboolean" t t)
+ (label-widget tool-button-label-widget "label-widget"
+ "GtkWidget" t t)
+ (stock-id tool-button-stock-id "stock-id" "gchararray" t
+ t)
+ (icon-name tool-button-icon-name "icon-name"
+ "gchararray" t t)
+ (icon-widget tool-button-icon-widget "icon-widget"
+ "GtkWidget" t t))
+
+(define-g-object-class "GtkMenuToolButton" menu-tool-button (tool-button t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (menu menu-tool-button-menu "menu" "GtkMenu" t t))
+
+(define-g-object-class "GtkToggleToolButton" toggle-tool-button (tool-button t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (active toggle-tool-button-active "active" "gboolean" t
+ t))
+
+(define-g-object-class "GtkRadioToolButton" radio-tool-button
+ (toggle-tool-button t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (group radio-tool-button-group "group"
+ "GtkRadioToolButton" nil t))
+
+(define-g-object-class "GtkSeparatorToolItem" separator-tool-item (tool-item t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (draw separator-tool-item-draw "draw" "gboolean" t t))
+
+(define-g-object-class "GtkScrolledWindow" scrolled-window (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (hadjustment scrolled-window-hadjustment "hadjustment"
+ "GtkAdjustment" t t)
+ (vadjustment scrolled-window-vadjustment "vadjustment"
+ "GtkAdjustment" t t)
+ (hscrollbar-policy scrolled-window-hscrollbar-policy
+ "hscrollbar-policy" "GtkPolicyType" t t)
+ (vscrollbar-policy scrolled-window-vscrollbar-policy
+ "vscrollbar-policy" "GtkPolicyType" t t)
+ (window-placement scrolled-window-window-placement
+ "window-placement" "GtkCornerType" t t)
+ (window-placement-set
+ scrolled-window-window-placement-set
+ "window-placement-set" "gboolean" t t)
+ (shadow-type scrolled-window-shadow-type "shadow-type"
+ "GtkShadowType" t t))
+
+(define-g-object-class "GtkViewport" viewport (bin t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (hadjustment viewport-hadjustment "hadjustment"
+ "GtkAdjustment" t t)
+ (vadjustment viewport-vadjustment "vadjustment"
+ "GtkAdjustment" t t)
+ (shadow-type viewport-shadow-type "shadow-type"
+ "GtkShadowType" t t))
+
+(define-g-object-class "GtkMenuShell" menu-shell (container t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (take-focus menu-shell-take-focus "take-focus"
+ "gboolean" t t))
+
+(define-g-object-class "GtkMenu" menu (menu-shell t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (active menu-active "active" "gint" t t)
+ (accel-group menu-accel-group "accel-group"
+ "GtkAccelGroup" t t)
+ (accel-path menu-accel-path "accel-path" "gchararray" t
+ t)
+ (attach-widget menu-attach-widget "attach-widget"
+ "GtkWidget" t t)
+ (tearoff-state menu-tearoff-state "tearoff-state"
+ "gboolean" t t)
+ (tearoff-title menu-tearoff-title "tearoff-title"
+ "gchararray" t t)
+ (monitor menu-monitor "monitor" "gint" t t))
+
+(define-g-object-class "GtkRecentChooserMenu" recent-chooser-menu (menu t)
+ ("AtkImplementorIface" "GtkBuildable"
+ "GtkRecentChooser")
+ (show-numbers recent-chooser-menu-show-numbers
+ "show-numbers" "gboolean" t t))
+
+(define-g-object-class "GtkMenuBar" menu-bar (menu-shell t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (pack-direction menu-bar-pack-direction "pack-direction"
+ "GtkPackDirection" t t)
+ (child-pack-direction menu-bar-child-pack-direction
+ "child-pack-direction" "GtkPackDirection" t t))
+
+(define-g-object-class "GtkNotebook" notebook (container t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (tab-pos notebook-tab-pos "tab-pos" "GtkPositionType" t
+ t)
+ (show-tabs notebook-show-tabs "show-tabs" "gboolean" t
+ t)
+ (show-border notebook-show-border "show-border"
+ "gboolean" t t)
+ (scrollable notebook-scrollable "scrollable" "gboolean"
+ t t)
+ (tab-border notebook-tab-border "tab-border" "guint" nil
+ t)
+ (tab-hborder notebook-tab-hborder "tab-hborder" "guint"
+ t t)
+ (tab-vborder notebook-tab-vborder "tab-vborder" "guint"
+ t t)
+ (page notebook-page "page" "gint" t t)
+ (enable-popup notebook-enable-popup "enable-popup"
+ "gboolean" t t)
+ (group-id notebook-group-id "group-id" "gint" t t)
+ (group notebook-group "group" "gpointer" t t)
+ (homogeneous notebook-homogeneous "homogeneous"
+ "gboolean" t t))
+
+(define-g-object-class "GtkTreeView" tree-view (container t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (model tree-view-model "model" "GtkTreeModel" t t)
+ (hadjustment tree-view-hadjustment "hadjustment"
+ "GtkAdjustment" t t)
+ (vadjustment tree-view-vadjustment "vadjustment"
+ "GtkAdjustment" t t)
+ (headers-visible tree-view-headers-visible
+ "headers-visible" "gboolean" t t)
+ (headers-clickable tree-view-headers-clickable
+ "headers-clickable" "gboolean" t t)
+ (expander-column tree-view-expander-column
+ "expander-column" "GtkTreeViewColumn" t t)
+ (reorderable tree-view-reorderable "reorderable"
+ "gboolean" t t)
+ (rules-hint tree-view-rules-hint "rules-hint" "gboolean"
+ t t)
+ (enable-search tree-view-enable-search "enable-search"
+ "gboolean" t t)
+ (search-column tree-view-search-column "search-column"
+ "gint" t t)
+ (fixed-height-mode tree-view-fixed-height-mode
+ "fixed-height-mode" "gboolean" t t)
+ (hover-selection tree-view-hover-selection
+ "hover-selection" "gboolean" t t)
+ (hover-expand tree-view-hover-expand "hover-expand"
+ "gboolean" t t)
+ (show-expanders tree-view-show-expanders
+ "show-expanders" "gboolean" t t)
+ (level-indentation tree-view-level-indentation
+ "level-indentation" "gint" t t)
+ (rubber-banding tree-view-rubber-banding
+ "rubber-banding" "gboolean" t t)
+ (enable-grid-lines tree-view-enable-grid-lines
+ "enable-grid-lines" "GtkTreeViewGridLines" t t)
+ (enable-tree-lines tree-view-enable-tree-lines
+ "enable-tree-lines" "gboolean" t t)
+ (tooltip-column tree-view-tooltip-column
+ "tooltip-column" "gint" t t))
+
+(define-g-object-class "GtkIconView" icon-view (container t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkCellLayout")
+ (pixbuf-column icon-view-pixbuf-column "pixbuf-column"
+ "gint" t t)
+ (text-column icon-view-text-column "text-column" "gint"
+ t t)
+ (markup-column icon-view-markup-column "markup-column"
+ "gint" t t)
+ (selection-mode icon-view-selection-mode
+ "selection-mode" "GtkSelectionMode" t t)
+ (orientation icon-view-orientation "orientation"
+ "GtkOrientation" t t)
+ (model icon-view-model "model" "GtkTreeModel" t t)
+ (columns icon-view-columns "columns" "gint" t t)
+ (item-width icon-view-item-width "item-width" "gint" t
+ t)
+ (spacing icon-view-spacing "spacing" "gint" t t)
+ (row-spacing icon-view-row-spacing "row-spacing" "gint"
+ t t)
+ (column-spacing icon-view-column-spacing
+ "column-spacing" "gint" t t)
+ (margin icon-view-margin "margin" "gint" t t)
+ (reorderable icon-view-reorderable "reorderable"
+ "gboolean" t t)
+ (tooltip-column icon-view-tooltip-column
+ "tooltip-column" "gint" t t))
+
+(define-g-object-class "GtkBox" box (container t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (spacing box-spacing "spacing" "gint" t t)
+ (homogeneous box-homogeneous "homogeneous" "gboolean" t
+ t))
+
+(define-g-object-class "GtkButtonBox" button-box (box t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (layout-style button-box-layout-style "layout-style"
+ "GtkButtonBoxStyle" t t))
+
+(define-g-object-class "GtkHButtonBox" h-button-box (button-box t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkVButtonBox" v-button-box (button-box t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkVBox" v-box (box t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkColorSelection" color-selection (v-box t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (has-palette color-selection-has-palette "has-palette"
+ "gboolean" t t)
+ (has-opacity-control color-selection-has-opacity-control
+ "has-opacity-control" "gboolean" t t)
+ (current-color color-selection-current-color
+ "current-color" "GdkColor" t t)
+ (current-alpha color-selection-current-alpha
+ "current-alpha" "guint" t t))
+
+(define-g-object-class "GtkFileChooserWidget" file-chooser-widget (v-box t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkFileChooser"
+ "GtkFileChooserEmbed"))
+
+(define-g-object-class "GtkFontSelection" font-selection (v-box t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (font-name font-selection-font-name "font-name"
+ "gchararray" t t)
+ (font font-selection-font "font" "GdkFont" t nil)
+ (preview-text font-selection-preview-text "preview-text"
+ "gchararray" t t))
+
+(define-g-object-class "GtkGammaCurve" gamma-curve (v-box t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkRecentChooserWidget" recent-chooser-widget (v-box t)
+ ("AtkImplementorIface" "GtkBuildable"
+ "GtkRecentChooser"))
+
+(define-g-object-class "GtkHBox" h-box (box t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkFileChooserButton" file-chooser-button (h-box t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkFileChooser")
+ (dialog file-chooser-button-dialog "dialog"
+ "GtkFileChooser" nil nil)
+ (focus-on-click file-chooser-button-focus-on-click
+ "focus-on-click" "gboolean" t t)
+ (title file-chooser-button-title "title" "gchararray" t
+ t)
+ (width-chars file-chooser-button-width-chars
+ "width-chars" "gint" t t))
+
+(define-g-object-class "GtkStatusbar" statusbar (h-box t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (has-resize-grip statusbar-has-resize-grip
+ "has-resize-grip" "gboolean" t t))
+
+(define-g-object-class "GtkCombo" combo (h-box t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (enable-arrow-keys combo-enable-arrow-keys
+ "enable-arrow-keys" "gboolean" t t)
+ (enable-arrows-always combo-enable-arrows-always
+ "enable-arrows-always" "gboolean" t t)
+ (case-sensitive combo-case-sensitive "case-sensitive"
+ "gboolean" t t)
+ (allow-empty combo-allow-empty "allow-empty" "gboolean"
+ t t)
+ (value-in-list combo-value-in-list "value-in-list"
+ "gboolean" t t))
+
+(define-g-object-class "GtkFixed" fixed (container t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkPaned" paned (container t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (position paned-position "position" "gint" t t)
+ (position-set paned-position-set "position-set"
+ "gboolean" t t)
+ (min-position paned-min-position "min-position" "gint" t
+ nil)
+ (max-position paned-max-position "max-position" "gint" t
+ nil))
+
+(define-g-object-class "GtkHPaned" h-paned (paned t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkVPaned" v-paned (paned t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkLayout" layout (container t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (hadjustment layout-hadjustment "hadjustment"
+ "GtkAdjustment" t t)
+ (vadjustment layout-vadjustment "vadjustment"
+ "GtkAdjustment" t t)
+ (width layout-width "width" "guint" t t)
+ (height layout-height "height" "guint" t t))
+
+(define-g-object-class "GtkSocket" socket (container t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkTable" table (container t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (n-rows table-n-rows "n-rows" "guint" t t)
+ (n-columns table-n-columns "n-columns" "guint" t t)
+ (column-spacing table-column-spacing "column-spacing"
+ "guint" t t)
+ (row-spacing table-row-spacing "row-spacing" "guint" t
+ t)
+ (homogeneous table-homogeneous "homogeneous" "gboolean"
+ t t))
+
+(define-g-object-class "GtkTextView" text-view (container t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (pixels-above-lines text-view-pixels-above-lines
+ "pixels-above-lines" "gint" t t)
+ (pixels-below-lines text-view-pixels-below-lines
+ "pixels-below-lines" "gint" t t)
+ (pixels-inside-wrap text-view-pixels-inside-wrap
+ "pixels-inside-wrap" "gint" t t)
+ (editable text-view-editable "editable" "gboolean" t t)
+ (wrap-mode text-view-wrap-mode "wrap-mode" "GtkWrapMode"
+ t t)
+ (justification text-view-justification "justification"
+ "GtkJustification" t t)
+ (left-margin text-view-left-margin "left-margin" "gint"
+ t t)
+ (right-margin text-view-right-margin "right-margin"
+ "gint" t t)
+ (indent text-view-indent "indent" "gint" t t)
+ (tabs text-view-tabs "tabs" "PangoTabArray" t t)
+ (cursor-visible text-view-cursor-visible
+ "cursor-visible" "gboolean" t t)
+ (buffer text-view-buffer "buffer" "GtkTextBuffer" t t)
+ (overwrite text-view-overwrite "overwrite" "gboolean" t
+ t)
+ (accepts-tab text-view-accepts-tab "accepts-tab"
+ "gboolean" t t))
+
+(define-g-object-class "GtkToolbar" toolbar (container t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkToolShell")
+ (orientation toolbar-orientation "orientation"
+ "GtkOrientation" t t)
+ (toolbar-style toolbar-toolbar-style "toolbar-style"
+ "GtkToolbarStyle" t t)
+ (show-arrow toolbar-show-arrow "show-arrow" "gboolean" t
+ t)
+ (tooltips toolbar-tooltips "tooltips" "gboolean" t t)
+ (icon-size toolbar-icon-size "icon-size" "GtkIconSize" t
+ t)
+ (icon-size-set toolbar-icon-size-set "icon-size-set"
+ "gboolean" t t))
+
+(define-g-object-class "GtkTree" tree (container t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkCList" c-list (container t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (n-columns c-list-n-columns "n-columns" "guint" t nil)
+ (shadow-type c-list-shadow-type "shadow-type"
+ "GtkShadowType" t t)
+ (selection-mode c-list-selection-mode "selection-mode"
+ "GtkSelectionMode" t t)
+ (row-height c-list-row-height "row-height" "guint" t t)
+ (titles-active c-list-titles-active "titles-active"
+ "gboolean" t t)
+ (reorderable c-list-reorderable "reorderable" "gboolean"
+ t t)
+ (use-drag-icons c-list-use-drag-icons "use-drag-icons"
+ "gboolean" t t)
+ (sort-type c-list-sort-type "sort-type" "GtkSortType" t
+ t))
+
+(define-g-object-class "GtkMisc" misc (widget t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (xalign misc-xalign "xalign" "gfloat" t t)
+ (yalign misc-yalign "yalign" "gfloat" t t)
+ (xpad misc-xpad "xpad" "gint" t t)
+ (ypad misc-ypad "ypad" "gint" t t))
+
+(define-g-object-class "GtkLabel" label (misc t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (label label-label "label" "gchararray" t t)
+ (attributes label-attributes "attributes"
+ "PangoAttrList" t t)
+ (use-markup label-use-markup "use-markup" "gboolean" t
+ t)
+ (use-underline label-use-underline "use-underline"
+ "gboolean" t t)
+ (justify label-justify "justify" "GtkJustification" t t)
+ (pattern label-pattern "pattern" "gchararray" nil t)
+ (wrap label-wrap "wrap" "gboolean" t t)
+ (wrap-mode label-wrap-mode "wrap-mode" "PangoWrapMode" t
+ t)
+ (selectable label-selectable "selectable" "gboolean" t
+ t)
+ (mnemonic-keyval label-mnemonic-keyval "mnemonic-keyval"
+ "guint" t nil)
+ (mnemonic-widget label-mnemonic-widget "mnemonic-widget"
+ "GtkWidget" t t)
+ (cursor-position label-cursor-position "cursor-position"
+ "gint" t nil)
+ (selection-bound label-selection-bound "selection-bound"
+ "gint" t nil)
+ (ellipsize label-ellipsize "ellipsize"
+ "PangoEllipsizeMode" t t)
+ (width-chars label-width-chars "width-chars" "gint" t t)
+ (single-line-mode label-single-line-mode
+ "single-line-mode" "gboolean" t t)
+ (angle label-angle "angle" "gdouble" t t)
+ (max-width-chars label-max-width-chars "max-width-chars"
+ "gint" t t))
+
+(define-g-object-class "GtkAccelLabel" accel-label (label t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (accel-closure accel-label-accel-closure "accel-closure"
+ "GClosure" t t)
+ (accel-widget accel-label-accel-widget "accel-widget"
+ "GtkWidget" t t))
+
+(define-g-object-class "GtkArrow" arrow (misc t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (arrow-type arrow-arrow-type "arrow-type" "GtkArrowType"
+ t t)
+ (shadow-type arrow-shadow-type "shadow-type"
+ "GtkShadowType" t t))
+
+(define-g-object-class "GtkImage" image (misc t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (pixbuf image-pixbuf "pixbuf" "GdkPixbuf" t t)
+ (pixmap image-pixmap "pixmap" "GdkPixmap" t t)
+ (image image-image "image" "GdkImage" t t)
+ (mask image-mask "mask" "GdkPixmap" t t)
+ (file image-file "file" "gchararray" t t)
+ (stock image-stock "stock" "gchararray" t t)
+ (icon-set image-icon-set "icon-set" "GtkIconSet" t t)
+ (icon-size image-icon-size "icon-size" "gint" t t)
+ (pixel-size image-pixel-size "pixel-size" "gint" t t)
+ (pixbuf-animation image-pixbuf-animation
+ "pixbuf-animation" "GdkPixbufAnimation" t t)
+ (icon-name image-icon-name "icon-name" "gchararray" t t)
+ (storage-type image-storage-type "storage-type"
+ "GtkImageType" t nil)
+ (gicon image-gicon "gicon" "GIcon" t t))
+
+(define-g-object-class "GtkCalendar" calendar (widget t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (year calendar-year "year" "gint" t t)
+ (month calendar-month "month" "gint" t t)
+ (day calendar-day "day" "gint" t t)
+ (show-heading calendar-show-heading "show-heading"
+ "gboolean" t t)
+ (show-day-names calendar-show-day-names "show-day-names"
+ "gboolean" t t)
+ (no-month-change calendar-no-month-change
+ "no-month-change" "gboolean" t t)
+ (show-week-numbers calendar-show-week-numbers
+ "show-week-numbers" "gboolean" t t)
+ (show-details calendar-show-details "show-details"
+ "gboolean" t t)
+ (detail-width-chars calendar-detail-width-chars
+ "detail-width-chars" "gint" t t)
+ (detail-height-rows calendar-detail-height-rows
+ "detail-height-rows" "gint" t t))
+
+(define-g-object-class "GtkCellView" cell-view (widget t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkCellLayout")
+ (background cell-view-background "background"
+ "gchararray" nil t)
+ (background-gdk cell-view-background-gdk
+ "background-gdk" "GdkColor" t t)
+ (background-set cell-view-background-set
+ "background-set" "gboolean" t t)
+ (model cell-view-model "model" "GtkTreeModel" t t))
+
+(define-g-object-class "GtkDrawingArea" drawing-area (widget t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkCurve" curve (drawing-area t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (curve-type curve-curve-type "curve-type" "GtkCurveType"
+ t t)
+ (min-x curve-min-x "min-x" "gfloat" t t)
+ (max-x curve-max-x "max-x" "gfloat" t t)
+ (min-y curve-min-y "min-y" "gfloat" t t)
+ (max-y curve-max-y "max-y" "gfloat" t t))
+
+(define-g-object-class "GtkEntry" entry (widget t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkCellEditable"
+ "GtkEditable")
+ (cursor-position entry-cursor-position "cursor-position"
+ "gint" t nil)
+ (selection-bound entry-selection-bound "selection-bound"
+ "gint" t nil)
+ (editable entry-editable "editable" "gboolean" t t)
+ (max-length entry-max-length "max-length" "gint" t t)
+ (visibility entry-visibility "visibility" "gboolean" t
+ t)
+ (has-frame entry-has-frame "has-frame" "gboolean" t t)
+ (inner-border entry-inner-border "inner-border"
+ "GtkBorder" t t)
+ (invisible-char entry-invisible-char "invisible-char"
+ "guint" t t)
+ (activates-default entry-activates-default
+ "activates-default" "gboolean" t t)
+ (width-chars entry-width-chars "width-chars" "gint" t t)
+ (scroll-offset entry-scroll-offset "scroll-offset"
+ "gint" t nil)
+ (text entry-text "text" "gchararray" t t)
+ (xalign entry-xalign "xalign" "gfloat" t t)
+ (truncate-multiline entry-truncate-multiline
+ "truncate-multiline" "gboolean" t t)
+ (shadow-type entry-shadow-type "shadow-type"
+ "GtkShadowType" t t)
+ (overwrite-mode entry-overwrite-mode "overwrite-mode"
+ "gboolean" t t)
+ (text-length entry-text-length "text-length" "guint" t
+ nil))
+
+(define-g-object-class "GtkSpinButton" spin-button (entry t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkCellEditable"
+ "GtkEditable")
+ (adjustment spin-button-adjustment "adjustment"
+ "GtkAdjustment" t t)
+ (climb-rate spin-button-climb-rate "climb-rate"
+ "gdouble" t t)
+ (digits spin-button-digits "digits" "guint" t t)
+ (snap-to-ticks spin-button-snap-to-ticks "snap-to-ticks"
+ "gboolean" t t)
+ (numeric spin-button-numeric "numeric" "gboolean" t t)
+ (wrap spin-button-wrap "wrap" "gboolean" t t)
+ (update-policy spin-button-update-policy "update-policy"
+ "GtkSpinButtonUpdatePolicy" t t)
+ (value spin-button-value "value" "gdouble" t t))
+
+(define-g-object-class "GtkRuler" ruler (widget t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (lower ruler-lower "lower" "gdouble" t t)
+ (upper ruler-upper "upper" "gdouble" t t)
+ (position ruler-position "position" "gdouble" t t)
+ (max-size ruler-max-size "max-size" "gdouble" t t)
+ (metric ruler-metric "metric" "GtkMetricType" t t))
+
+(define-g-object-class "GtkHRuler" h-ruler (ruler t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkVRuler" v-ruler (ruler t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkRange" range (widget t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (update-policy range-update-policy "update-policy"
+ "GtkUpdateType" t t)
+ (adjustment range-adjustment "adjustment"
+ "GtkAdjustment" t t)
+ (inverted range-inverted "inverted" "gboolean" t t)
+ (lower-stepper-sensitivity
+ range-lower-stepper-sensitivity
+ "lower-stepper-sensitivity" "GtkSensitivityType" t t)
+ (upper-stepper-sensitivity
+ range-upper-stepper-sensitivity
+ "upper-stepper-sensitivity" "GtkSensitivityType" t t)
+ (show-fill-level range-show-fill-level "show-fill-level"
+ "gboolean" t t)
+ (restrict-to-fill-level range-restrict-to-fill-level
+ "restrict-to-fill-level" "gboolean" t t)
+ (fill-level range-fill-level "fill-level" "gdouble" t t))
+
+(define-g-object-class "GtkScale" scale (range t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (digits scale-digits "digits" "gint" t t)
+ (draw-value scale-draw-value "draw-value" "gboolean" t
+ t)
+ (value-pos scale-value-pos "value-pos" "GtkPositionType"
+ t t))
+
+(define-g-object-class "GtkHScale" h-scale (scale t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkVScale" v-scale (scale t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkScrollbar" scrollbar (range t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkHScrollbar" h-scrollbar (scrollbar t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkVScrollbar" v-scrollbar (scrollbar t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkSeparator" separator (widget t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkHSeparator" h-separator (separator t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkVSeparator" v-separator (separator t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkHSV" h-s-v (widget t)
+ ("AtkImplementorIface" "GtkBuildable"))
+
+(define-g-object-class "GtkInvisible" invisible (widget t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (screen invisible-screen "screen" "GdkScreen" t t))
+
+(define-g-object-class "GtkProgress" progress (widget t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (activity-mode progress-activity-mode "activity-mode"
+ "gboolean" t t)
+ (show-text progress-show-text "show-text" "gboolean" t
+ t)
+ (text-xalign progress-text-xalign "text-xalign" "gfloat"
+ t t)
+ (text-yalign progress-text-yalign "text-yalign" "gfloat"
+ t t))
+
+(define-g-object-class "GtkProgressBar" progress-bar (progress t)
+ ("AtkImplementorIface" "GtkBuildable")
+ (fraction progress-bar-fraction "fraction" "gdouble" t
+ t)
+ (pulse-step progress-bar-pulse-step "pulse-step"
+ "gdouble" t t)
+ (orientation progress-bar-orientation "orientation"
+ "GtkProgressBarOrientation" t t)
+ (text progress-bar-text "text" "gchararray" t t)
+ (ellipsize progress-bar-ellipsize "ellipsize"
+ "PangoEllipsizeMode" t t)
+ (adjustment progress-bar-adjustment "adjustment"
+ "GtkAdjustment" t t)
+ (bar-style progress-bar-bar-style "bar-style"
+ "GtkProgressBarStyle" t t)
+ (activity-step progress-bar-activity-step
+ "activity-step" "guint" t t)
+ (activity-blocks progress-bar-activity-blocks
+ "activity-blocks" "guint" t t)
+ (discrete-blocks progress-bar-discrete-blocks
+ "discrete-blocks" "guint" t t))
+
+(define-g-object-class "GtkOldEditable" old-editable (widget t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkEditable")
+ (text-position old-editable-text-position
+ "text-position" "gint" t t)
+ (editable old-editable-editable "editable" "gboolean" t
+ t))
+
+(define-g-object-class "GtkText" text (old-editable t)
+ ("AtkImplementorIface" "GtkBuildable" "GtkEditable")
+ (hadjustment text-hadjustment "hadjustment"
+ "GtkAdjustment" t t)
+ (vadjustment text-vadjustment "vadjustment"
+ "GtkAdjustment" t t)
+ (line-wrap text-line-wrap "line-wrap" "gboolean" t t)
+ (word-wrap text-word-wrap "word-wrap" "gboolean" t t))
+
+(define-g-object-class "GtkAdjustment" adjustment (gtk-object t) nil
+ (value adjustment-value "value" "gdouble" t t)
+ (lower adjustment-lower "lower" "gdouble" t t)
+ (upper adjustment-upper "upper" "gdouble" t t)
+ (step-increment adjustment-step-increment
+ "step-increment" "gdouble" t t)
+ (page-increment adjustment-page-increment
+ "page-increment" "gdouble" t t)
+ (page-size adjustment-page-size "page-size" "gdouble" t
+ t))
+
+(define-g-object-class "GtkTreeViewColumn" tree-view-column (gtk-object t)
+ ("GtkBuildable" "GtkCellLayout")
+ (visible tree-view-column-visible "visible" "gboolean" t
+ t)
+ (resizable tree-view-column-resizable "resizable"
+ "gboolean" t t)
+ (width tree-view-column-width "width" "gint" t nil)
+ (spacing tree-view-column-spacing "spacing" "gint" t t)
+ (sizing tree-view-column-sizing "sizing"
+ "GtkTreeViewColumnSizing" t t)
+ (fixed-width tree-view-column-fixed-width "fixed-width"
+ "gint" t t)
+ (min-width tree-view-column-min-width "min-width" "gint"
+ t t)
+ (max-width tree-view-column-max-width "max-width" "gint"
+ t t)
+ (title tree-view-column-title "title" "gchararray" t t)
+ (expand tree-view-column-expand "expand" "gboolean" t t)
+ (clickable tree-view-column-clickable "clickable"
+ "gboolean" t t)
+ (widget tree-view-column-widget "widget" "GtkWidget" t
+ t)
+ (alignment tree-view-column-alignment "alignment"
+ "gfloat" t t)
+ (reorderable tree-view-column-reorderable "reorderable"
+ "gboolean" t t)
+ (sort-indicator tree-view-column-sort-indicator
+ "sort-indicator" "gboolean" t t)
+ (sort-order tree-view-column-sort-order "sort-order"
+ "GtkSortType" t t))
+
+(define-g-object-class "GtkCellRenderer" cell-renderer (gtk-object t) nil
+ (mode cell-renderer-mode "mode" "GtkCellRendererMode" t
+ t)
+ (visible cell-renderer-visible "visible" "gboolean" t t)
+ (sensitive cell-renderer-sensitive "sensitive"
+ "gboolean" t t)
+ (xalign cell-renderer-xalign "xalign" "gfloat" t t)
+ (yalign cell-renderer-yalign "yalign" "gfloat" t t)
+ (xpad cell-renderer-xpad "xpad" "guint" t t)
+ (ypad cell-renderer-ypad "ypad" "guint" t t)
+ (width cell-renderer-width "width" "gint" t t)
+ (height cell-renderer-height "height" "gint" t t)
+ (is-expander cell-renderer-is-expander "is-expander"
+ "gboolean" t t)
+ (is-expanded cell-renderer-is-expanded "is-expanded"
+ "gboolean" t t)
+ (cell-background cell-renderer-cell-background
+ "cell-background" "gchararray" nil t)
+ (cell-background-gdk cell-renderer-cell-background-gdk
+ "cell-background-gdk" "GdkColor" t t)
+ (cell-background-set cell-renderer-cell-background-set
+ "cell-background-set" "gboolean" t t)
+ (editing cell-renderer-editing "editing" "gboolean" t
+ nil))
+
+(define-g-object-class "GtkCellRendererText" cell-renderer-text
+ (cell-renderer t) nil
+ (text cell-renderer-text-text "text" "gchararray" t t)
+ (markup cell-renderer-text-markup "markup" "gchararray"
+ nil t)
+ (attributes cell-renderer-text-attributes "attributes"
+ "PangoAttrList" t t)
+ (single-paragraph-mode
+ cell-renderer-text-single-paragraph-mode
+ "single-paragraph-mode" "gboolean" t t)
+ (width-chars cell-renderer-text-width-chars
+ "width-chars" "gint" t t)
+ (wrap-width cell-renderer-text-wrap-width "wrap-width"
+ "gint" t t)
+ (alignment cell-renderer-text-alignment "alignment"
+ "PangoAlignment" t t)
+ (background cell-renderer-text-background "background"
+ "gchararray" nil t)
+ (foreground cell-renderer-text-foreground "foreground"
+ "gchararray" nil t)
+ (background-gdk cell-renderer-text-background-gdk
+ "background-gdk" "GdkColor" t t)
+ (foreground-gdk cell-renderer-text-foreground-gdk
+ "foreground-gdk" "GdkColor" t t)
+ (font cell-renderer-text-font "font" "gchararray" t t)
+ (font-desc cell-renderer-text-font-desc "font-desc"
+ "PangoFontDescription" t t)
+ (family cell-renderer-text-family "family" "gchararray"
+ t t)
+ (style cell-renderer-text-style "style" "PangoStyle" t
+ t)
+ (variant cell-renderer-text-variant "variant"
+ "PangoVariant" t t)
+ (weight cell-renderer-text-weight "weight" "gint" t t)
+ (stretch cell-renderer-text-stretch "stretch"
+ "PangoStretch" t t)
+ (size cell-renderer-text-size "size" "gint" t t)
+ (size-points cell-renderer-text-size-points
+ "size-points" "gdouble" t t)
+ (scale cell-renderer-text-scale "scale" "gdouble" t t)
+ (editable cell-renderer-text-editable "editable"
+ "gboolean" t t)
+ (strikethrough cell-renderer-text-strikethrough
+ "strikethrough" "gboolean" t t)
+ (underline cell-renderer-text-underline "underline"
+ "PangoUnderline" t t)
+ (rise cell-renderer-text-rise "rise" "gint" t t)
+ (language cell-renderer-text-language "language"
+ "gchararray" t t)
+ (ellipsize cell-renderer-text-ellipsize "ellipsize"
+ "PangoEllipsizeMode" t t)
+ (wrap-mode cell-renderer-text-wrap-mode "wrap-mode"
+ "PangoWrapMode" t t)
+ (background-set cell-renderer-text-background-set
+ "background-set" "gboolean" t t)
+ (foreground-set cell-renderer-text-foreground-set
+ "foreground-set" "gboolean" t t)
+ (family-set cell-renderer-text-family-set "family-set"
+ "gboolean" t t)
+ (style-set cell-renderer-text-style-set "style-set"
+ "gboolean" t t)
+ (variant-set cell-renderer-text-variant-set
+ "variant-set" "gboolean" t t)
+ (weight-set cell-renderer-text-weight-set "weight-set"
+ "gboolean" t t)
+ (stretch-set cell-renderer-text-stretch-set
+ "stretch-set" "gboolean" t t)
+ (size-set cell-renderer-text-size-set "size-set"
+ "gboolean" t t)
+ (scale-set cell-renderer-text-scale-set "scale-set"
+ "gboolean" t t)
+ (editable-set cell-renderer-text-editable-set
+ "editable-set" "gboolean" t t)
+ (strikethrough-set cell-renderer-text-strikethrough-set
+ "strikethrough-set" "gboolean" t t)
+ (underline-set cell-renderer-text-underline-set
+ "underline-set" "gboolean" t t)
+ (rise-set cell-renderer-text-rise-set "rise-set"
+ "gboolean" t t)
+ (language-set cell-renderer-text-language-set
+ "language-set" "gboolean" t t)
+ (ellipsize-set cell-renderer-text-ellipsize-set
+ "ellipsize-set" "gboolean" t t)
+ (align-set cell-renderer-text-align-set "align-set"
+ "gboolean" t t))
+
+(define-g-object-class "GtkCellRendererAccel" cell-renderer-accel
+ (cell-renderer-text t) nil
+ (accel-key cell-renderer-accel-accel-key "accel-key"
+ "guint" t t)
+ (accel-mods cell-renderer-accel-accel-mods "accel-mods"
+ "GdkModifierType" t t)
+ (keycode cell-renderer-accel-keycode "keycode" "guint" t
+ t)
+ (accel-mode cell-renderer-accel-accel-mode "accel-mode"
+ "GtkCellRendererAccelMode" t t))
+
+(define-g-object-class "GtkCellRendererCombo" cell-renderer-combo
+ (cell-renderer-text t) nil
+ (model cell-renderer-combo-model "model" "GtkTreeModel"
+ t t)
+ (text-column cell-renderer-combo-text-column
+ "text-column" "gint" t t)
+ (has-entry cell-renderer-combo-has-entry "has-entry"
+ "gboolean" t t))
+
+(define-g-object-class "GtkCellRendererSpin" cell-renderer-spin
+ (cell-renderer-text t) nil
+ (adjustment cell-renderer-spin-adjustment "adjustment"
+ "GtkAdjustment" t t)
+ (climb-rate cell-renderer-spin-climb-rate "climb-rate"
+ "gdouble" t t)
+ (digits cell-renderer-spin-digits "digits" "guint" t t))
+
+(define-g-object-class "GtkCellRendererPixbuf" cell-renderer-pixbuf
+ (cell-renderer t) nil
+ (pixbuf cell-renderer-pixbuf-pixbuf "pixbuf" "GdkPixbuf"
+ t t)
+ (pixbuf-expander-open
+ cell-renderer-pixbuf-pixbuf-expander-open
+ "pixbuf-expander-open" "GdkPixbuf" t t)
+ (pixbuf-expander-closed
+ cell-renderer-pixbuf-pixbuf-expander-closed
+ "pixbuf-expander-closed" "GdkPixbuf" t t)
+ (stock-id cell-renderer-pixbuf-stock-id "stock-id"
+ "gchararray" t t)
+ (stock-size cell-renderer-pixbuf-stock-size "stock-size"
+ "guint" t t)
+ (stock-detail cell-renderer-pixbuf-stock-detail
+ "stock-detail" "gchararray" t t)
+ (follow-state cell-renderer-pixbuf-follow-state
+ "follow-state" "gboolean" t t)
+ (icon-name cell-renderer-pixbuf-icon-name "icon-name"
+ "gchararray" t t)
+ (gicon cell-renderer-pixbuf-gicon "gicon" "GIcon" t t))
+
+(define-g-object-class "GtkCellRendererProgress" cell-renderer-progress
+ (cell-renderer t) nil
+ (value cell-renderer-progress-value "value" "gint" t t)
+ (text cell-renderer-progress-text "text" "gchararray" t
+ t)
+ (pulse cell-renderer-progress-pulse "pulse" "gint" t t)
+ (text-xalign cell-renderer-progress-text-xalign
+ "text-xalign" "gfloat" t t)
+ (text-yalign cell-renderer-progress-text-yalign
+ "text-yalign" "gfloat" t t)
+ (orientation cell-renderer-progress-orientation
+ "orientation" "GtkProgressBarOrientation" t t))
+
+(define-g-object-class "GtkCellRendererToggle" cell-renderer-toggle
+ (cell-renderer t) nil
+ (activatable cell-renderer-toggle-activatable
+ "activatable" "gboolean" t t)
+ (active cell-renderer-toggle-active "active" "gboolean"
+ t t)
+ (radio cell-renderer-toggle-radio "radio" "gboolean" t
+ t)
+ (inconsistent cell-renderer-toggle-inconsistent
+ "inconsistent" "gboolean" t t)
+ (indicator-size cell-renderer-toggle-indicator-size
+ "indicator-size" "gint" t t))
+
+(define-g-object-class "GtkFileFilter" file-filter (gtk-object t) nil)
+
+(define-g-object-class "GtkRecentFilter" recent-filter (gtk-object t) nil)
+
+(define-g-object-class "GtkTooltips" tooltips (gtk-object t) nil)
+
+(define-g-object-class "GtkSettings" settings (g-object t) nil
+ (gtk-double-click-time settings-gtk-double-click-time
+ "gtk-double-click-time" "gint" t t)
+ (gtk-double-click-distance
+ settings-gtk-double-click-distance
+ "gtk-double-click-distance" "gint" t t)
+ (gtk-cursor-blink settings-gtk-cursor-blink
+ "gtk-cursor-blink" "gboolean" t t)
+ (gtk-cursor-blink-time settings-gtk-cursor-blink-time
+ "gtk-cursor-blink-time" "gint" t t)
+ (gtk-cursor-blink-timeout
+ settings-gtk-cursor-blink-timeout
+ "gtk-cursor-blink-timeout" "gint" t t)
+ (gtk-split-cursor settings-gtk-split-cursor
+ "gtk-split-cursor" "gboolean" t t)
+ (gtk-theme-name settings-gtk-theme-name "gtk-theme-name"
+ "gchararray" t t)
+ (gtk-icon-theme-name settings-gtk-icon-theme-name
+ "gtk-icon-theme-name" "gchararray" t t)
+ (gtk-fallback-icon-theme
+ settings-gtk-fallback-icon-theme
+ "gtk-fallback-icon-theme" "gchararray" t t)
+ (gtk-key-theme-name settings-gtk-key-theme-name
+ "gtk-key-theme-name" "gchararray" t t)
+ (gtk-menu-bar-accel settings-gtk-menu-bar-accel
+ "gtk-menu-bar-accel" "gchararray" t t)
+ (gtk-dnd-drag-threshold settings-gtk-dnd-drag-threshold
+ "gtk-dnd-drag-threshold" "gint" t t)
+ (gtk-font-name settings-gtk-font-name "gtk-font-name"
+ "gchararray" t t)
+ (gtk-icon-sizes settings-gtk-icon-sizes "gtk-icon-sizes"
+ "gchararray" t t)
+ (gtk-modules settings-gtk-modules "gtk-modules"
+ "gchararray" t t)
+ (gtk-xft-antialias settings-gtk-xft-antialias
+ "gtk-xft-antialias" "gint" t t)
+ (gtk-xft-hinting settings-gtk-xft-hinting
+ "gtk-xft-hinting" "gint" t t)
+ (gtk-xft-hintstyle settings-gtk-xft-hintstyle
+ "gtk-xft-hintstyle" "gchararray" t t)
+ (gtk-xft-rgba settings-gtk-xft-rgba "gtk-xft-rgba"
+ "gchararray" t t)
+ (gtk-xft-dpi settings-gtk-xft-dpi "gtk-xft-dpi" "gint" t
+ t)
+ (gtk-cursor-theme-name settings-gtk-cursor-theme-name
+ "gtk-cursor-theme-name" "gchararray" t t)
+ (gtk-cursor-theme-size settings-gtk-cursor-theme-size
+ "gtk-cursor-theme-size" "gint" t t)
+ (gtk-alternative-button-order
+ settings-gtk-alternative-button-order
+ "gtk-alternative-button-order" "gboolean" t t)
+ (gtk-alternative-sort-arrows
+ settings-gtk-alternative-sort-arrows
+ "gtk-alternative-sort-arrows" "gboolean" t t)
+ (gtk-show-input-method-menu
+ settings-gtk-show-input-method-menu
+ "gtk-show-input-method-menu" "gboolean" t t)
+ (gtk-show-unicode-menu settings-gtk-show-unicode-menu
+ "gtk-show-unicode-menu" "gboolean" t t)
+ (gtk-timeout-initial settings-gtk-timeout-initial
+ "gtk-timeout-initial" "gint" t t)
+ (gtk-timeout-repeat settings-gtk-timeout-repeat
+ "gtk-timeout-repeat" "gint" t t)
+ (gtk-timeout-expand settings-gtk-timeout-expand
+ "gtk-timeout-expand" "gint" t t)
+ (gtk-color-scheme settings-gtk-color-scheme
+ "gtk-color-scheme" "gchararray" t t)
+ (gtk-enable-animations settings-gtk-enable-animations
+ "gtk-enable-animations" "gboolean" t t)
+ (gtk-touchscreen-mode settings-gtk-touchscreen-mode
+ "gtk-touchscreen-mode" "gboolean" t t)
+ (gtk-tooltip-timeout settings-gtk-tooltip-timeout
+ "gtk-tooltip-timeout" "gint" t t)
+ (gtk-tooltip-browse-timeout
+ settings-gtk-tooltip-browse-timeout
+ "gtk-tooltip-browse-timeout" "gint" t t)
+ (gtk-tooltip-browse-mode-timeout
+ settings-gtk-tooltip-browse-mode-timeout
+ "gtk-tooltip-browse-mode-timeout" "gint" t t)
+ (gtk-keynav-cursor-only settings-gtk-keynav-cursor-only
+ "gtk-keynav-cursor-only" "gboolean" t t)
+ (gtk-keynav-wrap-around settings-gtk-keynav-wrap-around
+ "gtk-keynav-wrap-around" "gboolean" t t)
+ (gtk-error-bell settings-gtk-error-bell "gtk-error-bell"
+ "gboolean" t t)
+ (color-hash settings-color-hash "color-hash"
+ "GHashTable" t nil)
+ (gtk-file-chooser-backend
+ settings-gtk-file-chooser-backend
+ "gtk-file-chooser-backend" "gchararray" t t)
+ (gtk-print-backends settings-gtk-print-backends
+ "gtk-print-backends" "gchararray" t t)
+ (gtk-print-preview-command
+ settings-gtk-print-preview-command
+ "gtk-print-preview-command" "gchararray" t t)
+ (gtk-enable-mnemonics settings-gtk-enable-mnemonics
+ "gtk-enable-mnemonics" "gboolean" t t)
+ (gtk-enable-accels settings-gtk-enable-accels
+ "gtk-enable-accels" "gboolean" t t)
+ (gtk-recent-files-limit settings-gtk-recent-files-limit
+ "gtk-recent-files-limit" "gint" t t)
+ (gtk-im-module settings-gtk-im-module "gtk-im-module"
+ "gchararray" t t)
+ (gtk-recent-files-max-age
+ settings-gtk-recent-files-max-age
+ "gtk-recent-files-max-age" "gint" t t)
+ (gtk-fontconfig-timestamp
+ settings-gtk-fontconfig-timestamp
+ "gtk-fontconfig-timestamp" "gint" t t)
+ (gtk-sound-theme-name settings-gtk-sound-theme-name
+ "gtk-sound-theme-name" "gchararray" t t)
+ (gtk-enable-input-feedback-sounds
+ settings-gtk-enable-input-feedback-sounds
+ "gtk-enable-input-feedback-sounds" "gboolean" t t)
+ (gtk-enable-event-sounds
+ settings-gtk-enable-event-sounds
+ "gtk-enable-event-sounds" "gboolean" t t)
+ (gtk-enable-tooltips settings-gtk-enable-tooltips
+ "gtk-enable-tooltips" "gboolean" t t)
+ (gtk-button-images settings-gtk-button-images
+ "gtk-button-images" "gboolean" t t)
+ (gtk-label-select-on-focus
+ settings-gtk-label-select-on-focus
+ "gtk-label-select-on-focus" "gboolean" t t)
+ (gtk-menu-images settings-gtk-menu-images
+ "gtk-menu-images" "gboolean" t t)
+ (gtk-scrolled-window-placement
+ settings-gtk-scrolled-window-placement
+ "gtk-scrolled-window-placement" "GtkCornerType" t t)
+ (gtk-can-change-accels settings-gtk-can-change-accels
+ "gtk-can-change-accels" "gboolean" t t)
+ (gtk-menu-popup-delay settings-gtk-menu-popup-delay
+ "gtk-menu-popup-delay" "gint" t t)
+ (gtk-menu-popdown-delay settings-gtk-menu-popdown-delay
+ "gtk-menu-popdown-delay" "gint" t t)
+ (gtk-menu-bar-popup-delay
+ settings-gtk-menu-bar-popup-delay
+ "gtk-menu-bar-popup-delay" "gint" t t)
+ (gtk-color-palette settings-gtk-color-palette
+ "gtk-color-palette" "gchararray" t t)
+ (gtk-toolbar-style settings-gtk-toolbar-style
+ "gtk-toolbar-style" "GtkToolbarStyle" t t)
+ (gtk-toolbar-icon-size settings-gtk-toolbar-icon-size
+ "gtk-toolbar-icon-size" "GtkIconSize" t t)
+ (gtk-entry-select-on-focus
+ settings-gtk-entry-select-on-focus
+ "gtk-entry-select-on-focus" "gboolean" t t)
+ (gtk-entry-password-hint-timeout
+ settings-gtk-entry-password-hint-timeout
+ "gtk-entry-password-hint-timeout" "guint" t t))
+
+(define-g-object-class "GtkRcStyle" rc-style (g-object t) nil)
+
+(define-g-object-class "GtkStyle" style (g-object t) nil)
+
+(define-g-object-class "GtkTooltip" tooltip (g-object t) nil)
+
+(define-g-object-class "GtkAccelGroup" accel-group (g-object t) nil
+ (is-locked accel-group-is-locked "is-locked" "gboolean"
+ t nil)
+ (modifier-mask accel-group-modifier-mask "modifier-mask"
+ "GdkModifierType" t nil))
+
+(define-g-object-class "GtkAccelMap" accel-map (g-object t) nil)
+
+(define-g-object-class "GtkAction" action (g-object t) ("GtkBuildable")
+ (name action-name "name" "gchararray" t nil)
+ (label action-label "label" "gchararray" t t)
+ (short-label action-short-label "short-label"
+ "gchararray" t t)
+ (tooltip action-tooltip "tooltip" "gchararray" t t)
+ (stock-id action-stock-id "stock-id" "gchararray" t t)
+ (icon-name action-icon-name "icon-name" "gchararray" t
+ t)
+ (visible-horizontal action-visible-horizontal
+ "visible-horizontal" "gboolean" t t)
+ (visible-vertical action-visible-vertical
+ "visible-vertical" "gboolean" t t)
+ (visible-overflown action-visible-overflown
+ "visible-overflown" "gboolean" t t)
+ (is-important action-is-important "is-important"
+ "gboolean" t t)
+ (hide-if-empty action-hide-if-empty "hide-if-empty"
+ "gboolean" t t)
+ (sensitive action-sensitive "sensitive" "gboolean" t t)
+ (visible action-visible "visible" "gboolean" t t)
+ (action-group action-action-group "action-group"
+ "GtkActionGroup" t t))
+
+(define-g-object-class "GtkActionGroup" action-group (g-object t)
+ ("GtkBuildable")
+ (name action-group-name "name" "gchararray" t nil)
+ (sensitive action-group-sensitive "sensitive" "gboolean"
+ t t)
+ (visible action-group-visible "visible" "gboolean" t t))
+
+(define-g-object-class "GtkBuilder" builder (g-object t) nil
+ (translation-domain builder-translation-domain
+ "translation-domain" "gchararray" t t))
+
+(define-g-object-class "GtkClipboard" clipboard (g-object t) nil)
+
+(define-g-object-class "GtkEntryCompletion" entry-completion (g-object t)
+ ("GtkBuildable" "GtkCellLayout")
+ (model entry-completion-model "model" "GtkTreeModel" t
+ t)
+ (minimum-key-length entry-completion-minimum-key-length
+ "minimum-key-length" "gint" t t)
+ (text-column entry-completion-text-column "text-column"
+ "gint" t t)
+ (inline-completion entry-completion-inline-completion
+ "inline-completion" "gboolean" t t)
+ (popup-completion entry-completion-popup-completion
+ "popup-completion" "gboolean" t t)
+ (popup-set-width entry-completion-popup-set-width
+ "popup-set-width" "gboolean" t t)
+ (popup-single-match entry-completion-popup-single-match
+ "popup-single-match" "gboolean" t t)
+ (inline-selection entry-completion-inline-selection
+ "inline-selection" "gboolean" t t))
+
+(define-g-object-class "GtkIconFactory" icon-factory (g-object t)
+ ("GtkBuildable"))
+
+(define-g-object-class "GtkIconTheme" icon-theme (g-object t) nil)
+
+(define-g-object-class "GtkIMContext" i-m-context (g-object t) nil)
+
+(define-g-object-class "GtkListStore" list-store (g-object t)
+ ("GtkBuildable" "GtkTreeModel" "GtkTreeDragSource"
+ "GtkTreeDragDest" "GtkTreeSortable"))
+
+(define-g-object-class "GtkPageSetup" page-setup (g-object t) nil)
+
+(define-g-object-class "GtkPrintContext" print-context (g-object t) nil)
+
+(define-g-object-class "GtkPrintOperation" print-operation (g-object t)
+ ("GtkPrintOperationPreview")
+ (default-page-setup print-operation-default-page-setup
+ "default-page-setup" "GtkPageSetup" t t)
+ (print-settings print-operation-print-settings
+ "print-settings" "GtkPrintSettings" t t)
+ (job-name print-operation-job-name "job-name"
+ "gchararray" t t)
+ (n-pages print-operation-n-pages "n-pages" "gint" t t)
+ (current-page print-operation-current-page
+ "current-page" "gint" t t)
+ (use-full-page print-operation-use-full-page
+ "use-full-page" "gboolean" t t)
+ (track-print-status print-operation-track-print-status
+ "track-print-status" "gboolean" t t)
+ (unit print-operation-unit "unit" "GtkUnit" t t)
+ (show-progress print-operation-show-progress
+ "show-progress" "gboolean" t t)
+ (allow-async print-operation-allow-async "allow-async"
+ "gboolean" t t)
+ (export-filename print-operation-export-filename
+ "export-filename" "gchararray" t t)
+ (status print-operation-status "status" "GtkPrintStatus"
+ t nil)
+ (status-string print-operation-status-string
+ "status-string" "gchararray" t nil)
+ (custom-tab-label print-operation-custom-tab-label
+ "custom-tab-label" "gchararray" t t))
+
+(define-g-object-class "GtkPrintSettings" print-settings (g-object t) nil)
+
+(define-g-object-class "GtkRecentManager" recent-manager (g-object t) nil
+ (filename recent-manager-filename "filename"
+ "gchararray" t nil)
+ (limit recent-manager-limit "limit" "gint" t t)
+ (size recent-manager-size "size" "gint" t nil))
+
+(define-g-object-class "GtkSizeGroup" size-group (g-object t) ("GtkBuildable")
+ (mode size-group-mode "mode" "GtkSizeGroupMode" t t)
+ (ignore-hidden size-group-ignore-hidden "ignore-hidden"
+ "gboolean" t t))
+
+(define-g-object-class "GtkStatusIcon" status-icon (g-object t) nil
+ (pixbuf status-icon-pixbuf "pixbuf" "GdkPixbuf" t t)
+ (file status-icon-file "file" "gchararray" nil t)
+ (stock status-icon-stock "stock" "gchararray" t t)
+ (icon-name status-icon-icon-name "icon-name"
+ "gchararray" t t)
+ (gicon status-icon-gicon "gicon" "GIcon" t t)
+ (storage-type status-icon-storage-type "storage-type"
+ "GtkImageType" t nil)
+ (size status-icon-size "size" "gint" t nil)
+ (screen status-icon-screen "screen" "GdkScreen" t t)
+ (visible status-icon-visible "visible" "gboolean" t t)
+ (orientation status-icon-orientation "orientation"
+ "GtkOrientation" t nil)
+ (embedded status-icon-embedded "embedded" "gboolean" t
+ nil)
+ (blinking status-icon-blinking "blinking" "gboolean" t
+ t))
+
+(define-g-object-class "GtkTextBuffer" text-buffer (g-object t) nil
+ (tag-table text-buffer-tag-table "tag-table"
+ "GtkTextTagTable" t nil)
+ (text text-buffer-text "text" "gchararray" t t)
+ (has-selection text-buffer-has-selection "has-selection"
+ "gboolean" t nil)
+ (cursor-position text-buffer-cursor-position
+ "cursor-position" "gint" t nil)
+ (copy-target-list text-buffer-copy-target-list
+ "copy-target-list" "GtkTargetList" t nil)
+ (paste-target-list text-buffer-paste-target-list
+ "paste-target-list" "GtkTargetList" t nil))
+
+(define-g-object-class "GtkTextChildAnchor" text-child-anchor (g-object t) nil)
+
+(define-g-object-class "GtkTextMark" text-mark (g-object t) nil
+ (name text-mark-name "name" "gchararray" t nil)
+ (left-gravity text-mark-left-gravity "left-gravity"
+ "gboolean" t nil))
+
+(define-g-object-class "GtkTextTag" text-tag (g-object t) nil
+ (name text-tag-name "name" "gchararray" t nil)
+ (background text-tag-background "background"
+ "gchararray" nil t)
+ (foreground text-tag-foreground "foreground"
+ "gchararray" nil t)
+ (background-gdk text-tag-background-gdk "background-gdk"
+ "GdkColor" t t)
+ (foreground-gdk text-tag-foreground-gdk "foreground-gdk"
+ "GdkColor" t t)
+ (background-stipple text-tag-background-stipple
+ "background-stipple" "GdkPixmap" t t)
+ (foreground-stipple text-tag-foreground-stipple
+ "foreground-stipple" "GdkPixmap" t t)
+ (font text-tag-font "font" "gchararray" t t)
+ (font-desc text-tag-font-desc "font-desc"
+ "PangoFontDescription" t t)
+ (family text-tag-family "family" "gchararray" t t)
+ (style text-tag-style "style" "PangoStyle" t t)
+ (variant text-tag-variant "variant" "PangoVariant" t t)
+ (weight text-tag-weight "weight" "gint" t t)
+ (stretch text-tag-stretch "stretch" "PangoStretch" t t)
+ (size text-tag-size "size" "gint" t t)
+ (size-points text-tag-size-points "size-points"
+ "gdouble" t t)
+ (scale text-tag-scale "scale" "gdouble" t t)
+ (pixels-above-lines text-tag-pixels-above-lines
+ "pixels-above-lines" "gint" t t)
+ (pixels-below-lines text-tag-pixels-below-lines
+ "pixels-below-lines" "gint" t t)
+ (pixels-inside-wrap text-tag-pixels-inside-wrap
+ "pixels-inside-wrap" "gint" t t)
+ (editable text-tag-editable "editable" "gboolean" t t)
+ (wrap-mode text-tag-wrap-mode "wrap-mode" "GtkWrapMode"
+ t t)
+ (justification text-tag-justification "justification"
+ "GtkJustification" t t)
+ (direction text-tag-direction "direction"
+ "GtkTextDirection" t t)
+ (left-margin text-tag-left-margin "left-margin" "gint" t
+ t)
+ (indent text-tag-indent "indent" "gint" t t)
+ (strikethrough text-tag-strikethrough "strikethrough"
+ "gboolean" t t)
+ (right-margin text-tag-right-margin "right-margin"
+ "gint" t t)
+ (underline text-tag-underline "underline"
+ "PangoUnderline" t t)
+ (rise text-tag-rise "rise" "gint" t t)
+ (background-full-height text-tag-background-full-height
+ "background-full-height" "gboolean" t t)
+ (language text-tag-language "language" "gchararray" t t)
+ (tabs text-tag-tabs "tabs" "PangoTabArray" t t)
+ (invisible text-tag-invisible "invisible" "gboolean" t
+ t)
+ (paragraph-background text-tag-paragraph-background
+ "paragraph-background" "gchararray" nil t)
+ (paragraph-background-gdk
+ text-tag-paragraph-background-gdk
+ "paragraph-background-gdk" "GdkColor" t t)
+ (accumulative-margin text-tag-accumulative-margin
+ "accumulative-margin" "gboolean" t t)
+ (background-set text-tag-background-set "background-set"
+ "gboolean" t t)
+ (foreground-set text-tag-foreground-set "foreground-set"
+ "gboolean" t t)
+ (background-stipple-set text-tag-background-stipple-set
+ "background-stipple-set" "gboolean" t t)
+ (foreground-stipple-set text-tag-foreground-stipple-set
+ "foreground-stipple-set" "gboolean" t t)
+ (family-set text-tag-family-set "family-set" "gboolean"
+ t t)
+ (style-set text-tag-style-set "style-set" "gboolean" t
+ t)
+ (variant-set text-tag-variant-set "variant-set"
+ "gboolean" t t)
+ (weight-set text-tag-weight-set "weight-set" "gboolean"
+ t t)
+ (stretch-set text-tag-stretch-set "stretch-set"
+ "gboolean" t t)
+ (size-set text-tag-size-set "size-set" "gboolean" t t)
+ (scale-set text-tag-scale-set "scale-set" "gboolean" t
+ t)
+ (pixels-above-lines-set text-tag-pixels-above-lines-set
+ "pixels-above-lines-set" "gboolean" t t)
+ (pixels-below-lines-set text-tag-pixels-below-lines-set
+ "pixels-below-lines-set" "gboolean" t t)
+ (pixels-inside-wrap-set text-tag-pixels-inside-wrap-set
+ "pixels-inside-wrap-set" "gboolean" t t)
+ (editable-set text-tag-editable-set "editable-set"
+ "gboolean" t t)
+ (wrap-mode-set text-tag-wrap-mode-set "wrap-mode-set"
+ "gboolean" t t)
+ (justification-set text-tag-justification-set
+ "justification-set" "gboolean" t t)
+ (left-margin-set text-tag-left-margin-set
+ "left-margin-set" "gboolean" t t)
+ (indent-set text-tag-indent-set "indent-set" "gboolean"
+ t t)
+ (strikethrough-set text-tag-strikethrough-set
+ "strikethrough-set" "gboolean" t t)
+ (right-margin-set text-tag-right-margin-set
+ "right-margin-set" "gboolean" t t)
+ (underline-set text-tag-underline-set "underline-set"
+ "gboolean" t t)
+ (rise-set text-tag-rise-set "rise-set" "gboolean" t t)
+ (background-full-height-set
+ text-tag-background-full-height-set
+ "background-full-height-set" "gboolean" t t)
+ (language-set text-tag-language-set "language-set"
+ "gboolean" t t)
+ (tabs-set text-tag-tabs-set "tabs-set" "gboolean" t t)
+ (invisible-set text-tag-invisible-set "invisible-set"
+ "gboolean" t t)
+ (paragraph-background-set
+ text-tag-paragraph-background-set
+ "paragraph-background-set" "gboolean" t t))
+
+(define-g-object-class "GtkTextTagTable" text-tag-table (g-object t) nil)
+
+(define-g-object-class "GtkTreeModelFilter" tree-model-filter (g-object t)
+ ("GtkTreeModel" "GtkTreeDragSource")
+ (child-model tree-model-filter-child-model "child-model"
+ "GtkTreeModel" t nil)
+ (virtual-root tree-model-filter-virtual-root
+ "virtual-root" "GtkTreePath" t nil))
+
+(define-g-object-class "GtkTreeModelSort" tree-model-sort (g-object t)
+ ("GtkTreeModel" "GtkTreeDragSource" "GtkTreeSortable")
+ (model tree-model-sort-model "model" "GtkTreeModel" t
+ nil))
+
+(define-g-object-class "GtkTreeSelection" tree-selection (g-object t) nil)
+
+(define-g-object-class "GtkTreeStore" tree-store (g-object t)
+ ("GtkBuildable" "GtkTreeModel" "GtkTreeDragSource"
+ "GtkTreeDragDest" "GtkTreeSortable"))
+
+(define-g-object-class "GtkUIManager" u-i-manager (g-object t) ("GtkBuildable")
+ (add-tearoffs u-i-manager-add-tearoffs "add-tearoffs"
+ "gboolean" t t)
+ (ui u-i-manager-ui "ui" "gchararray" t nil))
+
+(define-g-object-class "GtkWindowGroup" window-group (g-object t) nil)
+
--- /dev/null
+(in-package :gtk)
+
+(defcfun gtk-image-get-animation (g-object pixbuf-animation)
+ (image (g-object image)))
+
+(defcfun gtk-image-set-from-animation :void
+ (image (g-object image))
+ (animation (g-object pixbuf-animation)))
+
+(defun image-animation (image)
+ (gtk-image-get-animation image))
+
+(defun (setf image-animation) (animation image)
+ (gtk-image-set-from-animation image animation))
+
+(export 'image-animation)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun gtk-label-get-layout-offsets :void
+ (label (g-object label))
+ (x (:pointer :int))
+ (y (:pointer :int)))
+
+(defun label-layout-offsets (label)
+ (with-foreign-objects ((x :int) (y :int))
+ (gtk-label-get-layout-offsets label x y)
+ (values (mem-ref x :int) (mem-ref y :int))))
+
+(export 'label-layout-offsets)
+
+(defcfun (label-select-region "gtk_label_select_region") :void
+ (label (g-object label))
+ (start-offset :int)
+ (end-offset :int))
+
+(export 'label-select-region)
+
+(defcfun (label-layout "gtk_label_get_layout") g-object ;(g-object pango-layout)
+ (label (g-object label)))
+
+(export 'label-layout)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun gtk-init-check :boolean
+ (argc (:pointer :int))
+ (argv (:pointer (:pointer :string))))
+
+(defun gtk-init ()
+ (gtk-init-check (foreign-alloc :int :initial-element 0)
+ (foreign-alloc :string :initial-contents '("/usr/bin/sbcl")))
+ #+nil(with-foreign-objects ((argc :int)
+ (argv '(:pointer :string) 1))
+ (setf (mem-ref argc :int) 0
+ (mem-ref argv '(:pointer :string)) (foreign-alloc :string :count 1
+ :initial-element "/usr/bin/sbcl"))
+ (unwind-protect
+ (unless (gtk-init-check argc argv)
+ (error "Cannot initialize Gtk+"))
+ (foreign-free (mem-ref argv '(:pointer :string))))))
+
+(gtk-init)
+
+(defcfun gtk-test-register-all-types :void)
+
+(gtk-test-register-all-types)
+
+(defcfun gtk-events-pending :boolean)
+
+(defcfun gtk-main :void)
+
+(defcfun gtk-main-level :uint)
+
+(defcfun gtk-main-quit :void)
+
+(defcfun gtk-main-iteration :boolean)
+
+(defcfun gtk-main-iteration-do :boolean
+ (blocking :boolean))
+
+(defcfun gtk-grab-add :void
+ (widget g-object))
+
+(defcfun gtk-grab-get-current g-object)
+
+(defcfun gtk-grab-remove :void
+ (widget g-object))
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(define-g-boxed-class "GtkBorder" border ()
+ (left :int :initform 0)
+ (right :int :initform 0)
+ (top :int :initform 0)
+ (bottom :int :initform 0))
\ No newline at end of file
--- /dev/null
+(defpackage :gtk
+ (:use :cl :cffi :gobject :gdk :glib :metabang-bind :anaphora)
+ (:export #:register-object-type
+ #:gtk-main
+ #:gtk-main-quit
+ #:gtk-widget-queue-draw
+ #:gtk-widget-show-all
+ #:gtk-widget-create-pango-layout
+ #:box-pack-start
+ #:container-add
+ #:dialog-run
+ #:object-destroy
+ #:text-buffer-insert
+ #:table-attach))
+
+(defpackage :gtk-examples
+ (:use :cl :gtk :gdk :gobject)
+ (:export #:test-dialog))
+
+(in-package :gtk)
+
+(load-foreign-library "libgtk-x11-2.0.so")
+
+#+sbcl (when (and (find-package "SB-EXT")
+ (find-symbol "SET-FLOATING-POINT-MODES" (find-package "SB-EXT")))
+ (funcall (find-symbol "SET-FLOATING-POINT-MODES" (find-package "SB-EXT")) :traps nil))
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun (progress-bar-pulse "gtk_progress_bar_pulse") :void
+ (progress-bar (g-object progress-bar)))
+
+(export 'progress-bar-pulse)
--- /dev/null
+(in-package :gtk)
+
+(defcfun (scale-button-popup "gtk_scale_button_get_popup") (g-object widget)
+ (scale-button (g-object scale-button)))
+
+(defcfun (scale-button-plus-button "gtk_scale_button_get_plus_button") (g-object widget)
+ (scale-button (g-object scale-button)))
+
+(defcfun (scale-button-minus-button "gtk_scale_button_get_minus_button") (g-object widget)
+ (scale-button (g-object scale-button)))
+
+(export 'scale-button-popup)
+(export 'scale-button-plus-button)
+(export 'scale-button-minus-button)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(define-g-enum "GtkSpinType" spin-type (t)
+ (:step-forward 0)
+ (:step-backward 1) (:page-forward 2) (:page-backward 3)
+ (:home 4) (:end 5) (:user-defined 6))
+
+(defcfun (spin-button-spin "gtk_spin_button_spin") :void
+ (spin-button (g-object spin-button))
+ (direction spin-type)
+ (increment :double))
+
+(export 'spin-button-spin)
+
+(defcfun (spin-button-update "gtk_spin_button_update") :void
+ (spin-button (g-object spin-button)))
+
+(export 'spin-button-update)
--- /dev/null
+(in-package :gtk)
+
+(defcfun gtk-statusbar-get-context-id :uint
+ (status-bar (g-object statusbar))
+ (context-description :string))
+
+(defcfun gtk-statusbar-push :uint
+ (status-bar (g-object statusbar))
+ (context-id :uint)
+ (text :string))
+
+(defcfun gtk-statusbar-pop :void
+ (status-bar (g-object statusbar))
+ (context-id :uint))
+
+(defcfun gtk-statusbar-remove :void
+ (status-bar (g-object statusbar))
+ (context-id :uint)
+ (message-id :uint))
+
+(defun status-bar-push (status-bar context text)
+ (gtk-statusbar-push status-bar (gtk-statusbar-get-context-id status-bar context) text))
+
+(defun status-bar-pop (status-bar context)
+ (gtk-statusbar-pop status-bar (gtk-statusbar-get-context-id status-bar context)))
+
+(defun status-bar-remove (status-bar context message-id)
+ (gtk-statusbar-remove status-bar (gtk-statusbar-get-context-id status-bar context) message-id))
+
+(export 'status-bar-push)
+(export 'status-bar-pop)
+(export 'status-bar-remove)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun (set-status-icon-tooltip "gtk_status_icon_set_tooltip") :void
+ (status-icon (g-object status-icon))
+ (tooltip-text :string))
+
+(export 'set-status-icon-tooltip)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+void gtk_entry_append_text (GtkEntry *entry,
+ const gchar *text);
+void gtk_entry_prepend_text (GtkEntry *entry,
+ const gchar *text);
+void gtk_entry_set_position (GtkEntry *entry,
+ gint position);
+void gtk_entry_select_region (GtkEntry *entry,
+ gint start,
+ gint end);
+gint gtk_entry_layout_index_to_text_index
+ (GtkEntry *entry,
+ gint layout_index);
+gint gtk_entry_text_index_to_layout_index
+ (GtkEntry *entry,
+ gint text_index);
+void gtk_entry_set_completion (GtkEntry *entry,
+ GtkEntryCompletion *completion);
+GtkEntryCompletion* gtk_entry_get_completion (GtkEntry *entry);
+void gtk_entry_set_cursor_hadjustment (GtkEntry *entry,
+ GtkAdjustment *adjustment);
+GtkAdjustment* gtk_entry_get_cursor_hadjustment (GtkEntry *entry);
--- /dev/null
+(in-package :gtk)
+
+;; text iter
+
+
+(define-foreign-type unichar ()
+ ()
+ (:actual-type :uint32)
+ (:simple-parser unichar))
+
+(defmethod translate-from-foreign (value (type unichar))
+ (code-char value))
+
+(defmethod translate-to-foreign (value (type unichar))
+ (char-code value))
+
+(define-g-boxed-ref "GtkTextIter" text-iter
+ (:free-function gtk-text-iter-free)
+ (:alloc-function gtk-text-iter-alloc)
+ (:slots (text-iter-buffer :reader "gtk_text_iter_get_buffer" :type (g-object text-buffer))
+ (text-iter-offset :reader "gtk_text_iter_get_offset" :writer "gtk_text_iter_set_offset" :type :int)
+ (text-iter-line :reader "gtk_text_iter_get_line" :writer "gtk_text_iter_set_line" :type :int)
+ (text-iter-line-offset :reader "gtk_text_iter_get_line_offset" :writer "gtk_text_iter_set_line_offset" :type :int)
+ (text-iter-visible-line-offset :reader "gtk_text_iter_get_visible_line_offset" :writer "gtk_text_iter_set_visible_line_offset" :type :int)
+ (text-iter-char :reader "gtk_text_iter_get_char" :type unichar)
+ (text-iter-pixbuf :reader "gtk_text_iter_get_pixbuf" :type (g-object pixbuf))
+ (text-iter-marks :reader "gtk_text_iter_get_marks" :type (gslist (g-object text-mark) :free-from-foreign t))
+ (text-iter-child-anchor :reader "gtk_text_iter_get_child_anchor" :type (g-object text-child-anchor))
+ (text-iter-tags :reader "gtk_text_iter_get_tags" :type (gslist (g-object text-mark) :free-from-foreign t))
+ (text-iter-chars-in-line :reader "gtk_text_iter_get_chars_in_line" :type :int)
+ (text-iter-language :reader "gtk_text_iter_get_language" :type :pointer)
+ (text-iter-is-end :reader "gtk_text_iter_is_end" :type :boolean)
+ (text-iter-is-start :reader "gtk_text_iter_is_start" :type :boolean)
+ (text-iter-can-insert :reader "gtk_text_iter_can_insert" :type :boolean)
+ (text-iter-starts-word :reader "gtk_text_iter_starts_word" :type :boolean)
+ (text-iter-ends-word :reader "gtk_text_iter_ends_word" :type :boolean)
+ (text-iter-inside-word :reader "gtk_text_iter_inside_word" :type :boolean)
+ (text-iter-starts-line :reader "gtk_text_iter_starts_line" :type :boolean)
+ (text-iter-ends-line :reader "gtk_text_iter_ends_line" :type :boolean)
+ (text-iter-starts-sentence :reader "gtk_text_iter_starts_sentence" :type :boolean)
+ (text-iter-ends-sentence :reader "gtk_text_iter_ends_sentence" :type :boolean)
+ (text-iter-inside-sentence :reader "gtk_text_iter_inside_sentence" :type :boolean)
+ (text-iter-is-cursor-position :reader "gtk_text_iter_is_cursor_position" :type :boolean)
+ ))
+(export '(text-iter text-iter-offset text-iter-line text-iter-line-offset text-iter-visible-line-offset text-iter-char text-iter-pixbuf text-iter-marks text-iter-toggled-tags text-iter-child-anchor text-iter-tags text-iter-chars-in-line text-iter-language))
+
+(defcstruct %text-iter
+ (dummy1 :pointer)
+ (dummy2 :pointer)
+ (dummy3 :int)
+ (dummy4 :int)
+ (dummy5 :int)
+ (dummy6 :int)
+ (dummy7 :int)
+ (dummy8 :int)
+ (dummy9 :pointer)
+ (dummy10 :pointer)
+ (dummy11 :int)
+ (dummy12 :int)
+ (dummy13 :int)
+ (dummy14 :pointer))
+
+(defcfun gtk-text-iter-copy :pointer
+ (iter :pointer))
+
+(defcfun gtk-text-iter-free :void
+ (iter :pointer))
+
+(defun gtk-text-iter-alloc ()
+ (with-foreign-object (iter '%text-iter)
+ (gtk-text-iter-copy iter)))
+
+(defcfun (text-iter-slice "gtk_text_iter_get_slice") (:string :free-from-foreign t)
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(export 'text-iter-slice)
+
+(defcfun (text-iter-text "gtk_text_iter_get_text") (:string :free-from-foreign t)
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(export 'text-iter-text)
+
+(defcfun (text-iter-visible-slice "gtk_text_iter_get_visible_slice") (:string :free-from-foreign t)
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(export 'text-iter-visible-slice)
+
+(defcfun (text-iter-visible-text "gtk_text_iter_get_visible_text") (:string :free-from-foreign t)
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(export 'text-iter-visible-text)
+
+(defcfun (text-iter-toggled-tags "gtk_text_iter_get_toggled_tags") (gslist (g-object text-tag))
+ (iter (g-boxed-ref text-iter))
+ (toggled-on :boolean))
+
+(export 'text-iter-toggled-tags)
+
+(defcfun (text-iter-begins-tag "gtk_text_iter_begins_tag") :boolean
+ (iter (g-boxed-ref text-iter))
+ (tag (g-object text-tag)))
+
+(export 'text-iter-begins-tag)
+
+(defcfun (text-iter-ends-tag "gtk_text_iter_ends_tag") :boolean
+ (iter (g-boxed-ref text-iter))
+ (tag (g-object text-tag)))
+
+(export 'text-iter-ends-tag)
+
+(defcfun (text-iter-toggles-tag "gtk_text_iter_toggles_tag") :boolean
+ (iter (g-boxed-ref text-iter))
+ (tag (g-object text-tag)))
+
+(export 'text-iter-toggles-tag)
+
+(defcfun (text-iter-has-tag "gtk_text_iter_has_tag") :boolean
+ (iter (g-boxed-ref text-iter))
+ (tag (g-object text-tag)))
+
+(export 'text-iter-has-tag)
+
+(defcfun (text-iter-editable "gtk_text_iter_editable") :boolean
+ (iter (g-boxed-ref text-iter))
+ (default :boolean))
+
+(export 'text-iter-editable)
+
+(defcfun gtk-text-iter-get-attributes :boolean
+ (iter (g-boxed-ref text-iter))
+ (values (g-object text-attributes)))
+
+(defun text-iter-attributes (iter default-attributes)
+ (let ((changed-p (gtk-text-iter-get-attributes iter default-attributes)))
+ (values default-attributes changed-p)))
+
+(export 'text-iter-attributes)
+
+(defcfun gtk-text-iter-forward-chars :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-forward-lines :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-forward-word-ends :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-backward-word-starts :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-forward-cursor-positions :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-forward-sentence-ends :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-backward-sentence-starts :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-forward-visible-word-ends :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-backward-visible-word-starts :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-forward-visible-cursor-positions :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defcfun gtk-text-iter-forward-visible-lines :boolean
+ (iter (g-boxed-ref text-iter))
+ (count :int))
+
+(defun text-iter-move (iter &key (count 1) (by :char) (direction :forward))
+ (assert (typep by '(member :char :line :word :cursor-position :sentence :visible-word :visible-line :visible-cursor-position)))
+ (assert (typep direction '(member :forward :backward)))
+ (when (and (member by '(:char :ine :cursor-position :visible-line :visible-cursor-position)) (eq direction :backward))
+ (setf count (- count)))
+ (ecase by
+ (:char (gtk-text-iter-forward-chars iter count))
+ (:line (gtk-text-iter-forward-lines iter count))
+ (:word (if (eq direction :forward)
+ (gtk-text-iter-forward-word-ends iter count)
+ (gtk-text-iter-backward-word-starts iter count)))
+ (:cursor-position (gtk-text-iter-forward-cursor-positions iter count))
+ (:sentence (if (eq direction :forward)
+ (gtk-text-iter-forward-sentence-ends iter count)
+ (gtk-text-iter-backward-sentence-starts iter count)))
+ (:visible-word (if (eq direction :forward)
+ (gtk-text-iter-forward-visible-word-ends iter count)
+ (gtk-text-iter-backward-visible-word-starts iter count)))
+ (:visible-line (gtk-text-iter-forward-visible-lines iter count))
+ (:visible-cursor-position (gtk-text-iter-forward-visible-cursor-positions iter count))))
+
+(export 'text-iter-move)
+
+(defcfun (text-iter-forward-to-end "gtk_text_iter_forward_to_end") :void
+ (iter (g-boxed-ref text-iter)))
+
+(export 'text-iter-forward-to-end)
+
+(defcfun (text-iter-forward-to-line-end "gtk_text_iter_forward_to_line_end") :boolean
+ (iter (g-boxed-ref text-iter)))
+
+(export 'text-iter-forward-to-line-end)
+
+(defcfun (text-iter-forward-to-tag-toggle "gtk_text_iter_forward_to_tag_toggle") :boolean
+ (iter (g-boxed-ref text-iter))
+ (tag (g-object text-tag)))
+
+(defcfun (text-iter-backward-to-tag-toggle "gtk_text_iter_backward_to_tag_toggle") :boolean
+ (iter (g-boxed-ref text-iter))
+ (tag (g-object text-tag)))
+
+(export '(text-iter-forward-to-tag-toggle text-iter-backward-to-tag-toggle))
+
+(defcallback gtk-text-char-predicate :boolean ((char unichar) (user-data :pointer))
+ (let ((function (get-stable-pointer-value user-data)))
+ (funcall function char)))
+
+(defcfun gtk-text-iter-forward-find-char :boolean
+ (iter (g-boxed-ref text-iter))
+ (pred :pointer)
+ (user-data :pointer)
+ (limit (g-boxed-ref text-iter)))
+
+(defcfun gtk-text-iter-backward-find-char :boolean
+ (iter (g-boxed-ref text-iter))
+ (pred :pointer)
+ (user-data :pointer)
+ (limit (g-boxed-ref text-iter)))
+
+(defun text-iter-find-char (iter predicate &key limit (direction :forward))
+ (assert (typep direction '(member :forward :backward)))
+ (with-stable-pointer (ptr predicate)
+ (if (eq direction :forward)
+ (gtk-text-iter-forward-find-char iter (callback gtk-text-char-predicate) ptr limit)
+ (gtk-text-iter-backward-find-char iter (callback gtk-text-char-predicate) ptr limit))))
+
+(export 'text-iter-find-char)
+
+(defcfun gtk-text-iter-forward-search :boolean
+ (iter (g-boxed-ref text-iter))
+ (str (:string :free-to-foreign t))
+ (flags text-search-flags)
+ (match-start (g-boxed-ref text-iter))
+ (match-end (g-boxed-ref text-iter))
+ (limit (g-boxed-ref text-iter)))
+
+(defcfun gtk-text-iter-backward-search :boolean
+ (iter (g-boxed-ref text-iter))
+ (str (:string :free-to-foreign t))
+ (flags text-search-flags)
+ (match-start (g-boxed-ref text-iter))
+ (match-end (g-boxed-ref text-iter))
+ (limit (g-boxed-ref text-iter)))
+
+(defun text-iter-search (start-position string &key flags limit (direction :forward))
+ (assert (typep direction '(member :forward :backward)))
+ (let ((i1 (make-instance 'text-iter))
+ (i2 (make-instance 'text-iter)))
+ (if (if (eq direction :forward)
+ (gtk-text-iter-forward-search start-position string flags i1 i2 limit)
+ (gtk-text-iter-backward-search start-position string flags i1 i2 limit))
+ (values t i1 i2)
+ (progn (release i1)
+ (release i2)
+ (values nil nil nil)))))
+
+(export 'text-iter-search)
+
+(defcfun (text-iter-equal "gtk_text_iter_equal") :boolean
+ (iter-1 (g-boxed-ref text-iter))
+ (iter-2 (g-boxed-ref text-iter)))
+
+(export 'text-iter-equal)
+
+(defcfun (text-iter-compare "gtk_text_iter_compare") :int
+ (iter-1 (g-boxed-ref text-iter))
+ (iter-2 (g-boxed-ref text-iter)))
+
+(export 'text-iter-compare)
+
+(defcfun (text-iter-in-range "gtk_text_iter_in_range") :boolean
+ (iter (g-boxed-ref text-iter))
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(export 'text-iter-in-range)
+
+(defcfun (text-iter-order "gtk_text_iter_order") :void
+ (iter-1 (g-boxed-ref text-iter))
+ (iter-2 (g-boxed-ref text-iter)))
+
+(export 'text-iter-order)
+
+;; text mark
+
+(defcfun (text-mark-visible "gtk_text_mark_get_visible") :boolean
+ (mark (g-object text-mark)))
+
+(defcfun gtk-text-mark-set-visible :void
+ (mark (g-object text-mark))
+ (visible :boolean))
+
+(defun (setf text-mark-visible) (new-value mark)
+ (gtk-text-mark-set-visible mark new-value))
+
+(export 'text-mark-visible)
+
+(defcfun (text-mark-deleted "gtk_text_mark_get_deleted") :boolean
+ (mark (g-object text-mark)))
+
+(export 'text-mark-deleted)
+
+(defcfun (text-mark-buffer "gtk_text_mark_get_buffer") (g-object text-buffer)
+ (mark (g-object text-mark)))
+
+(export 'text-mark-buffer)
+
+;; text buffer
+
+(defcfun (text-buffer-line-count "gtk_text_buffer_get_line_count") :int
+ (buffer (g-object text-buffer)))
+
+(export 'text-buffer-line-count)
+
+(defcfun (text-buffer-char-count "gtk_text_buffer_get_char_count") :int
+ (buffer (g-object text-buffer)))
+
+(export 'text-buffer)
+
+(defcfun (text-buffer-tag-table "gtk_text_buffer_get_tag_table") (g-object text-tag-table)
+ (buffer (g-object text-buffer)))
+
+(export 'text-buffer-tag-table)
+
+(defcfun gtk-text-buffer-insert :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (text (:string :free-to-foreign t))
+ (len :int))
+
+(defcfun gtk-text-buffer-insert-at-cursor :void
+ (buffer (g-object text-buffer))
+ (text (:string :free-to-foreign t))
+ (len :int))
+
+(defcfun gtk-text-buffer-insert-interactive :boolean
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (text (:string :free-to-foreign t))
+ (len :int)
+ (default-editable :boolean))
+
+(defcfun gtk-text-buffer-insert-interactive-at-cursor :boolean
+ (buffer (g-object text-buffer))
+ (text (:string :free-to-foreign t))
+ (len :int)
+ (default-editable :boolean))
+
+(defun text-buffer-insert (buffer text &key (position :cursor) (interactive nil) (default-editable t))
+ (assert (typep position '(or text-iter (member :cursor))))
+ (if interactive
+ (if (eq position :cursor)
+ (gtk-text-buffer-insert-interactive-at-cursor buffer text (length text) default-editable)
+ (gtk-text-buffer-insert-interactive buffer position text (length text) default-editable))
+ (progn (if (eq position :cursor)
+ (gtk-text-buffer-insert-at-cursor buffer text (length text))
+ (gtk-text-buffer-insert buffer position text (length text)))
+ t)))
+
+(export 'text-buffer-insert)
+
+(defcfun gtk-text-buffer-insert-range :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (range-start (g-boxed-ref text-iter))
+ (range-end (g-boxed-ref text-iter)))
+
+(defcfun gtk-text-buffer-insert-range-interactive :boolean
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (range-start (g-boxed-ref text-iter))
+ (range-end (g-boxed-ref text-iter))
+ (default-editable :boolean))
+
+(defun text-buffer-insert-range (buffer position range-start range-end &key interactive default-editable)
+ (if interactive
+ (gtk-text-buffer-insert-range-interactive buffer position range-start range-end default-editable)
+ (progn (gtk-text-buffer-insert-range buffer position range-start range-end)
+ t)))
+
+(export 'text-buffer-insert-range)
+
+(defcfun gtk-text-buffer-delete :void
+ (buffer (g-object text-buffer))
+ (range-start (g-boxed-ref text-iter))
+ (range-end (g-boxed-ref text-iter)))
+
+(defcfun gtk-text-buffer-delete-interactive :boolean
+ (buffer (g-object text-buffer))
+ (range-start (g-boxed-ref text-iter))
+ (range-end (g-boxed-ref text-iter))
+ (default-editable :boolean))
+
+(defun text-buffer-delete (buffer range-start range-end &key interactive default-editable)
+ (if interactive
+ (gtk-text-buffer-delete-interactive buffer range-start range-end default-editable)
+ (progn (gtk-text-buffer-delete buffer range-start range-end)
+ t)))
+
+(export 'text-buffer-delete)
+
+(defcfun gtk-text-buffer-backspace :boolean
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (interactive :boolean)
+ (default-editable :boolean))
+
+(defun text-buffer-backspace (buffer position &key interactive default-editable)
+ (gtk-text-buffer-backspace buffer position interactive default-editable))
+
+(export 'text-buffer-backspace)
+
+(defcfun gtk-text-buffer-get-slice (:string :free-from-foreign t)
+ (buffer (g-object text-buffer))
+ (range-start (g-boxed-ref text-iter))
+ (range-end (g-boxed-ref text-iter))
+ (include-hidden-chars :boolean))
+
+(defun text-buffer-slice (buffer range-start range-end &key include-hidden-chars)
+ (gtk-text-buffer-get-slice buffer range-start range-end include-hidden-chars))
+
+(export 'text-buffer-slice)
+
+(defcfun (text-buffer-insert-pixbuf "gtk_text_buffer_insert_pixbuf") :void
+ (buffer (g-object text-buffer))
+ (position (g-boxed-ref text-iter))
+ (pixbuf (g-object pixbuf)))
+
+(export 'text-buffer-insert-pixbuf)
+
+(defcfun gtk-text-buffer-insert-child-anchor :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (anchor (g-object text-child-anchor)))
+
+(defcfun gtk-text-buffer-create-child-anchor (g-object text-child-anchor)
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter)))
+
+(defun text-buffer-insert-child-anchor (buffer position &optional anchor)
+ (if anchor
+ (progn (gtk-text-buffer-insert-child-anchor buffer position anchor)
+ anchor)
+ (gtk-text-buffer-create-child-anchor buffer position)))
+
+(export 'text-buffer-insert-child-anchor)
+
+(defcfun gtk-text-buffer-create-mark (g-object text-mark)
+ (buffer (g-object text-buffer))
+ (name (:string :free-to-foreign t))
+ (position (g-boxed-ref text-iter))
+ (left-gravity :boolean))
+
+(defun text-buffer-create-mark (buffer name position &optional (left-gravity t))
+ (gtk-text-buffer-create-mark buffer name position left-gravity))
+
+(export 'text-buffer-create-mark)
+
+(defcfun gtk-text-buffer-move-mark :void
+ (buffer (g-object text-buffer))
+ (mark (g-object text-mark))
+ (position (g-boxed-ref text-iter)))
+
+(defcfun gtk-text-buffer-move-mark-by-name :void
+ (buffer (g-object text-buffer))
+ (name (:string :free-to-foreign t))
+ (position (g-boxed-ref text-iter)))
+
+(defun text-buffer-move-mark (buffer mark position)
+ (etypecase mark
+ (string (gtk-text-buffer-move-mark-by-name buffer mark position))
+ (text-mark (gtk-text-buffer-move-mark buffer mark position))))
+
+(export 'text-buffer-move-mark)
+
+(defcfun (text-buffer-add-mark "gtk_text_buffer_add_mark") :void
+ (buffer (g-object text-buffer))
+ (mark (g-object text-mark))
+ (position (g-boxed-ref text-iter)))
+
+(export 'text-buffer-add-mark)
+
+(defcfun gtk-text-buffer-delete-mark :void
+ (buffer (g-object text-buffer))
+ (mark (g-object text-mark)))
+
+(defcfun gtk-text-buffer-delete-mark-by-name :void
+ (buffer (g-object text-buffer))
+ (name (:string :free-to-foreign t)))
+
+(defun text-buffer-delete-mark (buffer mark)
+ (etypecase mark
+ (string (gtk-text-buffer-delete-mark-by-name buffer mark))
+ (text-mark (gtk-text-buffer-delete-mark buffer mark))))
+
+(export 'text-buffer-delete-mark)
+
+(defcfun (text-buffer-get-mark "gtk_text_buffer_get_mark") (g-object text-mark)
+ (buffer (g-object text-buffer))
+ (name (:string :free-to-foreign t)))
+
+(export 'text-buffer-get-mark)
+
+(defcfun (text-buffer-insertion-mark "gtk_text_buffer_get_insert") (g-object text-mark)
+ (buffer (g-object text-buffer)))
+
+(export 'text-buffer-insertion-mark)
+
+(defcfun (text-buffer-selection-bound "gtk_text_buffer_get_selection_bound") (g-object text-mark)
+ (buffer (g-object text-buffer))
+ (name (:string :free-to-foreign t)))
+
+(export 'text-buffer-selection-bound)
+
+(defcfun (text-buffer-place-cursor "gtk_text_buffer_place_cursor") :void
+ (buffer (g-object text-buffer))
+ (position (g-boxed-ref text-iter)))
+
+(export 'text-buffer-place-cursor)
+
+(defcfun (text-buffer-select-range "gtk_text_buffer_select_range") :void
+ (buffer (g-object text-buffer))
+ (insertion-point (g-boxed-ref text-iter))
+ (selection-bound (g-boxed-ref text-iter)))
+
+(export 'text-buffer-select-range)
+
+(defcfun gtk-text-buffer-apply-tag :void
+ (buffer (g-object text-buffer))
+ (tag (g-object text-tag))
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(defcfun gtk-text-buffer-apply-tag-by-name :void
+ (buffer (g-object text-buffer))
+ (name (:string :free-to-foreign t))
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(defun text-buffer-apply-tag (buffer tag start end)
+ (etypecase tag
+ (string (gtk-text-buffer-apply-tag-by-name buffer tag start end))
+ (text-tag (gtk-text-buffer-apply-tag buffer tag start end))))
+
+(export 'text-buffer-apply-tag)
+
+(defcfun gtk-text-buffer-remove-tag :void
+ (buffer (g-object text-buffer))
+ (tag (g-object text-tag))
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(defcfun gtk-text-buffer-remove-tag-by-name :void
+ (buffer (g-object text-buffer))
+ (name (:string :free-to-foreign t))
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(defun text-buffer-remove-tag (buffer tag start end)
+ (etypecase tag
+ (string (gtk-text-buffer-remove-tag-by-name buffer tag start end))
+ (text-tag (gtk-text-buffer-remove-tag buffer tag start end))))
+
+(export 'text-buffer-remove-tag)
+
+(defcfun (text-buffer-remove-all-tags "gtk_text_buffer_remove_all_tags") :void
+ (buffer (g-object text-buffer))
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(defcfun gtk-text-buffer-get-iter-at-line-offset :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (line-number :int)
+ (char-offset :int))
+
+(defun text-buffer-get-iter-at-line-offset (buffer line-number char-offset)
+ (aprog1 (make-instance 'text-iter)
+ (gtk-text-buffer-get-iter-at-line-offset buffer it line-number char-offset)))
+
+(export 'text-buffer-get-iter-at-line-offset)
+
+(defcfun gtk-text-buffer-get-iter-at-offset :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (char-offset :int))
+
+(defun text-buffer-get-iter-at-offset (buffer offset)
+ (aprog1 (make-instance 'text-iter)
+ (gtk-text-buffer-get-iter-at-offset buffer it offset)))
+
+(export 'text-buffer-get-iter-at-offset)
+
+(defcfun gtk-text-buffer-get-iter-at-line :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (line-number :int))
+
+(defun text-buffer-get-iter-at-line (buffer line-number)
+ (aprog1 (make-instance 'text-iter)
+ (gtk-text-buffer-get-iter-at-line buffer it line-number)))
+
+(export 'text-buffet-get-iter-at-line)
+
+(defcfun gtk-text-buffer-get-iter-at-mark :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (mark (g-object text-mark)))
+
+(defun text-buffer-get-iter-at-mark (buffer mark)
+ (when (stringp mark)
+ (setf mark (text-buffer-get-mark buffer mark)))
+ (aprog1 (make-instance 'text-iter)
+ (gtk-text-buffer-get-iter-at-mark buffer it mark)))
+
+(export 'text-buffer-get-iter-at-mark)
+
+(defcfun gtk-text-buffer-get-iter-at-child-anchor :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter))
+ (anchor (g-object text-child-anchor)))
+
+(defun text-buffer-get-iter-at-child-anchor (buffer anchor)
+ (aprog1 (make-instance 'text-iter)
+ (gtk-text-buffer-get-iter-at-child-anchor buffer it anchor)))
+
+(export 'text-buffer-get-iter-at-child-anchor)
+
+(defcfun gtk-text-buffer-get-start-iter :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter)))
+
+(defun text-buffer-get-start-iter (buffer)
+ (aprog1 (make-instance 'text-iter)
+ (gtk-text-buffer-get-start-iter buffer it)))
+
+(export 'text-buffer-get-start-iter)
+
+(defcfun gtk-text-buffer-get-end-iter :void
+ (buffer (g-object text-buffer))
+ (iter (g-boxed-ref text-iter)))
+
+(defun text-buffer-get-end-iter (buffer)
+ (aprog1 (make-instance 'text-iter)
+ (gtk-text-buffer-get-end-iter buffer it)))
+
+(export 'text-buffer-get-end-iter)
+
+(defcfun gtk-text-buffer-get-bounds :void
+ (buffer (g-object text-buffer))
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(defun text-buffer-get-bounds (buffer)
+ (let ((start (make-instance 'text-iter))
+ (end (make-instance 'text-iter)))
+ (gtk-text-buffer-get-bounds buffer start end)))
+
+(export 'text-buffer-get-bounds)
+
+(defcfun gtk-text-buffer-delete-selection :boolean
+ (bufer (g-object text-buffer))
+ (interactive :boolean)
+ (default-editable :boolean))
+
+(defun text-buffer-delete-selection (buffer &key interactive default-editable)
+ (gtk-text-buffer-delete-selection buffer interactive default-editable))
+
+(export 'text-buffer-delete-selection)
+
+(defcfun gtk-text-buffer-paste-clipboard :void
+ (buffer (g-object text-buffer))
+ (clipboard (g-object clipboard))
+ (override-location (g-boxed-ref text-iter))
+ (default-editable :boolean))
+
+(defun text-buffer-paste-clipboard (buffer clipboard &key position default-editable)
+ (gtk-text-buffer-paste-clipboard buffer clipboard position default-editable))
+
+(export 'text-buffer-paste-clipboard)
+
+(defcfun (text-buffer-copy-clipboard "gtk_text_buffer_copy_clipboard") :void
+ (buffer (g-object text-buffer))
+ (clipboard (g-object clipboard)))
+
+(export 'text-buffer-copy-clipboard)
+
+(defcfun (text-buffer-cut-clipboard "gtk_text_buffer_cut_clipboard") :void
+ (buffer (g-object text-buffer))
+ (clipboard (g-object clipboard)))
+
+(export 'text-buffer-cut-clipboard)
+
+(defcfun gtk-text-buffer-get-selection-bounds :boolean
+ (buffer (g-object text-buffer))
+ (start (g-boxed-ref text-iter))
+ (end (g-boxed-ref text-iter)))
+
+(defun text-buffer-get-selection-bounds (buffer)
+ (let ((i1 (make-instance 'text-iter))
+ (i2 (make-instance 'text-iter)))
+ (if (gtk-text-buffer-get-selection-bounds buffer i1 i2)
+ (values i1 i2)
+ (progn (release i1)
+ (release i2)
+ (values nil nil)))))
+
+(export 'text-buffer-get-selection-bounds)
+
+(defcfun (text-buffer-begin-user-action "gtk_text_buffer_begin_user_action") :void
+ (buffer (g-object text-buffer)))
+
+(export 'text-buffer-begin-user-action)
+
+(defcfun (text-buffer-end-user-action "gtk_text_buffer_end_user_action") :void
+ (buffer (g-object text-buffer)))
+
+(export 'text-buffer-end-user-action)
+
+(defmacro with-text-buffer-user-action ((buffer) &body body)
+ (let ((g (gensym)))
+ `(let ((,g ,buffer))
+ (text-buffer-begin-user-action ,g)
+ (unwind-protect
+ (progn ,@body)
+ (text-buffer-end-user-action ,g)))))
+
+(export 'with-text-buffer-user-action)
+
+(defcfun (text-buffer-add-selection-clipboard "gtk_text_buffer_add_selection_clipboard") :void
+ (buffer (g-object text-buffer))
+ (clipboard (g-object clipboard)))
+
+(defcfun (text-buffer-remove-selection-clipboard "gtk_text_buffer_remove_selection_clipboard") :void
+ (buffer (g-object text-buffer))
+ (clipboard (g-object clipboard)))
+
+(export 'text-buffer-remove-selection-clipboard)
+
+;; enum GtkTextBufferTargetInfo;
+;; gboolean (*GtkTextBufferDeserializeFunc) (GtkTextBuffer *register_buffer,
+;; GtkTextBuffer *content_buffer,
+;; GtkTextIter *iter,
+;; const guint8 *data,
+;; gsize length,
+;; gboolean create_tags,
+;; gpointer user_data,
+;; GError **error);
+;; gboolean gtk_text_buffer_deserialize (GtkTextBuffer *register_buffer,
+;; GtkTextBuffer *content_buffer,
+;; GdkAtom format,
+;; GtkTextIter *iter,
+;; const guint8 *data,
+;; gsize length,
+;; GError **error);
+;; gboolean gtk_text_buffer_deserialize_get_can_create_tags
+;; (GtkTextBuffer *buffer,
+;; GdkAtom format);
+;; void gtk_text_buffer_deserialize_set_can_create_tags
+;; (GtkTextBuffer *buffer,
+;; GdkAtom format,
+;; gboolean can_create_tags);
+;; GtkTargetList* gtk_text_buffer_get_copy_target_list
+;; (GtkTextBuffer *buffer);
+;; GdkAtom* gtk_text_buffer_get_deserialize_formats
+;; (GtkTextBuffer *buffer,
+;; gint *n_formats);
+;; GtkTargetList* gtk_text_buffer_get_paste_target_list
+;; (GtkTextBuffer *buffer);
+;; GdkAtom* gtk_text_buffer_get_serialize_formats
+;; (GtkTextBuffer *buffer,
+;; gint *n_formats);
+;; GdkAtom gtk_text_buffer_register_deserialize_format
+;; (GtkTextBuffer *buffer,
+;; const gchar *mime_type,
+;; GtkTextBufferDeserializeFunc function,
+;; gpointer user_data,
+;; GDestroyNotify user_data_destroy);
+;; GdkAtom gtk_text_buffer_register_deserialize_tagset
+;; (GtkTextBuffer *buffer,
+;; const gchar *tagset_name);
+;; GdkAtom gtk_text_buffer_register_serialize_format
+;; (GtkTextBuffer *buffer,
+;; const gchar *mime_type,
+;; GtkTextBufferSerializeFunc function,
+;; gpointer user_data,
+;; GDestroyNotify user_data_destroy);
+;; GdkAtom gtk_text_buffer_register_serialize_tagset
+;; (GtkTextBuffer *buffer,
+;; const gchar *tagset_name);
+;; guint8* (*GtkTextBufferSerializeFunc) (GtkTextBuffer *register_buffer,
+;; GtkTextBuffer *content_buffer,
+;; const GtkTextIter *start,
+;; const GtkTextIter *end,
+;; gsize *length,
+;; gpointer user_data);
+;; guint8* gtk_text_buffer_serialize (GtkTextBuffer *register_buffer,
+;; GtkTextBuffer *content_buffer,
+;; GdkAtom format,
+;; const GtkTextIter *start,
+;; const GtkTextIter *end,
+;; gsize *length);
+;; void gtk_text_buffer_unregister_deserialize_format
+;; (GtkTextBuffer *buffer,
+;; GdkAtom format);
+;; void gtk_text_buffer_unregister_serialize_format
+;; (GtkTextBuffer *buffer,
+;; GdkAtom format);
+
+;; text tag
+
+(defcfun (text-tag-priority "gtk_text_tag_get_priority") :int
+ (tag (g-object text-tag)))
+
+(defcfun gtk-text-tag-set-priority :void
+ (tag (g-object text-tag))
+ (priority :int))
+
+(defun (setf text-tag-priority) (new-value tag)
+ (gtk-text-tag-set-priority tag new-value))
+
+(export 'text-tag-priority)
+
+;; text tag table
+
+(defcallback gtk-text-tag-table-foreach-function :void ((tag (g-object text-tag)) (data :pointer))
+ (funcall (get-stable-pointer-value data) tag))
+
+(defcfun (text-tag-table-add "gtk_text_tag_table_add") :void
+ (table (g-object text-tag-table))
+ (tag (g-object text-tag)))
+
+(export 'text-tag-table-add)
+
+(defcfun (text-tag-table-remove "gtk_text_tag_table_remove") :void
+ (table (g-object text-tag-table))
+ (tag (g-object text-tag)))
+
+(export 'text-tag-table-remove)
+
+(defcfun (text-tag-table-lookup "gtk_text_tag_table_lookup") (g-object text-tag)
+ (table (g-object text-tag-table))
+ (name (:string :free-to-foreign t)))
+
+(export 'text-tag-table-lookup)
+
+(defcfun gtk-text-tag-table-foreach :void
+ (table (g-object text-tag-table))
+ (function :pointer)
+ (data :pointer))
+
+(defun text-tag-table-foreach (table function)
+ (with-stable-pointer (ptr function)
+ (gtk-text-tag-table-foreach table (callback gtk-text-table-foreach-function) ptr)))
+
+(export 'text-tag-table-foreach)
+
+(defcfun (text-tag-table-size "gtk_text_tag_table_get_size") :int
+ (table (g-object text-tag-table)))
+
+(export 'text-tag-table-size)
+
+;; text view
+
+(defcfun gtk-text-view-scroll-to-mark :void
+ (text-view (g-object text-view))
+ (mark (g-object text-mark))
+ (within-margin :double)
+ (use-align :boolean)
+ (x-align :double)
+ (y-align :double))
+
+(defun text-view-scroll-to-mark (text-view mark &key (within-margin 0.4) (x-align 0.0 x-align-supplied) (y-align 0.0 y-align-supplied))
+ (gtk-text-view-scroll-to-mark text-view mark within-margin (or x-align-supplied y-align-supplied) (coerce x-align 'double-float) (coerce y-align 'double-float)))
+
+(export 'text-view-scroll-to-mark)
+
+(defcfun gtk-text-view-scroll-to-iter :void
+ (text-view (g-object text-view))
+ (iter (g-object text-iter))
+ (within-margin :double)
+ (use-align :boolean)
+ (x-align :double)
+ (y-align :double))
+
+(defun text-view-scroll-to-iter (text-view iter &key (within-margin 0.4) (x-align 0.0 x-align-supplied) (y-align 0.0 y-align-supplied))
+ (gtk-text-view-scroll-to-iter text-view iter within-margin (or x-align-supplied y-align-supplied) (coerce x-align 'double-float) (coerce y-align 'double-float)))
+
+(export 'text-view-scroll-to-iter)
+
+(defcfun (text-view-move-mark-onscreen "gtk_text_view_move_mark_onscreen") :boolean
+ (text-view (g-object text-view))
+ (mark (g-object text-mark)))
+
+(export 'text-view-move-mark-onscreen)
+
+(defcfun (text-view-place-cursor-onscreen "gtk_text_view_place_cursor_onscreen") :boolean
+ (text-view (g-object text-view)))
+
+(export 'text-view-place-cursor-onscreen)
+
+(defcfun gtk-text-view-get-visible-rect :void
+ (text-view (g-object text-view))
+ (visible-rect (g-boxed-ptr rectangle :in-out)))
+
+(defun text-view-visible-rect (text-view)
+ (aprog1 (make-rectangle :x 0 :y 0 :width 0 :height 0)
+ (gtk-text-view-get-visible-rect text-view it)))
+
+(export 'text-view-visible-rect)
+
+(defcfun gtk-text-view-get-iter-location :void
+ (text-view (g-object text-view))
+ (iter (g-boxed-ref text-iter))
+ (location (g-boxed-ptr rectangle :in-out)))
+
+(defun text-view-iter-location (text-view iter)
+ (aprog1 (make-rectangle :x 0 :y 0 :width 0 :height 0)
+ (gtk-text-view-get-iter-location text-view iter it)))
+
+(export 'text-view-iter-location)
+
+
+;; void gtk_text_view_get_line_at_y (GtkTextView *text_view,
+;; GtkTextIter *target_iter,
+;; gint y,
+;; gint *line_top);
+;; void gtk_text_view_get_line_yrange (GtkTextView *text_view,
+;; const GtkTextIter *iter,
+;; gint *y,
+;; gint *height);
+;; void gtk_text_view_get_iter_at_location (GtkTextView *text_view,
+;; GtkTextIter *iter,
+;; gint x,
+;; gint y);
+;; void gtk_text_view_get_iter_at_position (GtkTextView *text_view,
+;; GtkTextIter *iter,
+;; gint *trailing,
+;; gint x,
+;; gint y);
+;; void gtk_text_view_buffer_to_window_coords
+;; (GtkTextView *text_view,
+;; GtkTextWindowType win,
+;; gint buffer_x,
+;; gint buffer_y,
+;; gint *window_x,
+;; gint *window_y);
+;; void gtk_text_view_window_to_buffer_coords
+;; (GtkTextView *text_view,
+;; GtkTextWindowType win,
+;; gint window_x,
+;; gint window_y,
+;; gint *buffer_x,
+;; gint *buffer_y);
+;; GdkWindow* gtk_text_view_get_window (GtkTextView *text_view,
+;; GtkTextWindowType win);
+;; GtkTextWindowType gtk_text_view_get_window_type (GtkTextView *text_view,
+;; GdkWindow *window);
+;; void gtk_text_view_set_border_window_size
+;; (GtkTextView *text_view,
+;; GtkTextWindowType type,
+;; gint size);
+;; gint gtk_text_view_get_border_window_size
+;; (GtkTextView *text_view,
+;; GtkTextWindowType type);
+;; gboolean gtk_text_view_forward_display_line (GtkTextView *text_view,
+;; GtkTextIter *iter);
+;; gboolean gtk_text_view_backward_display_line (GtkTextView *text_view,
+;; GtkTextIter *iter);
+;; gboolean gtk_text_view_forward_display_line_end
+;; (GtkTextView *text_view,
+;; GtkTextIter *iter);
+;; gboolean gtk_text_view_backward_display_line_start
+;; (GtkTextView *text_view,
+;; GtkTextIter *iter);
+;; gboolean gtk_text_view_starts_display_line (GtkTextView *text_view,
+;; const GtkTextIter *iter);
+;; gboolean gtk_text_view_move_visually (GtkTextView *text_view,
+;; GtkTextIter *iter,
+;; gint count);
+;; void gtk_text_view_add_child_at_anchor (GtkTextView *text_view,
+;; GtkWidget *child,
+;; GtkTextChildAnchor *anchor);
+;; GtkTextChildAnchor;
+;; GtkTextChildAnchor* gtk_text_child_anchor_new (void);
+;; GList* gtk_text_child_anchor_get_widgets (GtkTextChildAnchor *anchor);
+;; gboolean gtk_text_child_anchor_get_deleted (GtkTextChildAnchor *anchor);
+;; void gtk_text_view_add_child_in_window (GtkTextView *text_view,
+;; GtkWidget *child,
+;; GtkTextWindowType which_window,
+;; gint xpos,
+;; gint ypos);
+;; void gtk_text_view_move_child (GtkTextView *text_view,
+;; GtkWidget *child,
+;; gint xpos,
+;; gint ypos);
--- /dev/null
+(in-package :gtk)
+
--- /dev/null
+(in-package :gtk)
+
+(defcfun (window-add-accel-group "gtk_window_add_accel_group") :void
+ (window (g-object gtk-window))
+ (accel-group (g-object accel-group)))
+
+(export 'window-add-accel-group)
+
+(defcfun (window-remove-accel-group "gtk_window_remove_accel_group") :void
+ (window (g-object gtk-window))
+ (accel-group (g-object accel-group)))
+
+(export 'window-remove-accel-group)
+
+(defcfun (window-activate-focus "gtk_window_activate_focus") :boolean
+ (window (g-object gtk-window)))
+
+(export 'window-activate-focus)
+
+(defcfun (window-activate-default "gtk_window_activate_default") :boolean
+ (window (g-object gtk-window)))
+
+(export 'window-activate-default)
+
+(defcfun (window-set-geometry-hints "gtk_window_set_geometry_hints") :void
+ (window (g-object gtk-window))
+ (geometry-widget (g-object widget))
+ (geometry geometry)
+ (geometry-mask window-hints))
+
+(export 'window-set-geometry-hints)
+
+(defcfun (window-list-toplevels "gtk_window_list_toplevels") (glist (g-object gtk-window) :free-from-foreign t))
+
+(export 'window-list-toplevels)
+
+(defcfun (window-add-mnemonic "gtk_window_add_mnemonic") :void
+ (window (g-object gtk-window))
+ (keyval :uint)
+ (target (g-object widget)))
+
+(export 'window-add-mnemonic)
+
+(defcfun (window-remove-mnemonic "gtk_window_remove_mnemonic") :void
+ (window (g-object gtk-window))
+ (keyval :uint)
+ (target (g-object widget)))
+
+(export 'window-remove-mnemonic)
+
+(defcfun (window-activate-mnemonic "gtk_window_mnemonic_activate") :boolean
+ (window (g-object gtk-window))
+ (keyval :uint)
+ (modifier modifier-type))
+
+(export 'window-activate-mnemonic)
+
+(defcfun (window-activate-key "gtk_window_activate_key") :boolean
+ (window (g-object gtk-window))
+ (event (g-boxed-ptr event-key)))
+
+(export 'window-activate-key)
+
+(defcfun (window-propagate-key-event "gtk_window_propagate_key_event") :boolean
+ (window (g-object gtk-window))
+ (event (g-boxed-ptr event-key)))
+
+(export 'window-propagate-key-event)
+
+(defcfun (window-focus "gtk_window_get_focus") (g-object widget)
+ (window (g-object gtk-window)))
+
+(defcfun (window-set-focus "gtk_window_set_focus") :void
+ (window (g-object gtk-window))
+ (focus (g-object widget)))
+
+(defun (setf window-focus) (focus window)
+ (window-set-focus window focus)
+ focus)
+
+(export 'window-focus)
+
+(defcfun (window-default-widget "gtk_window_get_default_widget") (g-object widget)
+ (window (g-object gtk-window)))
+
+(defcfun (window-set-default-widget "gtk_window_set_default") :void
+ (window (g-object gtk-window))
+ (default-widget (g-object widget)))
+
+(defun (setf window-default-widget) (default-widget window)
+ (window-set-default-widget window default-widget)
+ default-widget)
+
+(export 'window-default-widget)
+
+(defcfun (present-window "gtk_window_present") :void
+ (window (g-object gtk-window)))
+
+(export 'present-window)
+
+(defcfun (present-window-with-time "gtk_window_present_with_time") :void
+ (window (g-object gtk-window))
+ (timestamp :uint32))
+
+(export 'present-window-with-time)
+
+(defcfun (iconify-window "gtk_window_iconify") :void
+ (window (g-object gtk-window)))
+
+(export 'iconify-window)
+
+(defcfun (deiconify-window "gtk_window_deiconify") :void
+ (window (g-object gtk-window)))
+
+(export 'deiconify-window)
+
+(defcfun (stick-window "gtk_window_stick") :void
+ (window (g-object gtk-window)))
+
+(export 'stick-window)
+
+(defcfun (unstick-window "gtk_window_unstick") :void
+ (window (g-object gtk-window)))
+
+(export 'unstick-window)
+
+(defcfun (maximize-window "gtk_window_maximize") :void
+ (window (g-object gtk-window)))
+
+(export 'maximize-window)
+
+(defcfun (unmaximize-window "gtk_window_unmaximize") :void
+ (window (g-object gtk-window)))
+
+(export 'unmaximize-window)
+
+(defcfun (fullscreen-window "gtk_window_fullscreen") :void
+ (window (g-object gtk-window)))
+
+(export 'fullscreen-window)
+
+(defcfun (unfullscreen-window "gtk_window_unfullscreen") :void
+ (window (g-object gtk-window)))
+
+(export 'unfullscreen-window)
+
+(defcfun (window-set-keep-above "gtk_window_set_keep_above") :void
+ (window (g-object gtk-window))
+ (setting :boolean))
+
+(export 'window-set-keep-above)
+
+(defcfun (window-set-keep-below "gtk_window_set_keep_below") :void
+ (window (g-object gtk-window))
+ (setting :boolean))
+
+(export 'window-set-keep-below)
+
+(defcfun (window-begin-resize-drag "gtk_window_begin_resize_drag") :void
+ (window (g-object gtk-window))
+ (edge window-edge)
+ (button :int)
+ (root-x :int)
+ (root-y :int)
+ (timestamp :uint32))
+
+(export 'window-begin-resize-drag)
+
+(defcfun (window-begin-move-drag "gtk_window_begin_move_drag") :void
+ (window (g-object gtk-window))
+ (button :int)
+ (root-x :int)
+ (root-y :int)
+ (timestamp :uint32))
+
+(export 'window-begin-move-drag)
+
+(defcfun (window-set-frame-dimensions "gtk_window_set_frame_dimensions") :void
+ (window (g-object gtk-window))
+ (left :int)
+ (top :int)
+ (right :int)
+ (bottom :int))
+
+(export 'window-set-frame-dimensions)
+
+(defcfun (window-set-has-frame "gtk_window_set_has_frame") :void
+ (window (g-object gtk-window))
+ (setting :boolean))
+
+(export 'window-set-has-frame)
+
+(defcfun (window-set-mnemonic-modifier "gtk_window_set_mnemonic_modifier") :void
+ (window (g-object gtk-window))
+ (modifier modifier-type))
+
+(export 'window-set-mnemonic-modifier)
+
+(defcfun (window-icon-list "gtk_window_get_icon_list") (glist pixbuf :free-from-foreign t)
+ (window (g-object gtk-window)))
+
+(defcfun (window-set-icon-list "gtk_window_set_icon_list") :void
+ (window (g-object gtk-window))
+ (icons (glist pixbuf :free-to-foreign t)))
+
+(defun (setf window-icon-list) (icon-list window)
+ (window-set-icon-list window icon-list))
+
+(export 'window-icon-list)
+
+(defcfun (%window-get-position "gtk_window_get_position") :void
+ (window (g-object gtk-window))
+ (root-x (:pointer :int))
+ (root-y (:pointer :int)))
+
+(defun window-get-position (window)
+ (with-foreign-objects ((x :int)
+ (y :int))
+ (%window-get-position window x y)
+ (values (mem-ref x :int) (mem-ref y :int))))
+
+(export 'window-get-position)
+
+(defcfun (%window-get-size "gtk_window_get_size") :void
+ (window (g-object gtk-window))
+ (width (:pointer :int))
+ (height (:pointer :int)))
+
+(defun window-size (window)
+ (with-foreign-objects ((width :int)
+ (height :int))
+ (%window-get-size window width height)
+ (values (mem-ref width :int) (mem-ref height :int))))
+
+(export 'window-size)
+
+(defcfun (window-group "gtk_window_get_group") (g-object window-group)
+ (window (g-object gtk-window)))
+
+(export 'window-group)
+
+(defcfun (move-window "gtk_window_move") :void
+ (window (g-object gtk-window))
+ (x :int)
+ (y :int))
+
+(export 'move-window)
+
+(defcfun (window-parse-geometry "gtk_window_parse_geometry") :boolean
+ (window (g-object gtk-window))
+ (geometry-string :string))
+
+(export 'window-parse-geometry)
+
+(defcfun (reshow-window-with-initial-size "gtk_window_reshow_with_initial_size") :void
+ (window (g-object gtk-window)))
+
+(export 'reshow-window-with-initial-size)
+
+(defcfun (resize-window "gtk_window_resize") :void
+ (window (g-object gtk-window))
+ (width :int)
+ (height :int))
+
+(export 'resize-window)
+
+(defcfun (default-window-icon-list "gtk_window_get_default_icon_list") (glist pixbuf))
+
+(defcfun (set-default-window-icon-list "gtk_window_set_default_icon_list") :boolean
+ (icon-list (glist pixbuf)))
+
+(defun (setf default-window-icon-list) (icon-list)
+ (set-default-window-icon-list icon-list)
+ icon-list)
+
+(export 'default-window-icon-list)
+
+(defcfun (set-default-window-icon "gtk_window_set_default_icon") :void
+ (icon (g-object pixbuf)))
+
+(defcfun (set-default-window-icon-name "gtk_window_set_default_icon_name") :void
+ (icon-name :string))
+
+(defun (setf default-window-icon) (icon)
+ (etypecase icon
+ (pixbuf (set-default-window-icon icon))
+ (string (set-default-window-icon-name icon))))
+
+(export 'default-window-icon)
+
+(defcfun (set-window-auto-startup-notification "gtk_window_set_auto_startup_notification") :void
+ (setting :boolean))
+
+(export 'set-window-auto-startup-notification)
+
+(defcfun (window-group-add-window "gtk_window_group_add_window") :void
+ (window-group (g-object window-group))
+ (window (g-object gtk-window)))
+
+(export 'window-group-add-window)
+
+(defcfun (window-group-remove-window "gtk_window_group_remove_window") :void
+ (window-group (g-object window-group))
+ (window (g-object gtk-window)))
+
+(export 'window-group-remove-window)
+
+(defcfun (window-group-list-windows "gtk_window_group_list_windows") (glist gtk-window)
+ (window-group (g-object window-group)))
+
+(export 'window-group-list-windows)
\ No newline at end of file
--- /dev/null
+(eval-when (:load-toplevel :compile-toplevel :execute)
+ (asdf:oos 'asdf:load-op :gtk)
+ (asdf:oos 'asdf:load-op :iterate)
+ (asdf:oos 'asdf:load-op :metabang-bind)
+ (use-package :cffi)
+ (use-package :gobject)
+ (use-package :iter)
+ (use-package :bind))
+
+(define-g-boxed-class nil g-type-info ()
+ (class-size :uint16 :initform 0)
+ (base-init :pointer :initform (null-pointer))
+ (base-finalize :pointer :initform (null-pointer))
+ (class-init :pointer :initform (null-pointer))
+ (class-finalize :pointer :initform (null-pointer))
+ (class-data :pointer :initform (null-pointer))
+ (instance-size :uint16 :initform 0)
+ (n-preallocs :uint16 :initform 0)
+ (instance-init :pointer :initform (null-pointer))
+ (value-type :pointer :initform (null-pointer)))
+
+(defcfun (%g-type-register-static "g_type_register_static") gobject::g-type
+ (parent-type gobject::g-type)
+ (type-name :string)
+ (info (g-boxed-ptr g-type-info))
+ (flags gobject::g-type-flags))
+
+(defcfun (%g-type-regiser-static-simple "g_type_register_static_simple") gobject::g-type
+ (parent-type gobject::g-type)
+ (type-name :string)
+ (class-size :uint)
+ (class-init :pointer)
+ (instance-size :uint)
+ (instance-init :pointer)
+ (flags gobject::g-type-flags))
+
+(define-g-boxed-class nil g-type-query ()
+ (type gobject::g-type :initform 0)
+ (name (:string :free-from-foreign nil :free-to-foreign nil) :initform (null-pointer))
+ (class-size :uint :initform 0)
+ (instance-size :uint :initform 0))
+
+(defcfun (%g-type-query "g_type_query") :void
+ (type gobject::g-type)
+ (query (g-boxed-ptr g-type-query :in-out)))
+
+(define-foreign-type g-quark ()
+ ()
+ (:actual-type :uint32)
+ (:simple-parser g-quark))
+
+(defcfun g-quark-from-string :uint32
+ (string :string))
+
+(defcfun g-quark-to-string (:string :free-from-foreign nil)
+ (quark :uint32))
+
+(defmethod translate-to-foreign (string (type g-quark))
+ (g-quark-from-string string))
+
+(defmethod translate-from-foreign (value (type g-quark))
+ (g-quark-to-string value))
+
+(defvar *stable-pointers-to-symbols* (make-array 0 :adjustable t :fill-pointer t))
+
+(defun stable-pointer (symbol)
+ (vector-push-extend symbol *stable-pointers-to-symbols*)
+ (length *stable-pointers-to-symbols*))
+
+(defun deref-stable-pointer (p)
+ (aref *stable-pointers-to-symbols* (1- p)))
+
+(defcfun g-type-set-qdata :void
+ (type gobject::g-type)
+ (quark g-quark)
+ (data :pointer))
+
+(defcfun g-type-get-qdata :pointer
+ (type gobject::g-type)
+ (quark g-quark))
+
+(defun g-object-register-sub-type (name parent-type lisp-class)
+ (let ((q (make-g-type-query)))
+ (%g-type-query (gobject::ensure-g-type parent-type) q)
+ (let ((new-type-id (%g-type-regiser-static-simple (gobject::ensure-g-type parent-type)
+ name
+ (g-type-query-class-size q)
+ (null-pointer)
+ (g-type-query-instance-size q)
+ (null-pointer)
+ nil)))
+ (when (zerop new-type-id)
+ (error "Type registration failed for ~A" name))
+ (g-type-set-qdata new-type-id "lisp-class-name" (make-pointer (stable-pointer lisp-class)))
+ (setf (get lisp-class 'g-type-name) name))))
+
+(defun g-type-lisp-class (type)
+ (let ((sp (pointer-address (g-type-get-qdata (gobject::ensure-g-type type) "lisp-class-name"))))
+ (when (zerop sp)
+ (error "Type ~A is not a lisp-based type" type))
+ (deref-stable-pointer sp)))
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun vtable-item->cstruct-item (member)
+ (if (eq (first member) :skip)
+ (second member)
+ `(,(first member) :pointer)))
+
+ (defun vtable->cstruct (table-name options members)
+ (bind (((&key cstruct-name &allow-other-keys) options))
+ `(defcstruct ,cstruct-name
+ ,@(mapcar #'vtable-item->cstruct-item members))))
+
+ (defun arg-name->name (name)
+ (if (listp name)
+ (second name)
+ name))
+
+ (defun arg->arg-name (arg)
+ (arg-name->name (first arg)))
+
+ (defun vtable-member->callback (table-name options member)
+ (bind (((name return-type &rest args) member))
+ `(defcallback ,name ,return-type ,args
+ (funcall ',name ,@(mapcar #'arg->arg-name args)))))
+
+ (defun vtable->callbacks (table-name options members)
+ (mapcar (lambda (member) (vtable-member->callback table-name options member))
+ (remove-if (lambda (member) (eq (first member) :skip)) members)))
+
+ (defun vtable-member->init-member (iface-ptr-var table-name options member)
+ (bind (((&key cstruct-name &allow-other-keys) options))
+ `(setf (foreign-slot-value ,iface-ptr-var ',cstruct-name ',(first member))
+ (callback ,(first member)))))
+
+ (defun vtable->interface-init (table-name options members)
+ (bind (((&key interface-initializer &allow-other-keys) options))
+ `(defcallback ,interface-initializer :void ((iface :pointer) (data :pointer))
+ (declare (ignore data))
+ ,@(mapcar (lambda (member) (vtable-member->init-member 'iface table-name options member))
+ (remove-if (lambda (member) (eq (first member) :skip)) members)))))
+
+ (defun vtable-member->generic-function (table-name options member)
+ (bind (((name return-type &rest arguments) member))
+ `(defgeneric ,name (,@(mapcar #'first arguments)))))
+
+ (defun vtable->generics-def (table-name options members)
+ (mapcar (lambda (member) (vtable-member->generic-function table-name options member))
+ (remove-if (lambda (member) (eq (first member) :skip)) members))))
+
+(defmacro define-vtable (name options &body members)
+ `(progn
+ ,(vtable->cstruct name options members)
+ ,@(vtable->callbacks name options members)
+ ,(vtable->interface-init name options members)
+ ,@(vtable->generics-def name options members)
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf (get ',name 'options) ',options
+ (get ',name 'members) ',members))))
+
+(define-g-flags "GtkTreeModelFlags" tree-model-flags (t)
+ (:iters-persist 1) (:list-only 2))
+
+(define-g-boxed-class "GtkTreeIter" tree-iter ()
+ (stamp :int)
+ (user-data :pointer)
+ (user-data-2 :pointer)
+ (user-data-3 :pointer))
+
+(defctype tree-path :pointer)
+
+(define-vtable tree-model (:interface "GtkTreeModel" :class-name gtk-tree-model :cstruct-name gtk-tree-model-iface :interface-initializer gtk-tree-model-iface-init)
+ (:skip (parent-instance gobject::g-type-interface))
+ ;;some signals
+ (tree-model-row-changed :void (tree-model :pointer) (path :pointer) (iter :pointer))
+ (tree-model-row-inserted :void (tree-model :pointer) (path :pointer) (iter :pointer))
+ (tree-model-row-has-child-toggled :void (tree-model :pointer) (path :pointer) (iter :pointer))
+ (tree-model-row-deleted :void (tree-model :pointer) (path :pointer))
+ (tree-model-rows-reordered :void (tree-model :pointer) (path :pointer) (iter :pointer) (new-order :pointer))
+ ;;methods
+ (tree-model-get-flags tree-model-flags (tree-model g-object))
+ (tree-model-get-n-columns :int (tree-model g-object))
+ (tree-model-get-column-type gobject::g-type (tree-model g-object) (index :int))
+ (tree-model-get-iter :boolean (tree-model g-object) (iter (:pointer tree-iter)) (path tree-path))
+ (tree-model-get-path tree-path (tree-model g-object) (iter (g-boxed-ptr tree-iter)))
+ (tree-model-get-value :void (tree-model g-object) (iter (g-boxed-ptr tree-iter)) (n :int) (value (:pointer gobject::g-value)))
+ (tree-model-iter-next :boolean (tree-model g-object) (iter (:pointer tree-iter)))
+ (tree-model-iter-children :boolean (tree-model g-object) (iter (:pointer tree-iter)) (parent (g-boxed-ptr tree-iter)))
+ (tree-model-iter-has-child :boolean (tree-model g-object) (iter (g-boxed-ptr tree-iter)))
+ (tree-model-iter-n-children :int (tree-model g-object) (iter (g-boxed-ptr tree-iter)))
+ (tree-model-iter-nth-child :boolean (tree-model g-object) (iter (:pointer tree-iter)) (parent (g-boxed-ptr tree-iter)) (n :int))
+ (tree-model-iter-parent :boolean (tree-model g-object) (iter (:pointer tree-iter)) (child (g-boxed-ptr tree-iter)))
+ (tree-model-ref-node :void (tree-model g-object) (iter (g-boxed-ptr tree-iter)))
+ (tree-model-unref-node :void (tree-model g-object) (iter (g-boxed-ptr tree-iter))))
+
+(defcfun g-type-add-interface-static :void
+ (instance-type gobject::g-type)
+ (interface-type gobject::g-type)
+ (info (:pointer gobject::g-interface-info)))
+
+(defun add-interface (lisp-class vtable-name)
+ (with-foreign-object (iface-info 'gobject::g-interface-info)
+ (setf (foreign-slot-value iface-info 'gobject::g-interface-info 'gobject::interface-init) (get-callback (getf (get vtable-name 'options) :interface-initializer))
+ (foreign-slot-value iface-info 'gobject::g-interface-info 'gobject::interface-finalize) (null-pointer)
+ (foreign-slot-value iface-info 'gobject::g-interface-info 'gobject::interface-data) (null-pointer))
+ (unless (getf (get vtable-name 'options) :interface)
+ (error "Vtable ~A is not a vtable of an interface"))
+ (g-type-add-interface-static (gobject::g-type-from-name (get lisp-class 'g-type-name))
+ (gobject::g-type-from-name (getf (get vtable-name 'options) :interface))
+ iface-info)))
+
+(defvar *o1* nil)
+(defvar *o2* nil)
+
+(unless *o1*
+ (g-object-register-sub-type "LispTreeStore" "GObject" 'lisp-tree-store)
+ (setf *o1* t))
+(unless *o2*
+ (add-interface 'lisp-tree-store 'tree-model)
+ (setf *o2* t))
+
+(defclass tree-model (g-object) ())
+(defmethod initialize-instance :before ((object tree-model) &key pointer)
+ (unless pointer
+ (setf (gobject::pointer object) (gobject::g-object-call-constructor (gobject::g-type-from-name "LispTreeStore") nil nil nil))))
+
+(defmethod tree-model-get-flags ((model tree-model))
+ (list :list-only))
+
+(defmethod tree-model-get-n-columns ((model tree-model))
+ 1)
+
+(defmethod tree-model-get-column-type ((model tree-model) index)
+ (gobject::g-type-from-name "gchararray"))
+
+(defcfun (%gtk-tree-path-get-depth "gtk_tree_path_get_depth") :int
+ (path tree-path))
+
+(defcfun (%gtk-tree-path-get-indices "gtk_tree_path_get_indices") (:pointer :int)
+ (path tree-path))
+
+(defcfun (%gtk-tree-path-new "gtk_tree_path_new") :pointer)
+
+(defcfun (%gtk-tree-path-append-index "gtk_tree_path_append_index") :void
+ (path :pointer)
+ (index :int))
+
+(defun tree-path-indices (path)
+ (let ((n (%gtk-tree-path-get-depth path))
+ (indices (%gtk-tree-path-get-indices path)))
+ (loop
+ for i from 0 below n
+ collect (mem-aref indices :int i))))
+
+(defmethod tree-model-get-iter ((model tree-model) iter path)
+ (let ((indices (tree-path-indices path)))
+ (when (= 1 (length indices))
+ (with-foreign-slots ((stamp user-data user-data-2 user-data-3) iter tree-iter)
+ (setf stamp 0 user-data (make-pointer (first indices)) user-data-2 (null-pointer) user-data-3 (null-pointer)))
+ t)))
+
+(defmethod tree-model-ref-node ((model tree-model) iter))
+(defmethod tree-model-unref-node ((model tree-model) iter))
+
+(defmethod tree-model-iter-next ((model tree-model) iter)
+ (with-foreign-slots ((stamp user-data) iter tree-iter)
+ (let ((n (pointer-address user-data)))
+ (when (< n 5)
+ (setf user-data (make-pointer (1+ n)))
+ t))))
+
+(defmethod tree-model-iter-nth-child ((model tree-model) iter parent n)
+ (with-foreign-slots ((stamp user-data user-data-2 user-data-3) iter tree-iter)
+ (setf stamp 0 user-data (make-pointer n) user-data-2 (null-pointer) user-data-3 (null-pointer)))
+ t)
+
+(defmethod tree-model-iter-n-children ((model tree-model) iter)
+ (if (null iter)
+ 5
+ 0))
+
+(defmethod tree-model-get-path ((model tree-model) iter)
+ (let ((path (%gtk-tree-path-new)))
+ (%gtk-tree-path-append-index path (pointer-address (tree-iter-user-data iter)))
+ path))
+
+(defmethod tree-model-iter-has-child ((model tree-model) iter)
+ nil)
+
+(defmethod tree-model-get-value ((model tree-model) iter n value)
+ (let ((n-row (pointer-address (tree-iter-user-data iter))))
+ (gobject::set-g-value value (format nil "~A" (expt n-row 2)) (gobject::g-type-from-name "gchararray"))))
+
+(defcfun (%gtk-tree-view-append-column "gtk_tree_view_append_column") :int
+ (tree-view (g-object gtk:tree-view))
+ (column (g-object gtk:tree-view-column)))
+
+(defcfun (%gtk-tree-view-column-pack-start "gtk_tree_view_column_pack_start") :void
+ (tree-column (g-object gtk:tree-view-column))
+ (cell (g-object gtk:cell-renderer))
+ (expand :boolean))
+
+(defcfun (%gtk-tree-view-column-add-attribute "gtk_tree_view_column_add_attribute") :void
+ (tree-column (g-object gtk:tree-view-column))
+ (cell-renderer (g-object gtk:cell-renderer))
+ (attribute :string)
+ (column-number :int))
+
+(defun test-treeview ()
+ (let* ((window (make-instance 'gtk:gtk-window :type :toplevel :title "Treeview" :border-width 30))
+ (model (make-instance 'tree-model))
+ (tv (make-instance 'gtk:tree-view :model model :headers-visible t)))
+ (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk:gtk-main-quit)))
+ (let ((column (make-instance 'gtk:tree-view-column :title "Number"))
+ (renderer (make-instance 'gtk:cell-renderer-text :text "A text")))
+ (%gtk-tree-view-column-pack-start column renderer t)
+ (%gtk-tree-view-column-add-attribute column renderer "text" 0)
+ (%gtk-tree-view-append-column tv column))
+ (gtk:container-add window tv)
+ (gtk:gtk-widget-show-all window)
+ (gtk:gtk-main)))
+
+(defcfun (%gtk-cell-layout-pack-start "gtk_cell_layout_pack_start") :void
+ (cell-layout g-object)
+ (cell (g-object gtk:cell-renderer))
+ (expand :boolean))
+
+(defcfun (%gtk-cell-layout-add-attribute "gtk_cell_layout_add_attribute") :void
+ (cell-layout g-object)
+ (cell (g-object gtk:cell-renderer))
+ (attribute :string)
+ (column :int))
+
+(defun test-combobox ()
+ (let* ((window (make-instance 'gtk:gtk-window :type :toplevel :title "cb" :border-width 30))
+ (model (make-instance 'tree-model))
+ (combobox (make-instance 'gtk:combo-box :model model)))
+ (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk:gtk-main-quit)))
+ (g-signal-connect combobox "changed" (lambda (w) (declare (ignore w)) (format t "Changed cb; active now = ~A~%" (gtk:combo-box-active combobox))))
+ (let ((renderer (make-instance 'gtk:cell-renderer-text)))
+ (%gtk-cell-layout-pack-start combobox renderer t)
+ (%gtk-cell-layout-add-attribute combobox renderer "text" 0))
+ (gtk:container-add window combobox)
+ (gtk:gtk-widget-show-all window)
+ (gtk:gtk-main)))
+
+(define-vtable widget (:class "GtkWidget" :cstruct-name widget-vtable :interface-initializer gtk-tree-model-iface-init)
+ (:skip (parent-instance gobject::g-type-interface))
+ ;;some signals
+ (tree-model-row-changed :void (tree-model :pointer) (path :pointer) (iter :pointer))
+ (tree-model-row-inserted :void (tree-model :pointer) (path :pointer) (iter :pointer))
+ (tree-model-row-has-child-toggled :void (tree-model :pointer) (path :pointer) (iter :pointer))
+ (tree-model-row-deleted :void (tree-model :pointer) (path :pointer))
+ (tree-model-rows-reordered :void (tree-model :pointer) (path :pointer) (iter :pointer) (new-order :pointer))
+ ;;methods
+ (tree-model-get-flags tree-model-flags (tree-model g-object))
+ (tree-model-get-n-columns :int (tree-model g-object))
+ (tree-model-get-column-type gobject::g-type (tree-model g-object) (index :int))
+ (tree-model-get-iter :boolean (tree-model g-object) (iter (:pointer tree-iter)) (path tree-path))
+ (tree-model-get-path tree-path (tree-model g-object) (iter (g-boxed-ptr tree-iter)))
+ (tree-model-get-value :void (tree-model g-object) (iter (g-boxed-ptr tree-iter)) (n :int) (value (:pointer gobject::g-value)))
+ (tree-model-iter-next :boolean (tree-model g-object) (iter (:pointer tree-iter)))
+ (tree-model-iter-children :boolean (tree-model g-object) (iter (:pointer tree-iter)) (parent (g-boxed-ptr tree-iter)))
+ (tree-model-iter-has-child :boolean (tree-model g-object) (iter (g-boxed-ptr tree-iter)))
+ (tree-model-iter-n-children :int (tree-model g-object) (iter (g-boxed-ptr tree-iter)))
+ (tree-model-iter-nth-child :boolean (tree-model g-object) (iter (:pointer tree-iter)) (parent (g-boxed-ptr tree-iter)) (n :int))
+ (tree-model-iter-parent :boolean (tree-model g-object) (iter (:pointer tree-iter)) (child (g-boxed-ptr tree-iter)))
+ (tree-model-ref-node :void (tree-model g-object) (iter (g-boxed-ptr tree-iter)))
+ (tree-model-unref-node :void (tree-model g-object) (iter (g-boxed-ptr tree-iter))))
\ No newline at end of file
projects / cl-gtk2.git / commitdiff