#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("
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