ref: 1018d7a7091fd5e0433f501a3474cdc3fec322cc
dir: /appl/wm/prof.b/
implement Wmprof; include "sys.m"; sys: Sys; include "bufio.m"; bufio: Bufio; Iobuf: import bufio; include "draw.m"; draw: Draw; include "tk.m"; tk: Tk; include "tkclient.m"; tkclient: Tkclient; include "arg.m"; arg: Arg; include "profile.m"; Prof: module{ init0: fn(ctxt: ref Draw->Context, argv: list of string): Profile->Prof; }; prof: Prof; Wmprof: module{ init: fn(ctxt: ref Draw->Context, argl: list of string); }; usage(s: string) { sys->fprint(sys->fildes(2), "wm/prof: %s\n", s); sys->fprint(sys->fildes(2), "usage: wm/prof [-e] [-m modname]... cmd [arg ... ]\n"); exit; } TXTBEGIN: con 3; init(ctxt: ref Draw->Context, argl: list of string) { sys = load Sys Sys->PATH; bufio = load Bufio Bufio->PATH; draw = load Draw Draw->PATH; tk = load Tk Tk->PATH; tkclient = load Tkclient Tkclient->PATH; arg = load Arg Arg->PATH; if(ctxt == nil) fatal("wm not running"); sys->pctl(Sys->NEWPGRP, nil); arg->init(argl); while((o := arg->opt()) != 0){ case(o){ 'e' => ; 'm' => if(arg->arg() == nil) usage("missing module/file"); 's' => if(arg->arg() == nil) usage("missing sample rate"); * => usage(sys->sprint("unknown option -%c", o)); } } stats := execprof(ctxt, argl); if(stats.mods == nil) exit; tkclient->init(); (win, wmc) := tkclient->toplevel(ctxt, nil, hd argl, Tkclient->Resize|Tkclient->Hide); tkc := chan of string; tk->namechan(win, tkc, "tkc"); for(i := 0; i < len wincfg; i++) cmd(win, wincfg[i]); tkclient->onscreen(win, nil); tkclient->startinput(win, "kbd"::"ptr"::nil); createmenu(win, stats); curc := 0; cura := newprint(win, stats, curc); for(;;){ alt{ c := <-win.ctxt.kbd => tk->keyboard(win, c); c := <-win.ctxt.ptr => tk->pointer(win, *c); c := <-win.ctxt.ctl or c = <-win.wreq or c = <-wmc => tkclient->wmctl(win, c); c := <- tkc => (nil, toks) := sys->tokenize(c, " "); case(hd toks){ "b" => if(curc > 0) cura = newprint(win, stats, --curc); "f" => if(curc < len stats.mods - 1) cura = newprint(win, stats, ++curc); "s" => if(cura != nil) scroll(win, cura); "m" => x := cmd(win, ".f cget actx"); y := cmd(win, ".f cget acty"); cmd(win, ".f.menu post " + x + " " + y); * => curc = int hd toks; cura = newprint(win, stats, curc); } } } } execprof(ctxt: ref Draw->Context, argl: list of string): Profile->Prof { { prof = load Prof "/dis/prof.dis"; if(prof == nil) fatal("cannot load profiler"); return prof->init0(ctxt, hd argl :: "-g" :: tl argl); } exception{ "fail:*" => return (nil, 0, nil); } return (nil, 0, nil); } newprint(win: ref Tk->Toplevel, p: Profile->Prof, i: int): array of int { cmd(win, ".f.t delete 1.0 end"); cmd(win, "update"); m0, m1: list of Profile->Modprof; for(m := p.mods; m != nil && --i >= 0; m = tl m) m0 = m; if(m == nil) return nil; m1 = tl m; (name, nil, spath, nil, line, nil, nil, tot, nil, nil) := hd m; name0 := name1 := "nil"; if(m0 != nil) name0 = (hd m0).name; if(m1 != nil) name1 = (hd m1).name; a := len name; name += sys->sprint(" (%d%%) ", percent(tot, p.total)); cmd(win, ".f.t insert end {" + name + " <- " + name0 + " -> " + name1 + "}"); tag := gettag(win, tot, p.total); cmd(win, ".f.t tag add " + tag + " " + "1.0" + " " + "1." + string a); cmd(win, ".f.t insert end \n\n"); cmd(win, "update"); lineno := TXTBEGIN; bio := bufio->open(spath, Bufio->OREAD); if(bio == nil) return nil; i = 1; ll := len line; while((s := bio.gets('\n')) != nil){ f := 0; if(i < ll) f = line[i]; a = len s; if(f > 0) s = sys->sprint("%d%%\t%s", percent(f, tot), s); else s = sys->sprint("- \t%s", s); b := len s; cmd(win, ".f.t insert end " + tk->quote(s)); tag = gettag(win, f, tot); cmd(win, ".f.t tag add " + tag + " " + string lineno + "." + string (b-a) + " " + string lineno + "." + string (b-1)); cmd(win, "update"); lineno++; i++; } return line; } index(win: ref Tk->Toplevel, x: int, y: int): int { t := cmd(win, ".f.t index @" + string x + "," + string y); (nil, l) := sys->tokenize(t, "."); # sys->print("%d,%d -> %s\n", x, y, t); return int hd l; } winextent(win: ref Tk->Toplevel): (int, int) { w := int cmd(win, ".f.t cget -actwidth"); h := int cmd(win, ".f.t cget -actheight"); lw := index(win, 0, 0); uw := index(win, w-1, h-1); return (lw, uw); } see(win: ref Tk->Toplevel, line: int) { cmd(win, ".f.t see " + string line + ".0"); cmd(win, "update"); } scroll(win: ref Tk->Toplevel, line: array of int) { (nil, uw) := winextent(win); lno := TXTBEGIN; ll := len line; for(i := 1; i < ll; i++){ n := line[i]; if(n > 0 && lno > uw){ see(win, lno); return; } lno++; } lno = TXTBEGIN; ll = len line; for(i = 1; i < ll; i++){ n := line[i]; if(n > 0){ see(win, lno); return; } lno++; } } cmd(top: ref Tk->Toplevel, s: string): string { # sys->print("%s\n", s); e := tk->cmd(top, s); if (e != nil && e[0] == '!') sys->fprint(sys->fildes(2), "tk error on '%s': %s\n", s, e); return e; } fatal(s: string) { sys->fprint(sys->fildes(2), "%s\n", s); exit; } MENUMAX: con 20; createmenu(top: ref Tk->Toplevel, p: Profile->Prof ) { mn := ".f.menu"; cmd(top, "menu " + mn); i := j := 0; for(m := p.mods; m != nil; m = tl m){ name := (hd m).name; cmd(top, mn + " add command -label " + name + " -command {send tkc " + string i + "}"); i++; j++; if(j == MENUMAX && tl m != nil){ cmd(top, mn + " add cascade -label MORE -menu " + mn + ".menu"); mn += ".menu"; cmd(top, "menu " + mn); j = 0; } } } tags := array[256] of { * => byte 0 }; gettag(win: ref Tk->Toplevel, n: int, d: int): string { i := int ((real n/real d) * real 15); if(i < 0 || i > 15) i = 0; s := "tag" + string i; if(tags[i] == byte 0){ rgb := "#" + hex2(255-64*0)+hex2(255-64*(i/4))+hex2(255-64*(i%4)); cmd(win, ".f.t tag configure " + s + " -fg black -bg " + rgb); tags[i] = byte 1; } return s; } percent(n: int, d: int): int { return int ((real n/real d) * real 100); } hex(i: int): int { if(i < 10) return i+'0'; else return i-10+'A'; } hex2(i: int): string { s := "00"; s[0] = hex(i/16); s[1] = hex(i%16); return s; } wincfg := array[] of { "frame .f", "text .f.t -width 809 -height 500 -state disabled -wrap char -bg white -yscrollcommand {.f.s set}", "scrollbar .f.s -orient vertical -command {.f.t yview}", "frame .i", "button .i.b -bitmap small_color_left.bit -command {send tkc b}", "button .i.f -bitmap small_color_right.bit -command {send tkc f}", "button .i.s -bitmap small_find.bit -command {send tkc s}", "button .i.m -bitmap small_reload.bit -command {send tkc m}", "pack .i.b -side left", "pack .i.f -side left", "pack .i.s -side left", "pack .i.m -side left", "pack .f.s -fill y -side left", "pack .f.t -fill both -expand 1", "pack .i -fill x", "pack .f -fill both -expand 1", "pack propagate . 0", "update", };