xref: /inferno-os/appl/lib/tcl_string.b (revision 37da2899f40661e3e9631e497da8dc59b971cbd0) 
1implement TclLib;
2
3include "sys.m";
4	sys: Sys;
5include "draw.m";
6include "tk.m";
7include "bufio.m";
8	bufmod : Bufio;
9Iobuf : import bufmod;
10
11include "string.m";
12	str : String;
13include "tcl.m";
14include "tcllib.m";
15
16error : int;
17started : int;
18valid_commands:=array[] of {"format","string"};
19
20about() : array of string{
21	return valid_commands;
22}
23
24init(){
25	started=1;
26	sys=load Sys Sys->PATH;
27}
28
29exec(tcl : ref Tcl_Core->TclData,argv : array of string) : (int,string) {
30	if (tcl.context==nil);
31	if (!started) init();
32	error=0;
33	str=load String String->PATH;
34	if (str==nil)
35		return(1,"String module not loaded.");
36	if (len argv==1 && argv[0]=="string")
37		return (error,
38			notify(1,"string option arg ?arg ...?"));
39	case argv[0]{
40		"format" =>
41			return (error,do_format(argv));
42		"string" =>
43			return (error,do_string(argv));
44	}
45	return (1,nil);
46}
47
48
49do_string(argv : array of string) : string{
50	case argv[1]{
51		"compare" =>
52			if (len argv == 4){
53				i:= - (argv[2]<argv[3])+ (argv[2]>argv[3]);
54				return string i;
55			}
56			return notify(1,
57			     "string compare string1 string2");
58		"first" =>
59			return nil;
60		"last" =>
61			return nil;
62		"index" =>
63			if (len argv == 4){
64				if (len argv[2] > int argv[3])
65					return argv[2][int argv[3]:int argv[3]+1];
66				return nil;
67			}
68			return notify(1,
69			     "string index string charIndex");
70		"length" =>
71			if (len argv==3)
72				return string len argv[2];
73			return notify(1,"string length string");
74		"match" =>
75			return nil;
76		"range" =>
77			if (len argv==5){
78				end :int;
79				if (argv[4]=="end")
80					end=len argv[2];
81				else
82					end=int argv[4];
83				if (end>len argv[2]) end=len argv[2];
84				beg:=int argv[3];
85				if (beg<0) beg=0;
86				if (beg>end)
87					return nil;
88				return argv[2][int argv[3]:end];
89			}
90			return notify(1,
91			     "string range string first last");
92		"tolower" =>
93			if (len argv==3)
94				return str->tolower(argv[2]);
95			return notify(1,"string tolower string");
96		"toupper" =>
97			if (len argv==3)
98				return str->tolower(argv[2]);
99			return notify(1,"string tolower string");
100		"trim" =>
101			return nil;
102		"trimleft" =>
103			return nil;
104		"trimright" =>
105			return nil;
106		"wordend" =>
107			return nil;
108		"wordstart" =>
109			return nil;
110	}
111	return nil;
112}
113
114do_format(argv : array of string) : string {
115	retval,num1,num2,rest,curfm : string;
116	i,j : int;
117	if (len argv==1)
118		return notify(1,
119			"format formatString ?arg arg ...?");
120	j=2;
121	i1:=-1;
122	i2:=-1;
123	(retval,rest)=str->splitl(argv[1],"%");
124	do {
125		(curfm,rest)=str->splitl(rest[1:],"%");
126		i=0;
127		num1="";
128		num2="";
129		if (curfm[i]=='-'){
130			num1[len num1]=curfm[i];
131			i++;
132		}
133		while(curfm[i]>='0' && curfm[i]<='9'){
134			num1[len num1]=curfm[i];
135			i++;
136		}
137		if (num1!="")
138			(i1,nil) = str->toint(num1,10);
139		if (curfm[i]=='.'){
140			i++;
141			while(curfm[i]>='0' && curfm[i]<='9'){
142				num2[len num2]=curfm[i];
143				i++;
144			}
145			(i2,nil) = str->toint(num2,10);
146		} else {
147			i2=i1;
148			i1=-1;
149		}
150		case curfm[i] {
151			's' =>
152				retval+=print_string(i1,i2,argv[j]);
153			'd' =>
154				retval+=print_int(i1,i2,argv[j]);
155			'f' =>
156				retval+=print_float(i1,i2,argv[j]);
157			'x' =>
158				retval+=print_hex(i1,i2,argv[j]);
159		}
160		j++;
161	} while (rest!=nil && j<len argv);
162	return retval;
163}
164
165notify(num : int,s : string) : string {
166	error=1;
167	case num{
168		1 =>
169			return sys->sprint(
170			"wrong # args: should be \"%s\"",s);
171		* =>
172			return s;
173	}
174}
175
176print_string(i1,i2 : int, s : string) : string {
177	retval : string;
178	if (i1==-1 && i2==-1)
179		retval=sys->sprint("%s",s);
180	if (i1==-1 && i2!=-1)
181		retval=sys->sprint("%*s",i1,s);
182	if (i1!=-1 && i2!=-1)
183		retval=sys->sprint("%*.*s",i1,i2,s);
184	if (i1!=-1 && i2==-1)
185		retval=sys->sprint("%.*s",i2,s);
186	return retval;
187}
188
189print_int(i1,i2 : int, s : string) : string {
190	retval,ret2 : string;
191	n : int;
192	(num,nil):=str->toint(s,10);
193	width:=1;
194	i:=num;
195	while((i/=10)!= 0) width++;
196	if (i2 !=-1 && width<i2) width=i2;
197	for(i=0;i<width;i++)
198		retval[len retval]='0';
199	while(width!=0){
200		retval[width-1]=num%10+'0';
201		num/=10;
202		width--;
203	}
204	if (i1 !=-1 && i1>i){
205		for(n=0;n<i1-i;n++)
206			ret2[len ret2]=' ';
207		ret2+=retval;
208		retval=ret2;
209	}
210	return retval;
211}
212
213
214print_float(i1,i2 : int, s : string) : string {
215	r:= real s;
216	retval:=sys->sprint("%*.*f",i1,i2,r);
217	return retval;
218}
219
220print_hex(i1,i2 : int, s : string) : string {
221	retval,ret2 : string;
222	n : int;
223	(num,nil):=str->toint(s,10);
224	width:=1;
225	i:=num;
226	while((i/=16)!= 0) width++;
227	if (i2 !=-1 && width<i2) width=i2;
228	for(i=0;i<width;i++)
229		retval[len retval]='0';
230	while(width!=0){
231		n=num%16;
232		if (n>=0 && n<=9)
233			retval[width-1]=n+'0';
234		else
235			retval[width-1]=n+'a'-10;
236		num/=16;
237		width--;
238	}
239	if (i1 !=-1 && i1>i){
240		for(n=0;n<i1-i;n++)
241			ret2[len ret2]=' ';
242		ret2+=retval;
243		retval=ret2;
244	}
245	return retval;
246}
247