xref: /inferno-os/appl/cmd/sh/tk.b (revision 1311e23dda88a63b0497469995cbfa52c2432671) 
1implement Shellbuiltin;
2
3include "sys.m";
4	sys: Sys;
5include "draw.m";
6include "tk.m";
7	tk: Tk;
8include "tkclient.m";
9	tkclient: Tkclient;
10include "sh.m";
11	sh: Sh;
12	Listnode, Context: import sh;
13	myself: Shellbuiltin;
14
15tklock: chan of int;
16
17chans := array[23] of list of (string, chan of string);
18wins := array[16] of list of (int, ref Tk->Toplevel);
19winid := 0;
20
21badmodule(ctxt: ref Context, p: string)
22{
23	ctxt.fail("bad module", sys->sprint("tk: cannot load %s: %r", p));
24}
25
26initbuiltin(ctxt: ref Context, shmod: Sh): string
27{
28	sys = load Sys Sys->PATH;
29	sh = shmod;
30
31	myself = load Shellbuiltin "$self";
32	if (myself == nil) badmodule(ctxt, "self");
33
34	tk = load Tk Tk->PATH;
35	if (tk == nil) badmodule(ctxt, Tk->PATH);
36
37	tkclient = load Tkclient Tkclient->PATH;
38	if (tkclient == nil) badmodule(ctxt, Tkclient->PATH);
39	tkclient->init();
40
41	tklock = chan[1] of int;
42
43	ctxt.addbuiltin("tk", myself);
44	ctxt.addbuiltin("chan", myself);
45	ctxt.addbuiltin("send", myself);
46
47	ctxt.addsbuiltin("tk", myself);
48	ctxt.addsbuiltin("recv", myself);
49	ctxt.addsbuiltin("alt", myself);
50	ctxt.addsbuiltin("tkquote", myself);
51	return nil;
52}
53
54whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
55{
56	return nil;
57}
58
59getself(): Shellbuiltin
60{
61	return myself;
62}
63
64runbuiltin(ctxt: ref Context, nil: Sh,
65			cmd: list of ref Listnode, nil: int): string
66{
67	case (hd cmd).word {
68	"tk" =>		return builtin_tk(ctxt, cmd);
69	"chan" =>		return builtin_chan(ctxt, cmd);
70	"send" =>		return builtin_send(ctxt, cmd);
71	}
72	return nil;
73}
74
75runsbuiltin(ctxt: ref Context, nil: Sh,
76			cmd: list of ref Listnode): list of ref Listnode
77{
78	case (hd cmd).word {
79	"tk" =>		return sbuiltin_tk(ctxt, cmd);
80	"recv" =>		return sbuiltin_recv(ctxt, cmd);
81	"alt" =>		return sbuiltin_alt(ctxt, cmd);
82	"tkquote" =>	return sbuiltin_tkquote(ctxt, cmd);
83	}
84	return nil;
85}
86
87builtin_tk(ctxt: ref Context, argv: list of ref Listnode): string
88{
89	# usage:	tk window _title_ _options_
90	#		tk wintitle _winid_ _title_
91	#		tk _winid_ _cmd_
92	if (tl argv == nil)
93		ctxt.fail("usage", "usage: tk (<winid>|window|onscreen|winctlwintitle|del|namechan) args...");
94	argv = tl argv;
95	w := (hd argv).word;
96	case w {
97	"window" =>
98		remark(ctxt, string makewin(ctxt, tl argv));
99	"wintitle" =>
100		argv = tl argv;
101		# change the title of a window
102		if (len argv != 2 || !isnum((hd argv).word))
103			ctxt.fail("usage", "usage: tk wintitle winid title");
104		tkclient->settitle(egetwin(ctxt, hd argv), word(hd tl argv));
105	"winctl" =>
106		argv = tl argv;
107		if (len argv != 2 || !isnum((hd argv).word))
108			ctxt.fail("usage", "usage: tk winctl winid cmd");
109		wid := (hd argv).word;
110		win := egetwin(ctxt, hd argv);
111		rq := word(hd tl argv);
112		if (rq == "exit") {
113			delwin(int wid);
114			delchan(wid);
115		}
116		tkclient->wmctl(win, rq);
117	"onscreen" =>
118		argv = tl argv;
119		if (len argv < 1 || !isnum((hd argv).word))
120			ctxt.fail("usage", "usage: tk onscreen winid [how]");
121		how := "";
122		if(tl argv != nil)
123			how = word(hd tl argv);
124		win := egetwin(ctxt, hd argv);
125		tkclient->startinput(win, "ptr" :: "kbd" :: nil);
126		tkclient->onscreen(win, how);
127	"namechan" =>
128		argv = tl argv;
129		n := len argv;
130		if (n < 2 || n > 3 || !isnum((hd argv).word))
131			ctxt.fail("usage", "usage: tk namechan winid chan [name]");
132		name: string;
133		if (n == 3)
134			name = word(hd tl tl argv);
135		else
136			name = word(hd tl argv);
137		tk->namechan(egetwin(ctxt, hd argv), egetchan(ctxt, hd tl argv), name);
138
139	"del" =>
140		if (len argv < 2)
141			ctxt.fail("usage", "usage: tk del id...");
142		for (argv = tl argv; argv != nil; argv = tl argv) {
143			id := (hd argv).word;
144			if (isnum(id))
145				delwin(int id);
146			delchan(id);
147		}
148	* =>
149		e := tkcmd(ctxt, argv);
150		if (e != nil)
151			remark(ctxt, e);
152		if (e != nil && e[0] == '!')
153			return e;
154	}
155	return nil;
156}
157
158remark(ctxt: ref Context, s: string)
159{
160	if (ctxt.options() & ctxt.INTERACTIVE)
161		sys->print("%s\n", s);
162}
163
164# create a new window (and its associated channel)
165makewin(ctxt: ref Context, argv: list of ref Listnode): int
166{
167	if (argv == nil)
168		ctxt.fail("usage", "usage: tk window title options");
169
170	if (ctxt.drawcontext == nil)
171		ctxt.fail("no draw context", sys->sprint("tk: no graphics context available"));
172
173	(title, options) := (word(hd argv), concat(tl argv));
174	(top, topchan) := tkclient->toplevel(ctxt.drawcontext, options, title, Tkclient->Appl);
175	newid := addwin(top);
176	addchan(string newid, topchan);
177	return newid;
178}
179
180builtin_chan(ctxt: ref Context, argv: list of ref Listnode): string
181{
182	# create a new channel
183	argv = tl argv;
184	if (argv == nil)
185		ctxt.fail("usage", "usage: chan name....");
186	for (; argv != nil; argv = tl argv) {
187		name := (hd argv).word;
188		if (name == nil || isnum(name))
189			ctxt.fail("bad chan", "tk: bad channel name "+q(name));
190		if (addchan(name, chan of string) == nil)
191			ctxt.fail("bad chan", "tk: channel "+q(name)+" already exists");
192	}
193	return nil;
194}
195
196builtin_send(ctxt: ref Context, argv: list of ref Listnode): string
197{
198	if (len argv != 3)
199		ctxt.fail("usage", "usage: send chan arg");
200	argv = tl argv;
201	c := egetchan(ctxt, hd argv);
202	c <-= word(hd tl argv);
203	return nil;
204}
205
206
207sbuiltin_tk(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
208{
209	# usage:	tk _winid_ _command_
210	#		tk window _title_ _options_
211	argv = tl argv;
212	if (argv == nil)
213		ctxt.fail("usage", "tk (window|wid) args");
214	case (hd argv).word {
215	"window" =>
216		return ref Listnode(nil, string makewin(ctxt, tl argv)) :: nil;
217	"winids" =>
218		ret: list of ref Listnode;
219		for (i := 0; i < len wins; i++)
220			for (wl := wins[i]; wl != nil; wl = tl wl)
221				ret = ref Listnode(nil, string (hd wl).t0) :: ret;
222		return ret;
223	* =>
224		return ref Listnode(nil, tkcmd(ctxt, argv)) :: nil;
225	}
226}
227
228sbuiltin_alt(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
229{
230	# usage: alt chan ...
231	argv = tl argv;
232	if (argv == nil)
233		ctxt.fail("usage", "usage: alt chan...");
234	nc := len argv;
235	kbd := array[nc] of chan of int;
236	ptr := array[nc] of chan of ref Draw->Pointer;
237	ca := array[nc * 3] of chan of string;
238	win := array[nc] of ref Tk->Toplevel;
239
240	cname := array[nc] of string;
241	i := 0;
242	for (; argv != nil; argv = tl argv) {
243		w := (hd argv).word;
244		ca[i*3] = egetchan(ctxt, hd argv);
245		cname[i] = w;
246		if(isnum(w)){
247			win[i] = egetwin(ctxt, hd argv);
248			ca[i*3+1] = win[i].ctxt.ctl;
249			ca[i*3+2] = win[i].wreq;
250			ptr[i] = win[i].ctxt.ptr;
251			kbd[i] = win[i].ctxt.kbd;
252		}
253		i++;
254	}
255	for(;;) alt{
256	(n, key) := <-kbd =>
257		tk->keyboard(win[n], key);
258	(n, p) := <-ptr =>
259		tk->pointer(win[n], *p);
260	(n, v) := <-ca =>
261		return ref Listnode(nil, cname[n/3]) :: ref Listnode(nil, v) :: nil;
262	}
263}
264
265sbuiltin_recv(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
266{
267	# usage: recv chan
268	if (len argv != 2)
269		ctxt.fail("usage", "usage: recv chan");
270	ch := hd tl argv;
271	c := egetchan(ctxt, ch);
272	if(!isnum(ch.word))
273		return ref Listnode(nil, <-c) :: nil;
274
275	win := egetwin(ctxt, ch);
276	for(;;)alt{
277	key := <-win.ctxt.kbd =>
278		tk->keyboard(win, key);
279	p := <-win.ctxt.ptr =>
280		tk->pointer(win, *p);
281	s := <-win.ctxt.ctl or
282	s = <-win.wreq or
283	s = <-c =>
284		return ref Listnode(nil, s) :: nil;
285	}
286}
287
288sbuiltin_tkquote(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
289{
290	if (len argv != 2)
291		ctxt.fail("usage", "usage: tkquote arg");
292	return ref Listnode(nil, tk->quote(word(hd tl argv))) :: nil;
293}
294
295tkcmd(ctxt: ref Context, argv: list of ref Listnode): string
296{
297	if (argv == nil || !isnum((hd argv).word))
298		ctxt.fail("usage", "usage: tk winid command");
299
300	return tk->cmd(egetwin(ctxt, hd argv), concat(tl argv));
301}
302
303hashfn(s: string, n: int): int
304{
305	h := 0;
306	m := len s;
307	for(i:=0; i<m; i++){
308		h = 65599*h+s[i];
309	}
310	return (h & 16r7fffffff) % n;
311}
312
313q(s: string): string
314{
315	return "'" + s + "'";
316}
317
318egetchan(ctxt: ref Context, n: ref Listnode): chan of string
319{
320	if ((c := getchan(n.word)) == nil)
321		ctxt.fail("bad chan", "tk: bad channel name "+ q(n.word));
322	return c;
323}
324
325# assumes that n.word has been checked and found to be numeric.
326egetwin(ctxt: ref Context, n: ref Listnode): ref Tk->Toplevel
327{
328	wid := int n.word;
329	if (wid < 0 || (top := getwin(wid)) == nil)
330		ctxt.fail("bad win", "tk: unknown window id " + q(n.word));
331	return top;
332}
333
334getchan(name: string): chan of string
335{
336	n := hashfn(name, len chans);
337	for (cl := chans[n]; cl != nil; cl = tl cl) {
338		(cname, c) := hd cl;
339		if (cname == name)
340			return c;
341	}
342	return nil;
343}
344
345addchan(name: string, c: chan of string): chan of string
346{
347	n := hashfn(name, len chans);
348	tklock <-= 1;
349	if (getchan(name) == nil)
350		chans[n] = (name, c) :: chans[n];
351	<-tklock;
352	return c;
353}
354
355delchan(name: string)
356{
357	n := hashfn(name, len chans);
358	tklock <-= 1;
359	ncl: list of (string, chan of string);
360	for (cl := chans[n]; cl != nil; cl = tl cl) {
361		(cname, nil) := hd cl;
362		if (cname != name)
363			ncl = hd cl :: ncl;
364	}
365	chans[n] = ncl;
366	<-tklock;
367}
368
369addwin(top: ref Tk->Toplevel): int
370{
371	tklock <-= 1;
372	id := winid++;
373	slot := id % len wins;
374	wins[slot] = (id, top) :: wins[slot];
375	<-tklock;
376	return id;
377}
378
379delwin(id: int)
380{
381	tklock <-= 1;
382	slot := id % len wins;
383	nwl: list of (int, ref Tk->Toplevel);
384	for (wl := wins[slot]; wl != nil; wl = tl wl) {
385		(wid, nil) := hd wl;
386		if (wid != id)
387			nwl = hd wl :: nwl;
388	}
389	wins[slot] = nwl;
390	<-tklock;
391}
392
393getwin(id: int): ref Tk->Toplevel
394{
395	slot := id % len wins;
396	for (wl := wins[slot]; wl != nil; wl = tl wl) {
397		(wid, top) := hd wl;
398		if (wid == id)
399			return top;
400	}
401	return nil;
402}
403
404word(n: ref Listnode): string
405{
406	if (n.word != nil)
407		return n.word;
408	if (n.cmd != nil)
409		n.word = sh->cmd2string(n.cmd);
410	return n.word;
411}
412
413isnum(s: string): int
414{
415	for (i := 0; i < len s; i++)
416		if (s[i] > '9' || s[i] < '0')
417			return 0;
418	return 1;
419}
420
421concat(argv: list of ref Listnode): string
422{
423	if (argv == nil)
424		return nil;
425	s := word(hd argv);
426	for (argv = tl argv; argv != nil; argv = tl argv)
427		s += " " + word(hd argv);
428	return s;
429}
430
431lockproc(c: chan of int)
432{
433	sys->pctl(Sys->NEWFD|Sys->NEWNS, nil);
434	for(;;){
435		c <-= 1;
436		<-c;
437	}
438}
439