## libdoc.icn
#
# usage: libdoc header outname file...
#
# Reads one or more .icn and/or .c files and writes:
# outname.cts table of contents, as macro calls
# outname.summ summary descriptions
# outname.full full descriptions
# outname.bun bundle (sh script) of individual full files
#
# All of these files must be processed further before use as HTML files.
#
# Note: outname.full will contain references to the file "outname.htm",
# and name.summ will contain references to the file "foutname.htm".
#
# 3-Feb-96/gmt
# 23-Nov-96/gmt
# 30-Sep-97/gmt
# 12-Nov-97/gmt
# 8-Dec-97/gmt
# 23-Jun-00/gmt
# 3-Jul-00/gmt
# 3-May-00/gmt switch from 'echo .\\c' to 'printf .'
# 3-May-00/gmt use absolute path for Icon home page
$define LIBPAGE "../ipl.htm"
$define ICONPAGE "http://www.cs.arizona.edu/icon/"
$define STYLESHEET "istyle.css"
$define BACKGROUND "blubordr.gif"
global header # section header
global outname # output file basename
global iname # current input file name
global cfile, ffile, sfile, bfile # output files
global file, subject, author, date # header info
global fbase, fextn # file name split into base and extensn
global preset, postset # sets of possible optional sections
global secttab # table of optional sections seen
global sdoc, xdoc # short doc, extended doc
global proclist # list of procedure one-liners
# main procedure
procedure main(args)
if *args < 3 then stop("usage: ", &progname, " header outname file...")
header := get(args)
outname := get(args)
cfile := creat(".cts")
ffile := creat(".full")
sfile := creat(".summ")
bfile := creat(".bun")
write(cfile, "$BEGIN(", outname, ",", header, ")")
write(bfile, "#!/bin/sh")
write(bfile, "#")
write(bfile, "# sh this file to unbundle ", outname, "/*.htm")
write(bfile)
write(bfile, "if [ ! -d ", outname, " ]; then mkdir ", outname, "; fi")
write(bfile, "cp ", outname, "/../", BACKGROUND, " ", outname)
preset := set(["Version", "History", "Contributor", "Contributors",
"This file is in the public domain"])
postset := set(["Links", "Requires", "Includes", "See also"])
every dofile(!args)
write(cfile, "$END")
write(bfile, "echo ' done.'")
end
# creat(suffix) -- open output file for writing
procedure creat(suffix)
local name, f
name := outname || suffix
f := open(name, "w") | stop("cannot open ", name, " for writing")
return f
end
# dofile(name) -- process one input file
procedure dofile(name)
local f, slist, plist, tail
# read data
iname := name
secttab := table()
f := open(iname) | return diag("cannot open")
readdoc(f) | fail
proclist := readprocs(f)
close(f)
# check File: name and fix if wrong
iname ? {
while tab(upto('/')+1)
tail := tab(0)
if file ~== tail then {
diag("\tfixing stated \"File: " || file || "\"")
file := tail
}
}
# break down into parts
file ? {
fbase := tab(upto('.') | 0)
move(1)
fextn := tab(0)
}
# write info
writects(cfile)
writesumm(sfile)
writefull(ffile)
writebun(bfile)
return
end
# readdoc(f) -- read documentation comments into globals
procedure readdoc(f)
local s, data, k
# read past header bar (which may be preceded by /* in a .c file)
s := rline(f) | return diag("empty file")
if s ? ="/*" then
s := rline(f) | return diag("nearly empty file")
if not (s ? ="##########") then
return diag("header bar missing")
# process header
readhdr(f) | fail
# find short documentation section, which may be preceded by others
data := readsect(f) | return diag("no documentation section")
while member(preset, k := sectkey(data)) do {
secttab[k] := data
data := readsect(f) | return diag("no documentation section")
}
sdoc := data
# read optional extended documentation and/or trailing sections
xdoc := []
while data := readsect(f) do
if member(postset, k := sectkey(data)) then
secttab[k] := data
else
put(xdoc, data)
return
end
# readhdr(f) -- read header information
procedure readhdr(f)
local data, i, kw, val
file := subject := author := date := &null
data := readsect(f) | return diag("no header section")
i := 0
while (i +:= 1) <= *data do {
data[i] ? {
if pos(0) then next
kw := tab(upto(':')) | return diag("header line without \":\"")
move(1)
tab(many(' '))
val := tab(0)
}
while *data[i+1] ~= 0 do data[i+:=1] ? {
tab(many(' '))
val ||:= " "
val ||:= tab(0)
}
case kw of {
"File": file := val
"Subject": subject := val
"Author" | "Authors": author := val
"Date": date := val
"Contributor" | "Contributors": &null # accept/ignore
default: return diag("unrecognized header keyword: "||kw)
}
}
/file := "[unspecified]";
# allow subject, author, date to be missing
# if /subject then return diag("missing subject from header")
# if /author then return diag("missing author from header")
# if /date then diag("missing date from header") # but continue
return
end
# diag(s) -- issue diagnostic about bad file, and fail
#
# Note that "return diag(---)" means "write message, then fail".
procedure diag(s)
write(&errout, "*** ", iname, ": ", s)
fail
end
# sectkey(data) -- return identifying keyword of section, if any
procedure sectkey(data)
return data[1] ? tab(upto(':.'))
end
# readsect(f) -- read next bar-delimited documentation section
#
# Removes empty lines at beginning and end.
# Removes uniform indentation and trailing whitespace.
procedure readsect(f)
local data, maxt, s, i
# read lines, terminating with a bar; EOF is an error
data := []
repeat (rline(f) | fail) ? {
="#" | break
if ="##########" then break
put(data, tab(0))
}
if *data = 0 then fail
# determine minimum indent
maxt := 7
every s := !data do s ?
="\t" | (maxt >:= *tab(many(' ')))
# left-shift every line by same amount
every i := 1 to *data do data[i] ?
if ="\t" then {
if maxt = 7 then data[i] := data[i][2:0]
}
else {
data[i] := data[i][maxt+1 : 0]
}
# remove leading and trailing empty lines
while *data[1] = 0 do
pop(data)
while *data[-1] = 0 do
pull(data)
return data
end
# rline(f) -- read line, trim whitespace, detab, and add escapes.
procedure rline(f)
return escape(detab(trim(read(f),' \t')))
end
# readprocs(f) -- read procedure one-liners, returning list
procedure readprocs(f)
local line, plist, name, text
static pset
initial pset := &lcase ++ &ucase ++ &digits ++ '_'
plist := []
while line := read(f) do line ? {
tab(many(' \t'))
="procedure" | next
tab(many(' \t'))
name := tab(many(pset)) | next
tab(find("#:") + 2) | next
tab(many(' \t'))
text := trim(tab(0), ' \t')
put(plist, name || " " || escape(text))
}
return plist
end
# escape(s) -- add escape codes for special HTML characters <>&"
procedure escape(s)
local t
t := ""
s ? {
while t ||:= tab(upto('<>"&')) do
t ||:= case move(1) of {
"<" : "<"
">" : ">"
"&" : "&"
"\"" : """
}
t ||:= tab(0)
}
return t
end
# writects(f) -- write contents entry to file f
procedure writects(f)
write(f, "$FILE(", fbase, ",", fextn, ",", subject, ")")
end
# writesumm(f) -- write summary output to file f
procedure writesumm(f)
local k
static special
initial special := set(
["See also", "Links", "Includes", "Version", "History"])
write(f)
write(f, "
")
writeprocs(f, proclist)
\subject | return diag("no Subject:")
if subject ? =("Definition" | "Include") then
write(f, "
$include "", file, "" ")
else if not (subject ? ="Program") then file ? {
if tab(-4) & match(".icn") then
write(f, "
link ", tab(1), " ")
else if tab(-2) & match(".c") then
write(f, "
link cfunc ")
}
write(f, "See also: ", allsect("See also:"), " ")
write(f, "", date, "; ", author)
every k := key(secttab) do
if not member(suppress, k) then
write(f, " ", allsect(k))
write(f, "")
write(f, "
")
every write(f, !sdoc)
every l := !xdoc do {
write(f, repl("_", 60))
write(f)
every write(f, !l)
}
write(f, "
")
return
end
# allsect(k) -- return all data from optional section k as string
procedure allsect(k)
local data, s
data := \secttab[k] | fail
s := ""
every s ||:= !data do s ||:= "\n"
return s[1:-1]
end
# writeprocs(f, plist) -- write procedures from list
procedure writeprocs(f, plist)
local s
if *plist = 0 then return
write(f, "
")
every s := !plist do s ?
write(f, "procedure ", left(tab(upto(' ')) || ":", 16), tab(0))
write(f, "