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