![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to XtCreateWidget.rplc CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / modules / motif|
Return to XtCreateWidget.rplc CVS log | Up to [local] / rpl / modules / motif |
1.1 bertrand 1: #include "src/rplexternals.h"
2: #include "motif.h"
3:
4: declareExternalFunction(XtCreateWidget)
5: declareObject(nameObject);
6: declareObject(classObject);
7: declareObject(parentObject);
8: declareObject(parametersObject);
9: declareObject(list);
10: declareObject(directive);
1.3 bertrand 11: declareObject(widget);
12:
13: declareInteger(value);
1.1 bertrand 14:
15: declareDaisyChain(current);
16: declareDaisyChain(current2);
17:
18: char target(name);
19: char target(class);
1.3 bertrand 20: char target(cvalue);
1.1 bertrand 21:
1.2 bertrand 22: ArgList args;
1.1 bertrand 23: Cardinal argNum;
1.2 bertrand 24: String argument;
1.1 bertrand 25: WidgetClass wc;
1.3 bertrand 26: XmString x_string;
1.1 bertrand 27:
28: HEADER
29: declareHelpString("Create a Motif widget\n"
30: " 4: name\n"
31: " 3: class\n"
32: " 2: parent\n"
33: " 1: { parameters }\n"
34: " -> 1: widget\n");
35: numberOfArguments(4);
36: FUNCTION
37: if (initializationDone eq true) then
38: pullFromStack(parametersObject, list);
39: returnOnError(freeObject(parametersObject));
40:
41: pullFromStack(parentObject, external);
42: returnOnError(freeObject(parametersObject);
43: freeObject(parentObject));
44:
1.4 ! bertrand 45: ifIsExternal(widget, WIDGET) then
! 46: orElse
! 47: executionError("Type mismatch error");
! 48: returnOnError(freeObject(parametersObject);
! 49: freeObject(parentObject));
! 50: endIf
! 51:
1.1 bertrand 52: pullFromStack(classObject, string);
53: returnOnError(freeObject(parametersObject);
54: freeObject(parentObject);
55: freeObject(classObject));
56:
57: pullFromStack(nameObject, string);
58: returnOnError(freeObject(parametersObject);
59: freeObject(parentObject);
60: freeObject(classObject);
61: freeObject(nameObject));
62:
63: getString(classObject, class);
64: getString(nameObject, name);
65:
66: Xm_widgets_classes(class, wc);
67:
68: returnOnError(freeObject(parametersObject);
69: freeObject(parentObject);
70: freeObject(classObject);
71: freeObject(nameObject));
72:
73: getDaisyChainFromList(parametersObject, current);
74: argNum = 0;
75:
76: repeatWhile(not nullified(current))
77: list = fetchElementFromDaisyChain(current);
78:
79: ifIsList(list) then
80: getDaisyChainFromList(list, current2);
81:
82: if (nullified(current2)) then
83: executionError("Too few arguments");
84: returnOnError(freeObject(parametersObject);
85: freeObject(parentObject);
86: freeObject(classObject);
87: freeObject(nameObject));
88: endIf
89:
90: ifIsString(fetchElementFromDaisyChain(current2)) then
91: orElse
92: executionError("Type mismatch error");
93: returnOnError(freeObject(parametersObject);
94: freeObject(parentObject);
95: freeObject(classObject);
96: freeObject(nameObject));
97: endIf
98:
99: current2 = nextElementOfDaisyChain(current2);
100:
101: if (nullified(current2)) then
102: executionError("Too few arguments");
103: returnOnError(freeObject(parametersObject);
104: freeObject(parentObject);
105: freeObject(classObject);
106: freeObject(nameObject));
107: endIf
108:
109: directive = fetchElementFromDaisyChain(current2);
110:
111: ifIsInteger(directive) then
112: orElse
113: ifIsString(directive) then
114: orElse
115: ifIsName(directive) then
116: orElse
117: executionError("Type mismatch error");
118: returnOnError(freeObject(parametersObject);
119: freeObject(parentObject);
120: freeObject(classObject);
121: freeObject(nameObject));
122: endIf
123: endIf
124: endIf
125:
126: current2 = nextElementOfDaisyChain(current2);
127:
128: if (not nullified(current2)) then
129: executionError("Type mismatch error");
130: returnOnError(freeObject(parametersObject);
131: freeObject(parentObject);
132: freeObject(classObject);
133: freeObject(nameObject));
134: endIf
135: orElse
136: executionError("Type mismatch error");
137: returnOnError(freeObject(parametersObject);
138: freeObject(parentObject);
139: freeObject(classObject);
140: freeObject(nameObject));
141: endIf
142:
143: current = nextElementOfDaisyChain(current);
144: postIncr(argNum);
145: endWhile
1.2 bertrand 146:
147: args = allocate(size(Arg) * argNum);
148: argNum = 0;
149: getDaisyChainFromList(parametersObject, current);
150:
151: repeatWhile(not nullified(current))
152: list = fetchElementFromDaisyChain(current);
153: getDaisyChainFromList(list, current2);
154: getString(fetchElementFromDaisyChain(current2), name);
155: current2 = nextElementOfDaisyChain(current2);
156:
157: XmN_constants(name, argument);
158:
159: returnOnError(freeObject(parametersObject);
160: freeObject(parentObject);
161: freeObject(classObject);
162: freeObject(nameObject));
163:
1.3 bertrand 164: ifIsExternal(fetchElementFromDaisyChain(current2), WIDGET) then
165: if ((strcmp(name, "XmNtopWidget") eq 0) or
166: (strcmp(name, "XmNbottomWidget") eq 0) or
167: (strcmp(name, "XmNleftWidget") eq 0) or
168: (strcmp(name, "XmNrightWidget") eq 0)) then
169: XtSetArg(args[argNum], argument,
170: (XtArgVal) (*((sXtAppContext *)
171: objectContainer(fetchElementFromDaisyChain(
172: current2)))).widget);
173: orElse
174: executionError("Wait for XmN*Widget");
175: deallocate(args);
176: returnOnError(freeObject(parametersObject);
177: freeObject(parentObject);
178: freeObject(classObject);
179: freeObject(nameObject));
180: endIf
181: elseIfIsName(fetchElementFromDaisyChain(current2)) then
182: directive = fetchElementFromDaisyChain(current2);
183: dupObject(directive);
184: intrinsic(pshcntxt);
185: pushOnStack(directive);
186: intrinsic(eval);
187: pullFromStack(directive, unknown);
188: intrinsic(pulcntxt);
1.2 bertrand 189:
1.3 bertrand 190: ifIsInteger(directive) then
191: getInteger(directive, value);
192: XtSetArg(args[argNum], argument, (XtArgVal) value);
193: elseIfIsExternal(directive, WIDGET) then
194: if ((strcmp(name, "XmNtopWidget") eq 0) or
195: (strcmp(name, "XmNbottomWidget") eq 0) or
196: (strcmp(name, "XmNleftWidget") eq 0) or
197: (strcmp(name, "XmNrightWidget") eq 0)) then
198: XtSetArg(args[argNum], argument,
199: (XtArgVal) (*((sXtAppContext *)
200: objectContainer(directive))).widget);
201: orElse
202: executionError("Wait for XmN*Widget");
203: deallocate(args);
204: returnOnError(freeObject(parametersObject);
205: freeObject(parentObject);
206: freeObject(classObject);
207: freeObject(nameObject));
208: endIf
209: endIf
210: elseIfIsInteger(fetchElementFromDaisyChain(current2)) then
211: getInteger(fetchElementFromDaisyChain(current2), value);
212: XtSetArg(args[argNum], argument, (XtArgVal) value);
213: orElse // Allowed types are integer, name, widget or string
214: getString(fetchElementFromDaisyChain(current2), cvalue);
215: x_string = XmStringCreate(cvalue, XmFONTLIST_DEFAULT_TAG);
216: XtSetArg(args[argNum], argument, (XtArgVal) x_string);
217: endIf
1.2 bertrand 218: endWhile
219:
1.3 bertrand 220: createExternalObject(widget, WIDGET);
221:
222: target((Widget *) objectContainer(widget)) =
1.4 ! bertrand 223: XtCreateWidget(name, wc, target((sXtAppContext *)
! 224: objectContainer(parentObject)).widget, args, argNum);
1.3 bertrand 225: XtManageChild(target((Widget *) objectContainer(widget)));
226:
227: pushOnStack(widget);
228: deallocate(args);
1.1 bertrand 229: orElse
230: executionError("Application not initialized");
231: returnOnError();
232: endIf
233:
1.3 bertrand 234: freeObject(parametersObject);
235: freeObject(parentObject);
236: freeObject(classObject);
237: freeObject(nameObject);
1.1 bertrand 238: END
239: endExternalFunction
1.3 bertrand 240:
241: // vim: ts=4