20060303a

1 files changed, 1397 insertions, 0 deletions

diff --git a/appl/lib/tcl_core.b b/appl/lib/tcl_core.b
new file mode 100644
index 00000000..ef05ef97
--- /dev/null
+++ b/appl/lib/tcl_core.b
@@ -0,0 +1,1397 @@
+implement Tcl_Core;
+
+# these are the outside modules, self explanatory..
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+	draw: Draw;
+
+include "bufio.m";
+	bufmod : Bufio;
+Iobuf : import bufmod;
+
+include "string.m";
+	str : String;
+
+include "tk.m";
+	tk: Tk;
+
+include	"wmlib.m";
+	wmlib: Wmlib;
+
+# these are stand alone Tcl libraries, for Tcl pieces that
+# are "big" enough to be called their own.
+
+include "tcl.m";
+
+include "tcllib.m";
+
+include "utils.m";
+	htab: Str_Hashtab;
+	mhtab : Mod_Hashtab; 
+	shtab : Sym_Hashtab;
+	stack : Tcl_Stack;
+	utils : Tcl_Utils;
+
+Hash: import htab;
+MHash : import mhtab;
+SHash : import shtab;
+
+
+
+
+# global error flag and message. One day, this will be stack based..
+errmsg : string;
+error, mypid : int;
+
+sproc : adt {
+	name : string;
+	args : string;
+	script : string;
+};
+
+TCL_UNKNOWN, TCL_SIMPLE, TCL_ARRAY : con iota;
+
+# Global vars. Simple variables, and associative arrays.
+libmods : ref MHash;
+proctab := array[100] of sproc;
+retfl : int;
+symtab : ref SHash;
+nvtab : ref Hash;
+avtab : array of (ref Hash,string);
+tclmod : TclData;
+
+core_commands:=array[] of {		
+	"append" , "array", "break" , "continue" , "catch", "dumpstack",  
+	"exit" , "expr" , "eval" ,
+	"for" , "foreach" , 
+	"global" , "if" , "incr" , "info", 
+	"lappend" , "level" , "load" ,
+	"proc" , "return" , "set" ,
+	"source" ,"switch" , "time" ,
+	"unset" , "uplevel", "upvar", "while" , "#" 
+};
+		
+
+about() : array of string {
+	return core_commands;
+}
+		
+init(ctxt: ref Draw->Context, argv: list of string) {
+	sys = load Sys Sys->PATH;
+	draw = load Draw Draw->PATH;
+	bufmod = load Bufio Bufio->PATH;
+	htab = load Str_Hashtab Str_Hashtab->PATH;
+	mhtab = load Mod_Hashtab Mod_Hashtab->PATH;
+	shtab = load Sym_Hashtab Sym_Hashtab->PATH;
+	stack = load Tcl_Stack Tcl_Stack->PATH;
+	str = load String String->PATH;
+	utils = load Tcl_Utils Tcl_Utils->PATH;
+	tk = load Tk Tk->PATH;
+	wmlib= load Wmlib Wmlib->PATH;
+	if (bufmod == nil || htab == nil || stack == nil ||
+		str == nil || utils == nil || tk == nil ||
+		wmlib==nil || mhtab == nil || shtab == nil){
+		sys->print("can't load initial modules %r\n");
+		exit;
+	}	
+
+	# get a new stack frame.
+	stack->init();
+	(nvtab,avtab,symtab)=stack->newframe();
+	
+	libmods=mhtab->alloc(101);
+
+	# grab my pid, and set a new group to make me easy to kill.
+	mypid=sys->pctl(sys->NEWPGRP, nil);
+
+	# no default top window.
+	tclmod.top=nil;
+	tclmod.context=ctxt;
+	tclmod.debug=0;
+
+	# set up library modules.
+	args:=array[] of {"do_load","io"};
+	do_load(args);
+	args=array[] of {"do_load","string"};
+	do_load(args);
+	args=array[] of {"do_load","calc"};
+	do_load(args);
+	args=array[] of {"do_load","list"};
+	do_load(args);
+	args=array[] of {"do_load","tk"};
+	do_load(args);
+	arr:=about();
+	for(i:=0;i<len arr;i++)
+		libmods.insert(arr[i],nil);
+
+	# cmd line args...
+	if (argv != nil)
+		argv = tl argv;
+	while (argv != nil) {
+		loadfile(hd argv);
+		argv = tl argv;
+	}
+	
+}
+
+set_top(win:ref Tk->Toplevel){
+	tclmod.top=win;
+}
+
+clear_error(){
+	error=0;
+	errmsg="";
+}
+
+notify(num : int,s : string) : string {
+	error=1;
+	case num{
+		1 =>
+			errmsg=sys->sprint(
+			"wrong # args: should be \"%s\"",s);
+		* =>
+			errmsg= s;
+	}
+	return errmsg;
+}
+			
+grab_lines(new_inp,unfin: string ,lines : chan of string){
+	error=0;
+	tclmod.lines=lines;
+	input,line : string;
+	if (new_inp==nil)
+		new_inp = "tcl%";
+	if (unfin==nil)
+		unfin = "tcl>";
+	sys->print("%s ", new_inp);
+	iob := bufmod->fopen(sys->fildes(0),bufmod->OREAD);
+	if (iob==nil){
+		sys->print("cannot open stdin for reading.\n");
+		return;
+	}
+	while((input=iob.gets('\n'))!=nil){
+		line+=input;
+		if (!finished(line,0))
+			sys->print("%s ", unfin);
+		else{
+			lines <- = line;
+			line=nil;
+		}
+	}
+}
+
+# this is the main function. Its input is a complete (i.e. matching 
+# brackets etc) tcl script, and its output is a message - if there 
+# is one.
+evalcmd(s: string, termchar: int) : string {
+	msg : string;
+	i:=0;
+	retfl=0;
+	if (tclmod.debug==2)
+		sys->print("Entered evalcmd, s=%s, termchar=%c\n",s,termchar);
+	# strip null statements..
+	while((i<len s) && (s[i]=='\n' || s[i]==';')) i++;
+	if (i==len s) return nil;
+
+	# parse the script statement by statement
+	for(;s!=nil;i++){
+		# wait till we have a complete statement
+		if (i==len s || ((s[i]==termchar || s[i]==';' || s[i]=='\n')
+			&& finished(s[0:i],termchar))){
+			# throw it away if its a comment...
+			if (s[0]!='#')
+				argv := parsecmd(s[0:i],termchar,0);
+			msg = nil;			
+			if (tclmod.debug==2)
+				for(k:=0;k<len argv;k++)
+				sys->print("argv[%d]: (%s)\n",k,argv[k]);
+
+			# argv is now a completely parsed array of arguments
+			# for the Tcl command..
+			
+			# find the module that the command is in and 
+			# 	execute it.
+			if (len argv != 0){
+				mod:=lookup(argv[0]);
+				if (mod!=nil){
+					(error,msg)= 
+					   mod->exec(ref tclmod,argv);
+					if (error)
+						errmsg=msg;
+				} else {
+					if (argv[0]!=nil && 
+						argv[0][0]=='.')
+						msg=do_tk(argv);
+					else
+						msg=exec(argv);
+				}
+			}
+
+			# was there an error?
+			if (error) {
+				if (len argv > 0 && argv[0]!=""){
+					stat : string;
+					stat = "In function "+argv[0];
+					if (len argv >1 && argv[1]!=""){
+						stat[len stat]=' ';
+						stat+=argv[1];
+					}
+					stat+=".....\n\t";
+					errmsg=stat+errmsg;
+				}
+				msg=errmsg;
+			}
+
+			# we stop parsing if we hit a break, continue, return,
+			# error, termchar or end of string.
+			if (msg=="break" || msg=="continue" || error || retfl==1
+				|| len s <= i || (len s > i && s[i]==termchar))
+				return msg;
+
+			# otherwise eat up the parsed statement and continue
+			s=s[i+1:];
+			i=-1;
+		}
+	}
+	return msg;
+}
+
+				
+# returns 1 if the line has matching braces, brackets and 
+# double-quotes and does not end in "\\\n"
+finished(s : string, termchar : int) : int {
+	cb:=0;
+	dq:=0;
+	sb:=0;
+	if (s==nil) return 1;
+	if (termchar=='}') cb++;
+	if (termchar==']') sb++;
+	if (len s > 1 && s[len s -2]=='\\')
+		return 0;
+	if (s[0]=='{') cb++;
+	if (s[0]=='}' && cb>0) cb--;
+	if (s[0]=='[') sb++;
+	if (s[0]==']' && sb>0) sb--;
+	if (s[0]=='"') dq=1-dq;
+	for(i:=1;i<len s;i++){
+		if (s[i]=='{' && s[i-1]!='\\') cb++;
+		if (s[i]=='}' && s[i-1]!='\\' && cb>0) cb--;
+		if (s[i]=='[' && s[i-1]!='\\') sb++;
+		if (s[i]==']' && s[i-1]!='\\' && sb>0) sb--;
+		if (s[i]=='"' && s[i-1]!='\\') dq=1-dq;
+	}
+	return (cb==0 && sb==0 && dq==0);
+}
+
+# counts the offset till the next matching ']'
+strip_to_match(s : string, ptr: int) : int {
+	j :=0;
+	nb:=0;
+	while(j<len s){
+		if (s[j]=='{')
+			while (j < len s && s[j]!='}') j++;
+		if (s[j]=='[') nb++;
+		if (s[j]==']'){
+			nb--;
+			if (nb==-1) return ptr+j;
+		}
+		j++;
+	}
+	return ptr+j;
+}
+
+# returns the type of variable represented by the string s, which is
+# a name.
+isa(s: string) : (int,int,string) {
+	found,val : int;
+	name,al : string;
+	curlev:=stack->level();
+	if (tclmod.debug==2)
+		sys->print("Called isa with %s, current stack level is %d\n",s,curlev);
+	(found,nil)=nvtab.find(s);
+	if (found) return (TCL_SIMPLE,curlev,s);
+	for (i:=0;i<len avtab;i++){
+		(nil,name)=avtab[i];
+		if (name==s) return (TCL_ARRAY,curlev,s);	
+	}
+	if (symtab==nil)
+		return (TCL_UNKNOWN,curlev,s);
+	(found,val,al)=symtab.find(s);
+	if (!found)
+		return (TCL_UNKNOWN,curlev,s);
+	(tnv,tav,nil):=stack->examine(val);
+	if (tclmod.debug==2)
+		sys->print("have a level %d for %s\n",val,al);
+	if (tnv!=nil){
+		(found,nil)=tnv.find(al);
+		if (found) return (TCL_SIMPLE,val,al);
+	}
+	if (tav!=nil){
+		for (i=0;i<len tav;i++){
+			(nil,name)=tav[i];
+			if (name==al) return (TCL_ARRAY,val,al);	
+		}
+	}	
+	if (tclmod.debug==2)
+		sys->print("%s not found, creating at stack level %d\n",al,val);
+	return (TCL_UNKNOWN,val,al);
+}
+
+# This function only works if the string is already parsed!
+# takes a var_name and returns the hash table for it and the
+# name to look up. This is one of two things:
+# for simple variables:
+# findvar(foo) ---> (nvtab,foo)
+# for associative arrays:
+# findvar(foo(bar)) -----> (avtab[i],bar)
+# where avtab[i].name==foo
+# if create is 1, then an associative array is created upon first
+# reference.
+# returns (nil,error message) if there is a problem.
+
+find_var(s : string,create : int) : (ref Hash,string) {
+	rest,name,index : string;
+	retval,tnv : ref Hash;
+	tav : array of (ref Hash,string);
+	i,tag,lev: int;
+	(name,index)=str->splitl(s,"(");
+	if (index!=nil){
+		(index,rest)=str->splitl(index[1:],")");
+		if (rest!=")")
+			return (nil,"bad variable name");
+	}
+	(tag,lev,name) = isa(name);
+	case tag {
+		TCL_SIMPLE =>
+			if (index!=nil)
+				return (nil,"variable isn't array");
+			(tnv,nil,nil)=stack->examine(lev);
+			return (tnv,name);
+		TCL_ARRAY =>
+			if (index==nil)
+				return (nil,"variable is array");
+			(nil,tav,nil)=stack->examine(lev);
+			for(i=0;i<len tav;i++){
+				(retval,rest)=tav[i];
+				if (rest==name)
+					return (retval,index);
+			}
+			return (nil,"find_var: impossible!!");
+		# if we get here, the variable needs to be
+		# created.
+		TCL_UNKNOWN =>
+			if (!create)
+				return (nil,"no such variable");
+			(tnv,tav,nil)=stack->examine(lev);
+			if (index==nil)
+				return (tnv,name);
+		
+	}
+	# if we get here, we are creating an associative variable in the
+	# tav array.
+	for(i=0;i<len tav;i++){
+		(retval,rest)=tav[i];
+		if (rest==nil){
+			retval=htab->alloc(101);
+			tav[i]=(retval,name);
+			return (retval,index);	
+		}
+	}
+	return (nil,"associative array table full!");
+}
+
+# the main parsing function, a la ousterhouts man pages. Takes a 
+# string that is meant to be a tcl statement and parses it, 
+# reevaluating and quoting upto the termchar character. If disable 
+# is true, then whitespace is not ignored.	
+parsecmd(s: string, termchar,disable: int) : array of string {
+	argv:= array[200] of string;
+	buf,nm,id: string;
+	argc := 0;
+	nc := 0;
+	c :=0;
+	tab : ref Hash;
+	
+	if (disable && (termchar=='\n' || termchar==';')) termchar=0;
+   outer:
+	for (i := 0; i<len s ;) {
+		if ((i>0 &&s[i-1]!='\\' &&s[i]==termchar)||(s[0]==termchar))
+			break;
+		case int s[i] {
+		' ' or '\t' or '\n' =>
+			if (!disable){
+				if (nc > 0) {	# end of a word?
+					argv[argc++] = buf;
+					buf = nil;
+					nc = 0;
+				}
+				i++;
+			}
+			else 
+				buf[nc++]=s[i++];
+		'$' =>
+			if (i>0 && s[i-1]=='\\') 
+				buf[nc++]=s[i++];
+			else {
+				(nm,id) = parsename(s[i+1:], termchar);
+				if (id!=nil)
+					nm=nm+"("+id+")";
+				(tab,nm)=find_var(nm,0); #don't create var!
+				if (len nm > 0 && tab!=nil) {
+					(found, val) := tab.find(nm);
+					buf += val;
+					nc += len val;
+					#sys->print("Here s[i:] is (%s)\n",s[i:]);
+					if(nm==id)
+						while(s[i]!=')') i++;
+					else
+						if (s[i+1]=='{')
+							while(s[i]!='}') i++;
+						else
+							i += len nm;
+					if (nc==0 && (i==len s-1 ||
+							s[i+1]==' ' || 
+							s[i+1]=='\t'|| 
+							s[i+1]==termchar))
+						argv[argc++]=buf;
+				} else {
+					buf[nc++] = '$';
+				}
+				i++;
+			}
+		'{' =>
+			if (i>0 && s[i-1]=='\\') 
+				buf[nc++]=s[i++];
+			else if (s[i+1]=='}'){
+				argv[argc++] = nil;
+				buf = nil;
+				nc = 0;	
+				i+=2;
+			} else {
+				nbra := 1;
+				for (i++; i < len s; i++) {
+					if (s[i] == '{')
+						nbra++;
+					else if (s[i] == '}') {
+						nbra--;
+						if (nbra == 0) {
+							i++;
+							continue outer;
+						}
+					}
+					buf[nc++] = s[i];
+				}
+			}
+		'[' =>
+			if (i>0 && s[i-1]=='\\') 
+				buf[nc++]=s[i++];
+			else{
+				a:=evalcmd(s[i+1:],']');
+				if (error)
+					return nil;
+				if (nc>0){
+					buf+=a;
+					nc += len a;
+				} else {
+					argv[argc++] = a;
+					buf = nil;
+					nc = 0;
+				}
+				i++;
+				i=strip_to_match(s[i:],i);
+				i++;
+			}
+		'"' =>
+			if (i>0 && s[i-1]!='\\' && nc==0){
+				ans:=parsecmd(s[i+1:],'"',1);
+				#sys->print("len ans is %d\n",len ans);
+				if (len ans!=0){
+					for(;;){
+						i++;
+						if(s[i]=='"' && 
+							s[i-1]!='\\')
+						break;
+					}
+					i++;
+					argv[argc++] = ans[0];
+				} else {
+					argv[argc++] = nil;
+					i+=2;
+				}
+				buf = nil;
+				nc = 0;
+			}
+			else buf[nc++] = s[i++];	
+		* =>
+			if (s[i]=='\\'){
+				c=unesc(s[i:]);
+				if (c!=0){
+					buf[nc++] = c;
+					i+=2;
+				} else {
+					if (i+1 < len s && !(s[i+1]=='"'
+						|| s[i+1]=='$' || s[i+1]=='{' 
+						|| s[i+1]=='['))
+						buf[nc++]=s[i];
+					i++;
+				}
+				c=0;
+			} else
+				buf[nc++]=s[i++];
+		}
+	}
+	if (nc > 0)	# fix up last word if present
+		argv[argc++] = buf;
+	ret := array[argc] of string;
+	ret[0:] = argv[0:argc];
+	return ret;
+}
+
+# parses a name by Tcl rules, a valid name is either $foo, $foo(bar)
+# or ${foo}.
+parsename(s: string, termchar: int) : (string,string) {
+	ret,arr,rest: string;
+	rets : array of string;
+	if (len s == 0)
+		return (nil,nil);
+	if (s[0]=='{'){
+		(ret,nil)=str->splitl(s,"}");
+		#sys->print("returning [%s]\n",ret[1:]);
+		return (ret[1:],nil);
+	}
+	loop: for (i := 0; i < len s && s[i] != termchar; i++) {
+		case (s[i]) {
+		'a' to 'z' or 'A' to 'Z' or '0' to '9' or '_' =>
+			ret[i] = s[i];
+		* =>
+			break loop;
+		'(' =>
+			arr=ret[0:i];
+			rest=s[i+1:];
+			rets=parsecmd(rest,')',0);
+			# should always be len 1?
+			if (len rets >1)
+				sys->print("len rets>1 in parsename!\n");
+			return (arr,rets[0]);
+		}
+	}
+	return (ret,nil);
+}
+
+loadfile(file :string) : string {
+	iob : ref Iobuf;
+	msg,input,line : string;
+	if (file==nil)
+		return nil;	
+	iob = bufmod->open(file,bufmod->OREAD);
+	if (iob==nil)
+		return notify(0,sys->sprint(
+			"couldn't read file \"%s\":%r",file));
+	while((input=iob.gets('\n'))!=nil){
+		line+=input;
+		if (finished(line,0)){
+			# put in a return catch here...
+			line = prepass(line);
+			msg=evalcmd(line,0);
+			if (error) return errmsg;
+			line=nil;
+		}
+	}
+	return msg;
+}
+
+
+#unescapes a string. Can do better.....
+unesc(s: string) : int {
+	c: int;
+	if (len s == 1) return 0;
+	case s[1] {
+		'a'=>   c = '\a';
+		'n'=>	c = '\n';
+		't'=>	c = '\t';
+		'r'=>	c = '\r';
+		'b'=>	c = '\b';
+		'\\'=>	c = '\\';
+		'}' =>  c = '}';
+		']' =>  c=']';
+		# do hex and octal.
+		* =>	c = 0;
+	}
+	return c;
+}
+
+# prepass a string and replace "\\n[ \t]*" with ' '
+prepass(s : string) : string {
+	for(i := 0; i < len s; i++) {
+		if(s[i] != '\\')
+			continue;
+		j:=i;
+		if (s[i+1] == '\n') {
+			s[j]=' ';  
+			i++;
+			while(i<len s && (s[i]==' ' || s[i]=='\t'))
+				i++;
+			if (i==len s)
+				s = s[0:j];
+			else
+				s=s[0:j]+s[i+1:];
+		i=j;
+		}
+	}
+	return s;
+}
+
+exec(argv : array of string) : string {
+	msg : string;
+	if (argv[0]=="")
+		return nil;
+	case (argv[0]) {		
+		"append" =>
+			msg= do_append(argv);
+		"array" =>
+			msg= do_array(argv);
+		"break" or "continue" =>
+			return argv[0];
+		"catch" =>
+			msg=do_catch(argv);
+		"debug" =>
+			msg=do_debug(argv);
+		"dumpstack" =>
+			msg=do_dumpstack(argv);
+		"exit" =>
+			do_exit();
+		"expr" =>
+			msg = do_expr(argv);
+		"eval" =>
+			msg = do_eval(argv);
+		"for" =>
+			msg = do_for(argv);
+		"foreach" =>
+			msg = do_foreach(argv);
+		"format" =>
+			msg = do_string(argv);
+		"global" =>
+			msg = do_global(argv);
+		"if" =>
+			msg = do_if(argv);
+		"incr" =>
+			msg = do_incr(argv);
+		"info" =>
+			msg = do_info(argv);
+		"lappend" =>
+			msg = do_lappend(argv);
+		"level" =>
+			msg=sys->sprint("Current Stack "+
+			    "level is %d",
+				stack->level());
+		"load" =>
+			msg=do_load(argv);
+		"proc" =>
+			msg=do_proc(argv);
+		"return" =>
+			msg=do_return(argv);
+			retfl =1;
+		"set" =>
+			msg = do_set(argv);
+		"source" =>
+			msg = do_source(argv);
+		"string" =>
+			msg = do_string(argv);
+		"switch" => 
+			msg = do_switch(argv);
+		"time" =>
+			msg=do_time(argv);
+		"unset" =>
+			msg = do_unset(argv);
+		"uplevel" =>
+			msg=do_uplevel(argv);
+		"upvar" =>
+			msg=do_upvar(argv);		
+		"while" =>
+			msg = do_while(argv);
+		"#" => 
+			msg=nil;
+		* =>	
+			msg = uproc(argv);
+	}
+	return msg;
+}
+
+# from here on is the list of commands, alpahabetised, we hope.
+
+do_append(argv :array of string) : string {
+	tab : ref Hash;
+	if (len argv==1 || len argv==2)
+		 return notify(1,
+			"append varName value ?value ...?");
+	name := argv[1];
+	(tab,name)=find_var(name,1);
+	if (tab==nil)
+		return notify(0,name);
+	(found, val) := tab.find(name);
+	for (i:=2;i<len argv;i++)
+		val+=argv[i];
+	tab.insert(name,val);	
+	return val;
+}
+
+do_array(argv : array of string) : string {
+	tab : ref Hash;
+	name : string;
+	flag : int;
+	if (len argv!=3)
+		return notify(1,"array [names, size] name");
+	case argv[1] {
+		"names" =>
+			flag=1;
+		"size" =>
+			flag=0;
+		* =>
+			return notify(0,"expexted names or size, got "+argv[1]);
+			
+	}
+	(tag,lev,al) := isa(argv[2]);
+	if (tag!=TCL_ARRAY)
+		return notify(0,argv[2]+" isn't an array");
+	(nil,tav,nil):=stack->examine(lev);
+	for (i:=0;i<len tav;i++){
+		(tab,name)=tav[i];
+		if (name==al) break;
+	}
+	if (flag==0)
+		return string tab.lsize;
+	return tab.dump();
+}
+
+do_catch(argv : array of string) : string {
+	if (len argv==1 || len argv > 3)
+		return notify(1,"catch command ?varName?");
+	msg:=evalcmd(argv[1],0);
+	if (len argv==3 && error){
+		(tab,name):=find_var(argv[2],1);
+		if (tab==nil)
+			return notify(0,name);
+		tab.insert(name, msg);
+	}
+	ret:=string error;
+	error=0;
+	return ret;
+}
+
+do_debug(argv : array of string) : string {
+	add : string;
+	if (len argv!=2)
+		return notify(1,"debug");
+	(i,rest):=str->toint(argv[1],10);
+	if (rest!=nil)
+		return notify(0,"Expected integer and got "+argv[1]);
+	tclmod.debug=i;
+	if (tclmod.debug==0)
+		add="off";
+	else
+		add="on";
+	return "debugging is now "+add+" at level"+ string i;
+} 
+
+do_dumpstack(argv : array of string) : string {
+	if (len argv!=1)
+		return notify(1,"dumpstack");
+	stack->dump();
+	return nil;
+}
+	
+do_eval(argv : array of string) : string {
+	eval_str : string;
+	for(i:=1;i<len argv;i++){
+		eval_str += argv[i];
+		eval_str[len eval_str]=' ';
+	}
+	return evalcmd(eval_str[0:len eval_str -1],0);
+}
+
+do_exit(){
+	kfd := sys->open("#p/"+string mypid+"/ctl", sys->OWRITE);
+	if(kfd == nil) 
+		sys->print("error opening pid %d (%r)\n",mypid);
+	sys->fprint(kfd, "killgrp");
+	exit;
+}
+
+
+
+do_expr(argv : array of string) : string {
+	retval : string;
+	for (i:=1;i<len argv;i++){
+		retval+=argv[i];
+		retval[len retval]=' ';
+	}
+	retval=retval[0: len retval -1];
+	argv=parsecmd(retval,0,0);
+	cal:=lookup("calc");
+	(err,ret):= cal->exec(ref tclmod,argv);
+	if (err) return notify(0,ret);
+	return ret;
+}
+
+
+do_for(argv : array of string) : string {
+	if (len argv!=5)
+		return notify(1,"for start test next command");
+	test := array[] of {"expr",argv[2]};
+	evalcmd(argv[1],0);
+	for(;;){
+		msg:=do_expr(test);
+		if (msg=="Error!")
+		return notify(0,sys->sprint(
+			"syntax error in expression \"%s\"",
+					argv[2]));
+		if (msg=="0")
+			return nil;
+		msg=evalcmd(argv[4],0);
+		if (msg=="break")
+			return nil;
+		if (msg=="continue"); #do nothing!
+		evalcmd(argv[3],0);
+		if (error)
+			return errmsg;
+	}
+}
+
+
+
+do_foreach(argv: array of string) : string{
+	tab : ref Hash;
+	if (len argv!=4)
+		return notify(1,"foreach varName list command");
+	name := argv[1];
+	(tab,name)=find_var(name,1);
+	if (tab==nil)
+		return notify(0,name);
+	arr:=utils->break_it(argv[2]);
+	for(i:=0;i<len arr;i++){
+		tab.insert(name,arr[i]);
+		evalcmd(argv[3],0);
+	}	
+	return nil;
+}
+
+
+
+do_global(argv : array of string) : string {
+	if (len argv==1)
+		return notify(1,"global varName ?varName ...?");
+	if (symtab==nil)
+		return nil;
+	for (i:=1 ; i < len argv;i++)
+		symtab.insert(argv[i],argv[i],0);
+	return nil;
+}
+
+
+	
+do_if(argv : array of string) : string {
+	if (len argv==1)
+		return notify(1,"no expression after \"if\" argument");
+	expr1 := array[] of {"expr",argv[1]};
+	msg:=do_expr(expr1);
+	if (msg=="Error!")
+		return notify(0,sys->sprint(
+			"syntax error in expression \"%s\"",
+					argv[1]));
+	if (len argv==2)
+		return notify(1,sys->sprint(
+			"no script following \""+
+					"%s\" argument",msg));
+	if (msg=="0"){
+		if (len argv>3){
+			if (argv[3]=="else"){
+				if (len argv==4)
+					return notify(1,
+					"no script"+
+				" following \"else\" argument");
+				return evalcmd(argv[4],0);
+			}
+			if (argv[3]=="elseif"){
+				argv[3]="if";
+				return do_if(argv[3:]);
+			}
+		}
+		return nil;
+	}
+	return evalcmd(argv[2],0);
+}
+
+do_incr(argv :array of string) : string {
+	num,xtra : int;
+	rest :string;
+	tab : ref Hash;
+	if (len argv==1)
+		return notify(1,"incr varName ?increment?");
+	name := argv[1];
+	(tab,name)=find_var(name,0); #doesn't create!!
+	if (tab==nil)
+		return notify(0,name);
+	(found, val) := tab.find(name);
+	if (!found)
+		return notify(0,sys->sprint("can't read \"%s\": "
+			+"no such variable",name));
+	(num,rest)=str->toint(val,10);
+	if (rest!=nil)
+		return notify(0,sys->sprint(
+			"expected integer but got \"%s\"",val));
+	if (len argv == 2){	
+		num+=1;
+		tab.insert(name,string num);
+	}
+	if (len argv == 3) {
+		val = argv[2];
+		(xtra,rest)=str->toint(val,10);
+		if (rest!=nil)
+			return notify(0,sys->sprint(
+				"expected integer but got \"%s\""
+							,val));
+		num+=xtra;
+		tab.insert(name, string num);
+	} 
+	return string num;
+}
+
+do_info(argv : array of string) : string {
+	if (len argv==1)
+		return notify(1,"info option ?arg arg ...?");
+	case argv[1] {
+		"args" =>
+			return do_info_args(argv,0);
+		"body" =>
+			return do_info_args(argv,1); 
+		"commands" =>
+			return do_info_commands(argv);
+		"exists" =>
+			return do_info_exists(argv);
+		"procs" =>
+			return do_info_procs(argv);
+
+	}
+	return sys->sprint(
+	"bad option \"%s\": should be args, body, commands, exists, procs",
+			argv[1]);
+}
+
+do_info_args(argv : array of string,body :int) : string { 
+	name: string;
+	s : sproc;
+	if (body)
+		name="body";
+	else
+		name="args";
+	if (len argv!=3)
+		return notify(1,"info "+name+" procname");
+	for(i:=0;i<len proctab;i++){
+		s=proctab[i];
+		if (s.name==argv[2])
+			break;
+	}
+	if (i==len proctab)
+		return notify(0,argv[2]+" isn't a procedure.");
+	if (body)
+		return s.script;
+	return s.args;
+}
+	
+do_info_commands(argv : array of string) : string { 
+	if (len argv==1 || len argv>3)
+		return notify(1,"info commands [pattern]");
+	return libmods.dump();
+}		
+
+do_info_exists(argv : array of string) : string { 
+	name, index : string;
+	tab : ref Hash;
+	if (len argv!=3)
+		return notify(1,"info exists varName");
+	(name,index)=parsename(argv[2],0);
+	(i,nil,nil):=isa(name);
+	if (i==TCL_UNKNOWN)
+		return "0";
+	if (index==nil)
+		return "1";
+	(tab,name)=find_var(argv[2],0);
+	if (tab==nil)
+		return "0";
+	(found, val) := tab.find(name);
+	if (!found)
+		return "0";
+	return "1";	
+	
+}
+
+do_info_procs(argv : array of string) : string { 
+	if (len argv==1 || len argv>3)
+		return notify(1,"info procs [pattern]");
+	retval : string;
+	for(i:=0;i<len proctab;i++){
+		s:=proctab[i];
+		if (s.name!=nil){
+			retval+=s.name;
+			retval[len retval]=' ';
+		}
+	}
+	return retval;			
+}
+	
+do_lappend(argv : array of string) : string{
+	tab : ref Hash;
+	retval :string;
+	retval=nil;
+	if (len argv==1 || len argv==2)
+		return notify(1,
+			"lappend varName value ?value ...?");
+	name := argv[1];
+	(tab,name)=find_var(name,1);
+	if (tab==nil)
+		return notify(0,name);
+	(found, val) := tab.find(name);
+	for(i:=2;i<len argv;i++){
+		flag:=0;
+		if (spaces(argv[i])) flag=1;
+		if (flag) retval[len retval]='{';
+		retval += argv[i];
+		if (flag) retval[len retval]='}';
+		retval[len retval]=' ';
+	}
+	if (retval!=nil)
+		retval=retval[0:len retval-1];	
+	if (val!=nil)
+		retval=val+" "+retval;
+	tab.insert(name,retval);	
+	return retval;
+}
+
+spaces(s : string) : int{
+	if (s==nil) return 1;
+	for(i:=0;i<len s;i++)
+		if (s[i]==' ' || s[i]=='\t') return 1;
+	return 0;
+}
+
+do_load(argv : array of string) : string {
+	# look for a dis library to load up, then
+	# add to library array.
+	if (len argv!=2)
+		return notify(1,"load libname");
+	fname:="/dis/lib/tcl_"+argv[1]+".dis";
+	mod:= load TclLib fname;
+	if (mod==nil)
+		return notify(0,
+			sys->sprint("Cannot load %s",fname));
+	arr:=mod->about();
+	for(i:=0;i<len arr;i++)
+		libmods.insert(arr[i],mod);
+	return nil;
+}
+	
+	
+do_proc(argv : array of string) : string {
+	if (len argv != 4)
+		return notify(1,"proc name args body");
+	for(i:=0;i<len proctab;i++)
+		if (proctab[i].name==nil || 
+			proctab[i].name==argv[1]) break;
+	if (i==len proctab)
+		return notify(0,"procedure table full!");
+	proctab[i].name=argv[1];
+	proctab[i].args=argv[2];
+	proctab[i].script=argv[3];
+	return nil;
+}
+
+do_return(argv : array of string) : string {
+	if (len argv==1)
+		return nil;
+	# put in options here.....
+	return argv[1];
+}
+	
+do_set(argv : array of string) : string {
+	tab : ref Hash;
+	if (len argv == 1 || len argv > 3)
+		return notify(1,"set varName ?newValue?");
+	name := argv[1];
+	(tab,name)=find_var(name,1);
+	if (tab==nil)
+		return notify(0,name);
+	(found, val) := tab.find(name);
+	if (len argv == 2)
+		if (!found)
+			val = notify(0,sys->sprint(
+				"can't read \"%s\": "
+				+"no such variable",name));
+	if (len argv == 3) {
+		val = argv[2];
+		tab.insert(name, val);
+	} 
+	return val;
+}
+
+do_source(argv : array of string) : string {
+	if (len argv !=2)
+		return notify(1,"source fileName");
+	return loadfile(argv[1]);
+}
+
+do_string(argv : array of string) : string {
+	stringmod := lookup("string");
+	if (stringmod==nil)
+		return notify(0,sys->sprint(
+		"String Package not loaded (%r)"));
+	(err,retval):= stringmod->exec(ref tclmod,argv);
+	if (err) return notify(0,retval);
+	return retval;
+}
+
+do_switch(argv : array of string) : string {
+	i:=0;
+	arr : array of string;
+	if (len argv < 3)
+		return notify(1,"switch "
+			+"?switches? string pattern body ... "+
+			"?default body?\"");
+	if (len argv == 3)
+		arr=utils->break_it(argv[2]);
+	else 
+		arr=argv[2:];
+	if (len arr % 2 !=0)
+		return notify(0,
+			"extra switch pattern with no body");
+	for (i=0;i<len arr;i+=2)
+		if (argv[1]==arr[i])
+			break;
+	if (i==len arr){
+		if (arr[i-2]=="default")
+			return evalcmd(arr[i-1],0);
+		else return nil;
+	}
+	while (i<len arr && arr[i+1]=="-") i+=2;
+	return evalcmd(arr[i+1],0);
+}	
+
+do_time(argv : array of string) : string {
+	rest : string;
+	end,start,times : int;
+	if (len argv==1 || len argv>3)
+		return notify(1,"time command ?count?");
+	if (len argv==2)
+		times=1;
+	else{
+		(times,rest)=str->toint(argv[2],10);
+		if (rest!=nil)
+			return notify(0,sys->sprint(
+				"expected integer but got \"%s\"",argv[2]));
+	}
+	start=sys->millisec();
+	for(i:=0;i<times;i++)
+		evalcmd(argv[1],0);
+	end=sys->millisec();
+	r:= (real end - real start) / real times;
+	return sys->sprint("%g milliseconds per iteration", r);
+}
+
+do_unset(argv : array of string) : string {
+	tab : ref Hash;
+	name: string;
+	if (len argv == 1)
+		return notify(1,"unset "+
+			"varName ?varName ...?");
+	for(i:=1;i<len argv;i++){
+		name = argv[i];
+		(tab,name)=find_var(name,0);
+		if (tab==nil)
+			return notify(0,sys->sprint("can't unset \"%s\": no such" +
+					" variable",name));
+		tab.delete(name);
+
+	}
+	return nil;
+}
+
+do_uplevel(argv : array of string) : string {
+	level: int;
+	rest,scr : string;
+	scr=nil;
+	exact:=0;
+	i:=1;
+	if (len argv==1)
+		return notify(1,"uplevel ?level? command ?arg ...?");
+	if (len argv==2)
+		level=-1;
+	else {
+		lev:=argv[1];
+		if (lev[0]=='#'){
+			exact=1;
+			lev=lev[1:];
+		}
+		(level,rest)=str->toint(lev,10);
+		if (rest!=nil){
+			i=2;	
+			level =-1;
+		}
+	}
+	oldlev:=stack->level();
+	if (!exact)
+		level+=oldlev;
+	(tnv,tav,sym):=stack->examine(level);
+	if (tnv==nil && tav==nil)
+		return notify(0,"bad level "+argv[1]);
+	if (tclmod.debug==2)
+		sys->print("In uplevel, current level is %d, moving to level %d\n",
+				oldlev,level);
+	stack->move(level);
+	oldav:=avtab;
+	oldnv:=nvtab;
+	oldsym:=symtab;
+	avtab=tav;
+	nvtab=tnv;
+	symtab=sym;
+	for(;i<len argv;i++)
+		scr=scr+argv[i]+" ";
+	msg:=evalcmd(scr[0:len scr-1],0);
+	avtab=oldav;
+	nvtab=oldnv;
+	symtab=oldsym;
+	ok:=stack->move(oldlev);
+	if (tclmod.debug==2)
+		sys->print("Leaving uplevel, current level is %d, moving back to"+
+				" level %d,move was %d\n",
+				level,oldlev,ok);
+	return msg;
+}
+				
+do_upvar(argv : array of string) : string {
+	level:int;
+	rest:string;
+	i:=1;
+	exact:=0;
+	if (len argv<3 || len argv>4)
+		return notify(1,"upvar ?level? ThisVar OtherVar");
+	if (len argv==3)
+		level=-1;
+	else {
+		lev:=argv[1];
+		if (lev[0]=='#'){
+			exact=1;
+			lev=lev[1:];
+		}
+		(level,rest)=str->toint(lev,10);
+		if (rest!=nil){
+			i=2;	
+			level =-1;
+		}
+	}
+	if (!exact)
+		level+=stack->level();
+	symtab.insert(argv[i],argv[i+1],level);
+	return nil;
+}	
+				
+do_while(argv : array of string) : string {
+	if (len argv!=3)
+		return notify(1,"while test command");
+	for(;;){
+		expr1 := array[] of {"expr",argv[1]};
+		msg:=do_expr(expr1);
+		if (msg=="Error!")
+			return notify(0,sys->sprint(
+			"syntax error in expression \"%s\"",
+					argv[1]));
+		if (msg=="0")
+			return nil;
+		evalcmd(argv[2],0);
+		if (error)
+			return errmsg;
+	}
+}
+
+uproc(argv : array of string) : string {
+	cmd,add : string;
+	for(i:=0;i< len proctab;i++)
+		if (proctab[i].name==argv[0])
+			break;
+	if (i==len proctab)
+		return notify(0,sys->sprint("invalid command name \"%s\"",
+				argv[0]));
+	# save tables
+	# push a newframe
+	# bind args to arguments
+	# do cmd
+	# pop frame
+	# return msg
+
+	# globals are supported, but upvar and uplevel are not!
+
+	arg_arr:=utils->break_it(proctab[i].args);
+	j:=len arg_arr;
+	if (len argv < j+1 && arg_arr[j-1]!="args"){
+		j=len argv-1;
+		return notify(0,sys->sprint(
+			"no value given for"+
+			" parameter \"%s\" to \"%s\"",
+			arg_arr[j],proctab[i].name));
+	}
+	if ((len argv > j+1) && arg_arr[j-1]!="args")
+		return notify(0,"called "+proctab[i].name+
+					" with too many arguments");
+	oldavtab:=avtab;
+	oldnvtab:=nvtab;
+	oldsymtab:=symtab;
+	(nvtab,avtab,symtab)=stack->newframe();
+	for (j=0;j< len arg_arr-1;j++){
+		cmd="set "+arg_arr[j]+" {"+argv[j+1]+"}";
+		evalcmd(cmd,0);
+	}
+	if (len arg_arr>j && arg_arr[j] != "args") {
+		cmd="set "+arg_arr[j]+" {"+argv[j+1]+"}";
+		evalcmd(cmd,0);
+	}
+	else {
+		if (len arg_arr > j) {
+			if (j+1==len argv)
+				add="";
+			else
+				add=argv[j+1];
+			cmd="set "+arg_arr[j]+" ";
+			arglist:="{"+add+" ";
+			j++;
+			while(j<len argv-1) {
+				arglist+=argv[j+1];
+				arglist[len arglist]=' ';
+				j++;
+			}
+			arglist[len arglist]='}';
+			cmd+=arglist;
+			evalcmd(cmd,0);
+		}
+	}
+	msg:=evalcmd(proctab[i].script,0);
+	stack->pop();
+	avtab=oldavtab;
+	nvtab=oldnvtab;
+	symtab=oldsymtab;
+	#sys->print("Error is %d, msg is %s\n",error,msg);
+	return msg;
+}
+		
+do_tk(argv : array of string) : string {
+	tkpack:=lookup("button");
+	(err,retval):= tkpack->exec(ref tclmod,argv);
+	if (err) return notify(0,retval);
+	return retval;
+}
+
+
+lookup(s : string) : TclLib {
+	(found,mod):=libmods.find(s);
+	if (!found)
+		return nil;
+	return mod;
+}