implement DebData; include "sys.m";	sys: Sys; include "draw.m"; include "string.m";	str: String; include "tk.m";	tk: Tk; include "tkclient.m";	tkclient: Tkclient; include "dialog.m"; include "selectfile.m"; include "debug.m";	debug: Debug;	Sym, Src, Exp, Module: import debug; include "wmdeb.m";	debsrc: DebSrc; DatumSize:	con 32;WalkWidth:	con "20"; context:		ref Draw->Context;tktop:		ref Tk->Toplevel;var:		ref Vars;vid:		int;tkids :=	1;	# increasing id of tk pieces icondir :	con "debug/"; tkconfig := array[] of {	"frame .body -width 400 -height 400",	"pack .Wm_t -side top -fill x",	"pack .body -expand 1 -fill both",	"pack propagate . 0",	"update",	"image create bitmap Itemopen -file "+icondir+			"open.bit -maskfile "+icondir+"open.mask",	"image create bitmap Itemclosed -file "+icondir+			"closed.bit -maskfile "+icondir+"closed.mask",}; init(acontext: ref Draw->Context,	geom: string,	adebsrc: DebSrc,	astr: String,	adebug: Debug): (ref Tk->Toplevel, chan of string, chan of string){	context = acontext;	debsrc = adebsrc;	sys = load Sys Sys->PATH;	tk = load Tk Tk->PATH;	str = astr;	debug = adebug; 	tkclient = load Tkclient Tkclient->PATH; 	tkclient->init();	titlebut: chan of string;	(tktop, titlebut) = tkclient->toplevel(context, geom, "Stack", Tkclient->Resize);	buts := chan of string;	tk->namechan(tktop, buts, "buts"); 	for(i := 0; i < len tkconfig; i++)		tk->cmd(tktop, tkconfig[i]); 	tkcmd("update");	tkclient->onscreen(tktop, nil);	tkclient->startinput(tktop, "kbd" :: "ptr" :: nil);	return (tktop, buts, titlebut);} ctl(s: string){	if(var == nil)		return;	arg := s[1:];	case s[0]{	'o' =>		var.expand(arg);		var.update();	'c' =>		var.contract(arg);		var.update();	'y' =>		var.scrolly(arg);	's' =>		var.showsrc(arg);	}	tkcmd("update");} wmctl(s: string){	if(s == "exit"){		tkcmd(". unmap");		return;	}	tkclient->wmctl(tktop, s);	tkcmd("update");} Vars.create(): ref Vars{	t := ".body.v"+string vid++; 	tkcmd("frame "+t);	tkcmd("canvas "+t+".cvar -width 2 -height 2 -yscrollcommand {"+t+".sy set} -xscrollcommand {"+t+".sxvar set}");	tkcmd("frame "+t+".f0"); 	tkcmd(t+".cvar create window 0 0 -window "+t+".f0 -anchor nw");	tkcmd("scrollbar "+t+".sxvar -orient horizontal -command {"+t+".cvar xview}"); 	tkcmd("scrollbar "+t+".sy -command {send buts y}");	tkcmd("pack "+t+".sy -side right -fill y -in "+t);	tkcmd("pack "+t+".sxvar -fill x -side bottom -in "+t);	tkcmd("pack "+t+".cvar -expand 1 -fill both -in "+t); 	return ref Vars(t, 0, nil);} Vars.show(v: self ref Vars){	if(v == var)		return;	if(var != nil)		tkcmd("pack forget "+var.tk);	var = v;	tkcmd("pack "+var.tk+" -expand 1 -fill both");	v.update();} Vars.delete(v: self ref Vars){	if(var == v)		var = nil;	tkcmd("destroy "+v.tk);	tkcmd("update");} Vars.refresh(v: self ref Vars, ea: array of ref Exp){	nea := len ea;	newd := array[nea] of ref Datum;	da := v.d;	nd := len da;	n := nea;	if(n > nd)		n = nd;	for(i := 0; i < n; i++){		d := da[nd-i-1];		if(!sameexp(ea[nea-i-1], d.e, 1))			break;		newd[nea-i-1] = d;	}	n = nea-i;	for(; i < nd; i++)		da[nd-i-1].destroy();	v.d = nil;	for(i = 0; i < n; i++){		debsrc->findmod(ea[i].m);		ea[i].findsym();		newd[i] = mkkid(ea[i], v.tk, "0", string tkids++, nil, nil, -1, "");	}	for(; i < nea; i++){		debsrc->findmod(ea[i].m);		ea[i].findsym();		d := newd[i];		newd[i] = mkkid(ea[i], v.tk, "0", d.tkid, d.kids, d.val, d.canwalk, "");	}	v.d = newd;	v.update();} Vars.update(v: self ref Vars){	tkcmd("update");	tkcmd(v.tk+".cvar configure -scrollregion {0 0 ["+v.tk+".f0 cget -width] ["+v.tk+".f0 cget -height]}");	tkcmd("update");} Vars.scrolly(v: self ref Vars, pos: string){	tkcmd(v.tk+".cvar yview"+pos);} Vars.showsrc(v: self ref Vars, who: string){	(sid, kids) := str->splitl(who[1:], ".");	showsrc(v.d, sid, kids);} showsrc(da: array of ref Datum, id, kids: string){	if(da == nil)		return;	for(i := 0; i < len da; i++){		d := da[i];		if(d.tkid != id)			continue;		if(kids == "")			d.showsrc();		else{			sid : string;			(sid, kids) = str->splitl(kids[1:], ".");			showsrc(d.kids, sid, kids);		}		break;	}} Vars.expand(v: self ref Vars, who: string){	(sid, kids) := str->splitl(who[1:], ".");	v.d = expandkid(v.d, sid, kids, who);} expandkid(da: array of ref Datum, id, kids, who: string): array of ref Datum{	if(da == nil)		return nil;	for(i := 0; i < len da; i++){		d := da[i];		if(d.tkid != id)			continue;		if(kids == "")			da[i] = d.expand(nil, who);		else{			sid : string;			(sid, kids) = str->splitl(kids[1:], ".");			d.kids = expandkid(d.kids, sid, kids, who);		}		break;	}	return da;} Vars.contract(v: self ref Vars, who: string){	(sid, kids) := str->splitl(who[1:], ".");	v.d = contractkid(v.d, sid, kids, who);} contractkid(da: array of ref Datum, id, kids, who: string): array of ref Datum{	if(da == nil)		return nil;	for(i := 0; i < len da; i++){		d := da[i];		if(d.tkid != id)			continue;		if(kids == "")			da[i] = d.contract(who);		else{			sid : string;			(sid, kids) = str->splitl(kids[1:], ".");			d.kids = contractkid(d.kids, sid, kids, who);		}		break;	}	return da;} Datum.contract(d: self ref Datum, who: string): ref Datum{	vtk := d.vtk;	tkid := d.tkid;	if(tkid == "")		return d;	kids := d.kids;	if(kids == nil){		tkcmd(vtk+".v"+tkid+".b configure -image Itemclosed -command {send buts o"+who+"}");		return d;	} 	for(i := 0; i < len kids; i++)		kids[i].destroy();	d.kids = nil;	tkcmd("destroy "+vtk+".f"+tkid);	tkcmd(vtk+".v"+tkid+".b configure -image Itemclosed -command {send buts o"+who+"}"); 	return d;} Datum.showsrc(d: self ref Datum){	debsrc->showmodsrc(debsrc->findmod(d.e.m), d.e.src());} Datum.destroy(d: self ref Datum){	kids := d.kids;	for(i := 0; i < len kids; i++)		kids[i].destroy();	vtk := d.vtk;	tkid := string d.tkid;	if(d.kids != nil){		tkcmd("destroy "+vtk+".f"+tkid);	}	d.kids = nil;	tkcmd("destroy "+vtk+".v"+tkid);} mkkid(e: ref Exp, vtk, parent, me: string, okids: array of ref Datum, oval:string, owalk: int, who: string): ref Datum{	(val, walk) := e.val(); 	who = who+"."+me; 	# make the tk goo	if(walk != owalk){		if(owalk == -1){			tkcmd("frame "+vtk+".v"+me);			tkcmd("label "+vtk+".v"+me+".l -text '"+e.name);			tkcmd("bind "+vtk+".v"+me+".l <ButtonRelease-1> 'send buts s"+who);		}else{			tkcmd("destroy "+vtk+".v"+me+".b");		}		if(walk)			tkcmd("button "+vtk+".v"+me+".b -image Itemclosed -command 'send buts o"+who);		else			tkcmd("frame "+vtk+".v"+me+".b -width "+WalkWidth);	} 	n := 16 - len e.name;	if(n < 4)		n = 4;	pad := "                "[:n]; 	# tk value goo	if(val == "")		val = " ";	if(oval != ""){		if(val != oval)			tkcmd(vtk+".v"+me+".val configure -text '"+pad+val);	}else		tkcmd("label "+vtk+".v"+me+".val -text '"+pad+val); 	tkcmd("pack "+vtk+".v"+me+".b "+vtk+".v"+me+".l "+vtk+".v"+me+".val -side left");	tkcmd("pack "+vtk+".v"+me+" -side top -anchor w -in "+vtk+".f"+parent); 	d := ref Datum(me, parent, vtk, e, val, walk, nil);	if(okids != nil){		if(walk)			return d.expand(okids, who);		for(i := 0; i < len okids; i++)			okids[i].destroy();	}	return d;} Datum.expand(d: self ref Datum, okids: array of ref Datum, who: string): ref Datum{	e := d.e.expand();	if(e == nil)		return d; 	vtk := d.vtk; 	me := d.tkid; 	# make the tk goo for holding kids	needtk := okids == nil;	if(needtk){		tkcmd("frame "+vtk+".f"+me);		tkcmd("frame "+vtk+".f"+me+".x -width "+WalkWidth);		tkcmd("frame "+vtk+".f"+me+".v");		tkcmd("pack "+vtk+".f"+me+".x "+vtk+".f"+me+".v -side left -fill y -expand 1");	} 	kids := array[len e] of ref Datum;	for(i := 0; i < len e; i++){		if(i >= len okids)			break;		ok := okids[i];		if(!sameexp(e[i], ok.e, 0))			break;		kids[i] = mkkid(e[i], vtk, me, ok.tkid, ok.kids, ok.val, ok.canwalk, who);	}	for(oi := i; oi < len okids; oi++)		okids[oi].destroy();	for(; i < len e; i++)		kids[i] = mkkid(e[i], vtk, me, string tkids++, nil, nil, -1, who); 	tkcmd("pack "+vtk+".f"+me+" -side top -anchor w -after "+vtk+".v"+me);	tkcmd(vtk+".v"+me+".b configure -image Itemopen -command {send buts c"+who+"}"); 	d.kids = kids;	return d;} sameexp(e, f: ref Exp, offmatch: int): int{	if(e.m != f.m || e.p != f.p || e.name != f.name)		return 0;	return !offmatch || e.offset == f.offset;} tkcmd(cmd: string): string{	s := tk->cmd(tktop, cmd);#	if(len s != 0 && s[0] == '!')#		sys->print("%s '%s'\n", s, cmd);	return s;} raisex(){	tkcmd(". map; raise .; update");}