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);
47:
48: target((Widget *) objectContainer(widget)) =
49: XtVaCreatePopupShell(wn, wc, target((Widget *)
50: objectContainer(parent)), NULL);
51: XtManageChild(target((Widget *) objectContainer(widget)));
52:
53: freeObject(parent);
54: freeObject(class);
55: freeObject(name);
56:
57: pushOnStack(widget);
58: orElse
59: executionError("Application not initialized");
60: returnOnError();
61: endIf
62: END
63: endExternalFunction
64:
65: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>