Annotation of rpl/modules/motif/XtCreatePopupShell.rplc, revision 1.3
1.1 bertrand 1: #include "src/rplexternals.h"
2: #include "motif.h"
3:
4: declareExternalFunction(XtCreatePopupShell)
5: declareObject(class);
6: declareObject(name);
7: declareObject(parent);
8: declareObject(widget);
9:
10: char target(wc_s);
11: char target(wn);
12:
13: WidgetClass wc;
14:
15: HEADER
16: declareHelpString("Create a popup shell\n"
17: " 3: name\n"
18: " 2: class\n"
19: " 1: parent\n"
20: " -> 1: widget\n");
21: numberOfArguments(3);
22: FUNCTION
23: if (initializationDone eq true) then
24: pullFromStack(parent, external);
25: returnOnError(freeObject(parent));
26:
27: ifIsExternal(parent, WIDGET) then
28: orElse
29: executionError("Type mismath error");
30: returnOnError(freeObject(parent));
31: endIf
32:
33: pullFromStack(class, string);
34: returnOnError(freeObject(parent); freeObject(class));
35: pullFromStack(name, string);
36: returnOnError(freeObject(parent); freeObject(class);
37: freeObject(name));
38:
39: getString(class, wc_s);
40: getString(name, wn);
41:
42: Xm_widgets_classes(wc_s, wc);
43: returnOnError(freeObject(parent); freeObject(class);
44: freeObject(name));
45:
46: createExternalObject(widget, WIDGET);
1.3 ! bertrand 47: objectOf(widget) = allocate(size(Widget));
1.1 bertrand 48:
1.3 ! bertrand 49: target(objectContainer(Widget, widget)) =
! 50: XtVaCreatePopupShell(wn, wc, target(
! 51: objectContainer(Widget, parent)), NULL);
! 52: XtManageChild(target(objectContainer(Widget, widget)));
1.1 bertrand 53:
54: freeObject(parent);
55: freeObject(class);
56: freeObject(name);
57:
58: pushOnStack(widget);
59: orElse
60: executionError("Application not initialized");
61: returnOnError();
62: endIf
63: END
64: endExternalFunction
65:
66: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>