File:  [local] / rpl / modules / motif / XtOpenApplication.rplc
Revision 1.1: download - view: text, annotated - select for diffs - revision graph
Wed Aug 23 09:40:53 2017 UTC (6 years, 8 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, HEAD
Ajout de XtOpenApplication.

    1: #include "src/rplexternals.h"
    2: #include "motif.h"
    3: 
    4: declareExternalFunction(XtOpenApplication)
    5:     int             argc;
    6:     String          *argv;
    7:     string          name;
    8:     string          widgetClass;
    9: 
   10:     declareObject(appObject);
   11:     declareObject(widgetClassObject);
   12:     declareObject(nameObject);
   13:     declareObject(widgetObject);
   14: 
   15:     WidgetClass     wc;
   16: 
   17:     HEADER
   18:         declareHelpString("Initialize application context\n"
   19:                 "    2: \"application name\"\n"
   20:                 "    1: \"shell widget class\"\n"
   21:                 " -> 2: AppContext\n"
   22:                 "    1: Widget\n");
   23:         numberOfArguments(1);
   24:     FUNCTION
   25:         pullFromStack(widgetClassObject, string);
   26:         returnOnError(freeObject(widgetClassObject));
   27:         getString(widgetClassObject, widgetClass);
   28: 
   29:         pullFromStack(nameObject, string);
   30:         returnOnError(freeObject(widgetClassObject); freeObject(nameObject));
   31:         getString(nameObject, name);
   32: 
   33:         argc = 0;
   34:         nullify(argv);
   35: 
   36:         createExternalObject(appObject, APPCONTEXT);
   37:         createExternalObject(widgetObject, WIDGET);
   38: 
   39:         objectOf(appObject) = allocate(size(sXtAppContext));
   40:         objectOf(widgetObject) = allocate(size(Widget));
   41: 
   42:         XtSetLanguageProc(NULL, NULL, NULL);
   43: 
   44:         Xm_widgets_classes(widgetClass, wc);
   45:         target(objectContainer(Widget, widgetObject)) =
   46:                 XtVaOpenApplication(address(target(
   47:                 objectContainer(sXtAppContext, appObject)).context),
   48:                 name, NULL, 0, address(argc), argv, NULL, wc, NULL);
   49:         target(objectContainer(sXtAppContext, appObject)).widget =
   50:                 target(objectContainer(Widget, widgetObject));
   51: 
   52:         XtVaSetValues(target(objectContainer(Widget, widgetObject)),
   53:                 XmNtitle, name,
   54:                 NULL);
   55:         freeObject(nameObject);
   56:         freeObject(widgetClassObject);
   57: 
   58:         if (nullified(objectOf(appObject))) then
   59:             executionError("Nullified XtAppContext");
   60:             freeObject(appObject);
   61:             freeObject(widgetObject);
   62:             returnOnError();
   63:         endIf
   64: 
   65:         pushOnStack(appObject);
   66:         pushOnStack(widgetObject);
   67: 
   68:         setFalse(exitMainLoop);
   69:         setTrue(initializationDone);
   70:     END
   71: endExternalFunction
   72: 
   73: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>