clean up
This commit is contained in:
Matthew Flatt
parent
4f55d22705
commit
d7f1d12ea1
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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%
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(provide (except-out (all-defined-out) <<))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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%)
|
||||
|
|
|
|||
|
|
@ -9,7 +9,8 @@
|
|||
"queue.rkt"
|
||||
"frame.rkt")
|
||||
|
||||
(provide file-selector)
|
||||
(provide
|
||||
(protect-out file-selector))
|
||||
|
||||
(import-class NSOpenPanel NSSavePanel NSURL NSArray)
|
||||
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,8 @@
|
|||
"utils.rkt"
|
||||
"types.rkt")
|
||||
|
||||
(provide font->NSFont)
|
||||
(provide
|
||||
(protect-out font->NSFont))
|
||||
|
||||
(import-class NSFont NSFontManager)
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
(require "pool.rkt"
|
||||
"queue.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
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(provide map-key-code)
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -10,7 +10,8 @@
|
|||
"window.rkt"
|
||||
"menu-item.rkt")
|
||||
|
||||
(provide menu%)
|
||||
(provide
|
||||
(protect-out menu%))
|
||||
|
||||
(import-class NSMenu NSMenuItem)
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@
|
|||
"utils.rkt"
|
||||
"types.rkt")
|
||||
|
||||
(provide play-sound)
|
||||
(provide
|
||||
(protect-out play-sound))
|
||||
|
||||
(import-class NSSound)
|
||||
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -1,3 +0,0 @@
|
|||
#lang racket/base
|
||||
(require racket/draw/bstr)
|
||||
(provide scheme_make_sized_byte_string)
|
||||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
"../../lock.rkt"
|
||||
"queue.rkt")
|
||||
|
||||
(provide dialog-mixin)
|
||||
(provide (protect-out dialog-mixin))
|
||||
|
||||
(define dialog-level-counter 0)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
"../../syntax.rkt")
|
||||
|
||||
(provide event%
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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%:
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
(require "../../syntax.rkt")
|
||||
|
||||
(provide
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scheme/base
|
||||
(require scheme/class
|
||||
#lang racket/base
|
||||
(require racket/class
|
||||
"../../syntax.rkt"
|
||||
"../../lock.rkt"
|
||||
"queue.rkt")
|
||||
|
|
|
|||
|
|
@ -3,6 +3,6 @@
|
|||
ffi/unsafe/define
|
||||
"once.rkt")
|
||||
|
||||
(provide define-mz)
|
||||
(provide (protect-out define-mz))
|
||||
|
||||
(define-ffi-definer define-mz #f)
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(provide (except-out (all-defined-out) <<))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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)])
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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"))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#lang scheme/base
|
||||
#lang racket/base
|
||||
|
||||
(provide map-key-code)
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@
|
|||
"const.rkt"
|
||||
"types.rkt")
|
||||
|
||||
(provide get-alts)
|
||||
(provide
|
||||
(protect-out get-alts))
|
||||
|
||||
(define _GdkKeymap (_cpointer 'GdkKeymap))
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -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%))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user