Return to XtAddCallback.rplc CVS log

Up to [local] / rpl / modules / motif

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

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