Return to XtAddCallback.rplc CVS log

Up to [local] / rpl / modules / motif

Annotation of rpl/modules/motif/XtAddCallback.rplc, revision 1.2

1.1       bertrand    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