From: Dmitry Kalyanov Date: Tue, 10 Feb 2009 11:54:39 +0000 (+0300) Subject: Initial commit X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0d03b82a77743d2ea5ef69bea08735fa12857d92;p=cl-gtk2.git Initial commit --- 0d03b82a77743d2ea5ef69bea08735fa12857d92 diff --git a/gdk/gdk.asd b/gdk/gdk.asd new file mode 100644 index 0000000..fef78d1 --- /dev/null +++ b/gdk/gdk.asd @@ -0,0 +1,7 @@ +(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 diff --git a/gdk/gdk.functions.lisp b/gdk/gdk.functions.lisp new file mode 100644 index 0000000..0285a4a --- /dev/null +++ b/gdk/gdk.functions.lisp @@ -0,0 +1,49 @@ +(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))) diff --git a/gdk/gdk.objects.lisp b/gdk/gdk.objects.lisp new file mode 100644 index 0000000..380537c --- /dev/null +++ b/gdk/gdk.objects.lisp @@ -0,0 +1,309 @@ +(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 diff --git a/gdk/gdk.package.lisp b/gdk/gdk.package.lisp new file mode 100644 index 0000000..d1a6cfc --- /dev/null +++ b/gdk/gdk.package.lisp @@ -0,0 +1,14 @@ +(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 diff --git a/generating.lisp b/generating.lisp new file mode 100644 index 0000000..d44ffaf --- /dev/null +++ b/generating.lisp @@ -0,0 +1,69 @@ +(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 diff --git a/glib/glib.asd b/glib/glib.asd new file mode 100644 index 0000000..1aea310 --- /dev/null +++ b/glib/glib.asd @@ -0,0 +1,27 @@ +(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 diff --git a/glib/glib.glist.lisp b/glib/glib.glist.lisp new file mode 100644 index 0000000..82ba209 --- /dev/null +++ b/glib/glib.glist.lisp @@ -0,0 +1,67 @@ +(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 diff --git a/glib/glib.gstrv.lisp b/glib/glib.gstrv.lisp new file mode 100644 index 0000000..810fc39 --- /dev/null +++ b/glib/glib.gstrv.lisp @@ -0,0 +1,30 @@ +(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 diff --git a/glib/glib.lisp b/glib/glib.lisp new file mode 100644 index 0000000..64415f4 --- /dev/null +++ b/glib/glib.lisp @@ -0,0 +1,412 @@ +(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 + diff --git a/glib/glib.string.lisp b/glib/glib.string.lisp new file mode 100644 index 0000000..b2b6c81 --- /dev/null +++ b/glib/glib.string.lisp @@ -0,0 +1,20 @@ +(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 diff --git a/glib/gobject.boxed.lisp b/glib/gobject.boxed.lisp new file mode 100644 index 0000000..80c96c4 --- /dev/null +++ b/glib/gobject.boxed.lisp @@ -0,0 +1,17 @@ +(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 diff --git a/glib/gobject.closures.lisp b/glib/gobject.closures.lisp new file mode 100644 index 0000000..26c8e71 --- /dev/null +++ b/glib/gobject.closures.lisp @@ -0,0 +1,31 @@ +(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 diff --git a/glib/gobject.enum.lisp b/glib/gobject.enum.lisp new file mode 100644 index 0000000..ad8bf6c --- /dev/null +++ b/glib/gobject.enum.lisp @@ -0,0 +1,9 @@ +(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 diff --git a/glib/gobject.foreign-closures.lisp b/glib/gobject.foreign-closures.lisp new file mode 100644 index 0000000..bed6d45 --- /dev/null +++ b/glib/gobject.foreign-closures.lisp @@ -0,0 +1,51 @@ +(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 diff --git a/glib/gobject.foreign-gboxed.lisp b/glib/gobject.foreign-gboxed.lisp new file mode 100644 index 0000000..712e3e0 --- /dev/null +++ b/glib/gobject.foreign-gboxed.lisp @@ -0,0 +1,328 @@ +(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 diff --git a/glib/gobject.foreign-gobject.lisp b/glib/gobject.foreign-gobject.lisp new file mode 100644 index 0000000..ce17283 --- /dev/null +++ b/glib/gobject.foreign-gobject.lisp @@ -0,0 +1,227 @@ +(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 diff --git a/glib/gobject.foreign.lisp b/glib/gobject.foreign.lisp new file mode 100644 index 0000000..79d010f --- /dev/null +++ b/glib/gobject.foreign.lisp @@ -0,0 +1,51 @@ +(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 diff --git a/glib/gobject.generating.lisp b/glib/gobject.generating.lisp new file mode 100644 index 0000000..c0581fa --- /dev/null +++ b/glib/gobject.generating.lisp @@ -0,0 +1,334 @@ +(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 diff --git a/glib/gobject.gobject-query.lisp b/glib/gobject.gobject-query.lisp new file mode 100644 index 0000000..c96d83f --- /dev/null +++ b/glib/gobject.gobject-query.lisp @@ -0,0 +1,103 @@ +(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)))) diff --git a/glib/gobject.gparams.lisp b/glib/gobject.gparams.lisp new file mode 100644 index 0000000..a4593ed --- /dev/null +++ b/glib/gobject.gparams.lisp @@ -0,0 +1,322 @@ +(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 diff --git a/glib/gobject.gvalue-parser.lisp b/glib/gobject.gvalue-parser.lisp new file mode 100644 index 0000000..1443e34 --- /dev/null +++ b/glib/gobject.gvalue-parser.lisp @@ -0,0 +1,134 @@ +(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)))) diff --git a/glib/gobject.gvalue.lisp b/glib/gobject.gvalue.lisp new file mode 100644 index 0000000..22b1b04 --- /dev/null +++ b/glib/gobject.gvalue.lisp @@ -0,0 +1,28 @@ +(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))) + diff --git a/glib/gobject.object-defs.lisp b/glib/gobject.object-defs.lisp new file mode 100644 index 0000000..e9168bb --- /dev/null +++ b/glib/gobject.object-defs.lisp @@ -0,0 +1,3 @@ +(in-package :gobject) + +(define-g-object-class "GInitiallyUnowned" g-initially-unowned (g-object) ()) \ No newline at end of file diff --git a/glib/gobject.object.lisp b/glib/gobject.object.lisp new file mode 100644 index 0000000..cb9abec --- /dev/null +++ b/glib/gobject.object.lisp @@ -0,0 +1,110 @@ +(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 diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp new file mode 100644 index 0000000..5314ebf --- /dev/null +++ b/glib/gobject.package.lisp @@ -0,0 +1,42 @@ +(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 diff --git a/glib/gobject.signals.lisp b/glib/gobject.signals.lisp new file mode 100644 index 0000000..1531f16 --- /dev/null +++ b/glib/gobject.signals.lisp @@ -0,0 +1,7 @@ +(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 diff --git a/glib/gobject.structs.lisp b/glib/gobject.structs.lisp new file mode 100644 index 0000000..0be2503 --- /dev/null +++ b/glib/gobject.structs.lisp @@ -0,0 +1,277 @@ +(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 diff --git a/glib/gobject.type.lisp b/glib/gobject.type.lisp new file mode 100644 index 0000000..0e1fbfb --- /dev/null +++ b/glib/gobject.type.lisp @@ -0,0 +1,119 @@ +(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 diff --git a/gtk/gtk.asd b/gtk/gtk.asd new file mode 100644 index 0000000..697a5a0 --- /dev/null +++ b/gtk/gtk.asd @@ -0,0 +1,25 @@ +(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 diff --git a/gtk/gtk.base-classes.lisp b/gtk/gtk.base-classes.lisp new file mode 100644 index 0000000..0d38a0d --- /dev/null +++ b/gtk/gtk.base-classes.lisp @@ -0,0 +1,2 @@ +(in-package :gtk) + diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp new file mode 100644 index 0000000..1664d09 --- /dev/null +++ b/gtk/gtk.demo.lisp @@ -0,0 +1,242 @@ +(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 anything 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 diff --git a/gtk/gtk.dialog.example.lisp b/gtk/gtk.dialog.example.lisp new file mode 100644 index 0000000..e9647e3 --- /dev/null +++ b/gtk/gtk.dialog.example.lisp @@ -0,0 +1,32 @@ +(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 diff --git a/gtk/gtk.dialog.lisp b/gtk/gtk.dialog.lisp new file mode 100644 index 0000000..6f92abe --- /dev/null +++ b/gtk/gtk.dialog.lisp @@ -0,0 +1,92 @@ +(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) + diff --git a/gtk/gtk.entry.lisp b/gtk/gtk.entry.lisp new file mode 100644 index 0000000..dcd7e8d --- /dev/null +++ b/gtk/gtk.entry.lisp @@ -0,0 +1,154 @@ +(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 diff --git a/gtk/gtk.functions.lisp b/gtk/gtk.functions.lisp new file mode 100644 index 0000000..cb746e5 --- /dev/null +++ b/gtk/gtk.functions.lisp @@ -0,0 +1,55 @@ +(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 diff --git a/gtk/gtk.generated-classes.lisp b/gtk/gtk.generated-classes.lisp new file mode 100644 index 0000000..b56b707 --- /dev/null +++ b/gtk/gtk.generated-classes.lisp @@ -0,0 +1,1950 @@ +(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) + diff --git a/gtk/gtk.image.lisp b/gtk/gtk.image.lisp new file mode 100644 index 0000000..f56283e --- /dev/null +++ b/gtk/gtk.image.lisp @@ -0,0 +1,16 @@ +(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 diff --git a/gtk/gtk.label.lisp b/gtk/gtk.label.lisp new file mode 100644 index 0000000..c5d738a --- /dev/null +++ b/gtk/gtk.label.lisp @@ -0,0 +1,25 @@ +(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 diff --git a/gtk/gtk.main_loop_events.lisp b/gtk/gtk.main_loop_events.lisp new file mode 100644 index 0000000..6c7376a --- /dev/null +++ b/gtk/gtk.main_loop_events.lisp @@ -0,0 +1,45 @@ +(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 diff --git a/gtk/gtk.objects.lisp b/gtk/gtk.objects.lisp new file mode 100644 index 0000000..7837a1e --- /dev/null +++ b/gtk/gtk.objects.lisp @@ -0,0 +1,7 @@ +(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 diff --git a/gtk/gtk.package.lisp b/gtk/gtk.package.lisp new file mode 100644 index 0000000..56cd5b6 --- /dev/null +++ b/gtk/gtk.package.lisp @@ -0,0 +1,26 @@ +(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 diff --git a/gtk/gtk.progress-bar.lisp b/gtk/gtk.progress-bar.lisp new file mode 100644 index 0000000..445fc98 --- /dev/null +++ b/gtk/gtk.progress-bar.lisp @@ -0,0 +1,6 @@ +(in-package :gtk) + +(defcfun (progress-bar-pulse "gtk_progress_bar_pulse") :void + (progress-bar (g-object progress-bar))) + +(export 'progress-bar-pulse) diff --git a/gtk/gtk.scale-button.lisp b/gtk/gtk.scale-button.lisp new file mode 100644 index 0000000..efb80cf --- /dev/null +++ b/gtk/gtk.scale-button.lisp @@ -0,0 +1,14 @@ +(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 diff --git a/gtk/gtk.spin-button.lisp b/gtk/gtk.spin-button.lisp new file mode 100644 index 0000000..9668b88 --- /dev/null +++ b/gtk/gtk.spin-button.lisp @@ -0,0 +1,18 @@ +(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) diff --git a/gtk/gtk.status-bar.lisp b/gtk/gtk.status-bar.lisp new file mode 100644 index 0000000..45cc2c7 --- /dev/null +++ b/gtk/gtk.status-bar.lisp @@ -0,0 +1,32 @@ +(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 diff --git a/gtk/gtk.status-icon.lisp b/gtk/gtk.status-icon.lisp new file mode 100644 index 0000000..149fddd --- /dev/null +++ b/gtk/gtk.status-icon.lisp @@ -0,0 +1,7 @@ +(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 diff --git a/gtk/gtk.text-entry.lisp b/gtk/gtk.text-entry.lisp new file mode 100644 index 0000000..90acf40 --- /dev/null +++ b/gtk/gtk.text-entry.lisp @@ -0,0 +1,23 @@ +(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); diff --git a/gtk/gtk.text.lisp b/gtk/gtk.text.lisp new file mode 100644 index 0000000..10a994a --- /dev/null +++ b/gtk/gtk.text.lisp @@ -0,0 +1,1022 @@ +(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); diff --git a/gtk/gtk.widget.lisp b/gtk/gtk.widget.lisp new file mode 100644 index 0000000..0d38a0d --- /dev/null +++ b/gtk/gtk.widget.lisp @@ -0,0 +1,2 @@ +(in-package :gtk) + diff --git a/gtk/gtk.window.lisp b/gtk/gtk.window.lisp new file mode 100644 index 0000000..39a9e57 --- /dev/null +++ b/gtk/gtk.window.lisp @@ -0,0 +1,311 @@ +(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 diff --git a/subclass.lisp b/subclass.lisp new file mode 100644 index 0000000..9cf9e1e --- /dev/null +++ b/subclass.lisp @@ -0,0 +1,370 @@ +(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