Annotation of rpl/modules/motif/XtCreateManagedWidget.rplc, revision 1.1
1.1 ! bertrand 1: #include "src/rplexternals.h"
! 2: #include "motif.h"
! 3:
! 4: declareExternalFunction(XtCreateManagedWidget)
! 5: declareObject(nameObject);
! 6: declareObject(classObject);
! 7: declareObject(parentObject);
! 8: declareObject(parametersObject);
! 9: declareObject(list);
! 10: declareObject(directive);
! 11: declareObject(widget);
! 12:
! 13: declareInteger(value);
! 14:
! 15: declareDaisyChain(current);
! 16: declareDaisyChain(current2);
! 17:
! 18: char target(name);
! 19: char target(class);
! 20: char target(cvalue);
! 21: char target(command);
! 22:
! 23: ArgList args;
! 24: Cardinal argNum;
! 25: String argument;
! 26: WidgetClass wc;
! 27: XmString x_string;
! 28:
! 29: HEADER
! 30: declareHelpString("Create a Motif managed 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:
! 46: ifIsExternal(parentObject, WIDGET) then
! 47: orElse
! 48: executionError("Type mismatch error");
! 49: returnOnError(freeObject(parametersObject);
! 50: freeObject(parentObject));
! 51: endIf
! 52:
! 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
! 147:
! 148: args = allocate(size(Arg) * argNum);
! 149: argNum = 0;
! 150: getDaisyChainFromList(parametersObject, current);
! 151:
! 152: repeatWhile(not nullified(current))
! 153: list = fetchElementFromDaisyChain(current);
! 154: getDaisyChainFromList(list, current2);
! 155: getString(fetchElementFromDaisyChain(current2), command);
! 156: current2 = nextElementOfDaisyChain(current2);
! 157:
! 158: XmN_constants(command, argument);
! 159:
! 160: returnOnError(freeObject(parametersObject);
! 161: freeObject(parentObject);
! 162: freeObject(classObject);
! 163: freeObject(nameObject));
! 164:
! 165: ifIsExternal(fetchElementFromDaisyChain(current2), WIDGET) then
! 166: if ((strcmp(command, "XmNtopWidget") eq 0) or
! 167: (strcmp(command, "XmNbottomWidget") eq 0) or
! 168: (strcmp(command, "XmNleftWidget") eq 0) or
! 169: (strcmp(command, "XmNrightWidget") eq 0)) then
! 170: XtSetArg(args[argNum], argument,
! 171: (XtArgVal) target(objectContainer(Widget,
! 172: fetchElementFromDaisyChain(current2))));
! 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);
! 189:
! 190: ifIsInteger(directive) then
! 191: getInteger(directive, value);
! 192: XtSetArg(args[argNum], argument, (XtArgVal) value);
! 193: elseIfIsExternal(directive, WIDGET) then
! 194: if ((strcmp(command, "XmNtopWidget") eq 0) or
! 195: (strcmp(command, "XmNbottomWidget") eq 0) or
! 196: (strcmp(command, "XmNleftWidget") eq 0) or
! 197: (strcmp(command, "XmNrightWidget") eq 0)) then
! 198: XtSetArg(args[argNum], argument,
! 199: (XtArgVal) target(objectContainer(Widget,
! 200: directive)));
! 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
! 218:
! 219: current = nextElementOfDaisyChain(current);
! 220: postIncr(argNum);
! 221: endWhile
! 222:
! 223: createExternalObject(widget, WIDGET);
! 224: objectOf(widget) = allocate(size(Widget));
! 225:
! 226: target(objectContainer(Widget, widget)) =
! 227: XtCreateWidget(name, wc, target(
! 228: objectContainer(Widget, parentObject)), args, argNum);
! 229: XtManageChild(target(objectContainer(Widget, widget)));
! 230:
! 231: pushOnStack(widget);
! 232: deallocate(args);
! 233: orElse
! 234: executionError("Application not initialized");
! 235: returnOnError();
! 236: endIf
! 237:
! 238: freeObject(parametersObject);
! 239: freeObject(parentObject);
! 240: freeObject(classObject);
! 241: freeObject(nameObject);
! 242: END
! 243: endExternalFunction
! 244:
! 245: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to XtCreateManagedWidget.rplc CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / modules / motif