Tcl Source Code

Check-in [26586b1d7e]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add DDE package (moved from Tk).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 26586b1d7ee19e3708c8b0cbb87898708b4cf0f1
User & Date: redman 1999-04-02 23:48:32
Context
1999-04-03
00:44
Fix DDE code for Win95/98 check-in: ca77050cc6 user: redman tags: core-8-1-branch-old
1999-04-02
23:48
Add DDE package (moved from Tk). check-in: 26586b1d7e user: redman tags: core-8-1-branch-old
23:45
*** empty log message *** check-in: a2a5024790 user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to ChangeLog.

            1  +1999-04-02    <[email protected]>
            2  +
            3  +	* doc/dde.n:
            4  +	* tools/tcl.wse.in:
            5  +	* win/makefile.vc:
            6  +	* win/pkgIndex.tcl:
            7  +	* win/tclWinDde.c:  Add new DDE package, code removed from Tk now
            8  +	separated into its own package.  Changed DDE-based send code into
            9  +	"dde eval" command.  Can be loaded into tclsh (not just wish).
           10  +	Windows only.
           11  +
     1     12   1999-04-02    <[email protected]>
     2     13   
     3     14   	* tests/expr.test: 
     4     15   	* tests/for-old.test: 
     5     16   	* tests/for.test: 
     6     17   	* tests/foreach.test: 
     7     18   	* tests/format.test: 

Added doc/dde.n.

            1  +'\"
            2  +'\" Copyright (c) 1997 Sun Microsystems, Inc.
            3  +'\"
            4  +'\" See the file "license.terms" for information on usage and redistribution
            5  +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
            6  +'\" 
            7  +'\" RCS: @(#) $Id: dde.n,v 1.1.2.1 1999/04/02 23:48:32 redman Exp $
            8  +'\" 
            9  +.so man.macros
           10  +.TH dde n 8.1 Tcl "Tcl Built-In Commands"
           11  +.BS
           12  +'\" Note:  do not modify the .SH NAME line immediately below!
           13  +.SH NAME
           14  +dde \- Execute a Dynamic Data Exchange command
           15  +.SH SYNOPSIS
           16  +.sp
           17  +\fBpackage require dde 1.0\fR
           18  +.sp
           19  +\fBdde \fIservername \fR?\fItopic\fR?
           20  +.sp
           21  +\fBdde ?\-async?\fR \fIcommand service topic \fR?\fIdata\fR?
           22  +.BE
           23  +
           24  +.SH DESCRIPTION
           25  +.PP
           26  +This command allows an application to send Dynamic Data Exchange (DDE)
           27  +command when running under Microsoft Windows. Dynamic Data Exchange is
           28  +a mechanism where applications can exchange raw data. Each DDE
           29  +transaction needs a \fIservice name\fR and a \fItopic\fR. Both the
           30  +\fIservice name\fR and \fItopic\fR are application defined; Tcl uses
           31  +the service name \fBTclEval\fR, while the topic name is the name of the
           32  +interpreter given by \fBdde servername\fR. Other applications have their
           33  +own \fIservice names\fR and \fItopics\fR. For instance, Microsoft Excel
           34  +has the service name \fBExcel\fR.
           35  +.PP
           36  +The only option to the \fBdde\fR command is:
           37  +.TP
           38  +\fB\-async\fR
           39  +Requests asynchronous invocation.  This is valid only for the
           40  +\fBexecute\fR subcommand. Normally, the \fBdde execute\fR subcommand
           41  +waits until the command completes, returning appropriate error
           42  +messages. When the \fB\-async\fR option is used, the command returns
           43  +immediately, and no error information is available.
           44  +.SH "DDE COMMANDS"
           45  +.PP
           46  +The following commands are a subset of the full Dynamic Data Exchange
           47  +set of commands.
           48  +.TP
           49  +\fBdde servername \fR?\fItopic\fR?
           50  +\fBdde servername\fR registers the interpreter as a DDE server with
           51  +the service name TclEval and the topic name specified byt \fItopic\fR.
           52  +If no \fItopic\fR is given, \fBdde servername\fR returns the name
           53  +of the current topic or the empty string if it is not registered as a service.
           54  +.TP
           55  +\fBdde execute \fIservice topic data\fR
           56  +\fBdde execute\fR takes the \fIdata\fR and sends it to the server
           57  +indicated by \fIservice\fR with the topic indicated by
           58  +\fItopic\fR. Typically, \fIservice\fR is the name of an application,
           59  +and \fItopic\fR is a file to work on.  The \fIdata\fR field is given
           60  +to the remote application. Typically, the application treats the
           61  +\fIdata\fR field as a script, and the script is run in the
           62  +application. The command returns an error if the script did not
           63  +run. If the \fB\-async\fR flag was used, the command
           64  +returns immediately with no error.
           65  +.TP
           66  +\fBdde request \fIservice topic item\fR
           67  +\fBdde request\fR is typically used to get the value of something; the
           68  +value of a cell in Microsoft Excel or the text of a selection in
           69  +Microsoft Word. \fIservice\fR is typically the name of an application,
           70  +\fItopic\fR is typically the name of the file, and \fIitem\fR is
           71  +application-specific. The command returns the value of \fIitem\fR as
           72  +defined in the application.
           73  +.TP
           74  +\fBdde services \fIservice topic\fR
           75  +\fBdde services\fR returns a list of service-topic pairs that
           76  +currently exist on the machine. If \fIservice\fR and \fItopic\fR are
           77  +both null strings ({}), then all service-topic pairs currently
           78  +available on the system are returned. If \fIservice\fR is null and
           79  +\fItopic\fR is not, then all services with the specified topic are
           80  +returned. If \fIservice\fR is not null and \fItopic\fR is, all topics
           81  +for a given service are returned. If both are not null, if that
           82  +service-topic pair currently exists, it is returned; otherwise, null
           83  +is returned.
           84  +.TP
           85  +\fBdde eval \fItopic cmd \fR?\fIarg arg ...\fR?
           86  +\fBdde eval\fR evaluates a command and its arguments using the
           87  +interpreter specified by \fItopic\fR. The DDE service must be the
           88  +"TclEval" service.  This command can be used to replace send on Windows.
           89  +.SH "DDE AND TCL"
           90  +A Tcl interpreter always has a service name of "TclEval". Each
           91  +different interp of all running Tcl applications should a unique
           92  +name specified by \fBdde servername\fR. Each interp is available as a
           93  +DDE topic only if the \fBdde servername\fR command was used to set the
           94  +name of the topic for each interp. So a \fBdde services TclEval {}\fR
           95  +command will return a list of service-topic pairs, where each of the
           96  +currently running interps will be a topic.
           97  +.PP
           98  +When Tcl processes a \fBdde execute\fR command, the data for the
           99  +execute is run as a script in the interp named by the topic of the
          100  +\fBdde execute\fR command.
          101  +.PP
          102  +When Tcl processes a \fBdde request\fR command, it returns the value of
          103  +the variable given in the dde command in the context of the interp
          104  +named by the dde topic. Tcl reserves the variable "$TCLEVAL$EXECUTE$RESULT"
          105  +for internal use, and \fBdde request\fR commands for that variable
          106  +will give unpredictable results.
          107  +.PP
          108  +An external application which wishes to run a script in Tcl should have
          109  +that script store its result in a variable, run the \fBdde execute\fR
          110  +command, and the run \fBdde request\fR to get the value of the
          111  +variable.
          112  +.PP
          113  +When using DDE, be careful to ensure that the event queue is flushed
          114  +using either \fBupdate\fR or \fBvwait\fR.  This happens by default
          115  +when using \fBwish\fR unless a blocking command is called (such as \fBexec\fR
          116  +without adding the \fB&\fR to place the process in the background).
          117  +If for any reason the event queue is not flushed, DDE commands may
          118  +hang until the event queue is flushed.  This can create a deadlock
          119  +situation.
          120  +.SH KEYWORDS
          121  +application, dde, name, remote execution
          122  +.SH "SEE ALSO"
          123  +tk, winfo, send
          124  +

