From 30b2c4d867ddc6393b182936a48f9e43e10c4995 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 15 Oct 2010 13:25:53 -0600 Subject: [PATCH] gtk: make gl support optional and also clean up some unneeded unimplementeds original commit: 27f18efa881c411614657a3ed93db51c0b2ac357 --- collects/mred/private/wx/cocoa/canvas.rkt | 2 -- collects/mred/private/wx/cocoa/frame.rkt | 8 ++------ collects/mred/private/wx/cocoa/panel.rkt | 4 +--- collects/mred/private/wx/cocoa/window.rkt | 11 +++-------- collects/mred/private/wx/gtk/canvas.rkt | 2 -- collects/mred/private/wx/gtk/frame.rkt | 14 +++++++++----- collects/mred/private/wx/gtk/gl-context.rkt | 16 ++++++++++------ collects/mred/private/wx/gtk/menu.rkt | 3 ++- collects/mred/private/wx/gtk/panel.rkt | 4 +--- collects/mred/private/wx/gtk/window.rkt | 10 ++-------- collects/mred/private/wx/win32/canvas.rkt | 2 -- collects/mred/private/wx/win32/frame.rkt | 3 +-- collects/mred/private/wx/win32/panel.rkt | 4 +--- collects/mred/private/wx/win32/window.rkt | 7 ------- collects/mred/private/wxme/editor-canvas.rkt | 6 ++++-- collects/mred/private/wxpanel.rkt | 8 +------- 16 files changed, 37 insertions(+), 67 deletions(-) diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index dabf6444..2e50cc5c 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -691,8 +691,6 @@ ;; Called in Cocoa event-handling mode in-menu-click?) - (def/public-unimplemented set-background-to-gray) - (define/public (scroll x y) (when (x . > . 0) (scroll-pos h-scroller (* x (scroll-range h-scroller)))) (when (y . > . 0) (scroll-pos v-scroller (* y (scroll-range v-scroller)))) diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index 7daf05d9..6f91dd18 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/collects/mred/private/wx/cocoa/frame.rkt @@ -468,9 +468,9 @@ (define/public (on-menu-click) (void)) (define/public (on-toolbar-click) (void)) - (def/public-unimplemented on-menu-command) + (define/public (on-menu-command c) (void)) (def/public-unimplemented on-mdi-activate) - (def/public-unimplemented on-close) + (define/public (on-close) #t) (define/public (designate-root-frame) (set! root-fake-frame this)) (def/public-unimplemented system-menu) @@ -479,10 +479,6 @@ (let ([b (tell cocoa standardWindowButton: #:type _NSInteger NSWindowCloseButton)]) (tellv b setDocumentEdited: #:type _BOOL on?))) - (define/public (create-status-line) (void)) - (define/public (set-status-text s) (void)) - (def/public-unimplemented status-line-exists?) - (define/public (is-maximized?) (tell #:type _BOOL cocoa isZoomed)) (define/public (maximize on?) diff --git a/collects/mred/private/wx/cocoa/panel.rkt b/collects/mred/private/wx/cocoa/panel.rkt index aad8308a..46047d2c 100644 --- a/collects/mred/private/wx/cocoa/panel.rkt +++ b/collects/mred/private/wx/cocoa/panel.rkt @@ -70,9 +70,7 @@ (super show on?) (fix-dc)) - (def/public-unimplemented on-paint) - (define/public (set-item-cursor x y) (void)) - (def/public-unimplemented get-item-cursor))) + (define/public (set-item-cursor x y) (void)))) (defclass panel% (panel-mixin window%) (init parent diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index 6a04a6e9..3ff8328f 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -643,8 +643,7 @@ (set! sticky-cursor? #f) (send (get-parent) end-no-cursor-rects)) - (def/public-unimplemented get-handle) - (def/public-unimplemented set-phantom-size) + (define/public (get-handle) (get-cocoa)) (define/public (popup-menu m x y) (send m do-popup (get-cocoa-content) x (flip-client y) @@ -652,7 +651,7 @@ (queue-window-event this thunk)))) (define/public (center a b) (void)) - (def/public-unimplemented refresh) + (define/public (refresh) (void)) (define/public (screen-to-client xb yb) (let ([p (tell #:type _NSPoint (get-cocoa-content) @@ -677,8 +676,6 @@ (set-box! xb (inexact->exact (floor (NSPoint-x p)))) (set-box! yb (inexact->exact (floor new-y)))))) - (def/public-unimplemented fit) - (define cursor-handle #f) (define sticky-cursor? #f) (define/public (set-cursor c) @@ -707,9 +704,7 @@ (define/public (can-be-responder?) #t) (define/public (on-color-change) - (send parent on-color-change)) - - (def/public-unimplemented centre))) + (send parent on-color-change)))) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index e41491ad..52a94297 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -525,8 +525,6 @@ (define/public (set-combo-text t) (void)) - (def/public-unimplemented set-background-to-gray) - (define/public (do-scroll direction) (if (is-auto-scroll?) (refresh-for-autoscroll) diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt index 74153f86..8b1522cf 100644 --- a/collects/mred/private/wx/gtk/frame.rkt +++ b/collects/mred/private/wx/gtk/frame.rkt @@ -183,7 +183,7 @@ (gtk_fixed_move panel-gtk child-gtk x y) (gtk_widget_set_size_request child-gtk w h)) - (define/public (on-close) (void)) + (define/public (on-close) #t) (define/public (set-menu-bar mb) (let ([mb-gtk (send mb get-gtk)]) @@ -357,11 +357,15 @@ (set-box! x (+ (unbox x) dx cdx)) (set-box! y (+ (unbox y) dy cdy)))) - (def/public-unimplemented on-toolbar-click) - (def/public-unimplemented on-menu-click) - (def/public-unimplemented on-menu-command) + (define/public (on-toolbar-click) (void)) + (define/public (on-menu-click) (void)) + + (define/public (on-menu-command c) (void)) + (def/public-unimplemented on-mdi-activate) - (def/public-unimplemented on-activate) + + (define/public (on-activate on?) (void)) + (def/public-unimplemented designate-root-frame) (def/public-unimplemented system-menu) diff --git a/collects/mred/private/wx/gtk/gl-context.rkt b/collects/mred/private/wx/gtk/gl-context.rkt index f4c213eb..7f0aae79 100644 --- a/collects/mred/private/wx/gtk/gl-context.rkt +++ b/collects/mred/private/wx/gtk/gl-context.rkt @@ -16,9 +16,11 @@ install-gl-context) (define gdkglext-lib - (ffi-lib "libgdkglext-x11-1.0" '("0"))) + (with-handlers ([exn:fail? (lambda (exn) #f)]) + (ffi-lib "libgdkglext-x11-1.0" '("0")))) (define gtkglext-lib - (ffi-lib "libgtkglext-x11-1.0" '("0"))) + (with-handlers ([exn:fail? (lambda (exn) #f)]) + (ffi-lib "libgtkglext-x11-1.0" '("0")))) (define-ffi-definer define-gdkglext gdkglext-lib #:default-make-fail make-not-available) @@ -34,9 +36,10 @@ (define-gdkglext gdk_gl_init (_fun (_ptr i _int) (_ptr i _pointer) -> _void) - #:fail void) + #:fail (lambda () void)) -(define-gtkglext gdk_gl_config_new (_fun (_list i _int) -> (_or-null _GdkGLConfig))) +(define-gtkglext gdk_gl_config_new (_fun (_list i _int) -> (_or-null _GdkGLConfig)) + #:fail (lambda () (lambda args #f))) (define-gtkglext gdk_gl_config_new_for_screen (_fun _GdkScreen (_list i _int) -> (_or-null _GdkGLConfig))) (define-gtk gtk_widget_get_screen (_fun _GtkWidget -> _GdkScreen)) @@ -47,9 +50,10 @@ _gboolean _int -> _gboolean) - #:fail (lambda args #f)) + #:fail (lambda () (lambda args #f))) -(define-gtkglext gtk_widget_get_gl_context (_fun _GtkWidget -> _GdkGLContext)) +(define-gtkglext gtk_widget_get_gl_context (_fun _GtkWidget -> _GdkGLContext) + #:fail (lambda () (lambda args #f))) (define-gtkglext gtk_widget_get_gl_window (_fun _GtkWidget -> _GdkGLDrawable)) (define-gdkglext gdk_gl_context_destroy (_fun _GdkGLContext -> _void) diff --git a/collects/mred/private/wx/gtk/menu.rkt b/collects/mred/private/wx/gtk/menu.rkt index 68d59b21..f7f4f973 100644 --- a/collects/mred/private/wx/gtk/menu.rkt +++ b/collects/mred/private/wx/gtk/menu.rkt @@ -219,7 +219,8 @@ (def/public-unimplemented set-title) (def/public-unimplemented set-help-string) - (def/public-unimplemented number) + + (define/public (number) (length items)) (define/private (find-gtk item) (for/or ([i items]) diff --git a/collects/mred/private/wx/gtk/panel.rkt b/collects/mred/private/wx/gtk/panel.rkt index 4947b465..e485751f 100644 --- a/collects/mred/private/wx/gtk/panel.rkt +++ b/collects/mred/private/wx/gtk/panel.rkt @@ -49,9 +49,7 @@ (cons child children) (remq child children)))))) - (def/public-unimplemented on-paint) - (define/public (set-item-cursor x y) (void)) - (def/public-unimplemented get-item-cursor))) + (define/public (set-item-cursor x y) (void)))) (define panel% (class (panel-mixin window%) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index 36ef33f2..855fbc2c 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -611,8 +611,7 @@ (define/public (on-drop-file path) (void)) - (def/public-unimplemented get-handle) - (def/public-unimplemented set-phantom-size) + (define/public (get-handle) (get-gtk)) (define/public (popup-menu m x y) (let ([gx (box x)] @@ -639,12 +638,7 @@ (define/public (get-client-delta) (values 0 0)) - (def/public-unimplemented get-position) - (def/public-unimplemented fit) - - (define/public (gets-focus?) #t) - - (def/public-unimplemented centre))) + (define/public (gets-focus?) #t))) (define (queue-window-event win thunk) (queue-event (send win get-eventspace) thunk)) diff --git a/collects/mred/private/wx/win32/canvas.rkt b/collects/mred/private/wx/win32/canvas.rkt index a5aabf12..a681d2f9 100644 --- a/collects/mred/private/wx/win32/canvas.rkt +++ b/collects/mred/private/wx/win32/canvas.rkt @@ -330,8 +330,6 @@ (define/override (get-virtual-v-pos) (GetScrollPos canvas-hwnd SB_VERT)) - (def/public-unimplemented set-background-to-gray) - (define/public (get-scroll-pos which) (GetScrollPos canvas-hwnd (if (eq? which 'vertical) SB_VERT SB_HORZ))) (define/public (get-scroll-range which) diff --git a/collects/mred/private/wx/win32/frame.rkt b/collects/mred/private/wx/win32/frame.rkt index 8bc64a74..bb2e852a 100644 --- a/collects/mred/private/wx/win32/frame.rkt +++ b/collects/mred/private/wx/win32/frame.rkt @@ -92,7 +92,6 @@ get-eventspace on-size get-size - get-position pre-on-char pre-on-event reset-cursor-in-child) @@ -226,7 +225,7 @@ (maximize #f)) (super set-size x y w h)) - (define/public (on-close) (void)) + (define/public (on-close) #t) (define/override (is-shown-to-root?) (is-shown?)) diff --git a/collects/mred/private/wx/win32/panel.rkt b/collects/mred/private/wx/win32/panel.rkt index 1a3ffbd5..1ed5ddd6 100644 --- a/collects/mred/private/wx/win32/panel.rkt +++ b/collects/mred/private/wx/win32/panel.rkt @@ -73,9 +73,7 @@ (define/public (get-label-position) lbl-pos) (define/public (set-label-position pos) (set! lbl-pos pos)) - (def/public-unimplemented on-paint) - (define/public (set-item-cursor x y) (void)) - (def/public-unimplemented get-item-cursor))) + (define/public (set-item-cursor x y) (void)))) (define panel% (class (panel-mixin window%) diff --git a/collects/mred/private/wx/win32/window.rkt b/collects/mred/private/wx/win32/window.rkt index f6771c81..2de9e475 100644 --- a/collects/mred/private/wx/win32/window.rkt +++ b/collects/mred/private/wx/win32/window.rkt @@ -245,8 +245,6 @@ (define/public (is-shown?) shown?) - (def/public-unimplemented set-phantom-size) - (define/public (paint-children) (void)) (define/public (get-x) @@ -365,10 +363,6 @@ (define/public (on-drop-file p) (void)) - (define/public (get-position x y) - (set-box! x (get-x)) - (set-box! y (get-y))) - (define/public (get-client-size w h) (let ([r (GetClientRect (get-client-hwnd))]) (set-box! w (- (RECT-right r) (RECT-left r))) @@ -418,7 +412,6 @@ (send parent not-focus-child v)) (define/public (gets-focus?) #f) - (def/public-unimplemented centre) (define/public (register-child child on?) (void)) diff --git a/collects/mred/private/wxme/editor-canvas.rkt b/collects/mred/private/wxme/editor-canvas.rkt index 17017ff9..55542210 100644 --- a/collects/mred/private/wxme/editor-canvas.rkt +++ b/collects/mred/private/wxme/editor-canvas.rkt @@ -808,8 +808,10 @@ (values 0 0 0 0 1 1) (when (not media) (let ([dc (get-dc)]) - (send dc set-background (get-canvas-background)) - (send dc clear)))))]) + (let ([bg (get-canvas-background)]) + (when bg + (send dc set-background bg) + (send dc clear)))))))]) (if (not (and (= scroll-width hnum-scrolls) (= scroll-height vnum-scrolls) diff --git a/collects/mred/private/wxpanel.rkt b/collects/mred/private/wxpanel.rkt index 74f7b396..29bd3e8c 100644 --- a/collects/mred/private/wxpanel.rkt +++ b/collects/mred/private/wxpanel.rkt @@ -419,14 +419,8 @@ (raise-mismatch-error 'container-redraw "result from place-children is not a list of 4-integer lists with the correct length: " l)) - (when hidden-child - ;; This goes with the hack for macos and macosx below - (send hidden-child set-phantom-size width height)) (panel-redraw children children-info (if hidden-child - (cons (list 0 0 width - (if (memq (system-type) '(macos macosx)) ;; Yucky hack - (child-info-y-min (car children-info)) - height)) + (cons (list 0 0 width height) (let ([dy (child-info-y-min (car children-info))]) (map (lambda (i) (list (+ (car i) tab-h-border)