From c14bee176f735cb203c25cda3481b9a7d85dcd3b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 27 Oct 2010 05:23:18 -0600 Subject: [PATCH] clean up original commit: d7f1d12ea1c16d5ed062a8ac8fe2fe47db267f15 --- collects/framework/private/preferences.rkt | 28 +- collects/mred/mred-sig.rkt | 3 - collects/mred/mred.rkt | 3 - collects/mred/private/syntax.rkt | 300 +----------------- collects/mred/private/wx/cocoa/README.txt | 3 +- collects/mred/private/wx/cocoa/button.rkt | 17 +- collects/mred/private/wx/cocoa/canvas.rkt | 8 +- collects/mred/private/wx/cocoa/cg.rkt | 2 +- collects/mred/private/wx/cocoa/check-box.rkt | 13 +- collects/mred/private/wx/cocoa/choice.rkt | 13 +- collects/mred/private/wx/cocoa/clipboard.rkt | 11 +- .../mred/private/wx/cocoa/colordialog.rkt | 5 +- collects/mred/private/wx/cocoa/const.rkt | 2 +- collects/mred/private/wx/cocoa/cursor.rkt | 7 +- collects/mred/private/wx/cocoa/dc.rkt | 14 +- collects/mred/private/wx/cocoa/dialog.rkt | 7 +- collects/mred/private/wx/cocoa/filedialog.rkt | 3 +- collects/mred/private/wx/cocoa/finfo.rkt | 3 +- collects/mred/private/wx/cocoa/font.rkt | 3 +- collects/mred/private/wx/cocoa/frame.rkt | 9 +- collects/mred/private/wx/cocoa/gauge.rkt | 13 +- collects/mred/private/wx/cocoa/gc.rkt | 7 +- .../mred/private/wx/cocoa/group-panel.rkt | 13 +- collects/mred/private/wx/cocoa/image.rkt | 11 +- collects/mred/private/wx/cocoa/init.rkt | 2 +- collects/mred/private/wx/cocoa/item.rkt | 15 +- collects/mred/private/wx/cocoa/keycode.rkt | 2 +- collects/mred/private/wx/cocoa/list-box.rkt | 13 +- collects/mred/private/wx/cocoa/menu-bar.rkt | 7 +- collects/mred/private/wx/cocoa/menu-item.rkt | 5 +- collects/mred/private/wx/cocoa/menu.rkt | 3 +- collects/mred/private/wx/cocoa/message.rkt | 15 +- collects/mred/private/wx/cocoa/panel.rkt | 15 +- collects/mred/private/wx/cocoa/platform.rkt | 5 +- collects/mred/private/wx/cocoa/pool.rkt | 5 +- collects/mred/private/wx/cocoa/printer-dc.rkt | 20 +- collects/mred/private/wx/cocoa/procs.rkt | 76 ++--- collects/mred/private/wx/cocoa/queue.rkt | 32 +- collects/mred/private/wx/cocoa/radio-box.rkt | 13 +- collects/mred/private/wx/cocoa/slider.rkt | 13 +- collects/mred/private/wx/cocoa/sound.rkt | 3 +- collects/mred/private/wx/cocoa/tab-panel.rkt | 3 +- collects/mred/private/wx/cocoa/types.rkt | 27 +- collects/mred/private/wx/cocoa/utils.rkt | 35 +- collects/mred/private/wx/cocoa/window.rkt | 33 +- .../mred/private/wx/common/backing-dc.rkt | 42 +-- .../mred/private/wx/common/canvas-mixin.rkt | 7 +- collects/mred/private/wx/common/clipboard.rkt | 9 +- .../mred/private/wx/common/default-procs.rkt | 2 +- collects/mred/private/wx/common/delay.rkt | 5 +- collects/mred/private/wx/common/dialog.rkt | 2 +- collects/mred/private/wx/common/event.rkt | 4 +- collects/mred/private/wx/common/freeze.rkt | 7 +- collects/mred/private/wx/common/handlers.rkt | 13 +- collects/mred/private/wx/common/local.rkt | 6 +- collects/mred/private/wx/common/once.rkt | 2 +- collects/mred/private/wx/common/procs.rkt | 2 +- collects/mred/private/wx/common/queue.rkt | 77 ++--- collects/mred/private/wx/common/rbtree.rkt | 6 +- collects/mred/private/wx/common/timer.rkt | 4 +- collects/mred/private/wx/common/utils.rkt | 2 +- collects/mred/private/wx/gtk/button.rkt | 12 +- collects/mred/private/wx/gtk/canvas.rkt | 7 +- collects/mred/private/wx/gtk/check-box.rkt | 10 +- collects/mred/private/wx/gtk/choice.rkt | 10 +- .../mred/private/wx/gtk/client-window.rkt | 10 +- collects/mred/private/wx/gtk/clipboard.rkt | 13 +- collects/mred/private/wx/gtk/colordialog.rkt | 5 +- collects/mred/private/wx/gtk/combo.rkt | 12 +- collects/mred/private/wx/gtk/const.rkt | 2 +- collects/mred/private/wx/gtk/cursor.rkt | 7 +- collects/mred/private/wx/gtk/dc.rkt | 15 +- collects/mred/private/wx/gtk/dialog.rkt | 7 +- collects/mred/private/wx/gtk/filedialog.rkt | 3 +- collects/mred/private/wx/gtk/frame.rkt | 11 +- collects/mred/private/wx/gtk/gauge.rkt | 10 +- collects/mred/private/wx/gtk/gcwin.rkt | 11 +- collects/mred/private/wx/gtk/gl-context.rkt | 15 +- collects/mred/private/wx/gtk/group-panel.rkt | 10 +- collects/mred/private/wx/gtk/init.rkt | 9 +- collects/mred/private/wx/gtk/item.rkt | 7 +- collects/mred/private/wx/gtk/keycode.rkt | 2 +- collects/mred/private/wx/gtk/keymap.rkt | 3 +- collects/mred/private/wx/gtk/list-box.rkt | 7 +- collects/mred/private/wx/gtk/menu-bar.rkt | 16 +- collects/mred/private/wx/gtk/menu-item.rkt | 7 +- collects/mred/private/wx/gtk/menu.rkt | 10 +- collects/mred/private/wx/gtk/message.rkt | 18 +- collects/mred/private/wx/gtk/panel.rkt | 9 +- collects/mred/private/wx/gtk/pixbuf.rkt | 21 +- collects/mred/private/wx/gtk/platform.rkt | 8 +- collects/mred/private/wx/gtk/printer-dc.rkt | 19 +- collects/mred/private/wx/gtk/procs.rkt | 73 ++--- collects/mred/private/wx/gtk/queue.rkt | 9 +- collects/mred/private/wx/gtk/radio-box.rkt | 10 +- collects/mred/private/wx/gtk/slider.rkt | 10 +- collects/mred/private/wx/gtk/stddialog.rkt | 5 +- collects/mred/private/wx/gtk/style.rkt | 5 +- collects/mred/private/wx/gtk/tab-panel.rkt | 10 +- collects/mred/private/wx/gtk/types.rkt | 58 ++-- collects/mred/private/wx/gtk/unique.rkt | 5 +- collects/mred/private/wx/gtk/utils.rkt | 61 ++-- collects/mred/private/wx/gtk/widget.rkt | 19 +- collects/mred/private/wx/gtk/window.rkt | 55 ++-- collects/mred/private/wx/gtk/x11.rkt | 13 +- collects/mred/private/wx/platform.rkt | 9 +- collects/mred/private/wx/win32/button.rkt | 5 +- collects/mred/private/wx/win32/canvas.rkt | 3 +- collects/mred/private/wx/win32/check-box.rkt | 3 +- collects/mred/private/wx/win32/choice.rkt | 3 +- collects/mred/private/wx/win32/clipboard.rkt | 7 +- .../mred/private/wx/win32/colordialog.rkt | 5 +- collects/mred/private/wx/win32/const.rkt | 2 +- collects/mred/private/wx/win32/cursor.rkt | 7 +- collects/mred/private/wx/win32/dc.rkt | 19 +- collects/mred/private/wx/win32/filedialog.rkt | 3 +- collects/mred/private/wx/win32/font.rkt | 9 +- collects/mred/private/wx/win32/frame.rkt | 7 +- collects/mred/private/wx/win32/gauge.rkt | 3 +- collects/mred/private/wx/win32/gcwin.rkt | 11 +- collects/mred/private/wx/win32/gl-context.rkt | 7 +- .../mred/private/wx/win32/group-panel.rkt | 3 +- collects/mred/private/wx/win32/hbitmap.rkt | 11 +- collects/mred/private/wx/win32/item.rkt | 5 +- collects/mred/private/wx/win32/key.rkt | 5 +- collects/mred/private/wx/win32/list-box.rkt | 3 +- collects/mred/private/wx/win32/menu-bar.rkt | 3 +- collects/mred/private/wx/win32/menu-item.rkt | 7 +- collects/mred/private/wx/win32/menu.rkt | 7 +- collects/mred/private/wx/win32/message.rkt | 3 +- collects/mred/private/wx/win32/panel.rkt | 5 +- collects/mred/private/wx/win32/platform.rkt | 7 +- collects/mred/private/wx/win32/printer-dc.rkt | 17 +- collects/mred/private/wx/win32/procs.rkt | 72 ++--- collects/mred/private/wx/win32/queue.rkt | 2 +- collects/mred/private/wx/win32/radio-box.rkt | 5 +- collects/mred/private/wx/win32/slider.rkt | 3 +- collects/mred/private/wx/win32/sound.rkt | 3 +- collects/mred/private/wx/win32/tab-panel.rkt | 3 +- collects/mred/private/wx/win32/theme.rkt | 21 +- collects/mred/private/wx/win32/types.rkt | 81 ++--- collects/mred/private/wx/win32/utils.rkt | 73 ++--- collects/mred/private/wx/win32/window.rkt | 15 +- collects/mred/private/wx/win32/wndclass.rkt | 23 +- collects/scribblings/gui/miscwin-funcs.scrbl | 147 --------- doc/release-notes/racket/Draw_and_GUI_5_5.txt | 3 + 146 files changed, 937 insertions(+), 1362 deletions(-) diff --git a/collects/framework/private/preferences.rkt b/collects/framework/private/preferences.rkt index 75b8aae3..505fccaa 100644 --- a/collects/framework/private/preferences.rkt +++ b/collects/framework/private/preferences.rkt @@ -530,18 +530,7 @@ the state transitions / contracts are: (cond [(string? default) string?] [(number? default) number?] - [else (error 'internal-error.set-default "unrecognized default: ~a\n" default)])) - (preferences:add-callback - name - (λ (p new-value) - (write-resource - font-section - font-entry - (if (and (string? new-value) - (string=? font-default-string new-value)) - "" - new-value) - font-file))))))]) + [else (error 'internal-error.set-default "unrecognized default: ~a\n" default)])))))]) (for-each (set-default build-font-entry font-default-string string?) font-families) @@ -579,14 +568,7 @@ the state transitions / contracts are: [message (make-object message% (let ([b (box "")]) - (if (and (get-resource - font-section - (build-font-entry name) - b) - (not (string=? (unbox b) - ""))) - (unbox b) - font-default-string)) + font-default-string) horiz)] [button (make-object button% @@ -643,11 +625,7 @@ the state transitions / contracts are: [size-panel (make-object horizontal-panel% main '(border))] [initial-font-size (let ([b (box 0)]) - (if (get-resource font-section - font-size-entry - b) - (unbox b) - font-default-size))] + font-default-size)] [size-slider (make-object slider% (string-constant font-size-slider-label) diff --git a/collects/mred/mred-sig.rkt b/collects/mred/mred-sig.rkt index 53b52e26..47e3727f 100644 --- a/collects/mred/mred-sig.rkt +++ b/collects/mred/mred-sig.rkt @@ -93,7 +93,6 @@ get-panel-background get-ps-setup-from-user get-highlight-background-color get-highlight-text-color -get-resource get-text-from-user get-the-editor-data-class-list get-the-snip-class-list @@ -164,7 +163,6 @@ region% register-collecting-blit scroll-event% selectable-menu-item<%> -send-event send-message-to-window separator-menu-item% sleep/yield @@ -207,5 +205,4 @@ window<%> write-editor-global-footer write-editor-global-header write-editor-version -write-resource yield diff --git a/collects/mred/mred.rkt b/collects/mred/mred.rkt index 59f6dcbf..f9aa0393 100644 --- a/collects/mred/mred.rkt +++ b/collects/mred/mred.rkt @@ -130,7 +130,6 @@ font-name-directory<%> get-highlight-background-color get-highlight-text-color - get-resource get-the-editor-data-class-list get-the-snip-class-list image-snip% @@ -175,12 +174,10 @@ write-editor-global-footer write-editor-global-header write-editor-version - write-resource queue-callback yield eventspace-shutdown? get-panel-background - send-event gl-context<%> gl-config% diff --git a/collects/mred/private/syntax.rkt b/collects/mred/private/syntax.rkt index b4cc868a..431e1a26 100644 --- a/collects/mred/private/syntax.rkt +++ b/collects/mred/private/syntax.rkt @@ -1,299 +1,3 @@ #lang scheme/base -(require scheme/class - scheme/stxparam - (for-syntax scheme/base)) - -(provide defclass defclass* - def/public def/public-final def/override def/override-final define/top case-args - def/public-unimplemented define-unimplemented - maybe-box? any? bool? nonnegative-real? make-or-false make-box make-list make-alts - make-literal symbol-in integer-in real-in make-procedure - method-name init-name - let-boxes - properties field-properties init-properties - ->long - assert) - -(define-syntax-parameter class-name #f) - -(define-syntax-rule (defclass name super . body) - (defclass* name super () . body)) -(define-syntax-rule (defclass* name super intfs . body) - (define name - (syntax-parameterize ([class-name 'name]) - (class* super intfs . body)))) - -(define-syntax (def/public stx) - #`(def/thing define/public #,stx)) -(define-syntax (def/public-final stx) - #`(def/thing define/public-final #,stx)) -(define-syntax (def/override stx) - #`(def/thing define/override #,stx)) -(define-syntax (def/override-final stx) - #`(def/thing define/override-final #,stx)) -(define-syntax (define/top stx) - #`(def/thing define #,stx)) - -(define (method-name class method) - (string->symbol (format "~a in ~a" method class))) -(define (init-name class) - (string->symbol (format "initialization for ~a" class))) - -(define-syntax just-id - (syntax-rules () - [(_ [id default]) id] - [(_ id) id])) - -(define-struct named-pred (pred make-name) - #:property prop:procedure (struct-field-index pred)) - -(define (apply-pred pred val) - (cond - [(procedure? pred) (pred val)] - [(class? pred) (val . is-a? . pred)] - [(interface? pred) (val . is-a? . pred)] - [else (error 'check-arg "unknown predicate type: ~e" pred)])) - -(define (make-or-false pred) - (make-named-pred (lambda (v) - (or (not v) (apply-pred pred v))) - (lambda () - (string-append (predicate-name pred) - " or #f")))) - -(define (make-box pred) - (make-named-pred (lambda (v) - (and (box? v) (apply-pred pred (unbox v)))) - (lambda () - (string-append "boxed " (predicate-name pred))))) - -(define (make-list pred) - (make-named-pred (lambda (v) - (and (list? v) (andmap (lambda (v) (apply-pred pred v)) v))) - (lambda () - (string-append "list of " (predicate-name pred))))) - -(define (make-alts a b) - (make-named-pred (lambda (v) - (or (apply-pred a v) (apply-pred b v))) - (lambda () - (string-append (predicate-name a) - " or " - (predicate-name b))))) - -(define (make-literal lit) - (make-named-pred (lambda (v) (equal? v lit)) - (lambda () (if (symbol? lit) - (format "'~s" lit) - (format "~s" lit))))) - -(define (make-symbol syms) - (make-named-pred (lambda (v) (memq v syms)) - (lambda () - (let loop ([syms syms]) - (cond - [(null? (cdr syms)) - (format "'~s" (car syms))] - [(null? (cddr syms)) - (format "'~s, or '~s" (car syms) (cadr syms))] - [else - (format "'~s, ~a" (car syms) (loop (cdr syms)))]))))) -(define-syntax-rule (symbol-in sym ...) - (make-symbol '(sym ...))) - -(define (integer-in lo hi) - (make-named-pred (lambda (v) (and (exact-integer? v) - (<= lo v hi))) - (lambda () - (format "exact integer in [~a, ~a]" lo hi)))) -(define (real-in lo hi) - (make-named-pred (lambda (v) (and (real? v) - (<= lo v hi))) - (lambda () - (format "real in [~a, ~a]" lo hi)))) - -(define (make-procedure arity) - (make-named-pred (lambda (p) - (and (procedure? p) - (procedure-arity-includes? p arity))) - (lambda () - (format "procedure (arity ~a)" arity)))) - -(define (check-arg val pred pos) - (if (apply-pred pred val) - #f - (cons (predicate-name pred) - pos))) - -(define (predicate-name pred) - (cond - [(named-pred? pred) ((named-pred-make-name pred))] - [(procedure? pred) (let ([s (symbol->string (object-name pred))]) - (substring s 0 (sub1 (string-length s))))] - [(or (class? pred) (interface? pred)) - (format "~a instance" (object-name pred))] - [else "???"])) - -(define maybe-box? (make-named-pred (lambda (v) (or (not v) (box? v))) - (lambda () "box or #f"))) -(define (any? v) #t) -(define (bool? v) #t) -(define (nonnegative-real? v) (and (real? v) (v . >= . 0))) - -(define (method-of cls nam) - (if cls - (string->symbol (format "~a method of ~a" nam cls)) - nam)) - -(define-syntax (def/thing stx) - (syntax-case stx () - [(_ define/orig (_ (id [arg-type arg] ...))) - (raise-syntax-error #f "missing body" stx)] - [(_ define/orig (_ (id [arg-type arg] ...) . body)) - (with-syntax ([(_ _ orig-stx) stx] - [(pos ...) (for/list ([i (in-range (length (syntax->list #'(arg ...))))]) - i)] - [cname (syntax-parameter-value #'class-name)]) - (syntax/loc #'orig-stx - (define/orig (id arg ...) - (let ([bad (or (check-arg (just-id arg) arg-type pos) - ...)]) - (when bad - (raise-type-error (method-of 'cname 'id) (car bad) (cdr bad) (just-id arg) ...))) - (let () - . body))))])) - -(define-for-syntax lifted (make-hash)) -(define-syntax (lift-predicate stx) - (syntax-case stx () - [(_ id) (identifier? #'id) #'id] - [(_ expr) - (let ([d (syntax->datum #'expr)]) - (or (hash-ref lifted d #f) - (let ([id (syntax-local-lift-expression #'expr)]) - (hash-set! lifted d id) - id)))])) - -(define-syntax (case-args stx) - (syntax-case stx () - [(_ expr [([arg-type arg] ...) rhs ...] ... who) - (with-syntax ([((min-args-len . max-args-len) ...) - (map (lambda (args) - (let ([args (syntax->list args)]) - (cons (let loop ([args args]) - (if (or (null? args) - (not (identifier? (car args)))) - 0 - (add1 (loop (cdr args))))) - (length args)))) - (syntax->list #'((arg ...) ...)))]) - #'(let* ([args expr] - [len (length args)]) - (find-match - (lambda (next) - (if (and (len . >= . min-args-len) - (len . <= . max-args-len)) - (apply - (lambda (arg ...) - (if (and (not (check-arg (just-id arg) (lift-predicate arg-type) 0)) ...) - (lambda () rhs ...) - next)) - args) - next)) - ... - (lambda (next) - (bad-args who args)))))])) - -(define (bad-args who args) - (error who "bad argument combination:~a" - (apply string-append (map (lambda (x) (format " ~e" x)) - args)))) - -(define-syntax find-match - (syntax-rules () - [(_ proc) - ((proc #f))] - [(_ proc1 proc ...) - ((proc1 (lambda () (find-match proc ...))))])) - -(define-syntax-rule (let-boxes ([id init] ...) - call - body ...) - (let ([id (box init)] ...) - call - (let ([id (unbox id)] ...) - body ...))) - -(define-syntax (do-properties stx) - (syntax-case stx () - [(_ define-base check-immutable [[type id] expr] ...) - (let ([ids (syntax->list #'(id ...))]) - (with-syntax ([(getter ...) - (map (lambda (id) - (datum->syntax id - (string->symbol - (format "get-~a" (syntax-e id))) - id)) - ids)] - [(setter ...) - (map (lambda (id) - (datum->syntax id - (string->symbol - (format "set-~a" (syntax-e id))) - id)) - ids)]) - #'(begin - (define-base id expr) ... - (define/public (getter) id) ... - (def/public (setter [type v]) (check-immutable 'setter) (set! id (coerce type v))) ...)))])) - -(define-syntax coerce - (syntax-rules (bool?) - [(_ bool? v) (and v #t)] - [(_ _ v) v])) - -(define-syntax properties - (syntax-rules () - [(_ #:check-immutable check-immutable . props) - (do-properties define check-immutable . props)] - [(_ . props) - (do-properties define void . props)])) -(define-syntax field-properties - (syntax-rules () - [(_ #:check-immutable check-immutable . props) - (do-properties define-field check-immutable . props)] - [(_ . props) - (do-properties define-field void . props)])) -(define-syntax-rule (define-field id val) (field [id val])) -(define-syntax init-properties - (syntax-rules () - [(_ #:check-immutable check-immutable . props) - (do-properties define-init check-immutable . props)] - [(_ . props) - (do-properties define-init void . props)])) -(define-syntax-rule (define-init id val) (begin - (init [(internal id) val]) - (define id internal))) - -(define (->long i) - (cond - [(eqv? -inf.0 i) (- (expt 2 64))] - [(eqv? +inf.0 i) (expt 2 64)] - [(eqv? +nan.0 i) 0] - [else (inexact->exact (floor i))])) - - -(define-syntax-rule (assert e) (void)) -; (define-syntax-rule (assert e) (unless e (error 'assert "failed: ~s" 'e))) - -(define (unimplemented c m args) (error (if c (method-name c m) m) "unimplemented; args were ~e" - args)) - -(define-syntax (def/public-unimplemented stx) - (syntax-case stx () - [(_ id) - (with-syntax ([cname (syntax-parameter-value #'class-name)]) - #'(define/public (id . args) (unimplemented 'cname 'id args)))])) - -(define-syntax-rule (define-unimplemented id) - (define (id . args) (unimplemented #f 'id args))) +(require racket/draw/private/syntax) +(provide (all-from-out racket/draw/private/syntax)) diff --git a/collects/mred/private/wx/cocoa/README.txt b/collects/mred/private/wx/cocoa/README.txt index df44db48..b989a697 100644 --- a/collects/mred/private/wx/cocoa/README.txt +++ b/collects/mred/private/wx/cocoa/README.txt @@ -12,4 +12,5 @@ Allocation rules: * Other autoreleased objects may end up in the root pool installed by "pool.rkt". The root pool is periodically destroyed and replaced; call `queue-autorelease-flush' if you need to encurage replacement - of the pool. + of the pool. If you need to use an object htat might be autoflushed, + be sure that you're in atomic mode. diff --git a/collects/mred/private/wx/cocoa/button.rkt b/collects/mred/private/wx/cocoa/button.rkt index 97574919..b58f18e3 100644 --- a/collects/mred/private/wx/cocoa/button.rkt +++ b/collects/mred/private/wx/cocoa/button.rkt @@ -1,7 +1,7 @@ -#lang scheme/base -(require ffi/objc - scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe/objc + ffi/unsafe + racket/class "../../syntax.rkt" "item.rkt" "utils.rkt" @@ -10,12 +10,11 @@ "window.rkt" "../common/event.rkt" "image.rkt") -(unsafe!) -(objc-unsafe!) -(provide button% - core-button% - MyButton) +(provide + (protect-out button% + core-button% + MyButton)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 638e1c56..ee897ce3 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -3,14 +3,15 @@ ffi/unsafe racket/class racket/draw - racket/draw/gl-context - racket/draw/color + racket/draw/private/gl-context + racket/draw/private/color "pool.rkt" "utils.rkt" "const.rkt" "types.rkt" "window.rkt" "dc.rkt" + "bitmap.rkt" "cg.rkt" "queue.rkt" "item.rkt" @@ -24,7 +25,8 @@ "../../lock.rkt" "../common/freeze.rkt") -(provide canvas%) +(provide + (protect-out canvas%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/cg.rkt b/collects/mred/private/wx/cocoa/cg.rkt index 479a9dcd..b158602a 100644 --- a/collects/mred/private/wx/cocoa/cg.rkt +++ b/collects/mred/private/wx/cocoa/cg.rkt @@ -4,7 +4,7 @@ "types.rkt" "utils.rkt") -(provide (all-defined-out)) +(provide (protect-out (all-defined-out))) (define _CGContextRef (_cpointer 'CGContextRef)) (define-appserv CGContextSynchronize (_fun _CGContextRef -> _void)) diff --git a/collects/mred/private/wx/cocoa/check-box.rkt b/collects/mred/private/wx/cocoa/check-box.rkt index 6241bb17..cd2ed74a 100644 --- a/collects/mred/private/wx/cocoa/check-box.rkt +++ b/collects/mred/private/wx/cocoa/check-box.rkt @@ -1,15 +1,14 @@ -#lang scheme/base -(require ffi/objc - scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe/objc + ffi/unsafe + racket/class "../../syntax.rkt" "button.rkt" "types.rkt" "const.rkt") -(unsafe!) -(objc-unsafe!) -(provide check-box%) +(provide + (protect-out check-box%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/choice.rkt b/collects/mred/private/wx/cocoa/choice.rkt index 1974622d..844748e4 100644 --- a/collects/mred/private/wx/cocoa/choice.rkt +++ b/collects/mred/private/wx/cocoa/choice.rkt @@ -1,7 +1,7 @@ -#lang scheme/base -(require scheme/class - scheme/foreign - ffi/objc +#lang racket/base +(require racket/class + ffi/unsafe + ffi/unsafe/objc "../../syntax.rkt" "item.rkt" "types.rkt" @@ -9,10 +9,9 @@ "utils.rkt" "window.rkt" "../common/event.rkt") -(unsafe!) -(objc-unsafe!) -(provide choice%) +(provide + (protect-out choice%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/clipboard.rkt b/collects/mred/private/wx/cocoa/clipboard.rkt index d72d854a..34eb2370 100644 --- a/collects/mred/private/wx/cocoa/clipboard.rkt +++ b/collects/mred/private/wx/cocoa/clipboard.rkt @@ -1,16 +1,17 @@ -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class ffi/unsafe ffi/unsafe/objc "utils.rkt" "types.rkt" "image.rkt" - "../common/bstr.rkt" + racket/draw/unsafe/bstr "../../syntax.rkt" "../../lock.rkt") -(provide clipboard-driver% - has-x-selection?) +(provide + (protect-out clipboard-driver% + has-x-selection?)) (import-class NSPasteboard NSArray NSData NSImage NSGraphicsContext) (import-protocol NSPasteboardOwner) diff --git a/collects/mred/private/wx/cocoa/colordialog.rkt b/collects/mred/private/wx/cocoa/colordialog.rkt index 1f3a8e6b..2dc750c3 100644 --- a/collects/mred/private/wx/cocoa/colordialog.rkt +++ b/collects/mred/private/wx/cocoa/colordialog.rkt @@ -2,12 +2,13 @@ (require ffi/unsafe ffi/unsafe/objc racket/class - racket/draw/color + racket/draw/private/color "../../lock.rkt" "utils.rkt" "types.rkt") -(provide get-color-from-user) +(provide + (protect-out get-color-from-user)) (import-class NSColorPanel NSColor) diff --git a/collects/mred/private/wx/cocoa/const.rkt b/collects/mred/private/wx/cocoa/const.rkt index f8a39c5d..d2f99cb3 100644 --- a/collects/mred/private/wx/cocoa/const.rkt +++ b/collects/mred/private/wx/cocoa/const.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (provide (except-out (all-defined-out) <<)) diff --git a/collects/mred/private/wx/cocoa/cursor.rkt b/collects/mred/private/wx/cocoa/cursor.rkt index 28fc4e5d..0ca120c1 100644 --- a/collects/mred/private/wx/cocoa/cursor.rkt +++ b/collects/mred/private/wx/cocoa/cursor.rkt @@ -9,9 +9,10 @@ "../common/cursor-draw.rkt" "../common/local.rkt") -(provide cursor-driver% - arrow-cursor-handle - get-wait-cursor-handle) +(provide + (protect-out cursor-driver% + arrow-cursor-handle + get-wait-cursor-handle)) (import-class NSCursor) diff --git a/collects/mred/private/wx/cocoa/dc.rkt b/collects/mred/private/wx/cocoa/dc.rkt index cd44ad58..ed311688 100644 --- a/collects/mred/private/wx/cocoa/dc.rkt +++ b/collects/mred/private/wx/cocoa/dc.rkt @@ -2,10 +2,10 @@ (require racket/class ffi/unsafe ffi/unsafe/objc - racket/draw/cairo - racket/draw/bitmap - racket/draw/local - racket/draw/gl-context + racket/draw/unsafe/cairo + racket/draw/private/bitmap + racket/draw/private/local + racket/draw/private/gl-context "types.rkt" "utils.rkt" "bitmap.rkt" @@ -15,9 +15,9 @@ "../common/backing-dc.rkt" "cg.rkt") -(provide dc% - quartz-bitmap% - do-backing-flush) +(provide + (protect-out dc% + do-backing-flush)) (import-class NSOpenGLContext) diff --git a/collects/mred/private/wx/cocoa/dialog.rkt b/collects/mred/private/wx/cocoa/dialog.rkt index 85b8e361..bfb8517e 100644 --- a/collects/mred/private/wx/cocoa/dialog.rkt +++ b/collects/mred/private/wx/cocoa/dialog.rkt @@ -1,12 +1,13 @@ -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class "../../syntax.rkt" "../common/queue.rkt" "../common/dialog.rkt" "../../lock.rkt" "frame.rkt") -(provide dialog%) +(provide + (protect-out dialog%)) (define dialog% (class (dialog-mixin frame%) diff --git a/collects/mred/private/wx/cocoa/filedialog.rkt b/collects/mred/private/wx/cocoa/filedialog.rkt index c2bfc8ae..00e124e4 100644 --- a/collects/mred/private/wx/cocoa/filedialog.rkt +++ b/collects/mred/private/wx/cocoa/filedialog.rkt @@ -9,7 +9,8 @@ "queue.rkt" "frame.rkt") -(provide file-selector) +(provide + (protect-out file-selector)) (import-class NSOpenPanel NSSavePanel NSURL NSArray) diff --git a/collects/mred/private/wx/cocoa/finfo.rkt b/collects/mred/private/wx/cocoa/finfo.rkt index 4d841bbc..b1570bea 100644 --- a/collects/mred/private/wx/cocoa/finfo.rkt +++ b/collects/mred/private/wx/cocoa/finfo.rkt @@ -4,7 +4,8 @@ "utils.rkt" "types.rkt") -(provide file-creator-and-type) +(provide + (protect-out file-creator-and-type)) (define coreserv-lib (ffi-lib (format "/System/Library/Frameworks/CoreServices.framework/CoreServices"))) diff --git a/collects/mred/private/wx/cocoa/font.rkt b/collects/mred/private/wx/cocoa/font.rkt index 7b438b0a..014e0942 100644 --- a/collects/mred/private/wx/cocoa/font.rkt +++ b/collects/mred/private/wx/cocoa/font.rkt @@ -8,7 +8,8 @@ "utils.rkt" "types.rkt") -(provide font->NSFont) +(provide + (protect-out font->NSFont)) (import-class NSFont NSFontManager) diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index 5536d187..0edb644f 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/collects/mred/private/wx/cocoa/frame.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe/objc ffi/unsafe scheme/class @@ -15,9 +15,10 @@ "../common/freeze.rkt" "../../lock.rkt") -(provide frame% - location->window - get-front) +(provide + (protect-out frame% + location->window + get-front)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/gauge.rkt b/collects/mred/private/wx/cocoa/gauge.rkt index 1dfa3fce..d9d37610 100644 --- a/collects/mred/private/wx/cocoa/gauge.rkt +++ b/collects/mred/private/wx/cocoa/gauge.rkt @@ -1,18 +1,17 @@ -#lang scheme/base -(require scheme/class - scheme/foreign +#lang racket/base +(require racket/class + ffi/unsafe racket/math - ffi/objc + ffi/unsafe/objc "../../syntax.rkt" "item.rkt" "types.rkt" "const.rkt" "utils.rkt" "window.rkt") -(unsafe!) -(objc-unsafe!) -(provide gauge%) +(provide + (protect-out gauge%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/gc.rkt b/collects/mred/private/wx/cocoa/gc.rkt index b582a48a..8e384f37 100644 --- a/collects/mred/private/wx/cocoa/gc.rkt +++ b/collects/mred/private/wx/cocoa/gc.rkt @@ -4,9 +4,10 @@ "utils.rkt" "types.rkt") -(provide scheme_add_gc_callback - scheme_remove_gc_callback - make-gc-action-desc) +(provide + (protect-out scheme_add_gc_callback + scheme_remove_gc_callback + make-gc-action-desc)) (define objc-lib (ffi-lib "libobjc")) diff --git a/collects/mred/private/wx/cocoa/group-panel.rkt b/collects/mred/private/wx/cocoa/group-panel.rkt index 8c70afe1..17561714 100644 --- a/collects/mred/private/wx/cocoa/group-panel.rkt +++ b/collects/mred/private/wx/cocoa/group-panel.rkt @@ -1,16 +1,15 @@ -#lang scheme/base -(require scheme/class - scheme/foreign - ffi/objc +#lang racket/base +(require racket/class + ffi/unsafe + ffi/unsafe/objc "../../syntax.rkt" "types.rkt" "utils.rkt" "window.rkt" "panel.rkt") -(unsafe!) -(objc-unsafe!) -(provide group-panel%) +(provide + (protect-out group-panel%)) (import-class NSBox) diff --git a/collects/mred/private/wx/cocoa/image.rkt b/collects/mred/private/wx/cocoa/image.rkt index e8ebe30f..ac05763a 100644 --- a/collects/mred/private/wx/cocoa/image.rkt +++ b/collects/mred/private/wx/cocoa/image.rkt @@ -2,9 +2,9 @@ (require ffi/unsafe ffi/unsafe/objc racket/class - racket/draw/cairo - racket/draw/local - "../common/bstr.rkt" + racket/draw/unsafe/cairo + racket/draw/private/local + racket/draw/unsafe/bstr "utils.rkt" "types.rkt" "const.rkt" @@ -13,8 +13,9 @@ "../../lock.rkt" (only-in '#%foreign ffi-callback)) -(provide bitmap->image - image->bitmap) +(provide + (protect-out bitmap->image + image->bitmap)) (import-class NSImage NSGraphicsContext) diff --git a/collects/mred/private/wx/cocoa/init.rkt b/collects/mred/private/wx/cocoa/init.rkt index 2c3b5fba..4764cc1f 100644 --- a/collects/mred/private/wx/cocoa/init.rkt +++ b/collects/mred/private/wx/cocoa/init.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require "pool.rkt" "queue.rkt") diff --git a/collects/mred/private/wx/cocoa/item.rkt b/collects/mred/private/wx/cocoa/item.rkt index 6f3a0443..674da458 100644 --- a/collects/mred/private/wx/cocoa/item.rkt +++ b/collects/mred/private/wx/cocoa/item.rkt @@ -1,17 +1,16 @@ -#lang scheme/base -(require scheme/class - scheme/foreign - ffi/objc +#lang racket/base +(require racket/class + ffi/unsafe + ffi/unsafe/objc "../../syntax.rkt" "window.rkt" "const.rkt" "types.rkt" "font.rkt") -(unsafe!) -(objc-unsafe!) -(provide item% - install-control-font) +(provide + (protect-out item% + install-control-font)) (import-class NSFont) (define sys-font (tell NSFont diff --git a/collects/mred/private/wx/cocoa/keycode.rkt b/collects/mred/private/wx/cocoa/keycode.rkt index 572d1f2c..7eb4d26f 100644 --- a/collects/mred/private/wx/cocoa/keycode.rkt +++ b/collects/mred/private/wx/cocoa/keycode.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (provide map-key-code) diff --git a/collects/mred/private/wx/cocoa/list-box.rkt b/collects/mred/private/wx/cocoa/list-box.rkt index 40f635e5..72419a0e 100644 --- a/collects/mred/private/wx/cocoa/list-box.rkt +++ b/collects/mred/private/wx/cocoa/list-box.rkt @@ -1,7 +1,7 @@ -#lang scheme/base -(require ffi/objc - scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe/objc + ffi/unsafe + racket/class (only-in scheme/list take drop) "../../syntax.rkt" "../../lock.rkt" @@ -12,10 +12,9 @@ "window.rkt" "font.rkt" "../common/event.rkt") -(unsafe!) -(objc-unsafe!) -(provide list-box%) +(provide + (protect-out list-box%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/menu-bar.rkt b/collects/mred/private/wx/cocoa/menu-bar.rkt index e72947f9..b8c70ae5 100644 --- a/collects/mred/private/wx/cocoa/menu-bar.rkt +++ b/collects/mred/private/wx/cocoa/menu-bar.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require racket/class ffi/unsafe ffi/unsafe/objc @@ -10,8 +10,9 @@ "const.rkt" "queue.rkt") -(provide menu-bar% - get-menu-bar-height) +(provide + (protect-out menu-bar% + get-menu-bar-height)) (import-class NSApplication NSMenu NSMenuItem NSProcessInfo NSScreen) diff --git a/collects/mred/private/wx/cocoa/menu-item.rkt b/collects/mred/private/wx/cocoa/menu-item.rkt index 672a2b7c..6f26da24 100644 --- a/collects/mred/private/wx/cocoa/menu-item.rkt +++ b/collects/mred/private/wx/cocoa/menu-item.rkt @@ -7,8 +7,9 @@ "types.rkt" "const.rkt") -(provide menu-item% - set-menu-item-shortcut) +(provide + (protect-out menu-item% + set-menu-item-shortcut)) (import-class NSMenuItem) diff --git a/collects/mred/private/wx/cocoa/menu.rkt b/collects/mred/private/wx/cocoa/menu.rkt index 7f9637eb..8d59c1f3 100644 --- a/collects/mred/private/wx/cocoa/menu.rkt +++ b/collects/mred/private/wx/cocoa/menu.rkt @@ -10,7 +10,8 @@ "window.rkt" "menu-item.rkt") -(provide menu%) +(provide + (protect-out menu%)) (import-class NSMenu NSMenuItem) diff --git a/collects/mred/private/wx/cocoa/message.rkt b/collects/mred/private/wx/cocoa/message.rkt index 458b3fc3..1a3896ef 100644 --- a/collects/mred/private/wx/cocoa/message.rkt +++ b/collects/mred/private/wx/cocoa/message.rkt @@ -1,18 +1,17 @@ -#lang scheme/base -(require scheme/class - scheme/foreign - ffi/objc - racket/draw/bitmap +#lang racket/base +(require racket/class + ffi/unsafe + ffi/unsafe/objc + racket/draw/private/bitmap "../../syntax.rkt" "window.rkt" "item.rkt" "utils.rkt" "types.rkt" "image.rkt") -(unsafe!) -(objc-unsafe!) -(provide message%) +(provide + (protect-out message%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/panel.rkt b/collects/mred/private/wx/cocoa/panel.rkt index b7903746..48a5c03f 100644 --- a/collects/mred/private/wx/cocoa/panel.rkt +++ b/collects/mred/private/wx/cocoa/panel.rkt @@ -1,16 +1,15 @@ -#lang scheme/base -(require scheme/class - scheme/foreign - ffi/objc +#lang racket/base +(require racket/class + ffi/unsafe + ffi/unsafe/objc "../../syntax.rkt" "types.rkt" "utils.rkt" "window.rkt") -(unsafe!) -(objc-unsafe!) -(provide panel% - panel-mixin) +(provide + (protect-out panel% + panel-mixin)) (import-class NSView) diff --git a/collects/mred/private/wx/cocoa/platform.rkt b/collects/mred/private/wx/cocoa/platform.rkt index 98b0bfa7..f5e80dad 100644 --- a/collects/mred/private/wx/cocoa/platform.rkt +++ b/collects/mred/private/wx/cocoa/platform.rkt @@ -23,7 +23,7 @@ "tab-panel.rkt" "window.rkt" "procs.rkt") -(provide platform-values) +(provide (protect-out platform-values)) (define (platform-values) (values @@ -60,8 +60,6 @@ bell display-size display-origin - get-resource - write-resource flush-display fill-private-color cancel-quit @@ -71,7 +69,6 @@ get-double-click-time run-printout file-creator-and-type - send-event location->window shortcut-visible-in-label? unregister-collecting-blit diff --git a/collects/mred/private/wx/cocoa/pool.rkt b/collects/mred/private/wx/cocoa/pool.rkt index 5a101fc4..070719d2 100644 --- a/collects/mred/private/wx/cocoa/pool.rkt +++ b/collects/mred/private/wx/cocoa/pool.rkt @@ -6,8 +6,9 @@ "const.rkt" "types.rkt") -(provide queue-autorelease-flush - autorelease-flush) +(provide + (protect-out queue-autorelease-flush + autorelease-flush)) (import-class NSAutoreleasePool) diff --git a/collects/mred/private/wx/cocoa/printer-dc.rkt b/collects/mred/private/wx/cocoa/printer-dc.rkt index b48d2f04..c1224ed1 100644 --- a/collects/mred/private/wx/cocoa/printer-dc.rkt +++ b/collects/mred/private/wx/cocoa/printer-dc.rkt @@ -1,23 +1,25 @@ #lang racket/base (require racket/class racket/math - racket/draw/local - racket/draw/dc - racket/draw/cairo - racket/draw/bitmap - racket/draw/bitmap-dc - racket/draw/record-dc - racket/draw/ps-setup + racket/draw/private/local + racket/draw/private/dc + racket/draw/unsafe/cairo + racket/draw/private/bitmap + racket/draw/private/bitmap-dc + racket/draw/private/record-dc + racket/draw/private/ps-setup ffi/unsafe ffi/unsafe/objc "../../lock.rkt" "dc.rkt" + "bitmap.rkt" "cg.rkt" "utils.rkt" "types.rkt") -(provide printer-dc% - show-print-setup) +(provide + (protect-out printer-dc% + show-print-setup)) (import-class NSPrintOperation NSView NSGraphicsContext NSPrintInfo NSDictionary NSPageLayout diff --git a/collects/mred/private/wx/cocoa/procs.rkt b/collects/mred/private/wx/cocoa/procs.rkt index 7b77f911..ed872b4a 100644 --- a/collects/mred/private/wx/cocoa/procs.rkt +++ b/collects/mred/private/wx/cocoa/procs.rkt @@ -12,6 +12,7 @@ "filedialog.rkt" "colordialog.rkt" "dc.rkt" + "bitmap.rkt" "printer-dc.rkt" "../common/printer.rkt" "menu-bar.rkt" @@ -26,54 +27,45 @@ (provide - application-file-handler - application-quit-handler - application-about-handler - application-pref-handler - color-from-user-platform-mode - get-color-from-user - font-from-user-platform-mode - get-font-from-user - get-panel-background - play-sound - find-graphical-system-path - register-collecting-blit - unregister-collecting-blit - shortcut-visible-in-label? - send-event - file-creator-and-type - run-printout - get-double-click-time - get-control-font-face - get-control-font-size - get-control-font-size-in-pixels? - cancel-quit - fill-private-color - flush-display - write-resource - get-resource - display-origin - display-size - bell - hide-cursor - get-display-depth - is-color-display? - file-selector - id-to-menu-item - show-print-setup - can-show-print-setup? - get-highlight-background-color - get-highlight-text-color + (protect-out + color-from-user-platform-mode + font-from-user-platform-mode + get-font-from-user + find-graphical-system-path + register-collecting-blit + unregister-collecting-blit + shortcut-visible-in-label? + run-printout + get-double-click-time + get-control-font-face + get-control-font-size + get-control-font-size-in-pixels? + cancel-quit + display-origin + display-size + bell + hide-cursor + get-display-depth + is-color-display? + id-to-menu-item + can-show-print-setup? + get-highlight-background-color + get-highlight-text-color + check-for-break) make-screen-bitmap make-gl-bitmap - check-for-break) + show-print-setup + get-color-from-user + get-panel-background + fill-private-color + flush-display + play-sound + file-creator-and-type + file-selector) (import-class NSScreen NSCursor) (define-unimplemented find-graphical-system-path) -(define-unimplemented send-event) -(define-unimplemented write-resource) -(define-unimplemented get-resource) (define (color-from-user-platform-mode) "Show Picker") diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index 7d73a699..10d68f7c 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/collects/mred/private/wx/cocoa/queue.rkt @@ -1,8 +1,8 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe/objc ffi/unsafe - scheme/class - racket/draw/dc + racket/class + racket/draw/private/dc "pool.rkt" "utils.rkt" "const.rkt" @@ -12,21 +12,21 @@ "../../lock.rkt" "../common/freeze.rkt") -(provide app - cocoa-start-event-pump - cocoa-install-event-wakeup - queue-event - set-eventspace-hook! - set-front-hook! - set-menu-bar-hooks! - post-dummy-event +(provide + (protect-out app + cocoa-start-event-pump + cocoa-install-event-wakeup + set-eventspace-hook! + set-front-hook! + set-menu-bar-hooks! + post-dummy-event - try-to-sync-refresh + try-to-sync-refresh) - ;; from common/queue: - current-eventspace - queue-event - yield) + ;; from common/queue: + current-eventspace + queue-event + yield) (import-class NSApplication NSAutoreleasePool NSColor) (import-protocol NSApplicationDelegate) diff --git a/collects/mred/private/wx/cocoa/radio-box.rkt b/collects/mred/private/wx/cocoa/radio-box.rkt index be329cb6..ff799116 100644 --- a/collects/mred/private/wx/cocoa/radio-box.rkt +++ b/collects/mred/private/wx/cocoa/radio-box.rkt @@ -1,7 +1,7 @@ -#lang scheme/base -(require scheme/class - scheme/foreign - ffi/objc +#lang racket/base +(require racket/class + ffi/unsafe + ffi/unsafe/objc "../../syntax.rkt" "item.rkt" "button.rkt" @@ -11,10 +11,9 @@ "window.rkt" "../common/event.rkt" "image.rkt") -(unsafe!) -(objc-unsafe!) -(provide radio-box%) +(provide + (protect-out radio-box%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/slider.rkt b/collects/mred/private/wx/cocoa/slider.rkt index 35170d85..146352ed 100644 --- a/collects/mred/private/wx/cocoa/slider.rkt +++ b/collects/mred/private/wx/cocoa/slider.rkt @@ -1,7 +1,7 @@ -#lang scheme/base -(require scheme/class - scheme/foreign - ffi/objc +#lang racket/base +(require racket/class + ffi/unsafe + ffi/unsafe/objc "../../syntax.rkt" "item.rkt" "types.rkt" @@ -12,10 +12,9 @@ "../common/queue.rkt" "../common/freeze.rkt" "../../lock.rkt") -(unsafe!) -(objc-unsafe!) -(provide slider%) +(provide + (protect-out slider%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/cocoa/sound.rkt b/collects/mred/private/wx/cocoa/sound.rkt index ac0a28ef..ec31b205 100644 --- a/collects/mred/private/wx/cocoa/sound.rkt +++ b/collects/mred/private/wx/cocoa/sound.rkt @@ -4,7 +4,8 @@ "utils.rkt" "types.rkt") -(provide play-sound) +(provide + (protect-out play-sound)) (import-class NSSound) diff --git a/collects/mred/private/wx/cocoa/tab-panel.rkt b/collects/mred/private/wx/cocoa/tab-panel.rkt index d5f8a397..62a22c5e 100644 --- a/collects/mred/private/wx/cocoa/tab-panel.rkt +++ b/collects/mred/private/wx/cocoa/tab-panel.rkt @@ -13,7 +13,8 @@ "../common/procs.rkt" (for-syntax racket/base)) -(provide tab-panel%) +(provide + (protect-out tab-panel%)) (define-runtime-path psm-tab-bar-dir '(so "PSMTabBarControl.framework")) diff --git a/collects/mred/private/wx/cocoa/types.rkt b/collects/mred/private/wx/cocoa/types.rkt index accaffc8..5e577c95 100644 --- a/collects/mred/private/wx/cocoa/types.rkt +++ b/collects/mred/private/wx/cocoa/types.rkt @@ -1,20 +1,19 @@ -#lang scheme/base -(require ffi/objc - scheme/foreign +#lang racket/base +(require ffi/unsafe/objc + ffi/unsafe "../../lock.rkt" "utils.rkt") -(unsafe!) -(objc-unsafe!) -(provide _NSInteger _NSUInteger - _CGFloat - _NSPoint _NSPoint-pointer (struct-out NSPoint) - _NSSize _NSSize-pointer (struct-out NSSize) - _NSRect _NSRect-pointer (struct-out NSRect) - _NSRange _NSRange-pointer (struct-out NSRange) - NSObject - NSString _NSString - NSNotFound) +(provide + (protect-out _NSInteger _NSUInteger + _CGFloat + _NSPoint _NSPoint-pointer (struct-out NSPoint) + _NSSize _NSSize-pointer (struct-out NSSize) + _NSRect _NSRect-pointer (struct-out NSRect) + _NSRange _NSRange-pointer (struct-out NSRange) + NSObject + NSString _NSString + NSNotFound)) (define _NSInteger _long) (define _NSUInteger _ulong) diff --git a/collects/mred/private/wx/cocoa/utils.rkt b/collects/mred/private/wx/cocoa/utils.rkt index b1553187..42c62ebf 100644 --- a/collects/mred/private/wx/cocoa/utils.rkt +++ b/collects/mred/private/wx/cocoa/utils.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe/objc ffi/unsafe ffi/unsafe/alloc @@ -6,22 +6,23 @@ "../common/utils.rkt" "../../lock.rkt") -(provide cocoa-lib - cf-lib - define-cocoa - define-cf - define-appserv - define-appkit - define-mz - as-objc-allocation - as-objc-allocation-with-retain - clean-up-deleted - retain release - with-autorelease - clean-menu-label - ->wxb - ->wx - old-cocoa?) +(provide + (protect-out cocoa-lib + cf-lib + define-cocoa + define-cf + define-appserv + define-appkit + as-objc-allocation + as-objc-allocation-with-retain + clean-up-deleted + retain release + with-autorelease + clean-menu-label + ->wxb + ->wx + old-cocoa?) + define-mz) (define cocoa-lib (ffi-lib (format "/System/Library/Frameworks/Cocoa.framework/Cocoa"))) (define cf-lib (ffi-lib (format "/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation"))) diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index b937b47b..b4daaa97 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -1,7 +1,7 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe/objc ffi/unsafe - scheme/class + racket/class "queue.rkt" "utils.rkt" "const.rkt" @@ -17,23 +17,24 @@ "../../syntax.rkt" "../common/freeze.rkt") -(provide window% +(provide + (protect-out window% - FocusResponder - KeyMouseResponder - KeyMouseTextResponder - CursorDisplayer + FocusResponder + KeyMouseResponder + KeyMouseTextResponder + CursorDisplayer - queue-window-event - queue-window-refresh-event - queue-window*-event - request-flush-delay - cancel-flush-delay - make-init-point - flush-display + queue-window-event + queue-window-refresh-event + queue-window*-event + request-flush-delay + cancel-flush-delay + make-init-point + flush-display - special-control-key - special-option-key) + special-control-key + special-option-key)) (define-local-member-name flip-client) diff --git a/collects/mred/private/wx/common/backing-dc.rkt b/collects/mred/private/wx/common/backing-dc.rkt index 1c4f9669..f6c9b3b5 100644 --- a/collects/mred/private/wx/common/backing-dc.rkt +++ b/collects/mred/private/wx/common/backing-dc.rkt @@ -1,25 +1,26 @@ #lang racket/base (require racket/class - racket/draw/dc - racket/draw/bitmap-dc - racket/draw/bitmap - racket/draw/local + racket/draw/private/dc + racket/draw/private/bitmap-dc + racket/draw/private/bitmap + racket/draw/private/local "../../lock.rkt" "queue.rkt") -(provide backing-dc% - - ;; scoped method names: - get-backing-size - queue-backing-flush - on-backing-flush - start-backing-retained - end-backing-retained - reset-backing-retained - make-backing-bitmap - request-delay - cancel-delay - end-delay) +(provide + (protect-out backing-dc% + + ;; scoped method names: + get-backing-size + queue-backing-flush + on-backing-flush + start-backing-retained + end-backing-retained + reset-backing-retained + make-backing-bitmap + request-delay + cancel-delay + end-delay)) (define-local-member-name get-backing-size @@ -35,8 +36,7 @@ (define backing-dc% (class (dc-mixin bitmap-dc-backend%) - (inherit call-with-cr-lock - internal-get-bitmap + (inherit internal-get-bitmap internal-set-bitmap reset-cr) @@ -87,12 +87,12 @@ (release-backing-bitmap bm))))) (define/public (start-backing-retained) - (call-with-cr-lock + (as-entry (lambda () (set! retained-counter (add1 retained-counter))))) (define/public (end-backing-retained) - (call-with-cr-lock + (as-entry (lambda () (if (zero? retained-counter) (log-error "unbalanced end-on-paint") diff --git a/collects/mred/private/wx/common/canvas-mixin.rkt b/collects/mred/private/wx/common/canvas-mixin.rkt index 2e428a41..2822e41e 100644 --- a/collects/mred/private/wx/common/canvas-mixin.rkt +++ b/collects/mred/private/wx/common/canvas-mixin.rkt @@ -3,9 +3,10 @@ racket/draw "backing-dc.rkt") -(provide canvas-autoscroll-mixin - canvas-mixin - fix-bitmap-size) +(provide + (protect-out canvas-autoscroll-mixin + canvas-mixin + fix-bitmap-size)) ;; Implements canvas autoscroll, applied *before* platform-specific canvas ;; methods: diff --git a/collects/mred/private/wx/common/clipboard.rkt b/collects/mred/private/wx/common/clipboard.rkt index af22c334..383394fd 100644 --- a/collects/mred/private/wx/common/clipboard.rkt +++ b/collects/mred/private/wx/common/clipboard.rkt @@ -5,10 +5,11 @@ "local.rkt" "queue.rkt") -(provide clipboard<%> - clipboard-client% - get-the-clipboard - get-the-x-selection) +(provide + (protect-out clipboard<%> + clipboard-client% + get-the-clipboard + get-the-x-selection)) (defclass clipboard-client% object% (define types null) diff --git a/collects/mred/private/wx/common/default-procs.rkt b/collects/mred/private/wx/common/default-procs.rkt index 5034f1be..52598374 100644 --- a/collects/mred/private/wx/common/default-procs.rkt +++ b/collects/mred/private/wx/common/default-procs.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/class - racket/draw/color) + racket/draw/private/color) (provide special-control-key special-option-key file-creator-and-type diff --git a/collects/mred/private/wx/common/delay.rkt b/collects/mred/private/wx/common/delay.rkt index 0a348b08..7898a2d3 100644 --- a/collects/mred/private/wx/common/delay.rkt +++ b/collects/mred/private/wx/common/delay.rkt @@ -2,8 +2,9 @@ (require "../../lock.rkt" "queue.rkt") -(provide do-request-flush-delay - do-cancel-flush-delay) +(provide + (protect-out do-request-flush-delay + do-cancel-flush-delay)) (define (do-request-flush-delay win disable enable) (atomically diff --git a/collects/mred/private/wx/common/dialog.rkt b/collects/mred/private/wx/common/dialog.rkt index 1548fb06..319b265f 100644 --- a/collects/mred/private/wx/common/dialog.rkt +++ b/collects/mred/private/wx/common/dialog.rkt @@ -3,7 +3,7 @@ "../../lock.rkt" "queue.rkt") -(provide dialog-mixin) +(provide (protect-out dialog-mixin)) (define dialog-level-counter 0) diff --git a/collects/mred/private/wx/common/event.rkt b/collects/mred/private/wx/common/event.rkt index 1c757d79..e9820fe3 100644 --- a/collects/mred/private/wx/common/event.rkt +++ b/collects/mred/private/wx/common/event.rkt @@ -1,5 +1,5 @@ -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class "../../syntax.rkt") (provide event% diff --git a/collects/mred/private/wx/common/freeze.rkt b/collects/mred/private/wx/common/freeze.rkt index 28b3fecc..92c15665 100644 --- a/collects/mred/private/wx/common/freeze.rkt +++ b/collects/mred/private/wx/common/freeze.rkt @@ -1,9 +1,10 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe/try-atomic "queue.rkt") -(provide call-as-nonatomic-retry-point - constrained-reply) +(provide + call-as-nonatomic-retry-point + (protect-out constrained-reply)) (define (internal-error str) (log-error diff --git a/collects/mred/private/wx/common/handlers.rkt b/collects/mred/private/wx/common/handlers.rkt index 9fad1616..3776fd01 100644 --- a/collects/mred/private/wx/common/handlers.rkt +++ b/collects/mred/private/wx/common/handlers.rkt @@ -1,11 +1,12 @@ #lang racket/base -(provide application-file-handler - application-quit-handler - application-about-handler - application-pref-handler - - nothing-application-pref-handler) +(provide + (protect-out application-file-handler + application-quit-handler + application-about-handler + application-pref-handler + + nothing-application-pref-handler)) (define saved-files null) (define afh (lambda (f) diff --git a/collects/mred/private/wx/common/local.rkt b/collects/mred/private/wx/common/local.rkt index 0f1d6a08..82a8c6b6 100644 --- a/collects/mred/private/wx/common/local.rkt +++ b/collects/mred/private/wx/common/local.rkt @@ -1,7 +1,7 @@ -#lang scheme/base -(require scheme/class) +#lang racket/base +(require racket/class) -(provide (all-defined-out)) +(provide (protect-out (all-defined-out))) (define-local-member-name ;; clipboard-client%: diff --git a/collects/mred/private/wx/common/once.rkt b/collects/mred/private/wx/common/once.rkt index c0e49a64..d4167541 100644 --- a/collects/mred/private/wx/common/once.rkt +++ b/collects/mred/private/wx/common/once.rkt @@ -1,7 +1,7 @@ #lang racket/base (require ffi/unsafe) -(provide scheme_register_process_global) +(provide (protect-out scheme_register_process_global)) ;; This module must be instantiated only once: diff --git a/collects/mred/private/wx/common/procs.rkt b/collects/mred/private/wx/common/procs.rkt index 362911fc..6434cc48 100644 --- a/collects/mred/private/wx/common/procs.rkt +++ b/collects/mred/private/wx/common/procs.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require "../../syntax.rkt") (provide diff --git a/collects/mred/private/wx/common/queue.rkt b/collects/mred/private/wx/common/queue.rkt index 7882a650..b54cbd35 100644 --- a/collects/mred/private/wx/common/queue.rkt +++ b/collects/mred/private/wx/common/queue.rkt @@ -1,6 +1,6 @@ #lang racket/base (require ffi/unsafe - racket/draw/utils + racket/draw/private/utils ffi/unsafe/atomic racket/class "rbtree.rkt" @@ -8,52 +8,53 @@ "handlers.rkt" "once.rkt") -(provide queue-evt - set-check-queue! - set-queue-wakeup! +(provide + (protect-out queue-evt + set-check-queue! + set-queue-wakeup! - add-event-boundary-callback! - add-event-boundary-sometimes-callback! - remove-event-boundary-callback! - pre-event-sync - boundary-tasks-ready-evt + add-event-boundary-callback! + add-event-boundary-sometimes-callback! + remove-event-boundary-callback! + pre-event-sync + boundary-tasks-ready-evt - eventspace? - current-eventspace - queue-event - queue-refresh-event - yield - yield-refresh - (rename-out [make-new-eventspace make-eventspace]) + eventspace? + current-eventspace + queue-event + queue-refresh-event + yield + yield-refresh + (rename-out [make-new-eventspace make-eventspace]) - event-dispatch-handler - eventspace-shutdown? - main-eventspace? - eventspace-handler-thread - eventspace-wait-cursor-count - eventspace-extra-table - eventspace-adjust-external-modal! + event-dispatch-handler + eventspace-shutdown? + main-eventspace? + eventspace-handler-thread + eventspace-wait-cursor-count + eventspace-extra-table + eventspace-adjust-external-modal! - queue-callback - middle-queue-key + queue-callback + middle-queue-key - make-timer-callback - add-timer-callback - remove-timer-callback + make-timer-callback + add-timer-callback + remove-timer-callback - register-frame-shown - get-top-level-windows - other-modal? + register-frame-shown + get-top-level-windows + other-modal? - queue-quit-event - queue-prefs-event - queue-file-event + queue-quit-event + queue-prefs-event + queue-file-event - begin-busy-cursor - end-busy-cursor - is-busy? + begin-busy-cursor + end-busy-cursor + is-busy?) - scheme_register_process_global) + scheme_register_process_global) ;; ------------------------------------------------------------ ;; Create a Scheme evt that is ready when a queue is nonempty diff --git a/collects/mred/private/wx/common/rbtree.rkt b/collects/mred/private/wx/common/rbtree.rkt index a01817e1..884cc91b 100644 --- a/collects/mred/private/wx/common/rbtree.rkt +++ b/collects/mred/private/wx/common/rbtree.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base ;;; red-black-tree.rkt -- Jens Axel S�gaard and Carl Eastlund -- 3rd nov 2003 @@ -60,8 +60,8 @@ ;; SETS IMPLEMENTED AS REB-BLACK TREES. -(require scheme/match - (for-syntax scheme/base)) +(require racket/match + (for-syntax racket/base)) (define-match-expander $ (lambda (stx) (syntax-case stx () diff --git a/collects/mred/private/wx/common/timer.rkt b/collects/mred/private/wx/common/timer.rkt index 0a950e86..289eb651 100644 --- a/collects/mred/private/wx/common/timer.rkt +++ b/collects/mred/private/wx/common/timer.rkt @@ -1,5 +1,5 @@ -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class "../../syntax.rkt" "../../lock.rkt" "queue.rkt") diff --git a/collects/mred/private/wx/common/utils.rkt b/collects/mred/private/wx/common/utils.rkt index 1d9948dc..7a27dbfe 100644 --- a/collects/mred/private/wx/common/utils.rkt +++ b/collects/mred/private/wx/common/utils.rkt @@ -3,6 +3,6 @@ ffi/unsafe/define "once.rkt") -(provide define-mz) +(provide (protect-out define-mz)) (define-ffi-definer define-mz #f) diff --git a/collects/mred/private/wx/gtk/button.rkt b/collects/mred/private/wx/gtk/button.rkt index a064b586..4d5a6499 100644 --- a/collects/mred/private/wx/gtk/button.rkt +++ b/collects/mred/private/wx/gtk/button.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe + racket/class "../../syntax.rkt" "../../lock.rkt" "item.rkt" @@ -11,10 +11,10 @@ "pixbuf.rkt" "message.rkt" "../common/event.rkt") -(unsafe!) -(provide button% - button-core%) +(provide + (protect-out button% + button-core%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index 977ea3a5..bbc494d0 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -3,8 +3,8 @@ racket/class racket/draw ffi/unsafe/alloc - racket/draw/color - racket/draw/local + racket/draw/private/color + racket/draw/private/local "../common/backing-dc.rkt" "../common/canvas-mixin.rkt" "../../syntax.rkt" @@ -22,7 +22,8 @@ "pixbuf.rkt" "gcwin.rkt") -(provide canvas%) +(provide + (protect-out canvas%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/check-box.rkt b/collects/mred/private/wx/gtk/check-box.rkt index f8eede10..f9efa580 100644 --- a/collects/mred/private/wx/gtk/check-box.rkt +++ b/collects/mred/private/wx/gtk/check-box.rkt @@ -1,14 +1,14 @@ -#lang scheme/base -(require scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe + racket/class "../../syntax.rkt" "button.rkt" "utils.rkt" "types.rkt" "../../lock.rkt") -(unsafe!) -(provide check-box%) +(provide + (protect-out check-box%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/choice.rkt b/collects/mred/private/wx/gtk/choice.rkt index 9127a229..39802d2c 100644 --- a/collects/mred/private/wx/gtk/choice.rkt +++ b/collects/mred/private/wx/gtk/choice.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe + racket/class "../../syntax.rkt" "../../lock.rkt" "item.rkt" @@ -10,9 +10,9 @@ "combo.rkt" "../common/event.rkt" "../common/queue.rkt") -(unsafe!) -(provide choice%) +(provide + (protect-out choice%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/client-window.rkt b/collects/mred/private/wx/gtk/client-window.rkt index ed86c963..4382815f 100644 --- a/collects/mred/private/wx/gtk/client-window.rkt +++ b/collects/mred/private/wx/gtk/client-window.rkt @@ -1,15 +1,15 @@ -#lang scheme/base -(require scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe + racket/class "../../syntax.rkt" "widget.rkt" "window.rkt" "utils.rkt" "const.rkt" "types.rkt") -(unsafe!) -(provide client-size-mixin) +(provide + (protect-out client-size-mixin)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/clipboard.rkt b/collects/mred/private/wx/gtk/clipboard.rkt index e74f3d23..06f01340 100644 --- a/collects/mred/private/wx/gtk/clipboard.rkt +++ b/collects/mred/private/wx/gtk/clipboard.rkt @@ -2,20 +2,21 @@ (require racket/class ffi/unsafe ffi/unsafe/alloc + racket/draw/unsafe/bstr "../../syntax.rkt" "../../lock.rkt" "../common/queue.rkt" "../common/local.rkt" - "../common/bstr.rkt" "utils.rkt" "types.rkt" "pixbuf.rkt") -(provide clipboard-driver% - has-x-selection? - _GtkSelectionData - gtk_selection_data_get_length - gtk_selection_data_get_data) +(provide + (protect-out clipboard-driver% + has-x-selection? + _GtkSelectionData + gtk_selection_data_get_length + gtk_selection_data_get_data)) (define (has-x-selection?) #t) diff --git a/collects/mred/private/wx/gtk/colordialog.rkt b/collects/mred/private/wx/gtk/colordialog.rkt index c836da71..1c26323d 100644 --- a/collects/mred/private/wx/gtk/colordialog.rkt +++ b/collects/mred/private/wx/gtk/colordialog.rkt @@ -1,12 +1,13 @@ #lang racket/base (require ffi/unsafe racket/class - racket/draw/color + racket/draw/private/color "types.rkt" "utils.rkt" "stddialog.rkt") -(provide get-color-from-user) +(provide + (protect-out get-color-from-user)) (define-gtk gtk_color_selection_dialog_new (_fun _string -> _GtkWidget)) diff --git a/collects/mred/private/wx/gtk/combo.rkt b/collects/mred/private/wx/gtk/combo.rkt index d0c08c37..212aadfe 100644 --- a/collects/mred/private/wx/gtk/combo.rkt +++ b/collects/mred/private/wx/gtk/combo.rkt @@ -1,16 +1,16 @@ -#lang scheme/base -(require scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe + racket/class "../../syntax.rkt" "types.rkt" "utils.rkt" "window.rkt") -(unsafe!) ;; Hacks for working with GtkComboBox[Entry] -(provide extract-combo-button - connect-combo-key-and-mouse) +(provide + (protect-out extract-combo-button + connect-combo-key-and-mouse)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/const.rkt b/collects/mred/private/wx/gtk/const.rkt index 54b8cb0e..f7650353 100644 --- a/collects/mred/private/wx/gtk/const.rkt +++ b/collects/mred/private/wx/gtk/const.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (provide (except-out (all-defined-out) <<)) diff --git a/collects/mred/private/wx/gtk/cursor.rkt b/collects/mred/private/wx/gtk/cursor.rkt index 564e6536..da92895a 100644 --- a/collects/mred/private/wx/gtk/cursor.rkt +++ b/collects/mred/private/wx/gtk/cursor.rkt @@ -8,9 +8,10 @@ "../common/cursor-draw.rkt" "../../syntax.rkt") -(provide cursor-driver% - get-arrow-cursor-handle - get-watch-cursor-handle) +(provide + (protect-out cursor-driver% + get-arrow-cursor-handle + get-watch-cursor-handle)) (define GDK_ARROW 2) ; ugly! (define GDK_CROSSHAIR 34) diff --git a/collects/mred/private/wx/gtk/dc.rkt b/collects/mred/private/wx/gtk/dc.rkt index 331f7f3a..bc770391 100644 --- a/collects/mred/private/wx/gtk/dc.rkt +++ b/collects/mred/private/wx/gtk/dc.rkt @@ -9,15 +9,16 @@ "gl-context.rkt" "../../lock.rkt" "../common/backing-dc.rkt" - racket/draw/cairo - racket/draw/dc - racket/draw/bitmap - racket/draw/local + racket/draw/unsafe/cairo + racket/draw/private/dc + racket/draw/private/bitmap + racket/draw/private/local ffi/unsafe/alloc) -(provide dc% - do-backing-flush - x11-bitmap%) +(provide + (protect-out dc% + do-backing-flush + x11-bitmap%)) (define-gdk gdk_cairo_create (_fun _pointer -> _cairo_t) #:wrap (allocator cairo_destroy)) diff --git a/collects/mred/private/wx/gtk/dialog.rkt b/collects/mred/private/wx/gtk/dialog.rkt index 04477ac8..209930d9 100644 --- a/collects/mred/private/wx/gtk/dialog.rkt +++ b/collects/mred/private/wx/gtk/dialog.rkt @@ -1,5 +1,5 @@ -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class ffi/unsafe "../../syntax.rkt" "../common/queue.rkt" @@ -9,7 +9,8 @@ "utils.rkt" "frame.rkt") -(provide dialog%) +(provide + (protect-out dialog%)) (define GTK_WIN_POS_CENTER 1) (define GTK_WIN_POS_CENTER_ON_PARENT 4) diff --git a/collects/mred/private/wx/gtk/filedialog.rkt b/collects/mred/private/wx/gtk/filedialog.rkt index 97034faa..9520771f 100644 --- a/collects/mred/private/wx/gtk/filedialog.rkt +++ b/collects/mred/private/wx/gtk/filedialog.rkt @@ -12,7 +12,8 @@ "../common/handlers.rkt" "../common/queue.rkt") -(provide file-selector) +(provide + (protect-out file-selector)) (define _GtkFileChooserDialog _GtkWidget) (define _GtkFileChooser (_cpointer 'GtkFileChooser)) diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt index c76c3de6..34916efb 100644 --- a/collects/mred/private/wx/gtk/frame.rkt +++ b/collects/mred/private/wx/gtk/frame.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe racket/class racket/promise @@ -17,10 +17,11 @@ "pixbuf.rkt" "../common/queue.rkt") -(provide frame% - display-origin - display-size - location->window) +(provide + (protect-out frame% + display-origin + display-size + location->window)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/gauge.rkt b/collects/mred/private/wx/gtk/gauge.rkt index 2bb45011..dda1a9a5 100644 --- a/collects/mred/private/wx/gtk/gauge.rkt +++ b/collects/mred/private/wx/gtk/gauge.rkt @@ -1,15 +1,15 @@ -#lang scheme/base -(require scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe + racket/class "../../syntax.rkt" "item.rkt" "utils.rkt" "types.rkt" "window.rkt" "const.rkt") -(unsafe!) -(provide gauge%) +(provide + (protect-out gauge%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/gcwin.rkt b/collects/mred/private/wx/gtk/gcwin.rkt index 49701b74..d017aeba 100644 --- a/collects/mred/private/wx/gtk/gcwin.rkt +++ b/collects/mred/private/wx/gtk/gcwin.rkt @@ -4,11 +4,12 @@ "types.rkt" "window.rkt") -(provide scheme_add_gc_callback - scheme_remove_gc_callback - create-gc-window - make-gc-show-desc - make-gc-hide-desc) +(provide + (protect-out scheme_add_gc_callback + scheme_remove_gc_callback + create-gc-window + make-gc-show-desc + make-gc-hide-desc)) (define-cstruct _GdkWindowAttr ([title _string] diff --git a/collects/mred/private/wx/gtk/gl-context.rkt b/collects/mred/private/wx/gtk/gl-context.rkt index 7f0aae79..40769f44 100644 --- a/collects/mred/private/wx/gtk/gl-context.rkt +++ b/collects/mred/private/wx/gtk/gl-context.rkt @@ -3,17 +3,18 @@ ffi/unsafe ffi/unsafe/define ffi/unsafe/alloc - (prefix-in draw: racket/draw/gl-context) - racket/draw/gl-config + (prefix-in draw: racket/draw/private/gl-context) + racket/draw/private/gl-config "types.rkt" "utils.rkt") -(provide prepare-widget-gl-context - create-widget-gl-context +(provide + (protect-out prepare-widget-gl-context + create-widget-gl-context - create-and-install-gl-context - get-gdk-pixmap - install-gl-context) + create-and-install-gl-context + get-gdk-pixmap + install-gl-context)) (define gdkglext-lib (with-handlers ([exn:fail? (lambda (exn) #f)]) diff --git a/collects/mred/private/wx/gtk/group-panel.rkt b/collects/mred/private/wx/gtk/group-panel.rkt index c864a442..734feee3 100644 --- a/collects/mred/private/wx/gtk/group-panel.rkt +++ b/collects/mred/private/wx/gtk/group-panel.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/class - scheme/foreign +#lang racket/base +(require racket/class + ffi/unsafe "../../syntax.rkt" "../../lock.rkt" "window.rkt" @@ -8,9 +8,9 @@ "panel.rkt" "utils.rkt" "types.rkt") -(unsafe!) -(provide group-panel%) +(provide + (protect-out group-panel%)) (define-gtk gtk_frame_new (_fun _string -> _GtkWidget)) (define-gtk gtk_fixed_new (_fun -> _GtkWidget)) diff --git a/collects/mred/private/wx/gtk/init.rkt b/collects/mred/private/wx/gtk/init.rkt index ba601aeb..ded4146b 100644 --- a/collects/mred/private/wx/gtk/init.rkt +++ b/collects/mred/private/wx/gtk/init.rkt @@ -1,17 +1,14 @@ -#lang scheme/base -(require scheme/foreign +#lang racket/base +(require ffi/unsafe "utils.rkt" "types.rkt" "queue.rkt") -(unsafe!) (define-gtk gtk_rc_parse_string (_fun _string -> _void)) (define-gtk gtk_rc_add_default_file (_fun _path -> _void)) -(define-gtk gtk_rc_find_module_in_path (_fun _path -> _path)) -(define-gtk gtk_rc_get_module_dir (_fun -> _path)) (when (eq? 'windows (system-type)) - (let ([dir (simplify-path (build-path (collection-path "scheme") 'up 'up "lib"))]) + (let ([dir (simplify-path (build-path (collection-path "racket") 'up 'up "lib"))]) (gtk_rc_parse_string (format "module_path \"~a\"\n" dir)) (gtk_rc_add_default_file (build-path dir "gtkrc")))) diff --git a/collects/mred/private/wx/gtk/item.rkt b/collects/mred/private/wx/gtk/item.rkt index e63bfada..dbfd10bd 100644 --- a/collects/mred/private/wx/gtk/item.rkt +++ b/collects/mred/private/wx/gtk/item.rkt @@ -1,14 +1,15 @@ #lang racket/base (require ffi/unsafe racket/class - racket/draw/local + racket/draw/private/local "../../syntax.rkt" "window.rkt" "utils.rkt" "types.rkt") -(provide item% - install-control-font) +(provide + (protect-out item% + install-control-font)) (define _PangoFontDescription _pointer) (define-gtk gtk_widget_modify_font (_fun _GtkWidget _PangoFontDescription -> _void)) diff --git a/collects/mred/private/wx/gtk/keycode.rkt b/collects/mred/private/wx/gtk/keycode.rkt index 9830dfa7..b5e7eb36 100644 --- a/collects/mred/private/wx/gtk/keycode.rkt +++ b/collects/mred/private/wx/gtk/keycode.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (provide map-key-code) diff --git a/collects/mred/private/wx/gtk/keymap.rkt b/collects/mred/private/wx/gtk/keymap.rkt index fc827e06..80ff0c4e 100644 --- a/collects/mred/private/wx/gtk/keymap.rkt +++ b/collects/mred/private/wx/gtk/keymap.rkt @@ -4,7 +4,8 @@ "const.rkt" "types.rkt") -(provide get-alts) +(provide + (protect-out get-alts)) (define _GdkKeymap (_cpointer 'GdkKeymap)) diff --git a/collects/mred/private/wx/gtk/list-box.rkt b/collects/mred/private/wx/gtk/list-box.rkt index 3b18357a..a37a3401 100644 --- a/collects/mred/private/wx/gtk/list-box.rkt +++ b/collects/mred/private/wx/gtk/list-box.rkt @@ -1,7 +1,7 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe ffi/unsafe/define - scheme/class + racket/class (only-in racket/list take drop) "../../syntax.rkt" "../../lock.rkt" @@ -12,7 +12,8 @@ "const.rkt" "../common/event.rkt") -(provide list-box%) +(provide + (protect-out list-box%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/menu-bar.rkt b/collects/mred/private/wx/gtk/menu-bar.rkt index ce1e887f..45ff8b43 100644 --- a/collects/mred/private/wx/gtk/menu-bar.rkt +++ b/collects/mred/private/wx/gtk/menu-bar.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/class - scheme/foreign +#lang racket/base +(require racket/class + ffi/unsafe "../../syntax.rkt" "../../lock.rkt" "../common/freeze.rkt" @@ -9,12 +9,12 @@ "window.rkt" "utils.rkt" "types.rkt") -(unsafe!) -(provide menu-bar% - gtk_menu_item_new_with_mnemonic - gtk_menu_shell_append - fixup-mneumonic) +(provide + (protect-out menu-bar% + gtk_menu_item_new_with_mnemonic + gtk_menu_shell_append + fixup-mneumonic)) (define-gtk gtk_menu_bar_new (_fun -> _GtkWidget)) (define-gtk gtk_menu_shell_append (_fun _GtkWidget _GtkWidget -> _void)) diff --git a/collects/mred/private/wx/gtk/menu-item.rkt b/collects/mred/private/wx/gtk/menu-item.rkt index afe240e0..a6b6c342 100644 --- a/collects/mred/private/wx/gtk/menu-item.rkt +++ b/collects/mred/private/wx/gtk/menu-item.rkt @@ -1,8 +1,9 @@ -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class "../../syntax.rkt") -(provide menu-item%) +(provide + (protect-out menu-item%)) (defclass menu-item% object% (define/public (id) this) diff --git a/collects/mred/private/wx/gtk/menu.rkt b/collects/mred/private/wx/gtk/menu.rkt index a4207ffa..732821bd 100644 --- a/collects/mred/private/wx/gtk/menu.rkt +++ b/collects/mred/private/wx/gtk/menu.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/class - scheme/foreign +#lang racket/base +(require racket/class + ffi/unsafe "widget.rkt" "window.rkt" "../../syntax.rkt" @@ -10,9 +10,9 @@ "utils.rkt" "menu-bar.rkt" "../common/event.rkt") -(unsafe!) -(provide menu%) +(provide + (protect-out menu%)) (define-gtk gtk_menu_new (_fun -> _GtkWidget)) (define-gtk gtk_check_menu_item_new_with_mnemonic (_fun _string -> _GtkWidget)) diff --git a/collects/mred/private/wx/gtk/message.rkt b/collects/mred/private/wx/gtk/message.rkt index d74513fd..fd47ac52 100644 --- a/collects/mred/private/wx/gtk/message.rkt +++ b/collects/mred/private/wx/gtk/message.rkt @@ -1,18 +1,18 @@ -#lang scheme/base -(require scheme/class - scheme/foreign +#lang racket/base +(require racket/class + ffi/unsafe "../../syntax.rkt" "item.rkt" "utils.rkt" "types.rkt" "pixbuf.rkt") -(unsafe!) -(provide message% - - gtk_label_new_with_mnemonic - gtk_label_set_text_with_mnemonic - mnemonic-string) +(provide + (protect-out message% + + gtk_label_new_with_mnemonic + gtk_label_set_text_with_mnemonic + mnemonic-string)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/panel.rkt b/collects/mred/private/wx/gtk/panel.rkt index e485751f..280ad9aa 100644 --- a/collects/mred/private/wx/gtk/panel.rkt +++ b/collects/mred/private/wx/gtk/panel.rkt @@ -1,5 +1,5 @@ -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class ffi/unsafe "../../syntax.rkt" "../../lock.rkt" @@ -8,8 +8,9 @@ "types.rkt" "const.rkt") -(provide panel% - panel-mixin) +(provide + (protect-out panel% + panel-mixin)) (define-gtk gtk_fixed_new (_fun -> _GtkWidget)) (define-gtk gtk_event_box_new (_fun -> _GtkWidget)) diff --git a/collects/mred/private/wx/gtk/pixbuf.rkt b/collects/mred/private/wx/gtk/pixbuf.rkt index e89507a6..d5c2733c 100644 --- a/collects/mred/private/wx/gtk/pixbuf.rkt +++ b/collects/mred/private/wx/gtk/pixbuf.rkt @@ -1,22 +1,23 @@ -#lang racket +#lang racket/base (require racket/class ffi/unsafe ffi/unsafe/alloc racket/draw - racket/draw/local - racket/draw/cairo + racket/draw/private/local + racket/draw/unsafe/cairo "../../lock.rkt" - "../common/bstr.rkt" + racket/draw/unsafe/bstr "utils.rkt" "types.rkt" (only-in '#%foreign ffi-callback)) -(provide bitmap->pixbuf - pixbuf->bitmap - - _GdkPixbuf - gtk_image_new_from_pixbuf - release-pixbuf) +(provide + (protect-out bitmap->pixbuf + pixbuf->bitmap + + _GdkPixbuf + gtk_image_new_from_pixbuf + release-pixbuf)) (define _GdkPixbuf (_cpointer/null 'GdkPixbuf)) diff --git a/collects/mred/private/wx/gtk/platform.rkt b/collects/mred/private/wx/gtk/platform.rkt index 9f1d9eb2..0abd4fa3 100644 --- a/collects/mred/private/wx/gtk/platform.rkt +++ b/collects/mred/private/wx/gtk/platform.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require "init.rkt" "button.rkt" "canvas.rkt" @@ -23,7 +23,8 @@ "tab-panel.rkt" "window.rkt" "procs.rkt") -(provide platform-values) +(provide + (protect-out platform-values)) (define (platform-values) (values @@ -60,8 +61,6 @@ bell display-size display-origin - get-resource - write-resource flush-display fill-private-color cancel-quit @@ -71,7 +70,6 @@ get-double-click-time run-printout file-creator-and-type - send-event location->window shortcut-visible-in-label? unregister-collecting-blit diff --git a/collects/mred/private/wx/gtk/printer-dc.rkt b/collects/mred/private/wx/gtk/printer-dc.rkt index d72a47fa..92980523 100644 --- a/collects/mred/private/wx/gtk/printer-dc.rkt +++ b/collects/mred/private/wx/gtk/printer-dc.rkt @@ -1,12 +1,12 @@ #lang racket/base (require racket/class - racket/draw/local - racket/draw/dc - racket/draw/cairo - racket/draw/bitmap - racket/draw/bitmap-dc - racket/draw/record-dc - racket/draw/ps-setup + racket/draw/private/local + racket/draw/private/dc + racket/draw/unsafe/cairo + racket/draw/private/bitmap + racket/draw/private/bitmap-dc + racket/draw/private/record-dc + racket/draw/private/ps-setup ffi/unsafe ffi/unsafe/alloc "../common/queue.rkt" @@ -14,8 +14,9 @@ "utils.rkt" "types.rkt") -(provide printer-dc% - show-print-setup) +(provide + (protect-out printer-dc% + show-print-setup)) (define GTK_UNIT_POINTS 1) diff --git a/collects/mred/private/wx/gtk/procs.rkt b/collects/mred/private/wx/gtk/procs.rkt index 3ab44b98..c88d3a22 100644 --- a/collects/mred/private/wx/gtk/procs.rkt +++ b/collects/mred/private/wx/gtk/procs.rkt @@ -20,52 +20,47 @@ "../common/handlers.rkt") (provide - special-control-key - special-option-key - get-color-from-user - color-from-user-platform-mode - get-font-from-user - font-from-user-platform-mode - get-panel-background - play-sound - find-graphical-system-path - register-collecting-blit - unregister-collecting-blit - shortcut-visible-in-label? - location->window - send-event - file-creator-and-type - run-printout - get-double-click-time - get-control-font-face - get-control-font-size - get-control-font-size-in-pixels? - cancel-quit - fill-private-color - flush-display - write-resource - get-resource + (protect-out + color-from-user-platform-mode + get-font-from-user + font-from-user-platform-mode + play-sound + find-graphical-system-path + register-collecting-blit + unregister-collecting-blit + shortcut-visible-in-label? + run-printout + get-double-click-time + get-control-font-face + get-control-font-size + get-control-font-size-in-pixels? + cancel-quit + bell + hide-cursor + get-display-depth + is-color-display? + id-to-menu-item + can-show-print-setup? + get-highlight-background-color + get-highlight-text-color + check-for-break) + file-selector + show-print-setup display-origin display-size - bell - hide-cursor - get-display-depth - is-color-display? - file-selector - id-to-menu-item - show-print-setup - can-show-print-setup? - get-highlight-background-color - get-highlight-text-color + flush-display + location->window make-screen-bitmap make-gl-bitmap - check-for-break) + file-creator-and-type + special-control-key + special-option-key + get-panel-background + fill-private-color + get-color-from-user) (define-unimplemented find-graphical-system-path) -(define-unimplemented send-event) (define-unimplemented cancel-quit) -(define-unimplemented write-resource) -(define-unimplemented get-resource) (define-unimplemented play-sound) diff --git a/collects/mred/private/wx/gtk/queue.rkt b/collects/mred/private/wx/gtk/queue.rkt index a8c41134..b0885b51 100644 --- a/collects/mred/private/wx/gtk/queue.rkt +++ b/collects/mred/private/wx/gtk/queue.rkt @@ -10,12 +10,9 @@ "w32.rkt" "unique.rkt") -(provide gtk-start-event-pump - - try-to-sync-refresh - - set-widget-hook! - +(provide (protect-out gtk-start-event-pump + try-to-sync-refresh + set-widget-hook!) ;; from common/queue: current-eventspace queue-event diff --git a/collects/mred/private/wx/gtk/radio-box.rkt b/collects/mred/private/wx/gtk/radio-box.rkt index 6039e5d4..446c410a 100644 --- a/collects/mred/private/wx/gtk/radio-box.rkt +++ b/collects/mred/private/wx/gtk/radio-box.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/class - scheme/foreign +#lang racket/base +(require racket/class + ffi/unsafe "../../syntax.rkt" "item.rkt" (except-in "utils.rkt" _GSList) @@ -11,9 +11,9 @@ "message.rkt" "../common/event.rkt" "../../lock.rkt") -(unsafe!) -(provide radio-box%) +(provide + (protect-out radio-box%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/slider.rkt b/collects/mred/private/wx/gtk/slider.rkt index c2888a25..b120a29a 100644 --- a/collects/mred/private/wx/gtk/slider.rkt +++ b/collects/mred/private/wx/gtk/slider.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/foreign - scheme/class +#lang racket/base +(require ffi/unsafe + racket/class "../../syntax.rkt" "item.rkt" "utils.rkt" @@ -9,9 +9,9 @@ "const.rkt" "../common/event.rkt" "../../lock.rkt") -(unsafe!) -(provide slider%) +(provide + (protect-out slider%)) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/stddialog.rkt b/collects/mred/private/wx/gtk/stddialog.rkt index 49d6449b..f2a2dc78 100644 --- a/collects/mred/private/wx/gtk/stddialog.rkt +++ b/collects/mred/private/wx/gtk/stddialog.rkt @@ -7,8 +7,9 @@ "queue.rkt" "../common/queue.rkt") -(provide show-dialog - _GtkResponse) +(provide + (protect-out show-dialog + _GtkResponse)) (define _GtkResponse (_enum diff --git a/collects/mred/private/wx/gtk/style.rkt b/collects/mred/private/wx/gtk/style.rkt index 808f585a..4cc7f1e6 100644 --- a/collects/mred/private/wx/gtk/style.rkt +++ b/collects/mred/private/wx/gtk/style.rkt @@ -4,8 +4,9 @@ "utils.rkt" "init.rkt") -(provide get-selected-text-color - get-selected-background-color) +(provide + (protect-out get-selected-text-color + get-selected-background-color)) (define-cstruct _GTypeInstance ([class _pointer])) diff --git a/collects/mred/private/wx/gtk/tab-panel.rkt b/collects/mred/private/wx/gtk/tab-panel.rkt index 75ad7e1d..33dfaa0c 100644 --- a/collects/mred/private/wx/gtk/tab-panel.rkt +++ b/collects/mred/private/wx/gtk/tab-panel.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/class - scheme/foreign +#lang racket/base +(require racket/class + ffi/unsafe "../../syntax.rkt" "window.rkt" "client-window.rkt" @@ -10,9 +10,9 @@ "widget.rkt" "message.rkt" "../common/event.rkt") -(unsafe!) -(provide tab-panel%) +(provide + (protect-out tab-panel%)) (define-gtk gtk_notebook_new (_fun -> _GtkWidget)) (define-gtk gtk_fixed_new (_fun -> _GtkWidget)) diff --git a/collects/mred/private/wx/gtk/types.rkt b/collects/mred/private/wx/gtk/types.rkt index 7d2fd03a..0274dc50 100644 --- a/collects/mred/private/wx/gtk/types.rkt +++ b/collects/mred/private/wx/gtk/types.rkt @@ -1,35 +1,35 @@ -#lang scheme/base -(require scheme/foreign) -(unsafe!) +#lang racket/base +(require ffi/unsafe) -(provide _GdkWindow - _GtkWidget _GtkWindow - _GdkDisplay - _GdkScreen - _gpointer - _GType +(provide + (protect-out _GdkWindow + _GtkWidget _GtkWindow + _GdkDisplay + _GdkScreen + _gpointer + _GType - _fnpointer - _gboolean - _gfloat + _fnpointer + _gboolean + _gfloat - _GdkEventButton _GdkEventButton-pointer - (struct-out GdkEventButton) - _GdkEventKey _GdkEventKey-pointer - (struct-out GdkEventKey) - _GdkEventScroll _GdkEventScroll-pointer - (struct-out GdkEventScroll) - _GdkEventMotion _GdkEventMotion-pointer - (struct-out GdkEventMotion) - _GdkEventCrossing _GdkEventCrossing-pointer - (struct-out GdkEventCrossing) - _GdkEventConfigure _GdkEventConfigure-pointer - (struct-out GdkEventConfigure) - _GdkEventExpose _GdkEventExpose-pointer - (struct-out GdkEventExpose) - (struct-out GdkRectangle) - _GdkColor _GdkColor-pointer - (struct-out GdkColor)) + _GdkEventButton _GdkEventButton-pointer + (struct-out GdkEventButton) + _GdkEventKey _GdkEventKey-pointer + (struct-out GdkEventKey) + _GdkEventScroll _GdkEventScroll-pointer + (struct-out GdkEventScroll) + _GdkEventMotion _GdkEventMotion-pointer + (struct-out GdkEventMotion) + _GdkEventCrossing _GdkEventCrossing-pointer + (struct-out GdkEventCrossing) + _GdkEventConfigure _GdkEventConfigure-pointer + (struct-out GdkEventConfigure) + _GdkEventExpose _GdkEventExpose-pointer + (struct-out GdkEventExpose) + (struct-out GdkRectangle) + _GdkColor _GdkColor-pointer + (struct-out GdkColor))) (define _GType _long) diff --git a/collects/mred/private/wx/gtk/unique.rkt b/collects/mred/private/wx/gtk/unique.rkt index ca139be8..5385a725 100644 --- a/collects/mred/private/wx/gtk/unique.rkt +++ b/collects/mred/private/wx/gtk/unique.rkt @@ -1,13 +1,14 @@ #lang racket/base (require ffi/unsafe ffi/unsafe/define - racket/draw/bstr + racket/draw/unsafe/bstr net/base64 "../common/queue.rkt" "types.rkt" "utils.rkt") -(provide do-single-instance) +(provide + (protect-out do-single-instance)) (define unique-lib (with-handlers ([exn:fail? (lambda (exn) #f)]) diff --git a/collects/mred/private/wx/gtk/utils.rkt b/collects/mred/private/wx/gtk/utils.rkt index f92202c1..180533b7 100644 --- a/collects/mred/private/wx/gtk/utils.rkt +++ b/collects/mred/private/wx/gtk/utils.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe ffi/unsafe/define ffi/unsafe/alloc @@ -6,46 +6,47 @@ "../common/utils.rkt" "types.rkt") -(provide define-gtk - define-gdk - define-gobj - define-gio - define-glib - define-gdk_pixbuf - define-mz +(provide + define-mz + (protect-out define-gtk + define-gdk + define-gobj + define-gio + define-glib + define-gdk_pixbuf - g_object_ref - g_object_ref_sink - g_object_unref + g_object_ref + g_object_ref_sink + g_object_unref - gobject-ref - gobject-unref - as-gobject-allocation + gobject-ref + gobject-unref + as-gobject-allocation - as-gtk-allocation - as-gtk-window-allocation + as-gtk-allocation + as-gtk-window-allocation - g_free - _gpath/free - _GSList - gfree + g_free + _gpath/free + _GSList + gfree - g_object_set_data - g_object_get_data + g_object_set_data + g_object_get_data - g_object_new + g_object_new - (rename-out [g_object_get g_object_get_window]) + (rename-out [g_object_get g_object_get_window]) - get-gtk-object-flags - set-gtk-object-flags! + get-gtk-object-flags + set-gtk-object-flags! - define-signal-handler + define-signal-handler - gdk_screen_get_default + gdk_screen_get_default - ;; for declaring derived structures: - _GtkObject) + ;; for declaring derived structures: + _GtkObject)) (define gdk-lib (case (system-type) diff --git a/collects/mred/private/wx/gtk/widget.rkt b/collects/mred/private/wx/gtk/widget.rkt index 4ee5f740..ed9e5327 100644 --- a/collects/mred/private/wx/gtk/widget.rkt +++ b/collects/mred/private/wx/gtk/widget.rkt @@ -8,17 +8,18 @@ "utils.rkt" "types.rkt") -(provide widget% - gtk->wx +(provide + (protect-out widget% + gtk->wx - gtk_widget_show - gtk_widget_hide - gtk_widget_destroy + gtk_widget_show + gtk_widget_hide + gtk_widget_destroy - gtk_vbox_new - gtk_hbox_new - gtk_box_pack_start - gtk_box_pack_end) + gtk_vbox_new + gtk_hbox_new + gtk_box_pack_start + gtk_box_pack_end)) (define-gtk gtk_widget_show (_fun _GtkWidget -> _void)) (define-gtk gtk_widget_hide (_fun _GtkWidget -> _void)) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index 0aa30e25..b55c04c1 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -9,7 +9,7 @@ "../common/queue.rkt" "../common/local.rkt" "../common/delay.rkt" - "../common/bstr.rkt" + racket/draw/unsafe/bstr "keycode.rkt" "keymap.rkt" "queue.rkt" @@ -19,39 +19,40 @@ "widget.rkt" "clipboard.rkt") -(provide window% - gtk->wx - queue-window-event - queue-window-refresh-event +(provide + (protect-out window% + queue-window-event + queue-window-refresh-event - gtk_widget_show - gtk_widget_hide - gtk_widget_realize - gtk_container_add - gtk_widget_add_events - gtk_widget_size_request - gtk_widget_set_size_request - gtk_widget_grab_focus - gtk_widget_set_sensitive + gtk_widget_realize + gtk_container_add + gtk_widget_add_events + gtk_widget_size_request + gtk_widget_set_size_request + gtk_widget_grab_focus + gtk_widget_set_sensitive - connect-focus - connect-key-and-mouse - do-button-event + connect-focus + connect-key-and-mouse + do-button-event - (struct-out GtkRequisition) _GtkRequisition-pointer - (struct-out GtkAllocation) _GtkAllocation-pointer + (struct-out GtkRequisition) _GtkRequisition-pointer + (struct-out GtkAllocation) _GtkAllocation-pointer - widget-window + widget-window - the-accelerator-group - gtk_window_add_accel_group - gtk_menu_set_accel_group + the-accelerator-group + gtk_window_add_accel_group + gtk_menu_set_accel_group - flush-display - gdk_display_get_default + flush-display + gdk_display_get_default - request-flush-delay - cancel-flush-delay) + request-flush-delay + cancel-flush-delay) + gtk->wx + gtk_widget_show + gtk_widget_hide) ;; ---------------------------------------- diff --git a/collects/mred/private/wx/gtk/x11.rkt b/collects/mred/private/wx/gtk/x11.rkt index dce8ea4c..cda9c15a 100644 --- a/collects/mred/private/wx/gtk/x11.rkt +++ b/collects/mred/private/wx/gtk/x11.rkt @@ -4,12 +4,13 @@ ffi/unsafe/alloc "utils.rkt") -(provide gdk_pixmap_new - gdk_drawable_get_display - gdk_drawable_get_visual - gdk_x11_drawable_get_xid - gdk_x11_display_get_xdisplay - gdk_x11_visual_get_xvisual) +(provide + (protect-out gdk_pixmap_new + gdk_drawable_get_display + gdk_drawable_get_visual + gdk_x11_drawable_get_xid + gdk_x11_display_get_xdisplay + gdk_x11_visual_get_xvisual)) (define _GdkDrawable _pointer) (define _GdkDisplay (_cpointer 'GdkDisplay)) diff --git a/collects/mred/private/wx/platform.rkt b/collects/mred/private/wx/platform.rkt index 8ecb9b16..79dcef79 100644 --- a/collects/mred/private/wx/platform.rkt +++ b/collects/mred/private/wx/platform.rkt @@ -1,6 +1,8 @@ #lang racket/base -(require racket/runtime-path (for-syntax racket/base)) -(provide (all-defined-out)) +(require racket/runtime-path + (for-syntax racket/base)) +(provide + (protect-out (all-defined-out))) (define-runtime-module-path-index platform-lib (let ([gtk-lib @@ -45,8 +47,6 @@ bell display-size display-origin - get-resource - write-resource flush-display fill-private-color cancel-quit @@ -56,7 +56,6 @@ get-double-click-time run-printout file-creator-and-type - send-event location->window shortcut-visible-in-label? unregister-collecting-blit diff --git a/collects/mred/private/wx/win32/button.rkt b/collects/mred/private/wx/win32/button.rkt index f455c192..0c3a2924 100644 --- a/collects/mred/private/wx/win32/button.rkt +++ b/collects/mred/private/wx/win32/button.rkt @@ -12,8 +12,9 @@ "hbitmap.rkt" "types.rkt") -(provide base-button% - button%) +(provide + (protect-out base-button% + button%)) (define BM_SETSTYLE #x00F4) diff --git a/collects/mred/private/wx/win32/canvas.rkt b/collects/mred/private/wx/win32/canvas.rkt index a681d2f9..f46c513b 100644 --- a/collects/mred/private/wx/win32/canvas.rkt +++ b/collects/mred/private/wx/win32/canvas.rkt @@ -20,7 +20,8 @@ "gcwin.rkt" "theme.rkt") -(provide canvas%) +(provide + (protect-out canvas%)) (define WS_EX_STATICEDGE #x00020000) (define WS_EX_CLIENTEDGE #x00000200) diff --git a/collects/mred/private/wx/win32/check-box.rkt b/collects/mred/private/wx/win32/check-box.rkt index 675e4ae0..3106b450 100644 --- a/collects/mred/private/wx/win32/check-box.rkt +++ b/collects/mred/private/wx/win32/check-box.rkt @@ -6,7 +6,8 @@ "utils.rkt" "const.rkt") -(provide check-box%) +(provide + (protect-out check-box%)) (define BM_GETCHECK #x00F0) (define BM_SETCHECK #x00F1) diff --git a/collects/mred/private/wx/win32/choice.rkt b/collects/mred/private/wx/win32/choice.rkt index a584a698..940cca94 100644 --- a/collects/mred/private/wx/win32/choice.rkt +++ b/collects/mred/private/wx/win32/choice.rkt @@ -12,7 +12,8 @@ "wndclass.rkt" "types.rkt") -(provide choice%) +(provide + (protect-out choice%)) (define CBN_DROPDOWN 7) (define CBN_CLOSEUP 8) diff --git a/collects/mred/private/wx/win32/clipboard.rkt b/collects/mred/private/wx/win32/clipboard.rkt index 9fca7274..3b999c69 100644 --- a/collects/mred/private/wx/win32/clipboard.rkt +++ b/collects/mred/private/wx/win32/clipboard.rkt @@ -2,7 +2,7 @@ (require racket/class ffi/unsafe ffi/unsafe/alloc - racket/draw/bstr + racket/draw/unsafe/bstr "../common/queue.rkt" "../../lock.rkt" "types.rkt" @@ -12,8 +12,9 @@ "wndclass.rkt" "hbitmap.rkt") -(provide clipboard-driver% - has-x-selection?) +(provide + (protect-out clipboard-driver% + has-x-selection?)) (define (has-x-selection?) #f) diff --git a/collects/mred/private/wx/win32/colordialog.rkt b/collects/mred/private/wx/win32/colordialog.rkt index 7147ef38..8a99959c 100644 --- a/collects/mred/private/wx/win32/colordialog.rkt +++ b/collects/mred/private/wx/win32/colordialog.rkt @@ -2,14 +2,15 @@ (require ffi/unsafe racket/class racket/string - racket/draw/color + racket/draw/private/color "utils.rkt" "types.rkt" "const.rkt" "wndclass.rkt" "../../lock.rkt") -(provide get-color-from-user) +(provide + (protect-out get-color-from-user)) (define-cstruct _CHOOSECOLOR ([lStructSize _DWORD] diff --git a/collects/mred/private/wx/win32/const.rkt b/collects/mred/private/wx/win32/const.rkt index b32a3072..ecfcc941 100644 --- a/collects/mred/private/wx/win32/const.rkt +++ b/collects/mred/private/wx/win32/const.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (provide (all-defined-out)) (define WM_NULL #x0000) diff --git a/collects/mred/private/wx/win32/cursor.rkt b/collects/mred/private/wx/win32/cursor.rkt index 3af7c172..b49bec95 100644 --- a/collects/mred/private/wx/win32/cursor.rkt +++ b/collects/mred/private/wx/win32/cursor.rkt @@ -8,9 +8,10 @@ "../common/cursor-draw.rkt" "../../syntax.rkt") -(provide cursor-driver% - get-arrow-cursor - get-wait-cursor) +(provide + (protect-out cursor-driver% + get-arrow-cursor + get-wait-cursor)) (define (MAKEINTRESOURCE v) v) diff --git a/collects/mred/private/wx/win32/dc.rkt b/collects/mred/private/wx/win32/dc.rkt index 51e3fc86..d3b6ead0 100644 --- a/collects/mred/private/wx/win32/dc.rkt +++ b/collects/mred/private/wx/win32/dc.rkt @@ -7,17 +7,18 @@ "../../lock.rkt" "../common/backing-dc.rkt" "../common/delay.rkt" - racket/draw/cairo - racket/draw/dc - racket/draw/bitmap - racket/draw/local + racket/draw/unsafe/cairo + racket/draw/private/dc + racket/draw/private/bitmap + racket/draw/private/local ffi/unsafe/alloc) -(provide dc% - win32-bitmap% - do-backing-flush - request-flush-delay - cancel-flush-delay) +(provide + (protect-out dc% + win32-bitmap% + do-backing-flush + request-flush-delay + cancel-flush-delay)) (define win32-bitmap% (class bitmap% diff --git a/collects/mred/private/wx/win32/filedialog.rkt b/collects/mred/private/wx/win32/filedialog.rkt index c49b225e..df03b2ca 100644 --- a/collects/mred/private/wx/win32/filedialog.rkt +++ b/collects/mred/private/wx/win32/filedialog.rkt @@ -8,7 +8,8 @@ "wndclass.rkt" "../../lock.rkt") -(provide file-selector) +(provide + (protect-out file-selector)) (define-cstruct _OPENFILENAME ([lStructSize _DWORD] diff --git a/collects/mred/private/wx/win32/font.rkt b/collects/mred/private/wx/win32/font.rkt index 4017c643..cf7a4616 100644 --- a/collects/mred/private/wx/win32/font.rkt +++ b/collects/mred/private/wx/win32/font.rkt @@ -1,9 +1,10 @@ -#lang racket +#lang racket/base (require racket/class - racket/draw/local - racket/draw/pango) + racket/draw/private/local + racket/draw/unsafe/pango) -(provide font->hfont) +(provide + (protect-out font->hfont)) (define display-font-map (pango_win32_font_map_for_display)) diff --git a/collects/mred/private/wx/win32/frame.rkt b/collects/mred/private/wx/win32/frame.rkt index 2b8f1d7d..058d5caa 100644 --- a/collects/mred/private/wx/win32/frame.rkt +++ b/collects/mred/private/wx/win32/frame.rkt @@ -17,9 +17,10 @@ "hbitmap.rkt" "cursor.rkt") -(provide frame% - display-size - display-origin) +(provide + (protect-out frame% + display-size + display-origin)) (define-user32 SetLayeredWindowAttributes (_wfun _HWND _COLORREF _BYTE _DWORD -> _BOOL)) (define-user32 GetActiveWindow (_wfun -> _HWND)) diff --git a/collects/mred/private/wx/win32/gauge.rkt b/collects/mred/private/wx/win32/gauge.rkt index a2799cd8..d87bf8ce 100644 --- a/collects/mred/private/wx/win32/gauge.rkt +++ b/collects/mred/private/wx/win32/gauge.rkt @@ -10,7 +10,8 @@ "wndclass.rkt" "types.rkt") -(provide gauge%) +(provide + (protect-out gauge%)) (define PBS_VERTICAL #x04) (define PBM_SETRANGE (+ WM_USER 1)) diff --git a/collects/mred/private/wx/win32/gcwin.rkt b/collects/mred/private/wx/win32/gcwin.rkt index 7f84bdcc..3bb5a83e 100644 --- a/collects/mred/private/wx/win32/gcwin.rkt +++ b/collects/mred/private/wx/win32/gcwin.rkt @@ -5,11 +5,12 @@ "const.rkt" "wndclass.rkt") -(provide scheme_add_gc_callback - scheme_remove_gc_callback - create-gc-dc - make-gc-show-desc - make-gc-hide-desc) +(provide + (protect-out scheme_add_gc_callback + scheme_remove_gc_callback + create-gc-dc + make-gc-show-desc + make-gc-hide-desc)) (define-mz scheme_add_gc_callback (_fun _racket _racket -> _racket)) (define-mz scheme_remove_gc_callback (_fun _racket -> _void)) diff --git a/collects/mred/private/wx/win32/gl-context.rkt b/collects/mred/private/wx/win32/gl-context.rkt index 6aa27b53..bd94aeb8 100644 --- a/collects/mred/private/wx/win32/gl-context.rkt +++ b/collects/mred/private/wx/win32/gl-context.rkt @@ -3,12 +3,13 @@ ffi/unsafe ffi/unsafe/define ffi/unsafe/alloc - racket/draw/gl-config - (prefix-in draw: racket/draw/gl-context) + racket/draw/private/gl-config + (prefix-in draw: racket/draw/private/gl-context) "types.rkt" "utils.rkt") -(provide create-gl-context) +(provide + (protect-out create-gl-context)) (define opengl32-lib (ffi-lib "opengl32.dll")) diff --git a/collects/mred/private/wx/win32/group-panel.rkt b/collects/mred/private/wx/win32/group-panel.rkt index d77aabda..3dce9e40 100644 --- a/collects/mred/private/wx/win32/group-panel.rkt +++ b/collects/mred/private/wx/win32/group-panel.rkt @@ -11,7 +11,8 @@ "wndclass.rkt" "types.rkt") -(provide group-panel%) +(provide + (protect-out group-panel%)) (define group-panel% diff --git a/collects/mred/private/wx/win32/hbitmap.rkt b/collects/mred/private/wx/win32/hbitmap.rkt index 8f3c6456..4ca70954 100644 --- a/collects/mred/private/wx/win32/hbitmap.rkt +++ b/collects/mred/private/wx/win32/hbitmap.rkt @@ -1,15 +1,16 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe - racket/draw/cairo + racket/draw/unsafe/cairo racket/draw - racket/draw/local + racket/draw/private/local racket/class "types.rkt" "utils.rkt" "const.rkt") -(provide bitmap->hbitmap - hbitmap->bitmap) +(provide + (protect-out bitmap->hbitmap + hbitmap->bitmap)) (define (bitmap->hbitmap bm #:mask [mask-bm #f] diff --git a/collects/mred/private/wx/win32/item.rkt b/collects/mred/private/wx/win32/item.rkt index d9a18b8e..20477dd9 100644 --- a/collects/mred/private/wx/win32/item.rkt +++ b/collects/mred/private/wx/win32/item.rkt @@ -12,8 +12,9 @@ "hbitmap.rkt" "types.rkt") -(provide item-mixin - item%) +(provide + (protect-out item-mixin + item%)) (define (control-proc w msg wParam lParam) (let ([wx (hwnd->wx w)]) diff --git a/collects/mred/private/wx/win32/key.rkt b/collects/mred/private/wx/win32/key.rkt index 802b7880..a34a6760 100644 --- a/collects/mred/private/wx/win32/key.rkt +++ b/collects/mred/private/wx/win32/key.rkt @@ -6,8 +6,9 @@ "const.rkt" "../common/event.rkt") -(provide make-key-event - generates-key-event?) +(provide + (protect-out make-key-event + generates-key-event?)) (define-user32 GetKeyState (_wfun _int -> _SHORT)) (define-user32 MapVirtualKeyW (_wfun _UINT _UINT -> _UINT)) diff --git a/collects/mred/private/wx/win32/list-box.rkt b/collects/mred/private/wx/win32/list-box.rkt index c7ea846c..1ff72c98 100644 --- a/collects/mred/private/wx/win32/list-box.rkt +++ b/collects/mred/private/wx/win32/list-box.rkt @@ -13,7 +13,8 @@ "wndclass.rkt" "types.rkt") -(provide list-box%) +(provide + (protect-out list-box%)) (define WS_EX_CLIENTEDGE #x00000200) diff --git a/collects/mred/private/wx/win32/menu-bar.rkt b/collects/mred/private/wx/win32/menu-bar.rkt index 73a07513..cdbf1c0f 100644 --- a/collects/mred/private/wx/win32/menu-bar.rkt +++ b/collects/mred/private/wx/win32/menu-bar.rkt @@ -8,7 +8,8 @@ "types.rkt" "const.rkt") -(provide menu-bar%) +(provide + (protect-out menu-bar%)) (define-user32 CreateMenu (_wfun -> _HMENU)) (define-user32 SetMenu (_wfun _HWND _HMENU -> (r : _BOOL) diff --git a/collects/mred/private/wx/win32/menu-item.rkt b/collects/mred/private/wx/win32/menu-item.rkt index c974b6ae..ad2863fc 100644 --- a/collects/mred/private/wx/win32/menu-item.rkt +++ b/collects/mred/private/wx/win32/menu-item.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require ffi/unsafe scheme/class "utils.rkt" @@ -7,8 +7,9 @@ "../../lock.rkt" "../../syntax.rkt") -(provide menu-item% - id-to-menu-item) +(provide + (protect-out menu-item% + id-to-menu-item)) ;; Menu itens are identified by 16-bit numbers, so we have ;; to keep a hash mapping them to menu items. diff --git a/collects/mred/private/wx/win32/menu.rkt b/collects/mred/private/wx/win32/menu.rkt index d11d4fac..0b93f5ce 100644 --- a/collects/mred/private/wx/win32/menu.rkt +++ b/collects/mred/private/wx/win32/menu.rkt @@ -1,5 +1,5 @@ -#lang scheme/base -(require scheme/class +#lang racket/base +(require racket/class ffi/unsafe (only-in racket/list drop take) "../../lock.rkt" @@ -10,7 +10,8 @@ "const.rkt" "menu-item.rkt") -(provide menu%) +(provide + (protect-out menu%)) (define-user32 CreatePopupMenu (_wfun -> _HMENU)) (define-user32 AppendMenuW (_wfun _HMENU _UINT _pointer _string/utf-16 -> (r : _BOOL) diff --git a/collects/mred/private/wx/win32/message.rkt b/collects/mred/private/wx/win32/message.rkt index 1fd05984..e4ee583c 100644 --- a/collects/mred/private/wx/win32/message.rkt +++ b/collects/mred/private/wx/win32/message.rkt @@ -13,7 +13,8 @@ "hbitmap.rkt" "types.rkt") -(provide message%) +(provide + (protect-out message%)) (define STM_SETIMAGE #x0172) diff --git a/collects/mred/private/wx/win32/panel.rkt b/collects/mred/private/wx/win32/panel.rkt index 1485ad6f..c87ae2ce 100644 --- a/collects/mred/private/wx/win32/panel.rkt +++ b/collects/mred/private/wx/win32/panel.rkt @@ -8,8 +8,9 @@ "const.rkt" "cursor.rkt") -(provide panel-mixin - panel%) +(provide + (protect-out panel-mixin + panel%)) (define (panel-mixin %) (class % diff --git a/collects/mred/private/wx/win32/platform.rkt b/collects/mred/private/wx/win32/platform.rkt index 07c3629e..d6652c53 100644 --- a/collects/mred/private/wx/win32/platform.rkt +++ b/collects/mred/private/wx/win32/platform.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require "init.rkt" "button.rkt" "canvas.rkt" @@ -24,7 +24,7 @@ "tab-panel.rkt" "window.rkt" "procs.rkt") -(provide platform-values) +(provide (protect-out platform-values)) (define (platform-values) (values @@ -61,8 +61,6 @@ bell display-size display-origin - get-resource - write-resource flush-display fill-private-color cancel-quit @@ -72,7 +70,6 @@ get-double-click-time run-printout file-creator-and-type - send-event location->window shortcut-visible-in-label? unregister-collecting-blit diff --git a/collects/mred/private/wx/win32/printer-dc.rkt b/collects/mred/private/wx/win32/printer-dc.rkt index 7118d219..598ea093 100644 --- a/collects/mred/private/wx/win32/printer-dc.rkt +++ b/collects/mred/private/wx/win32/printer-dc.rkt @@ -2,20 +2,21 @@ (require racket/class ffi/unsafe ffi/unsafe/alloc - racket/draw/dc - racket/draw/local - racket/draw/cairo - racket/draw/record-dc - racket/draw/bitmap-dc - racket/draw/ps-setup + racket/draw/private/dc + racket/draw/private/local + racket/draw/unsafe/cairo + racket/draw/private/record-dc + racket/draw/private/bitmap-dc + racket/draw/private/ps-setup "../../lock.rkt" "dc.rkt" "types.rkt" "utils.rkt" "const.rkt") -(provide printer-dc% - show-print-setup) +(provide + (protect-out printer-dc% + show-print-setup)) (define _HGLOBAL _pointer) diff --git a/collects/mred/private/wx/win32/procs.rkt b/collects/mred/private/wx/win32/procs.rkt index 32153d9a..331b9dbf 100644 --- a/collects/mred/private/wx/win32/procs.rkt +++ b/collects/mred/private/wx/win32/procs.rkt @@ -20,52 +20,48 @@ racket/draw) (provide - special-control-key - special-option-key - get-color-from-user - color-from-user-platform-mode - get-font-from-user - font-from-user-platform-mode - get-panel-background - play-sound - find-graphical-system-path - register-collecting-blit - unregister-collecting-blit - shortcut-visible-in-label? - location->window - send-event - file-creator-and-type - run-printout - get-double-click-time - get-control-font-face - get-control-font-size - get-control-font-size-in-pixels? - cancel-quit + (protect-out + color-from-user-platform-mode + get-font-from-user + font-from-user-platform-mode + get-panel-background + find-graphical-system-path + register-collecting-blit + unregister-collecting-blit + shortcut-visible-in-label? + run-printout + get-double-click-time + get-control-font-face + get-control-font-size + get-control-font-size-in-pixels? + cancel-quit + flush-display + bell + hide-cursor + get-display-depth + is-color-display? + can-show-print-setup? + get-highlight-background-color + get-highlight-text-color + check-for-break) fill-private-color - flush-display - write-resource - get-resource + play-sound + location->window + file-selector + show-print-setup + id-to-menu-item + file-creator-and-type display-origin display-size - bell - hide-cursor - get-display-depth - is-color-display? - file-selector - id-to-menu-item - show-print-setup - can-show-print-setup? - get-highlight-background-color - get-highlight-text-color make-screen-bitmap make-gl-bitmap - check-for-break) + special-control-key + special-option-key + get-color-from-user) + (define-unimplemented find-graphical-system-path) -(define-unimplemented send-event) (define-unimplemented cancel-quit) -(define-unimplemented write-resource) -(define-unimplemented get-resource) (define (color-from-user-platform-mode) 'dialog) diff --git a/collects/mred/private/wx/win32/queue.rkt b/collects/mred/private/wx/win32/queue.rkt index 7fd628d4..24504696 100644 --- a/collects/mred/private/wx/win32/queue.rkt +++ b/collects/mred/private/wx/win32/queue.rkt @@ -11,7 +11,7 @@ "../../lock.rkt" "../common/queue.rkt") -(provide win32-start-event-pump +(provide (protect-out win32-start-event-pump) ;; from common/queue: current-eventspace diff --git a/collects/mred/private/wx/win32/radio-box.rkt b/collects/mred/private/wx/win32/radio-box.rkt index 6b3b66df..30453ffe 100644 --- a/collects/mred/private/wx/win32/radio-box.rkt +++ b/collects/mred/private/wx/win32/radio-box.rkt @@ -1,4 +1,4 @@ -#lang scheme/base +#lang racket/base (require racket/class racket/draw ffi/unsafe @@ -13,7 +13,8 @@ "hbitmap.rkt" "types.rkt") -(provide radio-box%) +(provide + (protect-out radio-box%)) (define SEP 4) (define BM_SETCHECK #x00F1) diff --git a/collects/mred/private/wx/win32/slider.rkt b/collects/mred/private/wx/win32/slider.rkt index 2310b8c7..05aafb36 100644 --- a/collects/mred/private/wx/win32/slider.rkt +++ b/collects/mred/private/wx/win32/slider.rkt @@ -11,7 +11,8 @@ "wndclass.rkt" "types.rkt") -(provide slider%) +(provide + (protect-out slider%)) (define TBS_VERT #x0002) (define TBS_HORZ #x0000) diff --git a/collects/mred/private/wx/win32/sound.rkt b/collects/mred/private/wx/win32/sound.rkt index 02aa963b..fb526058 100644 --- a/collects/mred/private/wx/win32/sound.rkt +++ b/collects/mred/private/wx/win32/sound.rkt @@ -5,7 +5,8 @@ "types.rkt" "const.rkt") -(provide play-sound) +(provide + (protect-out play-sound)) (define-winmm PlaySoundW (_wfun _string/utf-16 _pointer _DWORD -> _BOOL)) diff --git a/collects/mred/private/wx/win32/tab-panel.rkt b/collects/mred/private/wx/win32/tab-panel.rkt index 03b4dea1..5ff10ba0 100644 --- a/collects/mred/private/wx/win32/tab-panel.rkt +++ b/collects/mred/private/wx/win32/tab-panel.rkt @@ -12,7 +12,8 @@ "wndclass.rkt" "types.rkt") -(provide tab-panel%) +(provide + (protect-out tab-panel%)) (define TCIF_TEXT #x0001) (define TCM_SETUNICODEFORMAT #x2005) diff --git a/collects/mred/private/wx/win32/theme.rkt b/collects/mred/private/wx/win32/theme.rkt index 039f4683..6b1e21f1 100644 --- a/collects/mred/private/wx/win32/theme.rkt +++ b/collects/mred/private/wx/win32/theme.rkt @@ -5,16 +5,17 @@ "const.ss" "types.ss") -(provide get-theme-logfont - get-theme-font-face - get-theme-font-size - _LOGFONT-pointer - OpenThemeData - CloseThemeData - DrawThemeParentBackground - DrawThemeBackground - DrawThemeEdge - EnableThemeDialogTexture) +(provide + (protect-out get-theme-logfont + get-theme-font-face + get-theme-font-size + _LOGFONT-pointer + OpenThemeData + CloseThemeData + DrawThemeParentBackground + DrawThemeBackground + DrawThemeEdge + EnableThemeDialogTexture)) (define _HTHEME (_cpointer 'HTHEME)) diff --git a/collects/mred/private/wx/win32/types.rkt b/collects/mred/private/wx/win32/types.rkt index 360e6719..1ef78ccf 100644 --- a/collects/mred/private/wx/win32/types.rkt +++ b/collects/mred/private/wx/win32/types.rkt @@ -1,52 +1,53 @@ #lang racket/base (require ffi/unsafe) -(provide _wfun - - _WORD - _DWORD - _UDWORD - _ATOM - _WPARAM - _LPARAM - _LRESULT - _BOOL - _UINT - _UINT_PTR - _BYTE - _LONG - _ULONG - _SHORT - _HRESULT - _WCHAR - _SIZE_T +(provide + (protect-out _wfun + + _WORD + _DWORD + _UDWORD + _ATOM + _WPARAM + _LPARAM + _LRESULT + _BOOL + _UINT + _UINT_PTR + _BYTE + _LONG + _ULONG + _SHORT + _HRESULT + _WCHAR + _SIZE_T - _HINSTANCE - _HWND - _HMENU - _HICON - _HCURSOR - _HBRUSH - _HDC - _HFONT - _HBITMAP - _HANDLE + _HINSTANCE + _HWND + _HMENU + _HICON + _HCURSOR + _HBRUSH + _HDC + _HFONT + _HBITMAP + _HANDLE - _COLORREF + _COLORREF - _fnpointer + _fnpointer - _permanent-string/utf-16 - utf-16-length + _permanent-string/utf-16 + utf-16-length - (struct-out POINT) _POINT _POINT-pointer - (struct-out RECT) _RECT _RECT-pointer - (struct-out MSG) _MSG _MSG-pointer + (struct-out POINT) _POINT _POINT-pointer + (struct-out RECT) _RECT _RECT-pointer + (struct-out MSG) _MSG _MSG-pointer - HIWORD - LOWORD - MAKELONG - MAKELPARAM) + HIWORD + LOWORD + MAKELONG + MAKELPARAM)) (define-syntax-rule (_wfun . a) (_fun #:abi 'stdcall . a)) diff --git a/collects/mred/private/wx/win32/utils.rkt b/collects/mred/private/wx/win32/utils.rkt index 7965023d..30840da7 100644 --- a/collects/mred/private/wx/win32/utils.rkt +++ b/collects/mred/private/wx/win32/utils.rkt @@ -5,43 +5,44 @@ "../common/utils.rkt" "types.rkt") -(provide define-gdi32 - define-user32 - define-kernel32 - define-comctl32 - define-comdlg32 - define-shell32 - define-uxtheme - define-winmm - define-mz - failed +(provide + define-mz + (protect-out define-gdi32 + define-user32 + define-kernel32 + define-comctl32 + define-comdlg32 + define-shell32 + define-uxtheme + define-winmm + failed - GetLastError - DestroyWindow - NotifyWindowDestroy - CreateWindowExW - GetWindowLongW - SetWindowLongW - SendMessageW SendMessageW/str - GetSysColor GetRValue GetGValue GetBValue make-COLORREF - CreateBitmap - CreateCompatibleBitmap - DeleteObject - CreateCompatibleDC - DeleteDC - MoveWindow - ShowWindow - EnableWindow - SetWindowTextW - SetCursor - GetDC - ReleaseDC - InvalidateRect - GetMenuState - CheckMenuItem - ModifyMenuW - RemoveMenu - SelectObject) + GetLastError + DestroyWindow + NotifyWindowDestroy + CreateWindowExW + GetWindowLongW + SetWindowLongW + SendMessageW SendMessageW/str + GetSysColor GetRValue GetGValue GetBValue make-COLORREF + CreateBitmap + CreateCompatibleBitmap + DeleteObject + CreateCompatibleDC + DeleteDC + MoveWindow + ShowWindow + EnableWindow + SetWindowTextW + SetCursor + GetDC + ReleaseDC + InvalidateRect + GetMenuState + CheckMenuItem + ModifyMenuW + RemoveMenu + SelectObject)) (define gdi32-lib (ffi-lib "gdi32.dll")) (define user32-lib (ffi-lib "user32.dll")) diff --git a/collects/mred/private/wx/win32/window.rkt b/collects/mred/private/wx/win32/window.rkt index d3fd91eb..c2b8b832 100644 --- a/collects/mred/private/wx/win32/window.rkt +++ b/collects/mred/private/wx/win32/window.rkt @@ -2,7 +2,7 @@ (require ffi/unsafe racket/class racket/draw - racket/draw/bstr + racket/draw/unsafe/bstr "../../syntax.rkt" "../common/freeze.rkt" "../common/queue.rkt" @@ -19,13 +19,14 @@ "key.rkt" "font.rkt") -(provide window% - queue-window-event - queue-window-refresh-event - location->window +(provide + (protect-out window% + queue-window-event + queue-window-refresh-event + location->window - GetWindowRect - GetClientRect) + GetWindowRect + GetClientRect)) (define (unhide-cursor) (void)) diff --git a/collects/mred/private/wx/win32/wndclass.rkt b/collects/mred/private/wx/win32/wndclass.rkt index 330f8da6..4e3a62f1 100644 --- a/collects/mred/private/wx/win32/wndclass.rkt +++ b/collects/mred/private/wx/win32/wndclass.rkt @@ -7,17 +7,18 @@ "const.rkt" "icons.rkt") -(provide hInstance - DefWindowProcW - background-hbrush - set-hwnd-wx! - set-hwnd-ctlproc! - hwnd->wx - hwnd->ctlproc - any-hwnd->wx - unregister-hwnd - MessageBoxW - _WndProc) +(provide + (protect-out hInstance + DefWindowProcW + background-hbrush + set-hwnd-wx! + set-hwnd-ctlproc! + hwnd->wx + hwnd->ctlproc + any-hwnd->wx + unregister-hwnd + MessageBoxW + _WndProc)) ;; ---------------------------------------- ;; We use the "user data" field of an HWND to diff --git a/collects/scribblings/gui/miscwin-funcs.scrbl b/collects/scribblings/gui/miscwin-funcs.scrbl index 7771bf77..64bbb43c 100644 --- a/collects/scribblings/gui/miscwin-funcs.scrbl +++ b/collects/scribblings/gui/miscwin-funcs.scrbl @@ -79,9 +79,6 @@ The result depends on @racket[what], and a @racket[#f] result is only ]} - @item{@racket['setup-file] returns the path to the file - containing resources used by @racket[get-resource]; obsolete.} - @item{@racket['x-display] returns a ``path'' whose string identifies the X display if specified by either the @Flag{display} flag or the @envvar{DISPLAY} environment variable when GRacket starts under X. For @@ -127,60 +124,6 @@ Returns the color used to draw selected text or @racket[#f] if selected text is drawn with its usual color.} -@defproc[(get-resource [section string?] - [entry string?] - [value (box/c (or/c string? exact-integer?))] - [file (or/c path? false/c) #f]) - boolean?]{ - -Gets a resource value from the resource database. The resource value - is keyed on the combination of @racket[section] and @racket[entry]. The - return value is @racket[#t] if a value is found, @racket[#f] if it is - not. The type of the value initially in the @racket[value] box - determines the way that the resource is interpreted, and @racket[value] - is filled with a new value of the same type if one is found. - -If @racket[file] is @racket[#f], platform-specific resource files - are read, as determined by @racket[find-graphical-system-path] - with @indexed-racket['setup-file]. (Under X, when @racket[file] is - @racket[#f], the user's @filepath{.Xdefaults} file is also read, or the - file specified by the @filepath{XENVIRONMENT} environment variable.) - -The format of a resource entry depends on the platform. Windows - resources use the standard @filepath{.ini} format. X and Mac OS X - resources use the standard X resource format, where each entry - consists of a @racket[section].@racket[entry] resource name, a colon, and - the resource value, terminated by a newline. Section and entry names are - case-sensitive. - -@index['("registry")]{@index['("Windows registry")]{Under}} Windows, if - @racket[section] is one of the following strings, then @racket[file] - is ignored, and @racket[entry] is used as a resource path: - -@itemize[ - - @item{@indexed-racket["HKEY_CLASSES_ROOT"]} - @item{@indexed-racket["HKEY_CURRENT_CONFIG"]} - @item{@indexed-racket["HKEY_CURRENT_USER"]} - @item{@indexed-racket["HKEY_LOCAL_MACHINE"]} - @item{@indexed-racket["HKEY_USERS"]} - -] - -In that case, the @racket[entry] argument is parsed as a resource entry -path, followed by a backslash, followed by a value name. To get the -``default'' value for an entry, use the empty name. For example, the -following expression gets a command line for starting a browser: - -@racketblock[ -(let ([b (box "")]) - (get-resource "HKEY_CLASSES_ROOT" - "htmlfile\\shell\\open\\command\\" b) - (unbox b)) -] - -See also @racket[write-resource].} - @defproc[(get-window-text-extent [string string] [font (is-a?/c font%)] [combine? any/c #f]) @@ -386,71 +329,6 @@ Unregisters all blit requests installed for @racket[canvas] with @scheme[register-collecting-blit].} -@defproc[(send-event [receiver-bytes (lambda (s) (and (bytes? s) - (= 4 (bytes-length s))))] - [event-class-bytes (lambda (s) (and (bytes? s) - (= 4 (bytes-length s))))] - [event-id-bytes (lambda (s) (and (bytes? s) - (= 4 (bytes-length s))))] - [direct-arg-v any/c (void)] - [argument-list list? null]) - any/c]{ - -Sends an AppleEvent or raises @racket[exn:fail:unsupported]. - -The @racket[receiver-bytes], @racket[event-class-bytes], and -@racket[event-id-bytes] arguments specify the signature of the -receiving application, the class of the AppleEvent, and the ID of -the AppleEvent. - -The @racket[direct-arg-v] value is converted (see below) and passed as -the main argument of the event; if @racket[direct-argument-v] is -@|void-const|, no main argument is sent in the event. The -@racket[argument-list] argument is a list of two-element lists -containing a typestring and value; each typestring is used ad the -keyword name of an AppleEvent argument for the associated converted -value. - -The following types of Racket values can be converted to AppleEvent -values passed to the receiver: - -@atable[ -(tline @elem{@racket[#t] or @racket[#f]} @elem{Boolean}) -(tline @elem{small integer} @elem{Long Integer}) -(tline @elem{inexact real number} @elem{Double}) -(tline @elem{string} @elem{Characters}) -(tline @elem{list of convertible values} @elem{List of converted values}) -(tline @racket[#(file _pathname)] @elem{Alias (file exists) or FSSpec (does not exist)}) -(tline @racket[#(record (_typestring _v) ...)] @elem{Record of keyword-tagged values}) -] - -If other types of values are passed to @racket[send-event] for - conversion, the @exnraise[exn:fail:unsupported]. - -The @racket[send-event] procedure does not return until the receiver -of the AppleEvent replies. The result of @racket[send-event] is the -reverse-converted reply value (see below), or the @exnraise[exn:fail] -if there is an error. If there is no error or return value, -@racket[send-event] returns @|void-const|. - -The following types of AppleEvent values can be reverse-converted into -a Racket value returned by @racket[send-event]: - -@atable[ -(tline @elem{Boolean} @elem{@racket[#t] or @racket[#f]}) -(tline @elem{Signed Integer} @elem{integer}) -(tline @elem{Float, Double, or Extended} @elem{inexact real number}) -(tline @elem{Characters} @elem{string}) -(tline @elem{List of reverse-convertible values} @elem{list of reverse-converted values}) -(tline @elem{Alias or FSSpec} @racket[#(file _pathname)]) -(tline @elem{Record of keyword-tagged values} @racket[#(record (_typestring _v) ...)]) -] - -If the AppleEvent reply contains a value that cannot be - reverse-converted, the @exnraise[exn:fail]. - -} - @defproc[(send-message-to-window [x (integer-in -10000 10000)] [y (integer-in -10000 10000)] [message any/c]) @@ -489,31 +367,6 @@ See @racket[clipboard<%>]. } -@defproc[(write-resource [section string?] - [entry string?] - [value (or/c string? exact-integer?)] - [file (or/c path-string? false/c) #f]) - boolean?]{ - -Writes a resource value to the specified resource database. The - resource value is keyed on the combination of @racket[section] and - @racket[entry], with the same special handling of @racket[entry] for - under Windows as for @racket[get-resource]. - -If @racket[file] is @racket[#f], the platform-specific resource - database is read, as determined by - @racket[find-graphical-system-path] with - @indexed-racket['setup-file]. - -The return value is @racket[#t] if the write succeeds, @racket[#f] - otherwise. (A failure indicates that the resource file cannot be - written.) - -If @racket[value] is an integer outside a platform-specific range, - @|MismatchExn|. - -See also @racket[get-resource].} - @defproc[(label-string? [v any/c]) boolean?]{ Returns @racket[#t] if @racket[v] is a string whose length is less than or equal to @racket[200]. } diff --git a/doc/release-notes/racket/Draw_and_GUI_5_5.txt b/doc/release-notes/racket/Draw_and_GUI_5_5.txt index 6be461a7..356bc7e7 100644 --- a/doc/release-notes/racket/Draw_and_GUI_5_5.txt +++ b/doc/release-notes/racket/Draw_and_GUI_5_5.txt @@ -91,3 +91,6 @@ Changes: OpenG drawing to a bitmap requires a bitmap created with `make-gl-bitmap'. + * The `write-resource, `get-reource', and `send-event' functions have + been removed from `racket/gui/base'. If there is any demand for the + removed functionality, it will be implemented in a new library.