#!/bin/sh
#
# This is a shell archive.  To extract its contents,
# execute this file with /bin/sh to create the file(s):
#
# Makefile	    hsTcl4gl.c		sccs.mk		    tcl4gl.h
# README		    init.c		symbols.mk	    tcl4glP.h
# README.NEW	    rcs.mk		tcl4gl.c	    test.4gl
# Tcl4gl.doc	    rules.mk
#
# This shell archive created: Tue Jul 23 14:59:18 EDT 1996
#
echo "Extracting file Makefile"
sed -e 's/^X//' <<\SHAR_EOF > Makefile
X#
X#       ----------------------------------------------------------------------
X#				makefile
X#       ----------------------------------------------------------------------
X#
X# Program   :	STANDARD C LIBRARY makefile
X# Written   :   Gregory F. Hogg         HOGG'S SOFTWARE
X#   By                                  1411 My Lady's Drive
X#                                       Abingdon, MD 21009
X#                                       301-538-7241
X# RCS       :
X#       $Header: /usr5/src/tcl4gl/lib/RCS/Makefile 0.2 1993/10/28 18:06:10 bkuhn Exp bkuhn $
X# History   :
X#	09/15/90 GFH Create file
X#	11/11/90 GFH Copyed unix/4gl files
X#
X
X#
X#	-----	type, language and default symbols			-----
X#	-----	NOTE: must be first and lower case			-----
X#
XMAKETYPE = lib
XMAKELANG = c
Xinclude $(MAKEINCLUDE)/symbols.mk
X
X#
X#	-----	default FLAGS						-----
X#
XCC	= cc
XCFLAGS	= -I/usr/informix/incl -I/usr5/local/include -I/usr/local/include -O
X
X#
X#	-----	library name						-----
X#
XLIBDIR     = .
XLIBNAME    = libtcl4gl
XLIBRARY    = $(LIBDIR)/$(LIBNAME).a
X
X.PRECIOUS: $(LIBRARY)
X
X#
X#	-----	source files						-----
X#
XSRCFILES = $(CFILES) $(HFILES) $(LFILES) $(YFILES) \
X	$(MKFILES) Makefile
X
X#
X#	-----	make library by default					-----
X#
Xfirst : $(SRCFILES) $(LIBRARY)
X
X#
X#	-----	default rules						-----
X#	-----	NOTE: must be last					-----
X#
Xinclude $(MAKEINCLUDE)/rules.mk
X
SHAR_EOF
if [ `wc -c < Makefile` -ne     1356 ]
then
    echo "Lengths do not match -- Bad Copy of Makefile"
fi
echo "Extracting file README"
sed -e 's/^X//' <<\SHAR_EOF > README
XI wanted this to go in the Informix Archive because a lot of work went
Xinto making this code work with Informix. In some cases it was improved
Xover what was originally posted on purdue.edu.
X
XThis posting in the archive of Tcl stuff was not meant to be a "compile
Xand go" for anybody you wanted to use it. We don't have the time or
Xdesire to do that. This stuff has been tested in a complicated production
Xenvironment and it works for us. You should get the Tcl Informix
Xcode from purdue.edu and look at it.
X
XThe "Makefile" is custom to our installation. Trying to include all of
Xit so it will work on your system is too much work. If you are interested
Xenough to be using Informix/TcL interface then should have no trouble
Xfiguring out how to compile this stuff.
X
XHow we used it. . .
X
XWe used Tcl/Informix in the following way:
X
XWe needed to do statistical calculations envolving blood typing/DNA analysis
Xfor establishing paternity. The method of doing this required a lot of
Xlist comparison. From the Informix database we created temporary tables
Xthat had sets of data that the calculation would work on.
X
XThe Tcl code did the calculation work by reading data from the temp tables
Xand putting data back into temp tables. 
X
XThis was done in 4GL by creating a Tcl Interpreter and calling it
Xwith the filename of the Tcl code. Since Tcl was linked with esql/c
Xand because it is part of the same process you get an "imbeddable language"
Xinto 4GL that works just the way Tcl was intended.
X
XMike Kuhn  mkuhn@rhlab.com, csd@clark.net
X
XBrad Kuhn  bkuhn@acm.org
SHAR_EOF
if [ `wc -c < README` -ne     1555 ]
then
    echo "Lengths do not match -- Bad Copy of README"
