🚀 go-pugleaf

	Scriptace was spawned by my difficulties of getting the AceServer
to run automatically from a script, and catch every error.

	As I realized that AceServer was already taking its inputs from and
putting its outputs through a narrow pipe, I decided that I would work from
this form of Ace.

	I yanked out the RPC "stimulus-response" mechanism and replaced it
with Tcl "thunks".  The program still acts as a server, but now it's client
is a single Tcl script.  Instead of runing through XDR, the strings are
simply converted from Ace to Tcl forms (and vice-versa), etc.

	The remaining problem was that AceServer (and therefore Scriptace)
was throwing any errors encountered deep in the processing of a request to
stderr (via messout and friends).  So the program was registering errors,
at a deep level and making complaints, without realizing that it was doing
so. (Kind of like electronic Tourette's syndrome)  But with Mieg's help, we
established a buffer that messout will use, if present, and when the
program finds this buffer filled after processing a command, it throws a
Tcl error exception.  (Study the test.spa script to see how this can be
used).

	One last thing, if ScriptAce is invoked with no parameters, it
first "sources" your ~/.acerc file and then enters into an interactive
mode.

\\\\\\\\\\\\\\\\\\\\Next section from help.wrm\\\\\\\\\\\\\\\\\\\\

###################################################################

**Scriptace

	Scriptace is the form of Acedb that runs Tcl scripts.  This
provides a directly scriptable version of Ace for automatic data management
or reports.

	This program is invoked as `scriptace scriptfile`, where scriptfile
is a file of Tcl commands.  The program registers the single
"object-oriented" command "acedb" with the interpreter before parsing the
scriptfile. This command takes all of its parameters and hands them back
over to Ace to treat in the same manner as Tacedb commands. (Essentially the
interpreter is given a single "acedb" database object as part of its
environment, see Chapter 28 of Dr Ousterhout's book).

	In addition to the normal commands of Tacedb (each invoked as: acedb
command args), Scriptace has a few new features to take advantage of the
embedded interpreter.

acedb parse -v TclVar
	Parses a TclVar, like it was a file.

acedb write -v TclVar
	Acedumps current keyset to TclVar, like it was a file.

acedb table -l tablefile
	With the '-l' parameter, makes the table from the current keyset.

acedb getkey TclVar
	Returns the next element of the current keyset in
	TclVar (In an Ace-dump format), starting from the first element.
	Returns '1' if there was an element or '0' if there was no element
	left in the keyset.

acedb reset
	Restarts a getkey walk through the current keyset.  Changing
	the current keyset will also do this, and `acedb undo` will not
	recover the lost position

acedb_ketsize
	This Tcl variable tracks the current size of the current
	keyset, or zero when it's not valid.  This variable has the
	relationship to `acedb getkey` as the total number of valid entries
	that will be returned in total by that call, but not the number of
	iterations remaining.

	Any errors encountered in the processing of a command will cause
the `acedb` function to throw an error exception.  Tcl's catch command can
be used to retrieve the error message.  The intent being that usually, most
errors will leave the database in a state such that the operation can be
restarted. (Perhaps with an `acedb undo` after the catch.) 

	In addition, for various reasons, the Acedb side of the program can
crash, with or without any warning.  (I sure hope that none of this is ever
used in a "life critical" installation...)

	[From the Tcl FAQ by Larry W. Virden (lwv26@cas.org )
ftp://harbor.ecn.purdue.edu/pub/tcl/docs/tcl-faq.part*]

	Tcl and Tk originated with Dr. John Ousterhout (Oh'-stir-hout -
last syllable rhymes with rout, not root) from the University of California,
Berkeley, California.

	Tcl (current release version 7.3) stands for ``tool command
language'' and is pronounced ``tickle.'' The author's home ftp site for
the Tcl source code is ftp.cs.berkeley.edu.  Tcl is actually two
things: a language and a library.  First, Tcl is a simple textual
language, intended primarily for issuing commands to interactive
programs such as text editors, debuggers, illustrators, and shells.  It
has a simple syntax and is also programmable, so Tcl users can write
command procedures to provide more powerful commands than those in the
built-in set.

	Second, Tcl is a library package that can be embedded in
application programs.  The Tcl library consists of a parser for the Tcl
language, routines to implement the Tcl built-in commands, and
procedures that allow each application to extend Tcl with additional
commands specific to that application.  The application program
generates Tcl commands and passes them to the Tcl parser for
execution.  Commands may be generated by reading characters from an
input source, or by associating command strings with elements of the
application's user interface, such as menu entries, buttons, or
keystrokes.  When the Tcl library receives commands it parses them into
component fields and executes built-in commands directly.  For commands
implemented by the application, Tcl calls back to the application to
execute the commands.  In many cases commands will invoke recursive
invocations of the Tcl interpreter by passing in additional strings to
execute (procedures, looping commands, and conditional commands all
work in this way).

######################################################################

**Tacedb

    **************************************************************
    ****           acedb: A C. elegans Database               ****
    **** Richard Durbin (MRC, UK) rd@mrc-lmba.cam.ac.uk       ****
    **** Jean Thierry-Mieg (CNRS, France) mieg@kaa.cnrs-mop.fr****
    **************************************************************

	This help page provides basic information for the line oriented
version of the acedb program.

	Note that both Aceserver and Scriptace embed these commands into
their environments.

	These programs have a single KeySet with a single-step undo buffer
(i.e.: undo twice, and you'll have nothing).  Queries return their results
as the current keyset and most commands work only on this subset of the
items in the database.

	The following commands may be recognized.

Quit :
	Exits the program.

Help :
	for further help.

? : 
	List of commands.

Classes :
	Give a list of all the visible class names and how many objects
	they each contain.

Find class [name]:
	Creates a new current list with all objects from class, optionally
	matching name.

Model class:
	Shows the model of the given class, useful before Follow or Where
	commands.

Grep template:
	Generates a list from a search for *template* everywhere in the
	database, except longtexts.

LongTextGrep template:
	searches for *template*, everywhere, including longtexts.

Undo :
	returns the current list to its previous state.

List [template]:
	lists names of items in current list [matching template].

Show [tag] : 
	shows the [branch tag of] objects of current list.

Is template :
	keeps in the active list only those objects whose name match the
	template.

Remove template :
	removes from the active list only those objects whose name match
	the template.

Follow Tag :
	Replaces all elements in the current list with the elements
	referenced by Tag. i.e. Tag Author replaces the current
	list of papers with their authors.  (Note that this is setwise
	replacement so that a list of two papers Paper_A by Bob and Harry
	and Paper_B by Harry and Smith would result in a list of three
	elements: Bob, Harry and Smith). (Note also the the Keyset previous
	to this command is kept in the undo buffer, and so if you are
	careful, you can take this stuff, do a few things, and then step
	back.)

Where query_string :
	Trims the current list to the set of only those members
	that match the query_string (see: Query_syntax).

Write filename :
	acedump current list to file.

Biblio :
	shows the associated bibliography of the items in the current Keyset.

Dna filename :
	Fasta dump of related sequences to filename.

Array class:name format :
	formatted acedump of A class object.

Parse [aceFile] :
	parses an aceFile, or stdin,  until NUL or EOF.

Table-Maker file outputfile :
	Executes the file as a table-maker.def command file, placing the
	results into outputfile.

Read-models :
	Reads in the model defintions from wspec.

  You may redistribute this program and database subject to the
  conditions in the following copyright notice.  Anyone interested in
  maintaining an up to date version should contact one of the authors
  at the above email addresses.

/* Copyright (C) 1991 R Durbin and J Thierry-Mieg. All rights reserved.
 * Written by Jean Thierry Mieg and Richard Durbin, 1990, 1991.
 * Redistribution and use in source and binary forms are freely
 * permitted provided that the above copyright notice and 
 * attribution and date of work and this paragraph are duplicated 
 * in all such forms and that neither this software nor software
 * based in whole or in part on this software is sold for profit.
 * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
 * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR 
 * PURPOSE.
 */

#################################################################

\\\\\\\\\\\\\\\\\\\\Next section is test.spa\\\\\\\\\\\\\\\\\\\\

#	test.spa
#
#	Coverage testing for Scriptace.
#		12th April 1994 -HJC
#
#	Updated for new version of ScriptAce.
#		22nd April 1994 -HJC

proc trystuff args {
#Runs stuff, catches errors and displays results.
	global errorCode
	global foo
	if [catch {eval $args} msg] {
		puts "$errorCode :: $msg"
	} else {
		puts "$msg"
	}
}

proc matchstuff {patt args} {
#Runs stuff, catches errors and matches vs results.
	global errorCode
	global foo
	if [catch {eval $args} msg] {
		puts "$errorCode :: $msg"
		return 0
	} else {
		return [string match $patt $msg]
	}
}

set PID [pid]
set ACEDB $env(ACEDB)

#Test auto-init of acedb_keysize
puts "\nShould be: Zero items on list"
puts "$acedb_keysize"

#test null command handler.
puts "\nShould be: No command given"
trystuff acedb

#test 
puts "\nShould be: No such command"
trystuff acedb foo

puts "\nShould be: Commands listed"
trystuff acedb ?

puts "\nShould be: List of help topics"
trystuff acedb help

puts "\nShould be: Help on Tacedb command"
trystuff acedb help Query_syntax

puts "\nShould be: No such help topic"
trystuff acedb help sooy

puts "\nShould be: Active list is empty"
trystuff acedb list

puts "\nShould be: List of 9 P1s"
trystuff acedb find P1 DS0000*
puts "The list contains $acedb_keysize items"
trystuff acedb list

puts "\nShould be: List of 1 P1"
trystuff acedb list *1

puts "\nShould be: usage of keep"
trystuff acedb is

puts "\nShould be: One item kept"
trystuff acedb is *2
puts "The list contains $acedb_keysize items"

puts "\nShould be: list with just DS00002"
trystuff acedb list

puts "\nShould be: display of DS00002"
trystuff acedb show

puts "\nShould be: Complaint about lack of Tcl Variable"
trystuff acedb getkey

puts "\nShould be: Display of DS00002"
trystuff acedb getkey foo
puts "foo is $foo"

puts "\nShould be: Empty string"
trystuff acedb getkey foo
puts "foo is $foo"

puts "\nShould be: Not on a walk"
trystuff acedb getkey foo
puts "foo is $foo"

puts "\nShould be: Found 9 items, then display of DS0002"
trystuff acedb find P1 DS0000*
trystuff acedb getkey foo
trystuff acedb reset
trystuff acedb getkey foo
trystuff acedb getkey foo
puts "foo is $foo"

puts "\nShould be: display of args for remove"
trystuff acedb remove

puts "\nShould be: 9 objects kept"
trystuff acedb remove foo

puts "\nShould be: list of DS0000* except for 3"
trystuff acedb remove *3
trystuff acedb list

puts "\nShould be: Display of follow's syntax"
trystuff acedb follow

puts "\nShould be: Some number of Band_thingys"
trystuff acedb follow In_Situ
puts "The list contains $acedb_keysize items"
trystuff acedb list

puts "\nShould be: The last set of P1s"
trystuff acedb undo
puts "The list contains $acedb_keysize items"
trystuff acedb list

puts "\nShould display list of classes"
trystuff acedb class

puts "\nShould find many Genes"
trystuff acedb find Gene

puts "\nShould narrow stuff down."
trystuff acedb where COUNT GenBank_ref > 2

puts "\nShould be: Usage of model command."
trystuff acedb model

puts "\nShould be: model of Gene Class."
trystuff acedb model Ge*

puts "\nShould be: Complaint about unkown Class."
trystuff acedb model X*

puts "\nShould be: Complaint about missing model."
trystuff acedb model Author

puts "\nShould be: not found"
trystuff acedb where {}

puts "\nShould be: nothing"
trystuff acedb where

puts "\nShould be: explanation of grep"
trystuff acedb grep

puts "\nShould be: display of l(2)10626"
trystuff acedb grep l(2)10626
trystuff acedb show

puts "\nShould be: same display as above"
trystuff acedb write

puts "\nShould be: bib of objects above"
set foo [trystuff acedb bib]
puts "Foo is: $foo"

puts "\nShould be: a fasta dump"
trystuff acedb find Sequence X2-00232
trystuff acedb dna "/tmp/tcl$PID"
if [matchstuff {I wrote 1 sequences} acedb dna "/tmp/tcl$PID"] {
	set bar [open "/tmp/tcl$PID" r]
	while {-1 < [gets $bar foo]} {puts $foo}
}

puts "\nShould be: the same fasta dump"
trystuff acedb dna

puts "\nShould be: a nasty error message"
trystuff acedb dna /NO/SUCH/PATH

puts "\nShould be: Matching outputs"
set foo {Paper : Tcl_toolkit
Title "Tcl and the Tk Toolkit"
Author "John K. Ousterhout"
Keyword Tcl}

set bar [open "/tmp/tcl$PID" w]
puts $bar $foo
close $bar

trystuff acedb parse -v foo
trystuff acedb find Paper Tcl_toolkit
trystuff acedb show

trystuff acedb parse "/tmp/tcl$PID"
trystuff acedb find Paper Tcl_toolkit
trystuff acedb show

puts "\nShould be: nothing"
set foo {-D Paper Tcl_toolkit}
trystuff acedb parse -v foo
trystuff acedb find Paper Tcl_toolkit
trystuff acedb show

puts "\nShould be: Usage of Table command."
trystuff acedb table

puts "\nShould be: Error on inability to open file."
trystuff acedb table /NO/SUCH/PATH

puts "\nShould be: Table report."
trystuff acedb table  $ACEDB/wquery/tabletest.def

puts "\nShould be: shorter Table report."
trystuff acedb find Contig chi
trystuff acedb table  -l $ACEDB/wquery/tabletest.def

puts "\nShould be: New models read."
trystuff acedb read-models

puts "\nShould be: end of output."

\\\\\\\\\\\\\\\\\\\\Next section from truemake\\\\\\\\\\\\\\\\\\\\

SCRIPTACE_OBJS = \
	$(CLEAN_OBJS) \
	$(WORM_SERVER_OBJS) \
	parse.ng.o \
	messubs.ng.o \
	session.ng.o \
	longtext.ng.o \
	class.ng.o \
	dump.ng.o \
	scriptace.o

##### TCL variant #########################

scriptace.o: $(ACEDB_SRC)/wrpc/scriptace.c
	$(CC) -I/usr/local/include -I/cs/pub/tcl-7.3/include \
	-c $(ACEDB_SRC)/wrpc/scriptace.c

scriptace : $(SCRIPTACE_OBJS)
	$(LD) -o scriptace $(SCRIPTACE_OBJS)\
	$(LIBS) -L/usr/local/lib -ltcl -lm

\\\\\\\\\\\\\\\\\\\\Next Section is scriptace.c\\\\\\\\\\\\\\\\\\\\
/*  File: scriptace.c
 *  Author: Jean Thierry-Mieg (mieg@mrc-lmba.cam.ac.uk)
 *  Copyright (C) J Thierry-Mieg and R Durbin, 1992
 *-------------------------------------------------------------------
 * This file is part of the ACEDB genome database package, written by
 *      Richard Durbin (MRC LMB, UK) rd@mrc-lmba.cam.ac.uk, and
 *      Jean Thierry-Mieg (CRBM du CNRS, France) mieg@frmop11.bitnet
 *
 * Description:
     main module for Tcl parsing ace variant.
 * Exported functions:
 * HISTORY:
     Mutated from aceserver.c on Tue Nov 30 14:01:35 PST 1993 by HJC.

 * Last edited: Nov 10 00:30 1993 (mieg)
 * Created: Wed Nov 25 12:26:06 1992 (mieg)
 *-------------------------------------------------------------------
 $Revision: 1.2 $
 */


/*******************************************************************/
/*   A C e D B                                                     */
/*   A Caenorhabditis elegans Data Base                            */
/*               by R.Durbin and J.Thierry Mieg                    */
/*******************************************************************/
/*               Network Query Server                              */
/*******************************************************************/

/*  Version number is #defined  in session.h                       */

extern void 
  blockInit(void),
  lexInit(void),
  pickInit(void),
  sessionInit(void) ,
  pickInit(void),
  sessionAutoSelect(void) ;

int intFlag = 0 ; /* interupt flag, used in a few routines */

extern char *stackorigin ;            /* in arraysub */
 extern int isInteractive ;           /* in freesubs */

void wormClose(void) ;

#include "acedb.h"
#include "sysclass.wrm"
#include "session.h"
#include "parse.h"
#include "pick.h"
#include "bs.h"
#include "spread.h"
#include "systags.wrm"
#include "classes.wrm"
#include "tags.wrm"

#include <tcl.h>

BOOL parseKeepGoing ; /*Will be extern in parse.c... -HJC */

extern Stack errorstack;  /* Hidden buffer used by messout -HJC*/

/* #include "nace_com.h" Not needed in scriptace -HJC*/

/* begin suz & SUZ totally perverse patch */
extern ParseFunc parseFunc[] ;
extern BOOL dnaParse (int level, KEY key) ;
extern BOOL longTextParse (int level, KEY) ;
extern BOOL keySetParse (int level, KEY) ;
extern int  dumpFastAFile (FILE *fil, KEYSET ks) ;

static void
parseInit (void)
{
    parseFunc[_VKeySet]  = keySetParse ;
    parseFunc[_VLongText]  = longTextParse ;
    parseFunc[_VDNA]  = dnaParse ;
}

/* end suz & SUZ totally perverse patch */

static Array clients = 0 ;
typedef struct LOOKSTUFF { Array ksNew, ksOld ; } *LOOK ;
/*******************************************************************/
/********** Missing routines ***************************************/

void graphCleanUp(void)
{
  return ;
}

void graphText (char *text, float x, float y)
{ printf(text) ;
}

char *graphHelp(char *x)
{ return NULL;
}
void graphClear(void)
{ printf("\n\n") ;
  return ;
}

BOOL graphExists(Graph g)
{ return 0 ;
}

void graphRedraw(void)
{ printf("\n") ;
  return ;
}

void graphTextBounds(int w, int h)
{ return ;
}

int graphColor(int color)
{ return 0;
}

Graph   graphCreate (int a, char *b, float c, float d, float e, float f)
{ return NULL ;
}

void mainActivity(char *noway)
{
    return;
}

/******************* INITIALISATION ***************************/
/**************************************************************/

static void wormInit (int argc, char **argv)
{
    char *homedir ;
    /* This is the root of the database directory */
    /* by changing it, you may work on different sets of data */
    
    if (homedir = getenv ("ACEDB"))
        filsetdir (homedir) ;
    else
        messcrash ("%s %s",
                   "Environment variable ACEDB is not defined",
                   "Read the instructions in the README of this program"
                   ) ;
    
    /* Macro KEYKEY relies on KEY beeing 4 bytes long  */
    /* Furthermore, it may be assumed implicitly elsewhere */
    
    if (sizeof(KEY) != 4)
        messcrash ("KEY size is %d - it must be 4 - rethink and recompile!",
                   sizeof(KEY)) ;
    
    /* The order of the initialisations is crucial */
    
    freeinit ();                        /* must come before graphInit */
    
    blockInit()  ;              /*Initialisation du cache*/  
    lexInit() ;                   /*Initialisation du lexique*/  
    /* et lecture de sytags et tags */
    pickInit() ;                  /*Class definitions */
    parseInit () ;                /* suz, to be able to parse DNA arrays */
    sessionInit() ;               /*Reads in the lexiques etc */
    sessionAutoSelect() ;
}

/*************************************************************/

static void showModel(KEY key, Stack s)
{
  FILE *f = filopen("wspec/models", "wrm","r") ;
  char *cp , buf[256] ;

  buf[255] = 0 ;
  if (!f)
    messcrash("showModel can t find the model file") ;
  while (freeread(f))  /* look for ?className */
    if ((cp = freeword()) && *cp == '?' && !strcmp(cp+1, className(key)))
      break ;

  if (strcmp(cp+1, className(key))) {
      messout(messprintf ("Model of class %s not found", className(key)));
      return ;
    }
  catText(s, cp) ;
  catText(s, " ") ;
  catText(s, freepos()) ;
  catText(s, "\n") ;
  while (cp = fgets(buf, 255, f))
    if (*cp == '?')
          { fclose(f) ;
            return ;
          }
    else  /* printout */
      { catText(s, cp) ; catText(s, "\n") ;}
}

/****************** MAIN LOOP **********************/

#include "keyset.h"
#include "query.h"
#include "a.h"
#include "dump.h"
#include "lex.h"

static FREEOPT qmenu[] = 
{ 
  24,  "acedb",
  'x', "Quit :   Exits the program.       Any command can be abbreviated, $starts a subshell",
  'h', "Help : for further help",
  '?', "? : List of commands",
  'c', "Classes : Give a list of all the visible class names and how many  objects they contain.",
  'n', "Find class [name]: Creates a new current list with all objects from class, optionally matching name",
  'z', "Model class: Shows the model of the given class, useful before Follow or Where commands",
  'g', "Grep template: searches for *template* everywhere in the database except LongTexts",
  'G', "LongTextGrep: searches for *template* also in LongTexts",
  'u', "Undo : returns the current list to its previous state",
  'l', "List [template]: lists names of items in current list [matching template]",
  's', "Show [tag] : shows the [branch tag of] objects of current list",
  'i', "Is template : keeps in the active list only those objects whose name match the template",
  'r', "Remove template : removes from the active list only those objects whose name match the template",
  't', "Follow Tag : i.e. Tag Author gives the list of authors of the papers of the current list", 
  'q', "Where query_string : performs a complex query - 'help query_syntax' for further info",
  'w', "Write filename : acedump current list to file",
  'b', "Biblio : shows the associated bibliography",
  'd', "Dna filename : Fasta dump of related sequences", /* suz, added filename */
  'a', "Array class:name format : formatted acedummp of A class object",
  'p', "Parse file : parses an aceFile, or stdio, or Tclvar until \000 or EOF",
  'T', "Table-Maker file outputfile : Executes the file as a table-maker.def command file, outputs ",
  'Z', "reset : Restarts the getkey walk through the keylist.",
  'k', "getkey : Places next element of keylist into named Tcl variable.",
  'R', "Read-models",
} ;

static FREEOPT helpmenu[] =     /* no \n inside FREEOPT text (else rethink) */
{ 5, "helpmenu",
  1, "Tacedb : copyright etc", 
  2, "Query_syntax for the find command",
  3, "Useful_sequences : SL1 etc",
  4, "Clone_types used in the physical map (vector etc)",
  5, "DNA_and_amino_acids_nomenclature : codes for bases/amino acids and translation table",
} ;

 /* By convention, each reply starts with a message ending on /n
    which will be deleted if aceclient runs silently rather than verbose 
    */

static int processTclQueries(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
    static KEYSET ksNew = 0 , ksOld = 0 , kA = 0 , kClass = 0;
    int nn = 0 , i, j, class, successcode;
    KEY option;
    FILE *f ;
    char *cp , c ;
    static Stack grepText = 0 , localStack = 0 ;
    static Stack s = 0 ;   static char *oldAnswer = 0 ; /* Answer buffer */
    static char *question, *answer ;
    static int nClients = 0 , clientId =0;
    LOOK look ;
    int reply_len;
    static int walking = 0; /* State variable for keylist walks. */
    static char *varname=0;     /* Name of Tcl Variable */
    BOOL isLongGrep = FALSE;
    
    successcode = TCL_OK; /* Assume it works -HJC*/
    
    if (!clientId) {
        look = (LOOK) messalloc(sizeof(struct LOOKSTUFF)) ;
        ++nClients ;
        clientId = nClients;
        array(clients, nClients, LOOK) = look ;
    }     
    
    if (clientId <= 0  ||
        clientId >= arrayMax(clients)){
        char msg[256];
        sprintf(msg,"%d",clientId);
        Tcl_SetErrorCode(interp, "ACEDB",
                         "Aceserver received a bad client id",msg, (char *) NULL) ;
        return TCL_ERROR ;
    }
    
    look = arr(clients, clientId, LOOK) ;
    ksNew = look->ksNew ;
    ksOld = look->ksOld ;
    
    if(question && strlen(question))
        free(question);
    
    if(1 < argc) {
        /*There are paramters to deal with */
        question = Tcl_Merge(argc-1,argv+1);
        /* Skip over the "acedb" string that Tcl called us with */
    } else {
        question = "";
    }
    s = stackReCreate(s, 20000) ;
    freeforcecard(question) ;
    /*   fprintf(stderr,"aceserver received %s\n", question->cmd) ; */

    if (freekey (&option, qmenu)) {
	switch (option) {
	  case 'x':
	    wormClose() ;
	    return TCL_OK;
	  case 'h':
	    if (freekey (&option, helpmenu)){
		freeforcecard (helpmenu[option].text) ;
		/* helpAnswer (stdout, freeword()) ; */
		messout("Sorry help topic not coded") ;
	    } else {
		catText(s, "ACEDB Server Usage:\n"
			"Commands are not case sensitive and can be abbreviated.\n"
			"Lines starting with @ will take the next word as a file name to read\n"
			"commands from (include file), passing subsequent words on the line as parameters.\n"
			"Lines starting with $ execute the remainder of the line in an interactive subshell.\n"
			"Everything following // on a line is ignored (comment).\n"
			"To escape any of these special characters use a backslash, eg \\@.\n\n"
			"This program maintains an internal list of current objects. \n "
			"You can List or Show or Write the content of the list.\n"
			"You can change the list with the simple commands: \n"
			"       Grep, Find, Is, Follow, Biblio. \n"
			"Perform complex queries with: \n"
			"       Where search-string', where 'search-string' follows the acedb query syntax.\n"
			"Print relational tables with Table table-command-file\n\n"
			"To see a list of all possible commands type ?.\n\n"
			"For further help on any of the following features type 'help feature'\n"
			) ;
		for (i = 1 ; i <= helpmenu[0].key ; i++)
		    catText (s,helpmenu[i].text) ;
	    }
	    break ;
	  case '?':
	    catText(s, "ACEDB Server list of commands:\n") ;
	    for (i = 1 ; i <= qmenu[0].key ; i++){
		catText(s,qmenu[i].text) ;
		catText(s,"\n");
	    }
	    break ;   
	  case 'l':   /* lists names matching template */
	    if (!ksNew || !keySetExists(ksNew)){
		messout("Active list is empty") ;
		break ;
	    }
	    if (cp = freeword()){
		kClass = keySetCreate() ;
		for (i = 0, j = 0 ; i < keySetMax(ksNew) ; i++)
		    if (pickMatch(name(keySet(ksNew,i)), cp))
			keySet(kClass, j++) = keySet(ksNew, i) ;
	    } else
		kClass = keySetCopy(ksNew) ;
	    keySetDestroy(kA) ;
	    walking = 0; /* Just destroyed walk state */
	    kA = keySetAlphaHeap(kClass, keySetMax(kClass)) ;
	    keySetDestroy(kClass) ;
	    catText(s, messprintf("KeySet : Answer_%d\n",++nn)) ;
	    keySetDump(0, s, kA) ;
	    break ;
	    
	  case 'i':   /* keeps names matching template */
	    if (!ksNew) {
		catText(s, "Active list is empty") ;
		break ;
	    }
	    if (cp = freeword()) {
		if (ksNew && ksOld != ksNew) {
		    keySetDestroy(ksOld) ;
		    ksOld =  ksNew ;
		}
		ksNew = keySetCreate() ;
		for (i = 0, j = 0 ; i < keySetMax(ksOld) ; i++)
		    if (pickMatch(name(keySet(ksOld,i)), cp))
			keySet(ksNew, j++) = keySet(ksOld, i) ;
		catText(s, messprintf(" %d objects kept ", keySetMax(ksNew))) ;
	    } else
		messout("Usage Keep template : keeps names from current list matching template.") ;
	    break ;
	  case 'r':   /* remove names matching template */
	    if (!ksNew) {
		catText(s,"Active list is empty") ;
		break ;
	    }
	    if (cp = freeword()) {
		if (ksNew && ksOld != ksNew){
		    keySetDestroy(ksOld) ;
		    ksOld =  ksNew ;
		}
		ksNew = keySetCreate() ;
		for (i = 0, j = 0 ; i < keySetMax(ksOld) ; i++)
		    if (!pickMatch(name(keySet(ksOld,i)), cp))
			keySet(ksNew, j++) = keySet(ksOld, i) ;
		catText(s,
			messprintf(" %d objects kept ", keySetMax(ksNew))) ;
	    } else
		catText(s,"Usage Remove template : remove names matching template") ;
	    break ;
	  case 't':   /* Tag follow */
	    if (!ksNew || !keySetMax(ksNew)){
		printf ("Active list is empty") ;
		break ;
	    }
	    class = 0 ;
	    if (cp = freeword()){ /* Autocomplete to a tag */
		KEY tag = 0 ;
		
		while (lexNext(0, &tag))
		    if(pickMatch(name(tag), cp)){
			if (strcmp(cp, name(tag)))
			    catText(s, messprintf ("Autocompleting %s to %s",
						   cp, name(tag))) ;
			if (ksNew && ksOld != ksNew) {
			    keySetDestroy(ksOld) ;
			    ksOld =  ksNew ;
			}
			ksNew = query(ksOld, messprintf(">%s", name(tag))) ;
			goto goodTag ;
		    }
		catText(s, messprintf ("Sorry, Tag %s unknown ", cp)) ;
		break ;
	    } else {
		messout("Usage Follow tag-name, change to list of objects pointed by tag, ") ;
		messout("\ntype Z class to see the model of the class") ;
		break ;
	    }
	  goodTag:
	    catText(s, messprintf ("Found %d objects", keySetMax(ksNew))) ;
	    break ;
	    
	  case 's':   /* Show objects */
	    /* look for the class name */
	    if (!ksNew || !keySetMax(ksNew)){
		catText(s,"Active list is empty") ;
		break ;
	    }
	    class = 0 ;
	    
	    localStack = stackReCreate(localStack, 80) ;
	    pushText(localStack,"") ;
	    while (cp = freeword()) {
		catText(localStack, cp) ;
		catText(localStack, " ");
	    }
	    
	    kClass = keySetCopy(ksNew) ;
	    if (kClass && keySetMax(kClass)){
		keySetDestroy(kA) ;
		walking = 0; /* Just destroyed Walk state */
		kA = keySetAlphaHeap(kClass, keySetMax(kClass)) ;
		catText(s,"\n") ;
		for (i = 0 ; i < keySetMax(kA) ; ++i)
		    dumpKeyBeautifully (keySet(kA,i), 0, s, stackText(localStack,0)) ;
	    } else
		catText(s,"No match ") ;
	    keySetDestroy(kClass) ;
	    break ;
	  case 'u':   /* undo */
	    if (ksOld) {
		keySetDestroy (ksNew) ;
		ksNew = ksOld ;
		ksOld = 0 ;
		catText(s,messprintf("Recovered %d objects", keySetMax(ksNew))) ;
	    } else {
		messout("No more previous list available") ;
	    }
	    break ;
	    
	  case 'c':  /* Class */
	    catText(s,
		    "These are the known classes and the number of objects in each class \n");
	    for(i=0; i<256;i++)
		if(pickVisible(i))
		    catText(s, messprintf("%35s %d \n", pickClass2Word(i),lexMax(i) - 2 )) ;
	    break ;
	    
	  case 'n':   /* New class */
	    cp = freeword() ;
	    if (!cp) {
		catText(s, messprintf ("Usage Find Class [name]: Construct a new current list"
				       " formed with all objects belonging to class \n")) ;
		break ;
	    }
	    localStack = stackReCreate(localStack, 80) ;
	    catText(localStack, cp) ;
	    class = 0 ;
	    if (cp = freeword()) {
		keySetDestroy(kA) ;
		kA = query(0, messprintf("FIND %s IS %s",
					 stackText(localStack, 0),cp)) ;
	    } else {
		keySetDestroy(kA) ;
		kA = query(0, messprintf("FIND %s", stackText(localStack, 0))) ;
	    }
	    walking = 0; /* Just destoryed walk state */
	    if (kA && keySetMax(kA)) {
		if (ksNew && ksOld != ksNew) {
		    keySetDestroy(ksOld) ;
		    ksOld =  ksNew ;
		}
		ksNew = kA ; kA = 0;
		catText(s, 
			messprintf ("Found %d objects in this class", keySetMax(ksNew))) ;
	    }
	    break ;
	    
	  case 'z':   /* Z class-model */
	    cp = freeword() ;
	    if (!cp) {
		messout("Usage Model Class : Shows the model of given class,\n"
			"type C to list the models") ;
		break ;
	    }
	    class = 0 ;
	    { /* Autocomplete to a Class */
		KEY key, class = 0;
                
		if (lexNext(_VClass,&class))
		    while (lexNext(_VClass,&class))
			if (pickMatch
			    (name(class), cp) ) {
			    unsigned char mask ;   
			    
			    key = class ;
			    pickIsA (&class, &mask) ;
			    if (mask) {
				catText(s, messprintf("%s is a sub class of %s, "
						      "here is its definition\n\n",
						      name(key),
						      pickClass2Word(class))) ;
				dumpKey(key, 0, s) ; /* dumpKeyBeautifully (key, 0, s,0) ; */
			    } else {
				key = KEYMAKE(class, 0) ;
				if (pickType(key) == 'B') {
				    showModel(key,s) ;  /* dumpKey refuses to dump models */
                                    /* because they could not be parsed */
				} else {
				    messout(messprintf("Sorry, %c class %s has no model", 
						       pickType(key), name)) ;
				}
			    }
			    goto goodClass;
			}
	    }
	    messout(messprintf ("Sorry, class %s is unknown, type C "
				"for a list of known classes. ", cp)) ;
	  goodClass:
	    break ;
	    
	  case 'q':   /* Performs a complex query */
	    if (!(cp = freewordcut("",&c))) {
		messout("Usage: acedb where query");
		break ;
	    }
	    localStack = stackReCreate(localStack, 80) ;
	    catText(localStack, cp) ;
	    if (ksNew && ksOld != ksNew) {
		keySetDestroy(ksOld) ;
		ksOld =  ksNew ;
	    }
	    ksNew = query(ksOld,stackText(localStack, 0)) ;
	    if (ksNew != ksOld)
		catText(s, messprintf("Found %d objects", keySetMax(ksNew))) ;
	    break ;
	    
	  case 'G':
	    isLongGrep = TRUE ;
	  case 'g':   /* Match == Grep */
	    if (!(cp = freewordcut("",&c))) {
		messout("Usage: acedb grep string");
		break ;
	    }
	    if (ksNew) {
		keySetDestroy(ksOld) ;
		ksOld =  ksNew ;
	    }
	    catText(s,"I search for texts or object names matching *") ;
	    catText(s, cp) ;
	    catText(s,"* ") ;
	    grepText = stackReCreate(grepText,20) ;
	    catText(grepText,messprintf("*%s*",cp)) ;
	    ksNew = queryGrep(stackText(grepText,0)) ;
	    if (isLongGrep){ 
		KEYSET ks1 = ksNew,
		ks2 = longGrep(stackText(grepText,0)) ;
		ksNew = keySetOR(ks1, ks2) ;
		keySetDestroy(ks1) ;
		keySetDestroy(ks2) ; 
		isLongGrep = FALSE ;
	    }
	    break ;
	    /*
	       case 'a':
	       if (lexClassKey (freeword(), &key)
	       && (fmt = freeword())
	       && (a = uArrayGet(key, sizeOfFormattedArray(fmt), fmt)))
	       { dumpFormattedArray (stdout, a, fmt) ;
	       arrayDestroy (a) ;
	       }
	       break ;
	       */
	    
	  case 'b':
	    catText(s, "   Associated bibliography ") ;
	    {
		/* We need to declare all bib... to be able to destroy them */
		
		static KEYSET bib1, bib2, bib3, bib4, bib;
		static KEYSET aut = 0;
		KEY ref, text, kk; OBJ Ref ;
		int ix, j ;
		static Stack buf = 0;
		
		aut = arrayReCreate(aut,12, BSunit);
		buf = stackReCreate(buf,50) ;
		
		bib1 = query(ksNew,"?Paper") ; /* Class Paper members of s */
		bib2 = query(ksNew,">Paper") ; /* Follow tag Paper */
		bib3 = query(ksNew,">Reference") ; /* Follow tag Reference */
		
		bib4 = keySetOR(bib2,bib3) ;
		bib  = keySetOR(bib1,bib4) ;
		
		keySetDestroy(bib1) ;
		keySetDestroy(bib2) ;
		keySetDestroy(bib3) ;
		keySetDestroy(bib4) ;
		
		for(i=0 ; i < keySetMax(bib) ; i++){
		    ref=keySet(bib,i) ;
		    catText(s,name(ref)) ;
		    
		    if (Ref = bsCreate(ref)){
			if(bsGetKey (Ref,_Title,&text))
			    catText(s,name(text)) ;
			stackClear(buf) ; catText (buf,"") ;
			if (bsFindTag (Ref, _Author) &&
			    bsFlatten (Ref, 1, aut)){
			    for (j=0;j<arrayMax(aut);j++){
				if(j)
				    catText(buf,", ") ;
				catText(buf,name(keySet(aut,j))) ;
			    }
			    catText(buf,".");
			    catText(s,stackText(buf,0)) ;
			}
			stackClear(buf) ; catText(buf,"") ;
			if (bsGetKey (Ref,_Journal,&kk))
			    catText (buf,name(kk));
			if (bsGetData (Ref,_Volume,_Int,&ix)){
			    catText (buf, messprintf (" %d",ix)) ;
			    if (bsGetData (Ref,_bsRight,_Text,&cp))
				catText (buf, cp) ;
			}
			
			if (bsGetData (Ref,_Page,_Int,&ix)){
			    catText (buf, messprintf (", %d",ix)) ;
			    if (bsGetData (Ref,_bsRight,_Int,&ix))
				catText (buf, messprintf ("-%d",ix)) ;
			}
			
			if (bsGetData (Ref,_Year,_Int,&ix))
			    catText (buf, messprintf (" (%d)",ix)) ;
			
			catText(s, stackText(buf,0)) ;
			bsDestroy(Ref);
		    }
		}
		keySetDestroy(bib) ;
	    }
	    break ;
	    
	  case 'w': /* write */
	    if(varname) {
		free(varname);
		varname = 0;
	    }
	    f = 0;
	    
	    if (!ksNew || !keySetMax(ksNew)){
		messout("Active list is empty\n") ;
		break ;
	    }
	    
	    if(cp=freeword()){
		if(!strcmp(cp,"-v")){
		    if(cp = freeword()) {
			if(!(varname = malloc(strlen(cp)+1)))
			    break;
			strcpy(varname,cp);
			messout("Usage: write [-v varname] [filename]\n");
		    }
		} else {
		    if (!(f = fopen(cp, "w"))) {
			messout("Sorry, could not open file: ");
			messout(cp);
			break;
		    }
		}
	    }
	    
	    {
		static Stack buf = 0;
		if(!f){
		    buf = stackReCreate(buf,50) ;
		} else {
		    stackDestroy(buf);
		    buf = 0;
		}
		
		keySetDestroy(kA) ;
		walking = 0; /* Just destroyed walk state -HJC */
		kA = keySetAlphaHeap(ksNew, keySetMax(ksNew)) ;
		for (j = 0 , i = 0 ; i < keySetMax(kA) ; ++i)
		    if (dumpKey (keySet(kA,i), f, buf))
			j++ ;
		
		if(f) fclose(f);
		
		if(buf) {
		    if(varname) {
			Tcl_SetVar(interp, varname, stackText(buf,0),
				   TCL_LEAVE_ERR_MSG);
		    } else {
			catText(s,stackText(buf,0));
		    }
		}
	    }
	    
	    break ;
                
	  case 'd': /* by Suzanna Lewis. LBL */
	    /* don't bother if nothing is there */
	    if (!ksNew || !keySetMax(ksNew))
		break ;
	    
	    keySetDestroy(kA) ;
	    walking = 0; /* Just destroyed walk state -HJC */        
	    kA = keySetAlphaHeap(ksNew, keySetMax(ksNew)) ;
	    
	    freenext() ;
	    
	    /* closes the file */
	    if (cp = freeword()) {
		if( f = fopen(cp, "w") ) {
		    i = dumpFastAFile (f, kA) ;
		    catText (s, messprintf("I wrote %d sequences", i)) ;
		} else{
		    messout(messprintf("Could not open fastA file %s", cp));
		}
	    } else {
		/* No filename so stack into output */
		dumpFastAStack(s, kA);
	    }
	    break ;
	    /* suz, end of dna dump addition */         
	    
	    
	  case 'P':
	    parseKeepGoing = TRUE ;
	    /* fall thru */
	  case 'p':
	    if(varname){
		free(varname);
		varname = 0;
	    }
	    f = 0;
	    freenext() ;
	    if((cp = freeword()) && !strncmp("-v", cp, 2)) {
		if(!(cp = freeword())) {
		    messout("usage: Acedb parse -var TclVar.");
		    parseKeepGoing = FALSE ;
		    break;
		} else {
		    /* Got a Tcl variable name, I hope. */
		    if(!(varname = malloc(strlen(cp)+1))){
			parseKeepGoing = FALSE ;
			break;
		    }
		    strcpy(varname,cp);
		    if(! (cp = Tcl_GetVar(interp, varname, TCL_LEAVE_ERR_MSG))) {
			messout("usage: Acedb parse -var TclVar.");
			parseKeepGoing = FALSE ;
			break;
		    }
		}
	    } else {
		f = (cp) ? ( f = fopen(cp, "r") ) : stdin ;
	    }
	    sessionWriteAccess() ; /* try to grab it */
	    if (!isWriteAccess())
	    {
		messout("Sorry, you do not have write access.") ;
		if (f) fclose(f) ;
		parseKeepGoing = FALSE ;
		break ;
	    }
	    
	    if (varname) {
		if (!parseBuffer(cp)) {
		    messout(messprintf("\nError in parse of %s",varname));
		    parseKeepGoing = FALSE ;
		    sessionClose(TRUE) ;
		    break;
		}
	    }else if (f) { /* suz, corrected `if` structure */
		parseFile(f,0); /* will close f */
	    }else
		messout(messprintf("Sorry, I could not open file %s", cp)) ;
	    
	    sessionClose(TRUE) ; /* Does nothing if f==0 */
	    
	    parseKeepGoing = FALSE ;
	    break ;
	    
	  case 'T': {
	      BOOL islocal = FALSE;
	      
	      freenext() ;
	      cp = freeword() ;

	      if( cp && !(strcmp(cp,"-l"))){
		  islocal = TRUE;
		  cp = freeword();
	      }
	      if (!cp){
		  messout("Usage Table [-l] command-file [separator (1<sep<256)]") ;
		  break ;
	      }
	      
	      f = fopen(cp, "r") ;
	      if (!f){ 
		  messout(messprintf("Sorry, I could not open file %s", cp)) ;
		  break ;
	      }
	      freenext() ;
	      if (freeint(&i) && i > 0 && i < 256){
		  ;
	      } else i = '\t' ;         
	      
	      {
		  void *spread = spreadAlloc() ;
		  spreadDoReadDefinitions (spread, f, 0, "") ; /* will close f */
		  if(islocal) {
		      if (!ksNew || !keySetMax(ksNew))
			  break ;
		      spreadCleanUpAndFillNthCol(spread, ksNew, 0) ;
		      spreadRecomputeOthers (spread) ;
		  } else {
		      spreadDoRecompute (spread) ;
		  }
		  spreadDoDump (spread, i, s, 0) ;
		  spreadDoDestroy(spread) ;
	      }
	      break ;
	  }

	  case 'Z':   /* Restart Walk */
	    /* look for the class name */
	    if (!ksNew || !keySetMax(ksNew)) {
		catText(s,"0") ;
	    } else {
		catText(s,"1");
	    }
	    walking = 0 ;
	    break;

	    /* Note the fall through... -HJC*/
	    
	  case 'k': /* Provide next element of keyset*/

	    if (ksNew && keySetMax(ksNew)) {
		if(walking == 0) {
		    keySetDestroy(kA) ;
		    kA = keySetAlphaHeap(ksNew, keySetMax(ksNew)) ;
		}
	    } else {
		messout("Active list is empty.");
		break;
	    }

	    if(!(cp = freewordcut("",&c))) {
		messout("No variable given to place element in.");
		break;
	    }
	    
	    Tcl_SetVar( interp, cp, "", TCL_LEAVE_ERR_MSG);

	    if (-1 == walking) { /* One past last element */
		/* Return 0 result and null element */
		catText(s,"0");
		walking = 0;
		break;
	    }

	    if((!kA) || (keySetMax(kA) < walking)) {
		messout("Error in Keyset walk.");
	    }

	    if(keySetMax(kA) == walking) {
		walking = -1; /* End of walk */
		break;
	    }
	    
	    dumpKey(keySet(kA,walking), 0, s) ;
	    
	    Tcl_SetVar( interp, cp, s->pos, TCL_LEAVE_ERR_MSG);

	    s = stackReCreate(s, 20000) ;
	    catText(s,"1"); /* successful return result */
	    walking++; /* Next please */
	    break ;
	    
	  case 'R':      /* read models */
	    readModels() ;
	    catText(s,"New models read, save your work before quitting") ;
	    break ;
	    
	  default:
	    messout("Option not yet written, sorry") ;
	    break ;
	}
    } else {
	messout("Please type ? for a list of commands.") ;
    }
    
    if (!ksNew) {
	Tcl_SetVar(interp, "acedb_keysize", "0",
		   TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
    } else {
	Tcl_SetVar(interp, "acedb_keysize", messprintf("%d",keySetMax(ksNew)),
		   TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
    }
    
    reply_len = stackMark(s) ; 
    
    answer = messalloc(reply_len + 1) ;
    *(answer + reply_len) = 0 ;
    memcpy(answer, stackText(s, 0), reply_len) ;
    
    Tcl_SetResult(interp, answer, TCL_VOLATILE);
    
    messfree(answer);
    
    oldAnswer = stackText(s, 0) ;
    
    look->ksNew = ksNew ;
    look->ksOld = ksOld ;
    
    reply_len = stackMark(errorstack);
    if(reply_len) {
	answer = messalloc(reply_len + 1) ;
	*(answer + reply_len) = 0 ;
	memcpy(answer, stackText(errorstack, 0), reply_len) ;
	
	Tcl_SetErrorCode(interp,"ACEDB",answer, (char*) 0);
	
	messfree(answer);
	
	errorstack = stackReCreate(errorstack,128);
	
	successcode = TCL_ERROR;
    }
    return successcode;       
}



/**************************************************/
/********* ACEDB non graphic Query Server  ********/
/**************************************************/

void wormClose(void)
{
  if (isWriteAccess())
    sessionClose
     (freequery ("You did not save your work, should I ?")) ;
  
  exit(0) ;
}

/**************/

int Tcl_AppInit(Tcl_Interp *interp)
{
    char x ;
    static char *cpo;
    stackorigin = &x ;

    if(Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    tcl_RcFileName = "~/.acerc";

    wormInit (0, 0) ;
    
    clients = arrayCreate(120, LOOK) ;
    
    errorstack = stackCreate(128);
    
    Tcl_CreateCommand(interp, "acedb", processTclQueries, (ClientData *) 0,
		      (Tcl_CmdDeleteProc *) 0) ;

    Tcl_SetVar(interp, "acedb_keysize", "0",
	       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
    cpo = Tcl_GetVar(interp,"argv0",0);
    if(strcmp(cpo+(strlen(cpo)-9),"scriptace"))
	isInteractive = FALSE;
    return TCL_OK;
}

/**************************************************/
/**************************************************/

--
	Henry J. Cobb hcobb@fly2.berkeley.edu, SFB Tyrant-for-life
	"Stop the near-insanity!" -Crow