home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcltk805.zip / tcl805s.zip / tcl8.0.5 / os2 / tclOS2Init.c < prev    next >
C/C++ Source or Header  |  2001-02-09  |  16KB  |  613 lines
  1. /* 
  2.  * tclOS2Init.c --
  3.  *
  4.  *    Contains the OS/2-specific interpreter initialization functions.
  5.  *
  6.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  7.  * Copyright (c) 1996-2001 Illya Vaes
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  */
  12.  
  13. #include "tclOS2Int.h"
  14.  
  15. /*
  16.  * The following macro can be defined at compile time to specify
  17.  * the Tcl profile key.
  18.  */
  19.  
  20. #ifndef TCL_REGISTRY_KEY
  21. /*
  22. #define TCL_REGISTRY_KEY "Software\\Scriptics\\Tcl\\" TCL_VERSION
  23. */
  24. #define TCL_REGISTRY_KEY "Tcl" TCL_PATCH_LEVEL
  25. #endif
  26.  
  27. /* How many file handles do we want? OS/2 default is 20 */
  28. #define MAX_FH ((ULONG) 25)
  29.  
  30. /* Global PM variables, necessary because of event loop and thus console */
  31. HAB tclHab= (HAB)0;
  32. HMQ tclHmq= (HMQ)0;
  33. /* Other global variables */
  34. ULONG maxPath;
  35. LONG rc;
  36. BOOL usePm = TRUE;
  37. ULONG sysInfo[QSV_MAX];   /* System Information Data Buffer */
  38. #ifdef VERBOSE
  39. int openedFiles = 0;    /* Files opened by us with DosOpen/DosDupHandle */
  40. #endif
  41.  
  42. /*
  43.  * The following variable remembers if we've already initialized PM.
  44.  */
  45.  
  46. static BOOL initialized = FALSE;
  47.  
  48. /*
  49.  * The following arrays contain the human readable strings for the OS/2
  50.  * version values.
  51.  */
  52.  
  53. static char* processors[] = { "intel", "ppc" };
  54. static const int numProcessors = sizeof(processors);
  55.  
  56. #ifndef PROCESSOR_ARCHITECTURE_INTEL
  57. #define PROCESSOR_ARCHITECTURE_INTEL 0
  58. #endif
  59. #ifndef PROCESSOR_ARCHITECTURE_PPC
  60. #define PROCESSOR_ARCHITECTURE_PPC   1
  61. #endif
  62. #ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
  63. #define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
  64. #endif
  65.  
  66. /*
  67.  * The Init script, tclPreInitScript variable, and the routine
  68.  * TclSetPreInitScript (common to Windows, OS/2 and Unix platforms) are
  69.  * defined in generic/tclInitScript.h
  70.  */
  71.  
  72. #include "tclInitScript.h"
  73.  
  74.  
  75. /*
  76.  *----------------------------------------------------------------------
  77.  *
  78.  * TclPlatformInit --
  79.  *
  80.  *    Performs OS/2-specific interpreter initialization related to the
  81.  *    tcl_library variable.  Also sets up the HOME environment variable
  82.  *    if it is not already set.
  83.  *
  84.  * Results:
  85.  *    None.
  86.  *
  87.  * Side effects:
  88.  *    Sets "tcl_library" and "env(HOME)" Tcl variables
  89.  *
  90.  *----------------------------------------------------------------------
  91.  */
  92.  
  93. void
  94. TclPlatformInit(interp)
  95.     Tcl_Interp *interp;
  96. {
  97.     char *p;
  98.     /* buffer is Used for both PrfQueryProfileString and DosQuerySysInfo */
  99.     char buffer[CCHMAXPATH];
  100.     char *args[3];
  101.     char **argv;
  102.     int argc;
  103.     Tcl_DString ds;
  104.     int cpu = PROCESSOR_ARCHITECTURE_INTEL;
  105.     
  106. #ifdef VERBOSE
  107.     printf("TclPlatformInit, interp = 0x%x\n", interp);
  108. #endif
  109.     tclPlatform = TCL_PLATFORM_OS2;
  110.  
  111.     if (interp == (Tcl_Interp *)NULL) {
  112.         return;
  113.     }
  114.  
  115.     Tcl_DStringInit(&ds);
  116.  
  117.     /*
  118.      * Initialize the tcl_library variable from the user profile (OS2.INI).
  119.      * Environment overrides if set.
  120.      */
  121.  
  122.     Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY);
  123. #ifdef VERBOSE
  124.     printf("After Tcl_SetVar tclDefaultLibrary \"\"\n");
  125. #endif
  126.     rc = PrfQueryProfileString(HINI_PROFILE, TCL_REGISTRY_KEY, "InstallDir",
  127.                                NULL, &buffer, CCHMAXPATH);
  128. #ifdef VERBOSE
  129.     printf("PrfQueryProfileString InstallDir returns %d [%s]\n", rc, buffer);
  130. #endif
  131.     if (rc >= 0 && rc < CCHMAXPATH) {
  132.         buffer[rc] = '\0';
  133.     }
  134.     Tcl_SetVar(interp, "tclDefaultLibrary", buffer, TCL_GLOBAL_ONLY);
  135. #ifdef VERBOSE
  136.     printf("After Tcl_SetVar tclDefaultLibrary \"%s\"\n", buffer);
  137. #endif
  138.  
  139.     args[0] = Tcl_GetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
  140.     args[1] = "lib/tcl" TCL_VERSION;
  141.     args[2] = NULL;
  142.     Tcl_DStringSetLength(&ds, 0);
  143.     Tcl_SetVar(interp, "tclDefaultLibrary", Tcl_JoinPath(2, args, &ds),
  144.                TCL_GLOBAL_ONLY);
  145. #ifdef VERBOSE
  146.     printf("tclDefaultLibrary [%s] (%d)\n",
  147.            Tcl_GetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY), rc);
  148. #endif
  149.  
  150.     /*
  151.      * PkgPath is stored as an array of null terminated strings
  152.      * terminated by two null characters.  First count the number
  153.      * of strings, then allocate an argv array so we can construct
  154.      * a valid list.
  155.      */
  156.  
  157.     memset((void *)buffer, 0, CCHMAXPATH);
  158.     rc = PrfQueryProfileString(HINI_PROFILE, TCL_REGISTRY_KEY, "PkgPath",
  159.                                NULL, &buffer, CCHMAXPATH);
  160. #ifdef VERBOSE
  161.     printf("PkgPath INI-file [%s] (%d)\n", buffer, rc);
  162. #endif
  163.     argc = 0;
  164.     p = buffer;
  165.     do {
  166.         if (*p) {
  167.             argc++;
  168.         }
  169.         p += strlen(p) + 1;
  170.     } while (*p);
  171.  
  172.     argv = (char **) ckalloc((sizeof(char *) * argc) + 1);
  173.     argc = 0;
  174.     p = buffer;
  175.     do {
  176.         if (*p) {
  177.             argv[argc++] = p;
  178.             while (*p) {
  179.                 if (*p == '\\') {
  180.                     *p = '/';
  181.                 }
  182.                 p++;
  183.             }
  184.         }
  185.         p++;
  186.     } while (*p);
  187.  
  188.     p = Tcl_Merge(argc, argv);
  189.     Tcl_SetVar(interp, "tcl_pkgPath", p, TCL_GLOBAL_ONLY);
  190. #ifdef VERBOSE
  191.     printf("tcl_pkgPath [%s]\n",
  192.            Tcl_GetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY));
  193. #endif
  194.     Tcl_Free(p);
  195.     ckfree((char*) argv);
  196.  
  197.     /* Request all available system information */
  198.     rc= DosQuerySysInfo (1L, QSV_MAX, (PVOID)sysInfo, sizeof(ULONG)*QSV_MAX);
  199.     maxPath = sysInfo[QSV_MAX_PATH_LENGTH - 1];
  200. #ifdef VERBOSE
  201.     printf("major version [%d], minor version [%d], rev. [%d], maxPath [%d]\n",
  202.            sysInfo[QSV_VERSION_MAJOR - 1], sysInfo[QSV_VERSION_MINOR - 1],
  203.            sysInfo[QSV_VERSION_REVISION - 1], sysInfo[QSV_MAX_PATH_LENGTH - 1]);
  204. #endif
  205.  
  206.     /*
  207.      * Define the tcl_platform array.
  208.      */
  209.  
  210.     Tcl_SetVar2(interp, "tcl_platform", "platform", "os2", TCL_GLOBAL_ONLY);
  211.     Tcl_SetVar2(interp, "tcl_platform", "os", "OS/2", TCL_GLOBAL_ONLY);
  212.     /*
  213.      * Hack for LX-versions above 2.11
  214.      *  OS/2 version    MAJOR MINOR
  215.      *  2.0             20    0
  216.      *  2.1             20    10
  217.      *  2.11            20    11
  218.      *  3.0             20    30
  219.      *  4.0             20    40
  220.      */
  221.     if (sysInfo[QSV_VERSION_MAJOR-1]==20 && sysInfo[QSV_VERSION_MINOR-1] > 11) {
  222.         int major = (int) (sysInfo[QSV_VERSION_MINOR - 1] / 10);
  223.         sprintf(buffer, "%d.%d", major,
  224.                 (int) sysInfo[QSV_VERSION_MINOR - 1] - major * 10);
  225.     } else {
  226.         sprintf(buffer, "%d.%d", (int) (sysInfo[QSV_VERSION_MAJOR - 1] / 10),
  227.                 (int)sysInfo[QSV_VERSION_MINOR - 1]);
  228.     }
  229.     Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
  230.     /* No API for determining processor (yet) */
  231.     Tcl_SetVar2(interp, "tcl_platform", "machine", processors[cpu],
  232.                 TCL_GLOBAL_ONLY);
  233.  
  234.     /*
  235.      * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
  236.      * environment variables, if necessary.
  237.      */
  238.  
  239.     p = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
  240.     if (p == NULL) {
  241.     Tcl_DStringSetLength(&ds, 0);
  242.     p = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
  243.     if (p != NULL) {
  244.         Tcl_DStringAppend(&ds, p, -1);
  245.     }
  246.     p = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
  247.     if (p != NULL) {
  248.         Tcl_DStringAppend(&ds, p, -1);
  249.     }
  250.     if (Tcl_DStringLength(&ds) > 0) {
  251.         Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
  252.             TCL_GLOBAL_ONLY);
  253.     } else {
  254.         Tcl_SetVar2(interp, "env", "HOME", "c:/", TCL_GLOBAL_ONLY);
  255.     }
  256.     }
  257.  
  258.     Tcl_DStringFree(&ds);
  259.  
  260. }
  261.  
  262. /*
  263.  *----------------------------------------------------------------------
  264.  *
  265.  * Tcl_Init --
  266.  *
  267.  *    This procedure is typically invoked by Tcl_AppInit procedures
  268.  *    to perform additional initialization for a Tcl interpreter,
  269.  *    such as sourcing the "init.tcl" script.
  270.  *
  271.  * Results:
  272.  *    Returns a standard Tcl completion code and sets interp->result
  273.  *    if there is an error.
  274.  *
  275.  * Side effects:
  276.  *    Depends on what's in the init.tcl script.
  277.  *
  278.  *----------------------------------------------------------------------
  279.  */
  280.  
  281. int
  282. Tcl_Init(interp)
  283.     Tcl_Interp *interp;        /* Interpreter to initialize. */
  284. {
  285.     if (tclPreInitScript != NULL) {
  286.         if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
  287.             return (TCL_ERROR);
  288.         };
  289.     }
  290.     return(Tcl_Eval(interp, initScript));
  291. }
  292.  
  293. /*
  294.  *----------------------------------------------------------------------
  295.  *
  296.  * TclOS2GetPlatform --
  297.  *
  298.  *      This is a kludge that allows the test library to get access
  299.  *      the internal tclPlatform variable.
  300.  *
  301.  * Results:
  302.  *      Returns a pointer to the tclPlatform variable.
  303.  *
  304.  * Side effects:
  305.  *      None.
  306.  *
  307.  *----------------------------------------------------------------------
  308.  */
  309.  
  310. TclPlatformType *
  311. TclOS2GetPlatform()
  312. {
  313.     return &tclPlatform;
  314. }
  315.  
  316. /*
  317.  *----------------------------------------------------------------------
  318.  *
  319.  * Tcl_SourceRCFile --
  320.  *
  321.  *      This procedure is typically invoked by Tcl_Main of Tk_Main
  322.  *      procedure to source an application specific rc file into the
  323.  *      interpreter at startup time.
  324.  *
  325.  * Results:
  326.  *      None.
  327.  *
  328.  * Side effects:
  329.  *      Depends on what's in the rc script.
  330.  *
  331.  *----------------------------------------------------------------------
  332.  */
  333.  
  334. void
  335. Tcl_SourceRCFile(interp)
  336.     Tcl_Interp *interp;         /* Interpreter to source rc file into. */
  337. {
  338.     Tcl_DString temp;
  339.     char *fileName;
  340.  
  341.     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
  342.  
  343.     if (fileName != NULL) {
  344.         Tcl_Channel c;
  345.         char *fullName;
  346.  
  347.         Tcl_DStringInit(&temp);
  348.         fullName = Tcl_TranslateFileName(interp, fileName, &temp);
  349.         if (fullName == NULL) {
  350.             /*
  351.              * Couldn't translate the file name (e.g. it referred to a
  352.              * bogus user or there was no HOME environment variable).
  353.              * Just do nothing.
  354.              */
  355.         } else {
  356.  
  357.             /*
  358.              * Test for the existence of the rc file before trying to read it.
  359.              */
  360.             c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
  361.             if (c != (Tcl_Channel) NULL) {
  362.                 Tcl_Close(NULL, c);
  363.                 if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
  364. #ifndef CLI_VERSION
  365.                     char cbuf[1000];
  366.                     sprintf(cbuf, "%s\n", Tcl_GetStringResult(interp));
  367.                     WinMessageBox(HWND_DESKTOP, NULLHANDLE, cbuf, "Tclsh", 0,
  368.                                   MB_OK | MB_ICONEXCLAMATION | MB_APPLMODAL);
  369. #else
  370.                     errChannel = Tcl_GetStdChannel(TCL_STDERR);
  371.                     if (errChannel) {
  372.                         Tcl_Write(errChannel, interp->result, -1);
  373.                         Tcl_Write(errChannel, "\n", 1);
  374.                     }
  375. #endif
  376.                 }
  377.             }
  378.         }
  379.         Tcl_DStringFree(&temp);
  380.     }
  381. }
  382.  
  383. /*
  384.  *----------------------------------------------------------------------
  385.  *
  386.  * TclOS2PMInitialize --
  387.  *
  388.  *    Performs OS/2-specific initialization. When we are not going to
  389.  *    use PM perse (command line version), we only determine the anchor
  390.  *    block handle, which is necessary if/when the registry package is
  391.  *    loaded.
  392.  *
  393.  * Results:
  394.  *    True or false depending on intialization.
  395.  *
  396.  * Side effects:
  397.  *    Opens the "PM connection"
  398.  *
  399.  *----------------------------------------------------------------------
  400.  */
  401.  
  402. BOOL
  403. TclOS2PMInitialize(void)
  404. {
  405.     if (initialized) return TRUE;
  406.  
  407.     initialized = TRUE;
  408.  
  409.     if (TclOS2GetUsePm()) {
  410.         /* Initialize PM */
  411.         tclHab = WinInitialize (0);
  412. #ifdef VERBOSE
  413.         printf("HAB: %x\n", tclHab);
  414. #endif
  415.         if (tclHab == NULLHANDLE) return FALSE;
  416.         /* Create message queue, increased size from 10 */
  417.         tclHmq= WinCreateMsgQueue (tclHab, 64);
  418.         if (tclHmq == NULLHANDLE) {
  419.             WinTerminate(tclHab);
  420.             tclHab= (HAB)0;
  421.             return FALSE;
  422.         }
  423.     }
  424.     return TRUE;
  425. }
  426.  
  427. /*
  428.  *----------------------------------------------------------------------
  429.  *
  430.  * TclOS2PMShutdown --
  431.  *
  432.  *    Performs OS/2-specific cleanup.
  433.  *
  434.  * Results:
  435.  *    None.
  436.  *
  437.  * Side effects:
  438.  *    Closes the "PM connection"
  439.  *
  440.  *----------------------------------------------------------------------
  441.  */
  442.  
  443. void
  444. TclOS2PMShutdown(void)
  445. {
  446.     BOOL rc;
  447.  
  448.     if (TclOS2GetUsePm()) {
  449.         /* Reset pointer to arrow */
  450.         rc = WinSetPointer(HWND_DESKTOP,
  451.                            WinQuerySysPointer(HWND_DESKTOP, SPTR_ARROW, FALSE));
  452. #ifdef VERBOSE
  453.         if (rc != TRUE) {
  454.             printf("WinSetPointer TclOS2PMShutdown ERROR: %x\n",
  455.                    WinGetLastError(tclHab));
  456.         } else {
  457.             printf("WinSetPointer TclOS2PMShutdown OK\n");
  458.         }
  459. #endif
  460.         WinDestroyMsgQueue(tclHmq);
  461.         tclHmq= (HMQ)0;
  462.         WinTerminate(tclHab);
  463.         tclHab= (HAB)0;
  464.     }
  465.     initialized = FALSE;
  466. }
  467.  
  468. /*
  469.  *----------------------------------------------------------------------
  470.  *
  471.  * TclOS2GetHAB --
  472.  *
  473.  *    Get the handle to the anchor block.
  474.  *
  475.  * Results:
  476.  *    HAB or NULLHANDLE.
  477.  *
  478.  * Side effects:
  479.  *    None
  480.  *
  481.  *----------------------------------------------------------------------
  482.  */
  483.  
  484. HAB
  485. TclOS2GetHAB(void)
  486. {
  487. #ifdef VERBOSE
  488.     printf("TclOS2GetHAB returning %x\n", tclHab);
  489. #endif
  490.     return tclHab;
  491. }
  492.  
  493. /*
  494.  *----------------------------------------------------------------------
  495.  *
  496.  * TclOS2GetHMQ --
  497.  *
  498.  *    Get the handle to the message queue.
  499.  *
  500.  * Results:
  501.  *    HMQ or NULLHANDLE.
  502.  *
  503.  * Side effects:
  504.  *    None
  505.  *
  506.  *----------------------------------------------------------------------
  507.  */
  508.  
  509. HMQ
  510. TclOS2GetHMQ(HAB hab)
  511. {
  512. #ifdef VERBOSE
  513.     printf("TclOS2GetHMQ returning %x\n", tclHmq);
  514. #endif
  515.     return tclHmq;
  516. }
  517.  
  518. /*
  519.  *----------------------------------------------------------------------
  520.  *
  521.  * TclPlatformExit --
  522.  *
  523.  *    Cleanup and exit on OS/2.
  524.  *
  525.  * Results:
  526.  *    None. This procedure never returns (it exits the process when
  527.  *    it's done).
  528.  *
  529.  * Side effects:
  530.  *    This procedure terminates all relations with PM.
  531.  *
  532.  *----------------------------------------------------------------------
  533.  */
  534.  
  535. void
  536. TclPlatformExit(status)
  537.     int status;                /* Status to exit with */
  538. {
  539. #ifdef VERBOSE
  540.     printf("opened files not closed yet: %d\n", openedFiles);
  541. #endif
  542.     if (usePm) {
  543.         /*
  544.          * The MLE of the Terminal edit window doesn't restore the pointer
  545.          * when the 'exit' command is typed. Force it to be shown.
  546.          */
  547. #ifdef VERBOSE
  548.         printf("Showing pointer...\n");
  549. #endif
  550.         WinShowPointer(HWND_DESKTOP, TRUE);
  551.         WinDestroyMsgQueue(tclHmq);
  552.         tclHmq= (HMQ)0;
  553.         WinTerminate(tclHab);
  554.         tclHab= (HAB)0;
  555.     }
  556.     exit(status);
  557. }
  558.  
  559. /*
  560.  *----------------------------------------------------------------------
  561.  *
  562.  * TclOS2GetUsePm --
  563.  *
  564.  *    Get the value of the DLL's usePm value
  565.  *
  566.  * Results:
  567.  *    Value of usePm (Bool).
  568.  *
  569.  * Side effects:
  570.  *    None
  571.  *
  572.  *----------------------------------------------------------------------
  573.  */
  574.  
  575. BOOL
  576. TclOS2GetUsePm(void)
  577. {
  578. #ifdef VERBOSE
  579.     printf("TclOS2GetUsePm: %d\n", usePm);
  580. #endif
  581.     return usePm;
  582. }
  583.  
  584. /*
  585.  *----------------------------------------------------------------------
  586.  *
  587.  * TclOS2SetUsePm --
  588.  *
  589.  *    Set the value of the DLL's usePm value
  590.  *
  591.  * Results:
  592.  *    None.
  593.  *
  594.  * Side effects:
  595.  *    Sets the DLL's usePm variable.
  596.  *
  597.  *----------------------------------------------------------------------
  598.  */
  599.  
  600. void
  601. TclOS2SetUsePm(value)
  602.     BOOL value;
  603. {
  604. #ifdef VERBOSE
  605.     printf("TclOS2SetUsePm: %d and %d => ", usePm, value);
  606. #endif
  607.     usePm = value;
  608. #ifdef VERBOSE
  609.     printf("%d\n", usePm);
  610. #endif
  611.     return;
  612. }
  613.