fi
echo "Extracting file README.NEW"
sed -e 's/^X//' <<\SHAR_EOF > README.NEW
XAs I was checking this software into the IIUG archive, I discovered that the
XTCL archive has moved to:
X
X    http://www.neosoft.com/tcl and
X    ftp://ftp.neosoft.com/pub/tcl
X
X
XWalt Hultgren
XJuly 23, 1996
SHAR_EOF
if [ `wc -c < README.NEW` -ne      203 ]
then
    echo "Lengths do not match -- Bad Copy of README.NEW"
fi
echo "Extracting file Tcl4gl.doc"
sed -e 's/^X//' <<\SHAR_EOF > Tcl4gl.doc
X# Tcl4gl.doc                                                      -*- Text -*-
X#
X#  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X#
X# Program   :    Tcl4gl library
X# File      :    Description of the Tcl4gl interface
X#
X# Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X#   By                                  5916 Glenoak Ave.
X#                                       Baltimore, MD 21214-2009
X#                                       410-254-7060
X#
X# Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X#   For          400 West Franklin Street
X#                Baltimore, MD 21201
X#                410-225-9595
X#
X# RCS        :
X# $Source: /usr5/src/tcl4gl/lib/RCS/Tcl4gl.doc $
X# $Revision: 0.2 $
X# $Date: 1993/10/28 19:44:41 $
X#
X# $Log: Tcl4gl.doc $
X# Revision 0.2  1993/10/28  19:44:41  bkuhn
X# *** empty log message ***
X#
X# Revision 0.1  1993/08/23  18:49:12  bkuhn
X#   # initial version
X#
X
XThis library was designed to provide an interface between INFORMIX-4gl and Tcl.
XIt basically provides a subset of the functionality that C has to Tcl.
X
XThe functions from C/Tcl are:
X   Tcl_CreateInterp
X   Tcl_DeleteInterp
X   Tcl_Eval
X   Tcl_EvalFile
X   Tcl_GlobalEval
X   Tcl_Startup
X
XThese are described on Section 28.2, page 264 of ``An Introduction to Tcl and
XTk'' (draft of 16 April 1993) by John K. Ousterhout.  Except for Tcl_Startup,
Xwhich is an extended tcl command.
X
XThe 4gl function provided are as follows:
X   define
X      tclInterpID int,
X      fileName    char(256),   # string can be shorter but not longer
X      script      char(512),   # string can be shorter but not longer
X      tclCode     int,
X      tclResult   char(???)    # there is no set length of this string
X
XTcl4gl_CreateInterp() returning tclInterpID
X     creates an interpreter that will be referenced by tclInterpID
X
XTcl4gl_DeleteInterp(tclInterpID)
X     deletes the interpreter tclInterpID
X
XTcl4gl_Eval(tclInterpID, script) returning tclCode, tclResult
X     evaluates script inside the interpreter referenced by tclInterpID
X     returns the tclCode (0 iff. successful, similar to sqlca.sqlcode),
X     and the string result of the interpreter
X
XTcl4gl_EvalFile(tclInterpID, fileName) returning tclCode, tclResult
X     evaluates the file, fileName, inside interpreter ref'ed by tclInterpID.
X     returns the tclCode (0 iff. successful, similar to sqlca.sqlcode),
X     and the string result of the interpreter
X
XTcl4gl_GlobalEval(tclInterpID, script) returing tclCode, tclResult
X     same as Tcl4gl_Eval but evaluates at a global level 
X       instead of current local level.
X
XTcl4gl_Startup(tclInterpID, arg0, arg1, arg2, arg3, ..., argN)
X     this is an extended Tcl function.  It creates an interactive interpreter
X     (command loop) right in the middle of your 4gl program.  This is intended
X     for use when debugging.
SHAR_EOF
if [ `wc -c < Tcl4gl.doc` -ne     2849 ]
then
    echo "Lengths do not match -- Bad Copy of Tcl4gl.doc"
