(defpackage :gtk-generation
(:use :cl :gobject :cffi :glib)
- (:export #:gtk-generate))
+ (:export #:gtk-generate
+ #:gtk-generate-child-properties))
(in-package :gtk-generation)
("GtkFixed"
(:cffi gtk::has-window gtk::fixed-has-window :boolean "gtk_fixed_get_has_window" "gtk_gixed_set_has_window"))
("GtkLayout"
- (:cffi gtk::bin-window gtk::layout-bin-window g-object "gtk_layout_get_bin_window" nil))))))
\ No newline at end of file
+ (:cffi gtk::bin-window gtk::layout-bin-window g-object "gtk_layout_get_bin_window" nil))
+ ("GtkCalendar"
+ (:cffi gtk::detail-function gtk::calendar-detail-function nil nil gtk::calendar-set-detail-function))
+ ("GtkContainer"
+ (:cffi gtk::focus-child gtk::container-focus-child g-object "gtk_container_get_focus_child" "gtk_container_set_focus_child")
+ (:cffi gtk::vadjustment-child gtk::container-vadjustment-child g-object "gtk_container_get_vadjustment_child" "gtk_container_set_vadjustment_child")
+ (:cffi gtk::hadjustment-child gtk::container-hadjustment-child g-object "gtk_container_get_hadjustment_child" "gtk_container_set_hadjustment_child"))))))
+
+(defun gtk-generate-child-properties (filename)
+ (with-open-file (stream filename :direction :output :if-exists :supersede)
+ (let ((*package* (find-package :gtk))
+ (*print-case* :downcase))
+ (write-string "(in-package :gtk)" stream)
+ (terpri stream)
+ (format stream "~{~S~%~%~}" (gtk:generate-child-properties)))))
\ No newline at end of file
(defvar *registered-object-types* (make-hash-table :test 'equal))
(defun register-object-type (name type)
(setf (gethash name *registered-object-types*) type))
+(defun registered-object-type-by-name (name)
+ (gethash name *registered-object-types*))
(defun get-g-object-lisp-type (g-type)
(loop
while (not (zerop g-type))
(etypecase object
(g-object (pointer object)))))
+(defun g-param-spec-property-type (param-spec property-name object-type assert-readable assert-writable)
+ (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))
+
(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-param-spec-property-type param-spec property-name object-type assert-readable assert-writable)
(g-type-class-unref object-class))))
(defun g-object-property-type (object property-name
append (property->accessors name property export))
(eval-when (:compile-toplevel :load-toplevel :execute)
+ (register-object-type ,g-type-name ',name)
(setf (get ',name 'superclass) ',superclass
(get ',name 'properties) ',combined-properties)))))
constructor-only
owner-type)
+(defun parse-g-param-spec (param)
+ (let ((flags (foreign-slot-value param 'g-param-spec 'flags)))
+ (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))))
+
(defun class-properties (g-type)
(setf g-type (ensure-g-type g-type))
(let ((g-class (g-type-class-ref g-type)))
(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)))
+ collect (parse-g-param-spec param))
(g-free params))))
(g-type-class-unref g-class))))
#:emit-signal
#:g-value-unset
#:g-value-zero
- #:g-value-take-boxed))
+ #:g-value-take-boxed
+ #:g-value-init
+ #:g-class-property-definition
+ #:g-class-property-definition-name
+ #:g-class-property-definition-type
+ #:g-class-property-definition-readable
+ #:g-class-property-definition-writable
+ #:g-class-property-definition-constructor
+ #:g-class-property-definition-constructor-only
+ #:g-class-property-definition-owner-type
+ #:g-type-class-ref
+ #:g-object-class
+ #:g-param-spec
+ #:type-instance
+ #:parse-g-param-spec
+ #:g-type-class-unref
+ #:registered-object-type-by-name
+ #:g-type-children))
(in-package :gobject)
(n-children (:pointer :uint)))
(defun g-type-children (g-type)
+ (setf g-type (ensure-g-type g-type))
(with-foreign-object (n-children :uint)
(let ((g-types-ptr (%g-type-children g-type n-children)))
(prog1
(:file "gtk.ui-manager")
(:file "gtk.selectors")
(:file "gtk.layout-containers")
+ (:file "gtk.scrolling")
+ (:file "gtk.calendar")
+ (:file "gtk.size-group")
+ (:file "gtk.tooltip")
+ (:file "gtk.bin")
+ (:file "gtk.box")
+ (:file "gtk.container")
+ (:file "gtk.paned")
+ (:file "gtk.child-properties")
(:file "gtk.dialog.example")
--- /dev/null
+(in-package :gtk)
+
+(defcfun (bin-child "gtk_bin_get_child") g-object
+ (bin g-object))
+
+(export 'bin-child)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(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))
+
+(export 'box-pack-start)
+
+(defcfun gtk-box-pack-end :void
+ (box (g-object box))
+ (child (g-object widget))
+ (expand :boolean)
+ (fill :boolean)
+ (padding :uint))
+
+(defun box-pack-end (box child &key (expand t) (fill t) (padding 0))
+ (gtk-box-pack-end box child expand fill padding))
+
+(export 'box-pack-end)
+
+(defcfun (box-reorder-child "gtk_box_reorder_child") :void
+ (box g-object)
+ (child g-object)
+ (position :int))
+
+(export 'box-reorder-child)
+
+(define-child-property "GtkBox" box-child-expand "expand" "gboolean" t t t)
+(define-child-property "GtkBox" box-child-fill "fill" "gboolean" t t t)
+(define-child-property "GtkBox" box-child-pack-type "pack-type" "GtkPackType" t t t)
+(define-child-property "GtkBox" box-child-padding "padding" "guint" t t t)
+(define-child-property "GtkBox" box-child-position "position" "gint" t t t)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun (calendar-mark-day "gtk_calendar_mark_day") :boolean
+ (calendar g-object)
+ (day :uint))
+
+(export 'calendar-mark-day)
+
+(defcfun (calendar-unmark-day "gtk_calendar_unmark_day") :boolean
+ (calendar g-object)
+ (day :uint))
+
+(export 'calendar-unmark-day)
+
+(defcfun (calendar-clear-marks "gtk_calendar_clear_marks") :void
+ (calendar g-object))
+
+(export 'calendar-clear-marks)
+
+(defcallback gtk-calendar-detail-func-callback (g-string :free-to-foreign nil :free-from-foreign nil)
+ ((calendar g-object) (year :uint) (month :uint) (day :uint) (data :pointer))
+ (restart-case
+ (or (funcall (get-stable-pointer-value data)
+ calendar year month day)
+ (null-pointer))
+ (return-null () (null-pointer))))
+
+(defcfun gtk-calendar-set-detail-func :void
+ (calendar g-object)
+ (func :pointer)
+ (data :pointer)
+ (destroy-notify :pointer))
+
+(defun calendar-set-detail-function (calendar function)
+ (gtk-calendar-set-detail-func calendar
+ (callback gtk-calendar-detail-func-callback)
+ (allocate-stable-pointer function)
+ (callback stable-pointer-free-destroy-notify-callback)))
--- /dev/null
+(in-package :gtk)
+
+(defcfun gtk-container-child-get-property :void
+ (container g-object)
+ (child g-object)
+ (property-name :string)
+ (value (:pointer g-value)))
+
+(defcfun gtk-container-child-set-property :void
+ (container g-object)
+ (child g-object)
+ (property-name :string)
+ (value (:pointer g-value)))
+
+(defun container-call-get-property (container child property-name type)
+ (with-foreign-object (gvalue 'g-value)
+ (g-value-unset gvalue)
+ (g-value-init gvalue (ensure-g-type type))
+ (gtk-container-child-get-property container child property-name gvalue)
+ (prog1 (parse-gvalue gvalue)
+ (g-value-unset gvalue))))
+
+(defun container-call-set-property (container child property-name new-value type)
+ (with-foreign-object (gvalue 'g-value)
+ (set-g-value gvalue new-value (ensure-g-type type) :zero-g-value t)
+ (gtk-container-child-set-property container child property-name gvalue)
+ (g-value-unset gvalue)
+ (values)))
+
+(defmacro define-child-property (container-type property-name property-gname property-type readable writable export)
+ (when (stringp container-type) (setf container-type (registered-object-type-by-name container-type)))
+ `(progn
+ ,@(when readable
+ (list `(defun ,property-name (container child)
+ (assert (typep container ',container-type))
+ (container-call-get-property container child ,property-gname ,property-type))))
+ ,@(when writable
+ (list `(defun (setf ,property-name) (new-value container child)
+ (assert (typep container ',container-type))
+ (container-call-set-property container child ,property-gname new-value ,property-type))))
+ ,@(when export
+ (list `(export ',property-name)))))
+
+(defcfun gtk-container-class-list-child-properties (:pointer (:pointer g-param-spec))
+ (class (:pointer g-object-class))
+ (n-properties (:pointer :int)))
+
+(defun container-class-child-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 (gtk-container-class-list-child-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)
+ collect (parse-g-param-spec param))
+ (g-free params))))
+ (g-type-class-unref g-class))))
+
+(defun child-property-name (type-name property-name package-name)
+ (intern (format nil "~A-CHILD-~A" (symbol-name (registered-object-type-by-name type-name)) (string-upcase property-name)) (find-package package-name)))
+
+(defun generate-child-properties (&optional (type-root "GtkContainer") (package-name "GTK"))
+ (setf type-root (ensure-g-type type-root))
+ (append (loop
+ for property in (container-class-child-properties type-root)
+ collect
+ `(define-child-property
+ ,(g-type-name type-root)
+ ,(child-property-name (g-type-name type-root) (g-class-property-definition-name property) package-name)
+ ,(g-class-property-definition-name property)
+ ,(g-type-name (g-class-property-definition-type property))
+ ,(g-class-property-definition-readable property)
+ ,(g-class-property-definition-writable property)
+ t))
+ (loop
+ for subclass in (g-type-children type-root)
+ appending (generate-child-properties subclass package-name))))
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun (container-add "gtk_container_add") :void
+ (container (g-object container))
+ (widget (g-object widget)))
+
+(export 'container-add)
+
+(defcfun (container-remove "gtk_container_remove") :void
+ (container (g-object container))
+ (widget (g-object widget)))
+
+(export 'container-remove)
+
+(defcfun (container-check-resize "gtk_container_check_resize") :void
+ (container g-object))
+
+(export 'container-check-resize)
+
+(defcallback gtk-container-foreach-callback :void
+ ((widget g-object) (data :pointer))
+ (restart-case
+ (funcall (get-stable-pointer-value data)
+ widget)
+ (return () nil)))
+
+(defcfun gtk-container-foreach :void
+ (container g-object)
+ (callback :pointer)
+ (data :pointer))
+
+(defun map-container-children (container function)
+ (with-stable-pointer (ptr function)
+ (gtk-container-foreach container (callback gtk-container-foreach-callback) ptr)))
+
+(export 'map-container-children)
+
+(defcfun gtk-container-forall :void
+ (container g-object)
+ (callback :pointer)
+ (data :pointer))
+
+(defun map-container-internal-children (container function)
+ (with-stable-pointer (ptr function)
+ (gtk-container-forall container (callback gtk-container-foreach-callback) ptr)))
+
+(export 'map-container-internal-children)
+
+(defcfun (container-children "gtk_container_get_children") (glist g-object :free-from-foreign t)
+ (container g-object))
+
+; TODO: ownership issues
+
+(export 'container-children)
+
+; TODO: gtk_container_set_reallocate_redraws
+
+(defcfun (container-resize-children "gtk_container_resize_children") :void
+ (container g-object))
+
+(export 'container-resize-children)
+
+(defcfun gtk-container-child-type g-type
+ (container g-object))
+
+; TODO: export gtk-container-child-type, requires better interface
+
+; TODO: child properties
+
+; TODO: gtk_container_propagate_expose
+
+; TODO: gtk_container_get_focus_chain
+
+; TODO: gtk_container_set_focus_chain
+
+; TODO: gtk_container_unset_focus_chain
+
#:test-treeview-list
#:test-combobox
#:test-toolbar
- #:test-color-button
#:test-ui-manager
#:test-color-button
#:test-color-selection
#:test-file-chooser
#:test-font-chooser
- #:test-notebook))
+ #:test-notebook
+ #:test-calendar
+ #:test-box-child-property))
(in-package :gtk-demo)
(gtk-widget-show-all window)
(gtk-main)))
-(defun test-color-button ()
- (let* ((window (make-instance 'gtk-window :type :toplevel :title "Color button" :width-request 200 :height-request 100 :window-position :center))
- (button (make-instance 'color-button :label "Choose your color" :use-alpha t)))
- (gobject:g-signal-connect window "destroy" (lambda (w) (gobject:release w) (gtk-main-quit)))
- (container-add window button)
- (setf (color-button-color button)
- (make-color :red (random 65536) :green (random 65536) :blue (random 65536)))
- (gtk-widget-show-all window)
- (gtk-main)))
-
(defun test-ui-manager ()
(let* ((window (make-instance 'gtk-window :type :toplevel :title "UI Manager" :default-width 200 :default-height 100 :window-position :center))
(ui-manager (make-instance 'ui-manager))
(container-add window expander)
(container-add expander notebook)
(gtk-widget-show-all window)
+ (gtk-main)))
+
+(defun calendar-detail (calendar year month day)
+ (declare (ignore calendar year month))
+ (when (= day 23)
+ "!"))
+
+(defun test-calendar ()
+ (let ((window (make-instance 'gtk-window :title "Calendar" :type :toplevel :window-position :center :default-width 100 :default-height 100))
+ (calendar (make-instance 'calendar :detail-function #'calendar-detail)))
+ (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+ (g-signal-connect calendar "day-selected" (lambda (c) (declare (ignore c)) (format t "selected: year ~A month ~A day ~A~%"
+ (calendar-year calendar)
+ (calendar-month calendar)
+ (calendar-day calendar))))
+ (container-add window calendar)
+ (gtk-widget-show-all window)
+ (gtk-main)))
+
+(defun test-box-child-property ()
+ (let ((window (make-instance 'gtk-window :title "Text box child property" :type :toplevel :window-position :center :width-request 200 :height-request 200))
+ (box (make-instance 'h-box))
+ (button (make-instance 'toggle-button :active t :label "Expand")))
+ (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit)))
+ (g-signal-connect button "toggled" (lambda (b) (declare (ignore b)) (setf (box-child-expand box button) (toggle-button-active button))))
+ (container-add window box)
+ (box-pack-start box button)
+ (gtk-widget-show-all window)
(gtk-main)))
\ No newline at end of file
(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)))
--- /dev/null
+(in-package :gtk)
+(define-child-property "GtkAssistant" assistant-child-page-type "page-type"
+ "GtkAssistantPageType" t t t)
+
+(define-child-property "GtkAssistant" assistant-child-title "title"
+ "gchararray" t t t)
+
+(define-child-property "GtkAssistant" assistant-child-header-image
+ "header-image" "GdkPixbuf" t t t)
+
+(define-child-property "GtkAssistant" assistant-child-sidebar-image
+ "sidebar-image" "GdkPixbuf" t t t)
+
+(define-child-property "GtkAssistant" assistant-child-complete "complete"
+ "gboolean" t t t)
+
+(define-child-property "GtkMenu" menu-child-left-attach "left-attach" "gint" t
+ t t)
+
+(define-child-property "GtkMenu" menu-child-right-attach "right-attach" "gint"
+ t t t)
+
+(define-child-property "GtkMenu" menu-child-top-attach "top-attach" "gint" t t
+ t)
+
+(define-child-property "GtkMenu" menu-child-bottom-attach "bottom-attach"
+ "gint" t t t)
+
+(define-child-property "GtkRecentChooserMenu"
+ recent-chooser-menu-child-left-attach "left-attach"
+ "gint" t t t)
+
+(define-child-property "GtkRecentChooserMenu"
+ recent-chooser-menu-child-right-attach "right-attach"
+ "gint" t t t)
+
+(define-child-property "GtkRecentChooserMenu"
+ recent-chooser-menu-child-top-attach "top-attach" "gint"
+ t t t)
+
+(define-child-property "GtkRecentChooserMenu"
+ recent-chooser-menu-child-bottom-attach "bottom-attach"
+ "gint" t t t)
+
+(define-child-property "GtkNotebook" notebook-child-tab-label "tab-label"
+ "gchararray" t t t)
+
+(define-child-property "GtkNotebook" notebook-child-menu-label "menu-label"
+ "gchararray" t t t)
+
+(define-child-property "GtkNotebook" notebook-child-position "position" "gint"
+ t t t)
+
+(define-child-property "GtkNotebook" notebook-child-tab-expand "tab-expand"
+ "gboolean" t t t)
+
+(define-child-property "GtkNotebook" notebook-child-tab-fill "tab-fill"
+ "gboolean" t t t)
+
+(define-child-property "GtkNotebook" notebook-child-tab-pack "tab-pack"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkNotebook" notebook-child-reorderable "reorderable"
+ "gboolean" t t t)
+
+(define-child-property "GtkNotebook" notebook-child-detachable "detachable"
+ "gboolean" t t t)
+
+(define-child-property "GtkBox" box-child-expand "expand" "gboolean" t t t)
+
+(define-child-property "GtkBox" box-child-fill "fill" "gboolean" t t t)
+
+(define-child-property "GtkBox" box-child-padding "padding" "guint" t t t)
+
+(define-child-property "GtkBox" box-child-pack-type "pack-type" "GtkPackType" t
+ t t)
+
+(define-child-property "GtkBox" box-child-position "position" "gint" t t t)
+
+(define-child-property "GtkButtonBox" button-box-child-expand "expand"
+ "gboolean" t t t)
+
+(define-child-property "GtkButtonBox" button-box-child-fill "fill" "gboolean" t
+ t t)
+
+(define-child-property "GtkButtonBox" button-box-child-padding "padding"
+ "guint" t t t)
+
+(define-child-property "GtkButtonBox" button-box-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkButtonBox" button-box-child-position "position"
+ "gint" t t t)
+
+(define-child-property "GtkButtonBox" button-box-child-secondary "secondary"
+ "gboolean" t t t)
+
+(define-child-property "GtkHButtonBox" h-button-box-child-expand "expand"
+ "gboolean" t t t)
+
+(define-child-property "GtkHButtonBox" h-button-box-child-fill "fill"
+ "gboolean" t t t)
+
+(define-child-property "GtkHButtonBox" h-button-box-child-padding "padding"
+ "guint" t t t)
+
+(define-child-property "GtkHButtonBox" h-button-box-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkHButtonBox" h-button-box-child-position "position"
+ "gint" t t t)
+
+(define-child-property "GtkHButtonBox" h-button-box-child-secondary "secondary"
+ "gboolean" t t t)
+
+(define-child-property "GtkVButtonBox" v-button-box-child-expand "expand"
+ "gboolean" t t t)
+
+(define-child-property "GtkVButtonBox" v-button-box-child-fill "fill"
+ "gboolean" t t t)
+
+(define-child-property "GtkVButtonBox" v-button-box-child-padding "padding"
+ "guint" t t t)
+
+(define-child-property "GtkVButtonBox" v-button-box-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkVButtonBox" v-button-box-child-position "position"
+ "gint" t t t)
+
+(define-child-property "GtkVButtonBox" v-button-box-child-secondary "secondary"
+ "gboolean" t t t)
+
+(define-child-property "GtkVBox" v-box-child-expand "expand" "gboolean" t t t)
+
+(define-child-property "GtkVBox" v-box-child-fill "fill" "gboolean" t t t)
+
+(define-child-property "GtkVBox" v-box-child-padding "padding" "guint" t t t)
+
+(define-child-property "GtkVBox" v-box-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkVBox" v-box-child-position "position" "gint" t t t)
+
+(define-child-property "GtkColorSelection" color-selection-child-expand
+ "expand" "gboolean" t t t)
+
+(define-child-property "GtkColorSelection" color-selection-child-fill "fill"
+ "gboolean" t t t)
+
+(define-child-property "GtkColorSelection" color-selection-child-padding
+ "padding" "guint" t t t)
+
+(define-child-property "GtkColorSelection" color-selection-child-pack-type
+ "pack-type" "GtkPackType" t t t)
+
+(define-child-property "GtkColorSelection" color-selection-child-position
+ "position" "gint" t t t)
+
+(define-child-property "GtkFileChooserWidget" file-chooser-widget-child-expand
+ "expand" "gboolean" t t t)
+
+(define-child-property "GtkFileChooserWidget" file-chooser-widget-child-fill
+ "fill" "gboolean" t t t)
+
+(define-child-property "GtkFileChooserWidget" file-chooser-widget-child-padding
+ "padding" "guint" t t t)
+
+(define-child-property "GtkFileChooserWidget"
+ file-chooser-widget-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkFileChooserWidget"
+ file-chooser-widget-child-position "position" "gint" t t
+ t)
+
+(define-child-property "GtkFontSelection" font-selection-child-expand "expand"
+ "gboolean" t t t)
+
+(define-child-property "GtkFontSelection" font-selection-child-fill "fill"
+ "gboolean" t t t)
+
+(define-child-property "GtkFontSelection" font-selection-child-padding
+ "padding" "guint" t t t)
+
+(define-child-property "GtkFontSelection" font-selection-child-pack-type
+ "pack-type" "GtkPackType" t t t)
+
+(define-child-property "GtkFontSelection" font-selection-child-position
+ "position" "gint" t t t)
+
+(define-child-property "GtkGammaCurve" gamma-curve-child-expand "expand"
+ "gboolean" t t t)
+
+(define-child-property "GtkGammaCurve" gamma-curve-child-fill "fill" "gboolean"
+ t t t)
+
+(define-child-property "GtkGammaCurve" gamma-curve-child-padding "padding"
+ "guint" t t t)
+
+(define-child-property "GtkGammaCurve" gamma-curve-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkGammaCurve" gamma-curve-child-position "position"
+ "gint" t t t)
+
+(define-child-property "GtkRecentChooserWidget"
+ recent-chooser-widget-child-expand "expand" "gboolean" t
+ t t)
+
+(define-child-property "GtkRecentChooserWidget"
+ recent-chooser-widget-child-fill "fill" "gboolean" t t t)
+
+(define-child-property "GtkRecentChooserWidget"
+ recent-chooser-widget-child-padding "padding" "guint" t
+ t t)
+
+(define-child-property "GtkRecentChooserWidget"
+ recent-chooser-widget-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkRecentChooserWidget"
+ recent-chooser-widget-child-position "position" "gint" t
+ t t)
+
+(define-child-property "GtkHBox" h-box-child-expand "expand" "gboolean" t t t)
+
+(define-child-property "GtkHBox" h-box-child-fill "fill" "gboolean" t t t)
+
+(define-child-property "GtkHBox" h-box-child-padding "padding" "guint" t t t)
+
+(define-child-property "GtkHBox" h-box-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkHBox" h-box-child-position "position" "gint" t t t)
+
+(define-child-property "GtkFileChooserButton" file-chooser-button-child-expand
+ "expand" "gboolean" t t t)
+
+(define-child-property "GtkFileChooserButton" file-chooser-button-child-fill
+ "fill" "gboolean" t t t)
+
+(define-child-property "GtkFileChooserButton" file-chooser-button-child-padding
+ "padding" "guint" t t t)
+
+(define-child-property "GtkFileChooserButton"
+ file-chooser-button-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkFileChooserButton"
+ file-chooser-button-child-position "position" "gint" t t
+ t)
+
+(define-child-property "GtkStatusbar" statusbar-child-expand "expand"
+ "gboolean" t t t)
+
+(define-child-property "GtkStatusbar" statusbar-child-fill "fill" "gboolean" t
+ t t)
+
+(define-child-property "GtkStatusbar" statusbar-child-padding "padding" "guint"
+ t t t)
+
+(define-child-property "GtkStatusbar" statusbar-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkStatusbar" statusbar-child-position "position"
+ "gint" t t t)
+
+(define-child-property "GtkCombo" combo-child-expand "expand" "gboolean" t t t)
+
+(define-child-property "GtkCombo" combo-child-fill "fill" "gboolean" t t t)
+
+(define-child-property "GtkCombo" combo-child-padding "padding" "guint" t t t)
+
+(define-child-property "GtkCombo" combo-child-pack-type "pack-type"
+ "GtkPackType" t t t)
+
+(define-child-property "GtkCombo" combo-child-position "position" "gint" t t t)
+
+(define-child-property "GtkFixed" fixed-child-x "x" "gint" t t t)
+
+(define-child-property "GtkFixed" fixed-child-y "y" "gint" t t t)
+
+(define-child-property "GtkPaned" paned-child-resize "resize" "gboolean" t t t)
+
+(define-child-property "GtkPaned" paned-child-shrink "shrink" "gboolean" t t t)
+
+(define-child-property "GtkHPaned" h-paned-child-resize "resize" "gboolean" t t
+ t)
+
+(define-child-property "GtkHPaned" h-paned-child-shrink "shrink" "gboolean" t t
+ t)
+
+(define-child-property "GtkVPaned" v-paned-child-resize "resize" "gboolean" t t
+ t)
+
+(define-child-property "GtkVPaned" v-paned-child-shrink "shrink" "gboolean" t t
+ t)
+
+(define-child-property "GtkLayout" layout-child-x "x" "gint" t t t)
+
+(define-child-property "GtkLayout" layout-child-y "y" "gint" t t t)
+
+(define-child-property "GtkTable" table-child-left-attach "left-attach" "guint"
+ t t t)
+
+(define-child-property "GtkTable" table-child-right-attach "right-attach"
+ "guint" t t t)
+
+(define-child-property "GtkTable" table-child-top-attach "top-attach" "guint" t
+ t t)
+
+(define-child-property "GtkTable" table-child-bottom-attach "bottom-attach"
+ "guint" t t t)
+
+(define-child-property "GtkTable" table-child-x-options "x-options"
+ "GtkAttachOptions" t t t)
+
+(define-child-property "GtkTable" table-child-y-options "y-options"
+ "GtkAttachOptions" t t t)
+
+(define-child-property "GtkTable" table-child-x-padding "x-padding" "guint" t t
+ t)
+
+(define-child-property "GtkTable" table-child-y-padding "y-padding" "guint" t t
+ t)
+
+(define-child-property "GtkToolbar" toolbar-child-expand "expand" "gboolean" t
+ t t)
+
+(define-child-property "GtkToolbar" toolbar-child-homogeneous "homogeneous"
+ "gboolean" t 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)))
+ "detail-height-rows" "gint" t t)
+ (:cffi detail-function calendar-detail-function nil nil
+ calendar-set-detail-function)))
(define-g-object-class "GtkCellView" cell-view
(:superclass widget :export t :interfaces
--- /dev/null
+(in-package :gtk)
+
+(defcfun (fixed-put "gtk_fixed_put") :void
+ (fixed g-object)
+ (widget g-object)
+ (x :int)
+ (y :int))
+
+(export 'fixed-put)
+
+(defcfun (fixed-move "gtk_fixed_move") :void
+ (fixed g-object)
+ (widget g-object)
+ (x :int)
+ (y :int))
+
+(export 'fixed-move)
+
+(defcfun (layout-put "gtk_layout_put") :void
+ (layout g-object)
+ (widget g-object)
+ (x :int)
+ (y :int))
+
+(export 'layout-put)
+
+(defcfun (layout-move "gtk_layout_move") :void
+ (layout g-object)
+ (widget g-object)
+ (x :int)
+ (y :int))
+
+(export 'layout-move)
+
+(defcfun gtk-notebook-append-page :int
+ (notebook g-object)
+ (child g-object)
+ (tab-label g-object))
+
+(defcfun gtk-notebook-append-page-menu :int
+ (notebook g-object)
+ (child g-object)
+ (tab-label g-object)
+ (menu g-object))
+
+(defcfun gtk-notebook-prepend-page :int
+ (notebook g-object)
+ (child g-object)
+ (tab-label g-object))
+
+(defcfun gtk-notebook-prepend-page-menu :int
+ (notebook g-object)
+ (child g-object)
+ (tab-label g-object)
+ (menu g-object))
+
+(defcfun gtk-notebook-insert-page :int
+ (notebook g-object)
+ (child g-object)
+ (tab-label g-object)
+ (position :int))
+
+(defcfun gtk-notebook-insert-page-menu :int
+ (notebook g-object)
+ (child g-object)
+ (tab-label g-object)
+ (menu g-object)
+ (position :int))
+
+(defun notebook-add-page (notebook child tab-label &key (position :end) menu)
+ (assert (typep position '(or integer (member :start :end))))
+ (assert (typep menu '(or null g-object (member :default))))
+ (case position
+ (:end (if menu
+ (gtk-notebook-append-page-menu notebook child tab-label (if (eq menu :default) (null-pointer) menu))
+ (gtk-notebook-append-page notebook child tab-label)))
+ (:start (if menu
+ (gtk-notebook-prepend-page-menu notebook child tab-label (if (eq menu :default) (null-pointer) menu))
+ (gtk-notebook-prepend-page notebook child tab-label)))
+ (otherwise (if menu
+ (gtk-notebook-insert-page-menu notebook child tab-label (if (eq menu :default) (null-pointer) menu) position)
+ (gtk-notebook-insert-page notebook child tab-label position)))))
+
+(export 'notebook-add-page)
+
+(defcfun (notebook-remove-page "gtk_notebook_remove_page") :void
+ (notebook g-object)
+ (child g-object))
+
+(export 'notebook-remove-page)
+
+(defcfun (notebook-next-page "gtk_notebook_next_page") :void
+ (notebook g-object))
+
+(export 'notebook-next-page)
+
+(defcfun (notebook-prev-page "gtk_notebook_prev_page") :void
+ (notebook g-object))
+
+(export 'notebook-prev-page)
+
+(defcfun (notebook-reorder-child "gtk_notebook_reorder_child") :void
+ (notebook g-object)
+ (child g-object)
+ (position :int))
+
+(export 'notebook-reorder-child)
+
+(defcfun (notebook-menu-label-widget "gtk_notebook_get_menu_label") g-object
+ (notebook g-object)
+ (child g-object))
+
+(export 'notebook-menu-label-widget)
+
+(defcfun (notebook-nth-page "gtk_notebook_get_nth_page") g-object
+ (notebook g-object)
+ (page-num :int))
+
+(export 'notebook-nth-page)
+
+(defcfun (notebook-n-pages "gtk_notebook_get_n_pages") :int
+ (notebook g-object))
+
+(export 'notebook-n-pages)
+
+(defcfun (notebook-tab-label-widget "gtk_notebook_get_tab_label") g-object
+ (notebook g-object)
+ (child g-object))
+
+(export 'notebook-tab-label-widget)
+
+(defcfun gtk-notebook-set-menu-label-widget :void
+ (notebook g-object)
+ (child g-object)
+ (menu-label g-object))
+
+(defun (setf notebook-menu-label-widget) (new-value notebook child)
+ (gtk-notebook-set-menu-label-widget notebook child new-value)
+ new-value)
+
+(defcfun gtk-notebook-set-tab-label-widget :void
+ (notebook g-object)
+ (child g-object)
+ (tab-label g-object))
+
+(defun (setf notebook-tab-label-widget) (new-value notebook child)
+ (gtk-notebook-set-tab-label-widget notebook child new-value)
+ new-value)
+
+(defcallback gtk-notebook-window-creation-func-callback g-object
+ ((source g-object) (page g-object) (x :int) (y :int) (data :pointer))
+ (restart-case
+ (funcall (get-stable-pointer-value data)
+ source page x y)
+ (return-null () nil)))
+
+(defcfun gtk-notebook-set-window-creation-hook :void
+ (func :pointer)
+ (data :pointer)
+ (destroy-notify :pointer))
+
+(defun notebook-set-window-creation-hook (function)
+ (gtk-notebook-set-window-creation-hook (callback gtk-notebook-window-creation-func-callback)
+ (allocate-stable-pointer function)
+ (callback stable-pointer-free-destroy-notify-callback)))
+
+(export 'notebook-set-window-creation-hook)
+
+(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))
+
+(export 'table-attach)
+
+(defcfun (table-row-spacing-for-row "gtk_table_get_row_spacing") :uint
+ (table g-object)
+ (row :uint))
+
+(defcfun gtk-table-set-row-spacing :void
+ (table g-object)
+ (row :uint)
+ (spacing :uint))
+
+(defun (setf table-row-spacing-for-row) (new-value table row)
+ (gtk-table-set-row-spacing table row new-value))
+
+(export 'table-row-spacing-for-row)
+
+(defcfun (table-col-spacing-for-col "gtk_table_get_col_spacing") :uint
+ (table g-object)
+ (col :uint))
+
+(defcfun gtk-table-set-col-spacing :void
+ (table g-object)
+ (col :uint)
+ (spacing :uint))
+
+(defun (setf table-col-spacing-for-col) (new-value table col)
+ (gtk-table-set-col-spacing table col new-value))
+
+(export 'table-col-spacing-for-col)
\ No newline at end of file
#: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))
+ #:text-buffer-insert
+ #:define-child-property
+ #:container-class-child-properties
+ #:generate-child-properties))
(defpackage :gtk-examples
(:use :cl :gtk :gdk :gobject)
--- /dev/null
+(in-package :gtk)
+
+(defcfun gtk-paned-pack-1 :void
+ (paned g-object)
+ (child g-object)
+ (resize :boolean)
+ (shrink :boolean))
+
+(defun paned-pack-1 (paned child &key (resize nil) (shrink t))
+ (gtk-paned-pack-1 paned child resize shrink))
+
+(export 'panged-pack-1)
+
+(defcfun gtk-paned-pack-2 :void
+ (paned g-object)
+ (child g-object)
+ (resize :boolean)
+ (shrink :boolean))
+
+(defun paned-pack-2 (paned child &key (resize t) (shrink t))
+ (gtk-paned-pack-2 paned child resize shrink))
+
+(export 'paned-pack-2)
+
+(defcfun (paned-child-1 "gtk_paned_get_child1") g-object
+ (paned g-object))
+
+(defcfun (paned-child-2 "gtk_paned_get_child2") g-object
+ (paned g-object))
+
+(export 'paned-child-1)
+
+(export 'paned-child-2)
+
+; TODO: GtkScale, gtk_scale_get_layout_offsets
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+; TODO: Printing
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun (scrolled-window-add-with-viewport "gtk_scrolled_window_add_with_viewport") :void
+ (scrolled-window g-object)
+ (child g-object))
+
+(export 'scrolled-window-add-with-viewport)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun (size-group-add-widget "gtk_size_group_add_widget") :void
+ (size-group g-object)
+ (widget g-object))
+
+(export 'size-group-add-widget)
+
+(defcfun (size-group-remove-widget "gtk_size_group_remove_widget") :void
+ (size-group g-object)
+ (widget g-object))
+
+(export 'size-group-remove-widget)
+
+(defcfun (size-group-widgets "gtk_size_group_widgets") (gslist g-object :free-from-foreign nil)
+ (size-group g-object))
+
+(export 'size-group-widgets)
\ No newline at end of file
--- /dev/null
+(in-package :gtk)
+
+(defcfun gtk-tooltip-set-markup :void
+ (tooltip g-object)
+ (markup :string))
+
+(defun (setf tooltip-markup) (new-value tooltip)
+ (gtk-tooltip-set-markup tooltip new-value))
+
+(export 'tooltip-markup)
+
+(defcfun gtk-tooltip-set-text :void
+ (tooltip g-object)
+ (text :string))
+
+(defun (setf tooltip-text) (new-value tooltip)
+ (gtk-tooltip-set-text tooltip new-value))
+
+(export 'tooltip-text)
+
+(defcfun gtk-tooltip-set-icon :void
+ (tooltip g-object)
+ (pixbuf g-object))
+
+(defun (setf tooltip-icon) (new-value tooltip)
+ (gtk-tooltip-set-icon tooltip new-value))
+
+(export 'tooltip-icon)
+
+(defcfun (tooltip-set-icon-from-stock "gtk_tooltip_set_icon_from_stock") :void
+ (tooltip g-object)
+ (stock-id :string)
+ (icon-size icon-size))
+
+(export 'tooltip-set-icon-from-stock)
+
+(defcfun (tooltip-set-icon-from-icon-name "gtk_tooltip_set_icon_from_icon_name") :void
+ (tooltip g-object)
+ (icon-name :string)
+ (icon-size icon-size))
+
+(export 'tooltip-set-icon-from-icon-name)
+
+(defcfun (tooltip-set-custom "gtk_tooltip_set_custom") :void
+ (tooltip g-object)
+ (custom-widget g-object))
+
+(export 'tooltip-set-custom)
+
+(defcfun (tooltip-trigger-tooltip-query "gtk_tooltip_trigger_tooltip_query") :void
+ (display g-object))
+
+(export 'tooltip-trigger-tooltip-query)
+
+(defcfun (tooltip-set-tip-area "gtk_tooltip_set_tip_area") :void
+ (tooltip g-object)
+ (rectangle (g-boxed-ptr rectangle)))
+
+(export 'tooltip-set-tip-area)
\ No newline at end of file
(in-package :gtk)
+; TODO: GtkWidget
\ No newline at end of file
projects / cl-gtk2.git / commitdiff