/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwin32dll.c
ViewVC logotype

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwin32dll.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclwin32dll.c revision 29 by dashley, Sat Oct 8 07:08:47 2016 UTC projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwin32dll.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwin32dll.c,v 1.1.1.1 2001/06/13 04:48:12 dtashley Exp $ */  
   
 /*  
  * tclWin32Dll.c --  
  *  
  *      This file contains the DLL entry point.  
  *  
  * Copyright (c) 1995-1996 Sun Microsystems, Inc.  
  * Copyright (c) 1998-2000 Scriptics Corporation.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tclwin32dll.c,v 1.1.1.1 2001/06/13 04:48:12 dtashley Exp $  
  */  
   
 #include "tclWinInt.h"  
   
 /*  
  * The following data structures are used when loading the thunking  
  * library for execing child processes under Win32s.  
  */  
   
 typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,  
         LPVOID *lpTranslationList);  
   
 typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,  
         LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,  
         FARPROC UT32Callback, LPVOID Buff);  
   
 typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);  
   
 /*  
  * The following variables keep track of information about this DLL  
  * on a per-instance basis.  Each time this DLL is loaded, it gets its own  
  * new data segment with its own copy of all static and global information.  
  */  
   
 static HINSTANCE hInstance;     /* HINSTANCE of this DLL. */  
 static int platformId;          /* Running under NT, or 95/98? */  
   
 /*  
  * The following function tables are used to dispatch to either the  
  * wide-character or multi-byte versions of the operating system calls,  
  * depending on whether the Unicode calls are available.  
  */  
   
 static TclWinProcs asciiProcs = {  
     0,  
   
     (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,  
     (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,  
     (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,  
     (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA,  
     (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,  
             DWORD, DWORD, HANDLE)) CreateFileA,  
     (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,  
             LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,  
             LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,  
     (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,  
     (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,  
     (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,  
     (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,  
     (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,  
     (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,  
     (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,  
             TCHAR **)) GetFullPathNameA,  
     (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,  
     (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,  
     (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,  
             WCHAR *)) GetTempFileNameA,  
     (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,  
     (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,  
             WCHAR *, DWORD)) GetVolumeInformationA,  
     (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryA,  
     (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,  
     (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,  
     (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,  
     (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,  
             WCHAR *, TCHAR **)) SearchPathA,  
     (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,  
     (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,  
 };  
   
 static TclWinProcs unicodeProcs = {  
     1,  
   
     (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,  
     (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,  
     (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,  
     (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW,  
     (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,  
             DWORD, DWORD, HANDLE)) CreateFileW,  
     (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,  
             LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,  
             LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,  
     (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,  
     (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,  
     (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,  
     (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,  
     (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,  
     (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,  
     (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,  
             TCHAR **)) GetFullPathNameW,  
     (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,  
     (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,  
     (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,  
             WCHAR *)) GetTempFileNameW,  
     (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,  
     (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,  
             WCHAR *, DWORD)) GetVolumeInformationW,  
     (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryW,  
     (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,  
     (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,  
     (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,  
     (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,  
             WCHAR *, TCHAR **)) SearchPathW,  
     (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,  
     (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,  
 };  
   
 TclWinProcs *tclWinProcs;  
 static Tcl_Encoding tclWinTCharEncoding;  
   
 /*  
  * The following declaration is for the VC++ DLL entry point.  
  */  
   
 BOOL APIENTRY           DllMain(HINSTANCE hInst, DWORD reason,  
                                 LPVOID reserved);  
   
   
 #ifdef __WIN32__  
 #ifndef STATIC_BUILD  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * DllEntryPoint --  
  *  
  *      This wrapper function is used by Borland to invoke the  
  *      initialization code for Tcl.  It simply calls the DllMain  
  *      routine.  
  *  
  * Results:  
  *      See DllMain.  
  *  
  * Side effects:  
  *      See DllMain.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 BOOL APIENTRY  
 DllEntryPoint(hInst, reason, reserved)  
     HINSTANCE hInst;            /* Library instance handle. */  
     DWORD reason;               /* Reason this function is being called. */  
     LPVOID reserved;            /* Not used. */  
 {  
     return DllMain(hInst, reason, reserved);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * DllMain --  
  *  
  *      This routine is called by the VC++ C run time library init  
  *      code, or the DllEntryPoint routine.  It is responsible for  
  *      initializing various dynamically loaded libraries.  
  *  
  * Results:  
  *      TRUE on sucess, FALSE on failure.  
  *  
  * Side effects:  
  *      Establishes 32-to-16 bit thunk and initializes sockets library.  
  *  
  *----------------------------------------------------------------------  
  */  
 BOOL APIENTRY  
 DllMain(hInst, reason, reserved)  
     HINSTANCE hInst;            /* Library instance handle. */  
     DWORD reason;               /* Reason this function is being called. */  
     LPVOID reserved;            /* Not used. */  
 {  
     switch (reason) {  
     case DLL_PROCESS_ATTACH:  
         TclWinInit(hInst);  
         return TRUE;  
   
     case DLL_PROCESS_DETACH:  
         if (hInst == hInstance) {  
             Tcl_Finalize();  
         }  
         break;  
     }  
   
     return TRUE;  
 }  
   
 #endif /* !STATIC_BUILD */  
 #endif /* __WIN32__ */  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclWinGetTclInstance --  
  *  
  *      Retrieves the global library instance handle.  
  *  
  * Results:  
  *      Returns the global library instance handle.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 HINSTANCE  
 TclWinGetTclInstance()  
 {  
     return hInstance;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclWinInit --  
  *  
  *      This function initializes the internal state of the tcl library.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Initializes the tclPlatformId variable.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 TclWinInit(hInst)  
     HINSTANCE hInst;            /* Library instance handle. */  
 {  
     OSVERSIONINFO os;  
   
     hInstance = hInst;  
     os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);  
     GetVersionEx(&os);  
     platformId = os.dwPlatformId;  
   
     /*  
      * We no longer support Win32s, so just in case someone manages to  
      * get a runtime there, make sure they know that.  
      */  
   
     if (platformId == VER_PLATFORM_WIN32s) {  
         panic("Win32s is not a supported platform");      
     }  
   
     tclWinProcs = &asciiProcs;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclWinGetPlatformId --  
  *  
  *      Determines whether running under NT, 95, or Win32s, to allow  
  *      runtime conditional code.  
  *  
  * Results:  
  *      The return value is one of:  
  *          VER_PLATFORM_WIN32s         Win32s on Windows 3.1. (not supported)  
  *          VER_PLATFORM_WIN32_WINDOWS  Win32 on Windows 95.  
  *          VER_PLATFORM_WIN32_NT       Win32 on Windows NT  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int              
 TclWinGetPlatformId()  
 {  
     return platformId;  
 }  
   
 /*  
  *-------------------------------------------------------------------------  
  *  
  * TclWinNoBackslash --  
  *  
  *      We're always iterating through a string in Windows, changing the  
  *      backslashes to slashes for use in Tcl.  
  *  
  * Results:  
  *      All backslashes in given string are changed to slashes.  
  *  
  * Side effects:  
  *      None.  
  *  
  *-------------------------------------------------------------------------  
  */  
   
 char *  
 TclWinNoBackslash(  
     char *path)                 /* String to change. */  
 {  
     char *p;  
   
     for (p = path; *p != '\0'; p++) {  
         if (*p == '\\') {  
             *p = '/';  
         }  
     }  
     return path;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclpCheckStackSpace --  
  *  
  *      Detect if we are about to blow the stack.  Called before an  
  *      evaluation can happen when nesting depth is checked.  
  *  
  * Results:  
  *      1 if there is enough stack space to continue; 0 if not.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclpCheckStackSpace()  
 {  
     /*  
      * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD  
      * bytes of stack space left.  alloca() is cheap on windows; basically  
      * it just subtracts from the stack pointer causing the OS to throw an  
      * exception if the stack pointer is set below the bottom of the stack.  
      */  
   
     __try {  
         alloca(TCL_WIN_STACK_THRESHOLD);  
         return 1;  
     } __except (1) {}  
   
     return 0;  
 }  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclWinGetPlatform --  
  *  
  *      This is a kludge that allows the test library to get access  
  *      the internal tclPlatform variable.  
  *  
  * Results:  
  *      Returns a pointer to the tclPlatform variable.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 TclPlatformType *  
 TclWinGetPlatform()  
 {  
     return &tclPlatform;  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TclWinSetInterfaces --  
  *  
  *      A helper proc that allows the test library to change the  
  *      tclWinProcs structure to dispatch to either the wide-character  
  *      or multi-byte versions of the operating system calls, depending  
  *      on whether Unicode is the system encoding.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      None.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 void  
 TclWinSetInterfaces(  
     int wide)                   /* Non-zero to use wide interfaces, 0  
                                  * otherwise. */  
 {  
     Tcl_FreeEncoding(tclWinTCharEncoding);  
   
     if (wide) {  
         tclWinProcs = &unicodeProcs;  
         tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");  
     } else {  
         tclWinProcs = &asciiProcs;  
         tclWinTCharEncoding = NULL;  
     }  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --  
  *  
  *      Convert between UTF-8 and Unicode when running Windows NT or  
  *      the current ANSI code page when running Windows 95.  
  *  
  *      On Mac, Unix, and Windows 95, all strings exchanged between Tcl  
  *      and the OS are "char" oriented.  We need only one Tcl_Encoding to  
  *      convert between UTF-8 and the system's native encoding.  We use  
  *      NULL to represent that encoding.  
  *  
  *      On NT, some strings exchanged between Tcl and the OS are "char"  
  *      oriented, while others are in Unicode.  We need two Tcl_Encoding  
  *      APIs depending on whether we are targeting a "char" or Unicode  
  *      interface.    
  *  
  *      Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an  
  *      encoding of NULL should always used to convert between UTF-8  
  *      and the system's "char" oriented encoding.  The following two  
  *      functions are used in Windows-specific code to convert between  
  *      UTF-8 and Unicode strings (NT) or "char" strings(95).  This saves  
  *      you the trouble of writing the following type of fragment over and  
  *      over:  
  *  
  *              if (running NT) {  
  *                  encoding <- Tcl_GetEncoding("unicode");  
  *                  nativeBuffer <- UtfToExternal(encoding, utfBuffer);  
  *                  Tcl_FreeEncoding(encoding);  
  *              } else {  
  *                  nativeBuffer <- UtfToExternal(NULL, utfBuffer);  
  *              }  
  *  
  *      By convention, in Windows a TCHAR is a character in the ANSI code  
  *      page on Windows 95, a Unicode character on Windows NT.  If you  
  *      plan on targeting a Unicode interfaces when running on NT and a  
  *      "char" oriented interface while running on 95, these functions  
  *      should be used.  If you plan on targetting the same "char"  
  *      oriented function on both 95 and NT, use Tcl_UtfToExternal()  
  *      with an encoding of NULL.  
  *  
  * Results:  
  *      The result is a pointer to the string in the desired target  
  *      encoding.  Storage for the result string is allocated in  
  *      dsPtr; the caller must call Tcl_DStringFree() when the result  
  *      is no longer needed.  
  *  
  * Side effects:  
  *      None.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 TCHAR *  
 Tcl_WinUtfToTChar(string, len, dsPtr)  
     CONST char *string;         /* Source string in UTF-8. */  
     int len;                    /* Source string length in bytes, or < 0 for  
                                  * strlen(). */  
     Tcl_DString *dsPtr;         /* Uninitialized or free DString in which  
                                  * the converted string is stored. */  
 {  
     return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,  
             string, len, dsPtr);  
 }  
   
 char *  
 Tcl_WinTCharToUtf(string, len, dsPtr)  
     CONST TCHAR *string;        /* Source string in Unicode when running  
                                  * NT, ANSI when running 95. */  
     int len;                    /* Source string length in bytes, or < 0 for  
                                  * platform-specific string length. */  
     Tcl_DString *dsPtr;         /* Uninitialized or free DString in which  
                                  * the converted string is stored. */  
 {  
     return Tcl_ExternalToUtfDString(tclWinTCharEncoding,  
             (CONST char *) string, len, dsPtr);  
 }  
   
   
 /* $History: tclwin32dll.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 12:51a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLWIN32DLL.C */  
1    /* $Header$ */
2    /*
3     * tclWin32Dll.c --
4     *
5     *      This file contains the DLL entry point.
6     *
7     * Copyright (c) 1995-1996 Sun Microsystems, Inc.
8     * Copyright (c) 1998-2000 Scriptics Corporation.
9     *
10     * See the file "license.terms" for information on usage and redistribution
11     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12     *
13     * RCS: @(#) $Id: tclwin32dll.c,v 1.1.1.1 2001/06/13 04:48:12 dtashley Exp $
14     */
15    
16    #include "tclWinInt.h"
17    
18    /*
19     * The following data structures are used when loading the thunking
20     * library for execing child processes under Win32s.
21     */
22    
23    typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
24            LPVOID *lpTranslationList);
25    
26    typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
27            LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
28            FARPROC UT32Callback, LPVOID Buff);
29    
30    typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
31    
32    /*
33     * The following variables keep track of information about this DLL
34     * on a per-instance basis.  Each time this DLL is loaded, it gets its own
35     * new data segment with its own copy of all static and global information.
36     */
37    
38    static HINSTANCE hInstance;     /* HINSTANCE of this DLL. */
39    static int platformId;          /* Running under NT, or 95/98? */
40    
41    /*
42     * The following function tables are used to dispatch to either the
43     * wide-character or multi-byte versions of the operating system calls,
44     * depending on whether the Unicode calls are available.
45     */
46    
47    static TclWinProcs asciiProcs = {
48        0,
49    
50        (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,
51        (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,
52        (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,
53        (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA,
54        (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
55                DWORD, DWORD, HANDLE)) CreateFileA,
56        (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
57                LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
58                LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
59        (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,
60        (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,
61        (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,
62        (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,
63        (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,
64        (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
65        (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
66                TCHAR **)) GetFullPathNameA,
67        (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,
68        (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,
69        (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
70                WCHAR *)) GetTempFileNameA,
71        (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,
72        (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
73                WCHAR *, DWORD)) GetVolumeInformationA,
74        (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryA,
75        (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,
76        (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,
77        (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,
78        (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
79                WCHAR *, TCHAR **)) SearchPathA,
80        (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
81        (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
82    };
83    
84    static TclWinProcs unicodeProcs = {
85        1,
86    
87        (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,
88        (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,
89        (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,
90        (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW,
91        (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
92                DWORD, DWORD, HANDLE)) CreateFileW,
93        (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
94                LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
95                LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
96        (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,
97        (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,
98        (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,
99        (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,
100        (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,
101        (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
102        (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
103                TCHAR **)) GetFullPathNameW,
104        (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,
105        (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,
106        (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
107                WCHAR *)) GetTempFileNameW,
108        (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,
109        (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
110                WCHAR *, DWORD)) GetVolumeInformationW,
111        (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryW,
112        (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,
113        (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,
114        (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,
115        (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
116                WCHAR *, TCHAR **)) SearchPathW,
117        (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
118        (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
119    };
120    
121    TclWinProcs *tclWinProcs;
122    static Tcl_Encoding tclWinTCharEncoding;
123    
124    /*
125     * The following declaration is for the VC++ DLL entry point.
126     */
127    
128    BOOL APIENTRY           DllMain(HINSTANCE hInst, DWORD reason,
129                                    LPVOID reserved);
130    
131    
132    #ifdef __WIN32__
133    #ifndef STATIC_BUILD
134    
135    
136    /*
137     *----------------------------------------------------------------------
138     *
139     * DllEntryPoint --
140     *
141     *      This wrapper function is used by Borland to invoke the
142     *      initialization code for Tcl.  It simply calls the DllMain
143     *      routine.
144     *
145     * Results:
146     *      See DllMain.
147     *
148     * Side effects:
149     *      See DllMain.
150     *
151     *----------------------------------------------------------------------
152     */
153    
154    BOOL APIENTRY
155    DllEntryPoint(hInst, reason, reserved)
156        HINSTANCE hInst;            /* Library instance handle. */
157        DWORD reason;               /* Reason this function is being called. */
158        LPVOID reserved;            /* Not used. */
159    {
160        return DllMain(hInst, reason, reserved);
161    }
162    
163    /*
164     *----------------------------------------------------------------------
165     *
166     * DllMain --
167     *
168     *      This routine is called by the VC++ C run time library init
169     *      code, or the DllEntryPoint routine.  It is responsible for
170     *      initializing various dynamically loaded libraries.
171     *
172     * Results:
173     *      TRUE on sucess, FALSE on failure.
174     *
175     * Side effects:
176     *      Establishes 32-to-16 bit thunk and initializes sockets library.
177     *
178     *----------------------------------------------------------------------
179     */
180    BOOL APIENTRY
181    DllMain(hInst, reason, reserved)
182        HINSTANCE hInst;            /* Library instance handle. */
183        DWORD reason;               /* Reason this function is being called. */
184        LPVOID reserved;            /* Not used. */
185    {
186        switch (reason) {
187        case DLL_PROCESS_ATTACH:
188            TclWinInit(hInst);
189            return TRUE;
190    
191        case DLL_PROCESS_DETACH:
192            if (hInst == hInstance) {
193                Tcl_Finalize();
194            }
195            break;
196        }
197    
198        return TRUE;
199    }
200    
201    #endif /* !STATIC_BUILD */
202    #endif /* __WIN32__ */
203    
204    /*
205     *----------------------------------------------------------------------
206     *
207     * TclWinGetTclInstance --
208     *
209     *      Retrieves the global library instance handle.
210     *
211     * Results:
212     *      Returns the global library instance handle.
213     *
214     * Side effects:
215     *      None.
216     *
217     *----------------------------------------------------------------------
218     */
219    
220    HINSTANCE
221    TclWinGetTclInstance()
222    {
223        return hInstance;
224    }
225    
226    /*
227     *----------------------------------------------------------------------
228     *
229     * TclWinInit --
230     *
231     *      This function initializes the internal state of the tcl library.
232     *
233     * Results:
234     *      None.
235     *
236     * Side effects:
237     *      Initializes the tclPlatformId variable.
238     *
239     *----------------------------------------------------------------------
240     */
241    
242    void
243    TclWinInit(hInst)
244        HINSTANCE hInst;            /* Library instance handle. */
245    {
246        OSVERSIONINFO os;
247    
248        hInstance = hInst;
249        os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
250        GetVersionEx(&os);
251        platformId = os.dwPlatformId;
252    
253        /*
254         * We no longer support Win32s, so just in case someone manages to
255         * get a runtime there, make sure they know that.
256         */
257    
258        if (platformId == VER_PLATFORM_WIN32s) {
259            panic("Win32s is not a supported platform");    
260        }
261    
262        tclWinProcs = &asciiProcs;
263    }
264    
265    /*
266     *----------------------------------------------------------------------
267     *
268     * TclWinGetPlatformId --
269     *
270     *      Determines whether running under NT, 95, or Win32s, to allow
271     *      runtime conditional code.
272     *
273     * Results:
274     *      The return value is one of:
275     *          VER_PLATFORM_WIN32s         Win32s on Windows 3.1. (not supported)
276     *          VER_PLATFORM_WIN32_WINDOWS  Win32 on Windows 95.
277     *          VER_PLATFORM_WIN32_NT       Win32 on Windows NT
278     *
279     * Side effects:
280     *      None.
281     *
282     *----------------------------------------------------------------------
283     */
284    
285    int            
286    TclWinGetPlatformId()
287    {
288        return platformId;
289    }
290    
291    /*
292     *-------------------------------------------------------------------------
293     *
294     * TclWinNoBackslash --
295     *
296     *      We're always iterating through a string in Windows, changing the
297     *      backslashes to slashes for use in Tcl.
298     *
299     * Results:
300     *      All backslashes in given string are changed to slashes.
301     *
302     * Side effects:
303     *      None.
304     *
305     *-------------------------------------------------------------------------
306     */
307    
308    char *
309    TclWinNoBackslash(
310        char *path)                 /* String to change. */
311    {
312        char *p;
313    
314        for (p = path; *p != '\0'; p++) {
315            if (*p == '\\') {
316                *p = '/';
317            }
318        }
319        return path;
320    }
321    
322    /*
323     *----------------------------------------------------------------------
324     *
325     * TclpCheckStackSpace --
326     *
327     *      Detect if we are about to blow the stack.  Called before an
328     *      evaluation can happen when nesting depth is checked.
329     *
330     * Results:
331     *      1 if there is enough stack space to continue; 0 if not.
332     *
333     * Side effects:
334     *      None.
335     *
336     *----------------------------------------------------------------------
337     */
338    
339    int
340    TclpCheckStackSpace()
341    {
342        /*
343         * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD
344         * bytes of stack space left.  alloca() is cheap on windows; basically
345         * it just subtracts from the stack pointer causing the OS to throw an
346         * exception if the stack pointer is set below the bottom of the stack.
347         */
348    
349        __try {
350            alloca(TCL_WIN_STACK_THRESHOLD);
351            return 1;
352        } __except (1) {}
353    
354        return 0;
355    }
356    
357    
358    /*
359     *----------------------------------------------------------------------
360     *
361     * TclWinGetPlatform --
362     *
363     *      This is a kludge that allows the test library to get access
364     *      the internal tclPlatform variable.
365     *
366     * Results:
367     *      Returns a pointer to the tclPlatform variable.
368     *
369     * Side effects:
370     *      None.
371     *
372     *----------------------------------------------------------------------
373     */
374    
375    TclPlatformType *
376    TclWinGetPlatform()
377    {
378        return &tclPlatform;
379    }
380    
381    /*
382     *---------------------------------------------------------------------------
383     *
384     * TclWinSetInterfaces --
385     *
386     *      A helper proc that allows the test library to change the
387     *      tclWinProcs structure to dispatch to either the wide-character
388     *      or multi-byte versions of the operating system calls, depending
389     *      on whether Unicode is the system encoding.
390     *
391     * Results:
392     *      None.
393     *
394     * Side effects:
395     *      None.
396     *
397     *---------------------------------------------------------------------------
398     */
399    
400    void
401    TclWinSetInterfaces(
402        int wide)                   /* Non-zero to use wide interfaces, 0
403                                     * otherwise. */
404    {
405        Tcl_FreeEncoding(tclWinTCharEncoding);
406    
407        if (wide) {
408            tclWinProcs = &unicodeProcs;
409            tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
410        } else {
411            tclWinProcs = &asciiProcs;
412            tclWinTCharEncoding = NULL;
413        }
414    }
415    
416    /*
417     *---------------------------------------------------------------------------
418     *
419     * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
420     *
421     *      Convert between UTF-8 and Unicode when running Windows NT or
422     *      the current ANSI code page when running Windows 95.
423     *
424     *      On Mac, Unix, and Windows 95, all strings exchanged between Tcl
425     *      and the OS are "char" oriented.  We need only one Tcl_Encoding to
426     *      convert between UTF-8 and the system's native encoding.  We use
427     *      NULL to represent that encoding.
428     *
429     *      On NT, some strings exchanged between Tcl and the OS are "char"
430     *      oriented, while others are in Unicode.  We need two Tcl_Encoding
431     *      APIs depending on whether we are targeting a "char" or Unicode
432     *      interface.  
433     *
434     *      Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an
435     *      encoding of NULL should always used to convert between UTF-8
436     *      and the system's "char" oriented encoding.  The following two
437     *      functions are used in Windows-specific code to convert between
438     *      UTF-8 and Unicode strings (NT) or "char" strings(95).  This saves
439     *      you the trouble of writing the following type of fragment over and
440     *      over:
441     *
442     *              if (running NT) {
443     *                  encoding <- Tcl_GetEncoding("unicode");
444     *                  nativeBuffer <- UtfToExternal(encoding, utfBuffer);
445     *                  Tcl_FreeEncoding(encoding);
446     *              } else {
447     *                  nativeBuffer <- UtfToExternal(NULL, utfBuffer);
448     *              }
449     *
450     *      By convention, in Windows a TCHAR is a character in the ANSI code
451     *      page on Windows 95, a Unicode character on Windows NT.  If you
452     *      plan on targeting a Unicode interfaces when running on NT and a
453     *      "char" oriented interface while running on 95, these functions
454     *      should be used.  If you plan on targetting the same "char"
455     *      oriented function on both 95 and NT, use Tcl_UtfToExternal()
456     *      with an encoding of NULL.
457     *
458     * Results:
459     *      The result is a pointer to the string in the desired target
460     *      encoding.  Storage for the result string is allocated in
461     *      dsPtr; the caller must call Tcl_DStringFree() when the result
462     *      is no longer needed.
463     *
464     * Side effects:
465     *      None.
466     *
467     *---------------------------------------------------------------------------
468     */
469    
470    TCHAR *
471    Tcl_WinUtfToTChar(string, len, dsPtr)
472        CONST char *string;         /* Source string in UTF-8. */
473        int len;                    /* Source string length in bytes, or < 0 for
474                                     * strlen(). */
475        Tcl_DString *dsPtr;         /* Uninitialized or free DString in which
476                                     * the converted string is stored. */
477    {
478        return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
479                string, len, dsPtr);
480    }
481    
482    char *
483    Tcl_WinTCharToUtf(string, len, dsPtr)
484        CONST TCHAR *string;        /* Source string in Unicode when running
485                                     * NT, ANSI when running 95. */
486        int len;                    /* Source string length in bytes, or < 0 for
487                                     * platform-specific string length. */
488        Tcl_DString *dsPtr;         /* Uninitialized or free DString in which
489                                     * the converted string is stored. */
490    {
491        return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
492                (CONST char *) string, len, dsPtr);
493    }
494    
495    /* End of tclwin32dll.c */
Legend:
Removed from v.29  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25