diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index 5609d9d332..586e34cf0a 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -7,6 +7,7 @@ racket/draw/local "../common/backing-dc.rkt" "../../syntax.rkt" + "../../lock.rkt" "../common/event.rkt" "utils.rkt" "const.rkt" @@ -21,6 +22,15 @@ ;; ---------------------------------------- +(define-gobj g_object_freeze_notify (_fun _GtkWidget -> _void)) +(define-gobj g_object_thaw_notify (_fun _GtkWidget -> _void)) + +(define-gobj g_object_set_double (_fun _GtkWidget _string _double* (_pointer = #f) -> _void) + #:c-id g_object_set) +(define-gobj g_object_get_double (_fun _GtkWidget _string (r : (_ptr o _double)) (_pointer = #f) + -> _void -> r) + #:c-id g_object_get) + (define-gtk gtk_drawing_area_new (_fun -> _GtkWidget)) (define-gtk gtk_combo_box_entry_new_text (_fun -> _GtkWidget)) @@ -33,15 +43,47 @@ (define _GtkAdjustment _GtkWidget) ; no, actually a GtkObject (define-gtk gtk_adjustment_new (_fun _double* _double* _double* _double* _double* _double* -> _GtkAdjustment)) -(define-gtk gtk_adjustment_configure (_fun _GtkAdjustment _double* _double* _double* _double* _double* _double* -> _void)) +(define-gtk gtk_adjustment_configure (_fun _GtkAdjustment _double* _double* _double* _double* _double* _double* -> _void) + #:fail (lambda () + ;; This by-hand version doesn't produce quite the same notifications. + (lambda (gtk value lower upper step-inc page-inc page-size) + (as-entry + (lambda () + (g_object_freeze_notify gtk) + (g_object_set_double gtk "lower" lower) + (g_object_set_double gtk "upper" upper) + (g_object_set_double gtk "step-increment" step-inc) + (g_object_set_double gtk "page-increment" page-inc) + (g_object_set_double gtk "page-size" page-size) + (let ([value (max lower (min value (- upper page-size)))]) + (gtk_adjustment_set_value gtk value)) + (g_object_thaw_notify gtk)))))) (define-gtk gtk_adjustment_get_value (_fun _GtkAdjustment -> _double*)) (define-gtk gtk_adjustment_set_value (_fun _GtkAdjustment _double* -> _void)) -(define-gtk gtk_adjustment_get_upper (_fun _GtkAdjustment -> _double*)) -(define-gtk gtk_adjustment_set_upper (_fun _GtkAdjustment _double* -> _void)) -(define-gtk gtk_adjustment_get_page_size (_fun _GtkAdjustment -> _double*)) -(define-gtk gtk_adjustment_set_page_size (_fun _GtkAdjustment _double* -> _void)) -(define-gtk gtk_adjustment_get_page_increment (_fun _GtkAdjustment -> _double*)) -(define-gtk gtk_adjustment_set_page_increment (_fun _GtkAdjustment _double* -> _void)) +(define-gtk gtk_adjustment_get_upper (_fun _GtkAdjustment -> _double*) + #:fail (lambda () + (lambda (gtk) + (g_object_get_double gtk "upper")))) +(define-gtk gtk_adjustment_set_upper (_fun _GtkAdjustment _double* -> _void) + #:fail (lambda () + (lambda (gtk upper) + (g_object_set_double gtk "upper" upper)))) +(define-gtk gtk_adjustment_get_page_size (_fun _GtkAdjustment -> _double*) + #:fail (lambda () + (lambda (gtk) + (g_object_get_double gtk "page-size")))) +(define-gtk gtk_adjustment_set_page_size (_fun _GtkAdjustment _double* -> _void) + #:fail (lambda () + (lambda (gtk page-size) + (g_object_set_double gtk "page-size" page-size)))) +(define-gtk gtk_adjustment_get_page_increment (_fun _GtkAdjustment -> _double*) + #:fail (lambda () + (lambda (gtk) + (g_object_get_double gtk "page-increment")))) +(define-gtk gtk_adjustment_set_page_increment (_fun _GtkAdjustment _double* -> _void) + #:fail (lambda () + (lambda (gtk page-inc) + (g_object_set_double gtk "page-increment" page-inc)))) (define-gtk gtk_container_remove (_fun _GtkWidget _GtkWidget -> _void)) (define-gtk gtk_bin_get_child (_fun _GtkWidget -> _GtkWidget)) @@ -69,7 +111,7 @@ (define-gdk gdk_window_get_children (_fun _pointer -> _GList-pointer/null)) (define-gdk gdk_window_hide (_fun _pointer -> _void)) (define (get-subwindow gtk) - (let* ([win (g_object_get_window gtk)] + (let* ([win (widget-window gtk)] [subs (gdk_window_get_children win)]) (if subs (GList-data subs) @@ -91,14 +133,14 @@ (unless (send wx paint-or-queue-paint) (let ([gc (send wx get-canvas-background-for-clearing)]) (when gc - (gdk_draw_rectangle (g_object_get_window gtk) gc #t + (gdk_draw_rectangle (widget-window gtk) gc #t 0 0 32000 32000))))) #t)) (define-signal-handler connect-expose-border "expose-event" (_fun _GtkWidget _GdkEventExpose-pointer -> _gboolean) (lambda (gtk event) - (let* ([win (g_object_get_window gtk)] + (let* ([win (widget-window gtk)] [gc (gdk_gc_new win)] [gray #x8000]) (when gc @@ -292,7 +334,7 @@ (define/public (paint-or-queue-paint) (or (do-backing-flush this dc (if is-combo? (get-subwindow client-gtk) - (g_object_get_window client-gtk))) + (widget-window client-gtk))) (begin (queue-paint) #f))) @@ -446,7 +488,7 @@ (if clear-bg? (let ([conv (lambda (x) (bitwise-ior x (arithmetic-shift x 8)))]) (unless gc - (let ([w (g_object_get_window gtk)]) + (let ([w (widget-window gtk)]) (set! gc (gdk_gc_new w)))) (gdk_gc_set_rgb_fg_color gc (make-GdkColor 0 (conv (color-red bg-col)) diff --git a/collects/mred/private/wx/gtk/clipboard.rkt b/collects/mred/private/wx/gtk/clipboard.rkt index c2f0e3e8a3..075890b98f 100644 --- a/collects/mred/private/wx/gtk/clipboard.rkt +++ b/collects/mred/private/wx/gtk/clipboard.rkt @@ -19,6 +19,18 @@ (define _GtkDisplay _pointer) (define _GtkSelectionData (_cpointer 'GtkSelectionData)) +;; Recent versions of Gtk provide function calls to +;; access data, but use structure when the functions are +;; not available +(define-cstruct _GtkSelectionDataT ([selection _GdkAtom] + [target _GdkAtom] + [type _GdkAtom] + [format _int] + [data _pointer] + [length _int] + [display _GtkDisplay])) + + (define-gdk gdk_atom_intern (_fun _string _gboolean -> _GdkAtom)) (define-gtk gtk_clipboard_get (_fun _GdkAtom -> _GtkClipboard)) @@ -34,8 +46,10 @@ -> _void)) (define-gtk gtk_clipboard_wait_for_contents (_fun _GtkClipboard _GdkAtom -> (_or-null _GtkSelectionData))) (define-gtk gtk_selection_data_free (_fun _GtkSelectionData -> _void)) -(define-gtk gtk_selection_data_get_length (_fun _GtkSelectionData -> _int)) -(define-gtk gtk_selection_data_get_data (_fun _GtkSelectionData -> _pointer)) +(define-gtk gtk_selection_data_get_length (_fun _GtkSelectionData -> _int) + #:fail (lambda () GtkSelectionDataT-length)) +(define-gtk gtk_selection_data_get_data (_fun _GtkSelectionData -> _pointer) + #:fail (lambda () GtkSelectionDataT-data)) (define-gtk gtk_clipboard_wait_for_text (_fun _GtkClipboard -> _string)) (define-cstruct _GtkTargetEntry ([target _pointer] diff --git a/collects/mred/private/wx/gtk/menu.rkt b/collects/mred/private/wx/gtk/menu.rkt index 4e2232b606..d3ef2afd87 100644 --- a/collects/mred/private/wx/gtk/menu.rkt +++ b/collects/mred/private/wx/gtk/menu.rkt @@ -21,7 +21,6 @@ (define-gtk gtk_accel_map_add_entry (_fun _string _uint _int -> _void)) (define-gtk gtk_check_menu_item_set_active (_fun _GtkWidget _gboolean -> _void)) (define-gtk gtk_check_menu_item_get_active (_fun _GtkWidget -> _gboolean)) -(define-gtk gtk_menu_item_set_label (_fun _GtkWidget _string -> _void)) (define-gtk gtk_container_remove (_fun _GtkWidget _GtkWidget -> _void)) (define-gtk gtk_label_set_text_with_mnemonic (_fun _GtkWidget _string -> _void)) (define-gtk gtk_bin_get_child (_fun _GtkWidget -> _GtkWidget)) diff --git a/collects/mred/private/wx/gtk/utils.rkt b/collects/mred/private/wx/gtk/utils.rkt index 6e4c466444..43435a2de4 100644 --- a/collects/mred/private/wx/gtk/utils.rkt +++ b/collects/mred/private/wx/gtk/utils.rkt @@ -30,7 +30,10 @@ get-gtk-object-flags set-gtk-object-flags! - define-signal-handler) + define-signal-handler + + ;; for declaring derived structures: + _GtkObject) (define gdk-lib (case (system-type) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index c3b726d6c0..1bf5c8b2be 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -32,7 +32,9 @@ do-button-event (struct-out GtkRequisition) _GtkRequisition-pointer - (struct-out GtkAllocation) _GtkAllocation-pointer) + (struct-out GtkAllocation) _GtkAllocation-pointer + + widget-window) ;; ---------------------------------------- @@ -58,6 +60,20 @@ (define-gtk gtk_widget_is_focus (_fun _GtkWidget -> _gboolean)) (define-gtk gtk_widget_set_sensitive (_fun _GtkWidget _gboolean -> _void)) +(define-cstruct _GtkWidgetT ([obj _GtkObject] + [private_flags _uint16] + [state _byte] + [saved_state _byte] + [name _pointer] + [style _pointer] + [req _GtkRequisition] + [alloc _GtkAllocation] + [window _GdkWindow] + [parent _GtkWidget])) + +(define (widget-window gtk) + (GtkWidgetT-window (cast gtk _GtkWidget _GtkWidgetT-pointer))) + ;; ---------------------------------------- (define-signal-handler connect-focus-in "focus-in-event"