Annotation of rpl/modules/motif/XtAddCallback.rplc, revision 1.4
1.1 bertrand 1: #include "src/rplexternals.h"
2: #include "motif.h"
3:
4: declareExternalFunction(XtAddCallback)
5: declareObject(widget);
6: declareObject(callbackName);
1.4 ! bertrand 7: declareObject(callbackObject);
1.1 bertrand 8: declareObject(callbackProc);
1.4 ! bertrand 9: declareDaisyChain(tmp);
1.1 bertrand 10:
1.3 bertrand 11: sXtCallback *sCallback;
1.1 bertrand 12:
1.3 bertrand 13: string type;
14:
15: String callback;
16:
1.1 bertrand 17: HEADER
18: declareHelpString("Add callback to a widget\n"
19: " 3: widget\n"
20: " 2: callback name (XmNactivateCallback)\n"
1.4 ! bertrand 21: " 1: expression\n"
! 22: " -> 1: callback\n");
1.1 bertrand 23: numberOfArguments(3);
24: FUNCTION
25: if (initializationDone eq true) then
26: pullFromStack(callbackProc, unknown);
27: returnOnError(freeObject(callbackProc));
28:
29: pullFromStack(callbackName, string);
30: returnOnError(freeObject(callbackProc); freeObject(callbackName));
31:
32: pullFromStack(widget, external);
33: returnOnError(freeObject(callbackProc); freeObject(callbackName);
34: freeObject(widget));
35:
36: ifIsExternal(widget, WIDGET) then
37: orElse
38: executionError("Type mismatch error");
39: returnOnError(freeObject(callbackProc);
40: freeObject(callbackName); freeObject(widget));
41: endIf
42:
43: getString(callbackName, type);
44:
45: if (strcmp(type, "XmNactivateCallback") eq 0) then
46: callback = XmNactivateCallback;
47: orElse
48: executionError("Unknown callback type");
49: returnOnError(freeObject(callbackProc);
50: freeObject(callbackName); freeObject(widget));
51: endIf
52:
1.4 ! bertrand 53: createExternalObject(callbackObject, CALLBACK);
! 54:
1.3 bertrand 55: sCallback = allocate(size(sXtCallback));
56: sCallback->status = procStatus(rpl_arguments);
57: sCallback->callback = callbackProc;
58: sCallback->widget = target((Widget *) objectContainer(widget));
1.4 ! bertrand 59: objectContainer(callbackObject) = sCallback;
1.1 bertrand 60:
1.3 bertrand 61: XtAddCallback(target((Widget *) objectContainer(widget)),
62: callback, rplCallback, (XtPointer) sCallback);
1.1 bertrand 63:
1.3 bertrand 64: tmp = allocate(size(struct_liste_chainee));
1.4 ! bertrand 65: tmp->next = lCallbacks;
! 66: tmp->data = callbackObject;
1.3 bertrand 67: lCallbacks = tmp;
1.4 ! bertrand 68:
! 69: pushOnStack(callbackObject);
1.1 bertrand 70: orElse
71: executionError("Application not initialized");
72: returnOnError();
73: endIf
74: END
75: endExternalFunction
76:
77: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>