fi
echo "Extracting file hsTcl4gl.c"
sed -e 's/^X//' <<\SHAR_EOF > hsTcl4gl.c
X/* hsTcl4gl.c
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    HS Tcl4gl library
X** File      :    Tcl functions to interface w/ Hogg's Software 4gl libraries
X** Functions :
X**    Tcl4gl_HsMessageCmd  -- interface to HsMessage
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tcl4gl/lib/RCS/hsTcl4gl.c $
X** $Revision: 0.1 $
X** $Date: 1993/12/30 17:02:30 $
X**
X** $Log: hsTcl4gl.c $
X * Revision 0.1  1993/12/30  17:02:30  bkuhn
X *   #  initial version
X *
X*/
X#include <tcl.h>
X#include <fglapi.h>
X
Xstatic char rcsid[] =
X  "$Id: hsTcl4gl.c 0.1 1993/12/30 17:02:30 bkuhn Exp $";
X
X/*****************************************************************************/
Xint Tcl4gl_HsMessageCmd(dummy, interp, argc, argv)
X    ClientData dummy;                   /* Not used. */
X    Tcl_Interp *interp;                 /* Current interpreter. */
X    int argc;                           /* Number of arguments. */
X    char **argv;                        /* Argument strings. */
X{
X
X    Tcl_ResetResult(interp);
X    
X    if (argc != 4) {
X        Tcl_AppendResult(interp, "wrong # of args; should be: ", argv[0], 
X                         " msg1 msg2 msg3", NULL);
X        return TCL_ERROR;
X    }
X
X    pushquote(argv[1], strlen(argv[1]));
X    pushquote(argv[2], strlen(argv[2]));
X    pushquote(argv[3], strlen(argv[3]));
X    fgl_call(hsmessage, 3);
X
X    return TCL_OK;
X}
SHAR_EOF
if [ `wc -c < hsTcl4gl.c` -ne     1824 ]
then
    echo "Lengths do not match -- Bad Copy of hsTcl4gl.c"
