diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | doc/dde.n | 4 | ||||
| -rw-r--r-- | generic/tclInt.decls | 4 | ||||
| -rw-r--r-- | generic/tclIntPlatDecls.h | 10 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 10 | ||||
| -rw-r--r-- | tools/genStubs.tcl | 38 | ||||
| -rw-r--r-- | win/tclWinDde.c | 51 |
7 files changed, 92 insertions, 33 deletions
@@ -1,3 +1,11 @@ +2012-05-24 Jan Nijtmans <nijtmans@users.sf.net> + + * tools/genStubs.tcl: Take cygwin handling of X11 into account. + * generic/tcl*Decls.h: re-generated + * generic/tclStubInit.c: Implement TclpIsAtty, Cygwin only. + * doc/dde.n: Doc fix: "dde execute iexplore" doesn't work + without -async, because iexplore doesn't return a value + 2012-05-22 Jan Nijtmans <nijtmans@users.sf.net> * tools/genStubs.tcl: Let cygwin share stub table with win32 @@ -124,7 +124,7 @@ unpredictable results. .PP An external application which wishes to run a script in Tcl should have that script store its result in a variable, run the \fBdde execute\fR -command, and the run \fBdde request\fR to get the value of the +command, and then run \fBdde request\fR to get the value of the variable. .PP When using DDE, be careful to ensure that the event queue is flushed @@ -140,7 +140,7 @@ This asks Internet Explorer (which must already be running) to go to a particularly important website: .CS package require dde -\fBdde execute\fR iexplore WWW_OpenURL http://www.tcl.tk/ +\fBdde execute\fR -async iexplore WWW_OpenURL http://www.tcl.tk/ .CE .SH "SEE ALSO" diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 67f3db6..d714e85 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -894,6 +894,10 @@ declare 15 win { const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr) } +# new for 8.4.20+/8.5.12+ Cygwin only +declare 16 win { + int TclpIsAtty(int fd) +} # Signature changed in 8.1: # declare 16 win { # TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr) diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 201c597..350df03 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -134,7 +134,8 @@ EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); -/* Slot 16 is reserved */ +/* 16 */ +EXTERN int TclpIsAtty _ANSI_ARGS_((int fd)); /* Slot 17 is reserved */ /* 18 */ EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel, @@ -289,7 +290,7 @@ typedef struct TclIntPlatStubs { Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)); /* 13 */ int (*tclpCreatePipe) _ANSI_ARGS_((TclFile *readPipe, TclFile *writePipe)); /* 14 */ int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); /* 15 */ - VOID *reserved16; + int (*tclpIsAtty) _ANSI_ARGS_((int fd)); /* 16 */ VOID *reserved17; TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 18 */ TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char *fname, int mode)); /* 19 */ @@ -488,7 +489,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */ #endif -/* Slot 16 is reserved */ +#ifndef TclpIsAtty +#define TclpIsAtty \ + (tclIntPlatStubsPtr->tclpIsAtty) /* 16 */ +#endif /* Slot 17 is reserved */ #ifndef TclpMakeFile #define TclpMakeFile \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index e623fa6..b548b1d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -72,7 +72,9 @@ int TclSockMinimumBuffersOld(sock, size) #ifdef __WIN32__ # define TclUnixWaitForFile 0 # define TclpReaddir 0 +# define TclpIsAtty 0 #elif defined(__CYGWIN__) +# define TclpIsAtty TclPlatIsAtty # define TclWinSetInterfaces (void (*) (int)) doNothing # define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing # define TclWinFlushDirtyChannels doNothing @@ -81,6 +83,12 @@ int TclSockMinimumBuffersOld(sock, size) static Tcl_Encoding winTCharEncoding; +static int +TclpIsAtty(int fd) +{ + return isatty(fd); +} + int TclWinGetPlatformId() { @@ -461,7 +469,7 @@ TclIntPlatStubs tclIntPlatStubs = { TclpCreateCommandChannel, /* 13 */ TclpCreatePipe, /* 14 */ TclpCreateProcess, /* 15 */ - NULL, /* 16 */ + TclpIsAtty, /* 16 */ NULL, /* 17 */ TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 00888c9..e4cf868 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -279,18 +279,26 @@ proc genStubs::rewriteFile {file text} { # Results: # Returns the original text inside an appropriate #ifdef. -proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { +proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { set text "" switch $plat { win { - append text "#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */\n${iftxt}" + append text "#if defined(__WIN32__)" + if {$withCygwin} { + append text " || defined(__CYGWIN__)" + } + append text " /* WIN */\n${iftxt}" if {$eltxt != ""} { append text "#else /* WIN */\n${eltxt}" } append text "#endif /* WIN */\n" } unix { - append text "#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_TCL)\ + append text "#if !defined(__WIN32__)" + if {$withCygwin} { + append text " && !defined(__CYGWIN__)" + } + append text " && !defined(MAC_TCL)\ /* UNIX */\n${iftxt}" if {$eltxt != ""} { append text "#else /* UNIX */\n${eltxt}" @@ -319,7 +327,11 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { append text "#endif /* AQUA */\n" } x11 { - append text "#if !(defined(__WIN32__) || defined(__CYGWIN__) || defined(MAC_TCL) || defined(MAC_OSX_TK))\ + append text "#if !(defined(__WIN32__)" + if {$withCygwin} { + append text " || defined(__CYGWIN__)" + } + append text " || defined(MAC_OSX_TK))\ /* X11 */\n${iftxt}" if {$eltxt != ""} { append text "#else /* X11 */\n${eltxt}" @@ -466,7 +478,7 @@ proc genStubs::makeDecl {name decl index} { append line " " set pad 0 } - if {$args eq ""} { + if {$args == ""} { append line $fname append text $line append text ";\n" @@ -490,7 +502,7 @@ proc genStubs::makeDecl {name decl index} { append line $sep set next {} append next [lindex $arg 0] - if {[string index $next end] ne "*"} { + if {[string index $next end] != "*"} { append next " " } append next [lindex $arg 1] [lindex $arg 2] @@ -603,7 +615,7 @@ proc genStubs::makeSlot {name decl index} { set sep "(" foreach arg $args { append text $sep [lindex $arg 0] - if {[string index $text end] ne "*"} { + if {[string index $text end] != "*"} { append text " " } append text [lindex $arg 1] [lindex $arg 2] @@ -630,7 +642,7 @@ proc genStubs::makeSlot {name decl index} { # Returns the formatted declaration string. proc genStubs::makeInit {name decl index} { - if {[lindex $decl 2] eq ""} { + if {[lindex $decl 2] == ""} { append text " &" [lindex $decl 1] ", /* " $index " */\n" } else { append text " " [lindex $decl 1] ", /* " $index " */\n" @@ -737,7 +749,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar append temp [$slotProc $name $stubs($name,$plat,$i) $i] } } - append text [addPlatformGuard $plat $temp] + append text [addPlatformGuard $plat $temp {} true] } } # Again, make sure you don't duplicate entries for macosx & aqua. @@ -780,7 +792,7 @@ proc genStubs::forAllStubs {name slotProc onAll textVar append temp [$slotProc $name $stubs($name,x11,$i) $i] } } - append text [addPlatformGuard x11 $temp] + append text [addPlatformGuard x11 $temp {} true] } } } @@ -820,12 +832,14 @@ proc genStubs::emitMacros {name textVar} { upvar $textVar text set upName [string toupper $libraryName] - append text "\n#if defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS)\n" + append text "\n#if defined(USE_${upName}_STUBS) &&\ + !defined(USE_${upName}_STUB_PROCS)\n" append text "\n/*\n * Inline function declarations:\n */\n\n" forAllStubs $name makeMacro 0 text - append text "\n#endif /* defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS) */\n" + append text "\n#endif /* defined(USE_${upName}_STUBS) &&\ + !defined(USE_${upName}_STUB_PROCS) */\n" return } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 3b8ca23..4ef7f41 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -181,7 +181,7 @@ Initialize(void) ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, 0); + TCL_DDE_SERVICE_NAME, CP_WINANSI); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; @@ -577,6 +577,7 @@ DdeServerProc( */ Tcl_Obj *returnPackagePtr; + Tcl_UniChar *uniStr; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -590,11 +591,21 @@ DdeServerProc( } utilString = (char *) DdeAccessData(hData, &dlen); - len = dlen; - if (len && !utilString[len-1]) { - len--; + uniStr = (Tcl_UniChar *) utilString; + if (!dlen) { + /* Empty string. (Since TIP #106 we can create this!) */ + ddeObjectPtr = Tcl_NewObj(); + } else if (0) { + /* Cannot be unicode, so assume utf-8 */ + if (!utilString[dlen-1]) { + dlen--; + } + ddeObjectPtr = Tcl_NewStringObj(utilString, dlen); + } else { + /* unicode */ + dlen >>= 1; + ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen); } - ddeObjectPtr = Tcl_NewStringObj(utilString, len); Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); if (convPtr->returnPackagePtr != NULL) { @@ -712,8 +723,8 @@ MakeDdeConnection( HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINANSI); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINANSI); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -989,7 +1000,7 @@ DdeObjCmd( "-binary", NULL }; - int index, length; + int index, length, argIndex; int async = 0, binary = 0; int result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; @@ -1081,11 +1092,9 @@ DdeObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args"); return TCL_ERROR; } else { - int dummy; - firstArg = 2; if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", - 0, &dummy) == TCL_OK) { + 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } @@ -1143,8 +1152,12 @@ DdeObjCmd( break; } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); + if (ddeService) { + DdeFreeStringHandle(ddeInstance, ddeService); + } + if (ddeTopic) { + DdeFreeStringHandle(ddeInstance, ddeTopic); + } if (hConv == NULL) { SetDdeError(interp); @@ -1185,8 +1198,12 @@ DdeObjCmd( goto cleanup; } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); + if (ddeService) { + DdeFreeStringHandle(ddeInstance, ddeService); + } + if (ddeTopic) { + DdeFreeStringHandle(ddeInstance, ddeTopic); + } if (hConv == NULL) { SetDdeError(interp); @@ -1242,8 +1259,12 @@ DdeObjCmd( &length); hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); + if (ddeService) { DdeFreeStringHandle(ddeInstance, ddeService); + } + if (ddeTopic) { DdeFreeStringHandle(ddeInstance, ddeTopic); + } if (hConv == NULL) { SetDdeError(interp); |