Annotation of rpl/modules/motif/XtCreateWidget.rplc, revision 1.2
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);
11:
12: declareDaisyChain(current);
13: declareDaisyChain(current2);
14:
15: char target(name);
16: char target(class);
17:
1.2 ! bertrand 18: ArgList args;
1.1 bertrand 19: Cardinal argNum;
1.2 ! bertrand 20: String argument;
1.1 bertrand 21: WidgetClass wc;
22:
23: HEADER
24: declareHelpString("Create a Motif widget\n"
25: " 4: name\n"
26: " 3: class\n"
27: " 2: parent\n"
28: " 1: { parameters }\n"
29: " -> 1: widget\n");
30: numberOfArguments(4);
31: FUNCTION
32: if (initializationDone eq true) then
33: pullFromStack(parametersObject, list);
34: returnOnError(freeObject(parametersObject));
35:
36: pullFromStack(parentObject, external);
37: returnOnError(freeObject(parametersObject);
38: freeObject(parentObject));
39:
40: pullFromStack(classObject, string);
41: returnOnError(freeObject(parametersObject);
42: freeObject(parentObject);
43: freeObject(classObject));
44:
45: pullFromStack(nameObject, string);
46: returnOnError(freeObject(parametersObject);
47: freeObject(parentObject);
48: freeObject(classObject);
49: freeObject(nameObject));
50:
51: getString(classObject, class);
52: getString(nameObject, name);
53:
54: Xm_widgets_classes(class, wc);
55:
56: returnOnError(freeObject(parametersObject);
57: freeObject(parentObject);
58: freeObject(classObject);
59: freeObject(nameObject));
60:
61: getDaisyChainFromList(parametersObject, current);
62: argNum = 0;
63:
64: repeatWhile(not nullified(current))
65: list = fetchElementFromDaisyChain(current);
66:
67: ifIsList(list) then
68: getDaisyChainFromList(list, current2);
69:
70: if (nullified(current2)) then
71: executionError("Too few arguments");
72: returnOnError(freeObject(parametersObject);
73: freeObject(parentObject);
74: freeObject(classObject);
75: freeObject(nameObject));
76: endIf
77:
78: ifIsString(fetchElementFromDaisyChain(current2)) then
79: orElse
80: executionError("Type mismatch error");
81: returnOnError(freeObject(parametersObject);
82: freeObject(parentObject);
83: freeObject(classObject);
84: freeObject(nameObject));
85: endIf
86:
87: current2 = nextElementOfDaisyChain(current2);
88:
89: if (nullified(current2)) then
90: executionError("Too few arguments");
91: returnOnError(freeObject(parametersObject);
92: freeObject(parentObject);
93: freeObject(classObject);
94: freeObject(nameObject));
95: endIf
96:
97: directive = fetchElementFromDaisyChain(current2);
98:
99: ifIsInteger(directive) then
100: orElse
101: ifIsString(directive) then
102: orElse
103: ifIsName(directive) then
104: orElse
105: executionError("Type mismatch error");
106: returnOnError(freeObject(parametersObject);
107: freeObject(parentObject);
108: freeObject(classObject);
109: freeObject(nameObject));
110: endIf
111: endIf
112: endIf
113:
114: current2 = nextElementOfDaisyChain(current2);
115:
116: if (not nullified(current2)) then
117: executionError("Type mismatch error");
118: returnOnError(freeObject(parametersObject);
119: freeObject(parentObject);
120: freeObject(classObject);
121: freeObject(nameObject));
122: endIf
123: orElse
124: executionError("Type mismatch error");
125: returnOnError(freeObject(parametersObject);
126: freeObject(parentObject);
127: freeObject(classObject);
128: freeObject(nameObject));
129: endIf
130:
131: current = nextElementOfDaisyChain(current);
132: postIncr(argNum);
133: endWhile
1.2 ! bertrand 134:
! 135: args = allocate(size(Arg) * argNum);
! 136: argNum = 0;
! 137: getDaisyChainFromList(parametersObject, current);
! 138:
! 139: repeatWhile(not nullified(current))
! 140: list = fetchElementFromDaisyChain(current);
! 141: getDaisyChainFromList(list, current2);
! 142: getString(fetchElementFromDaisyChain(current2), name);
! 143: current2 = nextElementOfDaisyChain(current2);
! 144:
! 145: XmN_constants(name, argument);
! 146:
! 147: returnOnError(freeObject(parametersObject);
! 148: freeObject(parentObject);
! 149: freeObject(classObject);
! 150: freeObject(nameObject));
! 151:
! 152:
! 153: endWhile
! 154:
1.1 bertrand 155: orElse
156: executionError("Application not initialized");
157: returnOnError();
158: endIf
159:
160: setFalse(initializationDone);
161: END
162: endExternalFunction
CVSweb interface <joel.bertrand@systella.fr>