[BACK]Return to XtAppMainLoop.rplc CVS log [TXT] [DIR] Up to [local] / rpl / modules / motif
File:  [local] / rpl / modules / motif / XtAppMainLoop.rplc
Revision 1.4: download - view: text, annotated - select for diffs - revision graph
Sun Jul 30 21:59:40 2017 UTC (7 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(XtAppMainLoop)
    5:     XEvent      event;
    6: 
    7:     declareObject(appObject);
    8: 
    9:     HEADER
   10:         declareHelpString("Main loop of a Motif application\n"
   11:                 "    1: AppContext\n");
   12:         numberOfArguments(1);
   13:     FUNCTION
   14:         if (initializationDone eq true) then
   15:             pullFromStack(appObject, external);
   16:             returnOnError(freeObject(appObject));
   17: 
   18:             ifIsExternal(appObject, APPCONTEXT) then
   19:             orElse
   20:                 executionError("Type mismatch");
   21:                 returnOnError(freeObject(appObject));
   22:             endIf
   23: 
   24:             intrinsic(pshcntxt);
   25: 
   26:             doUntil
   27:                 if (XtAppPending(target(objectContainer(sXtAppContext,
   28:                         appObject)).context) ne 0) then
   29:                     XtAppNextEvent(target(objectContainer(sXtAppContext,
   30:                             appObject)).context, &event);
   31: 
   32:                     if (event.type eq DestroyNotify) then
   33:                         if (event.xdestroywindow.window eq
   34:                                 XtWindow(target(objectContainer(sXtAppContext,
   35:                                 appObject)).widget)) then
   36:                             XtAppSetExitFlag(target(objectContainer(
   37:                                     sXtAppContext, appObject)).context);
   38:                         endIf
   39:                     endIf
   40: 
   41:                     XtDispatchEvent(&event);
   42:                 orElse
   43:                     pollSignalsAndInterrupts();
   44:                     usleep(10000);
   45:                 endIf
   46:             repeatUntil(XtAppGetExitFlag(target(
   47:                     objectContainer(sXtAppContext, appObject)).context) or
   48:                     (stopRequest eq -1) or
   49:                     (exitMainLoop ne 0))
   50: 
   51:             intrinsic(pulcntxt);
   52: 
   53:             XtDestroyApplicationContext(target(
   54:                     objectContainer(sXtAppContext, appObject)).context);
   55:         orElse
   56:             executionError("Application not initialized");
   57:             returnOnError();
   58:         endIf
   59: 
   60:         setFalse(initializationDone);
   61:     END
   62: endExternalFunction
   63: 
   64: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>