diff options
Diffstat (limited to 'PerlTQt/TQt.xs')
| -rw-r--r-- | PerlTQt/TQt.xs | 2198 |
1 files changed, 2198 insertions, 0 deletions
diff --git a/PerlTQt/TQt.xs b/PerlTQt/TQt.xs new file mode 100644 index 0000000..22a66de --- /dev/null +++ b/PerlTQt/TQt.xs @@ -0,0 +1,2198 @@ +#include <stdio.h> +#include <qglobal.h> +#include <qstring.h> +#include <qapplication.h> +#include <qmetaobject.h> +#include <private/qucomextra_p.h> +#include "smoke.h" + +#undef DEBUG +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +#endif +#ifndef __USE_POSIX +#define __USE_POSIX +#endif +#ifndef __USE_XOPEN +#define __USE_XOPEN +#endif +#ifdef _BOOL +#define HAS_BOOL +#endif +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifndef TQT_VERSION_STR +#define TQT_VERSION_STR "Unknown" +#endif + +#undef free +#undef malloc + +#include "marshall.h" +#include "perlqt.h" +#include "smokeperl.h" + +#ifndef IN_BYTES +#define IN_BYTES IN_BYTE +#endif + +#ifndef IN_LOCALE +#define IN_LOCALE (PL_curcop->op_private & HINT_LOCALE) +#endif + +extern Smoke *qt_Smoke; +extern void init_qt_Smoke(); + +int do_debug = qtdb_none; + +HV *pointer_map = 0; +SV *sv_qapp = 0; +int object_count = 0; +void *_current_object = 0; // TODO: ask myself if this is stupid + +bool temporary_virtual_function_success = false; + +static TQAsciiDict<Smoke::Index> *methcache = 0; +static TQAsciiDict<Smoke::Index> *classcache = 0; + +SV *sv_this = 0; + +Smoke::Index _current_object_class = 0; +Smoke::Index _current_method = 0; +/* + * Type handling by moc is simple. + * + * If the type name matches /^(?:const\s+)?\Q$types\E&?$/, use the + * static_TQUType, where $types is join('|', qw(bool int double char* TQString); + * + * Everything else is passed as a pointer! There are types which aren't + * Smoke::tf_ptr but will have to be passed as a pointer. Make sure to keep + * track of what's what. + */ + +/* + * Simply using typeids isn't enough for signals/slots. It will be possible + * to declare signals and slots which use arguments which can't all be + * found in a single smoke object. Instead, we need to store smoke => typeid + * pairs. We also need additional informatation, such as whether we're passing + * a pointer to the union element. + */ + +enum MocArgumentType { + xmoc_ptr, + xmoc_bool, + xmoc_int, + xmoc_double, + xmoc_charstar, + xmoc_TQString +}; + +struct MocArgument { + // smoke object and associated typeid + SmokeType st; + MocArgumentType argType; +}; + + +extern TypeHandler TQt_handlers[]; +void install_handlers(TypeHandler *); + +void *sv_to_ptr(SV *sv) { // ptr on success, null on fail + smokeperl_object *o = sv_obj_info(sv); + return o ? o->ptr : 0; +} + +bool isTQObject(Smoke *smoke, Smoke::Index classId) { + if(!strcmp(smoke->classes[classId].className, "TQObject")) + return true; + for(Smoke::Index *p = smoke->inheritanceList + smoke->classes[classId].parents; + *p; + p++) { + if(isTQObject(smoke, *p)) + return true; + } + return false; +} + +int isDerivedFrom(Smoke *smoke, Smoke::Index classId, Smoke::Index baseId, int cnt) { + if(classId == baseId) + return cnt; + cnt++; + for(Smoke::Index *p = smoke->inheritanceList + smoke->classes[classId].parents; + *p; + p++) { + if(isDerivedFrom(smoke, *p, baseId, cnt) != -1) + return cnt; + } + return -1; +} + +int isDerivedFrom(Smoke *smoke, const char *className, const char *baseClassName, int cnt) { + if(!smoke || !className || !baseClassName) + return -1; + Smoke::Index idClass = smoke->idClass(className); + Smoke::Index idBase = smoke->idClass(baseClassName); + return isDerivedFrom(smoke, idClass, idBase, cnt); +} + +SV *getPointerObject(void *ptr) { + HV *hv = pointer_map; + SV *keysv = newSViv((IV)ptr); + STRLEN len; + char *key = SvPV(keysv, len); + SV **svp = hv_fetch(hv, key, len, 0); + if(!svp){ + SvREFCNT_dec(keysv); + return 0; + } + if(!SvOK(*svp)){ + hv_delete(hv, key, len, G_DISCARD); + SvREFCNT_dec(keysv); + return 0; + } + return *svp; +} + +void unmapPointer(smokeperl_object *o, Smoke::Index classId, void *lastptr) { + HV *hv = pointer_map; + void *ptr = o->smoke->cast(o->ptr, o->classId, classId); + if(ptr != lastptr) { + lastptr = ptr; + SV *keysv = newSViv((IV)ptr); + STRLEN len; + char *key = SvPV(keysv, len); + if(hv_exists(hv, key, len)) + hv_delete(hv, key, len, G_DISCARD); + SvREFCNT_dec(keysv); + } + for(Smoke::Index *i = o->smoke->inheritanceList + o->smoke->classes[classId].parents; + *i; + i++) { + unmapPointer(o, *i, lastptr); + } +} + +// Store pointer in pointer_map hash : "pointer_to_TQt_object" => weak ref to associated Perl object +// Recurse to store it also as casted to its parent classes. + +void mapPointer(SV *obj, smokeperl_object *o, HV *hv, Smoke::Index classId, void *lastptr) { + void *ptr = o->smoke->cast(o->ptr, o->classId, classId); + if(ptr != lastptr) { + lastptr = ptr; + SV *keysv = newSViv((IV)ptr); + STRLEN len; + char *key = SvPV(keysv, len); + SV *rv = newSVsv(obj); + sv_rvweaken(rv); // weak reference! + hv_store(hv, key, len, rv, 0); + SvREFCNT_dec(keysv); + } + for(Smoke::Index *i = o->smoke->inheritanceList + o->smoke->classes[classId].parents; + *i; + i++) { + mapPointer(obj, o, hv, *i, lastptr); + } +} + +Marshall::HandlerFn getMarshallFn(const SmokeType &type); + +class VirtualMethodReturnValue : public Marshall { + Smoke *_smoke; + Smoke::Index _method; + Smoke::Stack _stack; + SmokeType _st; + SV *_retval; +public: + const Smoke::Method &method() { return _smoke->methods[_method]; } + SmokeType type() { return _st; } + Marshall::Action action() { return Marshall::FromSV; } + Smoke::StackItem &item() { return _stack[0]; } + SV *var() { return _retval; } + void unsupported() { + croak("Cannot handle '%s' as return-type of virtual method %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + void next() {} + bool cleanup() { return false; } + VirtualMethodReturnValue(Smoke *smoke, Smoke::Index meth, Smoke::Stack stack, SV *retval) : + _smoke(smoke), _method(meth), _stack(stack), _retval(retval) { + _st.set(_smoke, method().ret); + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + } +}; + +class VirtualMethodCall : public Marshall { + Smoke *_smoke; + Smoke::Index _method; + Smoke::Stack _stack; + GV *_gv; + int _cur; + Smoke::Index *_args; + SV **_sp; + bool _called; + SV *_savethis; + +public: + SmokeType type() { return SmokeType(_smoke, _args[_cur]); } + Marshall::Action action() { return Marshall::ToSV; } + Smoke::StackItem &item() { return _stack[_cur + 1]; } + SV *var() { return _sp[_cur]; } + const Smoke::Method &method() { return _smoke->methods[_method]; } + void unsupported() { + croak("Cannot handle '%s' as argument of virtual method %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + void callMethod() { + dSP; + if(_called) return; + _called = true; + SP = _sp + method().numArgs - 1; + PUTBACK; + int count = call_sv((SV*)GvCV(_gv), G_SCALAR); + SPAGAIN; + VirtualMethodReturnValue r(_smoke, _method, _stack, POPs); + PUTBACK; + FREETMPS; + LEAVE; + } + void next() { + int oldcur = _cur; + _cur++; + while(!_called && _cur < method().numArgs) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + _cur++; + } + callMethod(); + _cur = oldcur; + } + bool cleanup() { return false; } // is this right? + VirtualMethodCall(Smoke *smoke, Smoke::Index meth, Smoke::Stack stack, SV *obj, GV *gv) : + _smoke(smoke), _method(meth), _stack(stack), _gv(gv), _cur(-1), _sp(0), _called(false) { + dSP; + ENTER; + SAVETMPS; + PUSHMARK(SP); + EXTEND(SP, method().numArgs); + _savethis = sv_this; + sv_this = newSVsv(obj); + _sp = SP + 1; + for(int i = 0; i < method().numArgs; i++) + _sp[i] = sv_newmortal(); + _args = _smoke->argumentList + method().args; + } + ~VirtualMethodCall() { + SvREFCNT_dec(sv_this); + sv_this = _savethis; + } +}; + +class MethodReturnValue : public Marshall { + Smoke *_smoke; + Smoke::Index _method; + SV *_retval; + Smoke::Stack _stack; +public: + MethodReturnValue(Smoke *smoke, Smoke::Index method, Smoke::Stack stack, SV *retval) : + _smoke(smoke), _method(method), _retval(retval), _stack(stack) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + } + const Smoke::Method &method() { return _smoke->methods[_method]; } + SmokeType type() { return SmokeType(_smoke, method().ret); } + Marshall::Action action() { return Marshall::ToSV; } + Smoke::StackItem &item() { return _stack[0]; } + SV *var() { return _retval; } + void unsupported() { + croak("Cannot handle '%s' as return-type of %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + void next() {} + bool cleanup() { return false; } +}; + +class MethodCall : public Marshall { + int _cur; + Smoke *_smoke; + Smoke::Stack _stack; + Smoke::Index _method; + Smoke::Index *_args; + SV **_sp; + int _items; + SV *_retval; + bool _called; +public: + MethodCall(Smoke *smoke, Smoke::Index method, SV **sp, int items) : + _smoke(smoke), _method(method), _sp(sp), _items(items), _cur(-1), _called(false) { + _args = _smoke->argumentList + _smoke->methods[_method].args; + _items = _smoke->methods[_method].numArgs; + _stack = new Smoke::StackItem[items + 1]; + _retval = newSV(0); + } + ~MethodCall() { + delete[] _stack; + SvREFCNT_dec(_retval); + } + SmokeType type() { return SmokeType(_smoke, _args[_cur]); } + Marshall::Action action() { return Marshall::FromSV; } + Smoke::StackItem &item() { return _stack[_cur + 1]; } + SV *var() { + if(_cur < 0) return _retval; + SvGETMAGIC(*(_sp + _cur)); + return *(_sp + _cur); + } + inline const Smoke::Method &method() { return _smoke->methods[_method]; } + void unsupported() { + croak("Cannot handle '%s' as argument to %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + inline void callMethod() { + if(_called) return; + _called = true; + Smoke::ClassFn fn = _smoke->classes[method().classId].classFn; + void *ptr = _smoke->cast( + _current_object, + _current_object_class, + method().classId + ); + _items = -1; + (*fn)(method().method, ptr, _stack); + MethodReturnValue r(_smoke, _method, _stack, _retval); + } + void next() { + int oldcur = _cur; + _cur++; + + while(!_called && _cur < _items) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + _cur++; + } + + callMethod(); + _cur = oldcur; + } + bool cleanup() { return true; } +}; + +class UnencapsulatedTQObject : public TQObject { +public: + TQConnectionList *public_receivers(int signal) const { return receivers(signal); } + void public_activate_signal(TQConnectionList *clist, TQUObject *o) { activate_signal(clist, o); } +}; + +class EmitSignal : public Marshall { + UnencapsulatedTQObject *_qobj; + int _id; + MocArgument *_args; + SV **_sp; + int _items; + int _cur; + Smoke::Stack _stack; + bool _called; +public: + EmitSignal(TQObject *qobj, int id, int items, MocArgument *args, SV **sp) : + _qobj((UnencapsulatedTQObject*)qobj), _id(id), _items(items), _args(args), + _sp(sp), _cur(-1), _called(false) { + _stack = new Smoke::StackItem[_items]; + } + ~EmitSignal() { + delete[] _stack; + } + const MocArgument &arg() { return _args[_cur]; } + SmokeType type() { return arg().st; } + Marshall::Action action() { return Marshall::FromSV; } + Smoke::StackItem &item() { return _stack[_cur]; } + SV *var() { return _sp[_cur]; } + void unsupported() { + croak("Cannot handle '%s' as signal argument", type().name()); + } + Smoke *smoke() { return type().smoke(); } + void emitSignal() { + if(_called) return; + _called = true; + + TQConnectionList *clist = _qobj->public_receivers(_id); + if(!clist) return; + + TQUObject *o = new TQUObject[_items + 1]; + for(int i = 0; i < _items; i++) { + TQUObject *po = o + i + 1; + Smoke::StackItem *si = _stack + i; + switch(_args[i].argType) { + case xmoc_bool: + static_TQUType_bool.set(po, si->s_bool); + break; + case xmoc_int: + static_TQUType_int.set(po, si->s_int); + break; + case xmoc_double: + static_TQUType_double.set(po, si->s_double); + break; + case xmoc_charstar: + static_TQUType_charstar.set(po, (char*)si->s_voidp); + break; + case xmoc_TQString: + static_TQUType_TQString.set(po, *(TQString*)si->s_voidp); + break; + default: + { + const SmokeType &t = _args[i].st; + void *p; + switch(t.elem()) { + case Smoke::t_bool: + p = &si->s_bool; + break; + case Smoke::t_char: + p = &si->s_char; + break; + case Smoke::t_uchar: + p = &si->s_uchar; + break; + case Smoke::t_short: + p = &si->s_short; + break; + case Smoke::t_ushort: + p = &si->s_ushort; + break; + case Smoke::t_int: + p = &si->s_int; + break; + case Smoke::t_uint: + p = &si->s_uint; + break; + case Smoke::t_long: + p = &si->s_long; + break; + case Smoke::t_ulong: + p = &si->s_ulong; + break; + case Smoke::t_float: + p = &si->s_float; + break; + case Smoke::t_double: + p = &si->s_double; + break; + case Smoke::t_enum: + { + // allocate a new enum value + Smoke::EnumFn fn = SmokeClass(t).enumFn(); + if(!fn) { + warn("Unknown enumeration %s\n", t.name()); + p = new int((int)si->s_enum); + break; + } + Smoke::Index id = t.typeId(); + (*fn)(Smoke::EnumNew, id, p, si->s_enum); + (*fn)(Smoke::EnumFromLong, id, p, si->s_enum); + // FIXME: MEMORY LEAK + } + break; + case Smoke::t_class: + case Smoke::t_voidp: + p = si->s_voidp; + break; + default: + p = 0; + break; + } + static_TQUType_ptr.set(po, p); + } + } + } + + _qobj->public_activate_signal(clist, o); + delete[] o; + } + void next() { + int oldcur = _cur; + _cur++; + + while(!_called && _cur < _items) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + _cur++; + } + + emitSignal(); + _cur = oldcur; + } + bool cleanup() { return true; } +}; + +class InvokeSlot : public Marshall { + TQObject *_qobj; + GV *_gv; + int _items; + MocArgument *_args; + TQUObject *_o; + int _cur; + bool _called; + SV **_sp; + Smoke::Stack _stack; +public: + const MocArgument &arg() { return _args[_cur]; } + SmokeType type() { return arg().st; } + Marshall::Action action() { return Marshall::ToSV; } + Smoke::StackItem &item() { return _stack[_cur]; } + SV *var() { return _sp[_cur]; } + Smoke *smoke() { return type().smoke(); } + bool cleanup() { return false; } + void unsupported() { + croak("Cannot handle '%s' as slot argument\n", type().name()); + } + void copyArguments() { + for(int i = 0; i < _items; i++) { + TQUObject *o = _o + i + 1; + switch(_args[i].argType) { + case xmoc_bool: + _stack[i].s_bool = static_TQUType_bool.get(o); + break; + case xmoc_int: + _stack[i].s_int = static_TQUType_int.get(o); + break; + case xmoc_double: + _stack[i].s_double = static_TQUType_double.get(o); + break; + case xmoc_charstar: + _stack[i].s_voidp = static_TQUType_charstar.get(o); + break; + case xmoc_TQString: + _stack[i].s_voidp = &static_TQUType_TQString.get(o); + break; + default: // case xmoc_ptr: + { + const SmokeType &t = _args[i].st; + void *p = static_TQUType_ptr.get(o); + switch(t.elem()) { + case Smoke::t_bool: + _stack[i].s_bool = *(bool*)p; + break; + case Smoke::t_char: + _stack[i].s_char = *(char*)p; + break; + case Smoke::t_uchar: + _stack[i].s_uchar = *(unsigned char*)p; + break; + case Smoke::t_short: + _stack[i].s_short = *(short*)p; + break; + case Smoke::t_ushort: + _stack[i].s_ushort = *(unsigned short*)p; + break; + case Smoke::t_int: + _stack[i].s_int = *(int*)p; + break; + case Smoke::t_uint: + _stack[i].s_uint = *(unsigned int*)p; + break; + case Smoke::t_long: + _stack[i].s_long = *(long*)p; + break; + case Smoke::t_ulong: + _stack[i].s_ulong = *(unsigned long*)p; + break; + case Smoke::t_float: + _stack[i].s_float = *(float*)p; + break; + case Smoke::t_double: + _stack[i].s_double = *(double*)p; + break; + case Smoke::t_enum: + { + Smoke::EnumFn fn = SmokeClass(t).enumFn(); + if(!fn) { + warn("Unknown enumeration %s\n", t.name()); + _stack[i].s_enum = *(int*)p; + break; + } + Smoke::Index id = t.typeId(); + (*fn)(Smoke::EnumToLong, id, p, _stack[i].s_enum); + } + break; + case Smoke::t_class: + case Smoke::t_voidp: + _stack[i].s_voidp = p; + break; + } + } + } + } + } + void invokeSlot() { + dSP; + if(_called) return; + _called = true; + + SP = _sp + _items - 1; + PUTBACK; + int count = call_sv((SV*)GvCV(_gv), G_SCALAR); + SPAGAIN; + SP -= count; + PUTBACK; + FREETMPS; + LEAVE; + } + void next() { + int oldcur = _cur; + _cur++; + + while(!_called && _cur < _items) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + _cur++; + } + + invokeSlot(); + _cur = oldcur; + } + InvokeSlot(TQObject *qobj, GV *gv, int items, MocArgument *args, TQUObject *o) : + _qobj(qobj), _gv(gv), _items(items), _args(args), _o(o), _cur(-1), _called(false) { + dSP; + ENTER; + SAVETMPS; + PUSHMARK(SP); + EXTEND(SP, items); + PUTBACK; + _sp = SP + 1; + for(int i = 0; i < _items; i++) + _sp[i] = sv_newmortal(); + _stack = new Smoke::StackItem[_items]; + copyArguments(); + } + ~InvokeSlot() { + delete[] _stack; + } + +}; + +class TQtSmokeBinding : public SmokeBinding { +public: + TQtSmokeBinding(Smoke *s) : SmokeBinding(s) {} + void deleted(Smoke::Index classId, void *ptr) { + SV *obj = getPointerObject(ptr); + smokeperl_object *o = sv_obj_info(obj); + if(do_debug && (do_debug & qtdb_gc)) { + fprintf(stderr, "%p->~%s()\n", ptr, smoke->className(classId)); + } + if(!o || !o->ptr) { + return; + } + unmapPointer(o, o->classId, 0); + o->ptr = 0; + } + bool callMethod(Smoke::Index method, void *ptr, Smoke::Stack args, bool isAbstract) { + SV *obj = getPointerObject(ptr); + smokeperl_object *o = sv_obj_info(obj); + if(do_debug && (do_debug & qtdb_virtual)) fprintf(stderr, "virtual %p->%s::%s() called\n", ptr, + smoke->classes[smoke->methods[method].classId].className, + smoke->methodNames[smoke->methods[method].name] + ); + + if(!o) { + if(!PL_dirty && (do_debug && (do_debug & qtdb_virtual)) ) // if not in global destruction + fprintf(stderr, "Cannot find object for virtual method\n"); + return false; + } + HV *stash = SvSTASH(SvRV(obj)); + if(*HvNAME(stash) == ' ') + stash = gv_stashpv(HvNAME(stash) + 1, TRUE); + const char *methodName = smoke->methodNames[smoke->methods[method].name]; + GV *gv = gv_fetchmethod_autoload(stash, methodName, 0); + if(!gv) return false; + + VirtualMethodCall c(smoke, method, args, obj, gv); + // exception variable, just temporary + temporary_virtual_function_success = true; + c.next(); + bool ret = temporary_virtual_function_success; + temporary_virtual_function_success = true; + return ret; + } + char *className(Smoke::Index classId) { + const char *className = smoke->className(classId); + char *buf = new char[strlen(className) + 6]; + strcpy(buf, " TQt::"); + strcat(buf, className + 1); + return buf; + } +}; + +// ---------------- Helpers ------------------- + +SV *catArguments(SV** sp, int n) +{ + SV* r=newSVpvf(""); + for(int i = 0; i < n; i++) { + if(i) sv_catpv(r, ", "); + if(!SvOK(sp[i])) { + sv_catpv(r, "undef"); + } else if(SvROK(sp[i])) { + smokeperl_object *o = sv_obj_info(sp[i]); + if(o) + sv_catpv(r, o->smoke->className(o->classId)); + else + sv_catsv(r, sp[i]); + } else { + bool isString = SvPOK(sp[i]); + STRLEN len; + char *s = SvPV(sp[i], len); + if(isString) sv_catpv(r, "'"); + sv_catpvn(r, s, len > 10 ? 10 : len); + if(len > 10) sv_catpv(r, "..."); + if(isString) sv_catpv(r, "'"); + } + } + return r; +} + +Smoke::Index package_classid(const char *p) +{ + Smoke::Index *item = classcache->find(p); + if(item) + return *item; + char *nisa = new char[strlen(p)+6]; + strcpy(nisa, p); + strcat(nisa, "::ISA"); + AV* isa=get_av(nisa, true); + delete[] nisa; + for(int i=0; i<=av_len(isa); i++) { + SV** np = av_fetch(isa, i, 0); + if(np) { + Smoke::Index ix = package_classid(SvPV_nolen(*np)); + if(ix) { + classcache->insert(p, new Smoke::Index(ix)); + return ix; + } + } + } + return (Smoke::Index) 0; +} + +char *get_SVt(SV *sv) +{ + char *r; + if(!SvOK(sv)) + r = "u"; + else if(SvIOK(sv)) + r = "i"; + else if(SvNOK(sv)) + r = "n"; + else if(SvPOK(sv)) + r = "s"; + else if(SvROK(sv)) { + smokeperl_object *o = sv_obj_info(sv); + if(!o) { + switch (SvTYPE(SvRV(sv))) { + case SVt_PVAV: + r = "a"; + break; +// case SVt_PV: +// case SVt_PVMG: +// r = "p"; + default: + r = "r"; + } + } + else + r = (char*)o->smoke->className(o->classId); + } + else + r = "U"; + return r; +} + +SV *prettyPrintMethod(Smoke::Index id) { + SV *r = newSVpvf(""); + Smoke::Method &meth = qt_Smoke->methods[id]; + const char *tname = qt_Smoke->types[meth.ret].name; + if(meth.flags & Smoke::mf_static) sv_catpv(r, "static "); + sv_catpvf(r, "%s ", (tname ? tname:"void")); + sv_catpvf(r, "%s::%s(", qt_Smoke->classes[meth.classId].className, qt_Smoke->methodNames[meth.name]); + for(int i = 0; i < meth.numArgs; i++) { + if(i) sv_catpv(r, ", "); + tname = qt_Smoke->types[qt_Smoke->argumentList[meth.args+i]].name; + sv_catpv(r, (tname ? tname:"void")); + } + sv_catpv(r, ")"); + if(meth.flags & Smoke::mf_const) sv_catpv(r, " const"); + return r; +} + +// --------------- Unary Keywords && Attributes ------------------ + + +// implements unary 'this' +XS(XS_this) { + dXSARGS; + ST(0) = sv_this; + XSRETURN(1); +} + +// implements unary attributes: 'foo' means 'this->{foo}' +XS(XS_attr) { + dXSARGS; + char *key = GvNAME(CvGV(cv)); + U32 klen = strlen(key); + SV **svp = 0; + if(SvROK(sv_this) && SvTYPE(SvRV(sv_this)) == SVt_PVHV) { + HV *hv = (HV*)SvRV(sv_this); + svp = hv_fetch(hv, key, klen, 1); + } + if(svp) { + ST(0) = *svp; + XSRETURN(1); + } + XSRETURN_UNDEF; +} + +// implements unary SUPER attribute: 'SUPER' means ${(CopSTASH)::_INTERNAL_STATIC_}{SUPER} +XS(XS_super) { + dXSARGS; + char *key = "SUPER"; + U32 klen = strlen(key); + SV **svp = 0; + if(SvROK(sv_this) && SvTYPE(SvRV(sv_this)) == SVt_PVHV) { + HV *cs = (HV*)CopSTASH(PL_curcop); + if(!cs) XSRETURN_UNDEF; + svp = hv_fetch(cs, "_INTERNAL_STATIC_", 17, 0); + if(!svp) XSRETURN_UNDEF; + cs = GvHV((GV*)*svp); + if(!cs) XSRETURN_UNDEF; + svp = hv_fetch(cs, "SUPER", 5, 0); + } + if(svp) { + ST(0) = *svp; + XSRETURN(1); + } + XSRETURN_UNDEF; +} + +//---------- XS Autoload (for all functions except fully qualified statics & enums) --------- + +static inline bool isTQt(char *p) { + return (p[0] == 'Q' && p[1] && p[1] == 't' && ((p[2] && p[2] == ':') || !p[2])); +} + +bool avoid_fetchmethod = false; +XS(XS_AUTOLOAD) { + // Err, XS autoload is borked. Lets try... + dXSARGS; + SV *sv = get_sv("TQt::AutoLoad::AUTOLOAD", TRUE); + char *package = SvPV_nolen(sv); + char *method = 0; + for(char *s = package; *s ; s++) + if(*s == ':') method = s; + if(!method) XSRETURN_NO; + *(method++ - 1) = 0; // sorry for showing off. :) + int withObject = (*package == ' ') ? 1 : 0; + int isSuper = 0; + if(withObject) { + package++; + if(*package == ' ') { + isSuper = 1; + char *super = new char[strlen(package) + 7]; + package++; + strcpy(super, package); + strcat(super, "::SUPER"); + package = super; + } + } else if( isTQt(package) ) + avoid_fetchmethod = true; + + HV *stash = gv_stashpv(package, TRUE); + + if(do_debug && (do_debug & qtdb_autoload)) + warn("In XS Autoload for %s::%s()\n", package, method); + + // check for user-defined methods in the REAL stash; skip prefix + GV *gv = 0; + if(avoid_fetchmethod) + avoid_fetchmethod = false; + else + gv = gv_fetchmethod_autoload(stash, method, 0); + + // If we've made it here, we need to set sv_this + if(gv) { + if(do_debug && (do_debug & qtdb_autoload)) + warn("\tfound in %s's Perl stash\n", package); + + // call the defined Perl method with new 'this' + SV *old_this; + if(withObject && !isSuper) { + old_this = sv_this; + sv_this = newSVsv(ST(0)); + } + + ENTER; + SAVETMPS; + PUSHMARK(SP - items + withObject); + PUTBACK; + int count = call_sv((SV*)GvCV(gv), G_SCALAR|G_EVAL); + SPAGAIN; + SV *ret = newSVsv(TOPs); + SP -= count; + PUTBACK; + FREETMPS; + LEAVE; + + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + else if(isSuper) + delete[] package; + + if(SvTRUE(ERRSV)) + croak(SvPV_nolen(ERRSV)); + ST(0) = sv_2mortal(ret); + XSRETURN(1); + } + else if(!strcmp(method, "DESTROY")) { + SV *old_this; + if(withObject && !isSuper) { + old_this = sv_this; + sv_this = newSVsv(ST(0)); + } + smokeperl_object *o = sv_obj_info(sv_this); + + if(!(o && o->ptr && (o->allocated || getPointerObject(o->ptr)))) { + if(isSuper) + delete[] package; + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + XSRETURN_YES; + } + const char *key = "has been hidden"; + U32 klen = 15; + SV **svp = 0; + if(SvROK(sv_this) && SvTYPE(SvRV(sv_this)) == SVt_PVHV) { + HV *hv = (HV*)SvRV(sv_this); + svp = hv_fetch(hv, key, klen, 0); + } + if(svp) { + if(isSuper) + delete[] package; + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + XSRETURN_YES; + } + gv = gv_fetchmethod_autoload(stash, "ON_DESTROY", 0); + if( !gv ) + croak( "Couldn't find ON_DESTROY method for %s=%p\n", package, o->ptr); + PUSHMARK(SP); + call_sv((SV*)GvCV(gv), G_SCALAR|G_NOARGS); + SPAGAIN; + int ret = POPi; + PUTBACK; + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + if( do_debug && ret && (do_debug & qtdb_gc) ) + fprintf(stderr, "Increasing refcount in DESTROY for %s=%p (still has a parent)\n", package, o->ptr); + } else { + + if( items > 18 ) XSRETURN_NO; // current max number of args in TQt is 13. + + // save the stack -- we'll need it + SV **savestack = new SV*[items+1]; + SV *saveobj = ST(0); + SV *old_this; + + Copy(SP - items + 1 + withObject, savestack, items-withObject, SV*); + + // Get the classid (eventually converting SUPER to the right TQt class) + Smoke::Index cid = package_classid(package); + // Look in the cache + char *cname = (char*)qt_Smoke->className(cid); + int lcname = strlen(cname); + int lmethod = strlen(method); + char mcid[256]; + strncpy(mcid, cname, lcname); + char *ptr = mcid + lcname; + *(ptr++) = ';'; + strncpy(ptr, method, lmethod); + ptr += lmethod; + for(int i=withObject ; i<items ; i++) + { + *(ptr++) = ';'; + char *t = get_SVt(ST(i)); + int tlen = strlen(t); + strncpy(ptr, t, tlen ); + ptr += tlen; + } + *ptr = 0; + Smoke::Index *rcid = methcache->find(mcid); + + if(rcid) { + // Got a hit + _current_method = *rcid; + if(withObject && !isSuper) { + old_this = sv_this; + sv_this = newSVsv(ST(0)); + } + } + else { + + // Find the C++ method to call. I'll do that from Perl for now + + ENTER; + SAVETMPS; + PUSHMARK(SP - items + withObject); + EXTEND(SP, 3); + PUSHs(sv_2mortal(newSViv((IV)cid))); + PUSHs(sv_2mortal(newSVpv(method, 0))); + PUSHs(sv_2mortal(newSVpv(package, 0))); + PUTBACK; + if(withObject && !isSuper) { + old_this = sv_this; + sv_this = newSVsv(saveobj); + } + call_pv("TQt::_internal::do_autoload", G_DISCARD|G_EVAL); + FREETMPS; + LEAVE; + + // Restore sv_this on error, so that eval{ } works + if(SvTRUE(ERRSV)) { + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + else if(isSuper) + delete[] package; + delete[] savestack; + croak(SvPV_nolen(ERRSV)); + } + + // Success. Cache result. + methcache->insert(mcid, new Smoke::Index(_current_method)); + } + // FIXME: I shouldn't have to set the current object + { + smokeperl_object *o = sv_obj_info(sv_this); + if(o && o->ptr) { + _current_object = o->ptr; + _current_object_class = o->classId; + } else { + _current_object = 0; + } + } + // honor debugging channels + if(do_debug && (do_debug & qtdb_calls)) { + warn("Calling method\t%s\n", SvPV_nolen(sv_2mortal(prettyPrintMethod(_current_method)))); + if(do_debug & qtdb_verbose) + warn("with arguments (%s)\n", SvPV_nolen(sv_2mortal(catArguments(savestack, items-withObject)))); + } + MethodCall c(qt_Smoke, _current_method, savestack, items-withObject); + c.next(); + if(savestack) + delete[] savestack; + + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + else if(isSuper) + delete[] package; + + SV *ret = c.var(); + SvREFCNT_inc(ret); + ST(0) = sv_2mortal(ret); + XSRETURN(1); + } + if(isSuper) + delete[] package; + XSRETURN_YES; +} + + +//----------------- Sig/Slot ------------------ + + +MocArgument *getmetainfo(GV *gv, const char *name, int &offset, int &index, int &argcnt) { + char *signalname = GvNAME(gv); + HV *stash = GvSTASH(gv); + + // $meta = $stash->{META} + SV **svp = hv_fetch(stash, "META", 4, 0); + if(!svp) return 0; + HV *hv = GvHV((GV*)*svp); + if(!hv) return 0; + + // $metaobject = $meta->{object} + // aka. Class->staticMetaObject + svp = hv_fetch(hv, "object", 6, 0); + if(!svp) return 0; + smokeperl_object *ometa = sv_obj_info(*svp); + if(!ometa) return 0; + TQMetaObject *metaobject = (TQMetaObject*)ometa->ptr; + + offset = metaobject->signalOffset(); + + // $signals = $meta->{signal} + U32 len = strlen(name); + svp = hv_fetch(hv, name, len, 0); + if(!svp) return 0; + HV *signalshv = (HV*)SvRV(*svp); + + // $signal = $signals->{$signalname} + len = strlen(signalname); + svp = hv_fetch(signalshv, signalname, len, 0); + if(!svp) return 0; + HV *signalhv = (HV*)SvRV(*svp); + + // $index = $signal->{index} + svp = hv_fetch(signalhv, "index", 5, 0); + if(!svp) return 0;; + index = SvIV(*svp); + + // $argcnt = $signal->{argcnt} + svp = hv_fetch(signalhv, "argcnt", 6, 0); + if(!svp) return 0; + argcnt = SvIV(*svp); + + // $mocargs = $signal->{mocargs} + svp = hv_fetch(signalhv, "mocargs", 7, 0); + if(!svp) return 0; + MocArgument *args = (MocArgument*)SvIV(*svp); + + return args; +} + +MocArgument *getslotinfo(GV *gv, int id, char *&slotname, int &index, int &argcnt, bool isSignal = false) { + HV *stash = GvSTASH(gv); + + // $meta = $stash->{META} + SV **svp = hv_fetch(stash, "META", 4, 0); + if(!svp) return 0; + HV *hv = GvHV((GV*)*svp); + if(!hv) return 0; + + // $metaobject = $meta->{object} + // aka. Class->staticMetaObject + svp = hv_fetch(hv, "object", 6, 0); + if(!svp) return 0; + smokeperl_object *ometa = sv_obj_info(*svp); + if(!ometa) return 0; + TQMetaObject *metaobject = (TQMetaObject*)ometa->ptr; + + int offset = isSignal ? metaobject->signalOffset() : metaobject->slotOffset(); + + index = id - offset; // where we at + // FIXME: make slot inheritance work + if(index < 0) return 0; + // $signals = $meta->{signal} + const char *key = isSignal ? "signals" : "slots"; + svp = hv_fetch(hv, key, strlen(key), 0); + if(!svp) return 0; + AV *signalsav = (AV*)SvRV(*svp); + svp = av_fetch(signalsav, index, 0); + if(!svp) return 0; + HV *signalhv = (HV*)SvRV(*svp); + // $argcnt = $signal->{argcnt} + svp = hv_fetch(signalhv, "argcnt", 6, 0); + if(!svp) return 0; + argcnt = SvIV(*svp); + // $mocargs = $signal->{mocargs} + svp = hv_fetch(signalhv, "mocargs", 7, 0); + if(!svp) return 0; + MocArgument *args = (MocArgument*)SvIV(*svp); + + svp = hv_fetch(signalhv, "name", 4, 0); + if(!svp) return 0; + slotname = SvPV_nolen(*svp); + + return args; +} + +XS(XS_signal) { + dXSARGS; + + smokeperl_object *o = sv_obj_info(sv_this); + TQObject *qobj = (TQObject*)o->smoke->cast( + o->ptr, + o->classId, + o->smoke->idClass("TQObject") + ); + if(qobj->signalsBlocked()) XSRETURN_UNDEF; + + int offset; + int index; + int argcnt; + MocArgument *args; + + args = getmetainfo(CvGV(cv), "signal", offset, index, argcnt); + if(!args) XSRETURN_UNDEF; + + // Okay, we have the signal info. *whew* + if(items < argcnt) + croak("Insufficient arguments to emit signal"); + + EmitSignal signal(qobj, offset + index, argcnt, args, &ST(0)); + signal.next(); + + XSRETURN_UNDEF; +} + +XS(XS_qt_invoke) { + dXSARGS; + // Arguments: int id, TQUObject *o + int id = SvIV(ST(0)); + TQUObject *_o = (TQUObject*)SvIV(SvRV(ST(1))); + + smokeperl_object *o = sv_obj_info(sv_this); + TQObject *qobj = (TQObject*)o->smoke->cast( + o->ptr, + o->classId, + o->smoke->idClass("TQObject") + ); + + // Now, I need to find out if this means me + int index; + char *slotname; + int argcnt; + MocArgument *args; + bool isSignal = !strcmp(GvNAME(CvGV(cv)), "qt_emit"); + args = getslotinfo(CvGV(cv), id, slotname, index, argcnt, isSignal); + if(!args) { + // throw an exception - evil style + temporary_virtual_function_success = false; + XSRETURN_UNDEF; + } + HV *stash = GvSTASH(CvGV(cv)); + GV *gv = gv_fetchmethod_autoload(stash, slotname, 0); + if(!gv) XSRETURN_UNDEF; + InvokeSlot slot(qobj, gv, argcnt, args, _o); + slot.next(); + + XSRETURN_UNDEF; +} + +// ------------------- Tied types ------------------------ + +MODULE = TQt PACKAGE = TQt::_internal::TQString +PROTOTYPES: DISABLE + +SV* +FETCH(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + TQString *s = (TQString*) tmp; + RETVAL = newSV(0); + if( s ) + { + if(!(IN_BYTES)) + { + sv_setpv_mg(RETVAL, (const char *)s->utf8()); + SvUTF8_on(RETVAL); + } + else if(IN_LOCALE) + sv_setpv_mg(RETVAL, (const char *)s->local8Bit()); + else + sv_setpv_mg(RETVAL, (const char *)s->latin1()); + } + else + sv_setsv_mg(RETVAL, &PL_sv_undef); + OUTPUT: + RETVAL + +void +STORE(obj,what) + SV* obj + SV* what + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + TQString *s = (TQString*) tmp; + s->truncate(0); + if(SvOK(what)) { + if(SvUTF8(what)) + s->append(TQString::fromUtf8(SvPV_nolen(what))); + else if(IN_LOCALE) + s->append(TQString::fromLocal8Bit(SvPV_nolen(what))); + else + s->append(TQString::fromLatin1(SvPV_nolen(what))); + } + +void +DESTROY(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + TQString *s = (TQString*) tmp; + delete s; + +MODULE = TQt PACKAGE = TQt::_internal::TQByteArray +PROTOTYPES: DISABLE + +SV* +FETCH(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + TQByteArray *s = (TQByteArray*) tmp; + RETVAL = newSV(0); + if( s ) + { + sv_setpvn_mg(RETVAL, s->data(), s->size()); + } + else + sv_setsv_mg(RETVAL, &PL_sv_undef); + OUTPUT: + RETVAL + +void +STORE(obj,what) + SV* obj + SV* what + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + TQByteArray *s = (TQByteArray*) tmp; + + if(SvOK(what)) { + STRLEN len; + char* tmp2 = SvPV(what, len); + s->resize(len); + Copy((void*)tmp2, (void*)s->data(), len, char); + } else + s->truncate(0); + +void +DESTROY(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + TQByteArray *s = (TQByteArray*) tmp; + delete s; + +MODULE = TQt PACKAGE = TQt::_internal::TQRgbStar +PROTOTYPES: DISABLE + +SV* +FETCH(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + TQRgb *s = (TQRgb*) tmp; + AV* ar = newAV(); + RETVAL = newRV_noinc((SV*)ar); + for(int i=0; s[i] ; i++) + { + SV *item = newSViv((IV)s[i]); + if(!av_store(ar, (I32)i, item)) + SvREFCNT_dec( item ); + } + OUTPUT: + RETVAL + +void +STORE(obj,sv) + SV* obj + SV* sv + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + TQRgb *s = (TQRgb*) tmp; + if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV || + av_len((AV*)SvRV(sv)) < 0) { + s = new TQRgb[1]; + s[0] = 0; + sv_setref_pv(obj, "TQt::_internal::TQRgbStar", (void*)s); + return; + } + AV *list = (AV*)SvRV(sv); + int count = av_len(list); + s = new TQRgb[count + 2]; + int i; + for(i = 0; i <= count; i++) { + SV **item = av_fetch(list, i, 0); + if(!item || !SvOK(*item)) { + s[i] = 0; + continue; + } + s[i] = SvIV(*item); + } + s[i] = 0; + sv_setref_pv(obj, "TQt::_internal::TQRgbStar", (void*)s); + +void +DESTROY(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + TQRgb *s = (TQRgb*) tmp; + delete[] s; + +# --------------- XSUBS for TQt::_internal::* helpers ---------------- + + +MODULE = TQt PACKAGE = TQt::_internal +PROTOTYPES: DISABLE + +void +getMethStat() + PPCODE: + XPUSHs(sv_2mortal(newSViv((int)methcache->size()))); + XPUSHs(sv_2mortal(newSViv((int)methcache->count()))); + +void +getClassStat() + PPCODE: + XPUSHs(sv_2mortal(newSViv((int)classcache->size()))); + XPUSHs(sv_2mortal(newSViv((int)classcache->count()))); + +void +getIsa(classId) + int classId + PPCODE: + Smoke::Index *parents = + qt_Smoke->inheritanceList + + qt_Smoke->classes[classId].parents; + while(*parents) + XPUSHs(sv_2mortal(newSVpv(qt_Smoke->classes[*parents++].className, 0))); + +void +dontRecurse() + CODE: + avoid_fetchmethod = true; + +void * +sv_to_ptr(sv) + SV* sv + +void * +allocateMocArguments(count) + int count + CODE: + RETVAL = (void*)new MocArgument[count + 1]; + OUTPUT: + RETVAL + +void +setMocType(ptr, idx, name, static_type) + void *ptr + int idx + char *name + char *static_type + CODE: + Smoke::Index typeId = qt_Smoke->idType(name); + if(!typeId) XSRETURN_NO; + MocArgument *arg = (MocArgument*)ptr; + arg[idx].st.set(qt_Smoke, typeId); + if(!strcmp(static_type, "ptr")) + arg[idx].argType = xmoc_ptr; + else if(!strcmp(static_type, "bool")) + arg[idx].argType = xmoc_bool; + else if(!strcmp(static_type, "int")) + arg[idx].argType = xmoc_int; + else if(!strcmp(static_type, "double")) + arg[idx].argType = xmoc_double; + else if(!strcmp(static_type, "char*")) + arg[idx].argType = xmoc_charstar; + else if(!strcmp(static_type, "TQString")) + arg[idx].argType = xmoc_TQString; + XSRETURN_YES; + +void +installsignal(name) + char *name + CODE: + char *file = __FILE__; + newXS(name, XS_signal, file); + +void +installqt_invoke(name) + char *name + CODE: + char *file = __FILE__; + newXS(name, XS_qt_invoke, file); + +void +setDebug(on) + int on + CODE: + do_debug = on; + +int +debug() + CODE: + RETVAL = do_debug; + OUTPUT: + RETVAL + +char * +getTypeNameOfArg(method, idx) + int method + int idx + CODE: + Smoke::Method &m = qt_Smoke->methods[method]; + Smoke::Index *args = qt_Smoke->argumentList + m.args; + RETVAL = (char*)qt_Smoke->types[args[idx]].name; + OUTPUT: + RETVAL + +int +classIsa(className, base) + char *className + char *base + CODE: + RETVAL = isDerivedFrom(qt_Smoke, className, base, 0); + OUTPUT: + RETVAL + +void +insert_pclassid(p, ix) + char *p + int ix + CODE: + classcache->insert(p, new Smoke::Index((Smoke::Index)ix)); + +int +find_pclassid(p) + char *p + CODE: + Smoke::Index *r = classcache->find(p); + if(r) + RETVAL = (int)*r; + else + RETVAL = 0; + OUTPUT: + RETVAL + +void +insert_mcid(mcid, ix) + char *mcid + int ix + CODE: + methcache->insert(mcid, new Smoke::Index((Smoke::Index)ix)); + +int +find_mcid(mcid) + char *mcid + CODE: + Smoke::Index *r = methcache->find(mcid); + if(r) + RETVAL = (int)*r; + else + RETVAL = 0; + OUTPUT: + RETVAL + +char * +getSVt(sv) + SV *sv + CODE: + RETVAL=get_SVt(sv); + OUTPUT: + RETVAL + +void * +make_TQUParameter(name, type, extra, inout) + char *name + char *type + SV *extra + int inout + CODE: + TQUParameter *p = new TQUParameter; + p->name = new char[strlen(name) + 1]; + strcpy((char*)p->name, name); + if(!strcmp(type, "bool")) + p->type = &static_TQUType_bool; + else if(!strcmp(type, "int")) + p->type = &static_TQUType_int; + else if(!strcmp(type, "double")) + p->type = &static_TQUType_double; + else if(!strcmp(type, "char*") || !strcmp(type, "const char*")) + p->type = &static_TQUType_charstar; + else if(!strcmp(type, "TQString") || !strcmp(type, "TQString&") || + !strcmp(type, "const TQString") || !strcmp(type, "const TQString&")) + p->type = &static_TQUType_TQString; + else + p->type = &static_TQUType_ptr; + // Lacking support for several types. Evil. + p->inOut = inout; + p->typeExtra = 0; + RETVAL = (void*)p; + OUTPUT: + RETVAL + +void * +make_TQMetaData(name, method) + char *name + void *method + CODE: + TQMetaData *m = new TQMetaData; // will be deleted + m->name = new char[strlen(name) + 1]; + strcpy((char*)m->name, name); + m->method = (TQUMethod*)method; + m->access = TQMetaData::Public; + RETVAL = m; + OUTPUT: + RETVAL + +void * +make_TQUMethod(name, params) + char *name + SV *params + CODE: + TQUMethod *m = new TQUMethod; // permanent memory allocation + m->name = new char[strlen(name) + 1]; // this too + strcpy((char*)m->name, name); + m->count = 0; + m->parameters = 0; + if(SvOK(params) && SvRV(params)) { + AV *av = (AV*)SvRV(params); + m->count = av_len(av) + 1; + if(m->count > 0) { + m->parameters = new TQUParameter[m->count]; + for(int i = 0; i < m->count; i++) { + SV *sv = av_shift(av); + if(!SvOK(sv)) + croak("Invalid paramater for TQUMethod\n"); + TQUParameter *p = (TQUParameter*)SvIV(sv); + SvREFCNT_dec(sv); + ((TQUParameter*)m->parameters)[i] = *p; + delete p; + } + } else + m->count = 0; + } + RETVAL = m; + OUTPUT: + RETVAL + +void * +make_TQMetaData_tbl(list) + SV *list + CODE: + RETVAL = 0; + if(SvOK(list) && SvRV(list)) { + AV *av = (AV*)SvRV(list); + int count = av_len(av) + 1; + TQMetaData *m = new TQMetaData[count]; + for(int i = 0; i < count; i++) { + SV *sv = av_shift(av); + if(!SvOK(sv)) + croak("Invalid metadata\n"); + TQMetaData *old = (TQMetaData*)SvIV(sv); + SvREFCNT_dec(sv); + m[i] = *old; + delete old; + } + RETVAL = (void*)m; + } + OUTPUT: + RETVAL + +SV * +make_metaObject(className, parent, slot_tbl, slot_count, signal_tbl, signal_count) + char *className + SV *parent + void *slot_tbl + int slot_count + void *signal_tbl + int signal_count + CODE: + smokeperl_object *po = sv_obj_info(parent); + if(!po || !po->ptr) croak("Cannot create metaObject\n"); + TQMetaObject *meta = TQMetaObject::new_metaobject( + className, (TQMetaObject*)po->ptr, + (const TQMetaData*)slot_tbl, slot_count, // slots + (const TQMetaData*)signal_tbl, signal_count, // signals + 0, 0, // properties + 0, 0, // enums + 0, 0); + + // this object-creation code is so, so wrong here + HV *hv = newHV(); + SV *obj = newRV_noinc((SV*)hv); + + smokeperl_object o; + o.smoke = qt_Smoke; + o.classId = qt_Smoke->idClass("TQMetaObject"); + o.ptr = meta; + o.allocated = true; + sv_magic((SV*)hv, sv_qapp, '~', (char*)&o, sizeof(o)); + MAGIC *mg = mg_find((SV*)hv, '~'); + mg->mg_virtual = &vtbl_smoke; + char *buf = qt_Smoke->binding->className(o.classId); + sv_bless(obj, gv_stashpv(buf, TRUE)); + delete[] buf; + RETVAL = obj; + OUTPUT: + RETVAL + +void +dumpObjects() + CODE: + hv_iterinit(pointer_map); + HE *e; + while(e = hv_iternext(pointer_map)) { + STRLEN len; + SV *sv = HeVAL(e); + printf("key = %s, refcnt = %d, weak = %d, ref? %d\n", HePV(e, len), SvREFCNT(sv), SvWEAKREF(sv), SvROK(sv)?1:0); + if(SvRV(sv)) + printf("REFCNT = %d\n", SvREFCNT(SvRV(sv))); + //SvREFCNT_dec(HeVAL(e)); + //HeVAL(e) = &PL_sv_undef; + } + +void +dangle(obj) + SV *obj + CODE: + if(SvRV(obj)) + SvREFCNT_inc(SvRV(obj)); + +void +setAllocated(obj, b) + SV *obj + bool b + CODE: + smokeperl_object *o = sv_obj_info(obj); + if(o) { + o->allocated = b; + } + +void +setqapp(obj) + SV *obj + CODE: + if(!obj || !SvROK(obj)) + croak("Invalid TQt::Application object. Couldn't set TQt::app()\n"); + sv_qapp = SvRV(obj); + +void +setThis(obj) + SV *obj + CODE: + sv_setsv_mg(sv_this, obj); + +void +deleteObject(obj) + SV *obj + CODE: + smokeperl_object *o = sv_obj_info(obj); + if(!o) { XSRETURN_EMPTY; } + TQObject *qobj = (TQObject*)o->smoke->cast(o->ptr, o->classId, o->smoke->idClass("TQObject")); + delete qobj; + +void +mapObject(obj) + SV *obj + CODE: + smokeperl_object *o = sv_obj_info(obj); + if(!o) + XSRETURN_EMPTY; + SmokeClass c( o->smoke, o->classId ); + if(!c.hasVirtual() ) { + XSRETURN_EMPTY; + } + mapPointer(obj, o, pointer_map, o->classId, 0); + +bool +isTQObject(obj) + SV *obj + CODE: + RETVAL = 0; + smokeperl_object *o = sv_obj_info(obj); + if(o && isTQObject(o->smoke, o->classId)) + RETVAL = 1; + OUTPUT: + RETVAL + +bool +isValidAllocatedPointer(obj) + SV *obj + CODE: + RETVAL = 0; + smokeperl_object *o = sv_obj_info(obj); + if(o && o->ptr && o->allocated) + RETVAL = 1; + OUTPUT: + RETVAL + +SV* +findAllocatedObjectFor(obj) + SV *obj + CODE: + RETVAL = &PL_sv_undef; + smokeperl_object *o = sv_obj_info(obj); + SV *ret; + if(o && o->ptr && (ret = getPointerObject(o->ptr))) + RETVAL = ret; + OUTPUT: + RETVAL + +SV * +getGV(cv) + SV *cv + CODE: + RETVAL = (SvROK(cv) && (SvTYPE(SvRV(cv))==SVt_PVCV) ? + SvREFCNT_inc(CvGV((CV*)SvRV(cv))) : &PL_sv_undef); + OUTPUT: + RETVAL + +int +idClass(name) + char *name + CODE: + RETVAL = qt_Smoke->idClass(name); + OUTPUT: + RETVAL + +int +idMethodName(name) + char *name + CODE: + RETVAL = qt_Smoke->idMethodName(name); + OUTPUT: + RETVAL + +int +idMethod(idclass, idmethodname) + int idclass + int idmethodname + CODE: + RETVAL = qt_Smoke->idMethod(idclass, idmethodname); + OUTPUT: + RETVAL + +void +findMethod(c, name) + char *c + char *name + PPCODE: + Smoke::Index meth = qt_Smoke->findMethod(c, name); +// printf("DAMNIT on %s::%s => %d\n", c, name, meth); + if(!meth) { + // empty list + } else if(meth > 0) { + Smoke::Index i = qt_Smoke->methodMaps[meth].method; + if(!i) { // shouldn't happen + croak("Corrupt method %s::%s", c, name); + } else if(i > 0) { // single match + PUSHs(sv_2mortal(newSViv( + (IV)qt_Smoke->methodMaps[meth].method + ))); + } else { // multiple match + i = -i; // turn into ambiguousMethodList index + while(qt_Smoke->ambiguousMethodList[i]) { + PUSHs(sv_2mortal(newSViv( + (IV)qt_Smoke->ambiguousMethodList[i] + ))); + i++; + } + } + } + +void +findMethodFromIds(idclass, idmethodname) + int idclass + int idmethodname + PPCODE: + Smoke::Index meth = qt_Smoke->findMethod(idclass, idmethodname); + if(!meth) { + // empty list + } else if(meth > 0) { + Smoke::Index i = qt_Smoke->methodMaps[meth].method; + if(i >= 0) { // single match + PUSHs(sv_2mortal(newSViv((IV)i))); + } else { // multiple match + i = -i; // turn into ambiguousMethodList index + while(qt_Smoke->ambiguousMethodList[i]) { + PUSHs(sv_2mortal(newSViv( + (IV)qt_Smoke->ambiguousMethodList[i] + ))); + i++; + } + } + } + +# findAllMethods(classid [, startingWith]) : returns { "mungedName" => [index in methods, ...], ... } + +HV* +findAllMethods(classid, ...) + SV* classid + CODE: + RETVAL=newHV(); + if(SvIOK(classid)) { + Smoke::Index c = (Smoke::Index) SvIV(classid); + char * pat = 0L; + if(items > 1 && SvPOK(ST(1))) + pat = SvPV_nolen(ST(1)); + Smoke::Index imax = qt_Smoke->numMethodMaps; + Smoke::Index imin = 0, icur = -1, methmin = 0, methmax = 0; + int icmp = -1; + while(imax >= imin) { + icur = (imin + imax) / 2; + icmp = qt_Smoke->leg(qt_Smoke->methodMaps[icur].classId, c); + if(!icmp) { + Smoke::Index pos = icur; + while(icur && qt_Smoke->methodMaps[icur-1].classId == c) + icur --; + methmin = icur; + icur = pos; + while(icur < imax && qt_Smoke->methodMaps[icur+1].classId == c) + icur ++; + methmax = icur; + break; + } + if (icmp > 0) + imax = icur - 1; + else + imin = icur + 1; + } + if(!icmp) { + for(Smoke::Index i=methmin ; i <= methmax ; i++) { + Smoke::Index m = qt_Smoke->methodMaps[i].name; + if(!pat || !strncmp(qt_Smoke->methodNames[m], pat, strlen(pat))) { + Smoke::Index ix= qt_Smoke->methodMaps[i].method; + AV* meths = newAV(); + if(ix >= 0) { // single match + av_push(meths, newSViv((IV)ix)); + } else { // multiple match + ix = -ix; // turn into ambiguousMethodList index + while(qt_Smoke->ambiguousMethodList[ix]) { + av_push(meths, newSViv((IV)qt_Smoke->ambiguousMethodList[ix])); + ix++; + } + } + hv_store(RETVAL, qt_Smoke->methodNames[m],strlen(qt_Smoke->methodNames[m]),newRV_inc((SV*)meths),0); + } + } + } + } + OUTPUT: + RETVAL + +SV * +dumpCandidates(rmeths) + SV *rmeths + CODE: + if(SvROK(rmeths) && SvTYPE(SvRV(rmeths)) == SVt_PVAV) { + AV *methods = (AV*)SvRV(rmeths); + SV *errmsg = newSVpvf(""); + for(int i = 0; i <= av_len(methods); i++) { + sv_catpv(errmsg, "\t"); + IV id = SvIV(*(av_fetch(methods, i, 0))); + Smoke::Method &meth = qt_Smoke->methods[id]; + const char *tname = qt_Smoke->types[meth.ret].name; + if(meth.flags & Smoke::mf_static) sv_catpv(errmsg, "static "); + sv_catpvf(errmsg, "%s ", (tname ? tname:"void")); + sv_catpvf(errmsg, "%s::%s(", qt_Smoke->classes[meth.classId].className, qt_Smoke->methodNames[meth.name]); + for(int i = 0; i < meth.numArgs; i++) { + if(i) sv_catpv(errmsg, ", "); + tname = qt_Smoke->types[qt_Smoke->argumentList[meth.args+i]].name; + sv_catpv(errmsg, (tname ? tname:"void")); + } + sv_catpv(errmsg, ")"); + if(meth.flags & Smoke::mf_const) sv_catpv(errmsg, " const"); + sv_catpv(errmsg, "\n"); + } + RETVAL=errmsg; + } + else + RETVAL=newSVpvf(""); + OUTPUT: + RETVAL + +SV * +catArguments(r_args) + SV* r_args + CODE: + RETVAL=newSVpvf(""); + if(SvROK(r_args) && SvTYPE(SvRV(r_args)) == SVt_PVAV) { + AV* args=(AV*)SvRV(r_args); + for(int i = 0; i <= av_len(args); i++) { + SV **arg=av_fetch(args, i, 0); + if(i) sv_catpv(RETVAL, ", "); + if(!arg || !SvOK(*arg)) { + sv_catpv(RETVAL, "undef"); + } else if(SvROK(*arg)) { + smokeperl_object *o = sv_obj_info(*arg); + if(o) + sv_catpv(RETVAL, o->smoke->className(o->classId)); + else + sv_catsv(RETVAL, *arg); + } else { + bool isString = SvPOK(*arg); + STRLEN len; + char *s = SvPV(*arg, len); + if(isString) sv_catpv(RETVAL, "'"); + sv_catpvn(RETVAL, s, len > 10 ? 10 : len); + if(len > 10) sv_catpv(RETVAL, "..."); + if(isString) sv_catpv(RETVAL, "'"); + } + } + } + OUTPUT: + RETVAL + +SV * +callMethod(...) + PPCODE: + if(_current_method) { + MethodCall c(qt_Smoke, _current_method, &ST(0), items); + c.next(); + SV *ret = c.var(); + SvREFCNT_inc(ret); + PUSHs(sv_2mortal(ret)); + } else + PUSHs(sv_newmortal()); + +bool +isObject(obj) + SV *obj + CODE: + RETVAL = sv_to_ptr(obj) ? TRUE : FALSE; + OUTPUT: + RETVAL + +void +setCurrentMethod(meth) + int meth + CODE: + // FIXME: damn, this is lame, and it doesn't handle ambiguous methods + _current_method = meth; //qt_Smoke->methodMaps[meth].method; + +SV * +getClassList() + CODE: + AV *av = newAV(); + for(int i = 1; i <= qt_Smoke->numClasses; i++) { +//printf("%s => %d\n", qt_Smoke->classes[i].className, i); + av_push(av, newSVpv(qt_Smoke->classes[i].className, 0)); +// hv_store(hv, qt_Smoke->classes[i].className, 0, newSViv(i), 0); + } + RETVAL = newRV((SV*)av); + OUTPUT: + RETVAL + +void +installthis(package) + char *package + CODE: + if(!package) XSRETURN_EMPTY; + char *name = new char[strlen(package) + 7]; + char *file = __FILE__; + strcpy(name, package); + strcat(name, "::this"); + // *{ $name } = sub () : lvalue; + CV *thissub = newXS(name, XS_this, file); + sv_setpv((SV*)thissub, ""); // sub this () : lvalue; + delete[] name; + +void +installattribute(package, name) + char *package + char *name + CODE: + if(!package || !name) XSRETURN_EMPTY; + char *attr = new char[strlen(package) + strlen(name) + 3]; + sprintf(attr, "%s::%s", package, name); + char *file = __FILE__; + // *{ $attr } = sub () : lvalue; + CV *attrsub = newXS(attr, XS_attr, file); + sv_setpv((SV*)attrsub, ""); + CvLVALUE_on(attrsub); + CvNODEBUG_on(attrsub); + delete[] attr; + +void +installsuper(package) + char *package + CODE: + if(!package) XSRETURN_EMPTY; + char *attr = new char[strlen(package) + 8]; + sprintf(attr, "%s::SUPER", package); + char *file = __FILE__; + CV *attrsub = newXS(attr, XS_super, file); + sv_setpv((SV*)attrsub, ""); + delete[] attr; + +void +installautoload(package) + char *package + CODE: + if(!package) XSRETURN_EMPTY; + char *autoload = new char[strlen(package) + 11]; + strcpy(autoload, package); + strcat(autoload, "::_UTOLOAD"); + char *file = __FILE__; + // *{ $package."::AUTOLOAD" } = XS_AUTOLOAD + newXS(autoload, XS_AUTOLOAD, file); + delete[] autoload; + +# ----------------- XSUBS for TQt:: ----------------- + +MODULE = TQt PACKAGE = TQt + +SV * +this() + CODE: + RETVAL = newSVsv(sv_this); + OUTPUT: + RETVAL + +SV * +app() + CODE: + RETVAL = newRV_inc(sv_qapp); + OUTPUT: + RETVAL + +SV * +version() + CODE: + RETVAL = newSVpv(TQT_VERSION_STR,0); + OUTPUT: + RETVAL + +BOOT: + init_qt_Smoke(); + qt_Smoke->binding = new TQtSmokeBinding(qt_Smoke); + install_handlers(TQt_handlers); + pointer_map = newHV(); + sv_this = newSV(0); + methcache = new TQAsciiDict<Smoke::Index>(1187); + classcache = new TQAsciiDict<Smoke::Index>(827); + methcache->setAutoDelete(1); + classcache->setAutoDelete(1); |