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

Now that the C code is back at a compile-ready point, I'll check in.

Browse Source 
svn: r18306
This commit is contained in:
Stevie Strickland 2010-02-23 20:57:22 +00:00
parent 472ef1e873
commit e1cd160a40
25 changed files with 153 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -78,9 +78,9 @@
(syntax
(define name (let ([c (dynamic-require ''#%mred-kernel 'name)])
(make-primitive-class
(lambda (class prop:object preparer dispatcher unwrapper more-props)
(lambda (class prop:object preparer dispatcher prop:unwrap unwrapper more-props)
(kernel:primitive-class-prepare-struct-type!
c prop:object class preparer dispatcher unwrapper more-props))
c prop:object class preparer dispatcher prop:unwrap unwrapper more-props))
kernel:initialize-primitive-object
'print-name super (list intf ...) 'args
'(old ...)

52
collects/scheme/private/class-internal.ss
View File

@ -209,10 +209,9 @@
(lambda (o v) (set! o 0 v))
struct:wrapper-object)))
;; unwrap-object : (union wrapper-object object) -> object
;; wrapped objects can only be one level deep, so just do a quick check and unwrap.
(define (unwrap-object o)
(if (wrapper-object? o) (wrapper-object-wrapped o) o))
(define-values (prop:unwrap object-unwrapper)
(let-values ([(prop:unwrap pred acc) (make-struct-type-property 'prop:unwrap)])
(values prop:unwrap acc)))
;;--------------------------------------------------------------------
;; class macros
@ -1185,7 +1184,7 @@
(make-field-map trace-flag
(quote-syntax the-finder)
(quote the-obj)
(quote-syntax unwrap-object)
(quote-syntax (λ (o) ((object-unwrapper o) o)))
(quote-syntax inherit-field-name)
(quote-syntax inherit-field-name-localized)
(quote-syntax inherit-field-accessor)
@ -1195,7 +1194,7 @@
(make-field-map trace-flag
(quote-syntax the-finder)
(quote the-obj)
(quote-syntax unwrap-object)
(quote-syntax (λ (o) ((object-unwrapper o) o)))
(quote-syntax local-field)
(quote-syntax local-field-localized)
(quote-syntax local-field-accessor)
@ -2124,7 +2123,10 @@
;; --- Make the new object struct ---
(let*-values ([(prim-object-make prim-object? struct:prim-object)
(if make-struct:prim
(make-struct:prim c prop:object preparer dispatcher unwrap-object (get-properties interfaces))
(make-struct:prim c prop:object
preparer dispatcher
prop:unwrap values
(get-properties interfaces))
(values #f #f #f))]
[(struct:object object-make object? object-field-ref object-field-set!)
(if make-struct:prim
@ -2139,6 +2141,7 @@
;; Map object property to class:
(append
(list (cons prop:object c))
(list (cons prop:unwrap values))
(if deserialize-id
(list
(cons prop:serializable
@ -2680,7 +2683,8 @@
0 ;; No new fields in this class replacement
undefined
;; Map object property to class:
(list (cons prop:object c)))])
(list (cons prop:object c)
(cons prop:unwrap values)))])
(set-class-struct:object! c struct:object)
(set-class-object?! c object?)
(set-class-make-object! c object-make)
@ -3306,7 +3310,8 @@
(vector-set! (class-supers object%) 0 object%)
(set-class-orig-cls! object% object%)
(let*-values ([(struct:obj make-obj obj? -get -set!)
(make-struct-type 'object #f 0 0 #f (list (cons prop:object object%)) #f)])
(make-struct-type 'object #f 0 0 #f (list (cons prop:object object%)
(cons prop:unwrap values)) #f)])
(set-class-struct:object! object% struct:obj)
(set-class-make-object! object% make-obj))
(set-class-object?! object% object?) ; don't use struct pred; it wouldn't work with prim classes
@ -3598,7 +3603,7 @@
traced?
stx
(syntax/loc stx receiver)
(syntax/loc stx unwrap-object)
(syntax/loc stx (λ (o) ((object-unwrapper o) o)))
(syntax/loc stx method)
(syntax/loc stx sym)
args
@ -3761,7 +3766,7 @@
traced?
stx
(syntax obj)
(syntax/loc stx unwrap-object)
(syntax/loc stx (λ (o) ((object-unwrapper o) o)))
(syntax/loc stx ((generic-applicable gen) obj))
(syntax/loc stx (generic-name gen))
flat-stx
@ -3843,7 +3848,7 @@
[field-ht (class-field-ht cls)]
[index (hash-ref field-ht id #f)])
(if index
((vector-ref (class-ext-field-sets cls) index) (unwrap-object obj) val)
((vector-ref (class-ext-field-sets cls) index) ((object-unwrapper obj) obj) val)
(raise-mismatch-error
'get-field
(format "expected an object that has a field named ~s, got " id)
@ -3879,7 +3884,7 @@
[field-ht (class-field-ht cls)]
[index (hash-ref field-ht id #f)])
(if index
((vector-ref (class-ext-field-refs cls) index) (unwrap-object obj))
((vector-ref (class-ext-field-refs cls) index) ((object-unwrapper obj) obj))
(raise-mismatch-error
'get-field
(format "expected an object that has a field named ~s, got " id)
@ -3965,7 +3970,7 @@
(quote-syntax id)
(quote-syntax method)
(quote-syntax method-obj)
(syntax unwrap-object))]
(syntax (λ (o) ((object-unwrapper o) o))))]
...)
()
body0 body1 ...)))))]
@ -4018,10 +4023,10 @@
(trace (when (object? v)
(inspect-event v)))
(cond
[(class? c) ((class-object? (class-orig-cls c)) (unwrap-object v))]
[(class? c) ((class-object? (class-orig-cls c)) ((object-unwrapper v) v))]
[(interface? c)
(and (object? v)
(implementation? (object-ref (unwrap-object v)) c))]
(implementation? (object-ref ((object-unwrapper v) v)) c))]
[else (raise-type-error 'is-a? "class or interface" 1 v c)])))
(define (subclass? v c)
@ -4039,7 +4044,7 @@
(raise-type-error 'object-interface "object" o))
(trace-begin
(trace (inspect-event o))
(class-self-interface (object-ref (unwrap-object o)))))
(class-self-interface (object-ref ((object-unwrapper o) o)))))
(define-traced (object-method-arity-includes? o name cnt)
(unless (object? o)
@ -4098,7 +4103,7 @@
(raise-type-error 'object-info "object" o))
(trace-begin
(trace (inspect-event o))
(let loop ([c (object-ref (unwrap-object o))]
(let loop ([c (object-ref ((object-unwrapper o) o))]
[skipped? #f])
(if (struct? ((class-insp-mk c)))
;; current inspector can inspect this object
@ -4138,7 +4143,7 @@
(raise-type-error 'object->vector "object" in-o))
(trace-begin
(trace (inspect-event in-o))
(let ([o (unwrap-object in-o)])
(let ([o ((object-unwrapper in-o) in-o)])
(list->vector
(cons
(string->symbol (format "object:~a" (class-name (object-ref o))))
@ -4165,8 +4170,8 @@
(raise-type-error 'object=? "object" o1))
(unless (object? o2)
(raise-type-error 'object=? "object" o2))
(eq? (unwrap-object o1)
(unwrap-object o2)))
(eq? ((object-unwrapper o1) o1)
((object-unwrapper o2) o2)))
;;--------------------------------------------------------------------
;; primitive classes
@ -4334,7 +4339,8 @@
0 ;; No new fields in this wrapped object
undefined
;; Map object property to class:
(list (cons prop:object c)))])
(list (cons prop:object c)
(cons prop:unwrap wrapper-object-wrapped)))])
(set-class-struct:object! c struct:object)
(set-class-object?! c object?)
(set-class-make-object! c object-make)
@ -4382,7 +4388,7 @@
(define (make-wrapper-object obj blame methods method-contracts fields field-contracts)
(check-object-contract obj blame methods fields)
(let ([new-cls (make-wrapper-class (object-ref obj) blame methods method-contracts fields field-contracts)])
((class-make-object new-cls) (unwrap-object obj))))
((class-make-object new-cls) ((object-unwrapper obj) obj))))
;;--------------------------------------------------------------------
;; misc utils

4
src/mred/wxs/wxs_bmap.cxx
View File

@ -659,7 +659,7 @@ int objscheme_istype_wxBitmap(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxBitmap_class);
if (objscheme_is_a(obj, os_wxBitmap_class))
return 1;
else {
@ -703,7 +703,7 @@ class wxBitmap *objscheme_unbundle_wxBitmap(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxBitmap_class);
(void)objscheme_istype_wxBitmap(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_butn.cxx
View File

@ -796,7 +796,7 @@ int objscheme_istype_wxButton(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxButton_class);
if (objscheme_is_a(obj, os_wxButton_class))
return 1;
else {
@ -840,7 +840,7 @@ class wxButton *objscheme_unbundle_wxButton(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxButton_class);
(void)objscheme_istype_wxButton(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_chce.cxx
View File

@ -899,7 +899,7 @@ int objscheme_istype_wxChoice(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxChoice_class);
if (objscheme_is_a(obj, os_wxChoice_class))
return 1;
else {
@ -943,7 +943,7 @@ class wxChoice *objscheme_unbundle_wxChoice(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxChoice_class);
(void)objscheme_istype_wxChoice(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_ckbx.cxx
View File

@ -821,7 +821,7 @@ int objscheme_istype_wxCheckBox(Scheme_Object *obj, const char *stop, int nullOK
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxCheckBox_class);
if (objscheme_is_a(obj, os_wxCheckBox_class))
return 1;
else {
@ -865,7 +865,7 @@ class wxCheckBox *objscheme_unbundle_wxCheckBox(Scheme_Object *obj, const char *
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxCheckBox_class);
(void)objscheme_istype_wxCheckBox(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_cnvs.cxx
View File

@ -1419,7 +1419,7 @@ int objscheme_istype_wxCanvas(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxCanvas_class);
if (objscheme_is_a(obj, os_wxCanvas_class))
return 1;
else {
@ -1463,7 +1463,7 @@ class wxCanvas *objscheme_unbundle_wxCanvas(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxCanvas_class);
(void)objscheme_istype_wxCanvas(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

24
src/mred/wxs/wxs_dc.cxx
View File

@ -2664,7 +2664,7 @@ int objscheme_istype_wxDC(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxDC_class);
if (objscheme_is_a(obj, os_wxDC_class))
return 1;
else {
@ -2708,7 +2708,7 @@ class wxDC *objscheme_unbundle_wxDC(Scheme_Object *obj, const char *where, int n
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxDC_class);
(void)objscheme_istype_wxDC(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -3116,7 +3116,7 @@ int objscheme_istype_wxMemoryDC(Scheme_Object *obj, const char *stop, int nullOK
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMemoryDC_class);
if (objscheme_is_a(obj, os_wxMemoryDC_class))
return 1;
else {
@ -3160,7 +3160,7 @@ class wxMemoryDC *objscheme_unbundle_wxMemoryDC(Scheme_Object *obj, const char *
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMemoryDC_class);
(void)objscheme_istype_wxMemoryDC(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -3281,7 +3281,7 @@ int objscheme_istype_wxPostScriptDC(Scheme_Object *obj, const char *stop, int nu
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPostScriptDC_class);
if (objscheme_is_a(obj, os_wxPostScriptDC_class))
return 1;
else {
@ -3325,7 +3325,7 @@ class wxPostScriptDC *objscheme_unbundle_wxPostScriptDC(Scheme_Object *obj, cons
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPostScriptDC_class);
(void)objscheme_istype_wxPostScriptDC(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -3467,7 +3467,7 @@ int objscheme_istype_basePrinterDC(Scheme_Object *obj, const char *stop, int nul
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_basePrinterDC_class);
if (objscheme_is_a(obj, os_basePrinterDC_class))
return 1;
else {
@ -3511,7 +3511,7 @@ class basePrinterDC *objscheme_unbundle_basePrinterDC(Scheme_Object *obj, const
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_basePrinterDC_class);
(void)objscheme_istype_basePrinterDC(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -3671,7 +3671,7 @@ int objscheme_istype_wxGL(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxGL_class);
if (objscheme_is_a(obj, os_wxGL_class))
return 1;
else {
@ -3715,7 +3715,7 @@ class wxGL *objscheme_unbundle_wxGL(Scheme_Object *obj, const char *where, int n
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxGL_class);
(void)objscheme_istype_wxGL(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -4029,7 +4029,7 @@ int objscheme_istype_wxGLConfig(Scheme_Object *obj, const char *stop, int nullOK
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxGLConfig_class);
if (objscheme_is_a(obj, os_wxGLConfig_class))
return 1;
else {
@ -4073,7 +4073,7 @@ class wxGLConfig *objscheme_unbundle_wxGLConfig(Scheme_Object *obj, const char *
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxGLConfig_class);
(void)objscheme_istype_wxGLConfig(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

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

@ -232,7 +232,7 @@ int objscheme_istype_wxEvent(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxEvent_class);
if (objscheme_is_a(obj, os_wxEvent_class))
return 1;
else {
@ -275,7 +275,7 @@ class wxEvent *objscheme_unbundle_wxEvent(Scheme_Object *obj, const char *where,
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxEvent_class);
(void)objscheme_istype_wxEvent(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -502,7 +502,7 @@ int objscheme_istype_wxCommandEvent(Scheme_Object *obj, const char *stop, int nu
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxCommandEvent_class);
if (objscheme_is_a(obj, os_wxCommandEvent_class))
return 1;
else {
@ -545,7 +545,7 @@ class wxCommandEvent *objscheme_unbundle_wxCommandEvent(Scheme_Object *obj, cons
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxCommandEvent_class);
(void)objscheme_istype_wxCommandEvent(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -682,7 +682,7 @@ int objscheme_istype_wxPopupEvent(Scheme_Object *obj, const char *stop, int null
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPopupEvent_class);
if (objscheme_is_a(obj, os_wxPopupEvent_class))
return 1;
else {
@ -725,7 +725,7 @@ class wxPopupEvent *objscheme_unbundle_wxPopupEvent(Scheme_Object *obj, const ch
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPopupEvent_class);
(void)objscheme_istype_wxPopupEvent(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1041,7 +1041,7 @@ int objscheme_istype_wxScrollEvent(Scheme_Object *obj, const char *stop, int nul
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxScrollEvent_class);
if (objscheme_is_a(obj, os_wxScrollEvent_class))
return 1;
else {
@ -1084,7 +1084,7 @@ class wxScrollEvent *objscheme_unbundle_wxScrollEvent(Scheme_Object *obj, const
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxScrollEvent_class);
(void)objscheme_istype_wxScrollEvent(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -2119,7 +2119,7 @@ int objscheme_istype_wxKeyEvent(Scheme_Object *obj, const char *stop, int nullOK
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxKeyEvent_class);
if (objscheme_is_a(obj, os_wxKeyEvent_class))
return 1;
else {
@ -2162,7 +2162,7 @@ class wxKeyEvent *objscheme_unbundle_wxKeyEvent(Scheme_Object *obj, const char *
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxKeyEvent_class);
(void)objscheme_istype_wxKeyEvent(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -3019,7 +3019,7 @@ int objscheme_istype_wxMouseEvent(Scheme_Object *obj, const char *stop, int null
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMouseEvent_class);
if (objscheme_is_a(obj, os_wxMouseEvent_class))
return 1;
else {
@ -3062,7 +3062,7 @@ class wxMouseEvent *objscheme_unbundle_wxMouseEvent(Scheme_Object *obj, const ch
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMouseEvent_class);
(void)objscheme_istype_wxMouseEvent(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_fram.cxx
View File

@ -1448,7 +1448,7 @@ int objscheme_istype_wxFrame(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxFrame_class);
if (objscheme_is_a(obj, os_wxFrame_class))
return 1;
else {
@ -1492,7 +1492,7 @@ class wxFrame *objscheme_unbundle_wxFrame(Scheme_Object *obj, const char *where,
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxFrame_class);
(void)objscheme_istype_wxFrame(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_gage.cxx
View File

@ -756,7 +756,7 @@ int objscheme_istype_wxsGauge(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxsGauge_class);
if (objscheme_is_a(obj, os_wxsGauge_class))
return 1;
else {
@ -800,7 +800,7 @@ class wxsGauge *objscheme_unbundle_wxsGauge(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxsGauge_class);
(void)objscheme_istype_wxsGauge(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

52
src/mred/wxs/wxs_gdi.cxx
View File

@ -686,7 +686,7 @@ int objscheme_istype_wxFont(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxFont_class);
if (objscheme_is_a(obj, os_wxFont_class))
return 1;
else {
@ -730,7 +730,7 @@ class wxFont *objscheme_unbundle_wxFont(Scheme_Object *obj, const char *where, i
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxFont_class);
(void)objscheme_istype_wxFont(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -934,7 +934,7 @@ int objscheme_istype_wxFontList(Scheme_Object *obj, const char *stop, int nullOK
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxFontList_class);
if (objscheme_is_a(obj, os_wxFontList_class))
return 1;
else {
@ -978,7 +978,7 @@ class wxFontList *objscheme_unbundle_wxFontList(Scheme_Object *obj, const char *
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxFontList_class);
(void)objscheme_istype_wxFontList(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1320,7 +1320,7 @@ int objscheme_istype_wxColour(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxColour_class);
if (objscheme_is_a(obj, os_wxColour_class))
return 1;
else {
@ -1364,7 +1364,7 @@ class wxColour *objscheme_unbundle_wxColour(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxColour_class);
(void)objscheme_istype_wxColour(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1461,7 +1461,7 @@ int objscheme_istype_wxColourDatabase(Scheme_Object *obj, const char *stop, int
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxColourDatabase_class);
if (objscheme_is_a(obj, os_wxColourDatabase_class))
return 1;
else {
@ -1505,7 +1505,7 @@ class wxColourDatabase *objscheme_unbundle_wxColourDatabase(Scheme_Object *obj,
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxColourDatabase_class);
(void)objscheme_istype_wxColourDatabase(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1710,7 +1710,7 @@ int objscheme_istype_wxPoint(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPoint_class);
if (objscheme_is_a(obj, os_wxPoint_class))
return 1;
else {
@ -1753,7 +1753,7 @@ class wxPoint *objscheme_unbundle_wxPoint(Scheme_Object *obj, const char *where,
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPoint_class);
(void)objscheme_istype_wxPoint(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -2274,7 +2274,7 @@ int objscheme_istype_wxBrush(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxBrush_class);
if (objscheme_is_a(obj, os_wxBrush_class))
return 1;
else {
@ -2318,7 +2318,7 @@ class wxBrush *objscheme_unbundle_wxBrush(Scheme_Object *obj, const char *where,
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxBrush_class);
(void)objscheme_istype_wxBrush(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -2471,7 +2471,7 @@ int objscheme_istype_wxBrushList(Scheme_Object *obj, const char *stop, int nullO
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxBrushList_class);
if (objscheme_is_a(obj, os_wxBrushList_class))
return 1;
else {
@ -2515,7 +2515,7 @@ class wxBrushList *objscheme_unbundle_wxBrushList(Scheme_Object *obj, const char
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxBrushList_class);
(void)objscheme_istype_wxBrushList(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -3085,7 +3085,7 @@ int objscheme_istype_wxPen(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPen_class);
if (objscheme_is_a(obj, os_wxPen_class))
return 1;
else {
@ -3129,7 +3129,7 @@ class wxPen *objscheme_unbundle_wxPen(Scheme_Object *obj, const char *where, int
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPen_class);
(void)objscheme_istype_wxPen(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -3287,7 +3287,7 @@ int objscheme_istype_wxPenList(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPenList_class);
if (objscheme_is_a(obj, os_wxPenList_class))
return 1;
else {
@ -3331,7 +3331,7 @@ class wxPenList *objscheme_unbundle_wxPenList(Scheme_Object *obj, const char *wh
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPenList_class);
(void)objscheme_istype_wxPenList(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -3600,7 +3600,7 @@ int objscheme_istype_wxCursor(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxCursor_class);
if (objscheme_is_a(obj, os_wxCursor_class))
return 1;
else {
@ -3644,7 +3644,7 @@ class wxCursor *objscheme_unbundle_wxCursor(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxCursor_class);
(void)objscheme_istype_wxCursor(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -4334,7 +4334,7 @@ int objscheme_istype_wxRegion(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxRegion_class);
if (objscheme_is_a(obj, os_wxRegion_class))
return 1;
else {
@ -4378,7 +4378,7 @@ class wxRegion *objscheme_unbundle_wxRegion(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxRegion_class);
(void)objscheme_istype_wxRegion(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -4953,7 +4953,7 @@ int objscheme_istype_wxPath(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPath_class);
if (objscheme_is_a(obj, os_wxPath_class))
return 1;
else {
@ -4997,7 +4997,7 @@ class wxPath *objscheme_unbundle_wxPath(Scheme_Object *obj, const char *where, i
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPath_class);
(void)objscheme_istype_wxPath(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -5313,7 +5313,7 @@ int objscheme_istype_wxFontNameDirectory(Scheme_Object *obj, const char *stop, i
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxFontNameDirectory_class);
if (objscheme_is_a(obj, os_wxFontNameDirectory_class))
return 1;
else {
@ -5357,7 +5357,7 @@ class wxFontNameDirectory *objscheme_unbundle_wxFontNameDirectory(Scheme_Object
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxFontNameDirectory_class);
(void)objscheme_istype_wxFontNameDirectory(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

8
src/mred/wxs/wxs_item.cxx
View File

@ -164,7 +164,7 @@ int objscheme_istype_wxItem(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxItem_class);
if (objscheme_is_a(obj, os_wxItem_class))
return 1;
else {
@ -208,7 +208,7 @@ class wxItem *objscheme_unbundle_wxItem(Scheme_Object *obj, const char *where, i
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxItem_class);
(void)objscheme_istype_wxItem(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1027,7 +1027,7 @@ int objscheme_istype_wxMessage(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMessage_class);
if (objscheme_is_a(obj, os_wxMessage_class))
return 1;
else {
@ -1071,7 +1071,7 @@ class wxMessage *objscheme_unbundle_wxMessage(Scheme_Object *obj, const char *wh
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMessage_class);
(void)objscheme_istype_wxMessage(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_lbox.cxx
View File

@ -1264,7 +1264,7 @@ int objscheme_istype_wxListBox(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxListBox_class);
if (objscheme_is_a(obj, os_wxListBox_class))
return 1;
else {
@ -1308,7 +1308,7 @@ class wxListBox *objscheme_unbundle_wxListBox(Scheme_Object *obj, const char *wh
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxListBox_class);
(void)objscheme_istype_wxListBox(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

12
src/mred/wxs/wxs_menu.cxx
View File

@ -586,7 +586,7 @@ int objscheme_istype_wxMenu(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMenu_class);
if (objscheme_is_a(obj, os_wxMenu_class))
return 1;
else {
@ -630,7 +630,7 @@ class wxMenu *objscheme_unbundle_wxMenu(Scheme_Object *obj, const char *where, i
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMenu_class);
(void)objscheme_istype_wxMenu(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -899,7 +899,7 @@ int objscheme_istype_wxMenuBar(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMenuBar_class);
if (objscheme_is_a(obj, os_wxMenuBar_class))
return 1;
else {
@ -943,7 +943,7 @@ class wxMenuBar *objscheme_unbundle_wxMenuBar(Scheme_Object *obj, const char *wh
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxMenuBar_class);
(void)objscheme_istype_wxMenuBar(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1119,7 +1119,7 @@ int objscheme_istype_wxsMenuItem(Scheme_Object *obj, const char *stop, int nullO
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxsMenuItem_class);
if (objscheme_is_a(obj, os_wxsMenuItem_class))
return 1;
else {
@ -1163,7 +1163,7 @@ class wxsMenuItem *objscheme_unbundle_wxsMenuItem(Scheme_Object *obj, const char
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxsMenuItem_class);
(void)objscheme_istype_wxsMenuItem(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

16
src/mred/wxs/wxs_misc.cxx
View File

@ -268,7 +268,7 @@ int objscheme_istype_wxTimer(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxTimer_class);
if (objscheme_is_a(obj, os_wxTimer_class))
return 1;
else {
@ -312,7 +312,7 @@ class wxTimer *objscheme_unbundle_wxTimer(Scheme_Object *obj, const char *where,
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxTimer_class);
(void)objscheme_istype_wxTimer(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -608,7 +608,7 @@ int objscheme_istype_wxClipboard(Scheme_Object *obj, const char *stop, int nullO
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxClipboard_class);
if (objscheme_is_a(obj, os_wxClipboard_class))
return 1;
else {
@ -652,7 +652,7 @@ class wxClipboard *objscheme_unbundle_wxClipboard(Scheme_Object *obj, const char
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxClipboard_class);
(void)objscheme_istype_wxClipboard(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1022,7 +1022,7 @@ int objscheme_istype_wxClipboardClient(Scheme_Object *obj, const char *stop, int
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxClipboardClient_class);
if (objscheme_is_a(obj, os_wxClipboardClient_class))
return 1;
else {
@ -1066,7 +1066,7 @@ class wxClipboardClient *objscheme_unbundle_wxClipboardClient(Scheme_Object *obj
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxClipboardClient_class);
(void)objscheme_istype_wxClipboardClient(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1826,7 +1826,7 @@ int objscheme_istype_wxPrintSetupData(Scheme_Object *obj, const char *stop, int
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPrintSetupData_class);
if (objscheme_is_a(obj, os_wxPrintSetupData_class))
return 1;
else {
@ -1870,7 +1870,7 @@ class wxPrintSetupData *objscheme_unbundle_wxPrintSetupData(Scheme_Object *obj,
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPrintSetupData_class);
(void)objscheme_istype_wxPrintSetupData(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_obj.cxx
View File

@ -120,7 +120,7 @@ int objscheme_istype_wxObject(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxObject_class);
if (objscheme_is_a(obj, os_wxObject_class))
return 1;
else {
@ -164,7 +164,7 @@ class wxObject *objscheme_unbundle_wxObject(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxObject_class);
(void)objscheme_istype_wxObject(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

8
src/mred/wxs/wxs_panl.cxx
View File

@ -958,7 +958,7 @@ int objscheme_istype_wxPanel(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPanel_class);
if (objscheme_is_a(obj, os_wxPanel_class))
return 1;
else {
@ -1002,7 +1002,7 @@ class wxPanel *objscheme_unbundle_wxPanel(Scheme_Object *obj, const char *where,
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxPanel_class);
(void)objscheme_istype_wxPanel(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1825,7 +1825,7 @@ int objscheme_istype_wxDialogBox(Scheme_Object *obj, const char *stop, int nullO
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxDialogBox_class);
if (objscheme_is_a(obj, os_wxDialogBox_class))
return 1;
else {
@ -1869,7 +1869,7 @@ class wxDialogBox *objscheme_unbundle_wxDialogBox(Scheme_Object *obj, const char
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxDialogBox_class);
(void)objscheme_istype_wxDialogBox(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_rado.cxx
View File

@ -1100,7 +1100,7 @@ int objscheme_istype_wxRadioBox(Scheme_Object *obj, const char *stop, int nullOK
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxRadioBox_class);
if (objscheme_is_a(obj, os_wxRadioBox_class))
return 1;
else {
@ -1144,7 +1144,7 @@ class wxRadioBox *objscheme_unbundle_wxRadioBox(Scheme_Object *obj, const char *
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxRadioBox_class);
(void)objscheme_istype_wxRadioBox(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_slid.cxx
View File

@ -697,7 +697,7 @@ int objscheme_istype_wxSlider(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxSlider_class);
if (objscheme_is_a(obj, os_wxSlider_class))
return 1;
else {
@ -741,7 +741,7 @@ class wxSlider *objscheme_unbundle_wxSlider(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxSlider_class);
(void)objscheme_istype_wxSlider(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

8
src/mred/wxs/wxs_tabc.cxx
View File

@ -999,7 +999,7 @@ int objscheme_istype_wxTabChoice(Scheme_Object *obj, const char *stop, int nullO
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxTabChoice_class);
if (objscheme_is_a(obj, os_wxTabChoice_class))
return 1;
else {
@ -1043,7 +1043,7 @@ class wxTabChoice *objscheme_unbundle_wxTabChoice(Scheme_Object *obj, const char
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxTabChoice_class);
(void)objscheme_istype_wxTabChoice(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));
@ -1626,7 +1626,7 @@ int objscheme_istype_wxGroupBox(Scheme_Object *obj, const char *stop, int nullOK
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxGroupBox_class);
if (objscheme_is_a(obj, os_wxGroupBox_class))
return 1;
else {
@ -1670,7 +1670,7 @@ class wxGroupBox *objscheme_unbundle_wxGroupBox(Scheme_Object *obj, const char *
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxGroupBox_class);
(void)objscheme_istype_wxGroupBox(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

4
src/mred/wxs/wxs_win.cxx
View File

@ -1418,7 +1418,7 @@ int objscheme_istype_wxWindow(Scheme_Object *obj, const char *stop, int nullOK)
{
REMEMBER_VAR_STACK();
if (nullOK && XC_SCHEME_NULLP(obj)) return 1;
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxWindow_class);
if (objscheme_is_a(obj, os_wxWindow_class))
return 1;
else {
@ -1462,7 +1462,7 @@ class wxWindow *objscheme_unbundle_wxWindow(Scheme_Object *obj, const char *wher
REMEMBER_VAR_STACK();
obj = objscheme_unwrap(obj);
obj = objscheme_unwrap(obj, os_wxWindow_class);
(void)objscheme_istype_wxWindow(obj, where, nullOK);
Scheme_Class_Object *o = (Scheme_Class_Object *)obj;
WITH_REMEMBERED_STACK(objscheme_check_valid(NULL, NULL, 0, &obj));

32
src/mzscheme/utils/xcglue.c
View File

@ -91,6 +91,7 @@ typedef struct Scheme_Class {
Scheme_Object **methods;
Scheme_Object *base_struct_type;
Scheme_Object *struct_type;
Scheme_Object *unwrap_property;
} Scheme_Class;
Scheme_Type objscheme_class_type;
@ -99,7 +100,6 @@ static Scheme_Object *object_struct;
static Scheme_Object *object_property;
static Scheme_Object *dispatcher_property;
static Scheme_Object *preparer_property;
static Scheme_Object *unwrapper_property;
#ifdef MZ_PRECISE_GC
# include "../gc2/gc2.h"
@ -122,6 +122,7 @@ int gc_class_mark(void *_c)
gcMARK(c->methods);
gcMARK(c->base_struct_type);
gcMARK(c->struct_type);
gcMARK(c->unwrap_property);
return gcBYTES_TO_WORDS(sizeof(Scheme_Class));
}
@ -137,6 +138,7 @@ int gc_class_fixup(void *_c)
gcFIXUP(c->methods);
gcFIXUP(c->base_struct_type);
gcFIXUP(c->struct_type);
gcFIXUP(c->unwrap_property);
return gcBYTES_TO_WORDS(sizeof(Scheme_Class));
}
@ -174,9 +176,11 @@ static Scheme_Object *class_prepare_struct_type(int argc, Scheme_Object **argv)
scheme_wrong_type("primitive-class-prepare-struct-type!", "struct-type-property", 1, argc, argv);
scheme_check_proc_arity("primitive-class-prepare-struct-type!", 1, 3, argc, argv);
scheme_check_proc_arity("primitive-class-prepare-struct-type!", 2, 4, argc, argv);
scheme_check_proc_arity("primitive-class-prepare-struct-type!", 1, 5, argc, argv);
if(SCHEME_TYPE(argv[5]) != scheme_struct_property_type)
scheme_wrong_type("primitive-class-prepare-struct-type!", "struct-type-property", 5, argc, argv);
scheme_check_proc_arity("primitive-class-prepare-struct-type!", 1, 6, argc, argv);
props = argv[6];
props = argv[7];
while (SCHEME_PAIRP(props)) {
name = SCHEME_CAR(props);
if (!SCHEME_PAIRP(name))
@ -186,8 +190,8 @@ static Scheme_Object *class_prepare_struct_type(int argc, Scheme_Object **argv)
props = SCHEME_CDR(props);
}
if (!SCHEME_NULLP(props))
scheme_wrong_type("primitive-class-prepare-struct-type!", "list of struct-type-property--value pairs", 6, argc, argv);
props = argv[6];
scheme_wrong_type("primitive-class-prepare-struct-type!", "list of struct-type-property--value pairs", 7, argc, argv);
props = argv[7];
objscheme_something_prepared = 1;
@ -238,7 +242,8 @@ static Scheme_Object *class_prepare_struct_type(int argc, Scheme_Object **argv)
/* Type to derive/instantiate from Scheme: */
props = scheme_make_pair(scheme_make_pair(unwrapper_property, argv[5]), props);
c->unwrap_property = argv[5];
props = scheme_make_pair(scheme_make_pair(argv[5], argv[6]), props);
props = scheme_make_pair(scheme_make_pair(dispatcher_property, argv[4]), props);
props = scheme_make_pair(scheme_make_pair(preparer_property, argv[3]), props);
@ -457,14 +462,18 @@ int objscheme_is_a(Scheme_Object *o, Scheme_Object *c)
return !!a;
}
Scheme_Object *objscheme_unwrap(Scheme_Object *obj)
Scheme_Object *objscheme_unwrap(Scheme_Object *obj, Scheme_Object *c)
{
Scheme_Object *s[1], *unwrapper;
Scheme_Object *s[1], *unwrapper, *unwrap_prop;
Scheme_Class *cls = (Scheme_Class *)cls;
if (!obj)
return NULL;
unwrapper = scheme_struct_type_property_ref(unwrapper_property, (Scheme_Object *)obj);
unwrap_prop = cls->unwrap_property;
if(!unwrap_prop)
return obj;
unwrapper = scheme_struct_type_property_ref(unwrap_prop, (Scheme_Object *)obj);
if (!unwrapper)
return obj;
@ -540,9 +549,6 @@ void objscheme_init(Scheme_Env *env)
wxREGGLOB(dispatcher_property);
dispatcher_property = scheme_make_struct_type_property(scheme_intern_symbol("primitive-dispatcher"));
wxREGGLOB(unwrapper_property);
unwrapper_property = scheme_make_struct_type_property(scheme_intern_symbol("primitive-unwrapper"));
wxREGGLOB(object_struct);
object_struct = scheme_make_struct_type(scheme_intern_symbol("primitive-object"),
NULL, NULL,
@ -562,7 +568,7 @@ void objscheme_init(Scheme_Env *env)
scheme_install_xc_global("primitive-class-prepare-struct-type!",
scheme_make_prim_w_arity(class_prepare_struct_type,
"primitive-class-prepare-struct-type!",
7, 7),
8, 8),
env);
scheme_install_xc_global("primitive-class-find-method",

2
src/mzscheme/utils/xcglue.h
View File

@ -78,7 +78,7 @@ Scheme_Object *objscheme_find_method(Scheme_Object *obj,
int objscheme_is_subclass(Scheme_Object *a, Scheme_Object *sup);
int objscheme_is_a(Scheme_Object *o, Scheme_Object *c);
Scheme_Object *objscheme_unwrap(Scheme_Object *);
Scheme_Object *objscheme_unwrap(Scheme_Object *, Scheme_Object *);
Scheme_Object *objscheme_unbox(Scheme_Object *, const char *where);
Scheme_Object *objscheme_nullable_unbox(Scheme_Object *, const char *where);

4
src/mzscheme/utils/xctocc
View File

@ -1237,7 +1237,7 @@ sub DoPrintClass
print "{\n";
print " REMEMBER_VAR_STACK();\n";
print " if (nullOK && XC_SCHEME_NULLP(obj)) return 1;\n";
print " obj = objscheme_unwrap(obj);\n";
print " obj = objscheme_unwrap(obj, ${newclass}_class);\n";
print " if (objscheme_is_a(obj, ${newclass}_class))\n";
print " return 1;\n";
print " else {\n";
@ -1288,7 +1288,7 @@ sub DoPrintClass
print "{\n";
print " if (nullOK && XC_SCHEME_NULLP(obj)) return NULL;\n\n";
print " REMEMBER_VAR_STACK();\n\n";
print " obj = objscheme_unwrap(obj);\n";
print " obj = objscheme_unwrap(obj, ${newclass}_class);\n";
print " (void)objscheme_istype_${oldclass}(obj, where, nullOK);\n";
print " Scheme_Class_Object *o = ";