Changes to tools/tcl.wse.in.

  1547   1547     Flags=0000000000000010
  1548   1548   end
  1549   1549   item: Install File
  1550   1550     Source=${__TCLBASEDIR__}\win\release\tclreg81.dll
  1551   1551     Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg81.dll
  1552   1552     Flags=0000000000000010
  1553   1553   end
         1554  +item: Install File
         1555  +  Source=${__TCLBASEDIR__}\win\pkgIndex.tcl
         1556  +  Destination=%MAINDIR%\lib\tcl%VER%\dde1.0\pkgIndex.tcl
         1557  +  Flags=0000000000000010
         1558  +end
         1559  +item: Install File
         1560  +  Source=${__TCLBASEDIR__}\win\release\tcldde81.dll
         1561  +  Destination=%MAINDIR%\lib\tcl%VER%\dde1.0\tcldde81.dll
         1562  +  Flags=0000000000000010
         1563  +end
  1554   1564   item: Install File
  1555   1565     Source=C:\WINNT\SYSTEM32\Msvcrt.dll
  1556   1566     Destination=%MAINDIR%\bin\msvcrt.dll
  1557   1567     Flags=0010001000000011
  1558   1568   end
  1559   1569   item: Install File
  1560   1570     Source=${__TKBASEDIR__}\win\release\wish81.exe

Changes to win/makefile.vc.

     2      2   #
     3      3   # See the file "license.terms" for information on usage and redistribution
     4      4   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     5      5   # 
     6      6   # Copyright (c) 1995-1996 Sun Microsystems, Inc.
     7      7   # Copyright (c) 1998-1999 by Scriptics Corporation.
     8      8   #
     9         -# RCS: @(#) $Id: makefile.vc,v 1.1.2.22 1999/04/01 21:52:58 redman Exp $
            9  +# RCS: @(#) $Id: makefile.vc,v 1.1.2.23 1999/04/02 23:48:33 redman Exp $
    10     10   
    11     11   # Does not depend on the presence of any environment variables in
    12     12   # order to compile tcl; all needed information is derived from 
    13     13   # location of the compiler directories.
    14     14   
    15     15   #
    16     16   # Project directories
................................................................................
    97     97   TCL16DLL	= $(OUTDIR)\$(NAMEPREFIX)16$(VERSION)$(DBGX).dll
    98     98   TCLSH		= $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
    99     99   TCLSHP		= $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
   100    100   TCLPIPEDLLNAME	= $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
   101    101   TCLPIPEDLL	= $(OUTDIR)\$(TCLPIPEDLLNAME)
   102    102   TCLREGDLLNAME	= $(NAMEPREFIX)reg$(VERSION)$(DBGX).dll
   103    103   TCLREGDLL	= $(OUTDIR)\$(TCLREGDLLNAME)
          104  +TCLDDEDLLNAME	= $(NAMEPREFIX)dde$(VERSION)$(DBGX).dll
          105  +TCLDDEDLL	= $(OUTDIR)\$(TCLDDEDLLNAME)
   104    106   TCLTEST		= $(OUTDIR)\$(NAMEPREFIX)test.exe
   105    107   DUMPEXTS	= $(TMPDIR)\dumpexts.exe
   106    108   CAT16		= $(TMPDIR)\cat16.exe
   107    109   CAT32		= $(TMPDIR)\cat32.exe
   108    110   RMDIR		= .\rmd.bat
   109    111   MKDIR		= .\mkd.bat
   110    112   RM		= del
................................................................................
   310    312   !ENDIF
   311    313   
   312    314   ######################################################################
   313    315   # Project specific targets
   314    316   ######################################################################
   315    317   
   316    318   release:    setup $(TCLSH) dlls
   317         -dlls:	    setup $(TCL16DLL) $(TCLPIPEDLL) $(TCLREGDLL)
          319  +dlls:	    setup $(TCL16DLL) $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
   318    320   all:	    setup $(TCLSH) dlls $(CAT16) $(CAT32) 
   319    321   tcltest:    setup $(TCLTEST) dlls $(CAT16) $(CAT32)
   320    322   plugin:	    setup $(TCLPLUGINDLL) $(TCLSHP)
   321    323   install:    install-binaries install-libraries
   322    324   test:	    setup $(TCLTEST) dlls $(CAT16) $(CAT32)
   323    325   	copy $(WINDIR)\pkgIndex.tcl $(OUTDIR)
   324    326   	set TCL_LIBRARY=$(ROOT)/library
