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

clean up

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-27 05:23:18 -06:00
parent 4f55d22705
commit d7f1d12ea1
185 changed files with 1323 additions and 1466 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/framework/private/preferences.rkt
View File

@ -530,18 +530,7 @@ the state transitions / contracts are:
(cond (cond
[(string? default) string?] [(string? default) string?]
[(number? default) number?] [(number? default) number?]
[else (error 'internal-error.set-default "unrecognized default: ~a\n" default)])) [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))))))])
(for-each (set-default build-font-entry font-default-string string?) (for-each (set-default build-font-entry font-default-string string?)
font-families) font-families)
@ -579,14 +568,7 @@ the state transitions / contracts are:
[message (make-object message% [message (make-object message%
(let ([b (box "")]) (let ([b (box "")])
(if (and (get-resource font-default-string)
font-section
(build-font-entry name)
b)
(not (string=? (unbox b)
"")))
(unbox b)
font-default-string))
horiz)] horiz)]
[button [button
(make-object button% (make-object button%
@ -643,11 +625,7 @@ the state transitions / contracts are:
[size-panel (make-object horizontal-panel% main '(border))] [size-panel (make-object horizontal-panel% main '(border))]
[initial-font-size [initial-font-size
(let ([b (box 0)]) (let ([b (box 0)])
(if (get-resource font-section font-default-size)]
font-size-entry
b)
(unbox b)
font-default-size))]
[size-slider [size-slider
(make-object slider% (make-object slider%
(string-constant font-size-slider-label) (string-constant font-size-slider-label)

3
collects/mred/mred-sig.rkt
View File

@ -93,7 +93,6 @@ get-panel-background
get-ps-setup-from-user get-ps-setup-from-user
get-highlight-background-color get-highlight-background-color
get-highlight-text-color get-highlight-text-color
get-resource
get-text-from-user get-text-from-user
get-the-editor-data-class-list get-the-editor-data-class-list
get-the-snip-class-list get-the-snip-class-list
@ -164,7 +163,6 @@ region%
register-collecting-blit register-collecting-blit
scroll-event% scroll-event%
selectable-menu-item<%> selectable-menu-item<%>
send-event
send-message-to-window send-message-to-window
separator-menu-item% separator-menu-item%
sleep/yield sleep/yield
@ -207,5 +205,4 @@ window<%>
write-editor-global-footer write-editor-global-footer
write-editor-global-header write-editor-global-header
write-editor-version write-editor-version
write-resource
yield yield

3
collects/mred/mred.rkt
View File

@ -130,7 +130,6 @@
font-name-directory<%> font-name-directory<%>
get-highlight-background-color get-highlight-background-color
get-highlight-text-color get-highlight-text-color
get-resource
get-the-editor-data-class-list get-the-editor-data-class-list
get-the-snip-class-list get-the-snip-class-list
image-snip% image-snip%
@ -175,12 +174,10 @@
write-editor-global-footer write-editor-global-footer
write-editor-global-header write-editor-global-header
write-editor-version write-editor-version
write-resource
queue-callback queue-callback
yield yield
eventspace-shutdown? eventspace-shutdown?
get-panel-background get-panel-background
send-event
gl-context<%> gl-context<%>
gl-config% gl-config%

300
collects/mred/private/syntax.rkt
View File

@ -1,299 +1,3 @@
#lang scheme/base #lang scheme/base
(require scheme/class (require racket/draw/private/syntax)
scheme/stxparam (provide (all-from-out racket/draw/private/syntax))
(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)))

3
collects/mred/private/wx/cocoa/README.txt
View File

@ -12,4 +12,5 @@ Allocation rules:
* Other autoreleased objects may end up in the root pool installed by * Other autoreleased objects may end up in the root pool installed by
"pool.rkt". The root pool is periodically destroyed and replaced; "pool.rkt". The root pool is periodically destroyed and replaced;
call `queue-autorelease-flush' if you need to encurage replacement 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.

12
collects/mred/private/wx/cocoa/agl.rkt
View File

@ -4,13 +4,13 @@
ffi/unsafe/define ffi/unsafe/define
ffi/unsafe/alloc ffi/unsafe/alloc
"../../lock.rkt" "../../lock.rkt"
racket/draw/cairo racket/draw/unsafe/cairo
racket/draw/local racket/draw/private/local
racket/draw/gl-context racket/draw/private/gl-context
racket/draw/gl-config racket/draw/private/gl-config
racket/draw/bitmap) racket/draw/private/bitmap)
(provide create-gl-bitmap) (provide (protect-out create-gl-bitmap))
(define agl-lib (define agl-lib
(ffi-lib "/System/Library/Frameworks/AGL.framework/AGL")) (ffi-lib "/System/Library/Frameworks/AGL.framework/AGL"))

6
collects/mred/private/wx/cocoa/bitmap.rkt
View File

@ -2,9 +2,9 @@
(require racket/class (require racket/class
ffi/unsafe ffi/unsafe
ffi/unsafe/objc ffi/unsafe/objc
racket/draw/cairo racket/draw/unsafe/cairo
racket/draw/bitmap racket/draw/private/bitmap
racket/draw/local racket/draw/private/local
"types.rkt" "types.rkt"
"utils.rkt" "utils.rkt"
"../../lock.rkt" "../../lock.rkt"

15
collects/mred/private/wx/cocoa/button.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require ffi/objc (require ffi/unsafe/objc
scheme/foreign ffi/unsafe
scheme/class racket/class
"../../syntax.rkt" "../../syntax.rkt"
"item.rkt" "item.rkt"
"utils.rkt" "utils.rkt"
@ -10,12 +10,11 @@
"window.rkt" "window.rkt"
"../common/event.rkt" "../common/event.rkt"
"image.rkt") "image.rkt")
(unsafe!)
(objc-unsafe!)
(provide button% (provide
(protect-out button%
core-button% core-button%
MyButton) MyButton))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -3,14 +3,15 @@
ffi/unsafe ffi/unsafe
racket/class racket/class
racket/draw racket/draw
racket/draw/gl-context racket/draw/private/gl-context
racket/draw/color racket/draw/private/color
"pool.rkt" "pool.rkt"
"utils.rkt" "utils.rkt"
"const.rkt" "const.rkt"
"types.rkt" "types.rkt"
"window.rkt" "window.rkt"
"dc.rkt" "dc.rkt"
"bitmap.rkt"
"cg.rkt" "cg.rkt"
"queue.rkt" "queue.rkt"
"item.rkt" "item.rkt"
@ -24,7 +25,8 @@
"../../lock.rkt" "../../lock.rkt"
"../common/freeze.rkt") "../common/freeze.rkt")
(provide canvas%) (provide
(protect-out canvas%))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -4,7 +4,7 @@
"types.rkt" "types.rkt"
"utils.rkt") "utils.rkt")
(provide (all-defined-out)) (provide (protect-out (all-defined-out)))
(define _CGContextRef (_cpointer 'CGContextRef)) (define _CGContextRef (_cpointer 'CGContextRef))
(define-appserv CGContextSynchronize (_fun _CGContextRef -> _void)) (define-appserv CGContextSynchronize (_fun _CGContextRef -> _void))

13
collects/mred/private/wx/cocoa/check-box.rkt
View File

@ -1,15 +1,14 @@
#lang scheme/base #lang racket/base
(require ffi/objc (require ffi/unsafe/objc
scheme/foreign ffi/unsafe
scheme/class racket/class
"../../syntax.rkt" "../../syntax.rkt"
"button.rkt" "button.rkt"
"types.rkt" "types.rkt"
"const.rkt") "const.rkt")
(unsafe!)
(objc-unsafe!)
(provide check-box%) (provide
(protect-out check-box%))
;; ---------------------------------------- ;; ----------------------------------------

13
collects/mred/private/wx/cocoa/choice.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/objc ffi/unsafe/objc
"../../syntax.rkt" "../../syntax.rkt"
"item.rkt" "item.rkt"
"types.rkt" "types.rkt"
@ -9,10 +9,9 @@
"utils.rkt" "utils.rkt"
"window.rkt" "window.rkt"
"../common/event.rkt") "../common/event.rkt")
(unsafe!)
(objc-unsafe!)
(provide choice%) (provide
(protect-out choice%))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -1,16 +1,17 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
ffi/unsafe ffi/unsafe
ffi/unsafe/objc ffi/unsafe/objc
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"image.rkt" "image.rkt"
"../common/bstr.rkt" racket/draw/unsafe/bstr
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt") "../../lock.rkt")
(provide clipboard-driver% (provide
has-x-selection?) (protect-out clipboard-driver%
has-x-selection?))
(import-class NSPasteboard NSArray NSData NSImage NSGraphicsContext) (import-class NSPasteboard NSArray NSData NSImage NSGraphicsContext)
(import-protocol NSPasteboardOwner) (import-protocol NSPasteboardOwner)

5
collects/mred/private/wx/cocoa/colordialog.rkt
View File

@ -2,12 +2,13 @@
(require ffi/unsafe (require ffi/unsafe
ffi/unsafe/objc ffi/unsafe/objc
racket/class racket/class
racket/draw/color racket/draw/private/color
"../../lock.rkt" "../../lock.rkt"
"utils.rkt" "utils.rkt"
"types.rkt") "types.rkt")
(provide get-color-from-user) (provide
(protect-out get-color-from-user))
(import-class NSColorPanel (import-class NSColorPanel
NSColor) NSColor)

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

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(provide (except-out (all-defined-out) <<)) (provide (except-out (all-defined-out) <<))

5
collects/mred/private/wx/cocoa/cursor.rkt
View File

@ -9,9 +9,10 @@
"../common/cursor-draw.rkt" "../common/cursor-draw.rkt"
"../common/local.rkt") "../common/local.rkt")
(provide cursor-driver% (provide
(protect-out cursor-driver%
arrow-cursor-handle arrow-cursor-handle
get-wait-cursor-handle) get-wait-cursor-handle))
(import-class NSCursor) (import-class NSCursor)

14
collects/mred/private/wx/cocoa/dc.rkt
View File

@ -2,10 +2,10 @@
(require racket/class (require racket/class
ffi/unsafe ffi/unsafe
ffi/unsafe/objc ffi/unsafe/objc
racket/draw/cairo racket/draw/unsafe/cairo
racket/draw/bitmap racket/draw/private/bitmap
racket/draw/local racket/draw/private/local
racket/draw/gl-context racket/draw/private/gl-context
"types.rkt" "types.rkt"
"utils.rkt" "utils.rkt"
"bitmap.rkt" "bitmap.rkt"
@ -15,9 +15,9 @@
"../common/backing-dc.rkt" "../common/backing-dc.rkt"
"cg.rkt") "cg.rkt")
(provide dc% (provide
quartz-bitmap% (protect-out dc%
do-backing-flush) do-backing-flush))
(import-class NSOpenGLContext) (import-class NSOpenGLContext)

7
collects/mred/private/wx/cocoa/dialog.rkt
View File

@ -1,12 +1,13 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
"../../syntax.rkt" "../../syntax.rkt"
"../common/queue.rkt" "../common/queue.rkt"
"../common/dialog.rkt" "../common/dialog.rkt"
"../../lock.rkt" "../../lock.rkt"
"frame.rkt") "frame.rkt")
(provide dialog%) (provide
(protect-out dialog%))
(define dialog% (define dialog%
(class (dialog-mixin frame%) (class (dialog-mixin frame%)

3
collects/mred/private/wx/cocoa/filedialog.rkt
View File

@ -9,7 +9,8 @@
"queue.rkt" "queue.rkt"
"frame.rkt") "frame.rkt")
(provide file-selector) (provide
(protect-out file-selector))
(import-class NSOpenPanel NSSavePanel NSURL NSArray) (import-class NSOpenPanel NSSavePanel NSURL NSArray)

3
collects/mred/private/wx/cocoa/finfo.rkt
View File

@ -4,7 +4,8 @@
"utils.rkt" "utils.rkt"
"types.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"))) (define coreserv-lib (ffi-lib (format "/System/Library/Frameworks/CoreServices.framework/CoreServices")))

3
collects/mred/private/wx/cocoa/font.rkt
View File

@ -8,7 +8,8 @@
"utils.rkt" "utils.rkt"
"types.rkt") "types.rkt")
(provide font->NSFont) (provide
(protect-out font->NSFont))
(import-class NSFont NSFontManager) (import-class NSFont NSFontManager)

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

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require ffi/unsafe/objc (require ffi/unsafe/objc
ffi/unsafe ffi/unsafe
scheme/class scheme/class
@ -15,9 +15,10 @@
"../common/freeze.rkt" "../common/freeze.rkt"
"../../lock.rkt") "../../lock.rkt")
(provide frame% (provide
(protect-out frame%
location->window location->window
get-front) get-front))
;; ---------------------------------------- ;; ----------------------------------------

13
collects/mred/private/wx/cocoa/gauge.rkt
View File

@ -1,18 +1,17 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
racket/math racket/math
ffi/objc ffi/unsafe/objc
"../../syntax.rkt" "../../syntax.rkt"
"item.rkt" "item.rkt"
"types.rkt" "types.rkt"
"const.rkt" "const.rkt"
"utils.rkt" "utils.rkt"
"window.rkt") "window.rkt")
(unsafe!)
(objc-unsafe!)
(provide gauge%) (provide
(protect-out gauge%))
;; ---------------------------------------- ;; ----------------------------------------

5
collects/mred/private/wx/cocoa/gc.rkt
View File

@ -4,9 +4,10 @@
"utils.rkt" "utils.rkt"
"types.rkt") "types.rkt")
(provide scheme_add_gc_callback (provide
(protect-out scheme_add_gc_callback
scheme_remove_gc_callback scheme_remove_gc_callback
make-gc-action-desc) make-gc-action-desc))
(define objc-lib (ffi-lib "libobjc")) (define objc-lib (ffi-lib "libobjc"))

13
collects/mred/private/wx/cocoa/group-panel.rkt
View File

@ -1,16 +1,15 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/objc ffi/unsafe/objc
"../../syntax.rkt" "../../syntax.rkt"
"types.rkt" "types.rkt"
"utils.rkt" "utils.rkt"
"window.rkt" "window.rkt"
"panel.rkt") "panel.rkt")
(unsafe!)
(objc-unsafe!)
(provide group-panel%) (provide
(protect-out group-panel%))
(import-class NSBox) (import-class NSBox)

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

@ -2,9 +2,9 @@
(require ffi/unsafe (require ffi/unsafe
ffi/unsafe/objc ffi/unsafe/objc
racket/class racket/class
racket/draw/cairo racket/draw/unsafe/cairo
racket/draw/local racket/draw/private/local
"../common/bstr.rkt" racket/draw/unsafe/bstr
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"const.rkt" "const.rkt"
@ -13,8 +13,9 @@
"../../lock.rkt" "../../lock.rkt"
(only-in '#%foreign ffi-callback)) (only-in '#%foreign ffi-callback))
(provide bitmap->image (provide
image->bitmap) (protect-out bitmap->image
image->bitmap))
(import-class NSImage NSGraphicsContext) (import-class NSImage NSGraphicsContext)

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

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require "pool.rkt" (require "pool.rkt"
"queue.rkt") "queue.rkt")

15
collects/mred/private/wx/cocoa/item.rkt
View File

@ -1,17 +1,16 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/objc ffi/unsafe/objc
"../../syntax.rkt" "../../syntax.rkt"
"window.rkt" "window.rkt"
"const.rkt" "const.rkt"
"types.rkt" "types.rkt"
"font.rkt") "font.rkt")
(unsafe!)
(objc-unsafe!)
(provide item% (provide
install-control-font) (protect-out item%
install-control-font))
(import-class NSFont) (import-class NSFont)
(define sys-font (tell NSFont (define sys-font (tell NSFont

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

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(provide map-key-code) (provide map-key-code)

13
collects/mred/private/wx/cocoa/list-box.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require ffi/objc (require ffi/unsafe/objc
scheme/foreign ffi/unsafe
scheme/class racket/class
(only-in scheme/list take drop) (only-in scheme/list take drop)
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
@ -12,10 +12,9 @@
"window.rkt" "window.rkt"
"font.rkt" "font.rkt"
"../common/event.rkt") "../common/event.rkt")
(unsafe!)
(objc-unsafe!)
(provide list-box%) (provide
(protect-out list-box%))
;; ---------------------------------------- ;; ----------------------------------------

7
collects/mred/private/wx/cocoa/menu-bar.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require racket/class (require racket/class
ffi/unsafe ffi/unsafe
ffi/unsafe/objc ffi/unsafe/objc
@ -10,8 +10,9 @@
"const.rkt" "const.rkt"
"queue.rkt") "queue.rkt")
(provide menu-bar% (provide
get-menu-bar-height) (protect-out menu-bar%
get-menu-bar-height))
(import-class NSApplication NSMenu NSMenuItem NSProcessInfo NSScreen) (import-class NSApplication NSMenu NSMenuItem NSProcessInfo NSScreen)

5
collects/mred/private/wx/cocoa/menu-item.rkt
View File

@ -7,8 +7,9 @@
"types.rkt" "types.rkt"
"const.rkt") "const.rkt")
(provide menu-item% (provide
set-menu-item-shortcut) (protect-out menu-item%
set-menu-item-shortcut))
(import-class NSMenuItem) (import-class NSMenuItem)

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

@ -10,7 +10,8 @@
"window.rkt" "window.rkt"
"menu-item.rkt") "menu-item.rkt")
(provide menu%) (provide
(protect-out menu%))
(import-class NSMenu NSMenuItem) (import-class NSMenu NSMenuItem)

15
collects/mred/private/wx/cocoa/message.rkt
View File

@ -1,18 +1,17 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/objc ffi/unsafe/objc
racket/draw/bitmap racket/draw/private/bitmap
"../../syntax.rkt" "../../syntax.rkt"
"window.rkt" "window.rkt"
"item.rkt" "item.rkt"
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"image.rkt") "image.rkt")
(unsafe!)
(objc-unsafe!)
(provide message%) (provide
(protect-out message%))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -1,16 +1,15 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/objc ffi/unsafe/objc
"../../syntax.rkt" "../../syntax.rkt"
"types.rkt" "types.rkt"
"utils.rkt" "utils.rkt"
"window.rkt") "window.rkt")
(unsafe!)
(objc-unsafe!)
(provide panel% (provide
panel-mixin) (protect-out panel%
panel-mixin))
(import-class NSView) (import-class NSView)

5
collects/mred/private/wx/cocoa/platform.rkt
View File

@ -23,7 +23,7 @@
"tab-panel.rkt" "tab-panel.rkt"
"window.rkt" "window.rkt"
"procs.rkt") "procs.rkt")
(provide platform-values) (provide (protect-out platform-values))
(define (platform-values) (define (platform-values)
(values (values
@ -60,8 +60,6 @@
bell bell
display-size display-size
display-origin display-origin
get-resource
write-resource
flush-display flush-display
fill-private-color fill-private-color
cancel-quit cancel-quit
@ -71,7 +69,6 @@
get-double-click-time get-double-click-time
run-printout run-printout
file-creator-and-type file-creator-and-type
send-event
location->window location->window
shortcut-visible-in-label? shortcut-visible-in-label?
unregister-collecting-blit unregister-collecting-blit

5
collects/mred/private/wx/cocoa/pool.rkt
View File

@ -6,8 +6,9 @@
"const.rkt" "const.rkt"
"types.rkt") "types.rkt")
(provide queue-autorelease-flush (provide
autorelease-flush) (protect-out queue-autorelease-flush
autorelease-flush))
(import-class NSAutoreleasePool) (import-class NSAutoreleasePool)

20
collects/mred/private/wx/cocoa/printer-dc.rkt
View File

@ -1,23 +1,25 @@
#lang racket/base #lang racket/base
(require racket/class (require racket/class
racket/math racket/math
racket/draw/local racket/draw/private/local
racket/draw/dc racket/draw/private/dc
racket/draw/cairo racket/draw/unsafe/cairo
racket/draw/bitmap racket/draw/private/bitmap
racket/draw/bitmap-dc racket/draw/private/bitmap-dc
racket/draw/record-dc racket/draw/private/record-dc
racket/draw/ps-setup racket/draw/private/ps-setup
ffi/unsafe ffi/unsafe
ffi/unsafe/objc ffi/unsafe/objc
"../../lock.rkt" "../../lock.rkt"
"dc.rkt" "dc.rkt"
"bitmap.rkt"
"cg.rkt" "cg.rkt"
"utils.rkt" "utils.rkt"
"types.rkt") "types.rkt")
(provide printer-dc% (provide
show-print-setup) (protect-out printer-dc%
show-print-setup))
(import-class NSPrintOperation NSView NSGraphicsContext (import-class NSPrintOperation NSView NSGraphicsContext
NSPrintInfo NSDictionary NSPageLayout NSPrintInfo NSDictionary NSPageLayout

30
collects/mred/private/wx/cocoa/procs.rkt
View File

@ -12,6 +12,7 @@
"filedialog.rkt" "filedialog.rkt"
"colordialog.rkt" "colordialog.rkt"
"dc.rkt" "dc.rkt"
"bitmap.rkt"
"printer-dc.rkt" "printer-dc.rkt"
"../common/printer.rkt" "../common/printer.rkt"
"menu-bar.rkt" "menu-bar.rkt"
@ -26,54 +27,45 @@
(provide (provide
application-file-handler (protect-out
application-quit-handler
application-about-handler
application-pref-handler
color-from-user-platform-mode color-from-user-platform-mode
get-color-from-user
font-from-user-platform-mode font-from-user-platform-mode
get-font-from-user get-font-from-user
get-panel-background
play-sound
find-graphical-system-path find-graphical-system-path
register-collecting-blit register-collecting-blit
unregister-collecting-blit unregister-collecting-blit
shortcut-visible-in-label? shortcut-visible-in-label?
send-event
file-creator-and-type
run-printout run-printout
get-double-click-time get-double-click-time
get-control-font-face get-control-font-face
get-control-font-size get-control-font-size
get-control-font-size-in-pixels? get-control-font-size-in-pixels?
cancel-quit cancel-quit
fill-private-color
flush-display
write-resource
get-resource
display-origin display-origin
display-size display-size
bell bell
hide-cursor hide-cursor
get-display-depth get-display-depth
is-color-display? is-color-display?
file-selector
id-to-menu-item id-to-menu-item
show-print-setup
can-show-print-setup? can-show-print-setup?
get-highlight-background-color get-highlight-background-color
get-highlight-text-color get-highlight-text-color
check-for-break)
make-screen-bitmap make-screen-bitmap
make-gl-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) (import-class NSScreen NSCursor)
(define-unimplemented find-graphical-system-path) (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") (define (color-from-user-platform-mode) "Show Picker")

12
collects/mred/private/wx/cocoa/queue.rkt
View File

@ -1,8 +1,8 @@
#lang scheme/base #lang racket/base
(require ffi/unsafe/objc (require ffi/unsafe/objc
ffi/unsafe ffi/unsafe
scheme/class racket/class
racket/draw/dc racket/draw/private/dc
"pool.rkt" "pool.rkt"
"utils.rkt" "utils.rkt"
"const.rkt" "const.rkt"
@ -12,16 +12,16 @@
"../../lock.rkt" "../../lock.rkt"
"../common/freeze.rkt") "../common/freeze.rkt")
(provide app (provide
(protect-out app
cocoa-start-event-pump cocoa-start-event-pump
cocoa-install-event-wakeup cocoa-install-event-wakeup
queue-event
set-eventspace-hook! set-eventspace-hook!
set-front-hook! set-front-hook!
set-menu-bar-hooks! set-menu-bar-hooks!
post-dummy-event post-dummy-event
try-to-sync-refresh try-to-sync-refresh)
;; from common/queue: ;; from common/queue:
current-eventspace current-eventspace

13
collects/mred/private/wx/cocoa/radio-box.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/objc ffi/unsafe/objc
"../../syntax.rkt" "../../syntax.rkt"
"item.rkt" "item.rkt"
"button.rkt" "button.rkt"
@ -11,10 +11,9 @@
"window.rkt" "window.rkt"
"../common/event.rkt" "../common/event.rkt"
"image.rkt") "image.rkt")
(unsafe!)
(objc-unsafe!)
(provide radio-box%) (provide
(protect-out radio-box%))
;; ---------------------------------------- ;; ----------------------------------------

13
collects/mred/private/wx/cocoa/slider.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
ffi/objc ffi/unsafe/objc
"../../syntax.rkt" "../../syntax.rkt"
"item.rkt" "item.rkt"
"types.rkt" "types.rkt"
@ -12,10 +12,9 @@
"../common/queue.rkt" "../common/queue.rkt"
"../common/freeze.rkt" "../common/freeze.rkt"
"../../lock.rkt") "../../lock.rkt")
(unsafe!)
(objc-unsafe!)
(provide slider%) (provide
(protect-out slider%))
;; ---------------------------------------- ;; ----------------------------------------

3
collects/mred/private/wx/cocoa/sound.rkt
View File

@ -4,7 +4,8 @@
"utils.rkt" "utils.rkt"
"types.rkt") "types.rkt")
(provide play-sound) (provide
(protect-out play-sound))
(import-class NSSound) (import-class NSSound)

3
collects/mred/private/wx/cocoa/tab-panel.rkt
View File

@ -13,7 +13,8 @@
"../common/procs.rkt" "../common/procs.rkt"
(for-syntax racket/base)) (for-syntax racket/base))
(provide tab-panel%) (provide
(protect-out tab-panel%))
(define-runtime-path psm-tab-bar-dir (define-runtime-path psm-tab-bar-dir
'(so "PSMTabBarControl.framework")) '(so "PSMTabBarControl.framework"))

13
collects/mred/private/wx/cocoa/types.rkt
View File

@ -1,12 +1,11 @@
#lang scheme/base #lang racket/base
(require ffi/objc (require ffi/unsafe/objc
scheme/foreign ffi/unsafe
"../../lock.rkt" "../../lock.rkt"
"utils.rkt") "utils.rkt")
(unsafe!)
(objc-unsafe!)
(provide _NSInteger _NSUInteger (provide
(protect-out _NSInteger _NSUInteger
_CGFloat _CGFloat
_NSPoint _NSPoint-pointer (struct-out NSPoint) _NSPoint _NSPoint-pointer (struct-out NSPoint)
_NSSize _NSSize-pointer (struct-out NSSize) _NSSize _NSSize-pointer (struct-out NSSize)
@ -14,7 +13,7 @@
_NSRange _NSRange-pointer (struct-out NSRange) _NSRange _NSRange-pointer (struct-out NSRange)
NSObject NSObject
NSString _NSString NSString _NSString
NSNotFound) NSNotFound))
(define _NSInteger _long) (define _NSInteger _long)
(define _NSUInteger _ulong) (define _NSUInteger _ulong)

7
collects/mred/private/wx/cocoa/utils.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require ffi/unsafe/objc (require ffi/unsafe/objc
ffi/unsafe ffi/unsafe
ffi/unsafe/alloc ffi/unsafe/alloc
@ -6,13 +6,13 @@
"../common/utils.rkt" "../common/utils.rkt"
"../../lock.rkt") "../../lock.rkt")
(provide cocoa-lib (provide
(protect-out cocoa-lib
cf-lib cf-lib
define-cocoa define-cocoa
define-cf define-cf
define-appserv define-appserv
define-appkit define-appkit
define-mz
as-objc-allocation as-objc-allocation
as-objc-allocation-with-retain as-objc-allocation-with-retain
clean-up-deleted clean-up-deleted
@ -22,6 +22,7 @@
->wxb ->wxb
->wx ->wx
old-cocoa?) old-cocoa?)
define-mz)
(define cocoa-lib (ffi-lib (format "/System/Library/Frameworks/Cocoa.framework/Cocoa"))) (define cocoa-lib (ffi-lib (format "/System/Library/Frameworks/Cocoa.framework/Cocoa")))
(define cf-lib (ffi-lib (format "/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation"))) (define cf-lib (ffi-lib (format "/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation")))

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

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require ffi/unsafe/objc (require ffi/unsafe/objc
ffi/unsafe ffi/unsafe
scheme/class racket/class
"queue.rkt" "queue.rkt"
"utils.rkt" "utils.rkt"
"const.rkt" "const.rkt"
@ -17,7 +17,8 @@
"../../syntax.rkt" "../../syntax.rkt"
"../common/freeze.rkt") "../common/freeze.rkt")
(provide window% (provide
(protect-out window%
FocusResponder FocusResponder
KeyMouseResponder KeyMouseResponder
@ -33,7 +34,7 @@
flush-display flush-display
special-control-key special-control-key
special-option-key) special-option-key))
(define-local-member-name flip-client) (define-local-member-name flip-client)

20
collects/mred/private/wx/common/backing-dc.rkt
View File

@ -1,13 +1,14 @@
#lang racket/base #lang racket/base
(require racket/class (require racket/class
racket/draw/dc racket/draw/private/dc
racket/draw/bitmap-dc racket/draw/private/bitmap-dc
racket/draw/bitmap racket/draw/private/bitmap
racket/draw/local racket/draw/private/local
"../../lock.rkt" "../../lock.rkt"
"queue.rkt") "queue.rkt")
(provide backing-dc% (provide
(protect-out backing-dc%
;; scoped method names: ;; scoped method names:
get-backing-size get-backing-size
@ -19,7 +20,7 @@
make-backing-bitmap make-backing-bitmap
request-delay request-delay
cancel-delay cancel-delay
end-delay) end-delay))
(define-local-member-name (define-local-member-name
get-backing-size get-backing-size
@ -35,8 +36,7 @@
(define backing-dc% (define backing-dc%
(class (dc-mixin bitmap-dc-backend%) (class (dc-mixin bitmap-dc-backend%)
(inherit call-with-cr-lock (inherit internal-get-bitmap
internal-get-bitmap
internal-set-bitmap internal-set-bitmap
reset-cr) reset-cr)
@ -87,12 +87,12 @@
(release-backing-bitmap bm))))) (release-backing-bitmap bm)))))
(define/public (start-backing-retained) (define/public (start-backing-retained)
(call-with-cr-lock (as-entry
(lambda () (lambda ()
(set! retained-counter (add1 retained-counter))))) (set! retained-counter (add1 retained-counter)))))
(define/public (end-backing-retained) (define/public (end-backing-retained)
(call-with-cr-lock (as-entry
(lambda () (lambda ()
(if (zero? retained-counter) (if (zero? retained-counter)
(log-error "unbalanced end-on-paint") (log-error "unbalanced end-on-paint")

3
collects/mred/private/wx/common/bstr.rkt
View File

@ -1,3 +0,0 @@
#lang racket/base
(require racket/draw/bstr)
(provide scheme_make_sized_byte_string)

5
collects/mred/private/wx/common/canvas-mixin.rkt
View File

@ -3,9 +3,10 @@
racket/draw racket/draw
"backing-dc.rkt") "backing-dc.rkt")
(provide canvas-autoscroll-mixin (provide
(protect-out canvas-autoscroll-mixin
canvas-mixin canvas-mixin
fix-bitmap-size) fix-bitmap-size))
;; Implements canvas autoscroll, applied *before* platform-specific canvas ;; Implements canvas autoscroll, applied *before* platform-specific canvas
;; methods: ;; methods:

5
collects/mred/private/wx/common/clipboard.rkt
View File

@ -5,10 +5,11 @@
"local.rkt" "local.rkt"
"queue.rkt") "queue.rkt")
(provide clipboard<%> (provide
(protect-out clipboard<%>
clipboard-client% clipboard-client%
get-the-clipboard get-the-clipboard
get-the-x-selection) get-the-x-selection))
(defclass clipboard-client% object% (defclass clipboard-client% object%
(define types null) (define types null)

2
collects/mred/private/wx/common/default-procs.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require racket/class (require racket/class
racket/draw/color) racket/draw/private/color)
(provide special-control-key (provide special-control-key
special-option-key special-option-key
file-creator-and-type file-creator-and-type

5
collects/mred/private/wx/common/delay.rkt
View File

@ -2,8 +2,9 @@
(require "../../lock.rkt" (require "../../lock.rkt"
"queue.rkt") "queue.rkt")
(provide do-request-flush-delay (provide
do-cancel-flush-delay) (protect-out do-request-flush-delay
do-cancel-flush-delay))
(define (do-request-flush-delay win disable enable) (define (do-request-flush-delay win disable enable)
(atomically (atomically

2
collects/mred/private/wx/common/dialog.rkt
View File

@ -3,7 +3,7 @@
"../../lock.rkt" "../../lock.rkt"
"queue.rkt") "queue.rkt")
(provide dialog-mixin) (provide (protect-out dialog-mixin))
(define dialog-level-counter 0) (define dialog-level-counter 0)

4
collects/mred/private/wx/common/event.rkt
View File

@ -1,5 +1,5 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
"../../syntax.rkt") "../../syntax.rkt")
(provide event% (provide event%

7
collects/mred/private/wx/common/freeze.rkt
View File

@ -1,9 +1,10 @@
#lang scheme/base #lang racket/base
(require ffi/unsafe/try-atomic (require ffi/unsafe/try-atomic
"queue.rkt") "queue.rkt")
(provide call-as-nonatomic-retry-point (provide
constrained-reply) call-as-nonatomic-retry-point
(protect-out constrained-reply))
(define (internal-error str) (define (internal-error str)
(log-error (log-error

5
collects/mred/private/wx/common/handlers.rkt
View File

@ -1,11 +1,12 @@
#lang racket/base #lang racket/base
(provide application-file-handler (provide
(protect-out application-file-handler
application-quit-handler application-quit-handler
application-about-handler application-about-handler
application-pref-handler application-pref-handler
nothing-application-pref-handler) nothing-application-pref-handler))
(define saved-files null) (define saved-files null)
(define afh (lambda (f) (define afh (lambda (f)

6
collects/mred/private/wx/common/local.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require scheme/class) (require racket/class)
(provide (all-defined-out)) (provide (protect-out (all-defined-out)))
(define-local-member-name (define-local-member-name
;; clipboard-client%: ;; clipboard-client%:

2
collects/mred/private/wx/common/once.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base #lang racket/base
(require ffi/unsafe) (require ffi/unsafe)
(provide scheme_register_process_global) (provide (protect-out scheme_register_process_global))
;; This module must be instantiated only once: ;; This module must be instantiated only once:

2
collects/mred/private/wx/common/printer.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base #lang racket/base
(require racket/class) (require racket/class)
(provide make-run-printout) (provide (protect-out make-run-printout))
(define ((make-run-printout printer-dc%) (define ((make-run-printout printer-dc%)
parent parent

2
collects/mred/private/wx/common/procs.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require "../../syntax.rkt") (require "../../syntax.rkt")
(provide (provide

7
collects/mred/private/wx/common/queue.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require ffi/unsafe (require ffi/unsafe
racket/draw/utils racket/draw/private/utils
ffi/unsafe/atomic ffi/unsafe/atomic
racket/class racket/class
"rbtree.rkt" "rbtree.rkt"
@ -8,7 +8,8 @@
"handlers.rkt" "handlers.rkt"
"once.rkt") "once.rkt")
(provide queue-evt (provide
(protect-out queue-evt
set-check-queue! set-check-queue!
set-queue-wakeup! set-queue-wakeup!
@ -51,7 +52,7 @@
begin-busy-cursor begin-busy-cursor
end-busy-cursor end-busy-cursor
is-busy? is-busy?)
scheme_register_process_global) scheme_register_process_global)

6
collects/mred/private/wx/common/rbtree.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
;;; red-black-tree.rkt -- Jens Axel S<>gaard and Carl Eastlund -- 3rd nov 2003 ;;; red-black-tree.rkt -- Jens Axel S<>gaard and Carl Eastlund -- 3rd nov 2003
@ -60,8 +60,8 @@
;; SETS IMPLEMENTED AS REB-BLACK TREES. ;; SETS IMPLEMENTED AS REB-BLACK TREES.
(require scheme/match (require racket/match
(for-syntax scheme/base)) (for-syntax racket/base))
(define-match-expander $ (define-match-expander $
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()

4
collects/mred/private/wx/common/timer.rkt
View File

@ -1,5 +1,5 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
"queue.rkt") "queue.rkt")

2
collects/mred/private/wx/common/utils.rkt
View File

@ -3,6 +3,6 @@
ffi/unsafe/define ffi/unsafe/define
"once.rkt") "once.rkt")
(provide define-mz) (provide (protect-out define-mz))
(define-ffi-definer define-mz #f) (define-ffi-definer define-mz #f)

12
collects/mred/private/wx/gtk/button.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/foreign (require ffi/unsafe
scheme/class racket/class
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
"item.rkt" "item.rkt"
@ -11,10 +11,10 @@
"pixbuf.rkt" "pixbuf.rkt"
"message.rkt" "message.rkt"
"../common/event.rkt") "../common/event.rkt")
(unsafe!)
(provide button% (provide
button-core%) (protect-out button%
button-core%))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -3,8 +3,8 @@
racket/class racket/class
racket/draw racket/draw
ffi/unsafe/alloc ffi/unsafe/alloc
racket/draw/color racket/draw/private/color
racket/draw/local racket/draw/private/local
"../common/backing-dc.rkt" "../common/backing-dc.rkt"
"../common/canvas-mixin.rkt" "../common/canvas-mixin.rkt"
"../../syntax.rkt" "../../syntax.rkt"
@ -22,7 +22,8 @@
"pixbuf.rkt" "pixbuf.rkt"
"gcwin.rkt") "gcwin.rkt")
(provide canvas%) (provide
(protect-out canvas%))
;; ---------------------------------------- ;; ----------------------------------------

10
collects/mred/private/wx/gtk/check-box.rkt
View File

@ -1,14 +1,14 @@
#lang scheme/base #lang racket/base
(require scheme/foreign (require ffi/unsafe
scheme/class racket/class
"../../syntax.rkt" "../../syntax.rkt"
"button.rkt" "button.rkt"
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"../../lock.rkt") "../../lock.rkt")
(unsafe!)
(provide check-box%) (provide
(protect-out check-box%))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/foreign (require ffi/unsafe
scheme/class racket/class
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
"item.rkt" "item.rkt"
@ -10,9 +10,9 @@
"combo.rkt" "combo.rkt"
"../common/event.rkt" "../common/event.rkt"
"../common/queue.rkt") "../common/queue.rkt")
(unsafe!)
(provide choice%) (provide
(protect-out choice%))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -1,15 +1,15 @@
#lang scheme/base #lang racket/base
(require scheme/foreign (require ffi/unsafe
scheme/class racket/class
"../../syntax.rkt" "../../syntax.rkt"
"widget.rkt" "widget.rkt"
"window.rkt" "window.rkt"
"utils.rkt" "utils.rkt"
"const.rkt" "const.rkt"
"types.rkt") "types.rkt")
(unsafe!)
(provide client-size-mixin) (provide
(protect-out client-size-mixin))
;; ---------------------------------------- ;; ----------------------------------------

7
collects/mred/private/wx/gtk/clipboard.rkt
View File

@ -2,20 +2,21 @@
(require racket/class (require racket/class
ffi/unsafe ffi/unsafe
ffi/unsafe/alloc ffi/unsafe/alloc
racket/draw/unsafe/bstr
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
"../common/queue.rkt" "../common/queue.rkt"
"../common/local.rkt" "../common/local.rkt"
"../common/bstr.rkt"
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"pixbuf.rkt") "pixbuf.rkt")
(provide clipboard-driver% (provide
(protect-out clipboard-driver%
has-x-selection? has-x-selection?
_GtkSelectionData _GtkSelectionData
gtk_selection_data_get_length gtk_selection_data_get_length
gtk_selection_data_get_data) gtk_selection_data_get_data))
(define (has-x-selection?) #t) (define (has-x-selection?) #t)

5
collects/mred/private/wx/gtk/colordialog.rkt
View File

@ -1,12 +1,13 @@
#lang racket/base #lang racket/base
(require ffi/unsafe (require ffi/unsafe
racket/class racket/class
racket/draw/color racket/draw/private/color
"types.rkt" "types.rkt"
"utils.rkt" "utils.rkt"
"stddialog.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)) (define-gtk gtk_color_selection_dialog_new (_fun _string -> _GtkWidget))

12
collects/mred/private/wx/gtk/combo.rkt
View File

@ -1,16 +1,16 @@
#lang scheme/base #lang racket/base
(require scheme/foreign (require ffi/unsafe
scheme/class racket/class
"../../syntax.rkt" "../../syntax.rkt"
"types.rkt" "types.rkt"
"utils.rkt" "utils.rkt"
"window.rkt") "window.rkt")
(unsafe!)
;; Hacks for working with GtkComboBox[Entry] ;; Hacks for working with GtkComboBox[Entry]
(provide extract-combo-button (provide
connect-combo-key-and-mouse) (protect-out extract-combo-button
connect-combo-key-and-mouse))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(provide (except-out (all-defined-out) <<)) (provide (except-out (all-defined-out) <<))

5
collects/mred/private/wx/gtk/cursor.rkt
View File

@ -8,9 +8,10 @@
"../common/cursor-draw.rkt" "../common/cursor-draw.rkt"
"../../syntax.rkt") "../../syntax.rkt")
(provide cursor-driver% (provide
(protect-out cursor-driver%
get-arrow-cursor-handle get-arrow-cursor-handle
get-watch-cursor-handle) get-watch-cursor-handle))
(define GDK_ARROW 2) ; ugly! (define GDK_ARROW 2) ; ugly!
(define GDK_CROSSHAIR 34) (define GDK_CROSSHAIR 34)

13
collects/mred/private/wx/gtk/dc.rkt
View File

@ -9,15 +9,16 @@
"gl-context.rkt" "gl-context.rkt"
"../../lock.rkt" "../../lock.rkt"
"../common/backing-dc.rkt" "../common/backing-dc.rkt"
racket/draw/cairo racket/draw/unsafe/cairo
racket/draw/dc racket/draw/private/dc
racket/draw/bitmap racket/draw/private/bitmap
racket/draw/local racket/draw/private/local
ffi/unsafe/alloc) ffi/unsafe/alloc)
(provide dc% (provide
(protect-out dc%
do-backing-flush do-backing-flush
x11-bitmap%) x11-bitmap%))
(define-gdk gdk_cairo_create (_fun _pointer -> _cairo_t) (define-gdk gdk_cairo_create (_fun _pointer -> _cairo_t)
#:wrap (allocator cairo_destroy)) #:wrap (allocator cairo_destroy))

7
collects/mred/private/wx/gtk/dialog.rkt
View File

@ -1,5 +1,5 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
ffi/unsafe ffi/unsafe
"../../syntax.rkt" "../../syntax.rkt"
"../common/queue.rkt" "../common/queue.rkt"
@ -9,7 +9,8 @@
"utils.rkt" "utils.rkt"
"frame.rkt") "frame.rkt")
(provide dialog%) (provide
(protect-out dialog%))
(define GTK_WIN_POS_CENTER 1) (define GTK_WIN_POS_CENTER 1)
(define GTK_WIN_POS_CENTER_ON_PARENT 4) (define GTK_WIN_POS_CENTER_ON_PARENT 4)

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

@ -12,7 +12,8 @@
"../common/handlers.rkt" "../common/handlers.rkt"
"../common/queue.rkt") "../common/queue.rkt")
(provide file-selector) (provide
(protect-out file-selector))
(define _GtkFileChooserDialog _GtkWidget) (define _GtkFileChooserDialog _GtkWidget)
(define _GtkFileChooser (_cpointer 'GtkFileChooser)) (define _GtkFileChooser (_cpointer 'GtkFileChooser))

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

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require ffi/unsafe (require ffi/unsafe
racket/class racket/class
racket/promise racket/promise
@ -17,10 +17,11 @@
"pixbuf.rkt" "pixbuf.rkt"
"../common/queue.rkt") "../common/queue.rkt")
(provide frame% (provide
(protect-out frame%
display-origin display-origin
display-size display-size
location->window) location->window))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -1,15 +1,15 @@
#lang scheme/base #lang racket/base
(require scheme/foreign (require ffi/unsafe
scheme/class racket/class
"../../syntax.rkt" "../../syntax.rkt"
"item.rkt" "item.rkt"
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"window.rkt" "window.rkt"
"const.rkt") "const.rkt")
(unsafe!)
(provide gauge%) (provide
(protect-out gauge%))
;; ---------------------------------------- ;; ----------------------------------------

5
collects/mred/private/wx/gtk/gcwin.rkt
View File

@ -4,11 +4,12 @@
"types.rkt" "types.rkt"
"window.rkt") "window.rkt")
(provide scheme_add_gc_callback (provide
(protect-out scheme_add_gc_callback
scheme_remove_gc_callback scheme_remove_gc_callback
create-gc-window create-gc-window
make-gc-show-desc make-gc-show-desc
make-gc-hide-desc) make-gc-hide-desc))
(define-cstruct _GdkWindowAttr (define-cstruct _GdkWindowAttr
([title _string] ([title _string]

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

@ -3,17 +3,18 @@
ffi/unsafe ffi/unsafe
ffi/unsafe/define ffi/unsafe/define
ffi/unsafe/alloc ffi/unsafe/alloc
(prefix-in draw: racket/draw/gl-context) (prefix-in draw: racket/draw/private/gl-context)
racket/draw/gl-config racket/draw/private/gl-config
"types.rkt" "types.rkt"
"utils.rkt") "utils.rkt")
(provide prepare-widget-gl-context (provide
(protect-out prepare-widget-gl-context
create-widget-gl-context create-widget-gl-context
create-and-install-gl-context create-and-install-gl-context
get-gdk-pixmap get-gdk-pixmap
install-gl-context) install-gl-context))
(define gdkglext-lib (define gdkglext-lib
(with-handlers ([exn:fail? (lambda (exn) #f)]) (with-handlers ([exn:fail? (lambda (exn) #f)])

10
collects/mred/private/wx/gtk/group-panel.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
"window.rkt" "window.rkt"
@ -8,9 +8,9 @@
"panel.rkt" "panel.rkt"
"utils.rkt" "utils.rkt"
"types.rkt") "types.rkt")
(unsafe!)
(provide group-panel%) (provide
(protect-out group-panel%))
(define-gtk gtk_frame_new (_fun _string -> _GtkWidget)) (define-gtk gtk_frame_new (_fun _string -> _GtkWidget))
(define-gtk gtk_fixed_new (_fun -> _GtkWidget)) (define-gtk gtk_fixed_new (_fun -> _GtkWidget))

9
collects/mred/private/wx/gtk/init.rkt
View File

@ -1,17 +1,14 @@
#lang scheme/base #lang racket/base
(require scheme/foreign (require ffi/unsafe
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"queue.rkt") "queue.rkt")
(unsafe!)
(define-gtk gtk_rc_parse_string (_fun _string -> _void)) (define-gtk gtk_rc_parse_string (_fun _string -> _void))
(define-gtk gtk_rc_add_default_file (_fun _path -> _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)) (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_parse_string (format "module_path \"~a\"\n" dir))
(gtk_rc_add_default_file (build-path dir "gtkrc")))) (gtk_rc_add_default_file (build-path dir "gtkrc"))))

7
collects/mred/private/wx/gtk/item.rkt
View File

@ -1,14 +1,15 @@
#lang racket/base #lang racket/base
(require ffi/unsafe (require ffi/unsafe
racket/class racket/class
racket/draw/local racket/draw/private/local
"../../syntax.rkt" "../../syntax.rkt"
"window.rkt" "window.rkt"
"utils.rkt" "utils.rkt"
"types.rkt") "types.rkt")
(provide item% (provide
install-control-font) (protect-out item%
install-control-font))
(define _PangoFontDescription _pointer) (define _PangoFontDescription _pointer)
(define-gtk gtk_widget_modify_font (_fun _GtkWidget _PangoFontDescription -> _void)) (define-gtk gtk_widget_modify_font (_fun _GtkWidget _PangoFontDescription -> _void))

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

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(provide map-key-code) (provide map-key-code)

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

@ -4,7 +4,8 @@
"const.rkt" "const.rkt"
"types.rkt") "types.rkt")
(provide get-alts) (provide
(protect-out get-alts))
(define _GdkKeymap (_cpointer 'GdkKeymap)) (define _GdkKeymap (_cpointer 'GdkKeymap))

7
collects/mred/private/wx/gtk/list-box.rkt
View File

@ -1,7 +1,7 @@
#lang scheme/base #lang racket/base
(require ffi/unsafe (require ffi/unsafe
ffi/unsafe/define ffi/unsafe/define
scheme/class racket/class
(only-in racket/list take drop) (only-in racket/list take drop)
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
@ -12,7 +12,8 @@
"const.rkt" "const.rkt"
"../common/event.rkt") "../common/event.rkt")
(provide list-box%) (provide
(protect-out list-box%))
;; ---------------------------------------- ;; ----------------------------------------

12
collects/mred/private/wx/gtk/menu-bar.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
"../common/freeze.rkt" "../common/freeze.rkt"
@ -9,12 +9,12 @@
"window.rkt" "window.rkt"
"utils.rkt" "utils.rkt"
"types.rkt") "types.rkt")
(unsafe!)
(provide menu-bar% (provide
(protect-out menu-bar%
gtk_menu_item_new_with_mnemonic gtk_menu_item_new_with_mnemonic
gtk_menu_shell_append gtk_menu_shell_append
fixup-mneumonic) fixup-mneumonic))
(define-gtk gtk_menu_bar_new (_fun -> _GtkWidget)) (define-gtk gtk_menu_bar_new (_fun -> _GtkWidget))
(define-gtk gtk_menu_shell_append (_fun _GtkWidget _GtkWidget -> _void)) (define-gtk gtk_menu_shell_append (_fun _GtkWidget _GtkWidget -> _void))

7
collects/mred/private/wx/gtk/menu-item.rkt
View File

@ -1,8 +1,9 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
"../../syntax.rkt") "../../syntax.rkt")
(provide menu-item%) (provide
(protect-out menu-item%))
(defclass menu-item% object% (defclass menu-item% object%
(define/public (id) this) (define/public (id) this)

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

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
"widget.rkt" "widget.rkt"
"window.rkt" "window.rkt"
"../../syntax.rkt" "../../syntax.rkt"
@ -10,9 +10,9 @@
"utils.rkt" "utils.rkt"
"menu-bar.rkt" "menu-bar.rkt"
"../common/event.rkt") "../common/event.rkt")
(unsafe!)
(provide menu%) (provide
(protect-out menu%))
(define-gtk gtk_menu_new (_fun -> _GtkWidget)) (define-gtk gtk_menu_new (_fun -> _GtkWidget))
(define-gtk gtk_check_menu_item_new_with_mnemonic (_fun _string -> _GtkWidget)) (define-gtk gtk_check_menu_item_new_with_mnemonic (_fun _string -> _GtkWidget))

12
collects/mred/private/wx/gtk/message.rkt
View File

@ -1,18 +1,18 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
"../../syntax.rkt" "../../syntax.rkt"
"item.rkt" "item.rkt"
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
"pixbuf.rkt") "pixbuf.rkt")
(unsafe!)
(provide message% (provide
(protect-out message%
gtk_label_new_with_mnemonic gtk_label_new_with_mnemonic
gtk_label_set_text_with_mnemonic gtk_label_set_text_with_mnemonic
mnemonic-string) mnemonic-string))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -1,5 +1,5 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
ffi/unsafe ffi/unsafe
"../../syntax.rkt" "../../syntax.rkt"
"../../lock.rkt" "../../lock.rkt"
@ -8,8 +8,9 @@
"types.rkt" "types.rkt"
"const.rkt") "const.rkt")
(provide panel% (provide
panel-mixin) (protect-out panel%
panel-mixin))
(define-gtk gtk_fixed_new (_fun -> _GtkWidget)) (define-gtk gtk_fixed_new (_fun -> _GtkWidget))
(define-gtk gtk_event_box_new (_fun -> _GtkWidget)) (define-gtk gtk_event_box_new (_fun -> _GtkWidget))

13
collects/mred/private/wx/gtk/pixbuf.rkt
View File

@ -1,22 +1,23 @@
#lang racket #lang racket/base
(require racket/class (require racket/class
ffi/unsafe ffi/unsafe
ffi/unsafe/alloc ffi/unsafe/alloc
racket/draw racket/draw
racket/draw/local racket/draw/private/local
racket/draw/cairo racket/draw/unsafe/cairo
"../../lock.rkt" "../../lock.rkt"
"../common/bstr.rkt" racket/draw/unsafe/bstr
"utils.rkt" "utils.rkt"
"types.rkt" "types.rkt"
(only-in '#%foreign ffi-callback)) (only-in '#%foreign ffi-callback))
(provide bitmap->pixbuf (provide
(protect-out bitmap->pixbuf
pixbuf->bitmap pixbuf->bitmap
_GdkPixbuf _GdkPixbuf
gtk_image_new_from_pixbuf gtk_image_new_from_pixbuf
release-pixbuf) release-pixbuf))
(define _GdkPixbuf (_cpointer/null 'GdkPixbuf)) (define _GdkPixbuf (_cpointer/null 'GdkPixbuf))

8
collects/mred/private/wx/gtk/platform.rkt
View File

@ -1,4 +1,4 @@
#lang scheme/base #lang racket/base
(require "init.rkt" (require "init.rkt"
"button.rkt" "button.rkt"
"canvas.rkt" "canvas.rkt"
@ -23,7 +23,8 @@
"tab-panel.rkt" "tab-panel.rkt"
"window.rkt" "window.rkt"
"procs.rkt") "procs.rkt")
(provide platform-values) (provide
(protect-out platform-values))
(define (platform-values) (define (platform-values)
(values (values
@ -60,8 +61,6 @@
bell bell
display-size display-size
display-origin display-origin
get-resource
write-resource
flush-display flush-display
fill-private-color fill-private-color
cancel-quit cancel-quit
@ -71,7 +70,6 @@
get-double-click-time get-double-click-time
run-printout run-printout
file-creator-and-type file-creator-and-type
send-event
location->window location->window
shortcut-visible-in-label? shortcut-visible-in-label?
unregister-collecting-blit unregister-collecting-blit

19
collects/mred/private/wx/gtk/printer-dc.rkt
View File

@ -1,12 +1,12 @@
#lang racket/base #lang racket/base
(require racket/class (require racket/class
racket/draw/local racket/draw/private/local
racket/draw/dc racket/draw/private/dc
racket/draw/cairo racket/draw/unsafe/cairo
racket/draw/bitmap racket/draw/private/bitmap
racket/draw/bitmap-dc racket/draw/private/bitmap-dc
racket/draw/record-dc racket/draw/private/record-dc
racket/draw/ps-setup racket/draw/private/ps-setup
ffi/unsafe ffi/unsafe
ffi/unsafe/alloc ffi/unsafe/alloc
"../common/queue.rkt" "../common/queue.rkt"
@ -14,8 +14,9 @@
"utils.rkt" "utils.rkt"
"types.rkt") "types.rkt")
(provide printer-dc% (provide
show-print-setup) (protect-out printer-dc%
show-print-setup))
(define GTK_UNIT_POINTS 1) (define GTK_UNIT_POINTS 1)

33
collects/mred/private/wx/gtk/procs.rkt
View File

@ -20,52 +20,47 @@
"../common/handlers.rkt") "../common/handlers.rkt")
(provide (provide
special-control-key (protect-out
special-option-key
get-color-from-user
color-from-user-platform-mode color-from-user-platform-mode
get-font-from-user get-font-from-user
font-from-user-platform-mode font-from-user-platform-mode
get-panel-background
play-sound play-sound
find-graphical-system-path find-graphical-system-path
register-collecting-blit register-collecting-blit
unregister-collecting-blit unregister-collecting-blit
shortcut-visible-in-label? shortcut-visible-in-label?
location->window
send-event
file-creator-and-type
run-printout run-printout
get-double-click-time get-double-click-time
get-control-font-face get-control-font-face
get-control-font-size get-control-font-size
get-control-font-size-in-pixels? get-control-font-size-in-pixels?
cancel-quit cancel-quit
fill-private-color
flush-display
write-resource
get-resource
display-origin
display-size
bell bell
hide-cursor hide-cursor
get-display-depth get-display-depth
is-color-display? is-color-display?
file-selector
id-to-menu-item id-to-menu-item
show-print-setup
can-show-print-setup? can-show-print-setup?
get-highlight-background-color get-highlight-background-color
get-highlight-text-color get-highlight-text-color
check-for-break)
file-selector
show-print-setup
display-origin
display-size
flush-display
location->window
make-screen-bitmap make-screen-bitmap
make-gl-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 find-graphical-system-path)
(define-unimplemented send-event)
(define-unimplemented cancel-quit) (define-unimplemented cancel-quit)
(define-unimplemented write-resource)
(define-unimplemented get-resource)
(define-unimplemented play-sound) (define-unimplemented play-sound)

7
collects/mred/private/wx/gtk/queue.rkt
View File

@ -10,12 +10,9 @@
"w32.rkt" "w32.rkt"
"unique.rkt") "unique.rkt")
(provide gtk-start-event-pump (provide (protect-out gtk-start-event-pump
try-to-sync-refresh try-to-sync-refresh
set-widget-hook!)
set-widget-hook!
;; from common/queue: ;; from common/queue:
current-eventspace current-eventspace
queue-event queue-event

10
collects/mred/private/wx/gtk/radio-box.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/class (require racket/class
scheme/foreign ffi/unsafe
"../../syntax.rkt" "../../syntax.rkt"
"item.rkt" "item.rkt"
(except-in "utils.rkt" _GSList) (except-in "utils.rkt" _GSList)
@ -11,9 +11,9 @@
"message.rkt" "message.rkt"
"../common/event.rkt" "../common/event.rkt"
"../../lock.rkt") "../../lock.rkt")
(unsafe!)
(provide radio-box%) (provide
(protect-out radio-box%))
;; ---------------------------------------- ;; ----------------------------------------

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

@ -1,6 +1,6 @@
#lang scheme/base #lang racket/base
(require scheme/foreign (require ffi/unsafe
scheme/class racket/class
"../../syntax.rkt" "../../syntax.rkt"
"item.rkt" "item.rkt"
"utils.rkt" "utils.rkt"
@ -9,9 +9,9 @@
"const.rkt" "const.rkt"
"../common/event.rkt" "../common/event.rkt"
"../../lock.rkt") "../../lock.rkt")
(unsafe!)
(provide slider%) (provide
(protect-out slider%))
;; ---------------------------------------- ;; ----------------------------------------

Some files were not shown because too many files have changed in this diff Show More