Return to XtAddCallback.rplc CVS log

Up to [local] / rpl / modules / motif

Patches pour motif.

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