Return to XtCreateWidget.rplc CVS log

Up to [local] / rpl / modules / motif

Patches pour motif.rplso.

    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:     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: 
   22:     ArgList         args;
   23:     Cardinal        argNum;
   24:     String          argument;
   25:     WidgetClass     wc;
   26:     XmString        x_string;
   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
  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: 
  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);
  182: 
  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
  211:             endWhile
  212: 
  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);
  222:         orElse
  223:             executionError("Application not initialized");
  224:             returnOnError();
  225:         endIf
  226: 
  227:         freeObject(parametersObject);
  228:         freeObject(parentObject);
  229:         freeObject(classObject);
  230:         freeObject(nameObject);
  231:     END
  232: endExternalFunction
  233: 
  234: // vim: ts=4