diff options
| -rw-r--r-- | generic/tcl.decls | 13 | ||||
| -rw-r--r-- | generic/tclPlatDecls.h | 60 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 14 | ||||
| -rw-r--r-- | tools/genStubs.tcl | 95 |
4 files changed, 49 insertions, 133 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 41e3d1d..db9950c 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1493,7 +1493,6 @@ declare 420 { declare 421 { Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const char *key) } - declare 422 { Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, const char *key, int *newPtr) @@ -1798,12 +1797,16 @@ declare 573 { ############################################################################## -# Define the platform specific public Tcl interface. These functions are -# only available on the designated platform. +# Define the platform specific public Tcl interface. These functions are only +# available on the designated platform. interface tclPlat ################################ +# Unix specific functions +# (none) + +################################ # Windows specific functions # Added in Tcl 8.1 @@ -1867,12 +1870,12 @@ declare 8 mac { ################################ # Mac OS X specific functions -declare 0 unix { +declare 0 macosx { int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath) } -declare 1 unix { +declare 1 macosx { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath) diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index 02191ca..b288296 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -29,20 +29,7 @@ * Exported function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ -/* 0 */ -EXTERN int Tcl_MacOSXOpenBundleResources _ANSI_ARGS_(( - Tcl_Interp *interp, CONST char *bundleName, - int hasResourceFile, int maxPathLen, - char *libraryPath)); -/* 1 */ -EXTERN int Tcl_MacOSXOpenVersionedBundleResources _ANSI_ARGS_(( - Tcl_Interp *interp, CONST char *bundleName, - CONST char *bundleVersion, - int hasResourceFile, int maxPathLen, - char *libraryPath)); -#endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) || defined(__CYGWIN__) /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar _ANSI_ARGS_((CONST char *str, int len, Tcl_DString *dsPtr)); @@ -81,16 +68,25 @@ EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1, EXTERN int strcasecmp _ANSI_ARGS_((CONST char *s1, CONST char *s2)); #endif /* MAC_TCL */ +#ifdef MAC_OSX_TCL +/* 0 */ +EXTERN int Tcl_MacOSXOpenBundleResources _ANSI_ARGS_(( + Tcl_Interp *interp, CONST char *bundleName, + int hasResourceFile, int maxPathLen, + char *libraryPath)); +/* 1 */ +EXTERN int Tcl_MacOSXOpenVersionedBundleResources _ANSI_ARGS_(( + Tcl_Interp *interp, CONST char *bundleName, + CONST char *bundleVersion, + int hasResourceFile, int maxPathLen, + char *libraryPath)); +#endif /* MAC_OSX_TCL */ typedef struct TclPlatStubs { int magic; struct TclPlatStubHooks *hooks; -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ - int (*tcl_MacOSXOpenBundleResources) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath)); /* 0 */ - int (*tcl_MacOSXOpenVersionedBundleResources) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath)); /* 1 */ -#endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) || defined(__CYGWIN__) TCHAR * (*tcl_WinUtfToTChar) _ANSI_ARGS_((CONST char *str, int len, Tcl_DString *dsPtr)); /* 0 */ char * (*tcl_WinTCharToUtf) _ANSI_ARGS_((CONST TCHAR *str, int len, Tcl_DString *dsPtr)); /* 1 */ #endif /* __WIN32__ */ @@ -105,6 +101,10 @@ typedef struct TclPlatStubs { int (*strncasecmp) _ANSI_ARGS_((CONST char *s1, CONST char *s2, size_t n)); /* 7 */ int (*strcasecmp) _ANSI_ARGS_((CONST char *s1, CONST char *s2)); /* 8 */ #endif /* MAC_TCL */ +#ifdef MAC_OSX_TCL + int (*tcl_MacOSXOpenBundleResources) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath)); /* 0 */ + int (*tcl_MacOSXOpenVersionedBundleResources) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath)); /* 1 */ +#endif /* MAC_OSX_TCL */ } TclPlatStubs; #ifdef __cplusplus @@ -121,17 +121,7 @@ extern TclPlatStubs *tclPlatStubsPtr; * Inline function declarations: */ -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ -#ifndef Tcl_MacOSXOpenBundleResources -#define Tcl_MacOSXOpenBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ -#endif -#ifndef Tcl_MacOSXOpenVersionedBundleResources -#define Tcl_MacOSXOpenVersionedBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ -#endif -#endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) || defined(__CYGWIN__) #ifndef Tcl_WinUtfToTChar #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ @@ -179,6 +169,16 @@ extern TclPlatStubs *tclPlatStubsPtr; (tclPlatStubsPtr->strcasecmp) /* 8 */ #endif #endif /* MAC_TCL */ +#ifdef MAC_OSX_TCL +#ifndef Tcl_MacOSXOpenBundleResources +#define Tcl_MacOSXOpenBundleResources \ + (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ +#endif +#ifndef Tcl_MacOSXOpenVersionedBundleResources +#define Tcl_MacOSXOpenVersionedBundleResources \ + (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ +#endif +#endif /* MAC_OSX_TCL */ #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 1ed349c..87c5039 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -187,10 +187,6 @@ Tcl_WinTCharToUtf( string, len, dsPtr); } -#define Tcl_MacOSXOpenBundleResources (int (*) _ANSI_ARGS_(( \ - Tcl_Interp *, CONST char *, int, int, char *))) Tcl_WinUtfToTChar -#define Tcl_MacOSXOpenVersionedBundleResources (int (*) _ANSI_ARGS_(( \ - Tcl_Interp *, CONST char *, CONST char *, int, int, char *))) Tcl_WinTCharToUtf #define TclMacOSXGetFileAttribute (int (*) _ANSI_ARGS_((Tcl_Interp *, \ int, Tcl_Obj *, Tcl_Obj **))) TclpCreateProcess #define TclMacOSXMatchType (int (*) _ANSI_ARGS_((Tcl_Interp *, CONST char *, \ @@ -560,11 +556,7 @@ TclIntPlatStubs tclIntPlatStubs = { TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, NULL, -#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ - Tcl_MacOSXOpenBundleResources, /* 0 */ - Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ -#endif /* UNIX */ -#ifdef __WIN32__ +#if defined(__WIN32__) || defined(__CYGWIN__) Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ #endif /* __WIN32__ */ @@ -579,6 +571,10 @@ TclPlatStubs tclPlatStubs = { strncasecmp, /* 7 */ strcasecmp, /* 8 */ #endif /* MAC_TCL */ +#ifdef MAC_OSX_TCL + Tcl_MacOSXOpenBundleResources, /* 0 */ + Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ +#endif /* MAC_OSX_TCL */ }; static TclStubHooks tclStubHooks = { diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index c2b0b27..009db07 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -242,7 +242,7 @@ proc genStubs::addPlatformGuard {plat text} { return "#if !(defined(__WIN32__) || defined(MAC_TCL) || defined(MAC_OSX_TK)) /* X11 */\n${text}#endif /* X11 */\n" } } - return "$text" + return $text } # genStubs::emitSlots -- @@ -451,71 +451,6 @@ proc genStubs::makeMacro {name decl index} { return $text } -# genStubs::makeStub -- -# -# Emits a stub function definition. -# -# Arguments: -# name The interface name. -# decl The function declaration. -# index The slot index for this function. -# -# Results: -# Returns the formatted stub function definition. - -proc genStubs::makeStub {name decl index} { - lassign $decl rtype fname args - - set lfname [string tolower [string index $fname 0]] - append lfname [string range $fname 1 end] - - append text "/* Slot $index */\n" $rtype "\n" $fname - - set arg1 [lindex $args 0] - - if {![string compare $arg1 "TCL_VARARGS"]} { - lassign [lindex $args 1] type argName - append text " TCL_VARARGS_DEF($type,$argName)\n\{\n" - append text " " $type " var;\n va_list argList;\n" - if {[string compare $rtype "void"]} { - append text " " $rtype " resultValue;\n" - } - append text "\n var = (" $type ") TCL_VARARGS_START(" \ - $type "," $argName ",argList);\n\n " - if {[string compare $rtype "void"]} { - append text "resultValue = " - } - append text "(" $name "StubsPtr->" $lfname "VA)(var, argList);\n" - append text " va_end(argList);\n" - if {[string compare $rtype "void"]} { - append text "return resultValue;\n" - } - append text "\}\n\n" - return $text - } - - if {![string compare $arg1 "void"]} { - set argList "()" - set argDecls "" - } else { - set argList "" - set sep "(" - foreach arg $args { - append argList $sep [lindex $arg 1] - append argDecls " " [lindex $arg 0] " " \ - [lindex $arg 1] [lindex $arg 2] ";\n" - set sep ", " - } - append argList ")" - } - append text $argList "\n" $argDecls "{\n " - if {[string compare $rtype "void"]} { - append text "return " - } - append text "(" $name "StubsPtr->" $lfname ")" $argList ";\n}\n\n" - return $text -} - # genStubs::makeSlot -- # # Generate the stub table entry for a function. @@ -538,8 +473,11 @@ proc genStubs::makeSlot {name decl index} { if {($rtype != "void") && ($rtype != "pascal void")} { regsub -all void $rtype VOID rtype } - append text $rtype " (*" $lfname ") _ANSI_ARGS_(" - + if {[string range $rtype end-8 end] == "__stdcall"} { + append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") _ANSI_ARGS_(" + } else { + append text $rtype " (*" $lfname ") _ANSI_ARGS_(" + } regsub -all void $args VOID args set arg1 [lindex $args 0] switch -exact $arg1 { @@ -823,27 +761,6 @@ proc genStubs::emitHeader {name} { return } -# genStubs::emitStubs -- -# -# This function emits the body of the <name>Stubs.c file for -# the specified interface. -# -# Arguments: -# name The name of the interface being emitted. -# -# Results: -# None. - -proc genStubs::emitStubs {name} { - variable outDir - - append text "\n/*\n * Exported stub functions:\n */\n\n" - forAllStubs $name makeStub 0 text - - rewriteFile [file join $outDir ${name}Stubs.c] $text - return -} - # genStubs::emitInit -- # # Generate the table initializers for an interface. |