Return to XtCreatePopupShell.rplc CVS log

Up to [local] / rpl / modules / motif

Annotation of rpl/modules/motif/XtCreatePopupShell.rplc, revision 1.2

1.1       bertrand    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);
1.2     ! bertrand   47:            objectContainer(widget) = allocate(size(Widget));
1.1       bertrand   48: 
                     49:            target((Widget *) objectContainer(widget)) =
                     50:                    XtVaCreatePopupShell(wn, wc, target((Widget *)
                     51:                    objectContainer(parent)), NULL);
                     52:            XtManageChild(target((Widget *) objectContainer(widget)));
                     53: 
                     54:            freeObject(parent);
                     55:            freeObject(class);
                     56:            freeObject(name);
                     57: 
                     58:            pushOnStack(widget);
                     59:        orElse
                     60:            executionError("Application not initialized");
                     61:            returnOnError();
                     62:        endIf
                     63:    END
                     64: endExternalFunction
                     65: 
                     66: // vim: ts=4