fi
echo "Extracting file init.c"
sed -e 's/^X//' <<\SHAR_EOF > init.c
X/* hsTcl4gl.c
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    HS Tcl4gl library
X** File      :    Tcl functions to interface w/ Hogg's Software 4gl libraries
X** Functions :
X**    Tcl4gl_Init  --  initialize the Tcl-4gl interpreter
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tcl4gl/lib/RCS/init.c $
X** $Revision: 0.1 $
X** $Date: 1993/12/30 17:47:39 $
X**
X** $Log: init.c $
X * Revision 0.1  1993/12/30  17:47:39  bkuhn
X *   #  initial version
X *
X*/
X#include <tcl.h>
X#include <tclsql.h>
X#include "tcl4glP.h"
X
Xstatic char rcsid[] =
X  "$Id: init.c 0.1 1993/12/30 17:47:39 bkuhn Exp $";
X
X/*****************************************************************************/
Xint Tcl4gl_Init(interp)
X    Tcl_Interp *interp;
X{
X    Tcl_CreateCommand(interp, "Hs:Message", Tcl4gl_HsMessageCmd,
X                      (ClientData)NULL, (void (*)())NULL);
X    Tcl_SetVar(interp, "TCL4GL", "1",
X               TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
X    return TCL_OK;
X}
SHAR_EOF
if [ `wc -c < init.c` -ne     1429 ]
then
    echo "Lengths do not match -- Bad Copy of init.c"
fi
echo "Extracting file rcs.mk"
sed -e 's/^X//' <<\SHAR_EOF > rcs.mk
X#
X#	-----	SCCS rules						-----
X#
XMakefile	: $(SrcDir)//usr5/src/tcl4gl/RCS/Makefile,v
X	co $(SrcDir)//usr5/src/tcl4gl/RCS/Makefile,v Makefile
XTCL4GL.DOC	: $(SrcDir)//usr5/src/tcl4gl/RCS/TCL4GL.DOC,v
X	co $(SrcDir)//usr5/src/tcl4gl/RCS/TCL4GL.DOC,v TCL4GL.DOC
Xrcs.mk	: $(SrcDir)//usr5/src/tcl4gl/RCS/rcs.mk,v
X	co $(SrcDir)//usr5/src/tcl4gl/RCS/rcs.mk,v rcs.mk
Xrules.mk	: $(SrcDir)//usr5/src/tcl4gl/RCS/rules.mk,v
X	co $(SrcDir)//usr5/src/tcl4gl/RCS/rules.mk,v rules.mk
Xsccs.mk	: $(SrcDir)//usr5/src/tcl4gl/RCS/sccs.mk,v
X	co $(SrcDir)//usr5/src/tcl4gl/RCS/sccs.mk,v sccs.mk
Xsymbols.mk	: $(SrcDir)//usr5/src/tcl4gl/RCS/symbols.mk,v
X	co $(SrcDir)//usr5/src/tcl4gl/RCS/symbols.mk,v symbols.mk
Xtcl4gl.c	: $(SrcDir)//usr5/src/tcl4gl/RCS/tcl4gl.c,v
X	co $(SrcDir)//usr5/src/tcl4gl/RCS/tcl4gl.c,v tcl4gl.c
Xtcl4gl.h	: $(SrcDir)//usr5/src/tcl4gl/RCS/tcl4gl.h,v
X	co $(SrcDir)//usr5/src/tcl4gl/RCS/tcl4gl.h,v tcl4gl.h
Xtcl4glP.h	: $(SrcDir)//usr5/src/tcl4gl/RCS/tcl4glP.h,v
X	co $(SrcDir)//usr5/src/tcl4gl/RCS/tcl4glP.h,v tcl4glP.h
SHAR_EOF
if [ `wc -c < rcs.mk` -ne     1014 ]
then
    echo "Lengths do not match -- Bad Copy of rcs.mk"
fi
echo "Extracting file rules.mk"
sed -e 's/^X//' <<\SHAR_EOF > rules.mk
X# rules.mk
X#
X#  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X#
X# Program   :    Tcl4gl library
X# File      :    Rules for the makefile
X#
X# Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X#   By                                  5916 Glenoak Ave.
X#                                       Baltimore, MD 21214-2009
X#                                       410-254-7060
X#
X# Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X#   For          400 West Franklin Street
X#                Baltimore, MD 21201
X#                410-225-9595
X#
X# RCS        :
X# $Source: /usr5/src/tcl4gl/lib/RCS/rules.mk $
X# $Revision: 0.1 $
X# $Date: 1993/08/23 18:55:32 $
X#
X# $Log: rules.mk $
X# Revision 0.1  1993/08/23  18:55:32  bkuhn
X#   # initial version
X#
X#
X#	-----	local rules						-----
X#
X
X#
X#	-----	START H FILES						-----
X#
Xtcl4glP.h	:  tcl4gl.h
Xtcl4gl.o	: tcl4gl.c 
X#
X#	-----	STOP H FILES						-----
X#
X
Xinstall:
X	cp $(LIBRARY) /usr/local/lib
X	chmod 644 /usr/local/lib/$(LIBRARY)
X	cp tcl4gl.h /usr/local/include
X	chmod 644 /usr/local/include/tcl4gl.h
X
Xci:
X	ci -d -M $(CFILES) $(ECFILES) $(HFILES) $(TCLLIBS)
X
Xco:
X	co -M $(CFILES) $(ECFILES) $(HFILES) $(TCLLIBS)
Xcico:
X	ci -d -M -u $(CFILES) $(ECFILES) $(HFILES) $(TCLLIBS)
Xtags:
X	etags -t $(CFILES) $(ECFILES) $(HFILES) $(TCLLIBS)
SHAR_EOF
if [ `wc -c < rules.mk` -ne     1317 ]
then
    echo "Lengths do not match -- Bad Copy of rules.mk"
fi
echo "Extracting file sccs.mk"
sed -e 's/^X//' <<\SHAR_EOF > sccs.mk
X#
X#	-----	SCCS rules						-----
X#
XMakefile	: $(SrcDir)//usr5/src/tcl4gl/SCCS/s.Makefile
X	get $(SrcDir)//usr5/src/tcl4gl/SCCS/s.Makefile
XTCL4GL.DOC	: $(SrcDir)//usr5/src/tcl4gl/SCCS/s.TCL4GL.DOC
X	get $(SrcDir)//usr5/src/tcl4gl/SCCS/s.TCL4GL.DOC
Xrules.mk	: $(SrcDir)//usr5/src/tcl4gl/SCCS/s.rules.mk
X	get $(SrcDir)//usr5/src/tcl4gl/SCCS/s.rules.mk
Xsccs.mk	: $(SrcDir)//usr5/src/tcl4gl/SCCS/s.sccs.mk
X	get $(SrcDir)//usr5/src/tcl4gl/SCCS/s.sccs.mk
Xsymbols.mk	: $(SrcDir)//usr5/src/tcl4gl/SCCS/s.symbols.mk
X	get $(SrcDir)//usr5/src/tcl4gl/SCCS/s.symbols.mk
Xtcl4gl.c	: $(SrcDir)//usr5/src/tcl4gl/SCCS/s.tcl4gl.c
X	get $(SrcDir)//usr5/src/tcl4gl/SCCS/s.tcl4gl.c
Xtcl4gl.h	: $(SrcDir)//usr5/src/tcl4gl/SCCS/s.tcl4gl.h
X	get $(SrcDir)//usr5/src/tcl4gl/SCCS/s.tcl4gl.h
Xtcl4glP.h	: $(SrcDir)//usr5/src/tcl4gl/SCCS/s.tcl4glP.h
X	get $(SrcDir)//usr5/src/tcl4gl/SCCS/s.tcl4glP.h
SHAR_EOF
if [ `wc -c < sccs.mk` -ne      862 ]
then
    echo "Lengths do not match -- Bad Copy of sccs.mk"
fi
echo "Extracting file symbols.mk"
sed -e 's/^X//' <<\SHAR_EOF > symbols.mk
X# symbols.mk
X#
X#  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X#
X# Program   :    Tcl4gl library
X# File      :    Symbols for the makefile
X#
X# Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X#   By                                  5916 Glenoak Ave.
X#                                       Baltimore, MD 21214-2009
X#                                       410-254-7060
X#
X# Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X#   For          400 West Franklin Street
X#                Baltimore, MD 21201
X#                410-225-9595
X#
X# RCS        :
X# $Source: /usr5/src/tcl4gl/lib/RCS/symbols.mk $
X# $Revision: 0.1 $
X# $Date: 1993/08/23 18:57:20 $
X#
X# $Log: symbols.mk $
X# Revision 0.1  1993/08/23  18:57:20  bkuhn
X#   # initial version
X#
X#
X#	-----	default CFLAGS						-----
X#
XCFLAGS = -O -I. -I/usr/local/include
X
X#
X#       -----   FILES MACROS                                            -----
X#
XCFILES = tcl4gl.c hsTcl4gl.c init.c
XHFILES = tcl4gl.h	\
X	tcl4glP.h
XLFILES = 
XYFILES = 
XMKFILES = rules.mk	\
X	symbols.mk
X
X#
X#       -----   list of files to put in the library			-----
X#
XLIBFILES = $(LIBRARY)(tcl4gl.o)  $(LIBRARY)(hsTcl4gl.o) $(LIBRARY)(init.o)
X
X#
X#	-----	required for uucp					-----
X#
XUUDIR	= /usr5/src
XUUFILE	= tcl4gl.cpz
X
SHAR_EOF
if [ `wc -c < symbols.mk` -ne     1293 ]
then
    echo "Lengths do not match -- Bad Copy of symbols.mk"
fi
echo "Extracting file tcl4gl.c"
sed -e 's/^X//' <<\SHAR_EOF > tcl4gl.c
X/* tcl4gl.c
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    Tcl4gl library
X** File      :    Tcl functions for 4gl
X** Functions :
X**    NOTE: Some of these functions had to be all lower case because 4GL
X**          downshifts function names
X**    Tcl4gl_InitInterpList  -- initialize the list of interpreters
X**    Tcl4gl_CreateInterp    -- create an interpreter w/ SQL capabilities
X**    Tcl4gl_DeleteInterp    -- delete a given interpreter
X**    Tcl4gl_Eval            -- evaluate a tcl script
X**    Tcl4gl_EvalFile        -- evaluate a file containing a tcl script
X**    Tcl4gl_GlobalEval      -- evaluate a tcl script at a global level
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tcl4gl/lib/RCS/tcl4gl.c $
X** $Revision: 1.10 $
X** $Date: 1994/06/06 14:52:29 $
X**
X** $Log: tcl4gl.c $
X** Revision 1.10  1994/06/06  14:52:29  bkuhn
X**   -- added Tcl_DeleteInterp(), typed CheckMalloc()
X**
X** Revision 1.9  1994/03/25  16:48:42  bkuhn
X**   # added Keyed List implentation call
X**
X** Revision 1.8  1993/12/30  17:06:05  bkuhn
X**   -- added Tcl4gl_Init support
X**
X** Revision 1.7  1993/12/29  16:20:36  bkuhn
X**   -- fixed bugs
X**
X** Revision 1.6  1993/12/29  15:16:09  bkuhn
X**   -- commented out delete call
X**
X** Revision 1.5  1993/12/28  20:31:29  bkuhn
X**   -- changed to work w/ Tcl 7.3
X**
X** Revision 1.4  1993/11/02  16:26:28  bkuhn
X**   -- fixed bug for argv processing in tcl_startup
X**
X** Revision 1.3  1993/11/02  14:32:31  bkuhn
X**   -- added support for stripping spaces on tcl_startup
X**
X** Revision 1.2  1993/11/02  13:18:55  bkuhn
X**   -- added Tcl_Startup
X**
X** Revision 1.1  1993/10/28  17:52:31  bkuhn
X**   -- installed version
X**
X** Revision 0.1  1993/08/23  19:19:42  bkuhn
X**   # initial version
X**
X*/
X#include <limits.h>
X#include <string.h>
X#include "tclExtend.h"
X#include "tclsql.h"
X#include "tcl4glP.h"
X
Xstatic char rcsid[] =
X  "$Id: tcl4gl.c 1.10 1994/06/06 14:52:29 bkuhn Exp $";
X
Xstatic t_Tcl4glInterp F4glInterp[TCL_INTERP_MAX];
X                                        /* file level global interpreters */
X
X/******************************************************************************
X** Tcl4gl_InitInterpList -- initialize the F4glInterp
X**   PRECONDITIONS: None
X**   POSTCONDITIONS: the F4glInterp array will be initialized
X**  This function is private to this file.
X*/
Xstatic void Tcl4gl_InitInterpList()
X{
X    register int ii;
X
X    for (ii = 0; ii < TCL_INTERP_MAX; ii++) {
X        F4glInterp[ii].inUse = FALSE;
X        F4glInterp[ii].interp = NULL;
X    }
X    return;
X}
X/******************************************************************************
X** Tcl4gl_CreateInterp -- create a new 4gl-TCL interpreter.
X**    PRECONDITIONS: None
X**    POSTCONDITIONS: An interpreter will be created and an ID for it will
X**                    be returned.
X*/
Xint tcl4gl_createinterp(numArgs)
X    int numArgs;
X{
X    static bool firstTime = TRUE;
X    int ii;
X    bool foundNew;
X    
X    if (numArgs != 0) {
X        fprintf(stderr,
X                "tcl4gl_createinterp: wrong # of args(%d); should be %d\n",
X                numArgs, 0);
X        exit(-1);
X    }
X    if (firstTime) {
X        Tcl4gl_InitInterpList();
X        firstTime = FALSE;
X    }
X    for(ii = 0, foundNew = FALSE; ii < TCL_INTERP_MAX; ii++) {
X        foundNew = (! F4glInterp[ii].inUse);
X        if (foundNew) break;
X    }
X     
X    if (! foundNew ) {
X        fprintf(stderr,
X                "Out of Tcl interpreters; maximum is %d...Aborting...\n",
X                TCL_INTERP_MAX);
X        exit(-1);
X    }
X
X    F4glInterp[ii].inUse = TRUE;
X    F4glInterp[ii].interp = Tcl_CreateInterp();
X
X    Tcl_SetVar(F4glInterp[ii].interp, "argv0", "tcl4gl",
X                    TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
X
X    Tcl_SetVar(F4glInterp[ii].interp, "argv", "",
X               TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
X
X    Tcl_SetVar(F4glInterp[ii].interp, "argc", "0",
X               TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
X
X    Tcl_SetVar(F4glInterp[ii].interp, "tcl_interactive", "0",
X               TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
X    TclX_Init(F4glInterp[ii].interp);
X
X    Tcl_Init_Sql(F4glInterp[ii].interp);
X    Tcl_Init_KeyL(F4glInterp[ii].interp);
X    Tcl4gl_Init(F4glInterp[ii].interp);
X
X    retint(ii);
X    return 1;
X}
X/******************************************************************************
X** Tcl4gl_DeleteInterp -- delete a 4gl-TCL interpreter.
X**    PRECONDITIONS: the interpreter, interpID, exists
X**    POSTCONDITIONS: the interpreter will be destroyed
X*/
Xint tcl4gl_deleteinterp(numArgs)
X    int numArgs;
X{
X    int interpID;
X
X    if (numArgs != 1) {
X        fprintf(stderr, "tcl4gl_deleteinterp: wrong # of args (%d)\n",
X                numArgs);
X        exit(-1);
X    }
X
X    popint(&interpID);
X    if ( (interpID < 0) || (interpID >= TCL_INTERP_MAX) || 
X         (! F4glInterp[interpID].inUse) ) {
X        fprintf(stderr, "tcl4gl_eval: invalid interpreter ID (%d)\n",
X                interpID);
X        exit(-1);
X    }
X/* FIX ME ! I commented out the delete because it wasn't working */
X    Tcl_DeleteInterp(F4glInterp[interpID].interp);
X    F4glInterp[interpID].inUse = FALSE;
X    return 0;
X}
X/******************************************************************************
X** Tcl4gl_Eval -- Evaluate a Tcl script
X**    PRECONDITIONS: interpID is a valid interpID; len(script) < TCL_STRING_MAX
X**    POSTCONDITIONS: script will be evaluated in interpID, the TCL code and
X**                    the result from the interpreter will be returned.
X*/
Xint tcl4gl_eval(numArgs)
X    int numArgs;
X{
X    int interpID;
X    char script[TCL_STRING_MAX];
X    int retVal = 0;
X
X    if (numArgs != 2) {
X        fprintf(stderr, "tcl4gl_eval: wrong # of args (%d)\n", numArgs);
X        exit(-1);
X    }
X
X    popquote(script, TCL_STRING_MAX);
X
X    popint(&interpID);
X    if ( (interpID < 0) || (interpID >= TCL_INTERP_MAX) || 
X         (! F4glInterp[interpID].inUse) ) {
X        fprintf(stderr, "tcl4gl_eval: invalid interpreter ID (%d)\n",
X                interpID);
X        exit(-1);
X    }
X    
X    retVal = Tcl_Eval(F4glInterp[interpID].interp, script);
X    pushint(retVal);
X    pushquote(F4glInterp[interpID].interp->result);
X    return 2;
X}
X/******************************************************************************
X** Tcl4gl_EvalFile -- evaluate a file with a given interpreter
X**    PRECONDITIONS: interpID is a valid interpID; len(fname) < PATH_MAX
X**    POSTCONDITIONS: file will be evaluated in interpID, the TCL code and
X**                    the result from the interpreter will be returned.
X*/
Xint tcl4gl_evalfile(numArgs)
X    int numArgs;
X{
X    char fname[PATH_MAX];
X    int interpID;
X    int retVal;
X    char *ptr = NULL;
X
X    popquote(fname, PATH_MAX);
X    ptr = strchr(fname, ' ');       /* remove spaces off the end */
X    if (ptr != NULL) *ptr = '\0';
X    
X    popint(&interpID);
X    if ( (interpID < 0) || (interpID >= TCL_INTERP_MAX) || 
X         (! F4glInterp[interpID].inUse) ) {
X        fprintf(stderr, "tcl4gl_evalfile: invalid interpreter ID (%d)\n",
X                interpID);
X        exit(-1);
X    }
X    
X    retVal = Tcl_EvalFile(F4glInterp[interpID].interp, fname);
X    retint(retVal);
X    retquote(F4glInterp[interpID].interp->result);
X    return 2;
X}
X/******************************************************************************
X** Tcl4gl_GlobalEval -- Evaluate a Tcl script globally
X**    PRECONDITIONS: interpID is a valid interpID; len(script) < TCL_STRING_MAX
X**    POSTCONDITIONS: script will be evaluated in interpID at the global level,
X**                    the TCL code and the result from the interpreter will be
X**                    returned.
X*/
Xint tcl4gl_globaleval(numArgs)
X    int numArgs;
X{
X    int interpID;
X    char script[TCL_STRING_MAX];
X    int retVal;
X
X    if (numArgs != 2) {
X        fprintf(stderr, "tcl4gl_globaleval: wrong # of args (%d)\n", numArgs);
X        exit(-1);
X    }
X
X    popquote(script, TCL_STRING_MAX);
X
X    popint(&interpID);
X    if ( (interpID < 0) || (interpID >= TCL_INTERP_MAX) || 
X         (! F4glInterp[interpID].inUse) ) {
X        fprintf(stderr, "tcl4gl_globaleval: invalid interpreter ID (%d)\n",
X                interpID);
X        exit(-1);
X    }
X    
X    retVal = Tcl_GlobalEval(F4glInterp[interpID].interp, script);
X    pushint(retVal);
X    pushquote(F4glInterp[interpID].interp->result);
X    return 2;
X}
X/******************************************************************************
X** Tcl4gl_Startup -- Startup a tcl command loop
X**    PRECONDITIONS: interpID is a valid interpID.
X**    POSTCONDITIONS: a command loop will have been started and executed
X*/
Xint tcl4gl_startup(numArgs)
X    int numArgs;
X{
X    int  interpID;
X    char **argv = NULL, *ptr = NULL;
X    int  argc = 0;
X    int  ii;
X
X    if (numArgs < 1) {
X        fprintf(stderr, "tcl4gl_startup: wrong # of args (%d)", numArgs);
X        exit(-1);
X    }
X
X    argv = (char **) CheckMalloc(numArgs * sizeof(char *));
X
X    while (argc < (numArgs - 1) ) {
X        argv[argc++] = (char *) CheckMalloc(TCL_ARG_MAX * sizeof(char));
X    }
X    argv[argc] = NULL;
X    
X    for(ii = argc - 1; ii >= 0; ii--) {
X        popquote(argv[ii], TCL_ARG_MAX);
X        ptr = strchr(argv[ii], ' ');       /* remove spaces off the end */
X        if (ptr != NULL) *ptr = '\0';
X    }
X
X    popint(&interpID);
X
X    if ( (interpID < 0) || (interpID >= TCL_INTERP_MAX) || 
X         (! F4glInterp[interpID].inUse) ) {
X        fprintf(stderr, "tcl4gl_startup: invalid interpreter ID (%d)",
X                interpID);
X        exit(-1);
X    }
X
X    Tcl_CommandLoop (F4glInterp[interpID].interp, isatty (0));
X
X    for(ii = 0; ii < argc; ii++)   CheckFree(argv[ii]);
X    CheckFree(argv);
X
X    pushquote(F4glInterp[interpID].interp->result);
X    return 1;
X}
SHAR_EOF
if [ `wc -c < tcl4gl.c` -ne    10144 ]
then
    echo "Lengths do not match -- Bad Copy of tcl4gl.c"
fi
echo "Extracting file tcl4gl.h"
sed -e 's/^X//' <<\SHAR_EOF > tcl4gl.h
X/* tcl4gl.h
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    Tcl4gl library
X** File      :    Header file for Tcl4gl
X** Functions :
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tcl4gl/lib/RCS/tcl4gl.h $
X** $Revision: 1.2 $
X** $Date: 1993/11/02 13:24:26 $
X**
X** $Log: tcl4gl.h $
X** Revision 1.2  1993/11/02  13:24:26  bkuhn
X**   -- added Tcl_Startup
X**
X** Revision 1.1  1993/10/28  18:12:32  bkuhn
X**   -- installed version
X**
X** Revision 0.1  1993/08/23  18:59:08  bkuhn
X**   # initial version
X**
X*/
X#ifndef TCL4GL_H
X#define TCL4GL_H
X
X#define TCL_INTERP_MAX 20       /* arbitrary maximum number of Tcl_Interps */
X#define TCL_STRING_MAX 512      /* arbitrary maximum for Tcl string from 4gl */
X#define TCL_ARG_MAX    128      /* arbitrary maximum for args for startup */
X
X/*  function headers */
Xextern int tcl4gl_deleteinterp();
Xextern int tcl4gl_eval();
Xextern int tcl4gl_evalfile();
Xextern int tcl4gl_globaleval();
Xextern int tcl4gl_createinterp();
Xextern int tcl4gl_startup();
X
X#endif
SHAR_EOF
if [ `wc -c < tcl4gl.h` -ne     1467 ]
then
    echo "Lengths do not match -- Bad Copy of tcl4gl.h"
fi
echo "Extracting file tcl4glP.h"
sed -e 's/^X//' <<\SHAR_EOF > tcl4glP.h
X/* tcl4glP.h
X**
X**  Copyright (C) 1993 BALTIMORE RH TYPING Laboratory, Inc. All Rights Reserved
X**
X** Program   :    Tcl4gl library
X** File      :    Private header file for Tcl4gl
X** Functions :
X**
X** Written   :    Bradley M. Kuhn        Computer Systems Development, Inc.
X**   By                                  5916 Glenoak Ave.
X**                                       Baltimore, MD 21214-2009
X**                                       410-254-7060
X**
X** Written   :    BALTIMORE RH TYPING Laboratory, Inc.
X**   For          400 West Franklin Street
X**                Baltimore, MD 21201
X**                410-225-9595
X**
X** RCS        :
X** $Source: /usr5/src/tcl4gl/lib/RCS/tcl4glP.h $
X** $Revision: 1.2 $
X** $Date: 1993/12/30 16:50:54 $
X**
X** $Log: tcl4glP.h $
X** Revision 1.2  1993/12/30  16:50:54  bkuhn
X**   -- added Tcl4gl_Init support
X**
X** Revision 1.1  1993/10/28  18:12:47  bkuhn
X**   -- installed version
X**
X** Revision 0.1  1993/08/23  18:24:47  bkuhn
X**   # initial version
X**
X*/
X#ifndef TCL4GLP_H
X#define TCL4GLP_H
X
X#include "tcl4gl.h"
X
Xtypedef struct {
X    Tcl_Interp *interp;
X    bool inUse;
X} t_Tcl4glInterp;
X
X/* from hsTcl4gl.c */
X
Xextern int Tcl4gl_HsMessageCmd();
X
X/* from init.c */
Xextern int Tcl4gl_Init();
X
X#endif
SHAR_EOF
if [ `wc -c < tcl4glP.h` -ne     1242 ]
then
    echo "Lengths do not match -- Bad Copy of tcl4glP.h"
fi
echo "Extracting file test.4gl"
sed -e 's/^X//' <<\SHAR_EOF > test.4gl
Xdatabase patern
Xmain
X  define
X  tclInterpID int,
X  tclResult  char(60)
X
X  call Tcl4gl_CreateInterp() returning tclInterpID
X  call Tcl4gl_Startup(tclInterpID, "foo") returning tclResult
X  call Tcl4gl_DeleteInterp(tclInterpID)
Xend main
SHAR_EOF
if [ `wc -c < test.4gl` -ne      234 ]
then
    echo "Lengths do not match -- Bad Copy of test.4gl"
fi
echo "Done."
exit 0