#line 3 "htmltree.nw" global url, qmark, base procedure main(args) server := getenv("SERVER_NAME") | "some_server" base := getenv("SCRIPT_NAME") | "/htmlview" url := "http://" || server || base path := args qmark := if upto('?', base) then "+" else "?" if args[1] == ("-gif"|"-dot"|"-nodemap"|"-clickable") then return gifout(args, get(args)) write("Content-type: text/html") write() write("NJ Machine-Code Toolkit Tree Explorer") write("") if *path = 0 then { i := 1 while tree(i) do { write("Matching statement #", i, " ", "(has ", leafphrase(tree(i)), ")

") i +:= 1 } } else { i := get(path) display_node(tree(i), [i], path) } write("") return end #line 33 "htmltree.nw" record treenode(name, offset, edges) record edge(ranges, node) record arm(file, line, name, code) procedure display_node(n, old, path) if i := get(path) then { write("", fieldname(n), "", inedge(n.edges[i]), " [graphics view]", " (reaches ", leafphrase(n.edges[i].node), ")", "

") put(old, i) display_node(n.edges[i].node, old, path) } else if type(n) == "treenode" then { write("", fieldname(n), " ", "[graphics view] in range ") c := "" every i := 1 to *n.edges do { put(old, i) writes(c, "", n.edges[i].ranges, "") pull(old) writes(" (", leafphrase(n.edges[i].node), ")") c := ",\n" } write("

") } else if type(n) == "list" then { every display_arm(!n) } else if type(n) == "string" then { write("", escape(n), "") } return end #line 67 "htmltree.nw" procedure leafcount(n) s := set() every insert(s, leafnames(n)) return *s end procedure leafnames(n) suspend case type(n) of { "treenode" : leafnames((!n.edges).node) "list" : { s := "" every a := !n do { s ||:= "\n" || a.file || ":" || a.line s ||:= "\n(" || \a.name || ")" } if *s > 1 then s[2:0] else s } "string" : n } end procedure leafphrase(n) x := leafcount(n) return x || " distinct " || (if x = 1 then "leaf" else "leaves") end #line 94 "htmltree.nw" procedure pathurl(p, front, base) p := [\front] ||| p # makes copy u := \base | url u ||:= qmark || p[1] every u ||:= "+" || p[2 to *p] return u end procedure inedge(e) return if upto(',-', e.ranges) then " in " || e.ranges else " = " || e.ranges end procedure fieldname(n) return n.name || " at " || n.offset end #line 111 "htmltree.nw" procedure display_arm(a) write("(Conditions not shown)") write("Execute code at ", a.file, ", line ", a.line, " with ", "name " || image(\a.name) | "no name", ":

