Return to XtAddCallback.rplc CVS log

Up to [local] / rpl / modules / motif

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

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: 
1.3     ! bertrand    9:    sXtCallback             *sCallback;
1.1       bertrand   10: 
1.3     ! bertrand   11:    string                  type;
        !            12: 
        !            13:    String                  callback;
        !            14: 
        !            15:    struct_liste_chainee    *tmp;
1.1       bertrand   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: 
1.3     ! bertrand   52:            sCallback = allocate(size(sXtCallback));
        !            53:            sCallback->status = procStatus(rpl_arguments);
        !            54:            sCallback->callback = callbackProc;
        !            55:            sCallback->widget = target((Widget *) objectContainer(widget));
1.1       bertrand   56: 
1.3     ! bertrand   57:            XtAddCallback(target((Widget *) objectContainer(widget)),
        !            58:                    callback, rplCallback, (XtPointer) sCallback);
1.1       bertrand   59: 
1.3     ! bertrand   60:            tmp = allocate(size(struct_liste_chainee));
        !            61:            tmp->suivant = lCallbacks;
        !            62:            tmp->donnee = (void *) sCallback;
        !            63:            lCallbacks = tmp;
1.1       bertrand   64:        orElse
                     65:            executionError("Application not initialized");
                     66:            returnOnError();
                     67:        endIf
                     68:    END
                     69: endExternalFunction
                     70: 
                     71: // vim: ts=4