Return to XtCreateWidget.rplc CVS log

Up to [local] / rpl / modules / motif

Premiers bouts de code pour la bibliothèque d'interface Xm.

    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:     Cardinal        argNum;
   19:     WidgetClass     wc;
   20: 
   21:     HEADER
   22:         declareHelpString("Create a Motif widget\n"
   23:                 "    4: name\n"
   24:                 "    3: class\n"
   25:                 "    2: parent\n"
   26:                 "    1: { parameters }\n"
   27:                 " -> 1: widget\n");
   28:         numberOfArguments(4);
   29:     FUNCTION
   30:         if (initializationDone eq true) then
   31:             pullFromStack(parametersObject, list);
   32:             returnOnError(freeObject(parametersObject));
   33: 
   34:             pullFromStack(parentObject, external);
   35:             returnOnError(freeObject(parametersObject);
   36:                     freeObject(parentObject));
   37: 
   38:             pullFromStack(classObject, string);
   39:             returnOnError(freeObject(parametersObject);
   40:                     freeObject(parentObject);
   41:                     freeObject(classObject));
   42: 
   43:             pullFromStack(nameObject, string);
   44:             returnOnError(freeObject(parametersObject);
   45:                     freeObject(parentObject);
   46:                     freeObject(classObject);
   47:                     freeObject(nameObject));
   48: 
   49:             getString(classObject, class);
   50:             getString(nameObject, name);
   51: 
   52:             Xm_widgets_classes(class, wc);
   53: 
   54:             returnOnError(freeObject(parametersObject);
   55:                     freeObject(parentObject);
   56:                     freeObject(classObject);
   57:                     freeObject(nameObject));
   58: 
   59:             getDaisyChainFromList(parametersObject, current);
   60:             argNum = 0;
   61: 
   62:             repeatWhile(not nullified(current))
   63:                 list = fetchElementFromDaisyChain(current);
   64: 
   65:                 ifIsList(list) then
   66:                     getDaisyChainFromList(list, current2);
   67: 
   68:                     if (nullified(current2)) then
   69:                         executionError("Too few arguments");
   70:                         returnOnError(freeObject(parametersObject);
   71:                                 freeObject(parentObject);
   72:                                 freeObject(classObject);
   73:                                 freeObject(nameObject));
   74:                     endIf
   75: 
   76:                     ifIsString(fetchElementFromDaisyChain(current2)) then
   77:                     orElse
   78:                         executionError("Type mismatch error");
   79:                         returnOnError(freeObject(parametersObject);
   80:                                 freeObject(parentObject);
   81:                                 freeObject(classObject);
   82:                                 freeObject(nameObject));
   83:                     endIf
   84: 
   85:                     current2 = nextElementOfDaisyChain(current2);
   86: 
   87:                     if (nullified(current2)) then
   88:                         executionError("Too few arguments");
   89:                         returnOnError(freeObject(parametersObject);
   90:                                 freeObject(parentObject);
   91:                                 freeObject(classObject);
   92:                                 freeObject(nameObject));
   93:                     endIf
   94: 
   95:                     directive = fetchElementFromDaisyChain(current2);
   96: 
   97:                     ifIsInteger(directive) then
   98:                     orElse
   99:                         ifIsString(directive) then
  100:                         orElse
  101:                             ifIsName(directive) then
  102:                             orElse
  103:                                 executionError("Type mismatch error");
  104:                                 returnOnError(freeObject(parametersObject);
  105:                                         freeObject(parentObject);
  106:                                         freeObject(classObject);
  107:                                         freeObject(nameObject));
  108:                             endIf
  109:                         endIf
  110:                     endIf
  111: 
  112:                     current2 = nextElementOfDaisyChain(current2);
  113: 
  114:                     if (not nullified(current2)) then
  115:                         executionError("Type mismatch error");
  116:                         returnOnError(freeObject(parametersObject);
  117:                                 freeObject(parentObject);
  118:                                 freeObject(classObject);
  119:                                 freeObject(nameObject));
  120:                     endIf
  121:                 orElse
  122:                     executionError("Type mismatch error");
  123:                     returnOnError(freeObject(parametersObject);
  124:                             freeObject(parentObject);
  125:                             freeObject(classObject);
  126:                             freeObject(nameObject));
  127:                 endIf
  128: 
  129:                 current = nextElementOfDaisyChain(current);
  130:                 postIncr(argNum);
  131:             endWhile
  132:         orElse
  133:             executionError("Application not initialized");
  134:             returnOnError();
  135:         endIf
  136: 
  137:         setFalse(initializationDone);
  138:     END
  139: endExternalFunction