1implement DebData; 2 3include "sys.m"; 4 sys: Sys; 5 6include "draw.m"; 7 8include "string.m"; 9 str: String; 10 11include "tk.m"; 12 tk: Tk; 13 14include "tkclient.m"; 15 tkclient: Tkclient; 16 17include "dialog.m"; 18 19include "selectfile.m"; 20 21include "debug.m"; 22 debug: Debug; 23 Sym, Src, Exp, Module: import debug; 24 25include "wmdeb.m"; 26 debsrc: DebSrc; 27 28DatumSize: con 32; 29WalkWidth: con "20"; 30 31context: ref Draw->Context; 32tktop: ref Tk->Toplevel; 33var: ref Vars; 34vid: int; 35tkids := 1; # increasing id of tk pieces 36 37icondir : con "debug/"; 38 39tkconfig := array[] of { 40 "frame .body -width 400 -height 400", 41 "pack .Wm_t -side top -fill x", 42 "pack .body -expand 1 -fill both", 43 "pack propagate . 0", 44 "update", 45 "image create bitmap Itemopen -file "+icondir+ 46 "open.bit -maskfile "+icondir+"open.mask", 47 "image create bitmap Itemclosed -file "+icondir+ 48 "closed.bit -maskfile "+icondir+"closed.mask", 49}; 50 51init(acontext: ref Draw->Context, 52 geom: string, 53 adebsrc: DebSrc, 54 astr: String, 55 adebug: Debug): (ref Tk->Toplevel, chan of string, chan of string) 56{ 57 context = acontext; 58 debsrc = adebsrc; 59 sys = load Sys Sys->PATH; 60 tk = load Tk Tk->PATH; 61 str = astr; 62 debug = adebug; 63 64 tkclient = load Tkclient Tkclient->PATH; 65 66 tkclient->init(); 67 titlebut: chan of string; 68 (tktop, titlebut) = tkclient->toplevel(context, geom, "Stack", Tkclient->Resize); 69 buts := chan of string; 70 tk->namechan(tktop, buts, "buts"); 71 72 for(i := 0; i < len tkconfig; i++) 73 tk->cmd(tktop, tkconfig[i]); 74 75 tkcmd("update"); 76 tkclient->onscreen(tktop, nil); 77 tkclient->startinput(tktop, "kbd" :: "ptr" :: nil); 78 return (tktop, buts, titlebut); 79} 80 81ctl(s: string) 82{ 83 if(var == nil) 84 return; 85 arg := s[1:]; 86 case s[0]{ 87 'o' => 88 var.expand(arg); 89 var.update(); 90 'c' => 91 var.contract(arg); 92 var.update(); 93 'y' => 94 var.scrolly(arg); 95 's' => 96 var.showsrc(arg); 97 } 98 tkcmd("update"); 99} 100 101wmctl(s: string) 102{ 103 if(s == "exit"){ 104 tkcmd(". unmap"); 105 return; 106 } 107 tkclient->wmctl(tktop, s); 108 tkcmd("update"); 109} 110 111Vars.create(): ref Vars 112{ 113 t := ".body.v"+string vid++; 114 115 tkcmd("frame "+t); 116 tkcmd("canvas "+t+".cvar -width 2 -height 2 -yscrollcommand {"+t+".sy set} -xscrollcommand {"+t+".sxvar set}"); 117 tkcmd("frame "+t+".f0"); 118 119 tkcmd(t+".cvar create window 0 0 -window "+t+".f0 -anchor nw"); 120 tkcmd("scrollbar "+t+".sxvar -orient horizontal -command {"+t+".cvar xview}"); 121 122 tkcmd("scrollbar "+t+".sy -command {send buts y}"); 123 tkcmd("pack "+t+".sy -side right -fill y -in "+t); 124 tkcmd("pack "+t+".sxvar -fill x -side bottom -in "+t); 125 tkcmd("pack "+t+".cvar -expand 1 -fill both -in "+t); 126 127 return ref Vars(t, 0, nil); 128} 129 130Vars.show(v: self ref Vars) 131{ 132 if(v == var) 133 return; 134 if(var != nil) 135 tkcmd("pack forget "+var.tk); 136 var = v; 137 tkcmd("pack "+var.tk+" -expand 1 -fill both"); 138 v.update(); 139} 140 141Vars.delete(v: self ref Vars) 142{ 143 if(var == v) 144 var = nil; 145 tkcmd("destroy "+v.tk); 146 tkcmd("update"); 147} 148 149Vars.refresh(v: self ref Vars, ea: array of ref Exp) 150{ 151 nea := len ea; 152 newd := array[nea] of ref Datum; 153 da := v.d; 154 nd := len da; 155 n := nea; 156 if(n > nd) 157 n = nd; 158 for(i := 0; i < n; i++){ 159 d := da[nd-i-1]; 160 if(!sameexp(ea[nea-i-1], d.e, 1)) 161 break; 162 newd[nea-i-1] = d; 163 } 164 n = nea-i; 165 for(; i < nd; i++) 166 da[nd-i-1].destroy(); 167 v.d = nil; 168 for(i = 0; i < n; i++){ 169 debsrc->findmod(ea[i].m); 170 ea[i].findsym(); 171 newd[i] = mkkid(ea[i], v.tk, "0", string tkids++, nil, nil, -1, ""); 172 } 173 for(; i < nea; i++){ 174 debsrc->findmod(ea[i].m); 175 ea[i].findsym(); 176 d := newd[i]; 177 newd[i] = mkkid(ea[i], v.tk, "0", d.tkid, d.kids, d.val, d.canwalk, ""); 178 } 179 v.d = newd; 180 v.update(); 181} 182 183Vars.update(v: self ref Vars) 184{ 185 tkcmd("update"); 186 tkcmd(v.tk+".cvar configure -scrollregion {0 0 ["+v.tk+".f0 cget -width] ["+v.tk+".f0 cget -height]}"); 187 tkcmd("update"); 188} 189 190Vars.scrolly(v: self ref Vars, pos: string) 191{ 192 tkcmd(v.tk+".cvar yview"+pos); 193} 194 195Vars.showsrc(v: self ref Vars, who: string) 196{ 197 (sid, kids) := str->splitl(who[1:], "."); 198 showsrc(v.d, sid, kids); 199} 200 201showsrc(da: array of ref Datum, id, kids: string) 202{ 203 if(da == nil) 204 return; 205 for(i := 0; i < len da; i++){ 206 d := da[i]; 207 if(d.tkid != id) 208 continue; 209 if(kids == "") 210 d.showsrc(); 211 else{ 212 sid : string; 213 (sid, kids) = str->splitl(kids[1:], "."); 214 showsrc(d.kids, sid, kids); 215 } 216 break; 217 } 218} 219 220Vars.expand(v: self ref Vars, who: string) 221{ 222 (sid, kids) := str->splitl(who[1:], "."); 223 v.d = expandkid(v.d, sid, kids, who); 224} 225 226expandkid(da: array of ref Datum, id, kids, who: string): array of ref Datum 227{ 228 if(da == nil) 229 return nil; 230 for(i := 0; i < len da; i++){ 231 d := da[i]; 232 if(d.tkid != id) 233 continue; 234 if(kids == "") 235 da[i] = d.expand(nil, who); 236 else{ 237 sid : string; 238 (sid, kids) = str->splitl(kids[1:], "."); 239 d.kids = expandkid(d.kids, sid, kids, who); 240 } 241 break; 242 } 243 return da; 244} 245 246Vars.contract(v: self ref Vars, who: string) 247{ 248 (sid, kids) := str->splitl(who[1:], "."); 249 v.d = contractkid(v.d, sid, kids, who); 250} 251 252contractkid(da: array of ref Datum, id, kids, who: string): array of ref Datum 253{ 254 if(da == nil) 255 return nil; 256 for(i := 0; i < len da; i++){ 257 d := da[i]; 258 if(d.tkid != id) 259 continue; 260 if(kids == "") 261 da[i] = d.contract(who); 262 else{ 263 sid : string; 264 (sid, kids) = str->splitl(kids[1:], "."); 265 d.kids = contractkid(d.kids, sid, kids, who); 266 } 267 break; 268 } 269 return da; 270} 271 272Datum.contract(d: self ref Datum, who: string): ref Datum 273{ 274 vtk := d.vtk; 275 tkid := d.tkid; 276 if(tkid == "") 277 return d; 278 kids := d.kids; 279 if(kids == nil){ 280 tkcmd(vtk+".v"+tkid+".b configure -image Itemclosed -command {send buts o"+who+"}"); 281 return d; 282 } 283 284 for(i := 0; i < len kids; i++) 285 kids[i].destroy(); 286 d.kids = nil; 287 tkcmd("destroy "+vtk+".f"+tkid); 288 tkcmd(vtk+".v"+tkid+".b configure -image Itemclosed -command {send buts o"+who+"}"); 289 290 return d; 291} 292 293Datum.showsrc(d: self ref Datum) 294{ 295 debsrc->showmodsrc(debsrc->findmod(d.e.m), d.e.src()); 296} 297 298Datum.destroy(d: self ref Datum) 299{ 300 kids := d.kids; 301 for(i := 0; i < len kids; i++) 302 kids[i].destroy(); 303 vtk := d.vtk; 304 tkid := string d.tkid; 305 if(d.kids != nil){ 306 tkcmd("destroy "+vtk+".f"+tkid); 307 } 308 d.kids = nil; 309 tkcmd("destroy "+vtk+".v"+tkid); 310} 311 312mkkid(e: ref Exp, vtk, parent, me: string, okids: array of ref Datum, oval:string, owalk: int, who: string): ref Datum 313{ 314 (val, walk) := e.val(); 315 316 who = who+"."+me; 317 318 # make the tk goo 319 if(walk != owalk){ 320 if(owalk == -1){ 321 tkcmd("frame "+vtk+".v"+me); 322 tkcmd("label "+vtk+".v"+me+".l -text '"+e.name); 323 tkcmd("bind "+vtk+".v"+me+".l <ButtonRelease-1> 'send buts s"+who); 324 }else{ 325 tkcmd("destroy "+vtk+".v"+me+".b"); 326 } 327 if(walk) 328 tkcmd("button "+vtk+".v"+me+".b -image Itemclosed -command 'send buts o"+who); 329 else 330 tkcmd("frame "+vtk+".v"+me+".b -width "+WalkWidth); 331 } 332 333 n := 16 - len e.name; 334 if(n < 4) 335 n = 4; 336 pad := " "[:n]; 337 338 # tk value goo 339 if(val == "") 340 val = " "; 341 if(oval != ""){ 342 if(val != oval) 343 tkcmd(vtk+".v"+me+".val configure -text '"+pad+val); 344 }else 345 tkcmd("label "+vtk+".v"+me+".val -text '"+pad+val); 346 347 tkcmd("pack "+vtk+".v"+me+".b "+vtk+".v"+me+".l "+vtk+".v"+me+".val -side left"); 348 tkcmd("pack "+vtk+".v"+me+" -side top -anchor w -in "+vtk+".f"+parent); 349 350 d := ref Datum(me, parent, vtk, e, val, walk, nil); 351 if(okids != nil){ 352 if(walk) 353 return d.expand(okids, who); 354 for(i := 0; i < len okids; i++) 355 okids[i].destroy(); 356 } 357 return d; 358} 359 360Datum.expand(d: self ref Datum, okids: array of ref Datum, who: string): ref Datum 361{ 362 e := d.e.expand(); 363 if(e == nil) 364 return d; 365 366 vtk := d.vtk; 367 368 me := d.tkid; 369 370 # make the tk goo for holding kids 371 needtk := okids == nil; 372 if(needtk){ 373 tkcmd("frame "+vtk+".f"+me); 374 tkcmd("frame "+vtk+".f"+me+".x -width "+WalkWidth); 375 tkcmd("frame "+vtk+".f"+me+".v"); 376 tkcmd("pack "+vtk+".f"+me+".x "+vtk+".f"+me+".v -side left -fill y -expand 1"); 377 } 378 379 kids := array[len e] of ref Datum; 380 for(i := 0; i < len e; i++){ 381 if(i >= len okids) 382 break; 383 ok := okids[i]; 384 if(!sameexp(e[i], ok.e, 0)) 385 break; 386 kids[i] = mkkid(e[i], vtk, me, ok.tkid, ok.kids, ok.val, ok.canwalk, who); 387 } 388 for(oi := i; oi < len okids; oi++) 389 okids[oi].destroy(); 390 for(; i < len e; i++) 391 kids[i] = mkkid(e[i], vtk, me, string tkids++, nil, nil, -1, who); 392 393 tkcmd("pack "+vtk+".f"+me+" -side top -anchor w -after "+vtk+".v"+me); 394 tkcmd(vtk+".v"+me+".b configure -image Itemopen -command {send buts c"+who+"}"); 395 396 d.kids = kids; 397 return d; 398} 399 400sameexp(e, f: ref Exp, offmatch: int): int 401{ 402 if(e.m != f.m || e.p != f.p || e.name != f.name) 403 return 0; 404 return !offmatch || e.offset == f.offset; 405} 406 407tkcmd(cmd: string): string 408{ 409 s := tk->cmd(tktop, cmd); 410# if(len s != 0 && s[0] == '!') 411# sys->print("%s '%s'\n", s, cmd); 412 return s; 413} 414 415raisex() 416{ 417 tkcmd(". map; raise .; update"); 418} 419