") 
  every write(escape(!a.code))
  write("

") return end procedure escape(s) s ? { r := "" while r ||:= tab(upto('&<')) do if ="&" then r ||:= "&" else if ="<" then r ||:= "<" return r || tab(0) } end #line 132 "htmltree.nw" procedure gifout(path, ty) local treenum case ty of { "-gif" : { write("Content-type: image/gif") write() f := open("/usr/cs/contrib/bin/dot -Tgif", "wp") | { write("could not start dot"); return } } "-dot" : { write("Content-type: text/plain") write() f := &output } "-nodemap" : { f := open("/usr/cs/contrib/bin/dot -Tplain > /tmp/gifplain", "wp") | { write("could not start dot"); return } } "-clickable" : { write("Content-type: text/html") write() write("NJ Machine-Code Toolkit Tree Explorer") write("") f := open("/usr/cs/contrib/bin/dot -Tplain > /tmp/gifplain", "wp") | { write("could not start dot"); return } write("") } "-old-clickable" : { write("Content-type: text/html") write() write("NJ Machine-Code Toolkit Tree Explorer") write("") write("") write("

") write("") return } default : stop("this can't happen") } t := tree(treenum := integer(get(path))) | {write("Bad path"); return} k := dotouttree(f, t, path) close(f) if ty == ("-nodemap" | "-clickable") then donodemap(k, t, path, treenum, ty) if ty == "-clickable" then { write("
Go to the text view") write("


Trees drawn by dot, from the ", "graphviz", " package. Visit the ", "Toolkit home page.", "") write("") } return end #line 192 "htmltree.nw" procedure dotouttree(file, root, path, treenum) local known, number, prev write(file, "digraph decisions {") known := table() number := create(seq()) n := root every i := integer(!path) do { write(file, "N", /known[n] := @number, " [peripheries=2,label=\"", n.name, "@" || (0 < n.offset) | "", "\"];") # write("known[", image(n), "] = ", image(known[n])) n := n.edges[i].node } dotoutnode(file, n, known, number) n := root every i := integer(!path) & e := n.edges[i] do { write(file, "N", known[n], " -> N", known[e.node], " [style=dashed,label=", image(split10(e.ranges)), "];") n := e.node } write(file, "}") return known end procedure dotoutnode(file, n, known, number) if /known[n] then case type(n) of { "treenode" : { write(file, "N", known[n] := @number, " [label=\"", n.name, "@" || (0 < n.offset) | "", "\"];") # write("known[", image(n), "] := ", image(known[n])) every e := !n.edges do { dotoutnode(file, e.node, known, number) write(file, "N", known[n], " -> N", known[e.node], " [label=", image(split10(e.ranges)), "];") } } "list" : { if /known[l := leafnames(n)] then write(file, "N", known[l] := @number, " [shape=box,label=", image(if *l = 0 then "NO MATCH" else l), "];") known[n] := known[l] # write("known[", image(n), "] := ", image(known[n])) } "string" : write(file, "N", known[n] := @number, " [label=", image(n), "];") } return end #line 240 "htmltree.nw" procedure donodemap(known, root, path, treenum, ty) local file if ty == "-nodemap" then { write("Content-type: text/x-imagemap") write() write("default /youlose.html") } f := open("/tmp/gifplain") | { write("Cannot open /tmp/gifplain"); return } bbs := readbbs(f) close(f) remove("/tmp/gifplain") n := root file := &output every i := 1 to *path do { # write("mapping ", image(n)) emit_rect(file, ty, pathurl(path[1:i], "-clickable+" || treenum), bbs["N" || known[n]]) n := n.edges[path[i]].node } # write("next up: ", image(n)) nodemapnode(file, n, path, known, bbs, ty, treenum) return end procedure nodemapnode(file, n, path, known, bbs, ty, treenum) # write("Mapping ", image(n)) case type(n) of { "treenode" : { emit_rect(file, ty, pathurl(path, "-clickable+" || treenum), bbs["N" || known[n]]) every e := n.edges[i := 1 to *n.edges] do { put(path, i) nodemapnode(file, e.node, path, known, bbs, ty, treenum) pull(path) } } "list" : emit_rect(file, ty, pathurl(path, treenum), bbs["N" || known[n]]) "string" : &null } return end #line 282 "htmltree.nw" procedure emit_rect(file, ty, url, bb) case ty of { "-nodemap" : write(file, "rect ", url, " ", bb.llx, ",", bb.lly, " ", bb.urx, ",", bb.ury) "-clickable" : write(file, "") } return end #line 293 "htmltree.nw" record bbox(llx, lly, urx, ury) record graph(bbs, w, h) procedure readbbs(file) local scale, width, height, bb, cx, cy, w, h, dx, dy, pixw, pixh bb := table() while line := read(file) do line ? if ="graph" & tab(many(' \t')) then { every scale | width | height := float() pixw := round(72*width) + 2 pixh := round(72*height) + 2 } else if ="node" & tab(many(' \t')) then { n := tab(upto(' \t')) every cx | cy | w | h := float() cy := height - cy # invert to put 0 at top dx := w / 2.0 dy := h / 2.0 bb[n] := bbscale(bbox((cx - dx)/width, (cy - dy)/height, (cx + dx)/width, (cy + dy)/height), pixw, pixh) } return bb end procedure float() tab(many(' \t')) return numeric(tab(upto(' \t')|0)) end procedure round(f) return integer(f+0.5) end #line 326 "htmltree.nw" procedure bbscale(bb, w, h) bb.llx := scale(bb.llx, w); bb.lly := scale(bb.lly, h) bb.urx := scale(bb.urx, w); bb.ury := scale(bb.ury, h) return bb end procedure scale(x, w) return integer(x * w) end #line 346 "htmltree.nw" procedure split10(s) static N local k initial N := 18 if *s > N & find(", ", s) <= N then { every k := N >= find(", ", s) return s[1:k+1] || "\n" || split10(s[k+2:0]) # keep comma, drop space } else { return s } end