Changeset 17923 in project


Ignore:
Timestamp:
04/26/10 12:41:18 (9 years ago)
Author:
felix
Message:

created branch with changes from Andrei Barbu

Location:
release/4/qt/branches/0xab
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/qt/branches/0xab/main.cpp

    r17381 r17923  
    11/* main.cpp */
    2 
    32
    43#include <QtGui>
    54#include <QtUiTools>
    65#include <QGLWidget>
     6#include <QtCore>
     7#include <QtDBus>
     8#include <QHttp>
    79#include <chicken.h>
    810#include <assert.h>
    911
    10 
    11 #define ___safe
    1212#define ___bool         int
    1313#define ___out
     
    1616static int qt_char_encoding = 1;        // 0=latin1, 1=utf8, 2=ascii
    1717
    18 
    19 class SimpleReceiver: public QObject
    20 {
    21   Q_OBJECT
    22 
     18struct variantlist_fun
     19{
     20  virtual void operator()(C_word w) = 0;
     21};
     22
     23static void qt_variantlist_do_one(QVariantList* l, variantlist_fun* fun, C_word **storage, int i);
     24static int qt_variantlist_storage(QVariantList* l, int i);
     25
     26// We have to craft a custom QObject and lie about its slots so that
     27// we'll get the appropriate qt_metacall. We can get away without
     28// this by the qt-approved method of connecting by explicitly
     29// specifying the ids of the methods. Unfortunately whoever
     30// implemented QtDBus broke this by having QtDBus provide its own
     31// incompatible connect that insists on named slots
     32
     33static const uint qt_meta_data_QDynamicReceiver[] = {
     34  // content:
     35  4,       // revision
     36  0,       // classname
     37  0,    0, // classinfo
     38  0,   14, // methods
     39  0,    0, // properties
     40  0,    0, // enums/sets
     41  0,    0, // constructors
     42  0,       // flags
     43  0,       // signalCount
     44
     45  // slots: signature, parameters, type, tag, flags
     46  18,   17,   17,   17, 0x0a,
     47
     48  0        // eod
     49};
     50
     51static const char qt_meta_stringdata_QDynamicReceiver[] = {
     52  "QDynamicReceiver\0\0\0\0\0\0" };
     53
     54struct QDynamicReceiver: public QObject
     55{
    2356  void *thunk;
    24 
    25 public:
    26 
    27   SimpleReceiver(char *name, C_word proc) {
    28     setObjectName(name);
    29     thunk = CHICKEN_new_gc_root();
    30     CHICKEN_gc_root_set(thunk, proc);
    31   }
    32 
    33   ~SimpleReceiver() { CHICKEN_delete_gc_root(thunk); }
    34 
    35 public slots:
    36   void slot() { C_callback(CHICKEN_gc_root_ref(thunk), 0); }
     57  QList<QMetaType::Type> argument_types;
     58  QMetaObject m;
     59  char* stringdata;
     60
     61  static const QMetaObject staticMetaObject;
     62
     63#ifdef Q_NO_DATA_RELOCATION
     64  const QMetaObject &getStaticMetaObject() { return staticMetaObject; }
     65#endif //Q_NO_DATA_RELOCATION
     66
     67  const QMetaObject *metaObject() const { return &m; }
     68
     69  void *qt_metacast(const char *_clname);
     70
     71  QDynamicReceiver(char *name, char *slot, C_word proc);
     72  ~QDynamicReceiver();
     73
     74  virtual int qt_metacall(QMetaObject::Call c, int id, void **arguments);
     75
     76private:
     77  void setupMetaObject(char *method);
     78  void fill_types(const QMetaMethod &member);
    3779};
    3880
     81// Nothing interesting here, standard Qt boilerplate
     82void *QDynamicReceiver::qt_metacast(const char *_clname)
     83{
     84  if (!_clname) return 0;
     85  if (!strcmp(_clname, qt_meta_stringdata_QDynamicReceiver))
     86    return static_cast<void*>(const_cast< QDynamicReceiver*>(this));
     87  return QObject::qt_metacast(_clname);
     88}
     89
     90void QDynamicReceiver::setupMetaObject(char *method)
     91{
     92  m = QMetaObject(staticMetaObject);
     93  m.d.data = new uint[sizeof(qt_meta_data_QDynamicReceiver)];
     94  memcpy(const_cast<uint*>(m.d.data), qt_meta_data_QDynamicReceiver,
     95         sizeof(qt_meta_data_QDynamicReceiver));
     96
     97  uint* data = const_cast<uint*>(m.d.data);
     98  int method_data = data[m.methodOffset()+1];
     99
     100  QString tmp;
     101
     102  tmp.append(m.className()).append(QChar::Null);
     103  data[method_data+3] = tmp.length();
     104  tmp.append(QChar::Null);
     105  data[method_data+2] = tmp.length();
     106  tmp.append(QMetaObject::normalizedType("")).append(QChar::Null);
     107  // Are parameter names really needed?
     108  data[method_data+1] = tmp.length();
     109  tmp.append(QChar::Null);
     110  data[method_data] = tmp.length();
     111  tmp.append(QMetaObject::normalizedSignature(method)).append(QChar::Null).append(QChar::Null);
     112
     113  stringdata = new char[tmp.length()];
     114  memcpy(stringdata, tmp.toAscii().data(), tmp.length());
     115
     116  m.d.stringdata = stringdata;
     117  data[m.methodOffset()] = 1;
     118}
     119
     120const QMetaObject QDynamicReceiver::staticMetaObject = {
     121  { &QObject::staticMetaObject, qt_meta_stringdata_QDynamicReceiver,
     122    qt_meta_data_QDynamicReceiver, 0 }
     123};
     124
     125QDynamicReceiver::QDynamicReceiver(char *name, char *slot, C_word proc)
     126{
     127  setObjectName(name);
     128  thunk = CHICKEN_new_gc_root();
     129  CHICKEN_gc_root_set(thunk, proc);
     130
     131  setupMetaObject(slot + 1);
     132  fill_types(m.method(4));
     133}
     134
     135QDynamicReceiver::~QDynamicReceiver()
     136{
     137  delete stringdata;
     138  delete m.d.data;
     139  CHICKEN_delete_gc_root(thunk);
     140}
     141
     142int QDynamicReceiver::qt_metacall(QMetaObject::Call c, int id,
     143                                  void **arguments)
     144{
     145  id = QObject::qt_metacall(c, id, arguments);
     146  if (id < 0 || c != QMetaObject::InvokeMetaMethod)
     147    return id;
     148
     149  QVariantList l;
     150  for(int i = 0; i < argument_types.count(); ++i)
     151  {
     152    // TODO This is temporary as I have no idea how Qt wraps
     153    // pointers passed into qt_metacall
     154    if(argument_types.at(i))
     155      l << QVariant(argument_types.at(i), arguments[i + 1]);
     156  }
     157
     158  struct f_ : public variantlist_fun { void operator()(C_word o) { C_save(o); } } f;
     159
     160  int size = 0;
     161  const int count = l.size();
     162
     163  for(int i = 0; i < count; ++i)
     164    size += qt_variantlist_storage(&l, i);
     165
     166  C_word *storage = C_alloc(size);
     167
     168  for(int i = 0; i < count; ++i)
     169    qt_variantlist_do_one(&l, &f, &storage, i);
     170
     171  l.clear();
     172
     173  C_callback(CHICKEN_gc_root_ref(thunk), count);
     174  return -1;
     175}
     176
     177void QDynamicReceiver::fill_types(const QMetaMethod &member)
     178{
     179  QList<QByteArray> params = member.parameterTypes();
     180  for (int i = 0; i < params.count(); ++i)
     181    argument_types << (QMetaType::Type)(QMetaType::type(params.at(i).constData()));
     182}
    39183
    40184class GLWidget: public QGLWidget
    41185{
    42186  void *thunk;
     187
     188  Q_OBJECT
    43189
    44190public:
    45191  GLWidget(char *name, QWidget *parent, C_word proc) : QGLWidget(parent) {
    46192    setObjectName(name);
    47     thunk = CHICKEN_new_gc_root(); 
     193    thunk = CHICKEN_new_gc_root();
    48194    CHICKEN_gc_root_set(thunk, proc);
    49195  }
     
    55201  void initializeGL() { C_save(C_fix(0)); C_callback(CHICKEN_gc_root_ref(thunk), 1); }
    56202  // setup viewport, projection etc.:
    57   void resizeGL(int w, int h) { C_save(C_fix(1)); C_save(C_fix(w)); C_save(C_fix(h)); C_callback(CHICKEN_gc_root_ref(thunk), 3); }
     203  void resizeGL(int w, int h)
     204  { C_save(C_fix(1)); C_save(C_fix(w)); C_save(C_fix(h));
     205    C_callback(CHICKEN_gc_root_ref(thunk), 3); }
    58206  // draw the scene:
    59207  void paintGL() { C_save(C_fix(2)); C_callback(CHICKEN_gc_root_ref(thunk), 1); }
    60208};
    61209
    62 
    63210#define qtobject          QObject *
    64211#define qtapplication     QApplication *
    65 #define qtreceiver        SimpleReceiver *
     212#define qtdynamicreceiver QDynamicReceiver *
    66213#define qtwidget          QWidget *
    67 #define qtpixmap           QPixmap *
     214#define qtpixmap          QPixmap *
    68215#define qttimer           QTimer *
    69216#define qtsound           QSound *
    70217#define qttextedit        QTextEdit *
    71218#define qtaction          QAction *
    72 
    73 extern "C" {
     219#define qtvariantlist     QVariantList *
     220#define qtdbusconnection  QDBusConnection *
     221#define qtvariantlist     QVariantList *
     222#define qthttp            QHttp *
     223
    74224#include "prototypes.h"
    75 }
    76 
    77225
    78226#include "main.moc"
    79 
    80227
    81228QApplication *qt_init()
     
    85232  return qApp;
    86233}
    87 
    88234
    89235QWidget *qt_create(char *string, QWidget *parent)
     
    99245}
    100246
    101 
    102247___bool qt_run(___bool once)
    103248{
     
    108253  else return qApp->exec();
    109254}
    110 
    111255
    112256void qt_show(QWidget *w) { w->show(); }
     
    114258void qt_deleteobject(QObject *o) { delete o; }
    115259void qt_deletepixmap(QPixmap *o) { delete o; }
    116 ___bool qt_connect(QWidget *w1, char *sig, QObject *w2, char *slot) { return QObject::connect(w1, sig, w2, slot); }
    117 QWidget *qt_find(QWidget *parent, char *name) { return parent->findChild<QWidget *>(QString(name)); }
    118 QObject *qt_receiver(char *name, C_word proc) { return new SimpleReceiver(name, proc); }
    119 
    120 
    121 char *qstrdata(const QString &str)
     260___bool qt_connect(QObject *w1, char *sig, QObject *w2, char *slot)
     261{ return QObject::connect(w1, sig, w2, slot); }
     262___bool qt_disconnect(QObject *w1, char *sig, QObject *w2, char *slot)
     263{ return QObject::disconnect(w1, sig, w2, slot); }
     264QWidget *qt_find(QWidget *parent, char *name)
     265{ return parent->findChild<QWidget *>(QString(name)); }
     266
     267QDynamicReceiver *qt_dynamicreceiver(char *name, char *slot, C_word proc)
     268{ return new QDynamicReceiver(name, slot, proc); }
     269
     270void qt_variant_list_insert_back_int(QVariantList *l, int a) { *l << a; }
     271void qt_variant_list_insert_back_string(QVariantList *l, char *s) { *l << s; }
     272void qt_variant_list_insert_back_bool(QVariantList *l, int a) { *l << (bool)a; }
     273void qt_variant_list_insert_back_uint(QVariantList *l, int a) { *l << (unsigned)a; }
     274void qt_variant_list_insert_back_double(QVariantList *l, double a) { *l << a; }
     275
     276QVariantList* qt_make_variantlist() { return new QVariantList; }
     277void qt_destroy_variantlist(QVariantList *l) { delete l; }
     278
     279void qt_variant_list_discard_front(QVariantList *l) { l->pop_front(); }
     280int qt_variant_list_length(QVariantList *l) { return l->length(); }
     281
     282QDBusConnection *qt_dbus_session_bus()
     283{ return new QDBusConnection(QDBusConnection::sessionBus()); }
     284QDBusConnection *qt_dbus_system_bus()
     285{ return new QDBusConnection(QDBusConnection::systemBus()); }
     286void qt_destroy_dbus_connection(QDBusConnection *c) { delete c; }
     287
     288___bool qt_c_dbus_connect(QDBusConnection *c,
     289                        char *service, char *object,
     290                        char *interface, char *signal,
     291                        QObject *w2, char *slot)
     292{ return c->connect(service, object, interface, signal, w2, slot); }
     293___bool qt_dbus_disconnect(QDBusConnection *c,
     294                             char *service, char *object,
     295                           char *interface, char *signal,
     296                           QObject *w2, char *slot)
     297{ return c->disconnect(service, object, interface, signal, w2, slot); }
     298void qt_c_dbus_list_names(QDBusConnection *bus, QVariantList* l)
     299{
     300  QStringList serviceNames = bus->interface()->registeredServiceNames();
     301  for(int i = 0; i < serviceNames.length(); ++i)
     302    *l << *(new QString(serviceNames.at(i)));
     303}
     304___bool qt_c_dbus_send_signal(QDBusConnection *bus, char *object,
     305                            char *interface, char *signal, QVariantList* l)
     306{
     307  QDBusMessage message = QDBusMessage::createSignal(object, interface, signal);
     308  message.setArguments(*l);
     309  return bus->send(message);
     310}
     311
     312___bool qt_dbus_register_object(QDBusConnection *bus, char *path, QObject *obj)
     313{ return bus->registerObject(path, obj, QDBusConnection::ExportAllSlots); }
     314void qt_dbus_unregister_object(QDBusConnection *bus, char *path)
     315{ bus->unregisterObject(path); }
     316___bool qt_dbus_method_call(QDBusConnection *bus, char *service, char *path,
     317                            char *interface, char *method, QVariantList* l)
     318{
     319  QDBusMessage msg = QDBusMessage::createMethodCall(service, path, interface, method);
     320  msg.setArguments(*l);
     321
     322  QDBusMessage reply = bus->call(msg, QDBus::BlockWithGui);
     323  l->clear();
     324  l->push_back((int)reply.type());
     325  if(QDBusMessage::ErrorMessage == reply.type())
     326    l->push_back(reply.errorName());
     327  if(reply.arguments().length() && reply.arguments().at(0).isValid())
     328    l->append(reply.arguments());
     329  return (reply.type() != QDBusMessage::ErrorMessage
     330          && reply.type() != QDBusMessage::InvalidMessage);
     331}
     332
     333___bool qt_dbus_method_call_with_callback(QDBusConnection *bus, char *service, char *path,
     334                                                  char *interface, char *method, QVariantList *l,
     335                                                  QObject *obj, char *slot)
     336{
     337  QDBusMessage msg = QDBusMessage::createMethodCall(service, path, interface, method);
     338  msg.setArguments(*l);
     339  return bus->callWithCallback(msg, obj, slot);
     340}
     341
     342
     343___bool qt_dbus_register_service(QDBusConnection *bus, char *service)
     344{ return bus->interface()->registerService(service); }
     345___bool qt_dbus_unregister_service(QDBusConnection *bus, char *service)
     346{ return bus->unregisterService(service); }
     347
     348___bool qt_invokemethod(QObject *o, char *signal, QVariantList *arguments)
     349{
     350  int idx = o->metaObject()->indexOfMethod(signal+1);
     351
     352  if(idx < 0) return false;
     353
     354  const char *typeName = o->metaObject()->method(idx).typeName();
     355  int resultType = QMetaType::type(typeName);
     356  void *result = QMetaType::construct(resultType, 0);
     357
     358  QList<QGenericArgument> genericArgs;
     359
     360  for(QList<QVariant>::ConstIterator iter = arguments->begin();
     361      iter != arguments->end();
     362      ++iter)
     363    genericArgs << QGenericArgument(iter->typeName(),iter->data());
     364
     365  QGenericReturnArgument ret( typeName, result );
     366  QByteArray signature = o->metaObject()->method(idx).signature();
     367
     368  if(QMetaObject::invokeMethod(o,
     369                               signature.left(signature.indexOf('(')),
     370                               ret,
     371                               genericArgs.value(0, QGenericArgument()),
     372                               genericArgs.value(1, QGenericArgument()),
     373                               genericArgs.value(2, QGenericArgument()),
     374                               genericArgs.value(3, QGenericArgument()),
     375                               genericArgs.value(4, QGenericArgument()),
     376                               genericArgs.value(5, QGenericArgument()),
     377                               genericArgs.value(6, QGenericArgument()),
     378                               genericArgs.value(7, QGenericArgument()),
     379                               genericArgs.value(8, QGenericArgument()),
     380                               genericArgs.value(9, QGenericArgument())))
     381  {
     382    QVariant returnValue(resultType, result);
     383    QMetaType::destroy(resultType, result);
     384    if(resultType != QVariant::Invalid)
     385      arguments->push_front(returnValue);
     386    return true;
     387  }
     388
     389  QMetaType::destroy(resultType, result);
     390  qDebug("No such method '%s'", signal+1 );
     391  return false;
     392}
     393
     394static char *qstrdata(const QString &str);
     395int qstrdata_size(const QString &str);
     396
     397static int qt_variantlist_storage(QVariantList* l, int i)
     398{
     399  switch(l->at(i).type())
     400  {
     401  case QVariant::Int:
     402  case QVariant::UInt:
     403  case QVariant::Bool:
     404    return 0;
     405  case QVariant::Double:
     406    return C_SIZEOF_FLONUM;
     407  case QVariant::String:
     408    return C_SIZEOF_STRING(qstrdata_size(l->at(i).toString()));
     409  default:
     410    printf("QVariantList (size) doesn't know how to convert  '%s'(%d) into a chicken type\n",
     411           l->at(i).typeName(), l->at(i).type());
     412    exit(1);
     413  }
     414}
     415
     416static void qt_variantlist_do_one(QVariantList* l, variantlist_fun* fun, C_word **storage, int i)
     417{
     418  C_word w;
     419
     420  switch(l->at(i).type())
     421  {
     422  case QVariant::Int: w = C_fix(l->at(i).toInt()); break;
     423    // TODO C_fix is signed, this might overflow, what's the unsigned version?
     424  case QVariant::UInt: w = C_fix(l->at(i).toUInt()); break;
     425  case QVariant::Bool: w = C_mk_bool(l->at(i).toBool()); break;
     426  case QVariant::Double: w = C_flonum((C_word**)storage, l->at(i).toDouble()); break;
     427  case QVariant::String:
     428      w = C_string((C_word**)storage, qstrdata_size(l->at(i).toString()),
     429                   qstrdata(l->at(i).toString())); break;
     430  default:
     431    printf("QVariantList doesn't know how to convert  '%s'(%d) into a chicken type\n",
     432           l->at(i).typeName(), l->at(i).type());
     433    exit(1);
     434  }
     435
     436  (*fun)(w);
     437}
     438
     439void qt_variantlist_remove_front(C_word c, C_word self, C_word k, C_word cl)
     440{
     441  QVariantList* l = (QVariantList*)C_pointer_address(cl);
     442
     443  struct f_ : public variantlist_fun
     444  {
     445    C_word k;
     446    QVariantList* l;
     447    f_(C_word k_, QVariantList* l_) : k(k_), l(l_) {}
     448    void operator()(C_word o) { l->pop_front(); C_kontinue(k, o); }
     449  } f(k, l);
     450
     451  C_word *storage = C_alloc(qt_variantlist_storage(l, 0));
     452  qt_variantlist_do_one(l, &f, &storage, 0);
     453}
     454
     455static char *qstrdata(const QString &str)
    122456{
    123457  static char *strbuf = NULL;
    124458  static int strbuflen = 0;
    125   int len = str.size();
    126 
    127   if(strbuf == NULL || strbuflen < len) {
    128     strbuf = (char *)realloc(strbuf, strbuflen = len * 2);
     459
     460  int len = qstrdata_size(str);
     461
     462  if(strbuf == NULL || strbuflen < (len + 1)) {
     463    strbuf = (char *)realloc(strbuf, strbuflen = (len + 1));
    129464    assert(strbuf != NULL);
    130465  }
     
    133468
    134469  switch(qt_char_encoding) {
    135 
    136470  case 1: ptr = str.toLatin1().data(); break;
    137471  case 2: ptr = str.toUtf8().data(); break;
    138   case 3: ptr = str.toAscii().data(); break;
     472  default: ptr = str.toAscii().data(); break;
    139473  }
    140474
     
    143477}
    144478
     479int qstrdata_size(const QString &str)
     480{
     481  QByteArray arr;
     482  switch(qt_char_encoding) {
     483  case 1: arr = str.toLatin1(); break;
     484  case 2: arr = str.toUtf8(); break;
     485  default: arr = str.toAscii(); break;
     486  }
     487
     488  return arr.size();
     489}
    145490
    146491int qchrdata(const QChar chr)
     
    158503{
    159504  QPixmap *px = new QPixmap(filename);
    160  
     505
    161506  if(px->isNull()) {
    162507    delete px;
    163508    return 0;
    164509  }
    165  
     510
    166511  return px;
    167512}
     
    174519
    175520
    176 #define propsetter(name, type)                                       \
    177 ___bool qt_set ## name ## property(QWidget *w, char *prop, type val) \
    178 { \
    179   const QMetaObject *mo = w->metaObject(); \
    180   int i = mo->indexOfProperty(prop); \
    181   if(i == -1) return 0; \
    182   else return mo->property(i).write(w, val); \
    183 }
     521#define propsetter(name, type)                                          \
     522  ___bool qt_set ## name ## property(QWidget *w, char *prop, type val)  \
     523  {                                                                     \
     524    const QMetaObject *mo = w->metaObject();                            \
     525    int i = mo->indexOfProperty(prop);                                  \
     526    if(i == -1) return 0;                                               \
     527    else return mo->property(i).write(w, val);                          \
     528  }
    184529
    185530
     
    248593
    249594
    250 char *qt_getstringproperty(QWidget *w, char *prop) 
    251 {
    252   const QMetaObject *mo = w->metaObject();
    253   int i = mo->indexOfProperty(prop);           
     595char *qt_getstringproperty(QWidget *w, char *prop)
     596{
     597  const QMetaObject *mo = w->metaObject();
     598  int i = mo->indexOfProperty(prop);
    254599  return qstrdata(mo->property(i).read(w).toString());
    255600}
    256601
    257602
    258 int qt_getcharproperty(QWidget *w, char *prop) 
    259 {
    260   const QMetaObject *mo = w->metaObject();
    261   int i = mo->indexOfProperty(prop);           
     603int qt_getcharproperty(QWidget *w, char *prop)
     604{
     605  const QMetaObject *mo = w->metaObject();
     606  int i = mo->indexOfProperty(prop);
    262607  return qchrdata(mo->property(i).read(w).toChar());
    263608}
    264609
    265610
    266 int qt_getintproperty(QWidget *w, char *prop) 
    267 {
    268   const QMetaObject *mo = w->metaObject();
    269   int i = mo->indexOfProperty(prop);           
     611int qt_getintproperty(QWidget *w, char *prop)
     612{
     613  const QMetaObject *mo = w->metaObject();
     614  int i = mo->indexOfProperty(prop);
    270615  return mo->property(i).read(w).toInt();
    271616}
    272617
    273618
    274 double qt_getfloatproperty(QWidget *w, char *prop) 
    275 {
    276   const QMetaObject *mo = w->metaObject();
    277   int i = mo->indexOfProperty(prop);           
     619double qt_getfloatproperty(QWidget *w, char *prop)
     620{
     621  const QMetaObject *mo = w->metaObject();
     622  int i = mo->indexOfProperty(prop);
    278623  return mo->property(i).read(w).toDouble();
    279624}
    280625
    281626
    282 ___bool qt_getboolproperty(QWidget *w, char *prop) 
    283 {
    284   const QMetaObject *mo = w->metaObject();
    285   int i = mo->indexOfProperty(prop);           
     627___bool qt_getboolproperty(QWidget *w, char *prop)
     628{
     629  const QMetaObject *mo = w->metaObject();
     630  int i = mo->indexOfProperty(prop);
    286631  return mo->property(i).read(w).toBool();
    287632}
    288633
    289634
    290 qtpixmap qt_getpixmapproperty(QWidget *w, char *prop) 
    291 {
    292   const QMetaObject *mo = w->metaObject();
    293   int i = mo->indexOfProperty(prop);           
     635qtpixmap qt_getpixmapproperty(QWidget *w, char *prop)
     636{
     637  const QMetaObject *mo = w->metaObject();
     638  int i = mo->indexOfProperty(prop);
    294639  return new QPixmap(mo->property(i).read(w).value<QPixmap>());
    295640}
    296641
    297642
    298 C_word qt_getpointfproperty(QWidget *w, char *prop, C_word pt) 
    299 {
    300   const QMetaObject *mo = w->metaObject();
    301   int i = mo->indexOfProperty(prop);           
     643C_word qt_getpointfproperty(QWidget *w, char *prop, C_word pt)
     644{
     645  const QMetaObject *mo = w->metaObject();
     646  int i = mo->indexOfProperty(prop);
    302647  QPointF qpt = mo->property(i).read(w).toPointF();
    303648  *((double *)C_data_pointer(C_block_item(pt, 1))) = qpt.x();
     
    307652
    308653
    309 C_word qt_getpointproperty(QWidget *w, char *prop, C_word pt) 
    310 {
    311   const QMetaObject *mo = w->metaObject();
    312   int i = mo->indexOfProperty(prop);           
     654C_word qt_getpointproperty(QWidget *w, char *prop, C_word pt)
     655{
     656  const QMetaObject *mo = w->metaObject();
     657  int i = mo->indexOfProperty(prop);
    313658  QPoint qpt = mo->property(i).read(w).toPoint();
    314659  *((int *)C_data_pointer(C_block_item(pt, 1))) = qpt.x();
     
    318663
    319664
    320 C_word qt_getrectfproperty(QWidget *w, char *prop, C_word pt) 
    321 {
    322   const QMetaObject *mo = w->metaObject();
    323   int i = mo->indexOfProperty(prop);           
     665C_word qt_getrectfproperty(QWidget *w, char *prop, C_word pt)
     666{
     667  const QMetaObject *mo = w->metaObject();
     668  int i = mo->indexOfProperty(prop);
    324669  QRectF qpt = mo->property(i).read(w).toRectF();
    325670  *((double *)C_data_pointer(C_block_item(pt, 1))) = qpt.x();
     
    331676
    332677
    333 C_word qt_getrectproperty(QWidget *w, char *prop, C_word pt) 
    334 {
    335   const QMetaObject *mo = w->metaObject();
    336   int i = mo->indexOfProperty(prop);           
     678C_word qt_getrectproperty(QWidget *w, char *prop, C_word pt)
     679{
     680  const QMetaObject *mo = w->metaObject();
     681  int i = mo->indexOfProperty(prop);
    337682  QRect qpt = mo->property(i).read(w).toRect();
    338683  *((int *)C_data_pointer(C_block_item(pt, 1))) = qpt.x();
     
    344689
    345690
    346 C_word qt_getsizefproperty(QWidget *w, char *prop, C_word pt) 
    347 {
    348   const QMetaObject *mo = w->metaObject();
    349   int i = mo->indexOfProperty(prop);           
     691C_word qt_getsizefproperty(QWidget *w, char *prop, C_word pt)
     692{
     693  const QMetaObject *mo = w->metaObject();
     694  int i = mo->indexOfProperty(prop);
    350695  QSizeF qpt = mo->property(i).read(w).toSizeF();
    351696  *((double *)C_data_pointer(C_block_item(pt, 1))) = qpt.width();
     
    355700
    356701
    357 C_word qt_getsizeproperty(QWidget *w, char *prop, C_word pt) 
    358 {
    359   const QMetaObject *mo = w->metaObject();
    360   int i = mo->indexOfProperty(prop);           
     702C_word qt_getsizeproperty(QWidget *w, char *prop, C_word pt)
     703{
     704  const QMetaObject *mo = w->metaObject();
     705  int i = mo->indexOfProperty(prop);
    361706  QSize qpt = mo->property(i).read(w).toSize();
    362707  *((int *)C_data_pointer(C_block_item(pt, 1))) = qpt.width();
     
    394739}
    395740
    396 
    397741const char *qt_classname(qtobject w) { return w->metaObject()->className(); }
    398742qtwidget qt_gl(char *name, qtwidget parent, C_word proc) { return new GLWidget(name, parent, proc); }
    399743void qt_update(qtwidget w) { w->update(); }
    400744
    401 
    402 qttimer qt_timer(double secs)
     745qttimer qt_make_timer(double secs)
    403746{
    404747  QTimer *tm = new QTimer();
     
    407750}
    408751
     752void qt_destroy_timer(qttimer timer) { delete timer; }
    409753
    410754void qt_start(qttimer t) { t->start(); }
     
    416760
    417761void qt_addtreewidgetitem(qtwidget w, char *s)
    418 { 
     762{
    419763  QStringList lst = QString(s).split("|");
    420   ((QTreeWidget *)w)->addTopLevelItem(new QTreeWidgetItem(lst)); 
    421 }
    422 
    423 char *qt_listwidgetitem(qtwidget w, int i) { 
     764  ((QTreeWidget *)w)->addTopLevelItem(new QTreeWidgetItem(lst));
     765}
     766
     767char *qt_listwidgetitem(qtwidget w, int i) {
    424768  return qstrdata(((QListWidget *)w)->item(i)->text());
    425769}
     
    431775char *qt_getexistingdirectory(qtwidget p, char *cap, char *dir, int opts)
    432776{
    433   return qstrdata(QFileDialog::getExistingDirectory(p, cap, dir, (QFileDialog::Option)opts)); 
     777  return qstrdata(QFileDialog::getExistingDirectory(p, cap, dir, (QFileDialog::Option)opts));
    434778}
    435779
     
    450794
    451795
    452 char *qt_selection(qttextedit t) 
    453 { 
     796char *qt_selection(qttextedit t)
     797{
    454798  QString txt = ((QTextEdit *)t)->textCursor().selectedText();
    455799  txt.replace(QChar(QChar::ParagraphSeparator), '\n');
     
    474818
    475819
    476 void qt_addaction(qtwidget w, qtaction a) { ((QWidget *)w)->addAction((QAction *)a); }
    477 void qt_removeaction(qtwidget w, qtaction a) { ((QWidget *)w)->removeAction((QAction *)a); }
     820void qt_add_action(qtwidget w, qtaction a) { ((QWidget *)w)->addAction((QAction *)a); }
     821void qt_remove_action(qtwidget w, qtaction a) { ((QWidget *)w)->removeAction((QAction *)a); }
    478822
    479823
     
    483827  else return qt_char_encoding;
    484828}
     829
     830void qt_attribute(qtwidget w, int attribute, int set)
     831{
     832  ((QWidget*)w)->setAttribute((Qt::WidgetAttribute)attribute, set);
     833}
     834
     835int qt_testattribute(qtwidget w, int attribute)
     836{
     837  return ((QWidget*)w)->testAttribute((Qt::WidgetAttribute)attribute);
     838}
     839
     840int qt_window_flags(qtwidget w)
     841{
     842  return ((QWidget*)w)->windowFlags();
     843}
     844
     845void qt_set_window_flags(qtwidget w, int f)
     846{
     847  ((QWidget*)w)->setWindowFlags((Qt::WindowFlags)f);
     848}
     849
     850qtwidget qt_desktop() { return QApplication::desktop(); }
     851
     852QHttp* qt_make_http() { return new QHttp(); }
     853void qt_destroy_http(QHttp *h) { delete h; }
     854int qt_http_set_host(QHttp *h, char *host, int port) { return h->setHost(host, port); }
     855int qt_http_get(QHttp *h, char *url) { return h->get(QUrl(url).toEncoded()); }
     856// blob version
     857char *qt_http_read_bytes(QHttp *h) { return h->readAll().data(); }
     858char *qt_http_read_string(QHttp *h) { return qstrdata(QString(h->readAll().data())); }
  • release/4/qt/branches/0xab/prototypes.h

    r17381 r17923  
    11/* prototypes.h */
    22
     3
     4
     5struct QDynamicReceiver;
     6class GLWidget;
    37
    48qtapplication qt_init();
     
    1014void qt_deletepixmap(qtpixmap widget);
    1115qtpixmap qt_pixmap(char *filename);
    12 ___bool qt_connect(qtwidget w1, char *sig, qtobject w2, char *slot);
     16___bool qt_connect(qtobject w1, char *sig, qtobject w2, char *slot);
     17___bool qt_disconnect(qtobject w1, char *sig, qtobject w2, char *slot);
    1318qtwidget qt_find(qtwidget parent, char *name);
    14 qtobject qt_receiver(char *name, C_word proc);
     19qtdynamicreceiver qt_dynamicreceiver(char *name, char *slot, C_word proc);
    1520int qt_message(char *caption, char *text, qtwidget parent, char *b0, char *b1, char *b2);
    1621const char *qt_classname(qtobject w);
     
    4045qtwidget qt_gl(char *name, qtwidget parent, C_word proc);
    4146void qt_update(qtwidget w);
    42 qttimer qt_timer(double secs);
     47qttimer qt_make_timer(double secs);
     48void qt_destroy_timer(qttimer timer);
    4349void qt_start(qttimer t);
    4450void qt_stoptimer(qttimer t);
     
    5864void qt_insert(qttextedit w, char *s);
    5965qtaction qt_shortcut(qtwidget w, char *k);
    60 void qt_addaction(qtwidget w, qtaction a);
    61 void qt_removeaction(qtwidget w, qtaction a);
     66void qt_add_action(qtwidget w, qtaction a);
     67void qt_remove_action(qtwidget w, qtaction a);
    6268int qt_charencoding(int mode);
     69void qt_attribute(qtwidget w, int attribute, int set);
     70int qt_testattribute(qtwidget w, int attribute);
     71int qt_window_flags(qtwidget w);
     72void qt_set_window_flags(qtwidget w, int f);
     73qtwidget qt_desktop();
     74void qt_variantlist_remove_front(C_word c, C_word self, C_word k, C_word l);
     75qtvariantlist qt_make_variantlist();
     76void qt_destroy_variantlist(qtvariantlist l);
     77void qt_variant_list_insert_back_int(qtvariantlist l, int a);
     78void qt_variant_list_insert_back_string(qtvariantlist l, char *s);
     79void qt_variant_list_insert_back_bool(qtvariantlist l, int a);
     80void qt_variant_list_insert_back_uint(qtvariantlist l, int a);
     81void qt_variant_list_insert_back_double(qtvariantlist l, double a);
     82int qt_variant_list_length(qtvariantlist l);
     83___bool qt_invokemethod(qtobject o, char *signal, qtvariantlist arguments);
     84void qt_variant_list_discard_front(qtvariantlist l);
     85qtdbusconnection qt_dbus_session_bus();
     86qtdbusconnection qt_dbus_system_bus();
     87void qt_destroy_dbus_connection(qtdbusconnection c);
     88___bool qt_c_dbus_connect(qtdbusconnection c,
     89                        char *service, char *object,
     90                        char *interface, char *signal,
     91                        qtobject w2, char *slot);
     92___bool qt_dbus_disconnect(qtdbusconnection c,
     93                           char *service, char *object,
     94                           char *interface, char *signal,
     95                           qtobject w2, char *slot);
     96void qt_c_dbus_list_names(qtdbusconnection c, qtvariantlist l);
     97___bool qt_c_dbus_send_signal(qtdbusconnection bus, char *object,
     98                            char *interface, char *signal, qtvariantlist l);
     99___bool qt_dbus_register_object(qtdbusconnection bus, char *path, qtobject obj);
     100void qt_dbus_unregister_object(qtdbusconnection bus, char *path);
     101___bool qt_dbus_method_call(qtdbusconnection bus, char *service, char *path,
     102                            char *interface, char *method, qtvariantlist l);
     103___bool qt_dbus_method_call_with_callback(qtdbusconnection bus, char *service, char *path,
     104                                          char *interface, char *method, qtvariantlist l,
     105                                          qtobject obj, char *slot);
     106___bool qt_dbus_register_service(qtdbusconnection bus, char *service);
     107___bool qt_dbus_unregister_service(qtdbusconnection bus, char *service);
     108
     109qthttp qt_make_http();
     110void qt_destroy_http(qthttp h);
     111int qt_http_set_host(qthttp h, char *host, int port);
     112int qt_http_get(qthttp h, char *url);
     113// TODO this should return ___byte_vector but easyffi complains
     114char *qt_http_read_bytes(qthttp h);
     115char *qt_http_read_string(qthttp h);
  • release/4/qt/branches/0xab/qt-base.scm

    r17626 r17923  
    22
    33
    4 (module qt (qt:init 
     4(module qt (qt:init
    55            qt:widget qt:show qt:hide qt:run
    66            qt:delete qt:message qt:connect qt:find
    7             qt:widget qt:receiver qt:pixmap qt:timer
     7            qt:widget qt:pixmap qt:timer qt:destroy-timer
    88            qt:property qt:gl qt:update qt:start qt:stop
    99            qt:clear qt:add qt:item <qt> qt:classname
    1010            <qt-object> <qt-widget> <qt-pixmap> <qt-application>
    11             <qt-receiver> <qt-timer> <qt-sound> <qt-text-edit>
     11            <qt-timer> <qt-sound> <qt-text-edit>
    1212            <qt-action>
    1313            qt:get-open-filename qt:get-save-filename qt:get-directory
    14             qt:sound qt:play qt:set-headers 
     14            qt:sound qt:play qt:set-headers
    1515            qt:selection qt:insert
    1616            qt:shortcut
    1717            qt:add-action qt:remove-action
    18             qt:char-encoding)
    19 
    20   (import scheme chicken
     18            qt:char-encoding
     19            qt:add-attribute qt:remove-attribute qt:attribute?
     20            qt:window-flags qt:set-window-flags qt:desktop
     21            qt:make-variant-list
     22            qt:variant-list-remove-front qt:variant-list-insert-back
     23            qt:variant-list-length qt:list->variant-list
     24            qt:emit-signal qt:invoke-method
     25            qt:variant-list-discard-front
     26            qt:session-bus qt:system-bus qt:dbus-connect
     27            qt:dbus-list-names qt:dbus-send-signal
     28            qt:dbus-register-method qt:dbus-call
     29            qt:dbus-call-with-callback
     30            qt:dbus-register-service qt:dbus-unregister-service
     31            qt:http-read-string qt:http-get qt:make-http
     32            qt:destroy-http qt:http-set-host qt:http-read-bytes
     33            qt:->pointer qt:pointer->widget qt:pointer->object
     34            qt:pointer->timer qt:pointer->application qt:pointer->pixmap
     35            qt:pointer->pixmap qt:pointer->dynamicreceiver
     36            qt:pointer->sound qt:pointer->text-edit
     37            qt:pointer->action qt:pointer->variant-list
     38            qt:pointer->dbus-connection qt:pointer->http
     39            )
     40
     41  (import scheme chicken
    2142          (except foreign foreign-declare)
    2243          easyffi
     
    2546
    2647(define <qt>
    27   (% (current-root-object) 
     48  (% (current-root-object)
    2849     (class '<qt>)
    2950     (pointer #f)
     
    3657(define <qt-application> (% <qt-object> (class 'qt-application)))
    3758(define <qt-pixmap> (% <qt> (class 'qt-pixmap)))
    38 (define <qt-receiver> (% <qt-object> (class 'qt-receiver)))
     59(define <qt-dynamicreceiver> (% <qt-object> (class 'qt-dynamicreceiver)))
    3960(define <qt-timer> (% <qt-object> (class 'qt-timer)))
    4061(define <qt-text-edit> (% <qt-widget> (class 'qt-text-edit)))
    4162(define <qt-action> (% <qt-object> (class 'qt-action)))
     63(define <qt-variant-list> (% <qt> (class 'qt-variant-list)))
     64(define <qt-dbus-connection> (% <qt> (class 'qt-dbus-connection)))
     65(define <qt-http> (% <qt> (class 'qt-http)))
    4266
    4367(define (qt:->pointer i) (and i (? i pointer)))
     
    4771(define (qt:pointer->application p) (and p (% <qt-application> (pointer p))))
    4872(define (qt:pointer->pixmap p) (and p (% <qt-pixmap> (pointer p))))
    49 (define (qt:pointer->receiver p) (and p (% <qt-receiver> (pointer p))))
     73(define (qt:pointer->dynamicreceiver p) (and p (% <qt-dynamicreceiver> (pointer p))))
    5074(define (qt:pointer->sound p) (and p (% <qt-sound> (pointer p))))
    5175(define (qt:pointer->text-edit p) (and p (% <qt-text-edit> (pointer p))))
    5276(define (qt:pointer->action p) (and p (% <qt-action> (pointer p))))
     77(define (qt:pointer->variant-list p) (and p (% <qt-variant-list> (pointer p))))
     78(define (qt:pointer->dbus-connection p) (and p (% <qt-dbus-connection> (pointer p))))
     79(define (qt:pointer->http p) (and p (% <qt-http> (pointer p))))
    5380
    5481#>?
    55 ___declare(substitute, "qt_;qt:")
    56 ___declare(type, "qtwidget;c-pointer;qt:->pointer;qt:pointer->widget")
    57 ___declare(type, "qtapplication;c-pointer;qt:->pointer;qt:pointer->application")
    58 ___declare(type, "qtpixmap;c-pointer;qt:->pointer;qt:pointer->pixmap")
    59 ___declare(type, "qtobject;c-pointer;qt:->pointer;qt:pointer->object")
    60 ___declare(type, "qttimer;c-pointer;qt:->pointer;qt:pointer->timer")
    61 ___declare(type, "qtreceiver;c-pointer;qt:->pointer;qt:pointer->receiver")
    62 ___declare(type, "qtsound;c-pointer;qt:->pointer;qt:pointer->sound")
    63 ___declare(type, "qttextedit;c-pointer;qt:->pointer;qt:pointer->text-edit")
    64 ___declare(type, "qtaction;c-pointer;qt:->pointer;qt:pointer->action")
     82___declare(substitute, "^qt_;qt:")
     83___declare(substitute, "_;-")
     84___declare(type, "qtobject;(c-pointer \"QObject\");qt:->pointer;qt:pointer->object")
     85___declare(type, "qtapplication;(c-pointer \"QApplication\");qt:->pointer;qt:pointer->application")
     86___declare(type, "qtwidget;(c-pointer \"QWidget\");qt:->pointer;qt:pointer->widget")
     87___declare(type, "qtdynamicreceiver;(c-pointer \"QDynamicReceiver\");qt:->pointer;qt:pointer->dynamicreceiver")
     88___declare(type, "qtpixmap;(c-pointer \"QPixmap\");qt:->pointer;qt:pointer->pixmap")
     89___declare(type, "qttimer;(c-pointer \"QTimer\");qt:->pointer;qt:pointer->timer")
     90___declare(type, "qtsound;(c-pointer \"QSound\");qt:->pointer;qt:pointer->sound")
     91___declare(type, "qttextedit;(c-pointer \"QTextEdit\");qt:->pointer;qt:pointer->text-edit")
     92___declare(type, "qtaction;(c-pointer \"QAction\");qt:->pointer;qt:pointer->action")
     93___declare(type, "qtvariantlist;(c-pointer \"QVariantList\");qt:->pointer;qt:pointer->variant-list")
     94___declare(type, "qtdbusconnection;(c-pointer \"QDBusConnection\");qt:->pointer;qt:pointer->dbus-connection")
     95___declare(type, "qthttp;(c-pointer \"QHttp\");qt:->pointer;qt:pointer->http")
    6596<#
    6697
    6798#>
    68 extern "C" {
    69 #include "prototypes.h"
    70 }
     99#include <QtGui>
     100#include <QtUiTools>
     101#include <QGLWidget>
     102#include <QtCore>
     103#include <QtDBus>
     104#include <QHttp>
     105#include <chicken.h>
     106#include <assert.h>
    71107<#
    72108
    73 #>?
     109#>!
    74110#include "prototypes.h"
    75111<#
    76112
     113(define (qt:timer seconds) (qt:make-timer seconds))
     114
     115(define (qt:variant-list-remove-front v)
     116 ((##core#primitive "qt_variantlist_remove_front") (qt:->pointer v)))
     117(define (qt:make-variant-list)
     118 (let ((v (qt:make-variantlist)))
     119  (set-finalizer! v qt:destroy-variantlist)
     120  v))
     121(define (qt:variant-list-insert-back q o #!optional (signed? #t))
     122 (cond ((flonum? o) (qt:variant-list-insert-back-double q o))
     123       ((integer? o)
     124        (if signed?
     125            (qt:variant-list-insert-back-int q o)
     126            (qt:variant-list-insert-back-uint q o)))
     127       ((string? o) (qt:variant-list-insert-back-string q o))
     128       ((boolean? o) (qt:variant-list-insert-back-bool q (if o 1 0)))
     129       (else (error "Unsupported type"))))
     130
     131(define (qt:list->variant-list l)
     132 (let* ((v (qt:make-variant-list)))
     133  (for-each (lambda (a) (qt:variant-list-insert-back v a)) l)
     134  v))
     135
     136(define (qt:variant-list->list l)
     137 (map (lambda (n) (qt:variant-list-remove-front l))
     138      (iota (qt:variant-list-length l))))
     139
     140(define (qt:session-bus)
     141 (let ((b (qt:dbus-session-bus)))
     142  (set-finalizer! b qt:destroy-dbus-connection)
     143  b))
     144(define (qt:system-bus)
     145 (let ((b (qt:dbus-system-bus)))
     146  (set-finalizer! b qt:destroy-dbus-connection)
     147  b))
     148
     149(define (qt:dbus-connect bus service object interface signal to
     150                         #!optional (slot signal))
     151 (let ((dest (if (procedure? to)
     152                 (qt:dynamicreceiver (->string (gensym "qt:dynamic-receiver"))
     153                                     (string->slot slot)
     154                                     to)
     155                 to)))
     156  (if (qt:c-dbus-connect bus service object interface signal dest (string->slot slot))
     157      (lambda ()
     158       (if (procedure? to)
     159           (qt:deleteobject dest)
     160           (qt:dbus-disconnect bus service object interface signal dest (string->slot slot))))
     161      (begin (when (procedure? to) (qt:deleteobject dest)) #f))))
     162
     163(define (qt:dbus-send-signal bus object interface signal . arguments)
     164 (let ((v (qt:list->variant-list arguments)))
     165  (qt:c-dbus-send-signal bus object interface signal v)))
     166
     167(define (qt:dbus-list-names bus)
     168 (let ((v (qt:make-variant-list)))
     169  (qt:c-dbus-list-names bus v)
     170  (qt:variant-list->list v)))
     171
     172(define (qt:dbus-register-method bus path f name)
     173 (let ((target (qt:dynamicreceiver (->string (gensym "qt:dynamic-receiver"))
     174                                   (string->slot name)
     175                                   f)))
     176  (if (qt:dbus-register-object bus path target)
     177      (lambda () (qt:deleteobject target))
     178      (begin (qt:deleteobject target) #f))))
     179
     180;;; TODO Need blocking & timeouts, blocking with GUI & timeouts, slots
     181;;; Blocking with gui is implemented for now because we use signal/slots
     182;;; so we can service dbus calls to ourselves
     183(define (qt:dbus-call bus service path interface method . arguments)
     184 (let ((v (qt:list->variant-list arguments)))
     185  ((foreign-safe-lambda bool "qt_dbus_method_call"
     186                   qtdbusconnection c-string c-string c-string c-string qtvariantlist)
     187   bus service path interface method v)
     188  (qt:variant-list->list v)))
     189
     190(define (qt:dbus-call-with-callback bus service path interface method fun slot . arguments)
     191 (letrec ((v (qt:list->variant-list arguments))
     192          (target (qt:dynamicreceiver (->string (gensym "qt:dynamic-receiver"))
     193                                      (string->slot slot)
     194                                      (lambda a (qt:deleteobject target) (apply fun a)))))
     195  ((foreign-safe-lambda bool "qt_dbus_method_call_with_callback"
     196                   qtdbusconnection c-string c-string c-string c-string qtvariantlist
     197                   qtobject c-string)
     198   bus service path interface method v target (string->slot slot))))
     199
     200
    77201(define-enum encoding->int int->encoding
    78   unused latin1 utf8 ascii)
     202 unused latin1 utf8 ascii)
    79203
    80204(define (qt:char-encoding #!optional enc)
    81   (if enc
    82       (qt:charencoding
    83         (or (encoding->int enc)
    84             (error 'qt:char-encoding "invalid encoding mode" enc)))
    85       (int->encoding (qt:charencoding 0))))
     205 (if enc
     206     (qt:charencoding
     207      (or (encoding->int enc)
     208          (error 'qt:char-encoding "invalid encoding mode" enc)))
     209     (int->encoding (qt:charencoding 0))))
     210
     211(define (string->method s) (string-append "0" s))
     212(define (string->slot s) (string-append "1" s))
     213(define (string->signal s) (string-append "2" s))
    86214
    87215(define qt:connect
    88   (let ((qt:connect qt:connect))
    89     (lambda (from sig to #!optional (slot "slot()"))
    90       (qt:connect
    91        from (string-append "2" sig)
    92        (if (procedure? to) (qt:receiver to) to)
    93        (string-append "1" slot)) ) ) )
    94 
    95 (define qt:receiver
    96   (let ((qt:receiver qt:receiver))
    97     (lambda (thunk #!optional (name (gensym "qt:receiver")))
    98       (qt:receiver (->string name) thunk) ) ) )
     216 (let ((qt:connect qt:connect))
     217  (lambda (from sig to #!optional (slot sig))
     218   (let ((dest (if (procedure? to)
     219                   (qt:dynamicreceiver (->string (gensym "qt:dynamic-receiver"))
     220                                       (string->slot slot)
     221                                       to)
     222                   to)))
     223    (if (qt:connect from (string->signal sig) dest (string->slot slot))
     224        (lambda ()
     225         (if (procedure? to)
     226             (qt:deleteobject dest)
     227             (qt:disconnect from (string->signal sig) dest (string->slot slot))))
     228        (begin (when (procedure? to) (qt:deleteobject dest)) #f))))))
     229
     230(define (qt:emit-signal o s . args) (apply qt:invoke-method o s #f args))
     231
     232(define (qt:invoke-method o s #!optional (r? #f) . args)
     233 (let ((v (qt:list->variant-list args)))
     234  (if ((foreign-safe-lambda bool "qt_invokemethod"
     235                       qtwidget c-string qtvariantlist)
     236       o (string->signal s) v)
     237      (if r? (list (qt:variant-list-remove-front v)) #t)
     238      #f)))
    99239
    100240(! <qt-object> 'delete
     
    107247
    108248(define qt:message
    109   (let ((qt:message qt:message))
    110     (lambda (text #!key (caption "") parent (button1 "OK") (button2 "Cancel") button3)
    111       (qt:message caption text parent button1 button2 button3) ) ) )
     249 (let ((qt:message qt:message))
     250  (lambda (text #!key (caption "") parent (button1 "OK") (button2 "Cancel") button3)
     251   (qt:message caption text parent button1 button2 button3))))
    112252
    113253(define (qt:widget fname #!optional parent)
    114   (qt:create fname parent) )
     254 (qt:create fname parent) )
    115255
    116256(define qt:property
    117   (getter-with-setter
    118    (lambda (w p)
    119      (let ((p (->string p)))
    120        (case (qt:propertytype w p)
    121         ((5) (qt:getstringproperty w p))
    122         ((4) (qt:getintproperty w p))
    123         ((3) (qt:getfloatproperty w p))
    124         ((1) (qt:getboolproperty w p))
    125         ((2) (integer->char (qt:getcharproperty w p)))
    126         ((6) (qt:getpixmapproperty w p))
    127         ((7) (qt:getpointfproperty w p (make-f64vector 2)))
    128         ((8) (qt:getrectfproperty w p (make-f64vector 4)))
    129         ((9) (qt:getsizefproperty w p (make-f64vector 2)))
    130         ((10) (qt:getpointproperty w p (make-s32vector 2)))
    131         ((11) (qt:getsizeproperty w p (make-s32vector 2)))
    132         ((12) (qt:getrectproperty w p (make-s32vector 4)))
    133         (else (error "unknown property" w p)) ) ) )
    134    (lambda (w p x)
    135      (let* ((p (->string p))
    136             (ok (cond ((string? x) (qt:setstringproperty w p x))
    137                       ((fixnum? x) (qt:setintproperty w p x))
    138                       ((flonum? x) (qt:setfloatproperty w p x))
    139                       ((char? x) (qt:setcharproperty w p (char->integer x)))
    140                       ((boolean? x) (qt:setboolproperty w p x))
    141                       ((s32vector? x)
    142                        (if (fx= (s32vector-length x) 2)
    143                            (qt:setpointproperty w p x)
    144                            (qt:setrectproperty w p x) ) )
    145                       ((f64vector? x)
    146                        (if (fx= (f64vector-length x) 2)
    147                            (qt:setpointfproperty w p x)
    148                            (qt:setrectfproperty w p x) ) )
    149                       ((eq? (? x class) 'qt-pixmap) (qt:setpixmapproperty w p x))
    150                       (else (error "unknown property" w p)) ) ) )
    151        (unless ok (error 'qt:property/setter "unable to set widget property" w p x) ) ) ) ) )
     257 (getter-with-setter
     258  (lambda (w p)
     259   (let ((p (->string p)))
     260    (case (qt:propertytype w p)
     261    ((5) (qt:getstringproperty w p))
     262    ((4) (qt:getintproperty w p))
     263    ((3) (qt:getfloatproperty w p))
     264    ((1) (qt:getboolproperty w p))
     265    ((2) (integer->char (qt:getcharproperty w p)))
     266    ((6) (qt:getpixmapproperty w p))
     267    ((7) (qt:getpointfproperty w p (make-f64vector 2)))
     268    ((8) (qt:getrectfproperty w p (make-f64vector 4)))
     269    ((9) (qt:getsizefproperty w p (make-f64vector 2)))
     270    ((10) (qt:getpointproperty w p (make-s32vector 2)))
     271    ((11) (qt:getsizeproperty w p (make-s32vector 2)))
     272    ((12) (qt:getrectproperty w p (make-s32vector 4)))
     273    (else (error "unknown property" w p)) ) ) )
     274  (lambda (w p x)
     275   (let* ((p (->string p))
     276          (ok (cond ((string? x) (qt:setstringproperty w p x))
     277                    ((fixnum? x) (qt:setintproperty w p x))
     278                    ((flonum? x) (qt:setfloatproperty w p x))
     279                    ((char? x) (qt:setcharproperty w p (char->integer x)))
     280                    ((boolean? x) (qt:setboolproperty w p x))
     281                    ((s32vector? x)
     282                     (if (fx= (s32vector-length x) 2)
     283                         (qt:setpointproperty w p x)
     284                         (qt:setrectproperty w p x) ) )
     285                    ((f64vector? x)
     286                     (if (fx= (f64vector-length x) 2)
     287                         (qt:setpointfproperty w p x)
     288                         (qt:setrectfproperty w p x) ) )
     289                    ((eq? (? x class) 'qt-pixmap) (qt:setpixmapproperty w p x))
     290                    (else (error "unknown property" w p)) ) ) )
     291    (unless ok (error 'qt:property/setter "unable to set widget property" w p x) ) ) ) ) )
    152292
    153293(define qt:gl
    154   (let ((qt:gl qt:gl))
    155     (lambda (name parent init resize paint)
    156       (qt:gl
    157        name parent
    158        (match-lambda*
    159         ((0) (init))
    160         ((1 w h) (resize w h))
    161         (_ (paint)) ) ) ) ) )
     294 (let ((qt:gl qt:gl))
     295  (lambda (name parent init resize paint)
     296   (qt:gl
     297    name parent
     298    (match-lambda*
     299    ((0) (init))
     300    ((1 w h) (resize w h))
     301    (_ (paint)) ) ) ) ) )
    162302
    163303(define qt:run
    164   (let ((qt:run qt:run))
    165     (lambda (#!optional once)
    166       (qt:run once) ) ) )
     304 (let ((qt:run qt:run))
     305  (lambda (#!optional once)
     306   (qt:run once) ) ) )
    167307
    168308(define (qt:add w x)
    169   (cond ((string=? "QComboBox" (qt:classname w)) (qt:addcomboboxitem w x))
    170         ((string=? "QListWidget" (qt:classname w)) (qt:addlistwidgetitem w x))
    171         ((string=? "QTreeWidget" (qt:classname w)) (qt:addtreewidgetitem w x))
    172         (else (error 'qt:add "invalid widget" w x)) ) )
     309 (cond ((string=? "QComboBox" (qt:classname w)) (qt:addcomboboxitem w x))
     310       ((string=? "QListWidget" (qt:classname w)) (qt:addlistwidgetitem w x))
     311       ((string=? "QTreeWidget" (qt:classname w)) (qt:addtreewidgetitem w x))
     312       (else (error 'qt:add "invalid widget" w x)) ) )
    173313
    174314(define (qt:item w i) (and (positive? i) (qt:listwidgetitem w i)))
     
    176316
    177317(define (qt:set-headers w x)
    178   (cond ((string=? "QTreeWidget" (qt:classname w)) (qt:setheaders w x))
    179         (else (error 'qt:set-headers "invalid widget" w x)) ) )
     318 (cond ((string=? "QTreeWidget" (qt:classname w)) (qt:setheaders w x))
     319       (else (error 'qt:set-headers "invalid widget" w x)) ) )
    180320
    181321(define (file-dialog-options loc os)
    182   (let loop ((os os))
    183     (cond ((null? os) 0)
    184           ((assq (car os)
    185                 '((show-dirs-only: . 1) (dont-resolve-symlinks: . 2) (dont-confirm-overwrite: . 4)
    186                    (dont-use-sheet: . 8) (dont-use-native-dialog: . 16) ) )
    187            => (lambda (a) (loop (bitwise-ior (cdr a) (loop (cdr os))))) )
    188           (else (error loc "invalid file-dialog option" (car os))) ) ) )
     322 (let loop ((os os))
     323  (cond ((null? os) 0)
     324        ((assq (car os)
     325              '((show-dirs-only: . 1) (dont-resolve-symlinks: . 2) (dont-confirm-overwrite: . 4)
     326                 (dont-use-sheet: . 8) (dont-use-native-dialog: . 16) ) )
     327         => (lambda (a) (loop (bitwise-ior (cdr a) (loop (cdr os))))) )
     328        (else (error loc "invalid file-dialog option" (car os))) ) ) )
    189329
    190330(define (qt:get-open-filename cap dir #!key parent (options '()) filter)
    191   (qt:getopenfilename parent cap dir filter (file-dialog-options 'qt:get-open-filename options)) )
     331 (qt:getopenfilename parent cap dir filter (file-dialog-options 'qt:get-open-filename options)) )
    192332
    193333(define (qt:get-save-filename cap dir #!key parent (options '()) filter)
    194   (qt:getsavefilename parent cap dir filter (file-dialog-options 'qt:get-save-filename options)) )
     334 (qt:getsavefilename parent cap dir filter (file-dialog-options 'qt:get-save-filename options)) )
    195335
    196336(define (qt:get-directory cap dir #!key parent (options '()))
    197   (qt:getexistingdirectory parent cap dir (file-dialog-options 'qt:get-directory options)) )
     337 (qt:getexistingdirectory parent cap dir (file-dialog-options 'qt:get-directory options)) )
    198338
    199339(! <qt-timer> 'stop
     
    205345(define (qt:stop x) (@ x stop))
    206346
    207 (define qt:add-action qt:addaction)
    208 (define qt:remove-action qt:removeaction)
    209 
     347(define (qt:add-attribute w a) (qt:attribute w a 1))
     348(define (qt:remove-attribute w a) (qt:attribute w a 0))
     349(define (qt:attribute? w a) (= (qt:testattribute w a) 1))
    210350)
  • release/4/qt/branches/0xab/qt.setup

    r17632 r17923  
    22
    33
    4 (parameterize ((command-line-arguments
    5                 '("-O3" "-d1" "-X" "easyffi" "-j" "qt" "qt-base.scm" "main.cpp"
    6                   "-o" "qt.so" "-k" "-v") ) )
    7   (load "chicken-compile-qt-extension.scm"))
     4(use files utils)
    85
    9 (compile -s -O3 -d0 qt.import.scm)
     6
     7(define QTDIR
     8  (or (getenv "QTDIR")
     9      (error "please set the QTDIR environment variable") ) )
     10
     11(define prefix (program-path))
     12(define libpath (make-pathname prefix "lib"))
     13(define incpath (make-pathname prefix "include"))
     14(define binpath (make-pathname prefix "bin"))
     15;; Note that binpath points to the wrong location on my system
     16(define csc (make-pathname "/usr/bin/" ;; binpath
     17                           "csc"))
     18
     19(with-output-to-file "qt.pro"
     20  (lambda ()
     21    (let ((csc (qs (normalize-pathname csc)))
     22          (libdir (qs (normalize-pathname libpath)))
     23          (incdir (qs (normalize-pathname incpath))))
     24      (print #<#EOF
     25SOURCES=main.cpp qt-base.cpp
     26HEADERS=prototypes.h
     27CONFIG+=uitools qt debug
     28TEMPLATE=lib
     29TARGET=qtb
     30win32:LIBS+=-lchicken -lm -lws2_32
     31QT+=dbus opengl network
     32EOF
     33))))
     34
     35(with-output-to-file ".qmake.cache"
     36  (lambda ()
     37    (let ((csc (qs (normalize-pathname csc)))
     38          (libdir (qs (normalize-pathname libpath)))
     39          (incdir (qs (normalize-pathname incpath))))
     40      (print #<#EOF
     41unix {
     42      QMAKE_CFLAGS_WARN_ON=-Wall -Werror -Wno-unused -Wno-write-strings
     43      QMAKE_CXXFLAGS_WARN_ON=-Wall -Werror -Wno-unused -Wno-write-strings
     44      QMAKE_CFLAGS+=-Wno-unused `#{csc} -cflags` -I#{incdir}
     45      QMAKE_CXXFLAGS+=-Wno-unused `#{csc} -cflags` -I#{incdir}
     46      QMAKE_LFLAGS+=`/usr/bin/csc -libs -ldflags` -L#{libdir}
     47}
     48
     49win32 {
     50        QMAKE_CFLAGS_WARN_ON=-Wall -Werror -Wno-unused -Wno-write-strings
     51        QMAKE_CXXFLAGS_WARN_ON=-Wall -Werror -Wno-unused -Wno-write-strings
     52        QMAKE_LFLAGS+=-L#{libdir}
     53        QMAKE_CFLAGS+=-Wno-unused -I#{incdir} -DHAVE_CHICKEN_CONFIG_H -DPIC
     54        QMAKE_CXXFLAGS+=-Wno-unused -I#{incdir} -DHAVE_CHICKEN_CONFIG_H -DPIC
     55}
     56EOF
     57))))
     58
     59(make (("Makefile" ("qt.pro")
     60        (run (,(normalize-pathname
     61                (make-pathname QTDIR "bin/qmake"))
     62              qt.pro)))
     63       ("qt.so" ("prototypes.h" "main.cpp" "qt-base.cpp" "Makefile")
     64        (run (,(cond-expand (mingw32 "mingw32-make") (else "make")) clean all))
     65        (run (,(cond-expand
     66                (mingw32 "copy /Y debug\\qtb.dll qt.so")
     67                (else "cp libqtb.so.1.0.0 qt.so")))))
     68       ("qt.import.so" ("qt-base.cpp")
     69        (compile -s -O3 -d0 qt.import.scm))
     70       ("qt-base.cpp" ("qt-base.scm" "prototypes.h")
     71        (compile -c++ -t qt-base.scm -optimize-level 0 -d2 -X easyffi -C -g -j qt)))
     72 '("qt.so" "qt.import.so"))
    1073
    1174(install-extension
    1275 'qt
    1376 `("qt.so" "qt.import.so")
    14  '((version 0.92)))
    15 
    16 (compile -O3 -d0 -b chicken-compile-qt-extension.scm)
    17 
    18 (install-program
    19  'chicken-compile-qt-extension
    20  '("chicken-compile-qt-extension")
    21  '((version 0.92)))
     77 '((version 0.100)))
Note: See TracChangeset for help on using the changeset viewer.