summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authorredman <redman>1999-06-26 22:41:52 (GMT)
committerredman <redman>1999-06-26 22:41:52 (GMT)
commit8b73ba327874b9ddf983934574f77dce7b6c927d (patch)
treeb29b3604f4c05adbdd3cea8e774bce800a459b50 /win
parent9ac9b8135f79c42b54dcb69d71659e33527080e6 (diff)
downloadtcl-8b73ba327874b9ddf983934574f77dce7b6c927d.zip
tcl-8b73ba327874b9ddf983934574f77dce7b6c927d.tar.gz
tcl-8b73ba327874b9ddf983934574f77dce7b6c927d.tar.bz2
Added poke command to dde.
Changed dde package version to 1.1 Fixed makefile to install tcl8.2 library correctly Fixed dll names in pkgIndex files for dde and reg
Diffstat (limited to 'win')
-rw-r--r--win/Makefile.in12
-rw-r--r--win/tclWinDde.c101
2 files changed, 83 insertions, 30 deletions
diff --git a/win/Makefile.in b/win/Makefile.in
index 7b72cc8..a03446f 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -5,7 +5,7 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.11 1999/06/26 03:56:48 jenn Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.12 1999/06/26 22:41:53 redman Exp $
VERSION = @TCL_VERSION@
@@ -362,7 +362,7 @@ install: all install-binaries install-libraries install-doc
install-binaries:
@$(MKDIR) -p "$(BIN_INSTALL_DIR)"
@$(MKDIR) -p "$(LIB_INSTALL_DIR)"
- @for i in dde1.0 reg1.0; \
+ @for i in dde1.1 reg1.0; \
do \
if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
@@ -386,8 +386,8 @@ install-binaries:
done
@if [ -f $(DDE_DLL_FILE) ]; then \
echo installing $(DDE_DLL_FILE); \
- $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.0; \
- $(COPY) $(ROOT_DIR)/library/dde1.0/pkgIndex.tcl $(LIB_INSTALL_DIR)/dde1.0; \
+ $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.1; \
+ $(COPY) $(ROOT_DIR)/library/dde1.1/pkgIndex.tcl $(LIB_INSTALL_DIR)/dde1.1; \
fi
@if [ -f $(REG_DLL_FILE) ]; then \
echo installing $(REG_DLL_FILE); \
@@ -405,7 +405,7 @@ install-libraries:
else true; \
fi; \
done;
- @for i in tcl$(VERSION) http1.0 http2.0 opt0.4 encoding msgcat1.0 tcltest1.0; \
+ @for i in http1.0 http2.0 opt0.4 encoding msgcat1.0 tcltest1.0; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -421,7 +421,7 @@ install-libraries:
@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
do \
echo "Installing $$i"; \
- $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/tcl$(VERSION)"; \
+ $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
done;
@for i in http2.0 http1.0 opt0.4 msgcat1.0 tcltest1.0; \
do \
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 021ff5a..2eaf974 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinDde.c,v 1.4 1999/06/16 02:10:25 redman Exp $
+ * RCS: @(#) $Id: tclWinDde.c,v 1.5 1999/06/26 22:41:53 redman Exp $
*/
#include "tclPort.h"
@@ -64,11 +64,15 @@ static Tcl_ThreadDataKey dataKey;
* The following variables cannot be placed in thread-local storage.
* The Mutex ddeMutex guards access to the ddeInstance.
*/
-static HSZ ddeService = 0;
+static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance; /* The application instance handle given
* to us by DdeInitialize. */
static int ddeIsServer = 0;
+#define TCL_DDE_VERSION "1.1"
+#define TCL_DDE_PACKAGE_NAME "dde"
+#define TCL_DDE_SERVICE_NAME "TclEval"
+
TCL_DECLARE_MUTEX(ddeMutex)
/*
@@ -132,7 +136,7 @@ Dde_Init(
}
Tcl_CreateExitHandler(DdeExitProc, NULL);
- return Tcl_PkgProvide(interp, "dde", "1.0");
+ return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}
@@ -153,7 +157,7 @@ Dde_Init(
*/
static void
-Initialize()
+Initialize(void)
{
int nameFound = 0;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -181,19 +185,19 @@ Initialize()
| CBF_SKIP_UNREGISTRATIONS
| CBF_FAIL_POKES, 0)
!= DMLERR_NO_ERROR) {
- DdeUninitialize(ddeInstance);
ddeInstance = 0;
}
}
Tcl_MutexUnlock(&ddeMutex);
}
- if ((ddeService == 0) && (nameFound != 0)) {
+ if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
Tcl_MutexLock(&ddeMutex);
- if ((ddeService == 0) && (nameFound != 0)) {
+ if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
ddeIsServer = 1;
Tcl_CreateExitHandler(DdeExitProc, NULL);
- ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
- DdeNameService(ddeInstance, ddeService, 0L, DNS_REGISTER);
+ ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \
+ TCL_DDE_SERVICE_NAME, 0);
+ DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
} else {
ddeIsServer = 0;
}
@@ -227,12 +231,13 @@ Initialize()
*/
static char *
-DdeSetServerName(interp, name)
- Tcl_Interp *interp;
- char *name; /* The name that will be used to
+DdeSetServerName(
+ Tcl_Interp *interp,
+ char *name /* The name that will be used to
* refer to the interpreter in later
* "send" commands. Must be globally
* unique. */
+ )
{
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
@@ -824,12 +829,13 @@ Tcl_DdeObjCmd(
enum {
DDE_SERVERNAME,
DDE_EXECUTE,
+ DDE_POKE,
DDE_REQUEST,
DDE_SERVICES,
DDE_EVAL
};
- static char *ddeCommands[] = {"servername", "execute",
+ static char *ddeCommands[] = {"servername", "execute", "poke",
"request", "services", "eval",
(char *) NULL};
static char *ddeOptions[] = {"-async", (char *) NULL};
@@ -841,7 +847,7 @@ Tcl_DdeObjCmd(
HSZ ddeItem = NULL;
HDDEDATA ddeData = NULL;
HDDEDATA ddeItemData = NULL;
- HCONV hConv;
+ HCONV hConv = NULL;
HSZ ddeCookie = 0;
char *serviceName, *topicName, *itemString, *dataString;
char *string;
@@ -902,6 +908,14 @@ Tcl_DdeObjCmd(
firstArg = 3;
}
break;
+ case DDE_POKE:
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "poke serviceName topicName item value");
+ return TCL_ERROR;
+ }
+ firstArg = 2;
+ break;
case DDE_REQUEST:
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -945,16 +959,17 @@ Tcl_DdeObjCmd(
break;
}
+ Initialize();
+
if (firstArg != 1) {
serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
} else {
- serviceName = NULL;
+ length = 0;
}
- Initialize();
if (length == 0) {
serviceName = NULL;
- } else if (index != DDE_SERVERNAME) {
+ } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
CP_WINANSI);
}
@@ -990,6 +1005,8 @@ Tcl_DdeObjCmd(
}
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic,
NULL);
+ DdeFreeStringHandle (ddeInstance, ddeService) ;
+ DdeFreeStringHandle (ddeInstance, ddeTopic) ;
if (hConv == NULL) {
SetDdeError(interp);
@@ -1018,7 +1035,6 @@ Tcl_DdeObjCmd(
SetDdeError(interp);
result = TCL_ERROR;
}
- DdeDisconnect(hConv);
break;
}
case DDE_REQUEST: {
@@ -1028,8 +1044,9 @@ Tcl_DdeObjCmd(
"cannot request value of null data", -1);
return TCL_ERROR;
}
- hConv = DdeConnect(ddeInstance, ddeService, ddeTopic,
- NULL);
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle (ddeInstance, ddeService) ;
+ DdeFreeStringHandle (ddeInstance, ddeTopic) ;
if (hConv == NULL) {
SetDdeError(interp);
@@ -1055,11 +1072,45 @@ Tcl_DdeObjCmd(
SetDdeError(interp);
result = TCL_ERROR;
}
- DdeDisconnect(hConv);
}
break;
}
+ case DDE_POKE: {
+ itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+ if (length == 0) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "cannot have a null item", -1);
+ return TCL_ERROR;
+ }
+ dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
+
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle (ddeInstance,ddeService) ;
+ DdeFreeStringHandle (ddeInstance, ddeTopic) ;
+
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ } else {
+ ddeItem = DdeCreateStringHandle(ddeInstance, itemString, \
+ CP_WINANSI);
+ if (ddeItem != NULL) {
+ ddeData = DdeClientTransaction(dataString,length+1, \
+ hConv, ddeItem,
+ CF_TEXT, XTYP_POKE, 5000, NULL);
+ if (ddeData == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ } else {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ }
+ }
+ break;
+ }
+
case DDE_SERVICES: {
HCONVLIST hConvList;
CONVINFO convInfo;
@@ -1070,6 +1121,8 @@ Tcl_DdeObjCmd(
convInfo.cb = sizeof(CONVINFO);
hConvList = DdeConnectList(ddeInstance, ddeService,
ddeTopic, 0, NULL);
+ DdeFreeStringHandle (ddeInstance,ddeService) ;
+ DdeFreeStringHandle (ddeInstance, ddeTopic) ;
hConv = 0;
convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
Tcl_DStringInit(&dString);
@@ -1204,9 +1257,7 @@ Tcl_DdeObjCmd(
if (ddeData == 0) {
SetDdeError(interp);
- DdeFreeDataHandle(ddeItemData);
- DdeDisconnect(hConv);
- goto error;
+ goto errorNoResult;
}
if (async == 0) {
@@ -1279,6 +1330,8 @@ Tcl_DdeObjCmd(
error:
Tcl_SetStringObj(Tcl_GetObjResult(interp),
"invalid data returned from server", -1);
+
+ errorNoResult:
if (ddeCookie != NULL) {
DdeFreeStringHandle(ddeInstance, ddeCookie);
}