xref: /inferno-os/appl/lib/tcl_tk.b (revision 37da2899f40661e3e9631e497da8dc59b971cbd0)

implement TclLib;

include "sys.m";
	sys: Sys;

include "draw.m";

include "string.m";
	str : String;

include "tk.m";
	tk: Tk;

include	"tkclient.m";
	tkclient: Tkclient;

include "tcl.m";

include "tcllib.m";

error,started : int;
w_cfg := array[] of {
	"pack .Wm_t -side top -fill x",
	"update",
};

tclmod : ref Tcl_Core->TclData;

windows := array[100] of (string, ref Tk->Toplevel, chan of string);

valid_commands:= array[] of {
		"bind" , "bitmap" , "button" ,
		"canvas" , "checkbutton" , "destroy" ,
		"entry" , "focus", "frame" , "grab", "image" , "label" ,
		"listbox" ,"lower", "menu" , "menubutton" ,
		"pack" , "radiobutton" , "raise", "scale" ,
		"scrollbar" , "text" , "update" ,
		"toplevel" , "variable"
};

about() : array of string {
	return valid_commands;
}

init() : string {
	sys = load Sys Sys->PATH;
	str = load String String->PATH;
	tk = load Tk Tk->PATH;
	tkclient = load Tkclient Tkclient->PATH;
	if (tkclient==nil || str==nil || tk==nil)
		return "Not Initialised";
	# set up Draw context
	tkclient->init();
	started=1;
	return nil;
}

exec(tcl : ref Tcl_Core->TclData,argv : array of string) : (int,string) {
	retval : string;
	retval="";
	han,whan : ref Tk->Toplevel;
	whan=nil;
	msg : string;
	c : chan of string;
	msg=nil;
	error=0;
	tclmod=tcl;
	if (!started)
		if (init()!=nil)
			return (1,"Can't Initialise TK");
	if (argv[0][0]!='.')
		case argv[0] {
			"destroy" =>
				for (j:=1;j<len argv;j++){
					(msg,han)=sweepthru(argv[j]);
					if (msg==nil){
						if (argv[j][0]=='.')
							argv[j]=argv[j][1:];
						for(i:=0;i<100;i++){
							(retval,nil,c)=windows[i];
							if (retval==argv[1]){
								c <-= "exit";
								break;
							}
						}
					}
					else
						msg=tkcmd(whan,"destroy "+msg);
				}
				return (error,msg);
			"bind" or "bitmap" or "button" or
			"canvas" or "checkbutton" or "entry" or
			"focus" or "frame" or "grab" or
			"image" or "label" or "listbox" or "lower" or
			"menu" or "menubutton" or "pack" or
			"radiobutton" or "raise" or "scale" or
			"scrollbar" or "text" or "update" or
			"variable" =>
					; # do nothing
			"toplevel" =>
				msg=do_toplevel(argv);
				return (error,msg);
			* =>
				return (0,"Unknown");
		}
	# so it's a tk-command ... replace any -command with
	# a send on the tcl channel.
	if (argv[0]=="bind")
		argv[3]="{send Tcl_Chan "+argv[3]+"}";
	for (i:=0;i<len argv;i++){
		(argv[i],han)=sweepthru(argv[i]);
		if (han!=nil) whan=han;
		if (argv[i]!="-tcl")
			retval+=argv[i];
		if (i+1<len argv &&
			(argv[i]=="-command" || argv[i]=="-yscrollcommand"
			|| argv[i]=="-tcl" || argv[i]=="-xscrollcommand"))
			argv[i+1]="{send Tcl_Chan "+argv[i+1]+"}";
		if (argv[i]!="-tcl")
			retval[len retval]=' ';
	}
	retval=retval[0:len retval -1];
	if (tclmod.debug==1)
		sys->print("Sending [%s] to tkcmd.\n",retval);
	msg=tkcmd(whan,retval);
	if (msg!="" && msg[0]=='!')
		error=1;
	return (error,msg);
}


sweepthru(s: string) : (string,ref Tk->Toplevel) {
	han : ref Tk->Toplevel;
	ret : string;
	if (s=="" || s=="." || s[0]!='.')
		return (s,nil);
	(wname,rest):=str->splitl(s[1:],".");
	for (i:=0;i<len windows;i++){
		(ret,han,nil)=windows[i];
		if (ret==wname)
			break;
	}
	if (i==len windows)
		return (s,nil);
	return (rest,han);
}

do_toplevel(argv : array of string): string
{
	name : string;
	whan : ref Tk->Toplevel;
	if (len argv!=2)
		return notify(1,"toplevel name");
	if (argv[1][0]=='.')
		argv[1]=argv[1][1:];
	for(i:=0;i<len windows;i++){
		(name,whan,nil)=windows[i];
		if(whan==nil || name==argv[1])
			break;
	}
	if (i==len windows)
		return notify(0,"Too many top level windows");
	if (name==argv[1])
		return notify(0,argv[1]+" is already a window name in use.");

	(top, menubut) := tkclient->toplevel(tclmod.context, "", argv[1], Tkclient->Appl);
	whan = top;

	windows[i]=(argv[1],whan,menubut);
	if (tclmod.debug==1)
		sys->print("creating window %d, name %s, handle %ux\n",i,argv[1],whan);
	cmd := chan of string;
	tk->namechan(whan, cmd, argv[1]);
	for(i=0; i<len w_cfg; i++)
		tk->cmd(whan, w_cfg[i]);
	tkclient->onscreen(whan, nil);
	tkclient->startinput(whan, "kbd"::"ptr"::nil);
	stop := chan of int;
	spawn tkclient->handler(whan, stop);
	spawn menulisten(whan,menubut, stop);
	return nil;
}


menulisten(t : ref Tk->Toplevel, menubut : chan of string, stop: chan of int) {
	for(;;) alt {
	menu := <-menubut =>
		if(menu == "exit"){
			for(i:=0;i<len windows;i++){
			(name,whan,nil):=windows[i];
				if(whan==t)
				break;
			}
			if (i!=len windows)
				windows[i]=("",nil,nil);
			stop <-= 1;
			exit;
		}
		tkclient->wmctl(t, menu);
	}
}

tkcmd(t : ref Tk->Toplevel, cmd: string): string {
	if (len cmd ==0 || tclmod.top==nil) return nil;
	if (t==nil){
		 t=tclmod.top;
		#sys->print("Sending to WishPad\n");
	}
	s := tk->cmd(t, cmd);
	tk->cmd(t,"update");
	return s;
}

notify(num : int,s : string) : string {
	error=1;
	case num{
		1 =>
			return sys->sprint(
			"wrong # args: should be \"%s\"",s);
		* =>
			return s;
	}
}