summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--doc/dde.n4
-rw-r--r--generic/tclInt.decls4
-rw-r--r--generic/tclIntPlatDecls.h10
-rw-r--r--generic/tclStubInit.c10
-rw-r--r--tools/genStubs.tcl38
-rw-r--r--win/tclWinDde.c51
7 files changed, 92 insertions, 33 deletions
diff --git a/ChangeLog b/ChangeLog
index ff1d562..7fe65c8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
diff --git a/doc/dde.n b/doc/dde.n
index 7222f51..5dbbee5 100644
--- a/doc/dde.n
+++ b/doc/dde.n
@@ -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);