diff options
Diffstat (limited to 'appl/lib/tcl_string.b')
| -rw-r--r-- | appl/lib/tcl_string.b | 246 |
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; +} |