Return to XtAddCallback.rplc CVS log

Up to [local] / rpl / modules / motif

Patches pour modules/motif.

    1: #include "src/rplexternals.h"
    2: #include "motif.h"
    3: 
    4: declareExternalFunction(XtAddCallback)
    5:     declareObject(widget);
    6:     declareObject(callbackName);
    7:     declareObject(callbackProc);
    8: 
    9:     sXtCallback             *sCallback;
   10: 
   11:     string                  type;
   12: 
   13:     String                  callback;
   14: 
   15:     struct_liste_chainee    *tmp;
   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:         numberOfArguments(3);
   23:     FUNCTION
   24:         if (initializationDone eq true) then
   25:             pullFromStack(callbackProc, unknown);
   26:             returnOnError(freeObject(callbackProc));
   27: 
   28:             pullFromStack(callbackName, string);
   29:             returnOnError(freeObject(callbackProc); freeObject(callbackName));
   30: 
   31:             pullFromStack(widget, external);
   32:             returnOnError(freeObject(callbackProc); freeObject(callbackName);
   33:                     freeObject(widget));
   34: 
   35:             ifIsExternal(widget, WIDGET) then
   36:             orElse
   37:                 executionError("Type mismatch error");
   38:                 returnOnError(freeObject(callbackProc);
   39:                         freeObject(callbackName); freeObject(widget));
   40:             endIf
   41: 
   42:             getString(callbackName, type);
   43: 
   44:             if (strcmp(type, "XmNactivateCallback") eq 0) then
   45:                 callback = XmNactivateCallback;
   46:             orElse
   47:                 executionError("Unknown callback type");
   48:                 returnOnError(freeObject(callbackProc);
   49:                         freeObject(callbackName); freeObject(widget));
   50:             endIf
   51: 
   52:             sCallback = allocate(size(sXtCallback));
   53:             sCallback->status = procStatus(rpl_arguments);
   54:             sCallback->callback = callbackProc;
   55:             sCallback->widget = target((Widget *) objectContainer(widget));
   56: 
   57:             XtAddCallback(target((Widget *) objectContainer(widget)),
   58:                     callback, rplCallback, (XtPointer) sCallback);
   59: 
   60:             tmp = allocate(size(struct_liste_chainee));
   61:             tmp->suivant = lCallbacks;
   62:             tmp->donnee = (void *) sCallback;
   63:             lCallbacks = tmp;
   64:         orElse
   65:             executionError("Application not initialized");
   66:             returnOnError();
   67:         endIf
   68:     END
   69: endExternalFunction
   70: 
   71: // vim: ts=4