Return to XtAddCallback.rplc CVS log

Up to [local] / rpl / modules / motif

Ajout de XtRemoveCallback.rplc et correction de bogues.

    1: #include "src/rplexternals.h"
    2: #include "motif.h"
    3: 
    4: declareExternalFunction(XtAddCallback)
    5:     declareObject(widget);
    6:     declareObject(callbackName);
    7:     declareObject(callbackObject);
    8:     declareObject(callbackProc);
    9:     declareDaisyChain(tmp);
   10: 
   11:     sXtCallback             *sCallback;
   12: 
   13:     string                  type;
   14: 
   15:     String                  callback;
   16: 
   17:     HEADER
   18:         declareHelpString("Add callback to a widget\n"
   19:                 "    3: widget\n"
   20:                 "    2: callback name (XmNactivateCallback)\n"
   21:                 "    1: expression\n"
   22:                 " -> 1: callback\n");
   23:         numberOfArguments(3);
   24:     FUNCTION
   25:         if (initializationDone eq true) then
   26:             pullFromStack(callbackProc, unknown);
   27:             returnOnError(freeObject(callbackProc));
   28: 
   29:             pullFromStack(callbackName, string);
   30:             returnOnError(freeObject(callbackProc); freeObject(callbackName));
   31: 
   32:             pullFromStack(widget, external);
   33:             returnOnError(freeObject(callbackProc); freeObject(callbackName);
   34:                     freeObject(widget));
   35: 
   36:             ifIsExternal(widget, WIDGET) then
   37:             orElse
   38:                 executionError("Type mismatch error");
   39:                 returnOnError(freeObject(callbackProc);
   40:                         freeObject(callbackName); freeObject(widget));
   41:             endIf
   42: 
   43:             getString(callbackName, type);
   44: 
   45:             if (strcmp(type, "XmNactivateCallback") eq 0) then
   46:                 callback = XmNactivateCallback;
   47:             orElse
   48:                 executionError("Unknown callback type");
   49:                 returnOnError(freeObject(callbackProc);
   50:                         freeObject(callbackName); freeObject(widget));
   51:             endIf
   52: 
   53:             createExternalObject(callbackObject, CALLBACK);
   54: 
   55:             sCallback = allocate(size(sXtCallback));
   56:             sCallback->status = procStatus(rpl_arguments);
   57:             sCallback->callback = callbackProc;
   58:             sCallback->widget = target((Widget *) objectContainer(widget));
   59:             objectContainer(callbackObject) = sCallback;
   60: 
   61:             XtAddCallback(target((Widget *) objectContainer(widget)),
   62:                     callback, rplCallback, (XtPointer) sCallback);
   63: 
   64:             tmp = allocate(size(struct_liste_chainee));
   65:             tmp->next = lCallbacks;
   66:             tmp->data = callbackObject;
   67:             lCallbacks = tmp;
   68: 
   69:             pushOnStack(callbackObject);
   70:         orElse
   71:             executionError("Application not initialized");
   72:             returnOnError();
   73:         endIf
   74:     END
   75: endExternalFunction
   76: 
   77: // vim: ts=4