suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gtk: make gl support optional and also clean up some unneeded unimplementeds

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-15 13:25:53 -06:00
parent c57c84721f
commit 27f18efa88
16 changed files with 37 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -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))))

8
collects/mred/private/wx/cocoa/frame.rkt
View File

@ -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?)

4
collects/mred/private/wx/cocoa/panel.rkt
View File

@ -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

11
collects/mred/private/wx/cocoa/window.rkt
View File

@ -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))))
;; ----------------------------------------

2
collects/mred/private/wx/gtk/canvas.rkt
View File

@ -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)

14
collects/mred/private/wx/gtk/frame.rkt
View File

@ -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)

16
collects/mred/private/wx/gtk/gl-context.rkt
View File

@ -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)

3
collects/mred/private/wx/gtk/menu.rkt
View File

@ -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])

4
collects/mred/private/wx/gtk/panel.rkt
View File

@ -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%)

10
collects/mred/private/wx/gtk/window.rkt
View File

@ -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))

2
collects/mred/private/wx/win32/canvas.rkt
View File

@ -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)

3
collects/mred/private/wx/win32/frame.rkt
View File

@ -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?))

4
collects/mred/private/wx/win32/panel.rkt
View File

@ -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%)

7
collects/mred/private/wx/win32/window.rkt
View File

@ -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))

6
collects/mred/private/wxme/editor-canvas.rkt
View File

@ -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)

8
collects/mred/private/wxpanel.rkt
View File

@ -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)