Return to XtCreatePopupShell.rplc CVS log

Up to [local] / rpl / modules / motif

Patches pour motif.

    1: #include "src/rplexternals.h"
    2: #include "motif.h"
    3: 
    4: declareExternalFunction(XtCreatePopupShell)
    5:     declareObject(class);
    6:     declareObject(name);
    7:     declareObject(parent);
    8:     declareObject(widget);
    9: 
   10:     char            target(wc_s);
   11:     char            target(wn);
   12: 
   13:     WidgetClass     wc;
   14: 
   15:     HEADER
   16:         declareHelpString("Create a popup shell\n"
   17:                 "    3: name\n"
   18:                 "    2: class\n"
   19:                 "    1: parent\n"
   20:                 " -> 1: widget\n");
   21:         numberOfArguments(3);
   22:     FUNCTION
   23:         if (initializationDone eq true) then
   24:             pullFromStack(parent, external);
   25:             returnOnError(freeObject(parent));
   26: 
   27:             ifIsExternal(parent, WIDGET) then
   28:             orElse
   29:                 executionError("Type mismath error");
   30:                 returnOnError(freeObject(parent));
   31:             endIf
   32: 
   33:             pullFromStack(class, string);
   34:             returnOnError(freeObject(parent); freeObject(class));
   35:             pullFromStack(name, string);
   36:             returnOnError(freeObject(parent); freeObject(class);
   37:                     freeObject(name));
   38: 
   39:             getString(class, wc_s);
   40:             getString(name, wn);
   41: 
   42:             Xm_widgets_classes(wc_s, wc);
   43:             returnOnError(freeObject(parent); freeObject(class);
   44:                     freeObject(name));
   45: 
   46:             createExternalObject(widget, WIDGET);
   47: 
   48:             target((Widget *) objectContainer(widget)) =
   49:                     XtVaCreatePopupShell(wn, wc, target((Widget *)
   50:                     objectContainer(parent)), NULL);
   51:             XtManageChild(target((Widget *) objectContainer(widget)));
   52: 
   53:             freeObject(parent);
   54:             freeObject(class);
   55:             freeObject(name);
   56: 
   57:             pushOnStack(widget);
   58:         orElse
   59:             executionError("Application not initialized");
   60:             returnOnError();
   61:         endIf
   62:     END
   63: endExternalFunction
   64: 
   65: // vim: ts=4