Google
 

Trailing-Edge - PDP-10 Archives - mit_emacs_170_teco_1220 - info/make_toc.clu
There are no other files named make_toc.clu in the archive.
start_up = proc ()
    as = array[string]
    afn = array[file_name]
    pi: stream := stream$primary_input ()
    po: stream := stream$primary_output ()
    po.output_buffered := false
    ifile: file_name
    while true do
	stream$puts (po, "Input file (defaults are PS:<INFO>.INFO.0): ")
	input: string := stream$getl (pi)
	if string$empty (input) then quit_ () end
	ifile := file_name$parse (input)
	   except
	      others:
		   stream$putl (po, "Bad file name.")
		   continue
	      end
	try: afn := afn$new ()
	afn$addh (try, ifile)
	if string$empty (ifile.dir) then
	   afn$addh (try, file_name$create ("ps:<info>", ifile.name,
					    ifile.suffix, ifile.other))
	   end
	if string$empty (ifile.suffix) then
	   afn$addh (try, file_name$create (ifile.dir, ifile.name,
					    "info", ""))
	   if string$empty (ifile.dir) then
	      afn$addh (try, file_name$create ("ps:<info>", ifile.name,
					       "info", ""))
	      end
	   end
	for ifile in afn$elements (try) do
	    if file_exists (ifile) then exit ok end
	    end
	stream$putl (po, "Not found.")
	end
       except when ok: end
    lpp: int
    while true do
	stream$puts (po, "Lines per page" ||
			 " (defaults right for PRESSIFY default): ")
	input: string := stream$getl (pi)
	if string$empty (input) then
	   lpp := 70
	   break
	   end
	lpp := int$parse (input)
	   except
	      others:
		   stream$putl (po, "A number please ...")
		   continue
	      end
	if lpp >= 0 then break end
	stream$putl (po, "Try again!")
	end
    stream$putl (po, "Output goes to TOC.OUTPUT.")
    fi: stream := stream$open (ifile, "read")
    fo: stream := open_write ("toc.output")
    stack: as := as$fill (1, 20, "(DIR)")
    for line: string, page: int in header_lines (fi, lpp) do
	node: string := extract ("Node", line)
	dad: string := extract ("Up", line)
	level: int := 1
	indent: string := "  "
	while stack[level] ~= dad do
	    level := level + 1
	    indent := indent || "    "
	    end
	stack[level+1] := node
	stream$putright (fo, int$unparse (page), 3)
	stream$putl (fo, indent || node)
	end
    stream$close (fi)
    stream$close (fo)
    quit_ ()
    end start_up

header_lines = iter (fi: stream, lpp: int) yields (string, int)
    header: bool := false
    for line: string, page: int in lines (fi, lpp) do
	if header then yield (line, page) end
	header := (~string$empty (line) cand line[1] = '\037')
	end
    end header_lines

lines = iter (fi: stream, lpp: int) yields (string, int)
    page: int := 1
    line_count: int := 0
    while true do
	line: string := stream$getl (fi)
	line_count := line_count + 1
	yield (line, page)
	if line_count = lpp then
	   page := page + 1
	   line_count := 0
	   end
	if string$indexc ('\p', line) ~= 0 then
	   page := page + 1			% possibly a second time!
	   line_count := 0
	   end
	end
       except when end_of_file: end
    end lines

extract = proc (key, line:string) returns (string)
    i: int := string$indexs (key, line)
    if i = 0 then return ("") end
    line := string$rest (line, i + string$size (key) + 1)
    while line[1] = ' ' do
	line := string$rest (line, 2)
	end except when bounds: return ("") end
    i := string$indexc (',', line)
    return (string$substr (line, 1, i - 1))
    end extract