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