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

370.6

Browse Source 
svn: r6849
This commit is contained in:
Matthew Flatt 2007-07-08 00:24:03 +00:00
parent 23d4949d94
commit a1e2d59690
29 changed files with 3830 additions and 3002 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/mred/private/kernel.ss
View File

@ -467,7 +467,9 @@
set-direction
get-position
set-position)
(define-class key-event% event% ([key-code #\nul] [shift-down #f] [control-down #f] [meta-down #f] [alt-down #f] [x 0] [y 0] [time-stamp 0])
(define-class key-event% event% ([key-code #\nul] [shift-down #f] [control-down #f] [meta-down #f] [alt-down #f] [x 0] [y 0] [time-stamp 0] [caps-down #f])
set-other-caps-key-code
get-other-caps-key-code
set-other-shift-altgr-key-code
get-other-shift-altgr-key-code
set-other-altgr-key-code
@ -486,12 +488,14 @@
set-meta-down
get-alt-down
set-alt-down
get-caps-down
set-caps-down
get-x
set-x
get-y
set-y)
(define-function key-symbol-to-integer)
(define-class mouse-event% event% (event-type [left-down #f] [middle-down #f] [right-down #f] [x 0] [y 0] [shift-down #f] [control-down #f] [meta-down #f] [alt-down #f] [time-stamp 0])
(define-class mouse-event% event% (event-type [left-down #f] [middle-down #f] [right-down #f] [x 0] [y 0] [shift-down #f] [control-down #f] [meta-down #f] [alt-down #f] [time-stamp 0] [caps-down #f])
moving?
leaving?
entering?
@ -515,6 +519,8 @@
set-meta-down
get-alt-down
set-alt-down
get-caps-down
set-caps-down
get-x
set-x
get-y

60
collects/scribblings/reference/code-inspectors.scrbl Normal file
View File

@ -0,0 +1,60 @@
#reader(lib "docreader.ss" "scribble")
@require["mz.ss"]
@title[#:tag "mz:modprotect"]{Code Inspectors}
In the same way that inspectors control access to structure fields
(see @secref["mz:inspectors"]), inspectors also control access to
module bindings (see @secref["mz:modules"]). The default inspector for
module bindings is determined by the @scheme[current-code-inspector]
parameter, instead of the @scheme[current-inspector] parameter.
When a @scheme[module] declaration is evaluated, the value of the
@scheme[current-code-inspector] parameter is associated with the
module declaration. When the module is invoked via @scheme[require] or
@scheme[dynamic-require], a sub-inspector of the module's
declaration-time inspector is created, and this sub-inspector is
associated with the module invocation. Any inspector that controls the
sub-inspector (i.e., the declaration-time inspector and its superior)
controls the module invocation.
Control over a module invocation enables
@itemize{
@item{the use of @scheme[module->namespace] on the module;}
@item{access to the module's protected identifiers, i.e. those
identifiers exported from the module with @scheme[protect]; and}
@item{access to the module's protected and unexported variables
within compiled code from @scheme[read] (see @secref["mz:compilation"]).}
}
If the value of @scheme[current-code-inspector] never changes, then no
control is lost for any module invocation, since the module's
invocation is associated with a sub-inspector of
@scheme[current-code-inspector].
The inspector for a module invocation is specific to a particular
module registry, in case a module is attached to a new registry via
@scheme[namespace-attach-module]. The invocation inspector in a
particular registry can be changed via
@scheme[namespace-unprotect-module] (but changing the inspector
requires control over the old one).
Control over a module declaration (as opposed to a mere invocation)
enables the reconstruction of syntax objects that contain references
to the module's unexported identifiers. Otherwise, the compiler and
macro expander prevent any reference to an unexported identifier,
unless the reference appears within an expression that was generated
by the module's macros (or, more precisely, a macro from a module
whose declaration inspector controls the invocation of the
identifier's module). See @secref["mz:stxprotect"] for further
information.
@defparam[current-code-inspector insp inspector?]{
A parameter that determines an inspector to control access to module
bindings and redefinitions.}

10
collects/scribblings/reference/custodians.scrbl
View File

@ -27,7 +27,15 @@ thread.}
@defproc[(custodian? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a @tech{custodian} value,
@scheme[#f] otherwise. }
@scheme[#f] otherwise.}
@defparam[current-custodian cust custodian?]{
A parameter that determines a custodian that assumes responsibility
for newly created threads, ports, TCP listeners, UDP sockets, and
byte converters.}
@defproc[(custodian-managed-list [cust custodian?][super custodian?]) list?]{

226
collects/scribblings/reference/namespaces.scrbl Normal file
View File

@ -0,0 +1,226 @@
#reader(lib "docreader.ss" "scribble")
@require["mz.ss"]
@title{Namespaces}
See @secref["mz:namespace-model"] for basic information on the
namespace model.
A new namespace is created with the @scheme[make-namespace] procedure,
which returns a first-class namespace value. A namespace is used by
setting the @scheme[current-namespace] parameter value, or by
providing the namespace to procedures such as @scheme[eval] and
@scheme[eval-syntax].
[FIXME: define the initial namespace.]
@defproc[(make-namespace [flag (one-of/c 'initial 'empty) 'initial]) namespace?]{
Creates a new namespace with a new module registry. The @scheme[flag]
is an option that determines the initial bindings in the namespace:
@itemize{
@item{@scheme['initial] --- the new namespace contains the module
declarations of the initial namespace, and the new namespace's
@tech{phase-level} 1 top-level environment contains bindings and
imports as in the initial namespace. However, the namespace's
@tech{phase-level} 1 top-level environment is empty.}
@item{@scheme['empty] --- creates a namespace with no initial
bindings or module declarations.}
}}
@defproc[(namespace? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a namespace value, @scheme[#f]
otherwise.}
@defproc[(namespace-symbol->identifier [sym symbol?]) identifier?]{
Similar to @scheme[datum->syntax-object] restricted to symbols. The
lexical context of the resulting identifier corresponds to the
top-level environment of the current namespace; the identifier has no
source location or properties.}
@defproc[(namespace-variable-value [sym symbol?]
[use-mapping? any/c #t]
[failure-thunk (or/c (-> any) false/c) #f]
[namespace namespace? (current-namespace)])
any]{
Returns a value for @scheme[sym] in @scheme[namespace]. The returned value
depends on @scheme[use-mapping?]:
@itemize{
@item{If @scheme[use-mapping?] is true (the default), and if
@scheme[sym] maps to a top-level variable or an imported variable
(see @secref["mz:namespace-model"]), then the result is the same as
evaluating @scheme[sym] as an expression. If @scheme[sym] maps to
syntax or imported syntax, then @scheme[failure-thunk] is called or
the @exnraise[exn:fail:syntax]. If @scheme[sym] is mapped to an
undefined variable or an uninitialized module variable, then
@scheme[failure-thunk] is called of the
@exnraise[exn:fail:contract:variable].}
@item{If @scheme[use-mapping?] is @scheme[#f], the namespace's
syntax and import mappings are ignored. Instead, the value of the
top-level variable named @scheme[sym] in namespace is returned. If
the variable is undefined, then @scheme[failure-thunk] is called or
the @exnraise[exn:fail:contract:variable].}
}
If @scheme[failure-thunk] is not @scheme[#f],
@scheme[namespace-variable-value] calls @scheme[failure-thunk] to
produce the return value in place of raising an
@scheme[exn:fail:contract:variable] or @scheme[exn:fail:syntax]
exception.
@defproc[(namespace-set-variable-value! [sym symbol?]
[v any/c]
[map? any/c #f]
[namespace namespace? (current-namespace)])
void?]{
Sets the value of @scheme[sym] in the top-level environment of
@scheme[namespace] for @tech{phase level} 0, defining @scheme[sym] if
it is not already defined.
If @scheme[map?] is supplied as true, then the namespace's identifier
mapping is also adjusted (see @secref["mz:namespace-model"]) so that
@scheme[sym] maps to the variable.}
@defproc[(namespace-undefine-variable! [sym symbol?]
[namespace namespace? (current-namespace)])
void?]{
Removes the @scheme[sym] variable, if any, in the top-level
environment of @scheme[namespace] at @tech{phase level 0}. The
namespace's identifier mapping (see @secref["mz:namespace-model"]) is
unaffected.}
@defproc[(namespace-mapped-symbols [namespace namespace? (current-namespace)])
(listof symbol?)]{
Returns a list of all symbols that are mapped to variables, syntax,
and imports in @scheme[namespace] for @tech{phase level} 0.
@defproc[(namespace-require [quoted-require-spec any/c])
void?]{
Performs the import corresponding to @scheme[quoted-require-spec] in
the top-level environment of the current namespace, like a top-level
@scheme[require]. Module paths in
@scheme[quoted-require-spec] are resolved with respect to
@scheme[current-load-relative-directory] or @scheme[current-directory]
(if the former is @scheme[#f]), even if the current namespace
corresponds to a module body.}
@defproc[(namespace-transformer-require [quoted-require-spec any/c])
void?]{
Performs the import corresponding to @scheme[quoted-require-spec] in
the top-level transformer environment, like a top-level
@scheme[require-for-syntax]. Module paths in
@scheme[quoted-require-spec] are resolved with respect to
@scheme[current-load-relative-directory] or @scheme[current-directory]
(if the former is @scheme[#f]), even if the current namespace
corresponds to a module body.}
@defproc[(namespace-require/copy [quoted-require-spec any/c])
void?]{
Like @scheme[namespace-require] for syntax exported from the module,
but exported variables are treated differently: the export's current
value is copied to a top-level variable in the current namespace.}
@defproc[(namespace-require/expansion-time [quoted-require-spec any/c])
void?]{
Is like @scheme[namespace-require], but only the transformer part of
the module is executed; that is, the module is merely @tech{visit}ed,
and not @tech{instantiate}d (see @secref["mz:mod-parse"]). If the
required module has not been instantiated before, the module's
variables remain undefined.}
@defproc[(namespace-attach-module [src-namespace namespace?]
[module-path-v any/c]
[dest-namespace any/c #f])
any]{
Attaches the instantiated module named by @scheme[module-path-v] in
@scheme[src-namespace] to the registry of @scheme[dest-namespace]
(which is the current namespace if @scheme[dest-namespace] is not
supplied). If @scheme[module-path-v] is not a symbol, the current
module name resolver is called to resolve the path, but no module is
loaded; the resolved form of @scheme[module-path-v] is used as the
module name in @scheme[dest-namespace]. In addition to
@scheme[module-path-v], every module that it imports (directly or
indirectly) is also recorded in the current namespace's registry. If
@scheme[module-path-v] does not refer to an instantiated module in
@scheme[src-namespace], or if the name of any module to be attached
already has a different declaration or instance in
@scheme[dest-namespace], then the @exnraise[exn:fail:contract]. The
inspector of the module invocation in @scheme[dest-namespace] is the
same as inspector of the invocation in @scheme[src-namespace].}
@defproc[(namespace-unprotect-module [inspector any/c][module-path-v any/c]) any]{namespace}
changes the inspector for the instance of the module referenced by
@scheme[module-path-v] in @scheme[namespace]'s registry so that it is
controlled by the current code inspector. If @scheme[namespace] is not
supplied, it is the current namespace. The given @scheme[inspector] must
currently control the invocation of the module in @scheme[namespace]'s
registry, otherwise the @exnraise[exn:fail:contract]. See also
@secref["mz:modprotect"].
@defproc[(namespace-module-registry [namespace any/c]) any] returns the registry of the
given namespace. This value is useful only for identification via
@scheme[eq?].
@defproc[(module->namespace [module-path-v any/c]) any] returns a namespace that
corresponds to the body of an instantiated module in the current
namespace's registry. The returned namespace has the same module
registry as the current namespace. Modifying a binding in the
namespace changes the binding seen in modules that require the
namespace's module. Module paths in a top-level @scheme[require]
expression are resolved with respect to the namespace's module. New
@scheme[provide] declarations are not allowed. If the current code
inspector does not control the invocation of the module in the
current namespace's registry, the @exnraise[exn:fail:contract]; see
also @secref["mz:modprotect"]. Bindings in the namespace cannot be
modified if the @scheme[compile-enforce-module-constants] parameter
was true when the module was declared, unless the module declaration
itself included assignments to the binding via @scheme[set!].
@defproc[(namespace-syntax-introduce [stx any/c]) any] returns a syntax object like
@scheme[stx], except that the current namespace's bindings are included
in the syntax object's context (see @secref["mz:stxscope"]). The
additional context is overridden by any existing top-level context in
the syntax object, or by any existing or future module context. See
@secref["mz:stxobj"] for more information about syntax objects.
@defproc[(module-provide-protected? [module-path-index any/c][sym symbol?]) any] returns
@scheme[#f] if the module declaration for @scheme[module-path-index]
defines @scheme[sym] and exports it unprotected, @scheme[#t]
otherwise (which may mean that the symbol corresponds to an
unexported definition, a protected export, or an identifier that is
not defined at all within the module). The @scheme[module-path-index]
argument can be a symbol; see @secref["mz:modpathidx"] for more information
on module path indices. Typically, the arguments to
@scheme[module-provide-protected?] correspond to the first two
elements of a list produced by @scheme[identifier-binding] (see
@secref["mz:stxscope"]).

2
collects/scribblings/reference/port-procs.scrbl
View File

@ -43,7 +43,7 @@ logging. For example, the default error display handler writes to this
port.}
@defproc[(file-stream-port? [port port?]) boolean?]{
Returns @scheme[#t] if the given port is a file-stream port (see
Returns @scheme[#t] if the given port is a @tech{file-stream port} (see
@secref["mz:file-ports"]), @scheme[#f] otherwise.}
@defproc[(terminal-port? [port port?]) boolean?]{

9
collects/scribblings/reference/rx.ss
View File

@ -191,8 +191,11 @@ Category ::= Ll | Lu | Lt | Lm Unicode general category
=> (lambda (m)
(substring s 0 (caar m)))]
[(regexp-match-positions #rx" *#[a-z]+$" s)
#f]))
(regexp-split "\n" (substring grammar 1 (sub1 (string-length grammar)))))))
#f]
[(equal? s "") #f]
[else
(error 'lines "no match!?: ~s" s)]))
(regexp-split "\r*\n" grammar))))
(define table-lines
(map
@ -375,7 +378,7 @@ Class : <1,1>
[else (list* (car l) i (insert i (cdr l)))]))
(define type-table
(let* ([lines (regexp-split "\n" types)]
(let* ([lines (regexp-split "\r*\n" types)]
[lines (let loop ([lines lines])
(if (null? lines)
null

155
collects/scribblings/reference/security-guards.scrbl Normal file
View File

@ -0,0 +1,155 @@
#reader(lib "docreader.ss" "scribble")
@require[(lib "bnf.ss" "scribble")]
@require["mz.ss"]
@title[#:tag "mz:securityguards"]{Security Guards}
A @deftech{security guard} provides a set of access-checking
procedures to be called when a thread initiates access of a file,
directory, or network connection through a primitive procedure. For
example, when a thread calls @scheme[open-input-file], the thread's
current security guard is consulted to check whether the thread is
allowed read access to the file. If access is granted, the thread
receives a port that it may use indefinitely, regardless of changes to
the security guard (although the port's custodian could shut down the
port; see @secref["mz:custodians"]).
A thread's current security guard is determined by the
@scheme[current-security-guard] parameter. Every security guard has a
parent, and a parent's access procedures are called whenever a child's
access procedures are called. Thus, a thread cannot increase its own
access arbitrarily by installing a new guard. The initial security
guard enforces no access restrictions other than those enforced by the
host platform.
@defproc[(make-security-guard [parent security-guard?]
[file-guard (symbol?
(or/c path? false/c)
(listof symbol?)
. -> . any)]
[network-guard (symbol?
(or/c (and/c string? immutable?) false/c)
(or/c (integer-in 1 65535) false/c)
(one-of/c 'server 'client)
. -> . any)]
[link (or/c (symbol? path? path? . -> . any)
false/c)
#f])
security-guard?]{
Creates a new security guard as child of @scheme[parent].
The @scheme[file-guard] procedure must accept three arguments:
@itemize{
@item{a symbol for the primitive procedure that triggered the access
check, which is useful for raising an exception to deny access.}
@item{a path (see @secref["mz:pathutils"]) or @scheme[#f] for
pathless queries, such as @scheme[(current-directory)],
@scheme[(filesystem-root-list)], and @scheme[(find-system-path
symbol)]. A path provided to @scheme[file-guard] is not expanded or
otherwise normalized before checking access; it may be a relative
path, for example.}
@item{a list containing one or more of the following
symbols:
@itemize{
@item{@scheme['read] --- read a file or directory}
@item{@scheme['write] --- modify or create a file or
directory}
@item{@scheme['execute] --- execute a file}
@item{@scheme['delete] --- delete a file or directory}
@item{@scheme['exists] --- determine whether a file or
directory exists, or that a path string is well-formed}
}
The @scheme['exists] symbol is never combined with other symbols in
the last argument to @scheme[file-guard], but any other combination is
possible. When the second argument to @scheme[file-guard] is @scheme[#f],
the last argument always contains only @scheme['exists].}
}
The @scheme[network-guard] procedure must accept four arguments:
@itemize{
@item{a symbol for the primitive operation that triggered the access
check, which is useful for raising an exception to deny access.}
@item{an immutable string representing the target hostname for a
client connection or the accepting hostname for a listening server;
@scheme[#f] for a listening server or UDP socket that accepts
connections at all of the host's address; or @scheme[#f] an unbound
UDP socket.}
@item{an exact integer between @scheme[1] and @scheme[65535]
(inclusive) representing the port number, or @scheme[#f] for an
unbound UDP socket. In the case of a client connection, the port
number is the target port on the server. For a listening server, the
port number is the local port number.}
@item{a symbol, either @scheme['client] or @scheme['server],
indicating whether the check is for the creation of a client
connection or a listening server. The opening of an unbound UDP
socket is identified as a @scheme['client] connection; explicitly
binding the socket is identified as a @scheme['server] action.}
}
The @scheme[link-guard] argument can be @scheme[#f] or a procedure of
three arguments:
@itemize{
@item{a symbol for the primitive procedure that triggered the access
check, which is useful for raising an exception to deny access.}
@item{a complete path (see @secref["mz:pathutils"]) representing the
file to create as link.}
@item{a path representing the content of the link, which may be
relative the second-argument path; this path is not expanded or
otherwise normalized before checking access.}
}
If @scheme[link-guard] is @scheme[#f], then a default
procedure is used that always raises @scheme[exn:fail].
The return value of @scheme[file-guard], @scheme[network-guard], or
@scheme[link-guard] is ignored. To deny access, the procedure must
raise an exception or otherwise escape from the context of the
primitive call. If the procedure returns, the parent's corresponding
procedure is called on the same inputs, and so on up the chain of
security guards.
The @scheme[file-guard], @scheme[network-guard], and
@scheme[link-guard] procedures are invoked in the thread that called
the access-checked primitive. Breaks may or may not be enabled (see
@secref["mz:breakhandler"]). Full continuation jumps are blocked going
into or out of the @scheme[file-guard] or @scheme[network-guard] call
(see @secref["mz:prompt-model"]).}
@defproc[(security-guard? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a security guard value as created
by @scheme[make-security-guard], @scheme[#f] otherwise.}
@defparam[current-security-guard guard security-guard?]{
A parameter that determines the current security guard that controls
access to the filesystem and network.}

8
collects/scribblings/reference/security.scrbl
View File

@ -1,8 +1,7 @@
#reader(lib "docreader.ss" "scribble")
@require[(lib "bnf.ss" "scribble")]
@require["mz.ss"]
@title[#:style 'toc]{Security}
@title[#:style 'toc]{Security and Reflection}
MzScheme offers several mechanisms for managing security, each of
which relies on @tech{thread}- and @tech{continuation}-specific
@ -11,4 +10,9 @@ which relies on @tech{thread}- and @tech{continuation}-specific
@local-table-of-contents[]
@;------------------------------------------------------------------------
@include-section["security-guards.scrbl"]
@include-section["custodians.scrbl"]
@include-section["thread-groups.scrbl"]
@include-section["struct-inspectors.scrbl"]
@include-section["code-inspectors.scrbl"]
@; @include-section["namespaces.scrbl"]

127
collects/scribblings/reference/struct-inspectors.scrbl Normal file
View File

@ -0,0 +1,127 @@
#reader(lib "docreader.ss" "scribble")
@require["mz.ss"]
@title[#:tag "mz:inspectors"]{Structure Inspectors}
An @pidefterm{inspector} provides access to structure fields and
structure type information without the normal field accessors and
mutators. (Inspectors are also used to control access to module
bindings; see @secref["mz:modprotect"].) Inspectors are primarily
intended for use by debuggers.
When a structure type is created, an inspector can be supplied. The
given inspector is not the one that will control the new structure
type; instead, the given inspector's parent will control the type. By
using the parent of the given inspector, the structure type remains
opaque to ``peer'' code that cannot access the parent inspector.
The @scheme[current-inspector] @tech{parameter} determines a default
inspector argument for new structure types. An alternate inspector can
be provided though the @scheme[#:inspector] option of the
@scheme[define-struct] form (see @secref["mz:define-struct"]), or
through an optional @scheme[inspector] argument to
@scheme[make-struct-type].
@defproc[(make-inspector [inspector inspector? (current-inspector)])
inspector?]{
Returns a new inspector that is a subinspector of
@scheme[inspector]. Any structure type controlled by the new inspector
is also controlled by its ancestor inspectors, but no other
inspectors.}
@defproc[(inspector? [v any/c]) boolean?]{Returns @scheme[#t] if
@scheme[v] is an inspector, @scheme[#f] otherwise.}
@defparam[current-inspector insp inspector?]{
A parameter that determines the default inspector for newly created
structure types.}
@defproc[(struct-info [v any/c])
(values (or/c struct-type? false/c)
boolean?)]{
Returns two values:
@itemize{
@item{@scheme[struct-type]: a structure type descriptor or @scheme[#f];
the result is a structure type descriptor of the most specific type
for which @scheme[v] is an instance, and for which the current
inspector has control, or the result is @scheme[#f] if the current
inspector does not control any structure type for which the
@scheme[struct] is an instance.}
@item{@scheme[skipped?]: @scheme[#f] if the first result corresponds to
the most specific structure type of @scheme[v], @scheme[#t] otherwise.}
}}
@defproc[(struct-type-info [struct-type struct-type?])
(values symbol?
nonnegative-exact-integer?
nonnegative-exact-integer?
struct-accessor-procedure?
struct-mutator-procedure?
(listof nonnegative-exact-integer?)
(or/c struct-type? false/c)
boolean?)]{
Returns eight values that provide information about the structure type
descriptor @scheme[struct-type], assuming that the type is controlled
by the current inspector:
@itemize{
@item{@scheme[name]: the structure type's name as a symbol;}
@item{@scheme[init-field-cnt]: the number of fields defined by the
structure type provided to the constructor procedure (not counting
fields created by its ancestor types);}
@item{@scheme[auto-field-cnt]: the number of fields defined by the
structure type without a counterpart in the constructor procedure
(not counting fields created by its ancestor types);}
@item{@scheme[accessor-proc]: an accessor procedure for the structure
type, like the one returned by @scheme[make-struct-type];}
@item{@scheme[mutator-proc]: a mutator procedure for the structure
type, like the one returned by @scheme[make-struct-type];}
@item{@scheme[immutable-k-list]: an immutable list of exact
non-negative integers that correspond to immutable fields for the
structure type;}
@item{@scheme[super-type]: a structure type descriptor for the
most specific ancestor of the type that is controlled by the
current inspector, or @scheme[#f] if no ancestor is controlled by
the current inspector;}
@item{@scheme[skipped?]: @scheme[#f] if the seventh result is the
most specific ancestor type or if the type has no supertype,
@scheme[#t] otherwise.}
}
If the type for @scheme[struct-type] is not controlled by the current inspector,
the @exnraise[exn:fail:contract].}
@defproc[(struct-type-make-constructor [struct-type struct-type?])
struct-constructor-procedure?]{
Returns a @tech{constructor} procedure to create instances of the type
for @scheme[struct-type]. If the type for @scheme[struct-type] is not
controlled by the current inspector, the
@exnraise[exn:fail:contract].}
@defproc[(struct-type-make-predicate [struct-type any/c]) any]{
Returns a @tech{predicate} procedure to recognize instances of the
type for @scheme[struct-type]. If the type for @scheme[struct-type]
is not controlled by the current inspector, the
@exnraise[exn:fail:contract].}

118
collects/scribblings/reference/struct.scrbl
View File

@ -300,124 +300,6 @@ descriptor} value, @scheme[#f] otherwise.
}
@;------------------------------------------------------------------------
@section[#:tag "mz:inspectors"]{Structure Inspectors}
An @pidefterm{inspector} provides access to structure fields and
structure type information without the normal field accessors and
mutators. (Inspectors are also used to control access to module
bindings; see @secref["mz:modprotect"].) Inspectors are primarily
intended for use by debuggers.
When a structure type is created, an inspector can be supplied. The
given inspector is not the one that will control the new structure
type; instead, the given inspector's parent will control the type. By
using the parent of the given inspector, the structure type remains
opaque to ``peer'' code that cannot access the parent inspector.
The @scheme[current-inspector] @tech{parameter} determines a default
inspector argument for new structure types. An alternate inspector can
be provided though the @scheme[#:inspector] option of the
@scheme[define-struct] form (see @secref["mz:define-struct"]), or
through an optional @scheme[inspector] argument to
@scheme[make-struct-type] (see @secref["mz:creatingmorestructs"]).
@defproc[(make-inspector [inspector inspector? (current-inspector)])
inspector?]{
Returns a new inspector that is a subinspector of
@scheme[inspector]. Any structure type controlled by the new inspector
is also controlled by its ancestor inspectors, but no other
inspectors.}
@defproc[(inspector? [v any/c]) boolean?]{Returns @scheme[#t] if
@scheme[v] is an inspector, @scheme[#f] otherwise.}
@defproc[(struct-info [v any/c])
(values (or/c struct-type? false/c)
boolean?)]{
Returns two values:
@itemize{
@item{@scheme[struct-type]: a structure type descriptor or @scheme[#f];
the result is a structure type descriptor of the most specific type
for which @scheme[v] is an instance, and for which the current
inspector has control, or the result is @scheme[#f] if the current
inspector does not control any structure type for which the
@scheme[struct] is an instance.}
@item{@scheme[skipped?]: @scheme[#f] if the first result corresponds to
the most specific structure type of @scheme[v], @scheme[#t] otherwise.}
}}
@defproc[(struct-type-info [struct-type struct-type?])
(values symbol?
nonnegative-exact-integer?
nonnegative-exact-integer?
struct-accessor-procedure?
struct-mutator-procedure?
(listof nonnegative-exact-integer?)
(or/c struct-type? false/c)
boolean?)]{
Returns eight values that provide information about the structure type
descriptor @scheme[struct-type], assuming that the type is controlled
by the current inspector:
@itemize{
@item{@scheme[name]: the structure type's name as a symbol;}
@item{@scheme[init-field-cnt]: the number of fields defined by the
structure type provided to the constructor procedure (not counting
fields created by its ancestor types);}
@item{@scheme[auto-field-cnt]: the number of fields defined by the
structure type without a counterpart in the constructor procedure
(not counting fields created by its ancestor types);}
@item{@scheme[accessor-proc]: an accessor procedure for the structure
type, like the one returned by @scheme[make-struct-type];}
@item{@scheme[mutator-proc]: a mutator procedure for the structure
type, like the one returned by @scheme[make-struct-type];}
@item{@scheme[immutable-k-list]: an immutable list of exact
non-negative integers that correspond to immutable fields for the
structure type;}
@item{@scheme[super-type]: a structure type descriptor for the
most specific ancestor of the type that is controlled by the
current inspector, or @scheme[#f] if no ancestor is controlled by
the current inspector;}
@item{@scheme[skipped?]: @scheme[#f] if the seventh result is the
most specific ancestor type or if the type has no supertype,
@scheme[#t] otherwise.}
}
If the type for @scheme[struct-type] is not controlled by the current inspector,
the @exnraise[exn:fail:contract].}
@defproc[(struct-type-make-constructor [struct-type struct-type?])
struct-constructor-procedure?]{
Returns a @tech{constructor} procedure to create instances of the type
for @scheme[struct-type]. If the type for @scheme[struct-type] is not
controlled by the current inspector, the
@exnraise[exn:fail:contract].}
@defproc[(struct-type-make-predicate [struct-type any/c]) any]{
Returns a @tech{predicate} procedure to recognize instances of the
type for @scheme[struct-type]. If the type for @scheme[struct-type]
is not controlled by the current inspector, the
@exnraise[exn:fail:contract].}
@;------------------------------------------------------------------------
@section[#:tag "mz:structutils"]{Structure Utilities}

62
collects/scribblings/reference/syntax-model.scrbl
View File

@ -609,7 +609,7 @@ example, the @scheme[eval] procedure takes a syntax object and expands
it, compiles it, and evaluates it.
@;------------------------------------------------------------------------
@section{Namespaces}
@section[#:tag "mz:namespace-model"]{Namespaces}
A @deftech{namespace} is a top-level mapping from symbols to binding
information. It is the starting point for expanding an expression; a
@ -620,8 +620,8 @@ namespace is also the starting point evaluating expanded code, where
the first step in evaluation is linking the code to specific module
instances and top-level variables.
For expansion purposes, a namespace maps each symbol to one of three
possible bindings:
For expansion purposes, a namespace maps each symbol in each phase
level to one of three possible bindings:
@itemize{
@ -640,15 +640,20 @@ for all of the imported named, and evaluating a top-level
@scheme[define] form updates the namespace's mapping to refer to a
variable (in addition to installing a value into the variable).
A namespace also has a @deftech{module registry} that maps module
names to module declarations (see @secref["mz:module-eval-model"]).
This registry is shared by all phase levels, though instances of
declared modules are not.
For evaluation, each namespace encapsulates a distinct set of
top-level variables, as well as a potentially distinct set of module
instances. After a namespace is created, module instances from
existing namespaces can be attached to the new namespace. In terms of
the evaluation model, top-level variables from different namespaces
essentially correspond to definitions with different prefixes.
Furthermore, the first step in evaluating any compiled expression is
to link its top-level variable and module-level variable references to
specific variables in the namespace.
instances in each phase. After a namespace is created, module
instances from existing namespaces can be attached to the new
namespace. In terms of the evaluation model, top-level variables from
different namespaces essentially correspond to definitions with
different prefixes. Furthermore, the first step in evaluating any
compiled expression is to link its top-level variable and module-level
variable references to specific variables in the namespace.
At all times during evaluation, some namespace is designated as the
@deftech{current namespace}. The current namespace has no particular
@ -660,6 +665,43 @@ variables to which executing expressions refer. The current namespace
only determines the behavior of (essentially reflective) operations to
expand code and to start evaluating expanded/compiled code.
@examples[
(code:line
(define x 'orig) (code:comment #, @t{define in the original namespace}))
(code:comment #, @t{The following @scheme[let] expression is compiled in the original})
(code:comment #, @t{namespace, so direct references to @scheme[x] see @scheme['orig].})
(code:line
(let ([n (make-namespace)]) ; make new namespace
(parameterize ([current-namespace n])
(eval '(define x 'new)) (code:comment #, @t{evals in the new namespace})
(display x) (code:comment #, @t{displays @scheme['orig]})
(display (eval 'x)))) (code:comment #, @t{displays @scheme['new]}))
]
A namespace is purely a top-level entity, not to be confused with an
environment. In particular, a namespace does not encapsulate the full
environment of an expression inside local-binding forms.
If an identifier is bound to syntax or to an import, then defining the
identifier as a variable shadows the syntax or import in future uses
of the environment. Similarly, if an identifier is bound to a
top-level variable, then binding the identifier to syntax or an import
shadows the variable; the variable's value remains unchanged, however,
and may be accessible through previously evaluated expressions.
@examples[
(define x 5)
(define (f) x)
x
(f)
(define-syntax x (syntax-id-rules () [_ 10]))
x
(f)
(define x 7)
x
(f)
(module m mzscheme (define x 8) (provide x))
(require m)
(eval:alts x (eval 'x))
(f)
]

37
collects/scribblings/reference/thread-groups.scrbl Normal file
View File

@ -0,0 +1,37 @@
#reader(lib "docreader.ss" "scribble")
@require[(lib "bnf.ss" "scribble")]
@require["mz.ss"]
@title[#:tag "mz:threadgroups"]{Thread Groups}
A @deftech{thread group} is a collection of threads and other thread
groups that have equal claim to the CPU. By nesting thread groups and
by creating certain threads within certain groups, a programmer can
control the amount of CPU allocated to a set of threads. Every thread
belongs to a thread group, which is determined by the
@scheme[current-thread-group] parameter when the thread is
created. Thread groups and custodians (see @secref["mz:custodians"])
are independent.
The root thread group receives all of the CPU that the operating
system gives Scheme. Every thread or nested group in a particular
thread group receives equal allocation of the CPU (a portion of the
group's access), although a thread may relinquish part of its
allocation by sleeping or synchronizing with other processes.
@defproc[(make-thread-group [group thread-group? (current-thread-group)])
thread-group?]{
Creates a new thread group that belongs to @scheme[group].}
@defproc[(thread-group? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a thread group value, @scheme[#f]
otherwise.}
@defparam[current-thread-group group thread-group?]{
A parameter that determines the thread group for newly created
threads.}

11
collects/tests/mred/showkey.ss
View File

@ -9,7 +9,7 @@
(override
[on-event
(lambda (ev)
(printf "~a~a MOUSE ~a (~a,~a)\n mods:~a~a~a~a\n buttons:~a~a~a~a~a~a~a~n"
(printf "~a~a MOUSE ~a (~a,~a)\n mods:~a~a~a~a~a\n buttons:~a~a~a~a~a~a~a~n"
(es-check)
iter
(send ev get-event-type)
@ -19,6 +19,7 @@
(if (send ev get-control-down) " CTL" "")
(if (send ev get-alt-down) " ALT" "")
(if (send ev get-shift-down) " SHIFT" "")
(if (send ev get-caps-down) " CAPS" "")
(if (send ev get-left-down) " LEFT" "")
(if (send ev get-middle-down) " MIDDLE" "")
(if (send ev get-right-down) " RIGHT" "")
@ -37,7 +38,7 @@
[on-char
(lambda (ev)
(set! iter (add1 iter))
(printf "~a~a KEY: ~a\n rel-code: ~a\n other-codes: ~a\n mods:~a~a~a~a~n"
(printf "~a~a KEY: ~a\n rel-code: ~a\n other-codes: ~a\n mods:~a~a~a~a~a~n"
(es-check)
iter
(let ([v (send ev get-key-code)])
@ -50,7 +51,8 @@
(format "~s = ASCII ~a" (string v) (char->integer v))))
(let ([vs (list (send ev get-other-shift-key-code)
(send ev get-other-altgr-key-code)
(send ev get-other-shift-altgr-key-code))])
(send ev get-other-shift-altgr-key-code)
(send ev get-other-caps-key-code))])
(map (lambda (v)
(and v
(if (symbol? v)
@ -60,7 +62,8 @@
(if (send ev get-meta-down) " META" "")
(if (send ev get-control-down) " CTL" "")
(if (send ev get-alt-down) " ALT" "")
(if (send ev get-shift-down) " SHIFT" "")))])))
(if (send ev get-shift-down) " SHIFT" "")
(if (send ev get-caps-down) " CAPS" "")))])))
(define f (make-object (class100 frame% ()
(inherit accept-drop-files)
(override

4
doc/release-notes/mzscheme/HISTORY
View File

@ -1,3 +1,7 @@
Version 370.6
Added continuation?
Added continuation-prompt-tag?
Version 370.5
Added keyword<?
Changed make-derived-parameter to accept a wrap procedure

81
src/mred/wxme/wx_keym.cxx
View File

@ -63,6 +63,8 @@ class wxKeycode
TF_Flag( altOff );
TF_Flag( metaOn );
TF_Flag( metaOff );
TF_Flag( capsOn );
TF_Flag( capsOff );
TF_Flag( checkOther );
@ -167,9 +169,9 @@ void wxKeymap::SetBreakSequenceCallback(wxBreakSequenceFunction f,
fold(dataold);
}
wxKeycode *wxKeymap::FindKey(long code, long other_code, long alt_code, long other_alt_code,
wxKeycode *wxKeymap::FindKey(long code, long other_code, long alt_code, long other_alt_code, long caps_code,
Bool shift, Bool ctrl,
Bool alt, Bool meta,
Bool alt, Bool meta, Bool caps,
wxKeycode *prefix, int *_score)
{
wxKeycode *key;
@ -181,7 +183,7 @@ wxKeycode *wxKeymap::FindKey(long code, long other_code, long alt_code, long oth
if (!keys)
return NULL;
for (iter = 0; iter < 4; iter++) {
for (iter = 0; iter < 5; iter++) {
switch (iter) {
case 0:
findk = code;
@ -193,9 +195,12 @@ wxKeycode *wxKeymap::FindKey(long code, long other_code, long alt_code, long oth
findk = alt_code;
break;
case 3:
default:
findk = other_alt_code;
break;
case 4:
default:
findk = caps_code;
break;
}
key = (wxKeycode *)keys->Get(findk);
while (key) {
@ -203,7 +208,8 @@ wxKeycode *wxKeymap::FindKey(long code, long other_code, long alt_code, long oth
|| (key->checkOther
&& ((key->code == other_code)
|| (key->code == alt_code)
|| (key->code == other_alt_code))))
|| (key->code == other_alt_code)
|| (key->code == caps_code))))
&& ((key->shiftOn && shift)
|| (key->shiftOff && !shift)
|| (!key->shiftOn && !key->shiftOff))
@ -216,6 +222,9 @@ wxKeycode *wxKeymap::FindKey(long code, long other_code, long alt_code, long oth
&& ((key->metaOn && meta)
|| (key->metaOff && !meta)
|| (!key->metaOn && !key->metaOff))
&& ((key->capsOn && caps)
|| (key->capsOff && !caps)
|| (!key->capsOn && !key->capsOff))
&& key->seqprefix == prefix) {
int score = key->score;
if (key->code != code) {
@ -323,7 +332,7 @@ static Keybind keylist[]
{ NULL, 0 }};
wxKeycode *wxKeymap::MapFunction(long code, int shift, int ctrl,
int alt, int meta, int checkOther,
int alt, int meta, int caps, int checkOther,
char *fname, wxKeycode *prev, int type)
{
wxKeycode *key, *newkey;
@ -340,6 +349,8 @@ wxKeycode *wxKeymap::MapFunction(long code, int shift, int ctrl,
&& (key->altOff == (alt < 0))
&& (key->metaOn == (meta > 0))
&& (key->metaOff == (meta < 0))
&& (key->capsOn == (caps > 0))
&& (key->capsOff == (caps < 0))
&& (key->checkOther == (checkOther ? 1 : 0))
&& key->seqprefix == prev)
break;
@ -409,6 +420,8 @@ wxKeycode *wxKeymap::MapFunction(long code, int shift, int ctrl,
newkey->altOff = (alt < 0);
newkey->metaOn = (meta > 0);
newkey->metaOff = (meta < 0);
newkey->capsOn = (caps > 0);
newkey->capsOff = (caps < 0);
newkey->checkOther = (checkOther ? 1 : 0);
newkey->score = ((newkey->shiftOn ? 1 : 0)
+ (newkey->shiftOff ? 5 : 0)
@ -417,8 +430,10 @@ wxKeycode *wxKeymap::MapFunction(long code, int shift, int ctrl,
+ (newkey->altOn ? 1 : 0)
+ (newkey->altOff ? 5 : 0)
+ (newkey->metaOn ? 1 : 0)
+ (newkey->metaOn ? 5 : 0)
+ (newkey->checkOther ? 5 : 25));
+ (newkey->metaOff ? 5 : 0)
+ (newkey->capsOn ? 1 : 0)
+ (newkey->capsOff ? 5 : 0)
+ (newkey->checkOther ? 6 : 30));
newkey->fullset = 0;
newkey->fname = copystring(fname);
newkey->next = NULL;
@ -502,7 +517,7 @@ void wxKeymap::MapFunction(wxchar *keys, char *fname)
wxchar *keyseq = keys;
int num_keys, num_new_keys, kp, start_keys;
wxKeycode **key, **new_key;
int shift, ctrl, alt, meta, mod, checkOther;
int shift, ctrl, alt, meta, caps, mod, checkOther;
int part = 1, i, j;
long code;
int fullset;
@ -516,7 +531,7 @@ void wxKeymap::MapFunction(wxchar *keys, char *fname)
start_keys = kp = 0;
while (keyseq[kp]) {
shift = ctrl = alt = meta = 0;
shift = ctrl = alt = meta = caps = 0;
code = 0;
fullset = 0;
checkOther = 0;
@ -525,6 +540,7 @@ void wxKeymap::MapFunction(wxchar *keys, char *fname)
mod = 1;
if ((kp == start_keys) && (keyseq[kp] == ':') && keyseq[kp + 1]) {
shift = ctrl = alt = meta = -1;
caps = 0;
kp++;
} else if (keyseq[kp] == '~') {
if (!keyseq[kp + 1] || (keyseq[kp + 2] != ':')) {
@ -549,6 +565,9 @@ void wxKeymap::MapFunction(wxchar *keys, char *fname)
case 'c':
ctrl = mod;
break;
case 'l':
caps = mod;
break;
case 'm':
#ifdef wx_mac
if (mod > 0)
@ -596,10 +615,10 @@ void wxKeymap::MapFunction(wxchar *keys, char *fname)
if ((code > 0) && (code < 127) && isalpha(code)) {
if (shift > 0) {
#ifdef wx_mac
if (!meta)
if ((meta < 1) && (ctrl < 1))
#endif
#ifdef wx_msw
if (!ctrl || meta)
#if defined(wx_msw) || defined(wx_xt)
if ((ctrl < 1) || (meta > 0))
#endif
code = toupper(code);
} else if (isupper(code))
@ -611,7 +630,7 @@ void wxKeymap::MapFunction(wxchar *keys, char *fname)
for (i = 0, j = 0; i < num_keys; i++) {
wxKeycode *mf;
mf = MapFunction(code, shift, ctrl, alt, meta, checkOther, fname, key[i],
mf = MapFunction(code, shift, ctrl, alt, meta, caps, checkOther, fname, key[i],
keyseq[kp] ? wxKEY_PREFIX : wxKEY_FINAL);
mf->fullset = fullset;
new_key[j++] = mf;
@ -657,16 +676,16 @@ void wxKeymap::MapFunction(char *keys, char *fname)
MapFunction(us, fname);
}
int wxKeymap::HandleEvent(long code, long other_code, long alt_code, long other_alt_code,
int wxKeymap::HandleEvent(long code, long other_code, long alt_code, long other_alt_code, long caps_code,
Bool shift, Bool ctrl,
Bool alt, Bool meta, int score,
Bool alt, Bool meta, Bool caps, int score,
char **fname, int *fullset)
{
wxKeycode *key;
int found_score;
key = FindKey(code, other_code, alt_code, other_alt_code,
shift, ctrl, alt, meta, prefix, &found_score);
key = FindKey(code, other_code, alt_code, other_alt_code, caps_code,
shift, ctrl, alt, meta, caps, prefix, &found_score);
prefix = NULL;
@ -685,16 +704,16 @@ int wxKeymap::HandleEvent(long code, long other_code, long alt_code, long othe
return 0;
}
int wxKeymap::GetBestScore(long code, long other_code, long alt_code, long other_alt_code,
int wxKeymap::GetBestScore(long code, long other_code, long alt_code, long other_alt_code, long caps_code,
Bool shift, Bool ctrl,
Bool alt, Bool meta)
Bool alt, Bool meta, Bool caps)
{
wxKeycode *key;
int s, i;
int score;
key = FindKey(code, other_code, alt_code, other_alt_code,
shift, ctrl, alt, meta, prefix, &score);
key = FindKey(code, other_code, alt_code, other_alt_code, caps_code,
shift, ctrl, alt, meta, caps, prefix, &score);
if (key)
s = score;
@ -703,8 +722,8 @@ int wxKeymap::GetBestScore(long code, long other_code, long alt_code, long oth
for (i = 0; i < chainCount; i++) {
int r;
r = chainTo[i]->GetBestScore(code, other_code, alt_code, other_alt_code,
shift, ctrl, alt, meta);
r = chainTo[i]->GetBestScore(code, other_code, alt_code, other_alt_code, caps_code,
shift, ctrl, alt, meta, caps);
if (r > s)
s = r;
}
@ -745,10 +764,12 @@ int wxKeymap::GetBestScore(wxKeyEvent *event)
event->otherKeyCode,
event->altKeyCode,
event->otherAltKeyCode,
event->capsKeyCode,
event->shiftDown,
event->controlDown,
event->altDown,
event->metaDown);
event->metaDown,
event->capsDown);
}
int wxKeymap::OtherHandleKeyEvent(UNKNOWN_OBJ media, wxKeyEvent *event,
@ -803,10 +824,12 @@ int wxKeymap::ChainHandleKeyEvent(UNKNOWN_OBJ media, wxKeyEvent *event,
event->otherKeyCode,
event->altKeyCode,
event->otherAltKeyCode,
event->capsKeyCode,
event->shiftDown,
event->controlDown,
event->altDown,
event->metaDown,
event->capsDown,
score,
&fname,
NULL)) {
@ -895,11 +918,12 @@ int wxKeymap::GetBestScore(wxMouseEvent *event)
}
return GetBestScore(code,
-1, -1, -1,
-1, -1, -1, -1,
event->shiftDown,
event->controlDown,
event->altDown,
event->metaDown);
event->metaDown,
event->capsDown);
}
int wxKeymap::OtherHandleMouseEvent(UNKNOWN_OBJ media, wxMouseEvent *event,
@ -996,11 +1020,12 @@ int wxKeymap::ChainHandleMouseEvent(UNKNOWN_OBJ media, wxMouseEvent *event,
do {
if (HandleEvent(code,
-1, -1, -1,
-1, -1, -1, -1,
event->shiftDown,
event->controlDown,
event->altDown,
event->metaDown,
event->capsDown,
score,
&fname,
&fullset)) {

10
src/mred/wxme/wx_keym.h
View File

@ -67,11 +67,11 @@ class wxKeymap : public wxObject
wxBreakSequenceFunction onBreak;
void *onBreakData;
class wxKeycode *FindKey(long, long, long, long, Bool, Bool, Bool, Bool, class wxKeycode *, int *_score);
int HandleEvent(long code, long, long, long,
Bool shift, Bool ctrl, Bool alt, Bool meta,
class wxKeycode *FindKey(long, long, long, long, long, Bool, Bool, Bool, Bool, Bool, class wxKeycode *, int *_score);
int HandleEvent(long code, long, long, long, long,
Bool shift, Bool ctrl, Bool alt, Bool meta, Bool,
int score, char **fname, int *fullset);
int GetBestScore(long code, long, long, long, Bool shift, Bool ctrl, Bool alt, Bool meta);
int GetBestScore(long code, long, long, long, long, Bool shift, Bool ctrl, Bool alt, Bool meta, Bool caps);
Bool CycleCheck(wxKeymap *km);
@ -110,7 +110,7 @@ class wxKeymap : public wxObject
void SetBreakSequenceCallback(wxBreakSequenceFunction f, void *data);
class wxKeycode *MapFunction(long code, int shift, int ctrl,
int alt, int meta, int check_alt,
int alt, int meta, int caps, int check_alt,
char *fname, class wxKeycode *prevkey=NULL,
int keytype = wxKEY_FINAL);
void MapFunction(wxchar *keyname, char *fname);

172
src/mred/wxs/wxs_evnt.cxx
View File

@ -45,10 +45,10 @@ wxScrollEvent_ext::wxScrollEvent_ext(int et, int d, int p, long ts)
}
class wxKeyEvent_ext : public wxKeyEvent {
public: wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, int yv, long ts);
public: wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, int yv, long ts, int caps);
};
wxKeyEvent_ext::wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, int yv, long ts)
wxKeyEvent_ext::wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, int yv, long ts, int caps)
: wxKeyEvent(wxEVENT_TYPE_CHAR)
{
keyCode = kc;
@ -56,16 +56,17 @@ wxKeyEvent_ext::wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, i
controlDown = cd;
metaDown = md;
altDown = ad;
capsDown = caps;
x = xv;
y = yv;
timeStamp = ts;
}
class wxMouseEvent_ext : public wxMouseEvent {
public: wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int yv, int sd, int cd, int md, int ad, long ts);
public: wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int yv, int sd, int cd, int md, int ad, long ts, int caps);
};
wxMouseEvent_ext::wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int yv, int sd, int cd, int md, int ad, long ts)
wxMouseEvent_ext::wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int yv, int sd, int cd, int md, int ad, long ts, int caps)
: wxMouseEvent(et)
{
leftDown = ld;
@ -77,6 +78,7 @@ wxMouseEvent_ext::wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int
controlDown = cd;
metaDown = md;
altDown = ad;
capsDown = caps;
timeStamp = ts;
}
@ -1464,6 +1466,8 @@ static long GetAltKey(wxKeyEvent *k) { return k->altKeyCode; }
static void SetAltKey(wxKeyEvent *k, long c) { k->altKeyCode = c; }
static long GetOtherAltKey(wxKeyEvent *k) { return k->otherAltKeyCode; }
static void SetOtherAltKey(wxKeyEvent *k, long c) { k->otherAltKeyCode = c; }
static long GetCapsKey(wxKeyEvent *k) { return k->capsKeyCode; }
static void SetCapsKey(wxKeyEvent *k, long c) { k->capsKeyCode = c; }
@ -1473,7 +1477,7 @@ static void SetOtherAltKey(wxKeyEvent *k, long c) { k->otherAltKeyCode = c; }
class os_wxKeyEvent : public wxKeyEvent_ext {
public:
os_wxKeyEvent CONSTRUCTOR_ARGS((int x0 = 0, Bool x1 = 0, Bool x2 = 0, Bool x3 = 0, Bool x4 = 0, int x5 = 0, int x6 = 0, ExactLong x7 = 0));
os_wxKeyEvent CONSTRUCTOR_ARGS((int x0 = 0, Bool x1 = 0, Bool x2 = 0, Bool x3 = 0, Bool x4 = 0, int x5 = 0, int x6 = 0, ExactLong x7 = 0, Bool x8 = 0));
~os_wxKeyEvent();
#ifdef MZ_PRECISE_GC
void gcMark();
@ -1492,8 +1496,8 @@ void os_wxKeyEvent::gcFixup() {
static Scheme_Object *os_wxKeyEvent_class;
os_wxKeyEvent::os_wxKeyEvent CONSTRUCTOR_ARGS((int x0, Bool x1, Bool x2, Bool x3, Bool x4, int x5, int x6, ExactLong x7))
CONSTRUCTOR_INIT(: wxKeyEvent_ext(x0, x1, x2, x3, x4, x5, x6, x7))
os_wxKeyEvent::os_wxKeyEvent CONSTRUCTOR_ARGS((int x0, Bool x1, Bool x2, Bool x3, Bool x4, int x5, int x6, ExactLong x7, Bool x8))
CONSTRUCTOR_INIT(: wxKeyEvent_ext(x0, x1, x2, x3, x4, x5, x6, x7, x8))
{
}
@ -1502,6 +1506,50 @@ os_wxKeyEvent::~os_wxKeyEvent()
objscheme_destroy(this, (Scheme_Object *) __gc_external);
}
static Scheme_Object *os_wxKeyEventSetCapsKey(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
REMEMBER_VAR_STACK();
objscheme_check_valid(os_wxKeyEvent_class, "set-other-caps-key-code in key-event%", n, p);
long x0 INIT_NULLED_OUT;
SETUP_VAR_STACK_REMEMBERED(2);
VAR_STACK_PUSH(0, p);
VAR_STACK_PUSH(1, x0);
x0 = (SCHEME_FALSEP(p[POFFSET+0]) ? 0 : unbundle_symset_keyCode(p[POFFSET+0], METHODNAME("key-event%","set-other-caps-key-code")));
WITH_VAR_STACK(SetCapsKey(((wxKeyEvent *)((Scheme_Class_Object *)p[0])->primdata), x0));
READY_TO_RETURN;
return scheme_void;
}
static Scheme_Object *os_wxKeyEventGetCapsKey(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
REMEMBER_VAR_STACK();
long r;
objscheme_check_valid(os_wxKeyEvent_class, "get-other-caps-key-code in key-event%", n, p);
SETUP_VAR_STACK_REMEMBERED(1);
VAR_STACK_PUSH(0, p);
r = WITH_VAR_STACK(GetCapsKey(((wxKeyEvent *)((Scheme_Class_Object *)p[0])->primdata)));
READY_TO_RETURN;
return (r ? bundle_symset_keyCode(r) : scheme_false);
}
static Scheme_Object *os_wxKeyEventSetOtherAltKey(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
@ -1838,6 +1886,40 @@ static Scheme_Object *objscheme_wxKeyEvent_SetaltDown(int n, Scheme_Object *p[]
return scheme_void;
}
static Scheme_Object *objscheme_wxKeyEvent_GetcapsDown(int n, Scheme_Object *p[])
{
Scheme_Class_Object *cobj INIT_NULLED_OUT;
Bool v;
REMEMBER_VAR_STACK();
objscheme_check_valid(os_wxKeyEvent_class, "get-caps-down in key-event%", n, p);
if (n > POFFSET) WITH_REMEMBERED_STACK(scheme_wrong_count_m("get-caps-down in key-event%", POFFSET, POFFSET, n, p, 1));
cobj = (Scheme_Class_Object *)p[0];
if (cobj->primflag)
v = ((os_wxKeyEvent *)cobj->primdata)->wxKeyEvent::capsDown;
else
v = ((wxKeyEvent *)cobj->primdata)->capsDown;
return (v ? scheme_true : scheme_false);
}
static Scheme_Object *objscheme_wxKeyEvent_SetcapsDown(int n, Scheme_Object *p[])
{
Scheme_Class_Object *cobj = (Scheme_Class_Object *)p[0];
Bool v;
SETUP_VAR_STACK(1);
VAR_STACK_PUSH(0, cobj);
WITH_VAR_STACK(objscheme_check_valid(os_wxKeyEvent_class, "set-caps-down in key-event%", n, p));
if (n != (POFFSET+1)) WITH_VAR_STACK(scheme_wrong_count_m("set-caps-down in key-event%", POFFSET+1, POFFSET+1, n, p, 1));
v = WITH_VAR_STACK(objscheme_unbundle_bool(p[POFFSET], "set-caps-down in key-event%"));
((wxKeyEvent *)cobj->primdata)->capsDown = v;
READY_TO_RETURN;
return scheme_void;
}
static Scheme_Object *objscheme_wxKeyEvent_Getx(int n, Scheme_Object *p[])
{
Scheme_Class_Object *cobj INIT_NULLED_OUT;
@ -1920,14 +2002,15 @@ static Scheme_Object *os_wxKeyEvent_ConstructScheme(int n, Scheme_Object *p[])
int x5;
int x6;
ExactLong x7;
Bool x8;
SETUP_VAR_STACK_PRE_REMEMBERED(2);
VAR_STACK_PUSH(0, p);
VAR_STACK_PUSH(1, realobj);
if ((n > (POFFSET+8)))
WITH_VAR_STACK(scheme_wrong_count_m("initialization in key-event%", POFFSET+POFFSET, POFFSET+8, n, p, 1));
if ((n > (POFFSET+9)))
WITH_VAR_STACK(scheme_wrong_count_m("initialization in key-event%", POFFSET+POFFSET, POFFSET+9, n, p, 1));
if (n > (POFFSET+0)) {
x0 = WITH_VAR_STACK(unbundle_symset_keyCode(p[POFFSET+0], "initialization in key-event%"));
} else
@ -1960,11 +2043,15 @@ static Scheme_Object *os_wxKeyEvent_ConstructScheme(int n, Scheme_Object *p[])
x7 = WITH_VAR_STACK(objscheme_unbundle_ExactLong(p[POFFSET+7], "initialization in key-event%"));
} else
x7 = 0;
if (n > (POFFSET+8)) {
x8 = WITH_VAR_STACK(objscheme_unbundle_bool(p[POFFSET+8], "initialization in key-event%"));
} else
x8 = 0;
realobj = WITH_VAR_STACK(new os_wxKeyEvent CONSTRUCTOR_ARGS((x0, x1, x2, x3, x4, x5, x6, x7)));
realobj = WITH_VAR_STACK(new os_wxKeyEvent CONSTRUCTOR_ARGS((x0, x1, x2, x3, x4, x5, x6, x7, x8)));
#ifdef MZ_PRECISE_GC
WITH_VAR_STACK(realobj->gcInit_wxKeyEvent_ext(x0, x1, x2, x3, x4, x5, x6, x7));
WITH_VAR_STACK(realobj->gcInit_wxKeyEvent_ext(x0, x1, x2, x3, x4, x5, x6, x7, x8));
#endif
realobj->__gc_external = (void *)p[0];
@ -1982,8 +2069,10 @@ void objscheme_setup_wxKeyEvent(Scheme_Env *env)
wxREGGLOB(os_wxKeyEvent_class);
os_wxKeyEvent_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "key-event%", "event%", (Scheme_Method_Prim *)os_wxKeyEvent_ConstructScheme, 22));
os_wxKeyEvent_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "key-event%", "event%", (Scheme_Method_Prim *)os_wxKeyEvent_ConstructScheme, 26));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class, "set-other-caps-key-code" " method", (Scheme_Method_Prim *)os_wxKeyEventSetCapsKey, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class, "get-other-caps-key-code" " method", (Scheme_Method_Prim *)os_wxKeyEventGetCapsKey, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class, "set-other-shift-altgr-key-code" " method", (Scheme_Method_Prim *)os_wxKeyEventSetOtherAltKey, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class, "get-other-shift-altgr-key-code" " method", (Scheme_Method_Prim *)os_wxKeyEventGetOtherAltKey, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class, "set-other-altgr-key-code" " method", (Scheme_Method_Prim *)os_wxKeyEventSetAltKey, 1, 1));
@ -2003,6 +2092,8 @@ void objscheme_setup_wxKeyEvent(Scheme_Env *env)
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class,"set-meta-down" " method", (Scheme_Method_Prim *)objscheme_wxKeyEvent_SetmetaDown, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class,"get-alt-down" " method", (Scheme_Method_Prim *)objscheme_wxKeyEvent_GetaltDown, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class,"set-alt-down" " method", (Scheme_Method_Prim *)objscheme_wxKeyEvent_SetaltDown, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class,"get-caps-down" " method", (Scheme_Method_Prim *)objscheme_wxKeyEvent_GetcapsDown, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class,"set-caps-down" " method", (Scheme_Method_Prim *)objscheme_wxKeyEvent_SetcapsDown, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class,"get-x" " method", (Scheme_Method_Prim *)objscheme_wxKeyEvent_Getx, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class,"set-x" " method", (Scheme_Method_Prim *)objscheme_wxKeyEvent_Setx, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxKeyEvent_class,"get-y" " method", (Scheme_Method_Prim *)objscheme_wxKeyEvent_Gety, 0, 0));
@ -2215,7 +2306,7 @@ static int unbundle_symset_buttonId(Scheme_Object *v, const char *where) {
class os_wxMouseEvent : public wxMouseEvent_ext {
public:
os_wxMouseEvent CONSTRUCTOR_ARGS((int x0, Bool x1 = 0, Bool x2 = 0, Bool x3 = 0, int x4 = 0, int x5 = 0, Bool x6 = 0, Bool x7 = 0, Bool x8 = 0, Bool x9 = 0, ExactLong x10 = 0));
os_wxMouseEvent CONSTRUCTOR_ARGS((int x0, Bool x1 = 0, Bool x2 = 0, Bool x3 = 0, int x4 = 0, int x5 = 0, Bool x6 = 0, Bool x7 = 0, Bool x8 = 0, Bool x9 = 0, ExactLong x10 = 0, Bool x11 = 0));
~os_wxMouseEvent();
#ifdef MZ_PRECISE_GC
void gcMark();
@ -2234,8 +2325,8 @@ void os_wxMouseEvent::gcFixup() {
static Scheme_Object *os_wxMouseEvent_class;
os_wxMouseEvent::os_wxMouseEvent CONSTRUCTOR_ARGS((int x0, Bool x1, Bool x2, Bool x3, int x4, int x5, Bool x6, Bool x7, Bool x8, Bool x9, ExactLong x10))
CONSTRUCTOR_INIT(: wxMouseEvent_ext(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10))
os_wxMouseEvent::os_wxMouseEvent CONSTRUCTOR_ARGS((int x0, Bool x1, Bool x2, Bool x3, int x4, int x5, Bool x6, Bool x7, Bool x8, Bool x9, ExactLong x10, Bool x11))
CONSTRUCTOR_INIT(: wxMouseEvent_ext(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11))
{
}
@ -2678,6 +2769,40 @@ static Scheme_Object *objscheme_wxMouseEvent_SetaltDown(int n, Scheme_Object *p
return scheme_void;
}
static Scheme_Object *objscheme_wxMouseEvent_GetcapsDown(int n, Scheme_Object *p[])
{
Scheme_Class_Object *cobj INIT_NULLED_OUT;
Bool v;
REMEMBER_VAR_STACK();
objscheme_check_valid(os_wxMouseEvent_class, "get-caps-down in mouse-event%", n, p);
if (n > POFFSET) WITH_REMEMBERED_STACK(scheme_wrong_count_m("get-caps-down in mouse-event%", POFFSET, POFFSET, n, p, 1));
cobj = (Scheme_Class_Object *)p[0];
if (cobj->primflag)
v = ((os_wxMouseEvent *)cobj->primdata)->wxMouseEvent::capsDown;
else
v = ((wxMouseEvent *)cobj->primdata)->capsDown;
return (v ? scheme_true : scheme_false);
}
static Scheme_Object *objscheme_wxMouseEvent_SetcapsDown(int n, Scheme_Object *p[])
{
Scheme_Class_Object *cobj = (Scheme_Class_Object *)p[0];
Bool v;
SETUP_VAR_STACK(1);
VAR_STACK_PUSH(0, cobj);
WITH_VAR_STACK(objscheme_check_valid(os_wxMouseEvent_class, "set-caps-down in mouse-event%", n, p));
if (n != (POFFSET+1)) WITH_VAR_STACK(scheme_wrong_count_m("set-caps-down in mouse-event%", POFFSET+1, POFFSET+1, n, p, 1));
v = WITH_VAR_STACK(objscheme_unbundle_bool(p[POFFSET], "set-caps-down in mouse-event%"));
((wxMouseEvent *)cobj->primdata)->capsDown = v;
READY_TO_RETURN;
return scheme_void;
}
static Scheme_Object *objscheme_wxMouseEvent_Getx(int n, Scheme_Object *p[])
{
Scheme_Class_Object *cobj INIT_NULLED_OUT;
@ -2763,14 +2888,15 @@ static Scheme_Object *os_wxMouseEvent_ConstructScheme(int n, Scheme_Object *p[]
Bool x8;
Bool x9;
ExactLong x10;
Bool x11;
SETUP_VAR_STACK_PRE_REMEMBERED(2);
VAR_STACK_PUSH(0, p);
VAR_STACK_PUSH(1, realobj);
if ((n < (POFFSET+1)) || (n > (POFFSET+11)))
WITH_VAR_STACK(scheme_wrong_count_m("initialization in mouse-event%", POFFSET+1, POFFSET+11, n, p, 1));
if ((n < (POFFSET+1)) || (n > (POFFSET+12)))
WITH_VAR_STACK(scheme_wrong_count_m("initialization in mouse-event%", POFFSET+1, POFFSET+12, n, p, 1));
x0 = WITH_VAR_STACK(unbundle_symset_mouseEventType(p[POFFSET+0], "initialization in mouse-event%"));
if (n > (POFFSET+1)) {
x1 = WITH_VAR_STACK(objscheme_unbundle_bool(p[POFFSET+1], "initialization in mouse-event%"));
@ -2812,11 +2938,15 @@ static Scheme_Object *os_wxMouseEvent_ConstructScheme(int n, Scheme_Object *p[]
x10 = WITH_VAR_STACK(objscheme_unbundle_ExactLong(p[POFFSET+10], "initialization in mouse-event%"));
} else
x10 = 0;
if (n > (POFFSET+11)) {
x11 = WITH_VAR_STACK(objscheme_unbundle_bool(p[POFFSET+11], "initialization in mouse-event%"));
} else
x11 = 0;
realobj = WITH_VAR_STACK(new os_wxMouseEvent CONSTRUCTOR_ARGS((x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10)));
realobj = WITH_VAR_STACK(new os_wxMouseEvent CONSTRUCTOR_ARGS((x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11)));
#ifdef MZ_PRECISE_GC
WITH_VAR_STACK(realobj->gcInit_wxMouseEvent_ext(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10));
WITH_VAR_STACK(realobj->gcInit_wxMouseEvent_ext(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11));
#endif
realobj->__gc_external = (void *)p[0];
@ -2834,7 +2964,7 @@ void objscheme_setup_wxMouseEvent(Scheme_Env *env)
wxREGGLOB(os_wxMouseEvent_class);
os_wxMouseEvent_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "mouse-event%", "event%", (Scheme_Method_Prim *)os_wxMouseEvent_ConstructScheme, 27));
os_wxMouseEvent_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "mouse-event%", "event%", (Scheme_Method_Prim *)os_wxMouseEvent_ConstructScheme, 29));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class, "moving?" " method", (Scheme_Method_Prim *)os_wxMouseEventMoving, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class, "leaving?" " method", (Scheme_Method_Prim *)os_wxMouseEventLeaving, 0, 0));
@ -2860,6 +2990,8 @@ void objscheme_setup_wxMouseEvent(Scheme_Env *env)
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class,"set-meta-down" " method", (Scheme_Method_Prim *)objscheme_wxMouseEvent_SetmetaDown, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class,"get-alt-down" " method", (Scheme_Method_Prim *)objscheme_wxMouseEvent_GetaltDown, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class,"set-alt-down" " method", (Scheme_Method_Prim *)objscheme_wxMouseEvent_SetaltDown, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class,"get-caps-down" " method", (Scheme_Method_Prim *)objscheme_wxMouseEvent_GetcapsDown, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class,"set-caps-down" " method", (Scheme_Method_Prim *)objscheme_wxMouseEvent_SetcapsDown, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class,"get-x" " method", (Scheme_Method_Prim *)objscheme_wxMouseEvent_Getx, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class,"set-x" " method", (Scheme_Method_Prim *)objscheme_wxMouseEvent_Setx, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMouseEvent_class,"get-y" " method", (Scheme_Method_Prim *)objscheme_wxMouseEvent_Gety, 0, 0));

24
src/mred/wxs/wxs_evnt.xc
View File

@ -37,10 +37,10 @@ wxScrollEvent_ext::wxScrollEvent_ext(int et, int d, int p, long ts)
}
class wxKeyEvent_ext : public wxKeyEvent {
public: wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, int yv, long ts);
public: wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, int yv, long ts, int caps);
};
wxKeyEvent_ext::wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, int yv, long ts)
wxKeyEvent_ext::wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, int yv, long ts, int caps)
: wxKeyEvent(wxEVENT_TYPE_CHAR)
{
keyCode = kc;
@ -48,16 +48,17 @@ wxKeyEvent_ext::wxKeyEvent_ext(int kc, int sd, int cd, int md, int ad, int xv, i
controlDown = cd;
metaDown = md;
altDown = ad;
capsDown = caps;
x = xv;
y = yv;
timeStamp = ts;
}
class wxMouseEvent_ext : public wxMouseEvent {
public: wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int yv, int sd, int cd, int md, int ad, long ts);
public: wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int yv, int sd, int cd, int md, int ad, long ts, int caps);
};
wxMouseEvent_ext::wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int yv, int sd, int cd, int md, int ad, long ts)
wxMouseEvent_ext::wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int yv, int sd, int cd, int md, int ad, long ts, int caps)
: wxMouseEvent(et)
{
leftDown = ld;
@ -69,6 +70,7 @@ wxMouseEvent_ext::wxMouseEvent_ext(int et, int ld, int mdd, int rd, int xv, int
controlDown = cd;
metaDown = md;
altDown = ad;
capsDown = caps;
timeStamp = ts;
}
@ -228,11 +230,13 @@ static long GetAltKey(wxKeyEvent *k) { return k->altKeyCode; }
static void SetAltKey(wxKeyEvent *k, long c) { k->altKeyCode = c; }
static long GetOtherAltKey(wxKeyEvent *k) { return k->otherAltKeyCode; }
static void SetOtherAltKey(wxKeyEvent *k, long c) { k->otherAltKeyCode = c; }
static long GetCapsKey(wxKeyEvent *k) { return k->capsKeyCode; }
static void SetCapsKey(wxKeyEvent *k, long c) { k->capsKeyCode = c; }
@CLASSBASE wxKeyEvent=wxKeyEvent_ext "key-event":"event" / nofnl
@CREATOR (SYM[keyCode]=0, bool=0, bool=0, bool=0, bool=0, int=0, int=0, ExactLong=0)
@ARGNAMES [key-code #\nul] [shift-down #f] [control-down #f] [meta-down #f] [alt-down #f] [x 0] [y 0] [time-stamp 0]
@CREATOR (SYM[keyCode]=0, bool=0, bool=0, bool=0, bool=0, int=0, int=0, ExactLong=0, bool=0)
@ARGNAMES [key-code #\nul] [shift-down #f] [control-down #f] [meta-down #f] [alt-down #f] [x 0] [y 0] [time-stamp 0] [caps-down #f]
@IVAR "key-code" : SYM[keyCode] keyCode
@IVAR "key-release-code" : SYM[keyCode] keyUpCode
@ -240,6 +244,7 @@ static void SetOtherAltKey(wxKeyEvent *k, long c) { k->otherAltKeyCode = c; }
@IVAR "control-down" : bool controlDown
@IVAR "meta-down" : bool metaDown
@IVAR "alt-down" : bool altDown
@IVAR "caps-down" : bool capsDown
@IVAR "x" : int x
@IVAR "y" : int y
@ -250,6 +255,8 @@ static void SetOtherAltKey(wxKeyEvent *k, long c) { k->otherAltKeyCode = c; }
@ m "set-other-altgr-key-code" : void SetAltKey(long//ubKeyOrFalse["set-other-altgr-key-code"]////push);
@ m "get-other-shift-altgr-key-code" : long/bKeyOrFalse GetOtherAltKey();
@ m "set-other-shift-altgr-key-code" : void SetOtherAltKey(long//ubKeyOrFalse["set-other-shift-altgr-key-code"]////push);
@ m "get-other-caps-key-code" : long/bKeyOrFalse GetCapsKey();
@ m "set-other-caps-key-code" : void SetCapsKey(long//ubKeyOrFalse["set-other-caps-key-code"]////push);
@END
@ -283,8 +290,8 @@ static int wxKeySymbolToInteger(int v) { return v; }
@CLASSBASE wxMouseEvent=wxMouseEvent_ext "mouse-event":"event" / nofnl
@CREATOR (SYM[mouseEventType], bool=0, bool=0, bool=0, int=0, int=0, bool=0, bool=0, bool=0, bool=0, ExactLong=0)
@ARGNAMES event-type [left-down #f] [middle-down #f] [right-down #f] [x 0] [y 0] [shift-down #f] [control-down #f] [meta-down #f] [alt-down #f] [time-stamp 0]
@CREATOR (SYM[mouseEventType], bool=0, bool=0, bool=0, int=0, int=0, bool=0, bool=0, bool=0, bool=0, ExactLong=0, bool=0)
@ARGNAMES event-type [left-down #f] [middle-down #f] [right-down #f] [x 0] [y 0] [shift-down #f] [control-down #f] [meta-down #f] [alt-down #f] [time-stamp 0] [caps-down #f]
@ "button-changed?" : bool Button(SYM[buttonId]=-1);
@ "button-down?" : bool ButtonDown(SYM[buttonId]=-1);
@ -302,6 +309,7 @@ static int wxKeySymbolToInteger(int v) { return v; }
@IVAR "control-down" : bool controlDown
@IVAR "meta-down" : bool metaDown
@IVAR "alt-down" : bool altDown
@IVAR "caps-down" : bool capsDown
@IVAR "x" : int x
@IVAR "y" : int y

5559
src/mzscheme/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

27
src/mzscheme/src/fun.c
View File

@ -100,6 +100,7 @@ static Scheme_Object *andmap (int argc, Scheme_Object *argv[]);
static Scheme_Object *ormap (int argc, Scheme_Object *argv[]);
static Scheme_Object *call_cc (int argc, Scheme_Object *argv[]);
static Scheme_Object *internal_call_cc (int argc, Scheme_Object *argv[]);
static Scheme_Object *continuation_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *call_with_continuation_barrier (int argc, Scheme_Object *argv[]);
static Scheme_Object *call_with_prompt (int argc, Scheme_Object *argv[]);
static Scheme_Object *call_with_control (int argc, Scheme_Object *argv[]);
@ -107,6 +108,7 @@ static Scheme_Object *make_prompt_tag (int argc, Scheme_Object *argv[]);
static Scheme_Object *abort_continuation (int argc, Scheme_Object *argv[]);
static Scheme_Object *continuation_prompt_available(int argc, Scheme_Object *argv[]);
static Scheme_Object *get_default_prompt_tag (int argc, Scheme_Object *argv[]);
static Scheme_Object *prompt_tag_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *call_with_sema (int argc, Scheme_Object *argv[]);
static Scheme_Object *call_with_sema_enable_break (int argc, Scheme_Object *argv[]);
static Scheme_Object *cc_marks (int argc, Scheme_Object *argv[]);
@ -283,6 +285,12 @@ scheme_init_fun (Scheme_Env *env)
scheme_add_global_constant("call-with-current-continuation", o, env);
scheme_add_global_constant("call/cc", o, env);
scheme_add_global_constant("continuation?",
scheme_make_folding_prim(continuation_p,
"continuation?",
1, 1, 1),
env);
scheme_add_global_constant("call-with-continuation-barrier",
scheme_make_prim_w_arity2(call_with_continuation_barrier,
"call-with-continuation-barrier",
@ -331,6 +339,11 @@ scheme_init_fun (Scheme_Env *env)
"default-continuation-prompt-tag",
0, 0),
env);
scheme_add_global_constant("continuation-prompt-tag?",
scheme_make_folding_prim(prompt_tag_p,
"continuation-prompt-tag?",
1, 1, 1),
env);
scheme_add_global_constant("call-with-semaphore",
scheme_make_prim_w_arity2(call_with_sema,
@ -4863,6 +4876,13 @@ internal_call_cc (int argc, Scheme_Object *argv[])
}
}
static Scheme_Object *continuation_p (int argc, Scheme_Object *argv[])
{
return ((SCHEME_CONTP(argv[0]) || SCHEME_ECONTP(argv[0]))
? scheme_true
: scheme_false);
}
void scheme_takeover_stacks(Scheme_Thread *p)
/* When a contination captured in on e thread is invoked in another,
the two threads can start using the same runstack, and possibly
@ -4938,6 +4958,13 @@ static Scheme_Object *get_default_prompt_tag (int argc, Scheme_Object *argv[])
return scheme_default_prompt_tag;
}
static Scheme_Object *prompt_tag_p (int argc, Scheme_Object *argv[])
{
return (SAME_TYPE(scheme_prompt_tag_type, SCHEME_TYPE(argv[0]))
? scheme_true
: scheme_false);
}
Scheme_Overflow *scheme_get_thread_end_overflow(void)
{
Scheme_Overflow *overflow;

2
src/mzscheme/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 905
#define EXPECTED_PRIM_COUNT 907
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

4
src/mzscheme/src/schvers.h
View File

@ -9,6 +9,6 @@
#define MZSCHEME_VERSION_MAJOR 370
#define MZSCHEME_VERSION_MINOR 5
#define MZSCHEME_VERSION_MINOR 6
#define MZSCHEME_VERSION "370.5" _MZ_SPECIAL_TAG
#define MZSCHEME_VERSION "370.6" _MZ_SPECIAL_TAG

3
src/wxmac/include/base/wx_stdev.h
View File

@ -118,6 +118,7 @@ class wxMouseEvent: public wxEvent
Bool shiftDown;
Bool altDown;
Bool metaDown;
Bool capsDown;
void CopyFrom(wxMouseEvent *src);
@ -191,10 +192,12 @@ class wxKeyEvent: public wxEvent
long otherKeyCode;
long altKeyCode;
long otherAltKeyCode;
long capsKeyCode;
Bool controlDown;
Bool shiftDown;
Bool altDown;
Bool metaDown;
Bool capsDown;
wxKeyEvent(WXTYPE keyType);

26
src/wxmac/src/mac/wx_app.cc
View File

@ -442,6 +442,7 @@ void wxApp::doMacMouseUp(void)
theMouseEvent->controlDown = FALSE;
theMouseEvent->altDown = cCurrentEvent.modifiers & optionKey;
theMouseEvent->metaDown = cCurrentEvent.modifiers & cmdKey;
theMouseEvent->capsDown = cCurrentEvent.modifiers & alphaLock;
theMouseEvent->x = hitX;
theMouseEvent->y = hitY;
theMouseEvent->timeStamp = SCALE_TIMESTAMP(cCurrentEvent.when);
@ -485,6 +486,7 @@ void wxApp::doMacMouseUp(void)
// altKey is optionKey on the mac platform:
theMouseEvent->altDown = cCurrentEvent.modifiers & optionKey;
theMouseEvent->metaDown = cCurrentEvent.modifiers & cmdKey;
theMouseEvent->capsDown = cCurrentEvent.modifiers & alphaLock;
theMouseEvent->x = hitX;
theMouseEvent->y = hitY;
theMouseEvent->timeStamp = SCALE_TIMESTAMP(cCurrentEvent.when);
@ -512,6 +514,7 @@ void wxApp::doMacMouseMotion(void)
theMouseEvent->controlDown = FALSE;
theMouseEvent->altDown = isAltKey;
theMouseEvent->metaDown = cCurrentEvent.modifiers & cmdKey;
theMouseEvent->capsDown = cCurrentEvent.modifiers & alphaLock;
theMouseEvent->timeStamp = SCALE_TIMESTAMP(cCurrentEvent.when);
if (wxWindow::gMouseWindow)
@ -575,6 +578,7 @@ void wxApp::doMacMouseLeave(void)
theMouseEvent->controlDown = FALSE;
theMouseEvent->altDown = isAltKey;
theMouseEvent->metaDown = cCurrentEvent.modifiers & cmdKey;
theMouseEvent->capsDown = cCurrentEvent.modifiers & alphaLock;
theMouseEvent->timeStamp = SCALE_TIMESTAMP(cCurrentEvent.when);
rc = (void *)cCurrentEvent.message;
@ -617,7 +621,7 @@ void wxApp::doMacKeyUpDown(Bool down)
{
wxFrame* theMacWxFrame;
wxKeyEvent *theKeyEvent;
int key, otherKey = 0, optKey = 0, otherOptKey = 0;
int key, otherKey = 0, optKey = 0, otherOptKey = 0, capsKey = 0;
theMacWxFrame = findMacWxFrame(MrEdKeyWindow());
@ -653,6 +657,7 @@ void wxApp::doMacKeyUpDown(Bool down)
// altKey is optionKey on the mac platform:
theKeyEvent->altDown = Bool(cCurrentEvent.modifiers & optionKey);
theKeyEvent->metaDown = Bool(cCurrentEvent.modifiers & cmdKey);
theKeyEvent->capsDown = Bool(cCurrentEvent.modifiers & alphaLock);
theKeyEvent->timeStamp = SCALE_TIMESTAMP(cCurrentEvent.when);
if (cCurrentEvent.what == wheelEvt) {
@ -674,7 +679,7 @@ void wxApp::doMacKeyUpDown(Bool down)
int iter, akey, orig_key = key;
key = 0; /* let compiler know that key is assigned */
for (iter = 0; iter < ((cCurrentEvent.modifiers & cmdKey) ? 4 : 1); iter++) {
for (iter = 0; iter < ((cCurrentEvent.modifiers & cmdKey) ? 5 : 1); iter++) {
char cstr[3];
int from_str = 0;
@ -695,10 +700,18 @@ void wxApp::doMacKeyUpDown(Bool down)
static UCKeyboardLayout *key_layout;
mods = cCurrentEvent.modifiers;
/* Strip Caps Lock and Shift when Control is pressed. */
if (mods & (controlKey & wxMacDisableMods))
mods -= (mods & (alphaLock | shiftKey));
if (mods & cmdKey) {
int mask;
/* Strip control modifier when command is pressed: */
mods -= (mods & (controlKey | cmdKey));
if (iter && (iter != 4)) {
mods -= (mods & alphaLock);
}
/* On all but first iteration, toggle shift and/or option: */
switch (iter) {
case 0:
@ -710,10 +723,13 @@ void wxApp::doMacKeyUpDown(Bool down)
case 2:
mask = optionKey;
break;
default:
case 3:
mask = optionKey | shiftKey;
break;
default:
case 4:
mask = alphaLock;
break;
}
mods = (mods & (~mask)) | ((~mods) & mask);
} else {
@ -815,6 +831,8 @@ void wxApp::doMacKeyUpDown(Bool down)
optKey = akey;
else if (iter == 3)
otherOptKey = akey;
else if (iter == 4)
capsKey = akey;
}
}
}
@ -829,6 +847,7 @@ void wxApp::doMacKeyUpDown(Bool down)
theKeyEvent->otherKeyCode = otherKey;
theKeyEvent->altKeyCode = optKey;
theKeyEvent->otherAltKeyCode = otherOptKey;
theKeyEvent->capsKeyCode = capsKey;
{
wxWindow *in_win;
@ -1235,6 +1254,7 @@ void wxApp::doMacContentClick(wxFrame* frame)
theMouseEvent->controlDown = FALSE;
theMouseEvent->altDown = isAltKey;
theMouseEvent->metaDown = cCurrentEvent.modifiers & cmdKey;
theMouseEvent->capsDown = cCurrentEvent.modifiers & alphaLock;
theMouseEvent->timeStamp = SCALE_TIMESTAMP(cCurrentEvent.when);
hitX = cCurrentEvent.where.h; // screen window c.s.

3
src/wxwindow/include/base/wx_stdev.h
View File

@ -113,6 +113,7 @@ class wxMouseEvent: public wxEvent
Bool shiftDown;
Bool altDown;
Bool metaDown;
Bool capsDown;
wxMouseEvent(WXTYPE mouseType = 0);
@ -186,10 +187,12 @@ class wxKeyEvent: public wxEvent
long otherKeyCode;
long altKeyCode;
long otherAltKeyCode;
long capsKeyCode;
Bool controlDown;
Bool shiftDown;
Bool altDown;
Bool metaDown;
Bool capsDown;
wxKeyEvent(WXTYPE keyType = 0);

27
src/wxwindow/src/msw/wx_win.cxx
View File

@ -1800,6 +1800,11 @@ int wxWnd::OnButton(int x, int y, UINT flags, int evttype, int for_nc)
event->leftDown = (flags & MK_LBUTTON);
event->middleDown = (flags & MK_MBUTTON);
event->rightDown = (flags & MK_RBUTTON);
{
int cd;
cd = (::GetKeyState(VK_CAPITAL) >> 1);
event->capsDown = cd;
}
event->SetTimestamp(last_msg_time);
if (!for_nc && wx_window && (is_canvas || is_panel)) {
@ -1945,6 +1950,11 @@ int wxWnd::OnMouseMove(int x, int y, UINT flags, int for_nc)
event->leftDown = (flags & MK_LBUTTON);
event->middleDown = (flags & MK_MBUTTON);
event->rightDown = (flags & MK_RBUTTON);
{
int cd;
cd = (::GetKeyState(VK_CAPITAL) >> 1);
event->capsDown = cd;
}
event->SetTimestamp(last_msg_time);
// Window gets a click down message followed by a mouse move
@ -1992,6 +2002,11 @@ static void wxDoOnMouseEnter(wxWindow *wx_window, int x, int y, UINT flags)
event->leftDown = (flags & MK_LBUTTON);
event->middleDown = (flags & MK_MBUTTON);
event->rightDown = (flags & MK_RBUTTON);
{
int cd;
cd = (::GetKeyState(VK_CAPITAL) >> 1);
event->capsDown = cd;
}
event->SetTimestamp(last_msg_time);
if (!wx_window->CallPreOnEvent(wx_window->PreWindow(), event))
@ -2019,6 +2034,11 @@ static void wxDoOnMouseLeave(wxWindow *wx_window, int x, int y, UINT flags)
event->leftDown = (flags & MK_LBUTTON);
event->middleDown = (flags & MK_MBUTTON);
event->rightDown = (flags & MK_RBUTTON);
{
int cd;
cd = (::GetKeyState(VK_CAPITAL) >> 1);
event->capsDown = cd;
}
event->SetTimestamp(last_msg_time);
if (!wx_window->CallPreOnEvent(wx_window->PreWindow(), event))
@ -2061,10 +2081,11 @@ static void init_sakc()
wxKeyEvent *wxMakeCharEvent(BOOL just_check, WORD wParam, LPARAM lParam, Bool isASCII, Bool isRelease, HWND handle)
{
int id, other_id = 0, other_alt_id = 0, alt_id = 0;
Bool tempControlDown, tempAltDown, tempShiftDown;
Bool tempControlDown, tempAltDown, tempShiftDown, tempCapsDown;
tempControlDown = (::GetKeyState(VK_CONTROL) >> 1);
tempShiftDown = (::GetKeyState(VK_SHIFT) >> 1);
tempCapsDown = (::GetKeyState(VK_CAPITAL) >> 1);
tempAltDown = ((HIWORD(lParam) & KF_ALTDOWN) == KF_ALTDOWN);
if (isASCII) {
@ -2211,6 +2232,8 @@ wxKeyEvent *wxMakeCharEvent(BOOL just_check, WORD wParam, LPARAM lParam, Bool is
event->controlDown = TRUE;
if (tempAltDown)
event->metaDown = TRUE;
if (tempCapsDown)
event->capsDown = TRUE;
event->keyCode = (isRelease ? WXK_RELEASE : id);
event->keyUpCode = (isRelease ? id : WXK_PRESS);

3
src/wxxt/src/EventHandling/wx_stdev.h
View File

@ -58,6 +58,7 @@ class wxMouseEvent: public wxEvent
Bool shiftDown;
Bool altDown;
Bool metaDown;
Bool capsDown;
wxMouseEvent(WXTYPE mouseType = 0);
@ -131,10 +132,12 @@ class wxKeyEvent: public wxEvent
long otherKeyCode;
long altKeyCode;
long otherAltKeyCode;
long capsKeyCode;
Bool controlDown;
Bool shiftDown;
Bool altDown;
Bool metaDown;
Bool capsDown;
wxKeyEvent(WXTYPE keyType = 0);

50
src/wxxt/src/Windows/Window.cc
View File

@ -1054,11 +1054,12 @@ void wxWindow::OnChar(wxKeyEvent* wxevent)
xev->xkey.keycode = kc;
xev->xkey.x = (int)wxevent->x;
xev->xkey.y = (int)wxevent->y;
xev->xkey.state &= ~(ShiftMask | ControlMask | Mod1Mask | Mod3Mask);
xev->xkey.state &= ~(ShiftMask | ControlMask | Mod1Mask | Mod3Mask | LockMask);
xev->xkey.state |= (wxevent->altDown ? Mod3Mask : 0) |
(wxevent->controlDown ? ControlMask : 0) |
(wxevent->metaDown ? Mod1Mask : 0) |
(wxevent->shiftDown ? ShiftMask : 0);
(wxevent->shiftDown ? ShiftMask : 0) |
(wxevent->capsDown ? LockMask : 0);
// call Widget methods to handle this event
_XtTranslateEvent(X->handle, xev);
}
@ -1785,7 +1786,7 @@ static int extract_string_key(char *str, int slen)
#endif
}
Status wxWindow::LookupKey(int unshifted, int unalted,
Status wxWindow::LookupKey(int unshifted, int unalted, int caps_mode,
Widget w, wxWindow *win, XEvent *xev, KeySym *_keysym, char *str, int *_len)
{
KeySym keysym;
@ -1794,6 +1795,12 @@ Status wxWindow::LookupKey(int unshifted, int unalted,
XKeyPressedEvent evt;
memcpy(&evt, &(xev->xkey), sizeof(XKeyPressedEvent));
if ((evt.state & ControlMask) && !(evt.state & Mod1Mask)) {
/* Control (and not AltGr) => cancel Shift and Caps Lock */
evt.state -= (evt.state & (ShiftMask | LockMask));
}
if (unshifted) {
if (evt.state & ShiftMask)
evt.state -= ShiftMask;
@ -1812,6 +1819,13 @@ Status wxWindow::LookupKey(int unshifted, int unalted,
evt.state |= ControlMask;
}
}
if (caps_mode != 1) {
if (evt.state & LockMask)
evt.state -= LockMask;
else if (caps_mode == 2) {
evt.state |= LockMask;
}
}
#ifndef NO_XMB_LOOKUP_STRING
if (!the_im) {
@ -1925,18 +1939,19 @@ void wxWindow::WindowEventHandler(Widget w,
win->current_state = xev->xkey.state;
{ /* ^^^ fallthrough !!!! ^^^ */
wxKeyEvent *wxevent;
KeySym keysym, other_keysym, alt_keysym, other_alt_keysym;
long kc, other_kc, alt_kc, other_alt_kc;
Status status, other_status, alt_status, other_alt_status;
char str[10], other_str[10], alt_str[10], other_alt_str[10];
int slen, other_slen, alt_slen, other_alt_slen;
KeySym keysym, other_keysym, alt_keysym, other_alt_keysym, caps_keysym;
long kc, other_kc, alt_kc, other_alt_kc, caps_kc;
Status status, other_status, alt_status, other_alt_status, caps_status;
char str[10], other_str[10], alt_str[10], other_alt_str[10], caps_str[10];
int slen, other_slen, alt_slen, other_alt_slen, caps_slen;
wxevent = new wxKeyEvent(wxEVENT_TYPE_CHAR);
status = LookupKey(0, 0, w, win, xev, &keysym, str, &slen);
other_status = LookupKey(1, 0, w, win, xev, &other_keysym, other_str, &other_slen);
alt_status = LookupKey(0, 1, w, win, xev, &alt_keysym, alt_str, &alt_slen);
other_alt_status = LookupKey(1, 1, w, win, xev, &other_alt_keysym, other_alt_str, &other_alt_slen);
status = LookupKey(0, 0, 1, w, win, xev, &keysym, str, &slen);
other_status = LookupKey(1, 0, 0, w, win, xev, &other_keysym, other_str, &other_slen);
alt_status = LookupKey(0, 1, 0, w, win, xev, &alt_keysym, alt_str, &alt_slen);
other_alt_status = LookupKey(1, 1, 0, w, win, xev, &other_alt_keysym, other_alt_str, &other_alt_slen);
caps_status = LookupKey(0, 0, 2, w, win, xev, &caps_keysym, caps_str, &caps_slen);
if (xev->xany.type == KeyPress) {
static int handle_alt = 0;
@ -1959,6 +1974,7 @@ void wxWindow::WindowEventHandler(Widget w,
other_kc = status_to_kc(other_status, xev, other_keysym, other_str, other_slen);
alt_kc = status_to_kc(alt_status, xev, alt_keysym, alt_str, alt_slen);
other_alt_kc = status_to_kc(other_alt_status, xev, other_alt_keysym, other_alt_str, other_alt_slen);
caps_kc = status_to_kc(caps_status, xev, caps_keysym, caps_str, caps_slen);
/* Figure out key state *after* event: */
{
@ -1984,13 +2000,15 @@ void wxWindow::WindowEventHandler(Widget w,
wxevent->otherKeyCode = other_kc;
wxevent->altKeyCode = alt_kc;
wxevent->otherAltKeyCode = other_alt_kc;
wxevent->capsKeyCode = caps_kc;
wxevent->x = xev->xkey.x;
wxevent->y = xev->xkey.y;
wxevent->altDown = /* xev->xkey.state & Mod3Mask */ FALSE;
wxevent->controlDown = xev->xkey.state & ControlMask;
wxevent->metaDown = xev->xkey.state & Mod1Mask;
wxevent->shiftDown = xev->xkey.state & ShiftMask;
wxevent->timeStamp = xev->xkey.time; /* MATTHEW */
wxevent->capsDown = xev->xkey.state & LockMask;
wxevent->timeStamp = xev->xkey.time;
/* Reverse scroll effects: */
if (wxSubType(win->__type, wxTYPE_CANVAS)) {
@ -2077,6 +2095,7 @@ void wxWindow::WindowEventHandler(Widget w,
wxevent->controlDown = xev->xbutton.state & ControlMask;
wxevent->metaDown = xev->xbutton.state & Mod1Mask;
wxevent->shiftDown = xev->xbutton.state & ShiftMask;
wxevent->capsDown = xev->xbutton.state & LockMask;
wxevent->timeStamp = xev->xbutton.time;
*continue_to_dispatch_return = FALSE;
@ -2161,6 +2180,7 @@ void wxWindow::WindowEventHandler(Widget w,
wxevent->controlDown = xev->xbutton.state & ControlMask;
wxevent->metaDown = xev->xbutton.state & Mod1Mask;
wxevent->shiftDown = xev->xbutton.state & ShiftMask;
wxevent->capsDown = xev->xbutton.state & LockMask;
wxevent->leftDown = ((wxevent->eventType == wxEVENT_TYPE_LEFT_DOWN)
|| (xev->xbutton.state & Button1Mask));
wxevent->middleDown = ((wxevent->eventType == wxEVENT_TYPE_MIDDLE_DOWN)
@ -2234,6 +2254,7 @@ void wxWindow::WindowEventHandler(Widget w,
wxevent->controlDown = xev->xcrossing.state & ControlMask;
wxevent->metaDown = xev->xcrossing.state & Mod1Mask;
wxevent->shiftDown = xev->xcrossing.state & ShiftMask;
wxevent->capsDown = xev->xcrossing.state & LockMask;
wxevent->leftDown = xev->xcrossing.state & Button1Mask;
wxevent->middleDown = xev->xcrossing.state & Button2Mask;
wxevent->rightDown = xev->xcrossing.state & Button3Mask;
@ -2283,10 +2304,11 @@ void wxWindow::WindowEventHandler(Widget w,
wxevent->controlDown = xev->xmotion.state & ControlMask;
wxevent->metaDown = xev->xmotion.state & Mod1Mask;
wxevent->shiftDown = xev->xmotion.state & ShiftMask;
wxevent->capsDown = xev->xmotion.state & LockMask;
wxevent->leftDown = xev->xmotion.state & Button1Mask;
wxevent->middleDown = xev->xmotion.state & Button2Mask;
wxevent->rightDown = xev->xmotion.state & Button3Mask;
wxevent->timeStamp = xev->xbutton.time; /* MATTHEW */
wxevent->timeStamp = xev->xbutton.time;
*continue_to_dispatch_return = FALSE; /* Event was handled by OnEvent */
/* Reverse scroll effects: */

2
src/wxxt/src/Windows/Window.h
View File

@ -195,7 +195,7 @@ protected:
static void WindowEventHandler(Widget w, wxWindow **win,
XEvent *ev, Boolean *continue_to_dispatch_return);
static void ScrollEventHandler(Widget w, wxWindow **win, XtPointer p_XfwfScrollInfo);
static Status LookupKey(int unshifted, int unalted,
static Status LookupKey(int unshifted, int unalted, int caps_mode,
Widget w, wxWindow *win, XEvent *xev, KeySym *_keysym, char *s, int *_len);
void RegisterAll(Widget ww);
wxWindow *FindChildByWidget(Widget w);