................................................................................
   396    398   <<
   397    399   	if exist $(cc16) $(rc16) -i $(GENERICDIR) $(TCL_DEFINES) $(WINDIR)\tcl16.rc [email protected]
   398    400   
   399    401   $(TCLPIPEDLL): $(WINDIR)\stub16.c
   400    402   	$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\stub16.c
   401    403   	set LIB="$(TOOLS32)\lib"
   402    404   	$(link32) $(ldebug) $(conlflags) -out:[email protected] $(TMPDIR)\stub16.obj $(guilibs)
          405  +
          406  +$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
          407  +	set LIB="$(TOOLS32)\lib"
          408  +	$(link32) $(ldebug) $(dlllflags) -out:[email protected] $(TMPDIR)\tclWinDde.obj \
          409  +		$(conlibsdll) $(TCLSTUBLIB)
   403    410   
   404    411   $(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
   405    412   	set LIB="$(TOOLS32)\lib"
   406    413   	$(link32) $(ldebug) $(dlllflags) -out:[email protected] $(TMPDIR)\tclWinReg.obj \
   407    414   		$(conlibsdll) $(TCLSTUBLIB)
   408    415   
   409    416   $(CAT32): $(WINDIR)\cat.c
................................................................................
   435    442   	@copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
   436    443   	@echo installing "$(TCLSH)"
   437    444   	@copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
   438    445   	@echo installing $(TCLPIPEDLLNAME)
   439    446   	@copy "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)"
   440    447   	@echo installing $(TCLREGDLLNAME)
   441    448   	@copy "$(TCLREGDLL)" "$(LIB_INSTALL_DIR)"
   442         -	echo installing $(TCLSTUBLIBNAME)
          449  +	@echo installing $(TCLDDEDLLNAME)
          450  +	@copy "$(TCLDDEDLL)" "$(LIB_INSTALL_DIR)"
          451  +	@echo installing $(TCLSTUBLIBNAME)
   443    452   	@copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"
   444    453   
   445    454   install-libraries:
   446    455   	[email protected]$(MKDIR) "$(LIB_INSTALL_DIR)"
   447    456   	[email protected]$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
   448    457   	[email protected]$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
   449    458   	[email protected]$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
   450    459   	@copy << "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
   451    460   package ifneeded registry 1.0 "load [list [file join $$dir .. $(TCLREGDLLNAME)]] registry"
          461  +package ifneeded dde 1.0 "load [list [file join $$dir .. $(TCLDDEDLLNAME)]] dde"
   452    462   <<
   453    463   	[email protected] "$(ROOT)\library\http1.0\http.tcl"     "$(SCRIPT_INSTALL_DIR)\http1.0"
   454    464   	[email protected] "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
   455    465   	[email protected]$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.0"
   456    466   	[email protected] "$(ROOT)\library\http2.0\http.tcl"     "$(SCRIPT_INSTALL_DIR)\http2.0"
   457    467   	[email protected] "$(ROOT)\library\http2.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.0"
   458    468   	[email protected]$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
................................................................................
   461    471   	[email protected] "$(GENERICDIR)\tcl.h"         "$(INCLUDE_INSTALL_DIR)"
   462    472   	[email protected] "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
   463    473   	[email protected] "$(ROOT)\library\init.tcl"    "$(SCRIPT_INSTALL_DIR)"
   464    474   	[email protected] "$(ROOT)\library\ldAout.tcl"  "$(SCRIPT_INSTALL_DIR)"
   465    475   	[email protected] "$(ROOT)\library\parray.tcl"  "$(SCRIPT_INSTALL_DIR)"
   466    476   	[email protected] "$(ROOT)\library\safe.tcl"    "$(SCRIPT_INSTALL_DIR)"
   467    477   	[email protected] "$(ROOT)\library\tclIndex"    "$(SCRIPT_INSTALL_DIR)"
          478  +	[email protected] "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)"
   468    479   	[email protected] "$(ROOT)\library\word.tcl"    "$(SCRIPT_INSTALL_DIR)"
   469    480   	[email protected] "$(ROOT)\library\auto.tcl"    "$(SCRIPT_INSTALL_DIR)"
   470    481   
   471    482   #
   472    483   # Regenerate the stubs files.
   473    484   #
   474    485   
................................................................................
   498    509   $(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
   499    510   	$(cc32) $(TCL_CFLAGS) [email protected] $?
   500    511   
   501    512   # The following objects should be built using the stub interfaces
   502    513   
   503    514   $(TMPDIR)\tclWinReg.obj : $(WINDIR)\tclWinReg.c
   504    515   	$(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS [email protected] $?
          516  +
          517  +$(TMPDIR)\tclWinDde.obj : $(WINDIR)\tclWinDde.c
          518  +	$(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS [email protected] $?
   505    519   
   506    520   # The following objects are part of the stub library and should not
   507    521   # be built as DLL objects but none of the symbols should be exported
   508    522   
   509    523   $(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
   510    524   	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD [email protected] $?
   511    525   

Changes to win/pkgIndex.tcl.

     2      2   # This file contains package information for Windows-specific extensions.
     3      3   #
     4      4   # Copyright (c) 1997 by Sun Microsystems, Inc.
     5      5   #
     6      6   # See the file "license.terms" for information on usage and redistribution
     7      7   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     8      8   # 
     9         -# RCS: @(#) $Id: pkgIndex.tcl,v 1.1.2.2 1998/09/24 23:59:49 stanton Exp $
            9  +# RCS: @(#) $Id: pkgIndex.tcl,v 1.1.2.3 1999/04/02 23:48:34 redman Exp $
    10     10   
    11     11   package ifneeded registry 1.0 [list tclPkgSetup $dir registry 1.0 {{tclreg81.dll load registry}}]
           12  +package ifneeded dde 1.0 [list tclPkgSetup $dir dde 1.0 {{tcldde81.dll load dde}}]

Added win/tclWinDde.c.

            1  +/* 
            2  + * tclWinDde.c --
            3  + *
            4  + *	This file provides procedures that implement the "send"
            5  + *	command, allowing commands to be passed from interpreter
            6  + *	to interpreter.
            7  + *
            8  + * Copyright (c) 1997 by Sun Microsystems, Inc.
            9  + *
           10  + * See the file "license.terms" for information on usage and redistribution
           11  + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
           12  + *
           13  + * RCS: @(#) $Id: tclWinDde.c,v 1.1.2.1 1999/04/02 23:48:34 redman Exp $
           14  + */
           15  +
           16  +#include "tclPort.h"
           17  +#include <ddeml.h>
           18  +
           19  +/*
           20  + * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
           21  + * Registry_Init declaration is in the source file itself, which is only
           22  + * accessed when we are building a library.
           23  + */
           24  +
           25  +#undef TCL_STORAGE_CLASS
           26  +#define TCL_STORAGE_CLASS DLLEXPORT
           27  +
           28  +/* 
           29  + * The following structure is used to keep track of the interpreters
           30  + * registered by this process.
           31  + */
           32  +
           33  +typedef struct RegisteredInterp {
           34  +    struct RegisteredInterp *nextPtr;
           35  +				/* The next interp this application knows
           36  +				 * about. */
           37  +    char *name;			/* Interpreter's name (malloc-ed). */
           38  +    Tcl_Interp *interp;		/* The interpreter attached to this name. */
           39  +} RegisteredInterp;
           40  +
           41  +/*
           42  + * Used to keep track of conversations.
           43  + */
           44  +
           45  +typedef struct Conversation {
           46  +    struct Conversation *nextPtr;
           47  +				/* The next conversation in the list. */
           48  +    RegisteredInterp *riPtr;	/* The info we know about the conversation. */
           49  +    HCONV hConv;		/* The DDE handle for this conversation. */
           50  +    Tcl_Obj *returnPackagePtr;	/* The result package for this conversation. */
           51  +} Conversation;
           52  +
           53  +typedef struct ThreadSpecificData {
           54  +    Conversation *currentConversations;
           55  +                                /* A list of conversations currently
           56  +				 * being processed. */
           57  +    RegisteredInterp *interpListPtr;
           58  +                                /* List of all interpreters registered
           59  +				 * in the current process. */
           60  +} ThreadSpecificData;
           61  +static Tcl_ThreadDataKey dataKey;
           62  +
           63  +/*
           64  + * The following variables cannot be placed in thread-local storage.
           65  + * The Mutex ddeMutex guards access to the ddeInstance.
           66  + */
           67  +static DWORD ddeInstance;       /* The application instance handle given
           68  +				 * to us by DdeInitialize. */
           69  +static int ddeIsServer = 0;
           70  +
           71  +TCL_DECLARE_MUTEX(ddeMutex)
           72  +
           73  +/*
           74  + * Forward declarations for procedures defined later in this file.
           75  + */
           76  +
           77  +static void		    DdeExitProc _ANSI_ARGS_((ClientData clientData));
           78  +static void		    DeleteProc _ANSI_ARGS_((ClientData clientData));
           79  +static Tcl_Obj *	    ExecuteRemoteObject _ANSI_ARGS_((
           80  +				RegisteredInterp *riPtr, 
           81  +				Tcl_Obj *ddeObjectPtr));
           82  +static int		    MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp,
           83  +				char *name, HCONV *ddeConvPtr));
           84  +static HDDEDATA CALLBACK    DdeServerProc _ANSI_ARGS_((UINT uType,
           85  +				UINT uFmt, HCONV hConv, HSZ ddeTopic,
           86  +				HSZ ddeItem, HDDEDATA hData, DWORD dwData1, 
           87  +				DWORD dwData2));
           88  +static void		    SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
           89  +int Tcl_DdeObjCmd(ClientData clientData,	/* Used only for deletion */
           90  +	Tcl_Interp *interp,		/* The interp we are sending from */
           91  +	int objc,			/* Number of arguments */
           92  +	Tcl_Obj *CONST objv[]);	/* The arguments */
           93  +
           94  +EXTERN int Dde_Init(Tcl_Interp *interp);
           95  +
           96  +/*
           97  + *----------------------------------------------------------------------
           98  + *
           99  + * Dde_Init --
          100  + *
          101  + *	This procedure initializes the dde command.
          102  + *
          103  + * Results:
          104  + *	A standard Tcl result.
          105  + *
          106  + * Side effects:
          107  + *	None.
          108  + *
          109  + *----------------------------------------------------------------------
          110  + */
          111  +
          112  +int
          113  +Dde_Init(
          114  +    Tcl_Interp *interp)
          115  +{
          116  +    ThreadSpecificData *tsdPtr;
          117  +    
          118  +    if (!Tcl_InitStubs(interp, "8.0", 0)) {
          119  +	return TCL_ERROR;
          120  +    }
          121  +
          122  +    Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL);
          123  +
          124  +    tsdPtr = (ThreadSpecificData *)
          125  +	Tcl_GetThreadData((Tcl_ThreadDataKey *) &dataKey, sizeof(ThreadSpecificData));
          126  +    
          127  +    if (tsdPtr == NULL) {
          128  +	tsdPtr = TCL_TSD_INIT(&dataKey);
          129  +	tsdPtr->currentConversations = NULL;
          130  +	tsdPtr->interpListPtr = NULL;
          131  +    }
          132  +    Tcl_CreateExitHandler(DdeExitProc, NULL);
          133  +
          134  +    return Tcl_PkgProvide(interp, "dde", "1.0");
          135  +}
          136  +
          137  +
          138  +
          139  +static void
          140  +Initialize()
          141  +{
          142  +    int nameFound = 0;
          143  +    HSZ ddeService = 0;
          144  +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
          145  +    
          146  +    /*
          147  +     * See if the application is already registered; if so, remove its
          148  +     * current name from the registry. The deletion of the command
          149  +     * will take care of disposing of this entry.
          150  +     */
          151  +
          152  +    if (tsdPtr->interpListPtr != NULL) {
          153  +	nameFound = 1;
          154  +    }
          155  +
          156  +    /*
          157  +     * First, if Dde has been initialized as a client, uninitialize it.
          158  +     */
          159  +    if ((ddeInstance != 0) && (ddeIsServer == 0) && (nameFound != 0)) {
          160  +	Tcl_MutexLock(&ddeMutex);
          161  +	DdeUninitialize(ddeInstance);
          162  +	ddeInstance = 0;
          163  +    }
          164  +
          165  +	
          166  +    /*
          167  +     * Make sure that the DDE server is there. This is done only once,
          168  +     * add an exit handler tear it down.
          169  +     */
          170  +
          171  +    if (ddeInstance == 0) {
          172  +	Tcl_MutexLock(&ddeMutex);
          173  +	if (ddeInstance == 0) {
          174  +	    if (nameFound != 0) {
          175  +		if (DdeInitialize(&ddeInstance, DdeServerProc,
          176  +			CBF_SKIP_REGISTRATIONS
          177  +			| CBF_SKIP_UNREGISTRATIONS
          178  +			| CBF_FAIL_POKES, 0) 
          179  +			!= DMLERR_NO_ERROR) {
          180  +		    DdeUninitialize(ddeInstance);
          181  +		    ddeInstance = 0;
          182  +		} else {
          183  +		    ddeIsServer = 1;
          184  +		    Tcl_CreateExitHandler(DdeExitProc, NULL);
          185  +		    ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
          186  +		    DdeNameService(ddeInstance, ddeService, 0L, DNS_REGISTER);
          187  +		}
          188  +	    } else {
          189  +		if (DdeInitialize(&ddeInstance, NULL,
          190  +			CBF_SKIP_REGISTRATIONS
          191  +			| CBF_SKIP_UNREGISTRATIONS
          192  +			| CBF_FAIL_POKES
          193  +			| APPCMD_CLIENTONLY
          194  +			| APPCMD_FILTERINITS, 0) 
          195  +			!= DMLERR_NO_ERROR) {
          196  +		    DdeUninitialize(ddeInstance);
          197  +		    ddeInstance = 0;
          198  +		} else {
          199  +		    ddeIsServer = 0;
          200  +		}
          201  +	    }
          202  +	}
          203  +	Tcl_MutexUnlock(&ddeMutex);
          204  +    }
          205  +}    
          206  +
          207  +
          208  +/*
          209  + *--------------------------------------------------------------
          210  + *
          211  + * DdeSetServerName --
          212  + *
          213  + *	This procedure is called to associate an ASCII name with a Dde
          214  + *	server.  If the interpreter has already been named, the
          215  + *	name replaces the old one.
          216  + *
          217  + * Results:
          218  + *	The return value is the name actually given to the interp.
          219  + *	This will normally be the same as name, but if name was already
          220  + *	in use for a Dde Server then a name of the form "name #2" will
          221  + *	be chosen,  with a high enough number to make the name unique.
          222  + *
          223  + * Side effects:
          224  + *	Registration info is saved, thereby allowing the "send" command
          225  + *	to be used later to invoke commands in the application.  In
          226  + *	addition, the "send" command is created in the application's
          227  + *	interpreter.  The registration will be removed automatically
          228  + *	if the interpreter is deleted or the "send" command is removed.
          229  + *
          230  + *--------------------------------------------------------------
          231  + */
          232  +
          233  +static char *
          234  +DdeSetServerName(interp, name)
          235  +    Tcl_Interp *interp;
          236  +    char *name;			/* The name that will be used to
          237  +				 * refer to the interpreter in later
          238  +				 * "send" commands.  Must be globally
          239  +				 * unique. */
          240  +{
          241  +    int suffix, offset;
          242  +    RegisteredInterp *riPtr, *prevPtr;
          243  +    Tcl_DString dString;
          244  +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
          245  +
          246  +    /*
          247  +     * See if the application is already registered; if so, remove its
          248  +     * current name from the registry. The deletion of the command
          249  +     * will take care of disposing of this entry.
          250  +     */
          251  +
          252  +    for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; 
          253  +	    prevPtr = riPtr, riPtr = riPtr->nextPtr) {
          254  +	if (riPtr->interp == interp) {
          255  +	    if (name != NULL) {
          256  +		if (prevPtr == NULL) {
          257  +		    tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
          258  +		} else {
          259  +		    prevPtr->nextPtr = riPtr->nextPtr;
          260  +		}
          261  +		break;
          262  +	    } else {
          263  +		/*
          264  +		 * the name was NULL, so the caller is asking for
          265  +		 * the name of the current interp.
          266  +		 */
          267  +
          268  +		return riPtr->name;
          269  +	    }
          270  +	}
          271  +    }
          272  +
          273  +    if (name == NULL) {
          274  +	/*
          275  +	 * the name was NULL, so the caller is asking for
          276  +	 * the name of the current interp, but it doesn't
          277  +	 * have a name.
          278  +	 */
          279  +
          280  +	return "";
          281  +    }
          282  +    
          283  +    /*
          284  +     * Pick a name to use for the application.  Use "name" if it's not
          285  +     * already in use.  Otherwise add a suffix such as " #2", trying
          286  +     * larger and larger numbers until we eventually find one that is
          287  +     * unique.
          288  +     */
          289  +
          290  +    suffix = 1;
          291  +    offset = 0;
          292  +    Tcl_DStringInit(&dString);
          293  +
          294  +    /*
          295  +     * We have found a unique name. Now add it to the registry.
          296  +     */
          297  +
          298  +    riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
          299  +    riPtr->interp = interp;
          300  +    riPtr->name = ckalloc(strlen(name) + 1);
          301  +    riPtr->nextPtr = tsdPtr->interpListPtr;
          302  +    tsdPtr->interpListPtr = riPtr;
          303  +    strcpy(riPtr->name, name);
          304  +
          305  +    Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
          306  +	    (ClientData) riPtr, DeleteProc);
          307  +    if (Tcl_IsSafe(interp)) {
          308  +	Tcl_HideCommand(interp, "dde", "dde");
          309  +    }
          310  +    Tcl_DStringFree(&dString);
          311  +
          312  +    return riPtr->name;
          313  +}
          314  +
          315  +/*
          316  + *--------------------------------------------------------------
          317  + *
          318  + * DeleteProc
          319  + *
          320  + *	This procedure is called when the command "dde" is destroyed.
          321  + *
          322  + * Results:
          323  + *	none
          324  + *
          325  + * Side effects:
          326  + *	The interpreter given by riPtr is unregistered.
          327  + *
          328  + *--------------------------------------------------------------
          329  + */
          330  +
          331  +static void
          332  +DeleteProc(clientData)
          333  +    ClientData clientData;	/* The interp we are deleting passed
          334  +				 * as ClientData. */
          335  +{
          336  +    RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
          337  +    RegisteredInterp *searchPtr, *prevPtr;
          338  +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
          339  +
          340  +    for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
          341  +	    (searchPtr != NULL) && (searchPtr != riPtr);
          342  +	    prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
          343  +	/*
          344  +	 * Empty loop body.
          345  +	 */
          346  +    }
          347  +
          348  +    if (searchPtr != NULL) {
          349  +	if (prevPtr == NULL) {
          350  +	    tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
          351  +	} else {
          352  +	    prevPtr->nextPtr = searchPtr->nextPtr;
          353  +	}
          354  +    }
          355  +    ckfree(riPtr->name);
          356  +    Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
          357  +}
          358  +
          359  +/*
          360  + *--------------------------------------------------------------
          361  + *
          362  + * ExecuteRemoteObject --
          363  + *
          364  + *	Takes the package delivered by DDE and executes it in
          365  + *	the server's interpreter.
          366  + *
          367  + * Results:
          368  + *	A list Tcl_Obj * that describes what happened. The first
          369  + *	element is the numerical return code (TCL_ERROR, etc.).
          370  + *	The second element is the result of the script. If the
          371  + *	return result was TCL_ERROR, then the third element
          372  + *	will be the value of the global "errorCode", and the
          373  + *	fourth will be the value of the global "errorInfo".
          374  + *	The return result will have a refCount of 0.
          375  + *
          376  + * Side effects:
          377  + *	A Tcl script is run, which can cause all kinds of other
          378  + *	things to happen.
          379  + *
          380  + *--------------------------------------------------------------
          381  + */
          382  +
          383  +static Tcl_Obj *
          384  +ExecuteRemoteObject(
          385  +    RegisteredInterp *riPtr,	    /* Info about this server. */
          386  +    Tcl_Obj *ddeObjectPtr)	    /* The object to execute. */
          387  +{
          388  +    Tcl_Obj *errorObjPtr;
          389  +    Tcl_Obj *returnPackagePtr;
          390  +    int result;
          391  +
          392  +    result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
          393  +    returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
          394  +    Tcl_ListObjAppendElement(NULL, returnPackagePtr,
          395  +	    Tcl_NewIntObj(result));
          396  +    Tcl_ListObjAppendElement(NULL, returnPackagePtr,
          397  +	    Tcl_GetObjResult(riPtr->interp));
          398  +    if (result == TCL_ERROR) {
          399  +	errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
          400  +		TCL_GLOBAL_ONLY);
          401  +	Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
          402  +	errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
          403  +		TCL_GLOBAL_ONLY);
          404  +        Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
          405  +    }
          406  +
          407  +    return returnPackagePtr;
          408  +}
          409  +
          410  +/*
          411  + *--------------------------------------------------------------
          412  + *
          413  + * DdeServerProc --
          414  + *
          415  + *	Handles all transactions for this server. Can handle
          416  + *	execute, request, and connect protocols. Dde will
          417  + *	call this routine when a client attempts to run a dde
          418  + *	command using this server.
          419  + *
          420  + * Results:
          421  + *	A DDE Handle with the result of the dde command.
          422  + *
          423  + * Side effects:
          424  + *	Depending on which command is executed, arbitrary
          425  + *	Tcl scripts can be run.
          426  + *
          427  + *--------------------------------------------------------------
          428  + */
          429  +
          430  +static HDDEDATA CALLBACK
          431  +DdeServerProc (
          432  +    UINT uType,			/* The type of DDE transaction we
          433  +				 * are performing. */
          434  +    UINT uFmt,			/* The format that data is sent or
          435  +				 * received. */
          436  +    HCONV hConv,		/* The conversation associated with the 
          437  +				 * current transaction. */
          438  +    HSZ ddeTopic,		/* A string handle. Transaction-type 
          439  +				 * dependent. */
          440  +    HSZ ddeItem,		/* A string handle. Transaction-type 
          441  +				 * dependent. */
          442  +    HDDEDATA hData,		/* DDE data. Transaction-type dependent. */
          443  +    DWORD dwData1,		/* Transaction-dependent data. */
          444  +    DWORD dwData2)		/* Transaction-dependent data. */
          445  +{
          446  +    Tcl_DString dString;
          447  +    int len;
          448  +    char *utilString;
          449  +    Tcl_Obj *ddeObjectPtr;
          450  +    HDDEDATA ddeReturn = NULL;
          451  +    RegisteredInterp *riPtr;
          452  +    Conversation *convPtr, *prevConvPtr;
          453  +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
          454  +
          455  +    switch(uType) {
          456  +	case XTYP_CONNECT:
          457  +
          458  +	    /*
          459  +	     * Dde is trying to initialize a conversation with us. Check
          460  +	     * and make sure we have a valid topic.
          461  +	     */
          462  +
          463  +	    len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
          464  +	    Tcl_DStringInit(&dString);
          465  +	    Tcl_DStringSetLength(&dString, len);
          466  +	    utilString = Tcl_DStringValue(&dString);
          467  +	    DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,
          468  +		    CP_WINANSI);
          469  +
          470  +	    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
          471  +		    riPtr = riPtr->nextPtr) {
          472  +		if (stricmp(utilString, riPtr->name) == 0) {
          473  +		    Tcl_DStringFree(&dString);
          474  +		    return (HDDEDATA) TRUE;
          475  +		}
          476  +	    }
          477  +
          478  +	    Tcl_DStringFree(&dString);
          479  +	    return (HDDEDATA) FALSE;
          480  +
          481  +	case XTYP_CONNECT_CONFIRM:
          482  +
          483  +	    /*
          484  +	     * Dde has decided that we can connect, so it gives us a 
          485  +	     * conversation handle. We need to keep track of it
          486  +	     * so we know which execution result to return in an
          487  +	     * XTYP_REQUEST.
          488  +	     */
          489  +
          490  +	    len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
          491  +	    Tcl_DStringInit(&dString);
          492  +	    Tcl_DStringSetLength(&dString, len);
          493  +	    utilString = Tcl_DStringValue(&dString);
          494  +	    DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1, 
          495  +		    CP_WINANSI);
          496  +	    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; 
          497  +		    riPtr = riPtr->nextPtr) {
          498  +		if (stricmp(riPtr->name, utilString) == 0) {
          499  +		    convPtr = (Conversation *) ckalloc(sizeof(Conversation));
          500  +		    convPtr->nextPtr = tsdPtr->currentConversations;
          501  +		    convPtr->returnPackagePtr = NULL;
          502  +		    convPtr->hConv = hConv;
          503  +		    convPtr->riPtr = riPtr;
          504  +		    tsdPtr->currentConversations = convPtr;
          505  +		    break;
          506  +		}
          507  +	    }
          508  +	    Tcl_DStringFree(&dString);
          509  +	    return (HDDEDATA) TRUE;
          510  +
          511  +	case XTYP_DISCONNECT:
          512  +
          513  +	    /*
          514  +	     * The client has disconnected from our server. Forget this
          515  +	     * conversation.
          516  +	     */
          517  +
          518  +	    for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
          519  +		    convPtr != NULL; 
          520  +		    prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
          521  +		if (hConv == convPtr->hConv) {
          522  +		    if (prevConvPtr == NULL) {
          523  +			tsdPtr->currentConversations = convPtr->nextPtr;
          524  +		    } else {
          525  +			prevConvPtr->nextPtr = convPtr->nextPtr;
          526  +		    }
          527  +		    if (convPtr->returnPackagePtr != NULL) {
          528  +			Tcl_DecrRefCount(convPtr->returnPackagePtr);
          529  +		    }
          530  +		    ckfree((char *) convPtr);
          531  +		    break;
          532  +		}
          533  +	    }
          534  +	    return (HDDEDATA) TRUE;
          535  +
          536  +	case XTYP_REQUEST:
          537  +
          538  +	    /*
          539  +	     * This could be either a request for a value of a Tcl variable,
          540  +	     * or it could be the send command requesting the results of the
          541  +	     * last execute.
          542  +	     */
          543  +
          544  +	    if (uFmt != CF_TEXT) {
          545  +		return (HDDEDATA) FALSE;
          546  +	    }
          547  +
          548  +	    ddeReturn = (HDDEDATA) FALSE;
          549  +	    for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
          550  +		    && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
          551  +		/*
          552  +		 * Empty loop body.
          553  +		 */
          554  +	    }
          555  +
          556  +	    if (convPtr != NULL) {
          557  +		char *returnString;
          558  +
          559  +		len = DdeQueryString(ddeInstance, ddeItem, NULL, 0,
          560  +			CP_WINANSI);
          561  +		Tcl_DStringInit(&dString);
          562  +		Tcl_DStringSetLength(&dString, len);
          563  +		utilString = Tcl_DStringValue(&dString);
          564  +		DdeQueryString(ddeInstance, ddeItem, utilString, 
          565  +                        len + 1, CP_WINANSI);
          566  +		if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
          567  +		    returnString =
          568  +		        Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
          569  +		    ddeReturn = DdeCreateDataHandle(ddeInstance,
          570  +			    returnString, len+1, 0, ddeItem, CF_TEXT,
          571  +			    0);
          572  +		} else {
          573  +		    Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
          574  +			    convPtr->riPtr->interp, utilString, NULL, 
          575  +			    TCL_GLOBAL_ONLY);
          576  +		    if (variableObjPtr != NULL) {
          577  +			returnString = Tcl_GetStringFromObj(variableObjPtr,
          578  +				&len);
          579  +			ddeReturn = DdeCreateDataHandle(ddeInstance,
          580  +				returnString, len+1, 0, ddeItem, CF_TEXT, 0);
          581  +		    } else {
          582  +			ddeReturn = NULL;
          583  +		    }
          584  +		}
          585  +		Tcl_DStringFree(&dString);
          586  +	    }
          587  +	    return ddeReturn;
          588  +
          589  +	case XTYP_EXECUTE: {
          590  +
          591  +	    /*
          592  +	     * Execute this script. The results will be saved into
          593  +	     * a list object which will be retreived later. See
          594  +	     * ExecuteRemoteObject.
          595  +	     */
          596  +
          597  +	    Tcl_Obj *returnPackagePtr;
          598  +
          599  +	    for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
          600  +		    && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
          601  +		/*
          602  +		 * Empty loop body.
          603  +		 */
          604  +
          605  +	    }
          606  +
          607  +	    if (convPtr == NULL) {
          608  +		return (HDDEDATA) DDE_FNOTPROCESSED;
          609  +	    }
          610  +
          611  +	    utilString = (char *) DdeAccessData(hData, &len);
          612  +	    ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
          613  +	    Tcl_IncrRefCount(ddeObjectPtr);
          614  +	    DdeUnaccessData(hData);
          615  +	    if (convPtr->returnPackagePtr != NULL) {
          616  +		Tcl_DecrRefCount(convPtr->returnPackagePtr);
          617  +	    }
          618  +	    convPtr->returnPackagePtr = NULL;
          619  +	    returnPackagePtr = 
          620  +		    ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
          621  +	    for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
          622  + 		    && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
          623  +		/*
          624  +		 * Empty loop body.
          625  +		 */
          626  +
          627  +	    }
          628  +	    if (convPtr != NULL) {
          629  +		Tcl_IncrRefCount(returnPackagePtr);
          630  +		convPtr->returnPackagePtr = returnPackagePtr;
          631  +	    }
          632  +	    Tcl_DecrRefCount(ddeObjectPtr);
          633  +	    if (returnPackagePtr == NULL) {
          634  +		return (HDDEDATA) DDE_FNOTPROCESSED;
          635  +	    } else {
          636  +		return (HDDEDATA) DDE_FACK;
          637  +	    }
          638  +	}
          639  +	    
          640  +	case XTYP_WILDCONNECT: {
          641  +
          642  +	    /*
          643  +	     * Dde wants a list of services and topics that we support.
          644  +	     */
          645  +
          646  +	    HSZPAIR *returnPtr;
          647  +	    int i;
          648  +	    int numItems;
          649  +
          650  +	    for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
          651  +		    i++, riPtr = riPtr->nextPtr) {
          652  +		/*
          653  +		 * Empty loop body.
          654  +		 */
          655  +
          656  +	    }
          657  +
          658  +	    numItems = i;
          659  +	    ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
          660  +		    (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
          661  +	    returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &len);
          662  +	    for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; 
          663  +		    i++, riPtr = riPtr->nextPtr) {
          664  +		returnPtr[i].hszSvc = DdeCreateStringHandle(
          665  +                        ddeInstance, "TclEval", CP_WINANSI);
          666  +		returnPtr[i].hszTopic = DdeCreateStringHandle(
          667  +                        ddeInstance, riPtr->name, CP_WINANSI);
          668  +	    }
          669  +	    returnPtr[i].hszSvc = NULL;
          670  +	    returnPtr[i].hszTopic = NULL;
          671  +	    DdeUnaccessData(ddeReturn);
          672  +	    return ddeReturn;
          673  +	}
          674  +
          675  +    }
          676  +    return NULL;
          677  +}
          678  +
          679  +
          680  +/*
          681  + *--------------------------------------------------------------
          682  + *
          683  + * DdeExitProc --
          684  + *
          685  + *	Gets rid of our DDE server when we go away.
          686  + *
          687  + * Results:
          688  + *	None.
          689  + *
          690  + * Side effects:
          691  + *	The DDE server is deleted.
          692  + *
          693  + *--------------------------------------------------------------
          694  + */
          695  +
          696  +static void
          697  +DdeExitProc(
          698  +    ClientData clientData)	    /* Not used in this handler. */
          699  +{
          700  +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
          701  +
          702  +    DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);
          703  +    DdeUninitialize(ddeInstance);
          704  +    ddeInstance = 0;
          705  +}
          706  +
          707  +/*
          708  + *--------------------------------------------------------------
          709  + *
          710  + * MakeDdeConnection --
          711  + *
          712  + *	This procedure is a utility used to connect to a DDE
          713  + *	server when given a server name and a topic name.
          714  + *
          715  + * Results:
          716  + *	A standard Tcl result.
          717  + *	
          718  + *
          719  + * Side effects:
          720  + *	Passes back a conversation through ddeConvPtr
          721  + *
          722  + *--------------------------------------------------------------
          723  + */
          724  +
          725  +static int
          726  +MakeDdeConnection(
          727  +    Tcl_Interp *interp,		/* Used to report errors. */
          728  +    char *name,			/* The connection to use. */
          729  +    HCONV *ddeConvPtr)
          730  +{
          731  +    HSZ ddeTopic, ddeService;
          732  +    HCONV ddeConv;
          733  +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
          734  +    
          735  +    ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
          736  +    ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
          737  +
          738  +    ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
          739  +    DdeFreeStringHandle(ddeInstance, ddeService);
          740  +    DdeFreeStringHandle(ddeInstance, ddeTopic);
          741  +
          742  +    if (ddeConv == (HCONV) NULL) {
          743  +	if (interp != NULL) {
          744  +	    Tcl_AppendResult(interp, "no registered server named \"",
          745  +		    name, "\"", (char *) NULL);
          746  +	}
          747  +	return TCL_ERROR;
          748  +    }
          749  +
          750  +    *ddeConvPtr = ddeConv;
          751  +    return TCL_OK;
          752  +}
          753  +
          754  +/*
          755  + *--------------------------------------------------------------
          756  + *
          757  + * SetDdeError --
          758  + *
          759  + *	Sets the interp result to a cogent error message
          760  + *	describing the last DDE error.
          761  + *
          762  + * Results:
          763  + *	None.
          764  + *	
          765  + *
          766  + * Side effects:
          767  + *	The interp's result object is changed.
          768  + *
          769  + *--------------------------------------------------------------
          770  + */
          771  +
          772  +static void
          773  +SetDdeError(
          774  +    Tcl_Interp *interp)	    /* The interp to put the message in.*/
          775  +{
          776  +    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
          777  +    int err;
          778  +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
          779  +
          780  +    err = DdeGetLastError(ddeInstance);
          781  +    switch (err) {
          782  +	case DMLERR_DATAACKTIMEOUT:
          783  +	case DMLERR_EXECACKTIMEOUT:
          784  +	case DMLERR_POKEACKTIMEOUT:
          785  +	    Tcl_SetStringObj(resultPtr,
          786  +		    "remote interpreter did not respond", -1);
          787  +	    break;
          788  +
          789  +	case DMLERR_BUSY:
          790  +	    Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
          791  +	    break;
          792  +
          793  +	case DMLERR_NOTPROCESSED:
          794  +	    Tcl_SetStringObj(resultPtr, 
          795  +		    "remote server cannot handle this command", -1);
          796  +	    break;
          797  +
          798  +	default:
          799  +	    Tcl_SetStringObj(resultPtr, "dde command failed", -1);
          800  +    }
          801  +}
          802  +
          803  +/*
          804  + *--------------------------------------------------------------
          805  + *
          806  + * Tcl_DdeObjCmd --
          807  + *
          808  + *	This procedure is invoked to process the "dde" Tcl command.
          809  + *	See the user documentation for details on what it does.
          810  + *
          811  + * Results:
          812  + *	A standard Tcl result.
          813  + *
          814  + * Side effects:
          815  + *	See the user documentation.
          816  + *
          817  + *--------------------------------------------------------------
          818  + */
          819  +
          820  +int
          821  +Tcl_DdeObjCmd(
          822  +    ClientData clientData,	/* Used only for deletion */
          823  +    Tcl_Interp *interp,		/* The interp we are sending from */
          824  +    int objc,			/* Number of arguments */
          825  +    Tcl_Obj *CONST objv[])	/* The arguments */
          826  +{
          827  +    enum {
          828  +	DDE_SERVERNAME,
          829  +	DDE_EXECUTE,
          830  +	DDE_REQUEST,
          831  +	DDE_SERVICES,
          832  +	DDE_EVAL
          833  +    };
          834  +
          835  +    static char *ddeCommands[] = {"servername", "execute",
          836  +          "request", "services", "eval", 
          837  +	  (char *) NULL};
          838  +    static char *ddeOptions[] = {"-async", (char *) NULL};
          839  +    int index, argIndex;
          840  +    int async = 0;
          841  +    int result = TCL_OK;
          842  +    HSZ ddeService = NULL;
          843  +    HSZ ddeTopic = NULL;
          844  +    HSZ ddeItem = NULL;
          845  +    HDDEDATA ddeData = NULL;
          846  +    HDDEDATA ddeItemData = NULL;
          847  +    HCONV hConv;
          848  +    HSZ ddeCookie = 0;
          849  +    char *serviceName, *topicName, *itemString, *dataString;
          850  +    char *string;
          851  +    int firstArg, length, dataLength;
          852  +    DWORD ddeResult;
          853  +    HDDEDATA ddeReturn;
          854  +    RegisteredInterp *riPtr;
          855  +    Tcl_Interp *sendInterp;
          856  +    Tcl_Obj *objPtr;
          857  +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
          858  +
          859  +    /*
          860  +     * Initialize DDE server/client
          861  +     */
          862  +    
          863  +    if (objc < 2) {
          864  +	Tcl_WrongNumArgs(interp, 1, objv, 
          865  +		"?-async? serviceName topicName value");
          866  +	return TCL_ERROR;
          867  +    }
          868  +
          869  +    if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
          870  +	    &index) != TCL_OK) {
          871  +	return TCL_ERROR;
          872  +    }
          873  +
          874  +    switch (index) {
          875  +	case DDE_SERVERNAME:
          876  +	    if ((objc != 3) && (objc != 2)) {
          877  +		Tcl_WrongNumArgs(interp, 1, objv, 
          878  +			"servername ?serverName?");
          879  +		return TCL_ERROR;
          880  +	    }
          881  +	    firstArg = (objc - 1);
          882  +	    break;
          883  +	case DDE_EXECUTE:
          884  +	    if ((objc < 5) || (objc > 6)) {
          885  +		Tcl_WrongNumArgs(interp, 1, objv, 
          886  +			"execute ?-async? serviceName topicName value");
          887  +		return TCL_ERROR;
          888  +	    }
          889  +	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
          890  +		    &argIndex) != TCL_OK) {
          891  +		if (objc != 5) {
          892  +		    Tcl_WrongNumArgs(interp, 1, objv,
          893  +			    "execute ?-async? serviceName topicName value");
          894  +		    return TCL_ERROR;
          895  +		}
          896  +		async = 0;
          897  +		firstArg = 2;
          898  +	    } else {
          899  +		if (objc != 6) {
          900  +		    Tcl_WrongNumArgs(interp, 1, objv,
          901  +			    "execute ?-async? serviceName topicName value");
          902  +		    return TCL_ERROR;
          903  +		}
          904  +		async = 1;
          905  +		firstArg = 3;
          906  +	    }
          907  +	    break;
          908  +	case DDE_REQUEST:
          909  +	    if (objc != 5) {
          910  +		Tcl_WrongNumArgs(interp, 1, objv, 
          911  +			"request serviceName topicName value");
          912  +		return TCL_ERROR;
          913  +	    }
          914  +	    firstArg = 2;
          915  +	    break;
          916  +	case DDE_SERVICES:
          917  +	    if (objc != 4) {
          918  +		Tcl_WrongNumArgs(interp, 1, objv,
          919  +			"services serviceName topicName");
          920  +		return TCL_ERROR;
          921  +	    }
          922  +	    firstArg = 2;
          923  +	    break;
          924  +	case DDE_EVAL:
          925  +	    if (objc < 4) {
          926  +		Tcl_WrongNumArgs(interp, 1, objv, 
          927  +			"eval ?-async? serviceName args");
          928  +		return TCL_ERROR;
          929  +	    }
          930  +	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
          931  +		    &argIndex) != TCL_OK) {
          932  +		if (objc < 4) {
          933  +		    Tcl_WrongNumArgs(interp, 1, objv,
          934  +			    "eval ?-async? serviceName args");
          935  +		    return TCL_ERROR;
          936  +		}
          937  +		async = 0;
          938  +		firstArg = 2;
          939  +	    } else {
          940  +		if (objc < 5) {
          941  +		    Tcl_WrongNumArgs(interp, 1, objv,
          942  +			    "eval ?-async? serviceName args");
          943  +		    return TCL_ERROR;
          944  +		}
          945  +		async = 1;
          946  +		firstArg = 3;
          947  +	    }
          948  +	    break;
          949  +    }
          950  +
          951  +    if (firstArg != 1) {
          952  +	serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
          953  +    } else {
          954  +	serviceName = NULL;
          955  +    }
          956  +
          957  +    if (length == 0) {
          958  +	serviceName = NULL;
          959  +    } else if (index != DDE_SERVERNAME) {
          960  +	ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
          961  +		CP_WINANSI);
          962  +    }
          963  +
          964  +    if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {
          965  +	topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
          966  +	if (length == 0) {
          967  +	    topicName = NULL;
          968  +	} else {
          969  +	    ddeTopic = DdeCreateStringHandle(ddeInstance, 
          970  +		    topicName, CP_WINANSI);
          971  +	}
          972  +    }
          973  +
          974  +    switch (index) {
          975  +	case DDE_SERVERNAME: {
          976  +	    serviceName = DdeSetServerName(interp, serviceName);
          977  +	    if (serviceName != NULL) {
          978  +		Tcl_SetStringObj(Tcl_GetObjResult(interp),
          979  +			serviceName, -1);
          980  +		Initialize();
          981  +	    } else {
          982  +		Tcl_ResetResult(interp);
          983  +	    }
          984  +	    break;
          985  +	}
          986  +	case DDE_EXECUTE: {
          987  +	    Initialize();
          988  +	    dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
          989  +	    if (dataLength == 0) {
          990  +		Tcl_SetStringObj(Tcl_GetObjResult(interp),
          991  +			"cannot execute null data", -1);
          992  +		result = TCL_ERROR;
          993  +		break;
          994  +	    }
          995  +	    hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, 
          996  +                    NULL);
          997  +
          998  +	    if (hConv == NULL) {
          999  +		SetDdeError(interp);
         1000  +		result = TCL_ERROR;
         1001  +		break;
         1002  +	    }
         1003  +
         1004  +	    ddeData = DdeCreateDataHandle(ddeInstance, dataString,
         1005  +		    dataLength+1, 0, 0, CF_TEXT, 0);
         1006  +	    if (ddeData != NULL) {
         1007  +		if (async) {
         1008  +		    DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, 
         1009  +			    CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
         1010  +		    DdeAbandonTransaction(ddeInstance, hConv, 
         1011  +                            ddeResult);
         1012  +		} else {
         1013  +		    ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
         1014  +			    hConv, 0, CF_TEXT, XTYP_EXECUTE, 7200000, NULL);
         1015  +		    if (ddeReturn == 0) {
         1016  +			SetDdeError(interp);
         1017  +			result = TCL_ERROR;
         1018  +		    }
         1019  +		}
         1020  +		DdeFreeDataHandle(ddeData);
         1021  +	    } else {
         1022  +		SetDdeError(interp);
         1023  +		result = TCL_ERROR;
         1024  +	    }
         1025  +	    DdeDisconnect(hConv);
         1026  +	    break;
         1027  +	}
         1028  +	case DDE_REQUEST: {
         1029  +	    Initialize();
         1030  +	    itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
         1031  +	    if (length == 0) {
         1032  +		Tcl_SetStringObj(Tcl_GetObjResult(interp),
         1033  +			"cannot request value of null data", -1);
         1034  +		return TCL_ERROR;
         1035  +	    }
         1036  +	    hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, 
         1037  +                    NULL);
         1038  +	    
         1039  +	    if (hConv == NULL) {
         1040  +		SetDdeError(interp);
         1041  +		result = TCL_ERROR;
         1042  +	    } else {
         1043  +		Tcl_Obj *returnObjPtr;
         1044  +		ddeItem = DdeCreateStringHandle(ddeInstance, 
         1045  +                        itemString, CP_WINANSI);
         1046  +		if (ddeItem != NULL) {
         1047  +		    ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
         1048  +			    CF_TEXT, XTYP_REQUEST, 5000, NULL);
         1049  +		    if (ddeData == NULL) {
         1050  +			SetDdeError(interp);
         1051  +			result = TCL_ERROR;
         1052  +		    } else {
         1053  +			dataString = DdeAccessData(ddeData, &dataLength);
         1054  +			returnObjPtr = Tcl_NewStringObj(dataString, -1);
         1055  +			DdeUnaccessData(ddeData);
         1056  +			DdeFreeDataHandle(ddeData);
         1057  +			Tcl_SetObjResult(interp, returnObjPtr);
         1058  +		    }
         1059  +		} else {
         1060  +		    SetDdeError(interp);
         1061  +		    result = TCL_ERROR;
         1062  +		}
         1063  +		DdeDisconnect(hConv);
         1064  +	    }
         1065  +
         1066  +	    break;
         1067  +	}
         1068  +	case DDE_SERVICES: {
         1069  +	    HCONVLIST hConvList;
         1070  +	    CONVINFO convInfo;
         1071  +	    Tcl_Obj *convListObjPtr, *elementObjPtr;
         1072  +	    Tcl_DString dString;
         1073  +	    char *name;
         1074  +	    
         1075  +	    Initialize();
         1076  +	    convInfo.cb = sizeof(CONVINFO);
         1077  +	    hConvList = DdeConnectList(ddeInstance, ddeService, 
         1078  +                    ddeTopic, 0, NULL);
         1079  +	    hConv = 0;
         1080  +	    convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
         1081  +	    Tcl_DStringInit(&dString);
         1082  +
         1083  +	    while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) {
         1084  +		elementObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
         1085  +		DdeQueryConvInfo(hConv, QID_SYNC, &convInfo);
         1086  +		length = DdeQueryString(ddeInstance, 
         1087  +                        convInfo.hszSvcPartner, NULL, 0, CP_WINANSI);
         1088  +		Tcl_DStringSetLength(&dString, length);
         1089  +		name = Tcl_DStringValue(&dString);
         1090  +		DdeQueryString(ddeInstance, convInfo.hszSvcPartner, 
         1091  +                        name, length + 1, CP_WINANSI);
         1092  +		Tcl_ListObjAppendElement(interp, elementObjPtr,
         1093  +			Tcl_NewStringObj(name, length));
         1094  +		length = DdeQueryString(ddeInstance, convInfo.hszTopic,
         1095  +			NULL, 0, CP_WINANSI);
         1096  +		Tcl_DStringSetLength(&dString, length);
         1097  +		name = Tcl_DStringValue(&dString);
         1098  +		DdeQueryString(ddeInstance, convInfo.hszTopic, name,
         1099  +			length + 1, CP_WINANSI);
         1100  +		Tcl_ListObjAppendElement(interp, elementObjPtr,
         1101  +			Tcl_NewStringObj(name, length));
         1102  +		Tcl_ListObjAppendElement(interp, convListObjPtr, elementObjPtr);
         1103  +	    }
         1104  +	    DdeDisconnectList(hConvList);
         1105  +	    Tcl_SetObjResult(interp, convListObjPtr);
         1106  +	    Tcl_DStringFree(&dString);
         1107  +	    break;
         1108  +	}
         1109  +	case DDE_EVAL: {
         1110  +	    Initialize();
         1111  +	    objc -= (async + 3);
         1112  +	    ((Tcl_Obj **) objv) += (async + 3);
         1113  +
         1114  +            /*
         1115  +	     * See if the target interpreter is local.  If so, execute
         1116  +	     * the command directly without going through the DDE server.
         1117  +	     * Don't exchange objects between interps.  The target interp could
         1118  +	     * compile an object, producing a bytecode structure that refers to 
         1119  +	     * other objects owned by the target interp.  If the target interp 
         1120  +	     * is then deleted, the bytecode structure would be referring to 
         1121  +	     * deallocated objects.
         1122  +	     */
         1123  +	    
         1124  +	    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr
         1125  +		     = riPtr->nextPtr) {
         1126  +		if (stricmp(serviceName, riPtr->name) == 0) {
         1127  +		    break;
         1128  +		}
         1129  +	    }
         1130  +	    
         1131  +	    if (riPtr != NULL) {
         1132  +		/*
         1133  +		 * This command is to a local interp. No need to go through
         1134  +		 * the server.
         1135  +		 */
         1136  +		
         1137  +		Tcl_Preserve((ClientData) riPtr);
         1138  +		sendInterp = riPtr->interp;
         1139  +		Tcl_Preserve((ClientData) sendInterp);
         1140  +		
         1141  +		/*
         1142  +		 * Don't exchange objects between interps.  The target interp would
         1143  +		 * compile an object, producing a bytecode structure that refers to 
         1144  +		 * other objects owned by the target interp.  If the target interp 
         1145  +		 * is then deleted, the bytecode structure would be referring to 
         1146  +		 * deallocated objects.
         1147  +		 */
         1148  +
         1149  +		if (objc == 1) {
         1150  +		    result = Tcl_EvalObjEx(sendInterp, objv[0], TCL_EVAL_GLOBAL);
         1151  +		} else {
         1152  +		    objPtr = Tcl_ConcatObj(objc, objv);
         1153  +		    Tcl_IncrRefCount(objPtr);
         1154  +		    result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL);
         1155  +		    Tcl_DecrRefCount(objPtr);
         1156  +		}
         1157  +		if (interp != sendInterp) {
         1158  +		    if (result == TCL_ERROR) {
         1159  +			/*
         1160  +			 * An error occurred, so transfer error information from the
         1161  +			 * destination interpreter back to our interpreter.  
         1162  +			 */
         1163  +			
         1164  +			Tcl_ResetResult(interp);
         1165  +			objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, 
         1166  +				TCL_GLOBAL_ONLY);
         1167  +			string = Tcl_GetStringFromObj(objPtr, &length);
         1168  +			Tcl_AddObjErrorInfo(interp, string, length);
         1169  +			
         1170  +			objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
         1171  +				TCL_GLOBAL_ONLY);
         1172  +			Tcl_SetObjErrorCode(interp, objPtr);
         1173  +		    }
         1174  +		    Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
         1175  +		}
         1176  +		Tcl_Release((ClientData) riPtr);
         1177  +		Tcl_Release((ClientData) sendInterp);
         1178  +	    } else {
         1179  +		/*
         1180  +		 * This is a non-local request. Send the script to the server and poll
         1181  +		 * it for a result.
         1182  +		 */
         1183  +		
         1184  +		if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
         1185  +		    goto error;
         1186  +		}
         1187  +		
         1188  +		objPtr = Tcl_ConcatObj(objc, objv);
         1189  +		string = Tcl_GetStringFromObj(objPtr, &length);
         1190  +		ddeItemData = DdeCreateDataHandle(ddeInstance, string, length+1, 0, 0,
         1191  +			CF_TEXT, 0);
         1192  +		
         1193  +		if (async) {
         1194  +		    ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0,
         1195  +			    CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
         1196  +		    DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
         1197  +		} else {
         1198  +		    ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0,
         1199  +			    CF_TEXT, XTYP_EXECUTE, 7200000, NULL);
         1200  +		    if (ddeData != 0) {
         1201  +			
         1202  +			ddeCookie = DdeCreateStringHandle(ddeInstance, 
         1203  +				"$TCLEVAL$EXECUTE$RESULT", CP_WINANSI);
         1204  +			ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
         1205  +				CF_TEXT, XTYP_REQUEST, 7200000, NULL);
         1206  +		    }
         1207  +		}
         1208  +		
         1209  +		
         1210  +		Tcl_DecrRefCount(objPtr);
         1211  +		
         1212  +		if (ddeData == 0) {
         1213  +		    SetDdeError(interp);
         1214  +		    DdeFreeDataHandle(ddeItemData);
         1215  +		    DdeDisconnect(hConv);
         1216  +		    goto error;
         1217  +		}
         1218  +		
         1219  +		if (async == 0) {
         1220  +		    Tcl_Obj *resultPtr;
         1221  +		    
         1222  +		    /*
         1223  +		     * The return handle has a two or four element list in it. The first
         1224  +		     * element is the return code (TCL_OK, TCL_ERROR, etc.). The
         1225  +		     * second is the result of the script. If the return code is TCL_ERROR,
         1226  +		     * then the third element is the value of the variable "errorCode",
         1227  +		     * and the fourth is the value of the variable "errorInfo".
         1228  +		     */
         1229  +		    
         1230  +		    resultPtr = Tcl_NewObj();
         1231  +		    length = DdeGetData(ddeData, NULL, 0, 0);
         1232  +		    Tcl_SetObjLength(resultPtr, length);
         1233  +		    string = Tcl_GetString(resultPtr);
         1234  +		    DdeGetData(ddeData, string, length, 0);
         1235  +		    Tcl_SetObjLength(resultPtr, strlen(string));
         1236  +		    
         1237  +		    if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
         1238  +			Tcl_DecrRefCount(resultPtr);
         1239  +			goto error;
         1240  +		    }
         1241  +		    if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
         1242  +			Tcl_DecrRefCount(resultPtr);
         1243  +			goto error;
         1244  +		    }
         1245  +		    if (result == TCL_ERROR) {
         1246  +			Tcl_ResetResult(interp);
         1247  +			
         1248  +			if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) != TCL_OK) {
         1249  +			    Tcl_DecrRefCount(resultPtr);
         1250  +			    goto error;
         1251  +			}
         1252  +			length = -1;
         1253  +			string = Tcl_GetStringFromObj(objPtr, &length);
         1254  +			Tcl_AddObjErrorInfo(interp, string, length);
         1255  +			
         1256  +			Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
         1257  +			Tcl_SetObjErrorCode(interp, objPtr);
         1258  +		    }
         1259  +		    if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) {
         1260  +			Tcl_DecrRefCount(resultPtr);
         1261  +			goto error;
         1262  +		    }
         1263  +		    Tcl_SetObjResult(interp, objPtr);
         1264  +		    Tcl_DecrRefCount(resultPtr);
         1265  +		}
         1266  +	    }
         1267  +	}
         1268  +    }
         1269  +    if (ddeCookie != NULL) {
         1270  +	DdeFreeStringHandle(ddeInstance, ddeCookie);
         1271  +    }
         1272  +    if (ddeItem != NULL) {
         1273  +	DdeFreeStringHandle(ddeInstance, ddeItem);
         1274  +    }
         1275  +    if (ddeItemData != NULL) {
         1276  +	DdeFreeDataHandle(ddeItemData);
         1277  +    }
         1278  +    if (ddeData != NULL) {
         1279  +	DdeFreeDataHandle(ddeData);
         1280  +    }
         1281  +    if (hConv != NULL) {
         1282  +	DdeDisconnect(hConv);
         1283  +    }
         1284  +    return result;
         1285  +
         1286  +    error:
         1287  +    Tcl_SetStringObj(Tcl_GetObjResult(interp),
         1288  +	    "invalid data returned from server", -1);
         1289  +    if (ddeCookie != NULL) {
         1290  +	DdeFreeStringHandle(ddeInstance, ddeCookie);
         1291  +    }
         1292  +    if (ddeItem != NULL) {
         1293  +	DdeFreeStringHandle(ddeInstance, ddeItem);
         1294  +    }
         1295  +    if (ddeItemData != NULL) {
         1296  +	DdeFreeDataHandle(ddeItemData);
         1297  +    }
         1298  +    if (ddeData != NULL) {
         1299  +	DdeFreeDataHandle(ddeData);
         1300  +    }
         1301  +    if (hConv != NULL) {
         1302  +	DdeDisconnect(hConv);
         1303  +    }
         1304  +    return TCL_ERROR;
         1305  +}