From d7f1d12ea1c16d5ed062a8ac8fe2fe47db267f15 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 27 Oct 2010 05:23:18 -0600 Subject: [PATCH] clean up --- 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/agl.rkt | 12 +- collects/mred/private/wx/cocoa/bitmap.rkt | 6 +- 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 +-- collects/mred/private/wx/common/bstr.rkt | 3 - .../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/printer.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/racket/draw.rkt | 30 +- collects/racket/draw/gif.rkt | 4 +- .../racket/draw/{ => private}/bitmap-dc.rkt | 22 +- collects/racket/draw/{ => private}/bitmap.rkt | 24 +- collects/racket/draw/{ => private}/brush.rkt | 0 collects/racket/draw/{ => private}/color.rkt | 0 .../racket/draw/{ => private}/dc-intf.rkt | 0 .../racket/draw/{ => private}/dc-path.rkt | 4 +- collects/racket/draw/{ => private}/dc.rkt | 37 +-- collects/racket/draw/{ => private}/define.rkt | 0 collects/racket/draw/{ => private}/fmod.rkt | 0 .../racket/draw/{ => private}/font-dir.rkt | 8 +- .../racket/draw/{ => private}/font-syms.rkt | 0 collects/racket/draw/{ => private}/font.rkt | 2 +- .../racket/draw/{ => private}/gl-config.rkt | 0 .../racket/draw/{ => private}/gl-context.rkt | 0 collects/racket/draw/{ => private}/hold.rkt | 0 collects/racket/draw/{ => private}/libs.rkt | 0 collects/racket/draw/{ => private}/local.rkt | 1 - collects/racket/draw/{ => private}/lzw.rkt | 0 collects/racket/draw/{ => private}/pen.rkt | 0 collects/racket/draw/{ => private}/point.rkt | 0 .../draw/{ => private}/post-script-dc.rkt | 4 +- .../racket/draw/{ => private}/ps-setup.rkt | 6 +- .../racket/draw/{ => private}/record-dc.rkt | 3 +- collects/racket/draw/{ => private}/region.rkt | 2 +- collects/racket/draw/private/syntax.rkt | 299 +++++++++++++++++ collects/racket/draw/{ => private}/utils.rkt | 0 collects/racket/draw/syntax.rkt | 3 - collects/racket/draw/{ => unsafe}/bstr.rkt | 0 collects/racket/draw/{ => unsafe}/cairo.rkt | 4 +- collects/racket/draw/{ => unsafe}/jpeg.rkt | 4 +- collects/racket/draw/{ => unsafe}/pango.rkt | 4 +- collects/racket/draw/{ => unsafe}/png.rkt | 4 +- collects/scribblings/gui/miscwin-funcs.scrbl | 147 --------- collects/scribblings/gui/region-class.scrbl | 2 +- doc/release-notes/racket/Draw_and_GUI_5_5.txt | 3 + 185 files changed, 1323 insertions(+), 1466 deletions(-) delete mode 100644 collects/mred/private/wx/common/bstr.rkt rename collects/racket/draw/{ => private}/bitmap-dc.rkt (94%) rename collects/racket/draw/{ => private}/bitmap.rkt (99%) rename collects/racket/draw/{ => private}/brush.rkt (100%) rename collects/racket/draw/{ => private}/color.rkt (100%) rename collects/racket/draw/{ => private}/dc-intf.rkt (100%) rename collects/racket/draw/{ => private}/dc-path.rkt (99%) rename collects/racket/draw/{ => private}/dc.rkt (99%) rename collects/racket/draw/{ => private}/define.rkt (100%) rename collects/racket/draw/{ => private}/fmod.rkt (100%) rename collects/racket/draw/{ => private}/font-dir.rkt (97%) rename collects/racket/draw/{ => private}/font-syms.rkt (100%) rename collects/racket/draw/{ => private}/font.rkt (99%) rename collects/racket/draw/{ => private}/gl-config.rkt (100%) rename collects/racket/draw/{ => private}/gl-context.rkt (100%) rename collects/racket/draw/{ => private}/hold.rkt (100%) rename collects/racket/draw/{ => private}/libs.rkt (100%) rename collects/racket/draw/{ => private}/local.rkt (97%) rename collects/racket/draw/{ => private}/lzw.rkt (100%) rename collects/racket/draw/{ => private}/pen.rkt (100%) rename collects/racket/draw/{ => private}/point.rkt (100%) rename collects/racket/draw/{ => private}/post-script-dc.rkt (98%) rename collects/racket/draw/{ => private}/ps-setup.rkt (98%) rename collects/racket/draw/{ => private}/record-dc.rkt (99%) rename collects/racket/draw/{ => private}/region.rkt (99%) create mode 100644 collects/racket/draw/private/syntax.rkt rename collects/racket/draw/{ => private}/utils.rkt (100%) delete mode 100644 collects/racket/draw/syntax.rkt rename collects/racket/draw/{ => unsafe}/bstr.rkt (100%) rename collects/racket/draw/{ => unsafe}/cairo.rkt (99%) rename collects/racket/draw/{ => unsafe}/jpeg.rkt (99%) rename collects/racket/draw/{ => unsafe}/pango.rkt (99%) rename collects/racket/draw/{ => unsafe}/png.rkt (99%) diff --git a/collects/framework/private/preferences.rkt b/collects/framework/private/preferences.rkt index 75b8aae372..505fccaa6a 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 53b52e2627..47e3727f1b 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 59f6dcbfee..f9aa039310 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 b4cc868a66..431e1a26c3 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 df44db48ba..b989a69751 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/agl.rkt b/collects/mred/private/wx/cocoa/agl.rkt index 874d68c495..796661f65e 100644 --- a/collects/mred/private/wx/cocoa/agl.rkt +++ b/collects/mred/private/wx/cocoa/agl.rkt @@ -4,13 +4,13 @@ ffi/unsafe/define ffi/unsafe/alloc "../../lock.rkt" - racket/draw/cairo - racket/draw/local - racket/draw/gl-context - racket/draw/gl-config - racket/draw/bitmap) + racket/draw/unsafe/cairo + racket/draw/private/local + racket/draw/private/gl-context + racket/draw/private/gl-config + racket/draw/private/bitmap) -(provide create-gl-bitmap) +(provide (protect-out create-gl-bitmap)) (define agl-lib (ffi-lib "/System/Library/Frameworks/AGL.framework/AGL")) diff --git a/collects/mred/private/wx/cocoa/bitmap.rkt b/collects/mred/private/wx/cocoa/bitmap.rkt index 9974d202a9..a017149e8a 100644 --- a/collects/mred/private/wx/cocoa/bitmap.rkt +++ b/collects/mred/private/wx/cocoa/bitmap.rkt @@ -2,9 +2,9 @@ (require racket/class ffi/unsafe ffi/unsafe/objc - racket/draw/cairo - racket/draw/bitmap - racket/draw/local + racket/draw/unsafe/cairo + racket/draw/private/bitmap + racket/draw/private/local "types.rkt" "utils.rkt" "../../lock.rkt" diff --git a/collects/mred/private/wx/cocoa/button.rkt b/collects/mred/private/wx/cocoa/button.rkt index 9757491982..b58f18e3d8 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 638e1c56a4..ee897ce35f 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 479a9dcd08..b158602aa3 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 6241bb17a8..cd2ed74a1f 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 1974622de4..844748e441 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 d72d854a37..34eb237042 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 1f3a8e6bc8..2dc750c38a 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 f8a39c5d32..d2f99cb325 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 28fc4e5d24..0ca120c1ba 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 cd44ad587d..ed31168851 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 85b8e3612f..bfb8517ec2 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 c2bfc8aee5..00e124e429 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 4d841bbc4b..b1570bea44 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 7b438b0a90..014e09428b 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 5536d1873b..0edb644f98 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 1dfa3fce5e..d9d37610a7 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 b582a48ac5..8e384f3713 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 8c70afe1cc..1756171423 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 e8ebe30f31..ac05763af8 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 2c3b5fbaca..4764cc1f22 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 6f3a04436c..674da458b8 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 572d1f2c38..7eb4d26fcc 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 40f635e557..72419a0eae 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 e72947f966..b8c70ae579 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 672a2b7ca4..6f26da2455 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 7f9637eb8b..8d59c1f31a 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 458b3fc305..1a3896ef1f 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 b790374611..48a5c03feb 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 98b0bfa7ee..f5e80dadc3 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 5a101fc4df..070719d284 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 b48d2f0417..c1224ed17c 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 7b77f911e9..ed872b4ad4 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 7d73a69900..10d68f7cf8 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 be329cb6eb..ff799116ee 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 35170d8528..146352edde 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 ac0a28ef55..ec31b205d4 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 d5f8a3975a..62a22c5eba 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 accaffc858..5e577c9550 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 b1553187d7..42c62ebf01 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 b937b47b56..b4daaa9740 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 1c4f96699d..f6c9b3b5a8 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/bstr.rkt b/collects/mred/private/wx/common/bstr.rkt deleted file mode 100644 index 2dd9409c38..0000000000 --- a/collects/mred/private/wx/common/bstr.rkt +++ /dev/null @@ -1,3 +0,0 @@ -#lang racket/base -(require racket/draw/bstr) -(provide scheme_make_sized_byte_string) diff --git a/collects/mred/private/wx/common/canvas-mixin.rkt b/collects/mred/private/wx/common/canvas-mixin.rkt index 2e428a413b..2822e41ea8 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 af22c334ab..383394fd88 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 5034f1be1c..52598374b4 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 0a348b0859..7898a2d31f 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 1548fb06ab..319b265f22 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 1c757d796b..e9820fe3e5 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 28b3fecc13..92c1566583 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 9fad1616f2..3776fd014b 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 0f1d6a08ec..82a8c6b6e3 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 c0e49a640a..d416754157 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/printer.rkt b/collects/mred/private/wx/common/printer.rkt index 7f360a4647..a421ed376d 100644 --- a/collects/mred/private/wx/common/printer.rkt +++ b/collects/mred/private/wx/common/printer.rkt @@ -1,7 +1,7 @@ #lang racket/base (require racket/class) -(provide make-run-printout) +(provide (protect-out make-run-printout)) (define ((make-run-printout printer-dc%) parent diff --git a/collects/mred/private/wx/common/procs.rkt b/collects/mred/private/wx/common/procs.rkt index 362911fc6d..6434cc48ec 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 7882a650f6..b54cbd3534 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 a01817e128..884cc91bd3 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 0a950e865e..289eb65196 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 1d9948dcf2..7a27dbfe9e 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 a064b58680..4d5a6499b7 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 977ea3a5c1..bbc494d031 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 f8eede1018..f9efa58044 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 9127a22968..39802d2c28 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 ed86c96363..4382815f2d 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 e74f3d236d..06f013402c 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 c836da7122..1c26323d2a 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 d0c08c3761..212aadfe16 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 54b8cb0e39..f7650353e1 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 564e6536e0..da92895a57 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 331f7f3a8d..bc770391a5 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 04477ac825..209930d98a 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 97034faa7a..9520771f47 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 c76c3de6c4..34916efb6a 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 2bb45011b6..dda1a9a5c6 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 49701b7492..d017aeba40 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 7f0aae79bf..40769f4472 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 c864a44236..734feee306 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 ba601aeb08..ded4146bb8 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 e63bfada29..dbfd10bdb7 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 9830dfa741..b5e7eb368a 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 fc827e0638..80ff0c4e6f 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 3b18357ac5..a37a3401d6 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 ce1e887f2b..45ff8b4396 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 afe240e0e3..a6b6c34283 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 a4207ffa0f..732821bd72 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 d74513fd07..fd47ac52cd 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 e485751f35..280ad9aa0d 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 e89507a69d..d5c2733c22 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 9f1d9eb210..0abd4fa342 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 d72a47faf1..92980523ee 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 3ab44b98af..c88d3a2266 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 a8c4113461..b0885b5148 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 6039e5d486..446c410a72 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 c2888a2514..b120a29a08 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 49d6449bb5..f2a2dc7800 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 808f585ad0..4cc7f1e6c6 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 75ad7e1da8..33dfaa0c8b 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 7d2fd03a2b..0274dc503e 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 ca139be8a7..5385a725e8 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 f92202c189..180533b77a 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 4ee5f740b9..ed9e53273b 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 0aa30e2579..b55c04c1e7 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 dce8ea4c18..cda9c15aff 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 8ecb9b168c..79dcef799a 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 f455c19284..0c3a2924af 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 a681d2f942..f46c513be8 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 675e4ae033..3106b45031 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 a584a698d4..940cca94fe 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 9fca727464..3b999c69fd 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 7147ef389d..8a99959ce3 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 b32a307238..ecfcc94193 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 3af7c17278..b49bec95c1 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 51e3fc86d7..d3b6ead054 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 c49b225efd..df03b2cad0 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 4017c64365..cf7a46168a 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 2b8f1d7dfb..058d5caaf4 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 a2799cd881..d87bf8ce01 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 7f84bdcc13..3bb5a83e05 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 6aa27b532e..bd94aeb83d 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 d77aabdac9..3dce9e4032 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 8f3c645679..4ca7095468 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 d9a18b8e15..20477dd901 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 802b7880de..a34a6760f4 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 c7ea846c13..1ff72c9847 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 73a0751318..cdbf1c0fff 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 c974b6ae1f..ad2863fc88 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 d11d4fac5b..0b93f5ce54 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 1fd0598453..e4ee583c3c 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 1485ad6f7e..c87ae2ce10 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 07c3629e98..d6652c5315 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 7118d21982..598ea09381 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 32153d9a20..331b9dbf88 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 7fd628d492..24504696f2 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 6b3b66dfe1..30453ffe4b 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 2310b8c7af..05aafb36b7 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 02aa963bf6..fb526058f9 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 03b4dea1ce..5ff10ba0cf 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 039f46834b..6b1e21f1fd 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 360e67197d..1ef78ccfb5 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 7965023dbd..30840da72e 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 d3fd91eb76..c2b8b832ff 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 330f8da676..4e3a62f1c0 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/racket/draw.rkt b/collects/racket/draw.rkt index ed8df57b3d..73a79bcba6 100644 --- a/collects/racket/draw.rkt +++ b/collects/racket/draw.rkt @@ -1,19 +1,19 @@ #lang racket/base -(require "draw/color.rkt" - "draw/point.rkt" - "draw/font.rkt" - "draw/font-dir.rkt" - "draw/pen.rkt" - "draw/brush.rkt" - "draw/region.rkt" - "draw/bitmap.rkt" - "draw/dc-path.rkt" - "draw/dc-intf.rkt" - "draw/bitmap-dc.rkt" - "draw/post-script-dc.rkt" - "draw/ps-setup.rkt" - "draw/gl-config.rkt" - "draw/gl-context.rkt") +(require "draw/private/color.rkt" + "draw/private/point.rkt" + "draw/private/font.rkt" + "draw/private/font-dir.rkt" + "draw/private/pen.rkt" + "draw/private/brush.rkt" + "draw/private/region.rkt" + "draw/private/bitmap.rkt" + "draw/private/dc-path.rkt" + "draw/private/dc-intf.rkt" + "draw/private/bitmap-dc.rkt" + "draw/private/post-script-dc.rkt" + "draw/private/ps-setup.rkt" + "draw/private/gl-config.rkt" + "draw/private/gl-context.rkt") (provide color% color-database<%> the-color-database diff --git a/collects/racket/draw/gif.rkt b/collects/racket/draw/gif.rkt index dcdad030e6..c1ef788d67 100644 --- a/collects/racket/draw/gif.rkt +++ b/collects/racket/draw/gif.rkt @@ -1,7 +1,5 @@ #lang racket/base -(require "lzw.rkt") - -;; FIXME: still need to handle transparency +(require "private/lzw.rkt") (provide gif->rgba-rows) diff --git a/collects/racket/draw/bitmap-dc.rkt b/collects/racket/draw/private/bitmap-dc.rkt similarity index 94% rename from collects/racket/draw/bitmap-dc.rkt rename to collects/racket/draw/private/bitmap-dc.rkt index 9ccdc110ac..a04ed16e0a 100644 --- a/collects/racket/draw/bitmap-dc.rkt +++ b/collects/racket/draw/private/bitmap-dc.rkt @@ -1,11 +1,12 @@ -#lang scheme/base -(require scheme/class - mred/private/syntax - "cairo.ss" - "color.ss" - "bitmap.ss" - "dc.ss" - "local.ss") +#lang racket/base +(require racket/class + ffi/unsafe/atomic + "syntax.rkt" + "../unsafe/cairo.rkt" + "color.rkt" + "bitmap.rkt" + "dc.rkt" + "local.rkt") (provide bitmap-dc% bitmap-dc-backend%) @@ -13,8 +14,7 @@ (define bitmap-dc-backend% (class default-dc-backend% (init [_bm #f]) - (inherit reset-cr - call-with-cr-lock) + (inherit reset-cr) (define c #f) (define bm #f) @@ -37,7 +37,7 @@ (define/public (internal-set-bitmap v [direct? #f]) (if direct? (do-set-bitmap v #t) - (call-with-cr-lock + (call-as-atomic (lambda () (do-set-bitmap v #t) (when c (reset-cr c)))))) diff --git a/collects/racket/draw/bitmap.rkt b/collects/racket/draw/private/bitmap.rkt similarity index 99% rename from collects/racket/draw/bitmap.rkt rename to collects/racket/draw/private/bitmap.rkt index 7695dfd854..92656eb1d0 100644 --- a/collects/racket/draw/bitmap.rkt +++ b/collects/racket/draw/private/bitmap.rkt @@ -1,18 +1,18 @@ #lang scheme/base (require scheme/class scheme/unsafe/ops - mred/private/syntax - "hold.ss" - "bstr.ss" - "cairo.ss" - "png.ss" - "jpeg.ss" - "xbm.ss" - "xpm.ss" - "bmp.ss" - "gif.rkt" - "local.ss" - "color.ss") + "syntax.rkt" + "hold.rkt" + "../unsafe/bstr.rkt" + "../unsafe/cairo.rkt" + "../unsafe/png.rkt" + "../unsafe/jpeg.rkt" + "../xbm.rkt" + "../xpm.rkt" + "../bmp.rkt" + "../gif.rkt" + "local.rkt" + "color.rkt") (provide bitmap% make-alternate-bitmap-kind) diff --git a/collects/racket/draw/brush.rkt b/collects/racket/draw/private/brush.rkt similarity index 100% rename from collects/racket/draw/brush.rkt rename to collects/racket/draw/private/brush.rkt diff --git a/collects/racket/draw/color.rkt b/collects/racket/draw/private/color.rkt similarity index 100% rename from collects/racket/draw/color.rkt rename to collects/racket/draw/private/color.rkt diff --git a/collects/racket/draw/dc-intf.rkt b/collects/racket/draw/private/dc-intf.rkt similarity index 100% rename from collects/racket/draw/dc-intf.rkt rename to collects/racket/draw/private/dc-intf.rkt diff --git a/collects/racket/draw/dc-path.rkt b/collects/racket/draw/private/dc-path.rkt similarity index 99% rename from collects/racket/draw/dc-path.rkt rename to collects/racket/draw/private/dc-path.rkt index 314433b34a..12257fc433 100644 --- a/collects/racket/draw/dc-path.rkt +++ b/collects/racket/draw/private/dc-path.rkt @@ -1,9 +1,9 @@ #lang scheme/base -(require mred/private/syntax +(require "syntax.rkt" scheme/math scheme/class - "cairo.ss" + "../unsafe/cairo.ss" "fmod.ss" "point.ss" (only-in scheme/base diff --git a/collects/racket/draw/dc.rkt b/collects/racket/draw/private/dc.rkt similarity index 99% rename from collects/racket/draw/dc.rkt rename to collects/racket/draw/private/dc.rkt index cc78270fc5..b28d560963 100644 --- a/collects/racket/draw/dc.rkt +++ b/collects/racket/draw/private/dc.rkt @@ -1,7 +1,7 @@ #lang scheme/base -(require mred/private/syntax - mred/private/lock +(require "syntax.rkt" + ffi/unsafe/atomic racket/flonum ffi/unsafe ffi/unsafe/atomic @@ -9,8 +9,8 @@ racket/class "hold.ss" "local.ss" - "cairo.ss" - "pango.ss" + "../unsafe/cairo.ss" + "../unsafe/pango.ss" "color.ss" "pen.ss" "brush.ss" @@ -21,7 +21,7 @@ "dc-path.ss" "point.ss" "local.ss" - "bstr.rkt") + "../unsafe/bstr.rkt") (provide dc-mixin dc-backend<%> @@ -67,11 +67,6 @@ ;; This is the interface that the backend specific code must implement (define dc-backend<%> (interface () - ;; call-with-cr-lock : (-> any) -> any - ;; - ;; Calls a thunk while holding the lock on the cairo context. - call-with-cr-lock - ;; get-cr : -> cairo_t or #f ;; ;; Gets a cairo_t created in a backend specific manner. @@ -159,16 +154,6 @@ (define default-dc-backend% (class* object% (dc-backend<%>) - ;; Using the global lock here is troublesome, becase - ;; operations involving paths, regions, and text can - ;; take arbitrarily long. Parts of the editor infrastructure, - ;; meanwhile, assume that the global lock can be taken - ;; around actions that use the editor-canvas dc. If we - ;; have a separate per-dc lock, we can hit deadlock due to - ;; lock order. - (define/public (call-with-cr-lock thunk) - (as-entry thunk)) - (define/public (get-cr) #f) (define/public (release-cr cr) (void)) (define/public (end-cr) (void)) @@ -240,9 +225,17 @@ (inherit flush-cr get-cr release-cr end-cr init-cr-matrix get-pango install-color dc-adjust-smoothing reset-clip - collapse-bitmap-b&w? call-with-cr-lock + collapse-bitmap-b&w? ok? can-combine-text? can-mask-bitmap?) + ;; Using the global lock here is troublesome, becase + ;; operations involving paths, regions, and text can + ;; take arbitrarily long. Parts of the editor infrastructure, + ;; meanwhile, assume that the global lock can be taken + ;; around actions that use the editor-canvas dc. If we + ;; have a separate per-dc lock, we can hit deadlock due to + ;; lock order. + (define-syntax-rule (with-cr default cr . body) ;; Faster: (begin @@ -258,7 +251,7 @@ default)))) ;; Safer: #; - (call-with-cr-lock + (call-as-atomic (lambda () (let ([cr (get-cr)]) (if cr diff --git a/collects/racket/draw/define.rkt b/collects/racket/draw/private/define.rkt similarity index 100% rename from collects/racket/draw/define.rkt rename to collects/racket/draw/private/define.rkt diff --git a/collects/racket/draw/fmod.rkt b/collects/racket/draw/private/fmod.rkt similarity index 100% rename from collects/racket/draw/fmod.rkt rename to collects/racket/draw/private/fmod.rkt diff --git a/collects/racket/draw/font-dir.rkt b/collects/racket/draw/private/font-dir.rkt similarity index 97% rename from collects/racket/draw/font-dir.rkt rename to collects/racket/draw/private/font-dir.rkt index fce1cd3e84..40037bc5b7 100644 --- a/collects/racket/draw/font-dir.rkt +++ b/collects/racket/draw/private/font-dir.rkt @@ -1,7 +1,7 @@ -#lang scheme/base -(require scheme/class - mred/private/syntax - "font-syms.ss") +#lang racket/base +(require racket/class + "syntax.rkt" + "font-syms.rkt") (provide font-name-directory<%> the-font-name-directory) diff --git a/collects/racket/draw/font-syms.rkt b/collects/racket/draw/private/font-syms.rkt similarity index 100% rename from collects/racket/draw/font-syms.rkt rename to collects/racket/draw/private/font-syms.rkt diff --git a/collects/racket/draw/font.rkt b/collects/racket/draw/private/font.rkt similarity index 99% rename from collects/racket/draw/font.rkt rename to collects/racket/draw/private/font.rkt index 28fc4e5460..0a5264486d 100644 --- a/collects/racket/draw/font.rkt +++ b/collects/racket/draw/private/font.rkt @@ -3,7 +3,7 @@ ffi/unsafe ffi/unsafe/atomic "syntax.ss" - "pango.ss" + "../unsafe/pango.ss" "font-syms.ss" "font-dir.ss" "local.ss") diff --git a/collects/racket/draw/gl-config.rkt b/collects/racket/draw/private/gl-config.rkt similarity index 100% rename from collects/racket/draw/gl-config.rkt rename to collects/racket/draw/private/gl-config.rkt diff --git a/collects/racket/draw/gl-context.rkt b/collects/racket/draw/private/gl-context.rkt similarity index 100% rename from collects/racket/draw/gl-context.rkt rename to collects/racket/draw/private/gl-context.rkt diff --git a/collects/racket/draw/hold.rkt b/collects/racket/draw/private/hold.rkt similarity index 100% rename from collects/racket/draw/hold.rkt rename to collects/racket/draw/private/hold.rkt diff --git a/collects/racket/draw/libs.rkt b/collects/racket/draw/private/libs.rkt similarity index 100% rename from collects/racket/draw/libs.rkt rename to collects/racket/draw/private/libs.rkt diff --git a/collects/racket/draw/local.rkt b/collects/racket/draw/private/local.rkt similarity index 97% rename from collects/racket/draw/local.rkt rename to collects/racket/draw/private/local.rkt index a7c169a1c8..76041e97ec 100644 --- a/collects/racket/draw/local.rkt +++ b/collects/racket/draw/private/local.rkt @@ -33,7 +33,6 @@ get-font-key ;; dc-backend<%> - call-with-cr-lock get-cr release-cr end-cr diff --git a/collects/racket/draw/lzw.rkt b/collects/racket/draw/private/lzw.rkt similarity index 100% rename from collects/racket/draw/lzw.rkt rename to collects/racket/draw/private/lzw.rkt diff --git a/collects/racket/draw/pen.rkt b/collects/racket/draw/private/pen.rkt similarity index 100% rename from collects/racket/draw/pen.rkt rename to collects/racket/draw/private/pen.rkt diff --git a/collects/racket/draw/point.rkt b/collects/racket/draw/private/point.rkt similarity index 100% rename from collects/racket/draw/point.rkt rename to collects/racket/draw/private/point.rkt diff --git a/collects/racket/draw/post-script-dc.rkt b/collects/racket/draw/private/post-script-dc.rkt similarity index 98% rename from collects/racket/draw/post-script-dc.rkt rename to collects/racket/draw/private/post-script-dc.rkt index 7642e7ea80..5f70454367 100644 --- a/collects/racket/draw/post-script-dc.rkt +++ b/collects/racket/draw/private/post-script-dc.rkt @@ -3,9 +3,9 @@ scheme/file racket/path racket/math - mred/private/syntax + "syntax.rkt" racket/gui/dynamic - "cairo.ss" + "../unsafe/cairo.ss" "dc.ss" "font.ss" "local.ss" diff --git a/collects/racket/draw/ps-setup.rkt b/collects/racket/draw/private/ps-setup.rkt similarity index 98% rename from collects/racket/draw/ps-setup.rkt rename to collects/racket/draw/private/ps-setup.rkt index 87d13bdec8..d07ecd53da 100644 --- a/collects/racket/draw/ps-setup.rkt +++ b/collects/racket/draw/private/ps-setup.rkt @@ -1,6 +1,6 @@ -#lang scheme/base -(require scheme/class - mred/private/syntax) +#lang racket/base +(require racket/class + "syntax.rkt") (provide ps-setup% current-ps-setup diff --git a/collects/racket/draw/record-dc.rkt b/collects/racket/draw/private/record-dc.rkt similarity index 99% rename from collects/racket/draw/record-dc.rkt rename to collects/racket/draw/private/record-dc.rkt index acc2e7f4b9..0167709245 100644 --- a/collects/racket/draw/record-dc.rkt +++ b/collects/racket/draw/private/record-dc.rkt @@ -1,6 +1,5 @@ #lang racket/base -(require mred/private/syntax - mred/private/lock +(require "syntax.rkt" racket/class "dc.rkt" "bitmap.rkt" diff --git a/collects/racket/draw/region.rkt b/collects/racket/draw/private/region.rkt similarity index 99% rename from collects/racket/draw/region.rkt rename to collects/racket/draw/private/region.rkt index 69c3348777..a9d435ede3 100644 --- a/collects/racket/draw/region.rkt +++ b/collects/racket/draw/private/region.rkt @@ -3,7 +3,7 @@ ffi/unsafe/atomic "syntax.ss" "local.ss" - "cairo.ss" + "../unsafe/cairo.ss" "dc-path.ss" "dc-intf.ss" "point.ss") diff --git a/collects/racket/draw/private/syntax.rkt b/collects/racket/draw/private/syntax.rkt new file mode 100644 index 0000000000..b4cc868a66 --- /dev/null +++ b/collects/racket/draw/private/syntax.rkt @@ -0,0 +1,299 @@ +#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))) diff --git a/collects/racket/draw/utils.rkt b/collects/racket/draw/private/utils.rkt similarity index 100% rename from collects/racket/draw/utils.rkt rename to collects/racket/draw/private/utils.rkt diff --git a/collects/racket/draw/syntax.rkt b/collects/racket/draw/syntax.rkt deleted file mode 100644 index 8f2b287dfc..0000000000 --- a/collects/racket/draw/syntax.rkt +++ /dev/null @@ -1,3 +0,0 @@ -#lang scheme/base -(require mred/private/syntax) -(provide (all-from-out mred/private/syntax)) diff --git a/collects/racket/draw/bstr.rkt b/collects/racket/draw/unsafe/bstr.rkt similarity index 100% rename from collects/racket/draw/bstr.rkt rename to collects/racket/draw/unsafe/bstr.rkt diff --git a/collects/racket/draw/cairo.rkt b/collects/racket/draw/unsafe/cairo.rkt similarity index 99% rename from collects/racket/draw/cairo.rkt rename to collects/racket/draw/unsafe/cairo.rkt index 19c9b39503..50ce3cadc4 100644 --- a/collects/racket/draw/cairo.rkt +++ b/collects/racket/draw/unsafe/cairo.rkt @@ -3,8 +3,8 @@ ffi/unsafe/define ffi/unsafe/alloc setup/dirs - "libs.rkt" - "utils.rkt") + "../private/libs.rkt" + "../private/utils.rkt") (define-runtime-lib cairo-lib [(unix) (ffi-lib "libcairo" '("2"))] diff --git a/collects/racket/draw/jpeg.rkt b/collects/racket/draw/unsafe/jpeg.rkt similarity index 99% rename from collects/racket/draw/jpeg.rkt rename to collects/racket/draw/unsafe/jpeg.rkt index 0f0cc70695..de8c4c78dc 100644 --- a/collects/racket/draw/jpeg.rkt +++ b/collects/racket/draw/unsafe/jpeg.rkt @@ -5,8 +5,8 @@ ffi/unsafe/atomic setup/dirs "bstr.rkt" - "utils.rkt" - "libs.rkt") + "../private/utils.rkt" + "../private/libs.rkt") (define-runtime-lib jpeg-lib [(unix) (ffi-lib "libjpeg" '("62" ""))] diff --git a/collects/racket/draw/pango.rkt b/collects/racket/draw/unsafe/pango.rkt similarity index 99% rename from collects/racket/draw/pango.rkt rename to collects/racket/draw/unsafe/pango.rkt index dd406f2e9e..7ee2bf0f28 100644 --- a/collects/racket/draw/pango.rkt +++ b/collects/racket/draw/unsafe/pango.rkt @@ -5,8 +5,8 @@ ffi/unsafe/atomic setup/dirs "cairo.rkt" - "utils.rkt" - "libs.rkt") + "../private/utils.rkt" + "../private/libs.rkt") (define-runtime-lib pango-lib [(unix) (ffi-lib "libpango-1.0" '("0"))] diff --git a/collects/racket/draw/png.rkt b/collects/racket/draw/unsafe/png.rkt similarity index 99% rename from collects/racket/draw/png.rkt rename to collects/racket/draw/unsafe/png.rkt index 1690eaed4f..8d28e6dd3d 100644 --- a/collects/racket/draw/png.rkt +++ b/collects/racket/draw/unsafe/png.rkt @@ -5,8 +5,8 @@ ffi/unsafe/atomic setup/dirs "bstr.rkt" - "utils.rkt" - "libs.rkt") + "../private/utils.rkt" + "../private/libs.rkt") (define-runtime-lib png-lib [(unix) diff --git a/collects/scribblings/gui/miscwin-funcs.scrbl b/collects/scribblings/gui/miscwin-funcs.scrbl index 7771bf77ae..64bbb43cb3 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/collects/scribblings/gui/region-class.scrbl b/collects/scribblings/gui/region-class.scrbl index 6d0e618ac8..fe84ee0099 100644 --- a/collects/scribblings/gui/region-class.scrbl +++ b/collects/scribblings/gui/region-class.scrbl @@ -22,7 +22,7 @@ Region combination with operations like @racket[region% union] are combinations work only if the paths have a suitable fill mode, which can be either @racket['winding], @racket['even-odd], or a @deftech{flexible fill} mode. When a region is installed as a device - context's clipping region, any subpath with a @deftech{flexible fill} + context's clipping region, any subpath with a @tech{flexible fill} mode uses @racket['even-odd] mode if any other path uses @racket['even-odd] mode. 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 6be461a76e..356bc7e7b1 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.