[BACK]Return to XtCreatePopupShell.rplc CVS log [TXT] [DIR] Up to [local] / rpl / modules / motif
File:  [local] / rpl / modules / motif / XtCreatePopupShell.rplc
Revision 1.3: download - view: text, annotated - select for diffs - revision graph
Sun Jul 30 21:59:40 2017 UTC (6 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, rpl-4_1_33, rpl-4_1_32, rpl-4_1_31, rpl-4_1_30, rpl-4_1_29, rpl-4_1_28, rpl-4_1_27, HEAD
Ajout d'une série de patches pour gérer les instructions de type A->B
dans les bibliothèques externes.

    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:             objectOf(widget) = allocate(size(Widget));
   48: 
   49:             target(objectContainer(Widget, widget)) =
   50:                     XtVaCreatePopupShell(wn, wc, target(
   51:                     objectContainer(Widget, parent)), NULL);
   52:             XtManageChild(target(objectContainer(Widget, 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
CVSweb interface <joel.bertrand@systella.fr>