NetNews Usenet Archive 1993 #3/NN_1993_3.iso/spool/comp/lang/tcl/2475

Text File | 1993-01-27 | 49.9 KB | 1,712 lines

Newsgroups: comp.lang.tcl
Path: sparky!uunet!eco.twg.com!twg.com!news
From: "David Herron" <[e-mail]>
Subject: interp module source
Message-ID: <[e-mail]>
Sensitivity: Personal
Encoding:  1692 TEXT , 4 TEXT
Sender: [e-mail] (USENET News System)
Conversion: Prohibited
Organization: The Wollongong Group, Inc., Palo Alto, CA
Conversion-With-Loss: Prohibited
Date: Tue, 26 Jan 1993 18:26:04 GMT
Lines: 1697

Since a couple people have asked for this (and a couple others have signed
up to the mailing list..) here it is.

NOTE: The code is also available by sending mail to [e-mail].
The commands are:

    To: [e-mail]
    Subject: archive-request files

Returns a list of all the files there.

    To: [e-mail]
    Subject: archive-request interp/interp.[ch] interp/README.interp
interp/fileBrowserC.tcl

Returns the interp source.

The server uses either the quoted printable or base64 encodings from MIME
for safe transmission.  Other software is available from the server
to decode either encoding.

qpdecode.sed
qpdecode.help

    A quoted-printable decoder written in sed.  This is incomplete
    but is enough for bootstrapping the following...

mimencode.tar.Z.uue

    A quoted-printable & base 64 decoder written in C.  The individual
    source files for this are separately retrievable as well.

Again, signing up to the mailing list is done with e-mail doing the
following:

    To: [e-mail]
    Subject: listserv subscribe interp

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    README.interp
#    interp.c
#    interp.h
#    fileBrowserC.tcl
# This archive created: Tue Jan 26 10:24:51 1993
export PATH; PATH=/bin:$PATH
echo shar: extracting "'README.interp'" '(7025 characters)'
if test -f 'README.interp'
then
    echo shar: will not over-write existing file "'README.interp'"
