20060303a

1 files changed, 246 insertions, 0 deletions

diff --git a/appl/lib/tcl_string.b b/appl/lib/tcl_string.b
new file mode 100644
index 00000000..088390df
--- /dev/null
+++ b/appl/lib/tcl_string.b
@@ -0,0 +1,246 @@
+implement TclLib;
+
+include "sys.m";
+	sys: Sys;
+include "draw.m";
+include "tk.m";
+include "bufio.m";
+	bufmod : Bufio;
+Iobuf : import bufmod;
+
+include "string.m";
+	str : String;
+include "tcl.m";
+include "tcllib.m";
+
+error : int;
+started : int;
+valid_commands:=array[] of {"format","string"};
+
+about() : array of string{
+	return valid_commands;
+}
+
+init(){
+	started=1;
+	sys=load Sys Sys->PATH;
+}
+
+exec(tcl : ref Tcl_Core->TclData,argv : array of string) : (int,string) {
+	if (tcl.context==nil);
+	if (!started) init();
+	error=0;
+	str=load String String->PATH;
+	if (str==nil)
+		return(1,"String module not loaded.");
+	if (len argv==1 && argv[0]=="string")
+		return (error,
+			notify(1,"string option arg ?arg ...?"));
+	case argv[0]{
+		"format" =>
+			return (error,do_format(argv));
+		"string" =>
+			return (error,do_string(argv));
+	}
+	return (1,nil);
+}
+
+
+do_string(argv : array of string) : string{
+	case argv[1]{
+		"compare" =>
+			if (len argv == 4){
+				i:= - (argv[2]<argv[3])+ (argv[2]>argv[3]);
+				return string i;
+			}
+			return notify(1,
+			     "string compare string1 string2");
+		"first" =>
+			return nil;
+		"last" =>
+			return nil;
+		"index" =>
+			if (len argv == 4){
+				if (len argv[2] > int argv[3])
+					return argv[2][int argv[3]:int argv[3]+1];
+				return nil;
+			}
+			return notify(1,
+			     "string index string charIndex");
+		"length" =>
+			if (len argv==3)
+				return string len argv[2];
+			return notify(1,"string length string");
+		"match" =>
+			return nil;
+		"range" =>
+			if (len argv==5){
+				end :int;
+				if (argv[4]=="end") 
+					end=len argv[2];
+				else
+					end=int argv[4];
+				if (end>len argv[2]) end=len argv[2];
+				beg:=int argv[3];
+				if (beg<0) beg=0;
+				if (beg>end)
+					return nil;
+				return argv[2][int argv[3]:end];
+			}
+			return notify(1,
+			     "string range string first last");
+		"tolower" =>
+			if (len argv==3)
+				return str->tolower(argv[2]);
+			return notify(1,"string tolower string");
+		"toupper" =>
+			if (len argv==3)
+				return str->tolower(argv[2]);
+			return notify(1,"string tolower string");
+		"trim" =>
+			return nil;
+		"trimleft" =>
+			return nil;
+		"trimright" =>
+			return nil;
+		"wordend" =>
+			return nil;
+		"wordstart" =>
+			return nil;
+	}
+	return nil;
+}
+
+do_format(argv : array of string) : string {
+	retval,num1,num2,rest,curfm : string;
+	i,j : int;
+	if (len argv==1)
+		return notify(1,
+			"format formatString ?arg arg ...?");
+	j=2;
+	i1:=-1;
+	i2:=-1;
+	(retval,rest)=str->splitl(argv[1],"%");
+	do {
+		(curfm,rest)=str->splitl(rest[1:],"%");
+		i=0;
+		num1="";
+		num2="";
+		if (curfm[i]=='-'){
+			num1[len num1]=curfm[i];
+			i++;
+		}
+		while(curfm[i]>='0' && curfm[i]<='9'){
+			num1[len num1]=curfm[i];
+			i++;
+		}
+		if (num1!="")
+			(i1,nil) = str->toint(num1,10);
+		if (curfm[i]=='.'){
+			i++;
+			while(curfm[i]>='0' && curfm[i]<='9'){
+				num2[len num2]=curfm[i];
+				i++;
+			}
+			(i2,nil) = str->toint(num2,10);
+		} else {
+			i2=i1;
+			i1=-1;
+		}
+		case curfm[i] {
+			's' =>
+				retval+=print_string(i1,i2,argv[j]);
+			'd' => 
+				retval+=print_int(i1,i2,argv[j]);
+			'f' =>
+				retval+=print_float(i1,i2,argv[j]);
+			'x' =>
+				retval+=print_hex(i1,i2,argv[j]);
+		}
+		j++;
+	} while (rest!=nil && j<len argv);
+	return retval;
+}
+
+notify(num : int,s : string) : string {
+	error=1;
+	case num{
+		1 =>
+			return sys->sprint(
+			"wrong # args: should be \"%s\"",s);
+		* =>
+			return s;
+	}
+}
+
+print_string(i1,i2 : int, s : string) : string {
+	retval : string;
+	if (i1==-1 && i2==-1)
+		retval=sys->sprint("%s",s);
+	if (i1==-1 && i2!=-1)
+		retval=sys->sprint("%*s",i1,s);
+	if (i1!=-1 && i2!=-1)
+		retval=sys->sprint("%*.*s",i1,i2,s);
+	if (i1!=-1 && i2==-1)
+		retval=sys->sprint("%.*s",i2,s);	
+	return retval;
+}
+
+print_int(i1,i2 : int, s : string) : string {
+	retval,ret2 : string;
+	n : int;
+	(num,nil):=str->toint(s,10);
+	width:=1;
+	i:=num;
+	while((i/=10)!= 0) width++;
+	if (i2 !=-1 && width<i2) width=i2;
+	for(i=0;i<width;i++)
+		retval[len retval]='0';
+	while(width!=0){
+		retval[width-1]=num%10+'0';
+		num/=10;
+		width--;
+	}
+	if (i1 !=-1 && i1>i){
+		for(n=0;n<i1-i;n++)
+			ret2[len ret2]=' ';
+		ret2+=retval;
+		retval=ret2;
+	}
+	return retval;
+}
+
+
+print_float(i1,i2 : int, s : string) : string {
+	r:= real s;
+	retval:=sys->sprint("%*.*f",i1,i2,r);
+	return retval;
+}
+
+print_hex(i1,i2 : int, s : string) : string {
+	retval,ret2 : string;
+	n : int;
+	(num,nil):=str->toint(s,10);
+	width:=1;
+	i:=num;
+	while((i/=16)!= 0) width++;
+	if (i2 !=-1 && width<i2) width=i2;
+	for(i=0;i<width;i++)
+		retval[len retval]='0';
+	while(width!=0){
+		n=num%16;
+		if (n>=0 && n<=9)
+			retval[width-1]=n+'0';
+		else
+			retval[width-1]=n+'a'-10;
+		num/=16;
+		width--;
+	}
+	if (i1 !=-1 && i1>i){
+		for(n=0;n<i1-i;n++)
+			ret2[len ret2]=' ';
+		ret2+=retval;
+		retval=ret2;
+	}
+	return retval;
+}