File:  [local] / rpl / modules / motif / XtCreateWidget.rplc
Revision 1.2: download - view: text, annotated - select for diffs - revision graph
Wed Jul 5 19:07:19 2017 UTC (6 years, 10 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Patch pour XtCreateWidget.rplc (ne fonctionne pas).

    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: 
   18:     ArgList         args;
   19:     Cardinal        argNum;
   20:     String          argument;
   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
  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: 
  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>