else
sed 's/^    X//' << \SHAR_EOF > 'README.interp'
    X.ds interp \fIinterp\fP
    X.ds tcl TCL
    X.TL
    XMultiple Interpreters in TCL
    X.br
    Xand
    X.br
    XObject Oriented Extensions to TCL
    X.AU
    XDavid S. Herron
    X.br
    X<[e-mail]>
    X.DA
    X.AB
    X.LP
    XIn one of the Usenix papers delivered by Dr. Ousterhout is a
    Xstatement to the effect that \*QInterpreters are light weight
    Xthings and programmers should feel free to make as many
    Xas s/he likes\*U.  Unfortunately there was no facilities in the
    XTCL language for manipulating interpreters.  Instead the only
    Xtools to manipulate them are C functions in the library.
    X
    XThis module, called \*[interp], provides access to multiple
    Xinterpreters from \*[tcl].  With it \*[tcl] programmers can create and
    Xdelete interpreters, and can execute commands or access variables in
    Xother interpreters.
    X
    XIn addition facilities are provided for doing Object Oriented
    XProgramming in \*[tcl].  Guidance in designing the facilities were
    Xtaken from \fIObject Oriented Design \s-2with applications\s+2\fP by
    XGrady Booch.
    X.AE
    X
    X.SH
    XCreating, deleting and interacting with interpreters
    X.LP
    X
    XCreating an interp is easy, simply type:
    X
    X.ce 1
    Xset var [interp new interpName]
    X
    XWhich creates a new interp (includes an interpretor) which can be
    Xreferred to either as `interpName' or `$var' (whichever strikes your
    Xfancy; `interp new' returns the name of the new interp structure).
    XThe object created is discussed more in fuller detail below.  This
    Xis just an introduction.
    X
    XThe name of the interp is registered as a command in, at least,
    Xthe namespace of the interpretor which created it.  This command
    Xevaluates the remainder of its command line and returns whatever
    Xthe result was.  For instance:
    X
    X.DS
    X\ \ \ \ \ interp new newInterp
    X\ \ \ \ \ newInterp set pwd \e[pwd\e]
    X\ \ \ \ \ newInterp set dl \e[split $pwd "/"\e]
    X\ \ \ \ \ set dl [newInterp -getVar dl ""]
    X.DE
    X
    XA bit nonsensical, but showed a couple of important points.
    XCreate a new interp and execute "set pwd [pwd]" over there.
    XBut there's \e's quoting the brackets.  This is to avoid
    Xexecuting the `pwd' command in the \fIcurrent\fP interpretor,
    Xbut to leave it for \fInewInterp\fP.  Quoting becomes very
    Ximportant and using the `{}' construct sometimes is important.
    XAn equivalent sequence is:
    X
    X.DS
    X\ \ \ \ \ interp new newInterp
    X\ \ \ \ \ newInterp {
    X\ \ \ \ \ \ \ \ \ \ set pwd [pwd]
    X\ \ \ \ \ \ \ \ \ \ set dl [split $pwd "/"]
    X\ \ \ \ \ }
    X\ \ \ \ \ set dl [newInterp -getVar dl ""]
    X.DE
    X
    XSome commands are created in the new interpretor.  One of particular
    Ximportance is that \fIexit\fP is replaced with one which destroys this
    Xinterpretor rather than exiting the process.
    X
    X.SH
    XIntroduction to O\-O extensions
    X.LP
    XMuch ado has been made about \fIObject Oriented Programming\fP
    Xrecently so there are many books on the subject.  The one I have been
    Xstudying is \fIObject Oriented Design \s-2with applications\s+2\fP by
    XGrady Booch.  It appears to be very good giving a very in depth
    Xdiscussion of what it is and how to use it.  Unfortunately it doesn't
    Xexplain the statement I've heard:
    X.CD
    X\fIObjects are poor mans closures.\fP
    X.DE
    XBe that as it may.  Early in the book is listed the conceptual
    Xframework necessary for an object oriented system.  These are:
    X\fBAbstraction\fP,
    X\fBEncapsulation\fP,
    X\fBModularity\fP,
    X\fBHierarchy\fP,
    X\fBTyping\fP,
    X\fBConcurrency\fP, and
    X\fBPersistence\fP.
    XOf these \*[interp] only implements the first four.
    X
    XThese terms mean:
    X
    X.IP Abstraction
    XIs the essential characteristics of an object which distinguish it
    Xfrom all others.  Provides crisply defined conceptual boundries.
    XPrimarily the actions the object performs rather than the data it
    Xholds.
    X
    X.IP Encapsulation
    XThis is supposed to be Information Hiding.  That is, holding details
    Xof implementation close to the chest so that other bits of software
    Xdon't depend on internal details.  Encapsulation is complementary to
    Xabstraction.  Abstraction is the view from outside the object while
    Xencapsulation is from the inside.  Things to be hidden are those which
    Xdon't contribute to its essential characteristics.
    X
    XUnfortunately \*[interp] and \*[tcl] do not allow for this to be
    Xcompletely carried out properly.  While it is more difficult to access
    Xthings in an interpreter, everything \fBis\fP available.
    X
    X.IP Modularity
    XThis is the unit of \fIphysical decomposition\fP.  That is, what
    Xpieces you break the problem down to.  Which is what \*[interp]
    Xis all about!
    X
    X.IP Hierarchy
    XThis builds on existing structure to create new things.  There
    Xare two sorts of inheritance, and both require a \fIclass\fP
    Xsystem to be present.  These are:
    X
    X.TS
    Xexpand allbox;
    Xl l.
    XSort of relationship    Sort of hierarchy
    X=
    XT{
    X\fIkind of\fP == \fIclass structure\fP
    XT}    T{
    Xinheritance - build on existing object
    XT}
    XT{
    X\fIpart of\fP == \fIobject structure\fP
    XT}    T{
    Xaggregation - build from many objects
    XT}
    X.TE
    X
    XWith \*[interp] one can create either sort of hierarchy.
    X
    X\fBInheritance: \fP The \fI-chainCommand\fP command creates
    Xa command in the interpretor executing it which pulls the same
    Xcommand from the other interpretor but executes that command
    Xwithin the local interpretor.  OK, that was probably a bit
    Xconfusing.  You have two interpretors, \fBcaller\fP and \fBtarget\fP.
    XIn caller you execute
    X
    X    -chainCommand target command-name
    X
    XThis creates \fIcommand-name\fP in caller.  When it executes, it is
    Xdone within caller's context (interp), but the actual function is
    Xretrieved from target's context (interp).
    X
    XThe intent is to create an interpretor which holds the definition
    Xfor objects of a particular class.  To create new instantiations
    Xof the class, a command \fInew\fP should be created.  It creates
    Xa new interpretor and then uses -chainCommand to link the necessary
    Xprocedures into the new interp.  If there are any values to create
    Xthere, then do so in \fInew\fP.
    X
    X\fBAggregation: \fP  This is when you make an object which contains
    Xother objects.  For instance, ...example...
    X
    X.IP Typing
    XNot necessarily the same concept as \fIclass\fP.  Definds what kinds
    Xof objects can be interchanged, and how it is done.
    X
    XSince TCL has no concept of data typing in the first place this
    Xdoesn't seem to have a place here.  Further, the objects one would
    Xcreate with \*[interp] are likely to be \fIlarge\fP, larger than
    Xone would normally do assignments with (for instance).
    X
    X.IP Concurrency
    XMulti threading ability.  Not entirely relavent to object oriented
    Xprogramming, but multi threading can make OOPing easier to accomplish.
    XThis feature distinguishes active objects from inactive ones.
    X
    XIt might be interesting to, at some time, fix a way to let each
    Xinterpretor be its own thread.  Some nifty/interesting abilities
    Xshould be possible that way.  We'll leave that to the future right
    Xnow.
    X
    X.IP Persistence
    XLive long and persist.  Persistent objects survive even after the
    Xprogram which created & held them exits.
    X
    XBut \*[interp] does not provide any facilities for persistent objects.
    XThe object itself may do it, that is up to the object.
    X
    X.SH
    X\fIinterp\fP command
    X.LP
    X
    X.SH
    XCommands in created interpretor
    X.LP
    X
    X.SH
    XCreating classes and objects
    X.LP
    X
SHAR_EOF
if test 7025 -ne "`wc -c < 'README.interp'`"
then
    echo shar: error transmitting "'README.interp'" '(should have been 7025
characters)'
fi
fi # end of overwriting check
echo shar: extracting "'interp.c'" '(27100 characters)'
if test -f 'interp.c'
then
    echo shar: will not over-write existing file "'interp.c'"
else
sed 's/^    X//' << \SHAR_EOF > 'interp.c'
    X/* $Id: interp.c,v 1.1 1993/01/25 06:32:12 david Exp $
    X *
    X * interp.c -- TCL Commands to create/delete/manipulate interpretors.
    X *
    X * AUTHOR:    David Herron <[e-mail]> (home)
    X *                 <[e-mail]>         (work)
    X *
    X * INTRO:
    X *
    X * In one of the Usenix papers delivered by Dr. Ousterhout is a
    X * statement to the effect that "Interpretors are light weight
    X * things and programmers should feel free to make as many
    X * as s/he likes".  Unfortunately there was no facilities in the
    X * TCL language for manipulating interpretors.  Instead the attributes
    X * of interpretors are not described very well, and the only
    X * tools to manipulate them are C functions in the library.
    X *
    X * This module is a first attempt at putting an interpretor facility
    X * into TCL.  It keeps a hash table of of {interp,name,destroyHook}
    X * tuples and provides a few TCL commands for manipulating them.
    X *
    X * Since each interpretor has its own namespace this is useful for
    X *
    X *    Creating `modules' with an pseudo-exported interface.
    X *
    X *    Allowing multiple Tk applications to be resident in
    X *    the same core image and have them all think their
    X *    main window is `.'.
    X *
    X *    A form of light-weight processes but with no scheduler
    X *    or preemption by other light weight processes.  This works
    X *    best with the `multiple Tk applications' concept above.
    X *
    X * My initial inspiration for creating this module was the
    X * multiple Tk applications in one core image.  It was thought
    X * up during a brainstorming session on a potential port of
    X * TCL/Tk to MS-DOG using X/DOS.  X/DOS creates a DOS program
    X * which makes the VGA screen look like an X session, but the
    X * X session only lasts for the existance of that one program.
    X *
    X * So the thought was to have a Tk script be a sort of application
    X * launcher.  It would need to be able to create new interpretors
    X * so that each launched application did not interfere with others
    X * and had `.' as its main window.  etc.
    X *
    X * Then an obvious application to have running is a `ps' which is
    X * constantly updated Tk scripts come and go.
    X *
    X * Another is a procedure/variable editor which pokes into other
    X * interpretors and allows the user to get/view/edit variables
    X * or procedures in other interpreters.  Of course you then have
    X * the problem of saving the procedures to disk when you're
    X * satisfied with 'em...
    X *
    X * As they say: The possibilities are endless ...
    X *
    X * PROBLEMS:
    X *
    X * The `interp eval' command prints the result directly to the users
    X * terminal AS WELL AS returning its value.  That is:
    X *
    X *    set val [otherInterp "set val"]
    X *
    X * Workaround: set val [otherInterp {return val}]
    X *
    X * is intended to retrieve `val' from otherInterp.  It does so, but
    X * the value of val is also printed on the screen.  This is probably
    X * because of the behaviour that a top-level `set' prints the value
    X * on the screen.  A possibility is to define a new command `setReturn'
    X * (or some such name) which all it does is set the interp's value.
    X *
    X * The new interpretor is stripped bare.  It isn't clear the
    X * right way to add commands which're C-coded application extensions to
    X * the interpretor.  Adding TCL code is trivial with the createHook.
    X *
    X * A possibility is to provide a library function for retrieving
    X * an interpretor info structure given its name.  Then a function
    X * can be written for each module of extensions which adds the
    X * C commands to that interpretor.  It might be hard, however, to
    X * find which interpretor has the C command in it which can add
    X * the C commands for a module to any interpretor.
    X *
    X * There is no possibility of sharing data or TCL commands between
    X * interpretors other than by passing things through `interp eval'.
    X *
    X * It is not clear that simply replacing the `exit' command
    X * will make things safe.  Nor that this is exactly the right
    X * thing to do.
    X *
    X * We are using TCL_STATIC for some return values below.  It isn't
    X * clear that this is safe.
    X *
    X * The following sequence core dumps:
    X *
    X *    interp manage goober; exit
    X *    -- Type any command.
    X *
    X * Workaround:
    X *
    X *    rename exit _exit; interp manage goober; rename _exit exit
    X *
    X *
    X * If an `interp' is encapsulating some TK widgets.  When the widgets
    X * are destroyed there isn't a clean way to get rid of the interp's.
    X * It would be helpful if widgets had a destroy callback.
    X *
    X * FUTURE:
    X *
    X * This implementation requires no changes to the `core' of TCL.
    X *
    X * COMMANDS:
    X *
    X * interp new name
    X *
    X *    Create a new interpretor, giving it the handle `name'.  The
    X *    interpreter is given the following attributes:
    X *
    X *        The `interp' command.
    X *
    X *        Its `exit' command replaced to simply delete itself
    X *        rather than exit the process.
    X *
    X *        Global variable `thisInterpretor' holding the name
    X *        of the interpretor.
    X *
    X *        A `-destroyHook' command.  This takes a command-string
    X *        which is executed at the beginning of the destruction
    X *        sequence.
    X *
    X *        If a CreateHook has been defined then it is executed.
    X *
    X *
    X *    All interpreter's interp commands have access to the same list
    X *    of interpretors.
    X *
    X * interp MainInterp
    X *
    X *    Registers the current interpreter as the "Main Interpreter".
    X *    The meaning is not currently implemented but ...
    X *
    X * interp result name
    X *
    X *    Returns the current result in the interpretor.  `eval' also
    X *    passes the result back.
    X *
    X * interp list
    X *
    X *    Return TCL list of all the current interpretors.
    X *
    X * interp exists name
    X *
    X *    Tests for existance of an interpretor by that name.  If it
    X *    exists, `1' is returned, otherwise `0'.  There can be only one
    X *    interpreter of a particular name.
    X *
    X * interp createHook command
    X *
    X *    Defines `command' to be the createHook which is executed
    X *    for every new interpretor.  If `command' is empty then
    X *    the createHook is forgotten.
    X *
    X * Some timing results:
    X *
    X * 1. Executing a command in local interpretor versus in a remote interp
    X *    versus in a remote interp but that interp relying on `unknown'
    X *    to find the command.
    X *
    X *
    X * setup:
    X *
    X *    wish: interp new nn
    X *    wish: interp MainInterp
    X *    wish: proc t {} { return }
    X *
    X * Establish baseline, execute command locally:
    X *
    X *    wish: time { for { set i 0 } {$i < 100000} {incr i} { t } }
    X *    21394279 microseconds per iteration
    X *
    X * Execute command remotely but rely on `unknown':
    X *
    X *    wish: time { for { set i 0 } {$i < 100000} {incr i} { nn t } }
    X *    33272622 microseconds per iteration
    X *
    X * Execute command remotely with `t' in there:
    X *
    X *    wish: nn { proc t {} { return } }
    X *    wish: time { for { set i 0 } {$i < 100000} {incr i} { nn t } }
    X *    27732659 microseconds per iteration
    X *
    X * Executing commands in the other interp costs 6.338 seconds extra (29%).
    X * Using `unknown' adds another 5.54 seconds beyond that (19%).
    X *
    X * (All this is as-of Jan 4, 1993) (This indicates we need to do
    X * some profile'ing to see what's going on).
    X *
    X * $Log: interp.c,v $
    X * Revision 1.1  1993/01/25  06:32:12  david
    X * Initial revisions of the interp module, documentation, and file browser.
    X *
    X *
    X */
    X
    X#include <stdlib.h>
    X#include <malloc.h>
    X#include <tclInt.h>
    X#include <tclHash.h>
    X#include "interp.h"
    X
    Xstatic int cmdInterp         _ANSI_ARGS_((ClientData *, Tcl_Interp *, int, char
**));
    Xstatic int cmdExitInterpCMD  _ANSI_ARGS_((ClientData *, Tcl_Interp *, int,
char **));
    Xstatic int cmdDoCMD         _ANSI_ARGS_((ClientData *, Tcl_Interp *, int, char
**));
    Xstatic int cmdDestroyHookCMD _ANSI_ARGS_((ClientData *, Tcl_Interp *, int,
char **));
    X/* static int cmdImportStuffCMD _ANSI_ARGS_((ClientData *, Tcl_Interp *, int,
char **)); */
    Xstatic int cmdChainCommand   _ANSI_ARGS_((ClientData *, Tcl_Interp *, int,
char **));
    Xstatic int cmdChainCommandHelper _ANSI_ARGS_((ClientData *, Tcl_Interp *, int,
char **));
    Xstatic int cmdImportGSetVar  _ANSI_ARGS_((ClientData *, Tcl_Interp *, int,
char **));
    Xstatic int cmdInterp         _ANSI_ARGS_((ClientData *, Tcl_Interp *, int,
char **));
    Xstatic int cmdUnknown        _ANSI_ARGS_((ClientData *, Tcl_Interp *, int,
char **));
    Xstatic int cmdSetParent      _ANSI_ARGS_((ClientData *, Tcl_Interp *, int,
char **));
    X
    Xextern Command *TclFindCmd _ANSI_ARGS_((    /* tclCmdQuery.c */
    X    Tcl_Interp *,         /* Interpreter in which to look. */
    X    char *));                /* Name of desired command. */
    X
    Xextern ClientData         TclClientData _ANSI_ARGS_((Command *));
    Xextern Tcl_CmdDeleteProc *TclDeleteProc _ANSI_ARGS_((Command *));
    Xextern Tcl_CmdProc       *TclCmdProc    _ANSI_ARGS_((Command *));
    X
    X
    Xstatic Tcl_HashTable iList;
    Xstatic short iListInited = (1==0);
    X
    Xstatic char *createHookText = (char *)NULL;
    X
    Xstatic Tcl_Interp *main_interp = (Tcl_Interp *)NULL;
    Xstatic struct interpInfo main_interp_info;
    X
    Xstatic char *nm_MainInterp = "MainInterp";
    X
    Xvoid init_interp(interp)
    XTcl_Interp *interp;
    X{
    X    Tcl_CreateCommand(interp, "interp", cmdInterp, (ClientData) NULL,
    X            (Tcl_CmdDeleteProc *) NULL);
    X    if (!iListInited) {
    X        memset(&main_interp_info, 0, sizeof(main_interp_info));
    X        Tcl_InitHashTable(&iList, TCL_STRING_KEYS);
    X        iListInited = (1==1);
    X    }
    X}
    X
    X/*
    X * Int_CreateInterp() -- Create one of our special interpreters.
    X */
    Xstruct interpInfo *Int_CreateInterp(interp, new_interp, name)
    XTcl_Interp *interp, *new_interp;
    Xchar *name;
    X{
    X    int new;
    X    Tcl_HashEntry *hPtr;
    X    struct interpInfo *info;
    X    char constCmd[128];
    X
    X    hPtr = Tcl_CreateHashEntry(&iList, name, &new);
    X    if (!new) {
    X        Tcl_AppendResult(interp, "ERROR: Already an interpretor named ",
    X                      name, ".", NULL);
    X        return (struct interpInfo *)NULL;
    X    }
    X
    X    if (!new_interp)
    X        new_interp = Tcl_CreateInterp();
    X    if (!new_interp) {
    X        Tcl_AppendResult(interp,
    X            "ERROR: Could not create interpretor for ", name, NULL);
    X        return (struct interpInfo *)NULL;
    X    }
    X
    X    info = (struct interpInfo *)malloc(sizeof(*info));
    X    memset(info, 0, sizeof(*info));
    X    Tcl_SetHashValue(hPtr, info);
    X    info->interp = new_interp;
    X    strncpy(info->name, name, sizeof(info->name));
    X
    X    /*
    X     * Give the new interpreter an `interp' command.
    X     * Also replace its exit command so we can free
    X     * everything up alright.
    X     */
    X/*
    X * Do we really need to do this?
    X *
    X    {
    X    Tcl_HashEntry *hp;
    X    Tcl_HashSearch hs;
    X    struct interpInfo *iinfo;
    X    for (hp = Tcl_FirstHashEntry(&iList, &hs);
    X         hp;
    X         hp = Tcl_NextHashEntry(&hs)) {
    X        iinfo = (struct interpInfo *)Tcl_GetHashValue(hp);
    X        Tcl_CreateCommand(iinfo->interp, info->name, cmdDoCMD,
    X                 (ClientData) info,
    X                     (Tcl_CmdDeleteProc *) NULL);
    X    }
    X    }
    X*/
    X    Tcl_CreateCommand(interp, info->name, cmdDoCMD,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X    Tcl_CreateCommand(info->interp, info->name, cmdDoCMD,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X    if (main_interp)
    X        Tcl_CreateCommand(main_interp, info->name, cmdDoCMD,
    X                 (ClientData) info,
    X                     (Tcl_CmdDeleteProc *) NULL);
    X
    X    Tcl_CreateCommand(info->interp, nm_MainInterp, cmdDoCMD,
    X             (ClientData) nm_MainInterp, NULL);
    X
    X    Tcl_CreateCommand(info->interp, "interp", cmdInterp,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X    Tcl_CreateCommand(info->interp, "exit", cmdExitInterpCMD,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X    Tcl_CreateCommand(info->interp, "-destroyHook", cmdDestroyHookCMD,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X    Tcl_CreateCommand(info->interp, "-getVar", cmdImportGSetVar,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X    Tcl_CreateCommand(info->interp, "-setVar", cmdImportGSetVar,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X    Tcl_CreateCommand(info->interp, "-unsetVar", cmdImportGSetVar,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X
    X/*
    X *    Tcl_CreateCommand(info->interp, "-import", cmdImportStuffCMD,
    X *             (ClientData) info,
    X *                 (Tcl_CmdDeleteProc *) NULL);
    X */
    X    Tcl_CreateCommand(info->interp, "-chainCommand", cmdChainCommand,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X
    X    Tcl_CreateCommand(info->interp, "-parentInterp", cmdSetParent,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X
    X    Tcl_CreateCommand(info->interp, "unknown", cmdUnknown,
    X             (ClientData) info,
    X                 (Tcl_CmdDeleteProc *) NULL);
    X
    X    /*
    X     * Set up the name of the interpretor.  Make it read-only.
    X     */
    X    Tcl_SetVar(interp, "thisInterpretor", info->name, TCL_GLOBAL_ONLY);
    X    sprintf(constCmd,
    X"set thisInterpretor {%s}; trace variable thisInterpretor w \"set
thisInterpretor {%s}\"; list",
    X        info->name, info->name);
    X    Tcl_GlobalEval(info->interp, constCmd, 0, (char *)NULL);
    X
    X    /*
    X     * The intention of the createHook is so the
    X     * new interpreters can be customized.
    X     */
    X    if (isstr(createHookText)) {
    X        Tcl_GlobalEval(info->interp, createHookText, 0,(char *)NULL);
    X    }
    X
    X    return info;
    X}
    X
    X/*
    X * Int_findInterp() -- Find the named interpretor info structure if
    X *    it exists.
    X *
    X * HACK: We recognize `MainInterp' as a special name and fake up
    X *     an info structure for it.
    X */
    Xstruct interpInfo *Int_findInterp(name)
    Xchar *name;
    X{
    X    Tcl_HashEntry *hPtr;
    X    struct interpInfo *info;
    X
    X    if (!isstr(name))
    X        return (struct interpInfo *)NULL;
    X
    X    if (strcmp(name, nm_MainInterp) == 0 && main_interp) {
    X        main_interp_info.interp = main_interp;
    X        return &main_interp_info;
    X    }
    X
    X    hPtr = Tcl_FindHashEntry(&iList, name);
    X    if (!hPtr)
    X        return (struct interpInfo *)NULL;
    X    info = (struct interpInfo *)Tcl_GetHashValue(hPtr);
    X    return info;
    X}
    X
    X/*
    X * Int_whoIs() -- Find the name for a particular interpretor.
    X */
    Xstruct interpInfo *Int_whoIs(interp)
    XTcl_Interp *interp;
    X{
    X    Tcl_HashEntry *hPtr;
    X    Tcl_HashSearch hs;
    X    struct interpInfo *info;
    X
    X    for (hPtr = Tcl_FirstHashEntry(&iList, &hs);
    X         hPtr;
    X         hPtr = Tcl_NextHashEntry(&hs)) {
    X        info = (struct interpInfo *)Tcl_GetHashValue(hPtr);
    X        if (info->interp == interp)
    X            return info;
    X    }
    X    return (struct interpInfo *)NULL;
    X}
    X
    X/*
    X * Int_delInterp() -- Clean up after an interpretor.
    X */
    Xvoid Int_delInterp(info)
    Xstruct interpInfo *info;
    X{
    X    Tcl_HashEntry *hPtr;
    X
    X    hPtr = Tcl_FindHashEntry(&iList, info->name);
    X
    X    {
    X    Tcl_HashEntry *hp;
    X    Tcl_HashSearch hs;
    X    struct interpInfo *iinfo;
    X    for (hp = Tcl_FirstHashEntry(&iList, &hs);
    X         hp;
    X         hp = Tcl_NextHashEntry(&hs)) {
    X        iinfo = (struct interpInfo *)Tcl_GetHashValue(hp);
    X        Tcl_DeleteCommand(iinfo->interp, info->name);
    X    }
    X    }
    X
    X    if (isstr(info->destroyHook)) {
    X        Tcl_GlobalEval(info->interp, info->destroyHook, 0, (char *)NULL);
    X        free(info->destroyHook);
    X    }
    X
    X    Tcl_DeleteInterp(info->interp);
    X    memset(info, 0, sizeof(*info));
    X    free(info);
    X    Tcl_DeleteHashEntry(hPtr);
    X}
    X
    X/*
    X * Int_ExecCommand() -- Execute a command (already parsed into argc/argv)
    X *    in another interpretor.  If we cannot find the command over there
    X *    attempt to execute `unknown' over there.
    X *
    X * HEAVILY derived from Tcl_Eval(), but we cannot call trace procedures.
    X */
    Xint Int_ExecCommand(this, other, argc, argv)
    XTcl_Interp *this, *other;
    Xint   argc;
    Xchar *argv[];
    X{
    X    int result = TCL_OK;                         /* Return value. */
    X    register Interp *iPtr = (Interp *) this;
    X    Command *cmdPtr;
    X    char **new_argv = (char **)NULL;
    X    int    new_argc = -1;
    X
    X    if (!other) {
    X        Tcl_AppendResult(this,
    X"ERROR: Int_ExecCommand() called with NULL `other' interpretor.", NULL);
    X        return TCL_ERROR;
    X    }
    X
    X    /*
    X     * This is taken from tclBasic.c:Tcl_Eval().
    X     *//*
    X         * Find the procedure to execute this command.  If there isn't
    X         * one, then see if there is a command "unknown".  If so,
    X         * invoke it instead, passing it the words of the original
    X         * command as arguments.
    X         */
    X    cmdPtr = TclFindCmd(other, argv[0]);
    X    if (cmdPtr == (Command *)NULL) {
    X        int i;
    X
    X        cmdPtr = TclFindCmd(this, "unknown");
    X        if (cmdPtr == (Command *)NULL) {
    X            Tcl_ResetResult(this);
    X            Tcl_AppendResult(this, "ERROR: invalid command name: \"",
    X                argv[0], "\"", (char *) NULL);
    X            result = TCL_ERROR;
    X            goto done;
    X        }
    X        new_argc = argc + 1;
    X        new_argv = (char **)malloc((new_argc+1) * sizeof(char *));
    X        new_argv[0] = "unknown";
    X        for (i = 0; i < new_argc; i++) {
    X            new_argv[i+1] = argv[i];
    X        }
    X        }
    X
    X    /*
    X     * Call trace procedures, if any.
    X     *//*
    X     * ... We can't do trace procedures since the original
    X     * ... command line isn't available.
    X     */
    X
    X        /*
    X         * At long last, invoke the command procedure.  Reset the
    X         * result to its default empty value first (it could have
    X         * gotten changed by earlier commands in the same command
    X         * string).
    X         */
    X        iPtr->cmdCount++;
    X        Tcl_FreeResult(iPtr);
    X        iPtr->result = iPtr->resultSpace;
    X        iPtr->resultSpace[0] = 0;
    X        result = (*(TclCmdProc(cmdPtr)))(TclClientData(cmdPtr), this,
    X                    new_argv ? new_argc : argc,
    X                    new_argv ? new_argv : argv);
    X    /* fall through */
    Xdone:
    X    if (new_argv) free(new_argv);
    X    return result;
    X}
    X
    Xvoid Int_copyErrorInfo(src, dest)
    Xstruct interpInfo *src;
    XTcl_Interp *dest;
    X{
    X    char msbuf[60];
    X    char *errorInfo = Tcl_GetVar(src->interp, "errorInfo", TCL_LEAVE_ERR_MSG);
    X    if (!isstr(errorInfo)) return;
    X
    X    sprintf(msbuf, "    ----> Copied from interpretor %s\n", src->name);
    X    Tcl_AddErrorInfo(dest, msbuf);
    X    Tcl_AddErrorInfo(dest, errorInfo);
    X    sprintf(msbuf, "\n    <---- End of copy from interpretor %s", src->name);
    X    Tcl_AddErrorInfo(dest, msbuf);
    X}
    X
    Xstatic int cmdExitInterpCMD(clientData, interp, argc, argv)
    X    ClientData *clientData;
    X    Tcl_Interp *interp;
    X    int argc;
    X    char *argv[];
    X{
    X    Tcl_DeleteCommand(interp, ((struct interpInfo *)clientData)->name);
    X    Int_delInterp((struct interpInfo *)clientData);
    X    return TCL_OK;
    X}
    X
    X/*
    X *----------------------------------------------------------------------
    X *
    X * cmdDoCMD --
    X *
    X *      Given a variable number of string arguments, concatenate them
    X *      all together and execute the result as a Tcl command in the
    X *    interpreter passed in clientData.  This routine is taken
    X *    DIRECTLY from tclBasic.c:Tcl_VarEval().
    X *
    X *    It would be nice if TCL internals offered a Tcl_xxxEval()
    X *    which took an argv/argc.  That way we could avoid some
    X *    needless malloc()ing & parsing.
    X *
    X * Results:
    X *      A standard Tcl return result.  An error message or other
    X *      result may be left in interp->result.
    X *
    X * Side effects:
    X *      Depends on what was done by the command.
    X *
    X *----------------------------------------------------------------------
    X */
    Xstatic int cmdDoCMD(clientData, interp, argc, argv)
    X    ClientData *clientData;
    X    Tcl_Interp *interp;
    X    int argc;
    X    char *argv[];
    X{
    X    struct interpInfo *info;
    X    char *cmd;
    X    int result;
    X
    X    if (clientData != nm_MainInterp)
    X        info = (struct interpInfo *)clientData;
    X    else
    X        info = Int_findInterp(nm_MainInterp);
    X
    X    cmd = Tcl_Merge(argc - 1, &(argv[1]));
    X    if (cmd && cmd[0] == '{') {
    X
    X        /*
    X         * Remove the {}'s if they're there.
    X         */
    X        register char *p;
    X        for (p = cmd; p[0] != '\0'; p++)
    X            p[0] = p[1];
    X        if (p > cmd) {
    X            while (p[0] == '\0') p--;
    X            while (p[0] == ' ' || p[0] == '\t') {
    X                p[0] = '\0';
    X                p--;
    X            }
    X            if (p[0] == '}') p[0] = '\0';
    X        }
    X    }
    X
    X    result = Tcl_Eval(info->interp, cmd, 0, (char **)NULL);
    X    if (cmd) ckfree(cmd);
    X
    X    /*
    X     * If the Eval deleted the interpretor then
    X     * info->interp will be NULL.
    X     */
    X    if (info->interp) {
    X        if (result != TCL_OK)
    X            Int_copyErrorInfo(info, interp);
    X        Tcl_SetResult(interp, info->interp->result, TCL_STATIC);
    X    }
    X
    X    return result;
    X}
    X
    X/*
    X * USAGE:    -destroyHook ?command?
    X *
    X * Manipulates the command string executed just before
    X * destruction of the interpreter.
    X */
    Xstatic int cmdDestroyHookCMD(clientData, interp, argc, argv)
    XClientData *clientData;
    XTcl_Interp *interp;
    Xint argc;
    Xchar *argv[];
    X{
    X    struct interpInfo *info = (struct interpInfo *)clientData;
    X
    X    if (isstr(info->destroyHook)) free(info->destroyHook);
    X    info->destroyHook = (char *)NULL;
    X    if (isstr(argv[1])) info->destroyHook = strdup(argv[1]);
    X
    X    return TCL_OK;
    X}
    X
    X/*
    X * USAGE:    -getVar name1 name2
    X *
    X * Gets the value of a variable from another interpretor.
    X *
    X * USAGE:    -setVar name1 name2 value
    X *
    X * Sets the value of a variable in another interpretor.
    X *
    X * USAGE:    -unsetVar name1 name2
    X *
    X * Gets rid of (unset) a variable in another interpretor.
    X */
    Xstatic int cmdImportGSetVar(clientData, interp, argc, argv)
    XClientData *clientData;
    XTcl_Interp *interp;
    Xint argc;
    Xchar *argv[];
    X{
    X    struct interpInfo *info = (struct interpInfo *)clientData;
    X    char *res;
    X
    X    switch (argv[0][1]) {
    X    case 'g':
    X        if (argc != 3) {
    X            Tcl_AppendResult(interp, "USAGE: -getVar name1 name2", NULL);
    X            return TCL_ERROR;
    X        }
    X        res = Tcl_GetVar2(info->interp, argv[1], argv[2], TCL_LEAVE_ERR_MSG);
    X        break;
    X
    X    case 's':
    X        if (argc != 4) {
    X            Tcl_AppendResult(interp, "USAGE: -setVar name1 name2 value", NULL);
    X            return TCL_ERROR;
    X        }
    X        res = Tcl_SetVar2(info->interp, argv[1], argv[2], argv[3],
TCL_LEAVE_ERR_MSG);
    X        break;
    X
    X    case 'u':
    X        if (argc != 4) {
    X            Tcl_AppendResult(interp, "USAGE: -unsetVar name1 name2", NULL);
    X            return TCL_ERROR;
    X        }
    X        return Tcl_UnsetVar2(info->interp, argv[1], argv[2], TCL_LEAVE_ERR_MSG);
    X        break;
    X    default:
    X    }
    X
    X
    X    if (isstr(res)) {
    X        Tcl_SetResult(interp, res, TCL_VOLATILE);
    X        return TCL_OK;
    X    }
    X    else
    X        return TCL_ERROR;
    X}
    X
    X/*
    X * USAGE:    -importCommand otherInterp function
    X *
    X * Imports copies of objects from other interpretors.
    X *
    X * IMPLEMENTATION: Look up the named interpreter.  We need to
    X * know internals.  Step through its hash table and duplicate
    X * everything we see.  As a side effect this should replace
    X * anything things already existing locally but with names
    X * conflicting with what is imported.
    X *
    X * Once we've duplicated the thing, it is completely independant
    X * from the original.
    X */
    X/*
    X * static int cmdImportStuffCMD(clientData, interp, argc, argv)
    X * ClientData *clientData;
    X * Tcl_Interp *interp;
    X * int argc;
    X * char *argv[];
    X * {
    X *     return TCL_OK;
    X * }
    X */
    X
    X/*
    X * cmdChainCommandHelper() -- Do the work of executing the command
    X *    in the interpretor named in the -chainCommand command.
    X *
    X * Also used to support MainInterp command.
    X */
    Xstatic int cmdChainCommandHelper(clientData, interp, argc, argv)
    XClientData *clientData;
    XTcl_Interp *interp;
    Xint argc;
    Xchar *argv[];
    X{
    X    struct interpInfo *info;
    X
    X    info = Int_findInterp((char *)clientData);
    X    if (!info) {
    X        Tcl_AppendResult(interp, "ERROR: Could not find interpretor '",
    X            (char *)clientData, "'.", NULL);
    X        return TCL_ERROR;
    X    }
    X    return Int_ExecCommand(interp, info->interp, argc, argv);
    X}
    X
    X/*
    X * USAGE:    -chainCommand otherInterp function
    X *
    X * Makes a link to command in another interpretor.
    X *
    X * IMPLEMENTATION: Looks up the named interpretor.  We must
    X * know the internals.  Steps through the hash table and for
    X * every object does:
    X *
    X *    FUNCTION: Creates a command pointing at a C function
    X *        to be written in this module.  The function looks
    X *        up the interpreter then eval's the command over
    X *        there.  It returns the ->result of that interpreter.
    X *
    X */
    Xstatic int cmdChainCommand(clientData, interp, argc, argv)
    XClientData *clientData;
    XTcl_Interp *interp;
    Xint argc;
    Xchar *argv[];
    X{
    X/*    struct interpInfo *info = (struct interpInfo *)clientData;*/
    X    struct interpInfo *other = (struct interpInfo *)NULL;
    X
    X    if (argc != 3) {
    X        Tcl_AppendResult(interp, "USAGE: -chainCommand otherInterp function",
    X            NULL);
    X        return TCL_ERROR;
    X    }
    X
    X    other = Int_findInterp(argv[1]);
    X    if (!other) {
    X        Tcl_AddErrorInfo(interp, "    While executing '-chainCommand'");
    X        return TCL_ERROR;
    X    }
    X
    X    Tcl_CreateCommand(interp, argv[2], cmdChainCommandHelper,
    X            strdup(argv[1]), free);
    X    return TCL_OK;
    X}
    X
    X
    X/*
    X * USAGE:    unknown command
    X *
    X * Version of `unknown' which
    X *
    X *
    X */
    Xstatic int cmdUnknown(clientData, interp, argc, argv)
    XClientData *clientData;
    XTcl_Interp *interp;
    Xint argc;
    Xchar *argv[];
    X{
    X    struct interpInfo *info = (struct interpInfo *)clientData;
    X    struct interpInfo *other = (struct interpInfo *)NULL;
    X
    X    if (isstr(info->parent)) {
    X        other = Int_findInterp(info->parent);
    X        if (TclFindCmd(other->interp, argv[1]))
    X            return Int_ExecCommand(interp, other->interp, argc-1, argv+1);
    X    }
    X
    X    if (main_interp && TclFindCmd(main_interp, argv[1]))
    X        return Int_ExecCommand(interp, main_interp, argc-1, argv+1);
    X
    X    Tcl_ResetResult(interp);
    X    Tcl_AppendResult(interp, "ERROR: Cannot pass command \"",
    X                argv[1], "\" to any interpretor.", (char *) NULL);
    X    return TCL_ERROR;
    X}
    X
    X
    X/*
    X * USAGE:    -parentInterp name
    X *
    X */
    Xstatic int cmdSetParent(clientData, interp, argc, argv)
    XClientData *clientData;
    XTcl_Interp *interp;
    Xint argc;
    Xchar *argv[];
    X{
    X    struct interpInfo *info = (struct interpInfo *)clientData;
    X
    X    if (argc < 1 || argc > 2) {
    X        Tcl_AppendResult(interp, "USAGE: -parentInterp name", NULL);
    X        return TCL_ERROR;
    X    }
    X
    X    /*
    X     * If there's only one arg they're asking for the name of the parent.
    X     */
    X    if (argc == 1) {
    X        Tcl_SetResult(interp, info->parent, TCL_STATIC);
    X        return TCL_OK;
    X    }
    X
    X    /*
    X     * If it's a NULL string they wanna dissasociate them.
    X     */
    X    if (!isstr(argv[1]))
    X        info->parent[0] = '\0';
    X    else
    X        strncpy(info->parent, argv[1], sizeof(info->parent));
    X
    X    return TCL_OK;
    X}
    X
    Xstatic int cmdInterp(clientData, interp, argc, argv)
    XClientData *clientData;
    XTcl_Interp *interp;
    Xint argc;
    Xchar *argv[];
    X{
    X    Tcl_HashEntry *hPtr;
    X    struct interpInfo *info;
    X
    X
    X
    X    Tcl_ResetResult(interp);
    X
    X    if (argc < 2) {
    X        Tcl_AppendResult(interp, "USAGE: interp
new|MainInterp|exists|list|createHook",
    X            NULL);
    X        return TCL_ERROR;
    X    }
    X
    X    /*
    X     * interp new name
    X     */
    X    if (argv[1][0] == 'n' && strcmp(argv[1], "new") == 0) {
    X        if (!isstr(argv[2])) goto no_interp_name_given;
    X        info = Int_CreateInterp(interp, (Tcl_Interp *)NULL, argv[2]);
    X        if (!info) {
    X            Tcl_AddErrorInfo(interp, "   While executing 'interp new'");
    X            return TCL_ERROR;
    X        }
    X        else return TCL_OK;
    X    }
    X
    X    /*
    X     * interp mainInterp
    X     */
    X    if (argv[1][0] == nm_MainInterp[0] && strcmp(argv[1], nm_MainInterp) == 0) {
    X        main_interp = interp;
    X        return TCL_OK;
    X    }
    X
    X    /*
    X     * interp exists name
    X     */
    X    else if (argv[1][0] == 'e' && strcmp(argv[1], "exists") == 0) {
    X        if (!isstr(argv[2])) goto no_interp_name_given;
    X        info = Int_findInterp(argv[2]);
    X        if (info)
    X            Tcl_SetResult(interp, "1", TCL_STATIC);
    X        else
    X            Tcl_SetResult(interp, "0", TCL_STATIC);
    X        return TCL_OK;
    X    }
    X
    X    /*
    X     * interp list
    X     */
    X    else if (argv[1][0] == 'l' && strcmp(argv[1], "list") == 0) {
    X        Tcl_HashSearch hs;
    X        for (hPtr = Tcl_FirstHashEntry(&iList, &hs);
    X             hPtr;
    X             hPtr = Tcl_NextHashEntry(&hs)) {
    X            Tcl_AppendElement(interp, Tcl_GetHashKey(&iList, hPtr), 0);
    X        }
    X        if (main_interp)
    X            Tcl_AppendElement(interp, "MainInterp");
    X        return TCL_OK;
    X    }
    X
    X    /*
    X     * interp createHook command
    X     */
    X    else if (argv[1][0] == 'c' && strcmp(argv[1], "createHook") == 0) {
    X        if (createHookText) free(createHookText);
    X        if (isstr(argv[2]))
    X            createHookText = strdup(argv[2]);
    X        else
    X            createHookText = (char *)NULL;
    X        return TCL_OK;
    X    }
    X
    X    /*
    X     * interp result name
    X     */
    X    else if (argv[1][0] == 'r' && strcmp(argv[1], "result") == 0) {
    X        if (!isstr(argv[2])) goto no_interp_name_given;
    X        info = Int_findInterp(argv[2]);
    X        if (!info) {
    X            Tcl_AppendResult(interp, "ERROR: Could not find interpreter '",
    X                argv[2], "'.", NULL);
    X            return TCL_ERROR;
    X        }
    X
    X        Tcl_SetResult(interp, info->interp->result, TCL_STATIC);
    X        return TCL_OK;
    X    }
    X
    X    Tcl_AppendResult(interp, "ERROR: Unknown interp subcommand: ",
    X                argv[1], NULL);
    X    return TCL_ERROR;
    X
    Xno_interp_name_given:
    X    Tcl_AppendResult(interp, "USAGE: ", argv[0], " ", argv[1], " interp-name",
    X                    NULL);
    X    return TCL_ERROR;
    X}
    X
SHAR_EOF
if test 27100 -ne "`wc -c < 'interp.c'`"
then
    echo shar: error transmitting "'interp.c'" '(should have been 27100
characters)'
fi
fi # end of overwriting check
echo shar: extracting "'interp.h'" '(1550 characters)'
if test -f 'interp.h'
then
    echo shar: will not over-write existing file "'interp.h'"
else
sed 's/^    X//' << \SHAR_EOF > 'interp.h'
    X/* $Id: interp.h,v 1.1 1993/01/25 06:32:11 david Exp $
    X * interp.h -- Definitions for interp module.
    X *
    X * PUBLIC FUNCTIONS:
    X *
    X * Int_CreateInterp(interp, name) -- Create a new one of these interpretors.
    X *    Returns `struct interpInfo' or NULL if it could not be created.
    X *
    X * Int_findInterp(name) -- Finds the interpInfo matching the name.  If
    X *    none, then return NULL;
    X *
    X * Int_whoIs(interp) -- Finds the interpInfo matching a TCL interpretor.
    X *
    X * Int_delInterp(info) -- Deletes all the information associated with
    X *    one of these interpretors.  First runs the destroyHook if
    X *    there is one.
    X *
    X *
    X * $Log: interp.h,v $
    X * Revision 1.1  1993/01/25  06:32:11  david
    X * Initial revisions of the interp module, documentation, and file browser.
    X *
    X *
    X */
    X
    X#ifndef __INTERP_H__DSH__
    X#define __INTERP_H__DSH__
    X
    X
    X#ifndef isstr
    X#define isstr(s) ((s) && (s)[0])
    X#endif
    X
    X#define INT_NAME_LEN    20
    X
    Xstruct interpInfo {
    X    Tcl_Interp *interp;
    X    char        name[INT_NAME_LEN];
    X    char        parent[INT_NAME_LEN];
    X    char       *destroyHook;
    X};
    X
    Xextern void init_interp _ANSI_ARGS_((Tcl_Interp *));
    Xextern struct interpInfo *Int_CreateInterp _ANSI_ARGS_((Tcl_Interp *,
Tcl_Interp *, char *));
    Xextern struct interpInfo *Int_findInterp _ANSI_ARGS_((char *));
    Xextern struct interpInfo *Int_whoIs _ANSI_ARGS_((Tcl_Interp *));
    Xextern void Int_delInterp _ANSI_ARGS_((Tcl_Interp *));
    Xextern int Int_ExecCommand _ANSI_ARGS_((Tcl_Interp *, Tcl_Interp *, int, char
*));
    Xextern void Int_copyErrorInfo _ANSI_ARGS_((struct interpInfo *, Tcl_Interp
*));
    X
    X#endif /* __INTERP_H__DSH__ */
SHAR_EOF
if test 1550 -ne "`wc -c < 'interp.h'`"
then
    echo shar: error transmitting "'interp.h'" '(should have been 1550 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'fileBrowserC.tcl'" '(8616 characters)'
if test -f 'fileBrowserC.tcl'
then
    echo shar: will not over-write existing file "'fileBrowserC.tcl'"
else
sed 's/^    X//' << \SHAR_EOF > 'fileBrowserC.tcl'
    X
    X# $Id: fileBrowserC.tcl,v 1.1 1993/01/25 06:32:14 david Exp $
    X# fileBrowserC.tcl - File Browser class definition.
    X#
    X# AUTHOR: David Herron <[e-mail] (home)>, <[e-mail] (work)>
    X#
    X# $Log: fileBrowserC.tcl,v $
    X# Revision 1.1  1993/01/25  06:32:14  david
    X# Initial revisions of the interp module, documentation, and file browser.
    X#
    X#
    X#
    X# The file browser continually presents the contents of a particular
    X# directory, with the goal of selecting a file.  The user is able to
    X# change the current directory at will.  The current list of files can
    X# be limited with a pattern, and the pattern can be modified at any
    X# time by the user.  Once a file is selected the browser goes away,
    X# and calls the okCommand.  The cancel button calls cancelCommand, and
    X# the help button calls helpCommand.
    X#
    X# Each place where a path name is shown there are two entry
    X# boxes.  One for the path component, and the other for
    X# the file component.  Two such places are shown, one for
    X# the current directory and file pattern.  The other for
    X# the last selected file.
    X#
    X# METHODS:
    X#
    X# new
    X#
    X#    Create a new fileBrowser instance.
    X#
    X# delete
    X#
    X#    Delete a fileBrowser.
    X#
    X# MakeWidgets
    X#
    X#    Create the visual components.
    X#
    X# setDirectory dirString
    X#
    X#    Change directory to the named one.  If dirString ends in ".."
    X#    then go to the parent.
    X#
    X# changeDirectory
    X#
    X#    Changes directory to the one stored in $dirEntry.  Finds
    X#    the files matching the pattern in $patEntry.  Displays
    X#    all directories there in the directory list, and all matching
    X#    files in the file list.
    X#
    X# setPattern newpat
    X#
    X#    Sets the text in $patEntry.
    X#
    X# setFile file
    X#
    X#    Sets the selected file to be the path from the current
    X#    directory, and the file name passed in.
    X#
    X#
    X
    Xif ![interp exists FileBrowserClass] {
    X
    Xinterp new FileBrowserClass
    X
    XFileBrowserClass {
    X
    Xproc new {} {
    X    global fileb_count
    X    if ![info exists fileb_count] {set fileb_count 0}
    X    incr fileb_count
    X    set name "fileb$fileb_count"
    X    interp new $name
    X
    X    foreach cmd {    new delete MakeWidgets isModal setDirectory
    X            changeDirectory
    X            setPattern setFile rescan getDirectory
    X            getPattern getFile doubleCommand okCommand
    X            cancelCommand helpCommand
    X        } { $name -chainCommand FileBrowserClass $cmd }
    X
    X    return $name
    X}
    X
    Xproc delete {} { exit }
    X
    Xproc MakeWidgets top {
    X    global topFrame patFrame lstFrame filFrame cmdFrame \
    X        patLabel dirEntry slashLabel patEntry \
    X        dirList dirScroll filList filScroll \
    X        filLabel pathEntry filslashLabel filEntry \
    X        okBtn canBtn travBtn hlpBtn
    X
    X    global thisInterpretor
    X
    X    set topFrame ${top}
    X    set patFrame ${top}.pat
    X    set lstFrame ${top}.lst
    X    set filFrame ${top}.fil
    X    set cmdFrame ${top}.cmd
    X
    X    MainInterp frame $topFrame
    X    MainInterp frame $patFrame
    X    MainInterp frame $lstFrame
    X    MainInterp frame $filFrame
    X    MainInterp frame $cmdFrame
    X    MainInterp pack append  $topFrame \
    X                $patFrame {top fillx} \
    X                $lstFrame {top fill expand} \
    X                $filFrame {top fillx} \
    X                $cmdFrame {top fillx}
    X
    X    set patLabel   ${patFrame}.l
    X    set dirEntry   ${patFrame}.dir
    X    set slashLabel ${patFrame}.slash
    X    set patEntry   ${patFrame}.pat
    X
    X    MainInterp label $patLabel -text "Pattern"
    X    MainInterp entry $dirEntry
    X    MainInterp label $slashLabel -text "/"
    X    MainInterp entry $patEntry
    X    MainInterp pack append  $patFrame \
    X                $patLabel   {left fillx} \
    X                $dirEntry   {left fillx expand} \
    X                $slashLabel {left fillx} \
    X                $patEntry   {left fillx expand}
    X
    X    set dirList    ${lstFrame}.dl
    X    set dirScroll    ${lstFrame}.ds
    X    set filList    ${lstFrame}.fl
    X    set filScroll    ${lstFrame}.fs
    X
    X    MainInterp scrollbar $dirScroll -command        "$dirList   yview"
    X    MainInterp listbox   $dirList     -yscrollcommand "$dirScroll set"
    X    MainInterp scrollbar $filScroll -command        "$filList   yview"
    X    MainInterp listbox   $filList     -yscrollcommand "$filScroll set"
    X
    X    MainInterp pack append  $lstFrame \
    X                $dirList   {left fill expand} \
    X                $dirScroll {left filly} \
    X                $filList   {left fill expand} \
    X                $filScroll {left filly}
    X
    X    set filLabel ${filFrame}.l
    X    set pathEntry ${filFrame}.p
    X    set filslashLabel ${filFrame}.sl
    X    set filEntry ${filFrame}.e
    X
    X    MainInterp label $filLabel -text "File"
    X    MainInterp entry $pathEntry
    X    MainInterp label $filslashLabel -text "/"
    X    MainInterp entry $filEntry
    X    MainInterp pack append  $filFrame \
    X                $filLabel {left fillx} \
    X                $pathEntry {left fillx expand} \
    X                $filslashLabel {left fillx} \
    X                $filEntry {left fillx expand}
    X
    X    set okBtn   ${cmdFrame}.ok
    X    set canBtn  ${cmdFrame}.can
    X    set travBtn ${cmdFrame}.trav
    X    set hlpBtn  ${cmdFrame}.hlp
    X
    X    MainInterp button $okBtn   -text "OK" \
    X                   -command "$thisInterpretor okCommand"
    X    MainInterp button $canBtn  -text "Cancel" \
    X                   -command "$thisInterpretor cancelCommand"
    X    MainInterp button $travBtn -text "Change Directory" \
    X                   -command "$thisInterpretor changeDirectory"
    X    MainInterp button $hlpBtn  -text "Help" \
    X                   -command "$thisInterpretor helpCommand"
    X
    X    MainInterp pack append  $cmdFrame \
    X                $okBtn   {left fillx expand} \
    X                $canBtn  {left fillx expand} \
    X                $travBtn {left fillx expand} \
    X                $hlpBtn  {left fillx expand}
    X
    X
    X    bind $dirEntry <Return> "$thisInterpretor {
    X            setDirectory \[$dirEntry get\]
    X            changeDirectory
    X        }
    X        $travBtn flash
    X        "
    X    bind $patEntry <Return> \
    X        "$thisInterpretor changeDirectory; $travBtn flash"
    X
    X    bind $filEntry <Return> \
    X        "$okBtn flash; update; $thisInterpretor okCommand"
    X
    X
    X    # Override the unaddorned <1> bindings so that we get
    X    # notified of any clicks.  This unfortunately means that
    X    # if the default binding were to change we'd have to be
    X    # aware of that and change it here.
    X
    X    MainInterp bind $dirList <1> "
    X        %W select from \[%W nearest %y\]
    X        $thisInterpretor setDirectory \
    X            \[%W get \[lindex \[%W curselection\] 0\]\]
    X    "
    X    MainInterp bind $dirList <Double-Button-1> "
    X        %W select from \[%W nearest %y\]
    X        $thisInterpretor setDirectory \
    X            \[%W get \[lindex \[%W curselection\] 0\]\]
    X        $thisInterpretor changeDirectory
    X        $travBtn flash
    X    "
    X    MainInterp bind $filList <1> "
    X        %W select from \[%W nearest %y\]
    X        $thisInterpretor setFile \
    X            \[%W get \[lindex \[%W curselection\] 0\]\]
    X    "
    X    MainInterp bind $filList <Double-Button-1> "
    X        %W select from \[%W nearest %y\]
    X        $thisInterpretor setFile \
    X            \[%W get \[lindex \[%W curselection\] 0\]\]
    X        $thisInterpretor okCommand
    X    "
    X
    X    return $topFrame
    X}
    X
    X# setDirectory - Set the given directory into $dirEntry.  If the last
    X# component is ".." then strip it & its parent off.  If the length of
    X# the whole thing is too short when stripping away the ".."  then assume
    X# we've gone to/through the root and change to `/'.
    X#
    X# If the first component is "." then we expand that to be [pwd].
    X#
    X# BUG(let): If the string is something weird (like `a/..') then
    X# the result is `/'.
    X
    X
    Xproc setDirectory dir {
    X    global dirEntry
    X catch {MainInterp $dirEntry delete 0 end}
    X    set dl [split $dir "/"]
    X    if {[lindex $dl 0] == "."} {
    X        set s [split [pwd] "/"]
    X        foreach d [lrange $dl 1 end] {lappend s $d}
    X        set dl $s
    X        set dlen [llength $dl]
    X        set dir "/[join [lrange $dl 1 [expr $dlen-1]] /]"
    X    } else {
    X        set dlen [llength $dl]
    X    }
    X    if {[lindex $dl [expr $dlen-1]] == ".."} {
    X        if {$dlen <= 3} {
    X            set dir "/"
    X        } else {
    X            set dir "/[join [lrange $dl 1 [expr $dlen-3]] /]"
    X        }
    X    }
    X    MainInterp $dirEntry insert end $dir
    X}
    X
    Xproc changeDirectory {} {
    X    global dirEntry patEntry dirList filList
    X
    X    set newDir  [MainInterp $dirEntry get]
    X    set pattern [MainInterp $patEntry get]
    X
    X    if {[catch {set list [glob "${newDir}/*"]}] != 0} {
    X            set list ""
    X    }
    X    if {$newDir == "/"} {
    X        set dirs [list "/.."]
    X    } else {
    X        set dirs [list "$newDir/.."]
    X    }
    X    set files ""
    X    foreach f $list {
    X        if {[file isdirectory $f]}      {
    X            lappend dirs  $f
    X            continue
    X        }
    X        if {[string match $pattern $f]} {
    X            set fl [split $f "/"]
    X            # This should've been just [lindex $fl end]
    X            set end [expr [llength $fl]-1]
    X            lappend files [lindex $fl $end]
    X        }
    X    }
    X
    X    catch         {MainInterp $dirList delete 0 end}
    X    foreach d $dirs  {MainInterp $dirList insert end $d}
    X    catch          {MainInterp $filList delete 0 end}
    X    foreach f $files {MainInterp $filList insert end $f}
    X}
    X
    Xproc setPattern newpat {
    X    global patEntry
    X catch {MainInterp $patEntry delete 0 end}
    X    MainInterp $patEntry insert end $newpat
    X    changeDirectory
    X}
    X
    Xproc setFile file {
    X    global filEntry pathEntry dirEntry
    X catch {MainInterp $filEntry delete 0 end}
    X    MainInterp $filEntry insert end $file
    X catch {MainInterp $pathEntry delete 0 end}
    X    MainInterp $pathEntry insert end [MainInterp $dirEntry get]
    X}
    X
    X# proc getDirectory {} {
    X# }
    X
    X# proc getPattern {} {
    X# }
    X
    X# proc getFile {} {
    X# }
    X
    Xproc okCommand {} {
    X}
    X
    Xproc cancelCommand {} {
    X}
    X
    Xproc helpCommand {} {
    X}
    X
    X}
    X}
    X# END: if ![interp exists FileBrowserClass]
SHAR_EOF
if test 8616 -ne "`wc -c < 'fileBrowserC.tcl'`"
then
    echo shar: error transmitting "'fileBrowserC.tcl'" '(should have been 8616
characters)'
fi
fi # end of overwriting check
#    End of shell archive
exit 0

<- David Herron <[e-mail]> (work) <[e-mail]> (home)
<-
<- "That's our advantage at Microsoft; we set the standards and we can change them."
<- Karen Hargrove of Microsoft quoted in the Feb 1993 Unix Review editorial.