From: Dmitry Kalyanov Date: Wed, 18 Mar 2009 19:49:28 +0000 (+0300) Subject: fix function names in gtk.demo, add widget style properties X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9af0a44db2b9491749a7936c782c3d7ff1b804a3;p=cl-gtk2.git fix function names in gtk.demo, add widget style properties --- diff --git a/gtk/gtk.asd b/gtk/gtk.asd index 3046e3e..68fe66f 100644 --- a/gtk/gtk.asd +++ b/gtk/gtk.asd @@ -41,6 +41,9 @@ (:file "gtk.container") (:file "gtk.paned") (:file "gtk.child-properties") + (:file "gtk.widget") + (:file "gtk.builder") + (:file "gtk.generated-child-properties") diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp index 8a48107..bd7c519 100644 --- a/gtk/gtk.demo.lisp +++ b/gtk/gtk.demo.lisp @@ -34,7 +34,7 @@ (release widget) (setf x (event-motion-x event) y (event-motion-y event)) - (gtk-widget-queue-draw window))) + (widget-queue-draw window))) (g-signal-connect window "expose-event" (lambda (widget event) (declare (ignore event)) @@ -42,7 +42,7 @@ ;(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)))) + (layout (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) @@ -51,8 +51,8 @@ (lambda (widget event) (declare (ignore event)) (release widget) - (gtk-widget-queue-draw window))) - (gtk-widget-show-all window) + (widget-queue-draw window))) + (widget-show window) (push :pointer-motion-mask (gdk-window-events (widget-window window))) (gtk-main) (release window))) @@ -91,7 +91,7 @@ (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) + (widget-show window) (gtk-main))) (defun table-packing () @@ -106,7 +106,7 @@ (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) + (widget-show window) (gtk-main))) (defun test-pixbuf () @@ -121,7 +121,7 @@ (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) + (widget-show window) (gtk-main))) (defun test-image () @@ -129,7 +129,7 @@ (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) + (widget-show window) (gtk-main))) (defun test-progress-bar () @@ -149,7 +149,7 @@ (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) + (widget-show window) (gtk-main))) (defun test-status-bar () @@ -179,7 +179,7 @@ (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) + (widget-show window) (setf (status-icon-screen icon) (gtk-window-screen window)) (gtk-main))) @@ -188,7 +188,7 @@ (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) + (widget-show window) (gtk-main))) (defun test-text-view () @@ -235,7 +235,7 @@ (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) + (widget-show window) (gtk-main))) (defun demo-code-editor () @@ -246,7 +246,7 @@ (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) + (widget-show 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))))) @@ -304,7 +304,7 @@ (tree-view-append-column tv column) (print (tree-view-column-tree-view column)) (print (tree-view-column-cell-renderers column))) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-combo-box () @@ -346,7 +346,7 @@ (let ((renderer (make-instance 'cell-renderer-text :text "A number"))) (cell-layout-pack-start combo-box renderer :expand nil) (cell-layout-add-attribute combo-box renderer "text" 1)) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-ui-manager () @@ -382,7 +382,7 @@ (action-group-add-action action-group action)) (awhen (ui-manager-widget ui-manager "/toolbar1") (container-add window it)) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-color-button () @@ -391,7 +391,7 @@ (g-signal-connect window "destroy" (lambda (w) (release w) (gtk-main-quit))) (g-signal-connect button "color-set" (lambda (b) (release b) (format t "Chose color ~A~%" (color-button-color button)))) (container-add window button) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-color-selection () @@ -400,7 +400,7 @@ (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit))) (g-signal-connect selection "color-changed" (lambda (s) (declare (ignore s)) (unless (color-selection-adjusting-p selection) (format t "color: ~A~%" (color-selection-current-color selection))))) (container-add window selection) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-file-chooser () @@ -421,7 +421,7 @@ (container-add window v-box) (box-pack-start v-box button) (box-pack-start v-box b) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-font-chooser () @@ -432,7 +432,7 @@ (g-signal-connect button "font-set" (lambda (b) (declare (ignore b)) (format t "Chose font ~A~%" (font-button-font-name button)))) (container-add window v-box) (box-pack-start v-box button) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-notebook () @@ -447,11 +447,11 @@ (for tab-hbox = (make-instance 'h-box)) (box-pack-start tab-hbox tab-label) (box-pack-start tab-hbox tab-button) - (gtk-widget-show-all tab-hbox) + (widget-show tab-hbox) (notebook-add-page notebook page tab-hbox)) (container-add window expander) (container-add expander notebook) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun calendar-detail (calendar year month day) @@ -468,7 +468,7 @@ (calendar-month calendar) (calendar-day calendar)))) (container-add window calendar) - (gtk-widget-show-all window) + (widget-show window) (gtk-main))) (defun test-box-child-property () @@ -479,5 +479,5 @@ (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) + (widget-show window) (gtk-main))) \ No newline at end of file diff --git a/gtk/gtk.widget.lisp b/gtk/gtk.widget.lisp index 15336ff..0e5def4 100644 --- a/gtk/gtk.widget.lisp +++ b/gtk/gtk.widget.lisp @@ -386,9 +386,9 @@ (x :int) (y :int) (width :int) - (height :int) + (height :int)) -(export 'widget-queue-draw-area)) +(export 'widget-queue-draw-area) (defcfun (widget-reset-shapes "gtk_widget_reset_shapes") :void (widget g-object)) @@ -406,15 +406,61 @@ ; TOOD: gtk_widget_class_install_style_property_parser -; TODO: gtk_widget_class_find_style_property - ; TODO: gtk_widget_class_list_style_properties ; TODO: gtk_widget_region_intersect ; TODO: gtk_widget_send_expose -; TODO: gtk_widget_style_get_property +(defcfun gtk-widget-style-get-property :void + (widget g-object) + (property-name :string) + (value (:pointer g-value))) + +(defcfun gtk-widget-class-find-style-property (:pointer g-param-spec) + (class :pointer) + (property-name :string)) + +(defcfun gtk-widget-class-list-style-properties (:pointer (:pointer g-param-spec)) + (class :pointer) + (n-properties (:pointer :int))) + +(defun widget-class-get-style-properties (type) + (setf type (ensure-g-type type)) + (let ((class (g-type-class-ref type))) + (unwind-protect + (with-foreign-object (np :int) + (let ((specs (gtk-widget-class-list-style-properties class np))) + (unwind-protect + (loop + repeat (mem-ref np :int) + for i from 0 + for spec = (mem-aref specs :pointer i) + collect (parse-g-param-spec spec)) + (g-free specs)))) + (g-type-class-unref class)))) + +(export 'widget-class-get-style-properties) + +(defun widget-child-property-type (widget property-name) + (let* ((type (g-type-from-object widget)) + (class (g-type-class-ref type))) + (unwind-protect + (let ((g-param-spec (gtk-widget-class-find-style-property class property-name))) + (unless g-param-spec (error "Widget ~A has no style-property named '~A'" widget property-name)) + (foreign-slot-value g-param-spec 'gobject::g-param-spec 'gobject::value-type)) + (g-type-class-unref class)))) + +(defun widget-child-property-value (widget property-name &optional property-type) + (unless property-type (setf property-type (widget-child-property-type widget property-name))) + (setf property-type (ensure-g-type property-type)) + (with-foreign-object (gvalue 'g-value) + (g-value-zero gvalue) + (g-value-init gvalue property-type) + (prog1 (gtk-widget-style-get-property widget property-name gvalue) + (g-value-unset gvalue)))) + +(export 'widget-child-property-value) (defcfun (widget-child-focus "gtk_widget_child_focus") :boolean (widget g-object)