summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog30
-rw-r--r--generic/tclIO.c8
-rw-r--r--generic/tclIORChan.c173
-rw-r--r--generic/tclIOSock.c2
-rw-r--r--generic/tclPlatDecls.h2
-rw-r--r--library/dde/pkgIndex.tcl4
-rw-r--r--tests/ioCmd.test116
-rwxr-xr-xunix/configure5
-rw-r--r--unix/configure.in5
-rw-r--r--unix/tclUnixPort.h1
-rwxr-xr-xwin/configure5
-rw-r--r--win/configure.in5
-rw-r--r--win/tclWinDde.c225
13 files changed, 451 insertions, 130 deletions
diff --git a/ChangeLog b/ChangeLog
index fc7c245..f0c7533 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,33 @@
+2012-05-10 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent
+ * library/dde/pkgIndex.tcl Increase version to 1.3.3
+
+2012-05-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * {win,unix}/configure{,.in} [Bug 2812981]: Clean up bundled
+ packages' build directory from within Tcl's ./configure, to avoid
+ stale configuration.
+
+2012-05-09 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclIORChan.c [Bug 3522560]: Fixed the crash, enabled the
+ test case. Modified [chan postevent] to properly inject the
+ event(s) into the owner thread's event queue for execution in the
+ correct context. Renamed the ForwardOpTo...Thread() function to
+ match with our terminology.
+
+ * tests/ioCmd.test [Bug 3522560]: Added a test which crashes the
+ core if it were not disabled as knownBug. For a reflected channel
+ transfered to a different thread the [chan postevent] run in the
+ handler thread tries to execute the owner threads's fileevent
+ scripts by itself, wrongly reaching across thread boundaries.
+
+2012-04-28 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * generic/tclIO.c: Properly close nonblocking channels even when
+ not flushing them.
+
2012-05-03 Jan Nijtmans <nijtmans@users.sf.net>
* compat/zlib/*: Upgrade to zlib 1.2.7 (pre-built dll is still 1.2.5,
diff --git a/generic/tclIO.c b/generic/tclIO.c
index b06c14d..9e729c4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -428,14 +428,15 @@ TclFinalizeIOSubsystem(void)
statePtr = statePtr->nextCSPtr) {
chanPtr = statePtr->topChanPtr;
if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD)
- || (doflushnb && GotFlag(statePtr, BG_FLUSH_SCHEDULED))) {
+ || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+ ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
active = 1;
break;
}
}
/*
- * We've found a live channel. Close it.
+ * We've found a live (or bg-closing) channel. Close it.
*/
if (active) {
@@ -479,7 +480,6 @@ TclFinalizeIOSubsystem(void)
* The refcount is greater than zero, so flush the channel.
*/
- ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
Tcl_Flush((Tcl_Channel) chanPtr);
/*
@@ -8760,7 +8760,7 @@ CreateScriptRecord(
/*
* Initialize the structure before calling Tcl_CreateChannelHandler,
- * because a reflected channel caling 'chan postevent' aka
+ * because a reflected channel calling 'chan postevent' aka
* 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
* 'TclChannelEventScriptInvoker' immediately, and we do not wish it to
* see uninitialized memory and crash. See [Bug 2918110].
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 49e2930..2d31da3 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -39,6 +39,9 @@ static int ReflectOutput(ClientData clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
+#ifdef TCL_THREADS
+static void ReflectThread(ClientData clientData, int action);
+#endif
static Tcl_WideInt ReflectSeekWide(ClientData clientData,
Tcl_WideInt offset, int mode, int *errorCodePtr);
static int ReflectSeek(ClientData clientData, long offset,
@@ -71,7 +74,11 @@ static const Tcl_ChannelType tclRChannelType = {
NULL, /* Flush channel. Not used by core. NULL'able */
NULL, /* Handle events. NULL'able */
ReflectSeekWide, /* Move access point (64 bit). NULL'able */
+#ifdef TCL_THREADS
+ ReflectThread, /* thread action, tracking owner */
+#else
NULL, /* thread action */
+#endif
NULL /* truncate */
};
@@ -89,7 +96,8 @@ typedef struct {
* command is gone.
*/
#ifdef TCL_THREADS
- Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
+ Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
+ Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
#endif
/* See [==] as well.
@@ -390,7 +398,7 @@ TCL_DECLARE_MUTEX(rcForwardMutex)
* leak resources when threads go away.
*/
-static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr,
+static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
ForwardedOperation op, const void *param);
static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(ClientData clientData);
@@ -765,6 +773,48 @@ TclChanCreateObjCmd(
*----------------------------------------------------------------------
*/
+typedef struct ReflectEvent {
+ Tcl_Event header;
+ ReflectedChannel* rcPtr;
+ int events;
+} ReflectEvent;
+
+static int
+ReflectEventRun (Tcl_Event* ev, int flags)
+{
+ /* OWNER thread
+ *
+ * Note: When the channel is closed any pending events of this type are
+ * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls
+ * accomplishing that.
+ */
+
+ ReflectEvent* e = (ReflectEvent*) ev;
+
+ Tcl_NotifyChannel (e->rcPtr->chan, e->events);
+ return 1;
+}
+
+static int
+ReflectEventDelete (Tcl_Event* ev, ClientData cd)
+{
+ /* OWNER thread
+ *
+ * Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The
+ * latter ensures that no pending events of this type are run on an
+ * invalid channel.
+ */
+
+ ReflectEvent* e = (ReflectEvent*) ev;
+
+ if ((ev->proc != ReflectEventRun) ||
+ ((cd != NULL) &&
+ (cd != e->rcPtr))) {
+ return 0;
+ }
+ return 1;
+}
+
int
TclChanPostEventObjCmd(
ClientData clientData,
@@ -773,6 +823,8 @@ TclChanPostEventObjCmd(
Tcl_Obj *const *objv)
{
/*
+ * Ensure -> HANDLER thread
+ *
* Syntax: chan postevent CHANNEL EVENTSPEC
* [0] [1] [2] [3]
*
@@ -882,7 +934,37 @@ TclChanPostEventObjCmd(
* We have the channel and the events to post.
*/
- Tcl_NotifyChannel(chan, events);
+ if (rcPtr->owner == rcPtr->thread) {
+ Tcl_NotifyChannel (chan, events);
+ } else {
+ ReflectEvent* ev = ckalloc (sizeof (ReflectEvent));
+ ev->header.proc = ReflectEventRun;
+ ev->events = events;
+ ev->rcPtr = rcPtr;
+
+ /*
+ * We are not preserving the structure here. When the channel is
+ * closed any pending events are deleted, see ReflectClose(), and
+ * ReflectEventDelete(). Trying to preserve and later release when the
+ * event is run may generate a situation where the channel structure
+ * is deleted but not our structure, crashing in
+ * FreeReflectedChannel().
+ *
+ * Force creation of the RCM, for proper cleanup on thread teardown.
+ * The teardown of unprocessed events is currently coupled to the
+ * thread reflected channel map
+ */
+ (void) GetThreadReflectedChannelMap ();
+
+ /* XXX Race condition !!
+ * XXX The destination thread may not exist anymore already.
+ * XXX (Delayed postevent executed after channel got removed).
+ * XXX Can we detect this ? (check the validity of the owner threadid ?)
+ * XXX Actually, in that case the channel should be dead also !
+ */
+ Tcl_ThreadQueueEvent (rcPtr->owner, (Tcl_Event*) ev, TCL_QUEUE_TAIL);
+ Tcl_ThreadAlert (rcPtr->owner);
+ }
/*
* Squash interp results left by the event script.
@@ -1067,9 +1149,12 @@ ReflectClose(
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
- ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
result = p.base.code;
+ /* Now squash the pending reflection events for this channel. */
+ Tcl_DeleteEvents (ReflectEventDelete, rcPtr);
+
if (result != TCL_OK) {
FreeReceivedError(&p);
}
@@ -1100,9 +1185,12 @@ ReflectClose(
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
- ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
result = p.base.code;
+ /* Now squash the pending reflection events for this channel. */
+ Tcl_DeleteEvents (ReflectEventDelete, rcPtr);
+
Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
if (result != TCL_OK) {
@@ -1207,7 +1295,7 @@ ReflectInput(
p.input.buf = buf;
p.input.toRead = toRead;
- ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p);
if (p.base.code != TCL_OK) {
if (p.base.code < 0) {
@@ -1322,7 +1410,7 @@ ReflectOutput(
p.output.buf = buf;
p.output.toWrite = toWrite;
- ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p);
if (p.base.code != TCL_OK) {
if (p.base.code < 0) {
@@ -1438,7 +1526,7 @@ ReflectSeekWide(
p.seek.seekMode = seekMode;
p.seek.offset = offset;
- ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rcPtr->chan, &p);
@@ -1562,7 +1650,7 @@ ReflectWatch(
ForwardParam p;
p.watch.mask = mask;
- ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p);
/*
* Any failure from the forward is ignored. We have no place to put
@@ -1620,7 +1708,7 @@ ReflectBlock(
p.block.nonblocking = nonblocking;
- ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rcPtr->chan, &p);
@@ -1650,6 +1738,42 @@ ReflectBlock(
return errorNum;
}
+#ifdef TCL_THREADS
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectThread --
+ *
+ * This function is invoked to tell the channel about thread movements.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReflectThread(ClientData clientData, int action)
+{
+ ReflectedChannel *rcPtr = clientData;
+
+ switch (action) {
+ case TCL_CHANNEL_THREAD_INSERT:
+ rcPtr->owner = Tcl_GetCurrentThread();
+ break;
+ case TCL_CHANNEL_THREAD_REMOVE:
+ rcPtr->owner = NULL;
+ break;
+ default:
+ Tcl_Panic ("Unknown thread action code.");
+ break;
+ }
+}
+
+#endif
/*
*----------------------------------------------------------------------
*
@@ -1689,7 +1813,7 @@ ReflectSetOption(
p.setOpt.name = optionName;
p.setOpt.value = newValue;
- ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p);
+ ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p);
if (p.base.code != TCL_OK) {
Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
@@ -1775,7 +1899,7 @@ ReflectGetOption(
opcode = ForwardedGetOpt;
}
- ForwardOpToOwnerThread(rcPtr, opcode, &p);
+ ForwardOpToHandlerThread(rcPtr, opcode, &p);
if (p.base.code != TCL_OK) {
Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);
@@ -2673,6 +2797,15 @@ DeleteThreadReflectedChannelMap(
Tcl_MutexUnlock(&rcForwardMutex);
/*
+ * Run over the event queue of this thread and remove all ReflectEvent's
+ * still pending. These are inbound events for reflected channels this
+ * thread owns but doesn't handle. The inverse of the channel map
+ * actually.
+ */
+
+ Tcl_DeleteEvents (ReflectEventDelete, NULL);
+
+ /*
* Get the map of all channels handled by the current thread. This is a
* ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
* through the channels, remove all, mark them as dead.
@@ -2693,11 +2826,16 @@ DeleteThreadReflectedChannelMap(
}
static void
-ForwardOpToOwnerThread(
+ForwardOpToHandlerThread(
ReflectedChannel *rcPtr, /* Channel instance */
ForwardedOperation op, /* Forwarded driver operation */
const void *param) /* Arguments */
{
+ /*
+ * Core of the communication from OWNER to HANDLER thread.
+ * The receiver is ForwardProc() below.
+ */
+
Tcl_ThreadId dst = rcPtr->thread;
ForwardingEvent *evPtr;
ForwardingResult *resultPtr;
@@ -2750,7 +2888,7 @@ ForwardOpToOwnerThread(
/*
* Ensure cleanup of the event if the origin thread exits while this event
* is pending or in progress. Exit of the destination thread is handled by
- * DeleteThreadReflectionChannelMap(), this is set up by
+ * DeleteThreadReflectedChannelMap(), this is set up by
* GetThreadReflectedChannelMap(). This is what we use the 'forwardList'
* (see above) for.
*/
@@ -2765,7 +2903,7 @@ ForwardOpToOwnerThread(
Tcl_ThreadAlert(dst);
/*
- * (*) Block until the other thread has either processed the transfer or
+ * (*) Block until the handler thread has either processed the transfer or
* rejected it.
*/
@@ -2813,6 +2951,11 @@ ForwardProc(
int mask)
{
/*
+ * HANDLER thread.
+
+ * The receiver part for the operations coming from the OWNER thread.
+ * See ForwardOpToHandlerThread() for the transmitter.
+ *
* Notes regarding access to the referenced data.
*
* In principle the data belongs to the originating thread (see
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 538ca1d..89d6c02 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -88,7 +88,7 @@ TclSockGetPort(
*/
#if !defined(_WIN32) && !defined(__CYGWIN__)
-# define SOCKET size_t
+# define SOCKET int
#endif
int
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
index 37f5479..2ed5fed 100644
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -31,7 +31,7 @@
* TCHAR is needed here for win32, so if it is not defined yet do it here.
* This way, we don't need to include <tchar.h> just for one define.
*/
-#if defined(_WIN32) && !defined(_TCHAR_DEFINED)
+#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(_TCHAR_DEFINED)
# if defined(_UNICODE)
typedef wchar_t TCHAR;
# else
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index 9e62ac8..ce92028 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,7 +1,7 @@
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[string compare [info sharedlibextension] .dll]} return
if {[::tcl::pkgconfig get debug]} {
- package ifneeded dde 1.3.2 [list load [file join $dir tcldde13g.dll] dde]
+ package ifneeded dde 1.3.3 [list load [file join $dir tcldde13g.dll] dde]
} else {
- package ifneeded dde 1.3.2 [list load [file join $dir tcldde13.dll] dde]
+ package ifneeded dde 1.3.3 [list load [file join $dir tcldde13.dll] dde]
}
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 1d34861..cf913ff 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -2614,7 +2614,121 @@ test iocmd.tf-24.16 {chan write, note the background flush setup by close due to
rename foo {}
unset res
} -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \
- -constraints {testchannel thread knownBug}
+ -constraints {testchannel thread}
+
+test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
+ -constraints {testchannel thread} -setup {
+ # This test exposes how the execution of postevent in the handler thread causes
+ # a crash if we are not properly injecting the events into the owning thread instead.
+ # With the injection the test will simply complete without crash.
+
+ set beat 10000
+ set drive 999
+ set data ...---...
+
+ proc LOG {text} {
+ #puts stderr "[thread::id]: $text"
+ return
+ }
+
+ proc POST {hi} {
+ LOG "-> [info level 0]"
+ chan postevent $hi read
+ LOG "<- [info level 0]"
+
+ set ::timer [after $::drive [info level 0]]
+ return
+ }
+
+ proc HANDLER {op ch args} {
+ lappend ::res [lrange [info level 0] 1 end]
+ LOG "-> [info level 0]"
+ set ret {}
+ switch -glob -- $op {
+ init* {set ret {initialize finalize watch read}}
+ watch {
+ set l [lindex $args 0]
+ if {[llength $l]} {
+ set ::timer [after $::drive [list POST $ch]]
+ } else {
+ after cancel $::timer
+ }
+ }
+ finalize {
+ catch { after cancel $::timer }
+ after 500 {set ::forever now}
+ }
+ read {
+ set ret $::data
+ set ::data {} ; # Next is EOF.
+ }
+ }
+ LOG "<- [info level 0] : $ret"
+ return $ret
+ }
+} -body {
+ LOG BEGIN
+ set ch [chan create {read} HANDLER]
+
+ set tid [thread::create {
+ proc LOG {text} {
+ #puts stderr "\t\t\t\t\t\t[thread::id]: $text"
+ return
+ }
+ LOG THREAD-STARTED
+ load {} Tcltest
+ proc bgerror s {
+ LOG BGERROR:$s
+ }
+ vwait forever
+ LOG THREAD-DONE
+ }]
+
+ testchannel cut $ch
+ thread::send $tid [list set thech $ch]
+ thread::send $tid [list set beat $beat]
+ thread::send -async $tid {
+ LOG SPLICE-BEG
+ testchannel splice $thech
+ LOG SPLICE-END
+ proc PROCESS {ch} {
+ LOG "-> [info level 0]"
+ if {[eof $ch]} {
+ close $ch
+ set ::done 1
+ set c <<EOF>>
+ } else {
+ set c [read $ch 1]
+ }
+ LOG "GOTCHAR: $c"
+ LOG "<- [info level 0]"
+ }
+ LOG THREAD-FILEEVENT
+ fconfigure $thech -translation binary -blocking 0
+ fileevent $thech readable [list PROCESS $thech]
+ LOG THREAD-NOEVENT-LOOP
+ set done 0
+ while {!$done} {
+ after $beat
+ LOG THREAD-HEARTBEAT
+ update
+ }
+ LOG THREAD-LOOP-DONE
+ thread::exit
+ }
+
+ LOG MAIN_WAITING
+ vwait forever
+ LOG MAIN_DONE
+
+ set res
+} -cleanup {
+ rename LOG {}
+ rename POST {}
+ rename HANDLER {}
+ unset beat drive data forever res tid ch
+} -match glob \
+ -result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}}
# --- === *** ###########################
# method cgetall
diff --git a/unix/configure b/unix/configure
index 8f25c08..1151497 100755
--- a/unix/configure
+++ b/unix/configure
@@ -1353,6 +1353,11 @@ if test -r "$cache_file" -a -f "$cache_file"; then
fi
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+rm -Rf pkgs
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
diff --git a/unix/configure.in b/unix/configure.in
index 066a84f..4fc93dd 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -43,6 +43,11 @@ if test -r "$cache_file" -a -f "$cache_file"; then
fi
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+rm -Rf pkgs
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index fac9f75..c56988e 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -88,7 +88,6 @@ typedef off_t Tcl_SeekOffset;
# define HINSTANCE void *
# define SOCKET unsigned int
# define WSAEWOULDBLOCK 10035
- typedef char TCHAR;
typedef unsigned short WCHAR;
DLLIMPORT extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *);
DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int);
diff --git a/win/configure b/win/configure
index f3bd0d9..6673ecb 100755
--- a/win/configure
+++ b/win/configure
@@ -1329,6 +1329,11 @@ REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
PKG_CFG_ARGS=$@
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+rm -Rf pkgs
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
diff --git a/win/configure.in b/win/configure.in
index 0ed8f89..1bab810 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -32,6 +32,11 @@ REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
PKG_CFG_ARGS=$@
#------------------------------------------------------------------------
+# Empty slate for bundled packages, to avoid stale configuration
+#------------------------------------------------------------------------
+rm -Rf pkgs
+
+#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 11e713b..387c05a 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -11,13 +11,19 @@
*/
#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-# define USE_TCL_STUBS
-#endif
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
+#undef UNICODE
+#undef _UNICODE
#include "tclInt.h"
#include <dde.h>
#include <ddeml.h>
+#ifndef UNICODE
+# undef CP_WINUNICODE
+# define CP_WINUNICODE CP_WINANSI
+#endif
+
/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init
* declaration is in the source file itself, which is only accessed when we
@@ -37,7 +43,7 @@ typedef struct RegisteredInterp {
struct RegisteredInterp *nextPtr;
/* The next interp this application knows
* about. */
- char *name; /* Interpreter's name (malloc-ed). */
+ TCHAR *name; /* Interpreter's name (malloc-ed). */
Tcl_Obj *handlerPtr; /* The server handler command */
Tcl_Interp *interp; /* The interpreter attached to this name. */
} RegisteredInterp;
@@ -51,7 +57,7 @@ typedef struct Conversation {
/* The next conversation in the list. */
RegisteredInterp *riPtr; /* The info we know about the conversation. */
HCONV hConv; /* The DDE handle for this conversation. */
- Tcl_Obj *returnPackagePtr; /* The result package for this conversation */
+ Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
} Conversation;
typedef struct DdeEnumServices {
@@ -79,13 +85,13 @@ static Tcl_ThreadDataKey dataKey;
static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance; /* The application instance handle given to us
- * by DdeInitializeA. */
+ * by DdeInitialize. */
static int ddeIsServer = 0;
-#define TCL_DDE_VERSION "1.3.2"
+#define TCL_DDE_VERSION "1.3.3"
#define TCL_DDE_PACKAGE_NAME "dde"
-#define TCL_DDE_SERVICE_NAME "TclEval"
-#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT"
+#define TCL_DDE_SERVICE_NAME TEXT("TclEval")
+#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT")
TCL_DECLARE_MUTEX(ddeMutex)
@@ -100,7 +106,7 @@ static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
LPARAM lParam);
static void DdeExitProc(ClientData clientData);
static int DdeGetServicesList(Tcl_Interp *interp,
- const char *serviceName, const char *topicName);
+ const TCHAR *serviceName, const TCHAR *topicName);
static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv,
HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData,
DWORD dwData1, DWORD dwData2);
@@ -110,7 +116,7 @@ static void DeleteProc(ClientData clientData);
static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr,
Tcl_Obj *ddeObjectPtr);
static int MakeDdeConnection(Tcl_Interp *interp,
- const char *name, HCONV *ddeConvPtr);
+ const TCHAR *name, HCONV *ddeConvPtr);
static void SetDdeError(Tcl_Interp *interp);
static int DdeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -215,7 +221,7 @@ Initialize(void)
if (ddeInstance == 0) {
Tcl_MutexLock(&ddeMutex);
if (ddeInstance == 0) {
- if (DdeInitializeA(&ddeInstance, (PFNCALLBACK) DdeServerProc,
+ if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc,
CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS
| CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) {
ddeInstance = 0;
@@ -228,7 +234,7 @@ Initialize(void)
if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
ddeIsServer = 1;
Tcl_CreateExitHandler(DdeExitProc, NULL);
- ddeServiceGlobal = DdeCreateStringHandleA(ddeInstance,
+ ddeServiceGlobal = DdeCreateStringHandle(ddeInstance,
TCL_DDE_SERVICE_NAME, 0);
DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
} else {
@@ -263,10 +269,10 @@ Initialize(void)
*----------------------------------------------------------------------
*/
-static const char *
+static const TCHAR *
DdeSetServerName(
Tcl_Interp *interp,
- const char *name, /* The name that will be used to refer to the
+ const TCHAR *name, /* The name that will be used to refer to the
* interpreter in later "send" commands. Must
* be globally unique. */
int exactName, /* Should we make a unique name? 0 = unique */
@@ -276,7 +282,7 @@ DdeSetServerName(
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
- const char *actualName;
+ const TCHAR *actualName;
Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;
int n, srvCount = 0, lastSuffix, r = TCL_OK;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -314,15 +320,16 @@ DdeSetServerName(
* current interp, but it doesn't have a name.
*/
- return "";
+ return TEXT("");
}
+ Tcl_DStringInit(&dString);
+
/*
* Get the list of currently registered Tcl interpreters by calling the
* internal implementation of the 'dde services' command.
*/
- Tcl_DStringInit(&dString);
actualName = name;
if (!exactName) {
@@ -335,7 +342,7 @@ DdeSetServerName(
&srvPtrPtr);
}
if (r != TCL_OK) {
- OutputDebugStringA(Tcl_GetStringResult(interp));
+ OutputDebugString(Tcl_GetStringResult(interp));
return NULL;
}
@@ -355,7 +362,7 @@ DdeSetServerName(
Tcl_DStringAppend(&dString, name, -1);
Tcl_DStringAppend(&dString, " #", 2);
offset = Tcl_DStringLength(&dString);
- Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE);
+ Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE);
actualName = Tcl_DStringValue(&dString);
}
sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
@@ -369,7 +376,7 @@ DdeSetServerName(
Tcl_Obj* namePtr;
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
- if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) {
+ if (_tcscmp(actualName, Tcl_GetString(namePtr)) == 0) {
suffix++;
break;
}
@@ -385,14 +392,14 @@ DdeSetServerName(
riPtr = ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
- riPtr->name = ckalloc(strlen(actualName) + 1);
+ riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
riPtr->nextPtr = tsdPtr->interpListPtr;
riPtr->handlerPtr = handlerPtr;
if (riPtr->handlerPtr != NULL) {
Tcl_IncrRefCount(riPtr->handlerPtr);
}
tsdPtr->interpListPtr = riPtr;
- strcpy(riPtr->name, actualName);
+ _tcscpy(riPtr->name, actualName);
if (Tcl_IsSafe(interp)) {
Tcl_ExposeCommand(interp, "dde", "dde");
@@ -472,7 +479,7 @@ DeleteProc(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
- searchPtr != NULL && searchPtr != riPtr;
+ (searchPtr != NULL) && (searchPtr != riPtr);
prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
/*
* Empty loop body.
@@ -552,7 +559,8 @@ ExecuteRemoteObject(
returnPackagePtr = Tcl_NewListObj(0, NULL);
- Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result));
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr,
+ Tcl_NewIntObj(result));
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
Tcl_GetObjResult(riPtr->interp));
@@ -607,7 +615,7 @@ DdeServerProc(
Tcl_DString dString;
int len;
DWORD dlen;
- char *utilString;
+ TCHAR *utilString;
Tcl_Obj *ddeObjectPtr;
HDDEDATA ddeReturn = NULL;
RegisteredInterp *riPtr;
@@ -621,16 +629,16 @@ DdeServerProc(
* sure we have a valid topic.
*/
- len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0);
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
- DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINANSI);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
+ CP_WINUNICODE);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (strcasecmp(utilString, riPtr->name) == 0) {
+ if (_tcsicmp(utilString, riPtr->name) == 0) {
Tcl_DStringFree(&dString);
return (HDDEDATA) TRUE;
}
@@ -646,15 +654,15 @@ DdeServerProc(
* result to return in an XTYP_REQUEST.
*/
- len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0);
+ len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
- DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINANSI);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
+ CP_WINUNICODE);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (strcasecmp(riPtr->name, utilString) == 0) {
+ if (_tcsicmp(riPtr->name, utilString) == 0) {
convPtr = ckalloc(sizeof(Conversation));
convPtr->nextPtr = tsdPtr->currentConversations;
convPtr->returnPackagePtr = NULL;
@@ -698,7 +706,7 @@ DdeServerProc(
* execute.
*/
- if (uFmt != CF_TEXT) {
+ if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) {
return (HDDEDATA) FALSE;
}
@@ -711,19 +719,25 @@ DdeServerProc(
}
if (convPtr != NULL) {
- BYTE *returnString;
+ char *returnString;
- len = DdeQueryStringA(ddeInstance, ddeItem, NULL, 0, CP_WINANSI);
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
- DdeQueryStringA(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
- CP_WINANSI);
- if (strcasecmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
- returnString = (BYTE *)
- Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
- ddeReturn = DdeCreateDataHandle(ddeInstance, returnString,
- (DWORD) len+1, 0, ddeItem, CF_TEXT, 0);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
+ DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
+ CP_WINUNICODE);
+ if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
+ if (uFmt == CF_TEXT) {
+ returnString =
+ Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
+ } else {
+ returnString = (char *)
+ Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
+ len = 2 * len + 1;
+ }
+ ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
+ (DWORD) len+1, 0, ddeItem, uFmt, 0);
} else {
if (Tcl_IsSafe(convPtr->riPtr->interp)) {
ddeReturn = NULL;
@@ -732,11 +746,17 @@ DdeServerProc(
convPtr->riPtr->interp, utilString, NULL,
TCL_GLOBAL_ONLY);
if (variableObjPtr != NULL) {
- returnString = (BYTE *) Tcl_GetStringFromObj(
- variableObjPtr, &len);
+ if (uFmt == CF_TEXT) {
+ returnString = Tcl_GetStringFromObj(
+ variableObjPtr, &len);
+ } else {
+ returnString = (char *) Tcl_GetUnicodeFromObj(
+ variableObjPtr, &len);
+ len = 2 * len + 1;
+ }
ddeReturn = DdeCreateDataHandle(ddeInstance,
- returnString, (DWORD) len+1, 0, ddeItem,
- CF_TEXT, 0);
+ (BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
+ uFmt, 0);
} else {
ddeReturn = NULL;
}
@@ -765,7 +785,7 @@ DdeServerProc(
return (HDDEDATA) DDE_FNOTPROCESSED;
}
- utilString = (char *) DdeAccessData(hData, &dlen);
+ utilString = (TCHAR *) DdeAccessData(hData, &dlen);
len = dlen;
ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
Tcl_IncrRefCount(ddeObjectPtr);
@@ -818,10 +838,10 @@ DdeServerProc(
len = dlen;
for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
i++, riPtr = riPtr->nextPtr) {
- returnPtr[i].hszSvc = DdeCreateStringHandleA(ddeInstance,
- TCL_DDE_SERVICE_NAME, CP_WINANSI);
- returnPtr[i].hszTopic = DdeCreateStringHandleA(ddeInstance,
- riPtr->name, CP_WINANSI);
+ returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance,
+ TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
+ returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance,
+ riPtr->name, CP_WINUNICODE);
}
returnPtr[i].hszSvc = NULL;
returnPtr[i].hszTopic = NULL;
@@ -879,14 +899,14 @@ DdeExitProc(
static int
MakeDdeConnection(
Tcl_Interp *interp, /* Used to report errors. */
- const char *name, /* The connection to use. */
+ const TCHAR *name, /* The connection to use. */
HCONV *ddeConvPtr)
{
HSZ ddeTopic, ddeService;
HCONV ddeConv;
- ddeService = DdeCreateStringHandleA(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
- ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) name, 0);
+ ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
@@ -929,9 +949,9 @@ static int
DdeCreateClient(
struct DdeEnumServices *es)
{
- WNDCLASSEXA wc;
- static const char *szDdeClientClassName = "TclEval client class";
- static const char *szDdeClientWindowName = "TclEval client window";
+ WNDCLASSEX wc;
+ static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
+ static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window");
memset(&wc, 0, sizeof(wc));
wc.cbSize = sizeof(wc);
@@ -943,8 +963,8 @@ DdeCreateClient(
* Register and create the callback window.
*/
- RegisterClassExA(&wc);
- es->hwnd = CreateWindowExA(0, szDdeClientClassName, szDdeClientWindowName,
+ RegisterClassEx(&wc);
+ es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName,
WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es);
return TCL_OK;
}
@@ -956,7 +976,6 @@ DdeClientWindowProc(
WPARAM wParam,
LPARAM lParam) /* (Potentially) our local handle */
{
-
switch (uMsg) {
case WM_CREATE: {
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
@@ -964,17 +983,16 @@ DdeClientWindowProc(
(struct DdeEnumServices *) lpcs->lpCreateParams;
#ifdef _WIN64
- SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR)es);
+ SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
#else
- SetWindowLongA(hwnd, GWL_USERDATA, (long)es);
+ SetWindowLong(hwnd, GWL_USERDATA, (LONG) es);
#endif
return (LRESULT) 0L;
}
case WM_DDE_ACK:
return DdeServicesOnAck(hwnd, wParam, lParam);
- break;
default:
- return DefWindowProcA(hwnd, uMsg, wParam, lParam);
+ return DefWindowProc(hwnd, uMsg, wParam, lParam);
}
}
@@ -988,12 +1006,12 @@ DdeServicesOnAck(
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
struct DdeEnumServices *es;
- char sz[255];
+ TCHAR sz[255];
#ifdef _WIN64
es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
- es = (struct DdeEnumServices *) GetWindowLongA(hwnd, GWL_USERDATA);
+ es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
#endif
if ((es->service == (ATOM)0 || es->service == service)
@@ -1001,9 +1019,9 @@ DdeServicesOnAck(
Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
- GlobalGetAtomNameA(service, sz, 255);
+ GlobalGetAtomName(service, sz, 255);
Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
- GlobalGetAtomNameA(topic, sz, 255);
+ GlobalGetAtomName(topic, sz, 255);
Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
/*
@@ -1030,7 +1048,7 @@ DdeServicesOnAck(
* Tell the server we are no longer interested.
*/
- PostMessageA(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
+ PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
return 0L;
}
@@ -1042,7 +1060,7 @@ DdeEnumWindowsCallback(
DWORD_PTR dwResult = 0;
struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
- SendMessageTimeoutA(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
+ SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
&dwResult);
return TRUE;
@@ -1051,16 +1069,16 @@ DdeEnumWindowsCallback(
static int
DdeGetServicesList(
Tcl_Interp *interp,
- const char *serviceName,
- const char *topicName)
+ const TCHAR *serviceName,
+ const TCHAR *topicName)
{
struct DdeEnumServices es;
es.interp = interp;
es.result = TCL_OK;
es.service = (serviceName == NULL)
- ? (ATOM)0 : GlobalAddAtomA(serviceName);
- es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtomA(topicName);
+ ? (ATOM)0 : GlobalAddAtom(serviceName);
+ es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName);
Tcl_ResetResult(interp); /* our list is to be appended to result. */
DdeCreateClient(&es);
@@ -1147,12 +1165,11 @@ DdeObjCmd(
ClientData clientData, /* Used only for deletion */
Tcl_Interp *interp, /* The interp we are sending from */
int objc, /* Number of arguments */
- Tcl_Obj *const * objv) /* The arguments */
+ Tcl_Obj *const *objv) /* The arguments */
{
static const char *const ddeCommands[] = {
"servername", "execute", "poke", "request", "services", "eval",
- (char *) NULL
- };
+ (char *) NULL};
enum DdeSubcommands {
DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
DDE_EVAL
@@ -1182,8 +1199,8 @@ DdeObjCmd(
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
HCONV hConv = NULL;
- const char *serviceName = NULL, *topicName = NULL;
- char *string;
+ const TCHAR *serviceName = NULL, *topicName = NULL;
+ const char *string;
DWORD ddeResult;
Tcl_Obj *objPtr, *handlerPtr = NULL;
@@ -1343,8 +1360,8 @@ DdeObjCmd(
if (length == 0) {
serviceName = NULL;
} else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
- ddeService = DdeCreateStringHandleA(ddeInstance, (void *) serviceName,
- CP_WINANSI);
+ ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName,
+ CP_WINUNICODE);
}
if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
@@ -1352,8 +1369,8 @@ DdeObjCmd(
if (length == 0) {
topicName = NULL;
} else {
- ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) topicName,
- CP_WINANSI);
+ ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName,
+ CP_WINUNICODE);
}
}
@@ -1439,9 +1456,8 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
Tcl_Obj *returnObjPtr;
-
- ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString,
- CP_WINANSI);
+ ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
+ CP_WINUNICODE);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
CF_TEXT, XTYP_REQUEST, 5000, NULL);
@@ -1456,8 +1472,7 @@ DdeObjCmd(
returnObjPtr =
Tcl_NewByteArrayObj(dataString, (int) tmp);
} else {
- returnObjPtr =
- Tcl_NewStringObj((char *) dataString, -1);
+ returnObjPtr = Tcl_NewStringObj((char *)dataString, -1);
}
DdeUnaccessData(ddeData);
DdeFreeDataHandle(ddeData);
@@ -1499,8 +1514,8 @@ DdeObjCmd(
SetDdeError(interp);
result = TCL_ERROR;
} else {
- ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString,
- CP_WINANSI);
+ ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
+ CP_WINUNICODE);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
@@ -1546,7 +1561,7 @@ DdeObjCmd(
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (strcasecmp(serviceName, riPtr->name) == 0) {
+ if (_tcsicmp(serviceName, riPtr->name) == 0) {
break;
}
}
@@ -1639,8 +1654,7 @@ DdeObjCmd(
if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
invalidServerResponse:
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("invalid data returned from server",
- -1));
+ Tcl_NewStringObj("invalid data returned from server", -1));
Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
result = TCL_ERROR;
goto cleanup;
@@ -1649,7 +1663,7 @@ DdeObjCmd(
objPtr = Tcl_ConcatObj(objc, objv);
string = Tcl_GetStringFromObj(objPtr, &length);
ddeItemData = DdeCreateDataHandle(ddeInstance,
- (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
+ (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
if (async) {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
@@ -1661,8 +1675,8 @@ DdeObjCmd(
0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeData != 0) {
- ddeCookie = DdeCreateStringHandleA(ddeInstance,
- TCL_DDE_EXECUTE_RESULT, CP_WINANSI);
+ ddeCookie = DdeCreateStringHandle(ddeInstance,
+ TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE);
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
CF_TEXT, XTYP_REQUEST, 30000, NULL);
}
@@ -1673,6 +1687,7 @@ DdeObjCmd(
if (ddeData == 0) {
SetDdeError(interp);
result = TCL_ERROR;
+ goto cleanup;
}
if (async == 0) {
@@ -1689,7 +1704,7 @@ DdeObjCmd(
resultPtr = Tcl_NewObj();
length = DdeGetData(ddeData, NULL, 0, 0);
- Tcl_SetObjLength(resultPtr, length);
+ Tcl_SetObjLength(resultPtr, (length + 1) * sizeof(TCHAR) - 1);
string = Tcl_GetString(resultPtr);
DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0);
Tcl_SetObjLength(resultPtr, (int) strlen(string));
generated by cgit v0.12 at 2024-11-20 05:42:26 (GMT)