diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /web/noweb/src/icon |
Initial commit
Diffstat (limited to 'web/noweb/src/icon')
49 files changed, 14349 insertions, 0 deletions
diff --git a/web/noweb/src/icon/Makefile b/web/noweb/src/icon/Makefile new file mode 100644 index 0000000000..7d9b8db1eb --- /dev/null +++ b/web/noweb/src/icon/Makefile @@ -0,0 +1,151 @@ +SHELL=/bin/sh +LIB=/dev/null # to be overridden +BIN=/dev/null # to be overridden +ICONC=iconc -p -L/usr/X11R6/lib # override to icont if no iconc on your system +ICONT=icont # override to iconc if all filters should be compiled +CPIF=| cpif # change to ">" to insure all sources always made + +LIBEXECS=totex disambiguate noidx tohtml elide l2h docs2comments \ + autodefs.tex autodefs.icon autodefs.yacc autodefs.sml autodefs.pascal \ + autodefs.promela autodefs.lrtl autodefs.asdl autodefs.mmix xchunks pipedocs +LIBSPECIAL=autodefs.cee +BINEXECS=noindex sl2h htmltoc +EXECS=$(LIBEXECS) $(BINEXECS) $(LIBSPECIAL) pdcached +SRCS=totex.icn disambiguate.icn noidx.icn texdefs.icn icondefs.icn \ + yaccdefs.icn noindex.icn smldefs.icn tohtml.icn cdefs.icn elide.icn \ + l2h.icn sl2h.icn pascaldefs.icn promeladefs.icn lrtldefs.icn asdldefs.icn \ + mmixdefs.icn htmltoc.icn xchunks.icn docs2comments.icn pipedocs.icn pdcached.icn + +.SUFFIXES: .nw .icn .html .tex .dvi +.nw.icn: + notangle -L'#line %-1L "%F"%N' $*.nw $(CPIF) $*.icn +.nw.html: + noweave -filter l2h -autodefs icon -html -index $*.nw | htmltoc > $*.html +.nw.tex: + noweave -delay -autodefs icon -index $*.nw > $*.tex +.tex.dvi: + latex $*; while grep -s 'Rerun to get cross' $*.log; do latex $*; done + +all: $(EXECS) +source: $(SRCS) +touch: $(SRCS) + touch $(SRCS) + +boot: + touch $(SRCS) + +install: $(EXECS) + cp $(LIBEXECS) $(LIB) + cp $(BINEXECS) $(BIN) + cp $(LIBSPECIAL) $(LIB)/autodefs.c + +uninstall: + for i in $(LIBEXECS); do rm -f $(LIB)/$$i; done + for i in $(BINEXECS); do rm -f $(BIN)/$$i; done + rm -f $(LIB)/autodefs.c + +clean: + /bin/rm -f *.tex *.dvi *.aux *.log *.blg *.bbl *~ *.toc *.html *.u1 *.u2 + /bin/rm -f *.[ch] *.ps *.gz + /bin/rm -f $(EXECS) + /bin/rm -f sl2h + +clobber: clean + /bin/rm -f *.icn + +texdefs.icn: texdefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' texdefs.nw defns.nw $(CPIF) texdefs.icn +icondefs.icn: icondefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' icondefs.nw defns.nw $(CPIF) icondefs.icn +yaccdefs.icn: yaccdefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' yaccdefs.nw defns.nw $(CPIF) yaccdefs.icn +smldefs.icn: smldefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' smldefs.nw defns.nw $(CPIF) smldefs.icn +cdefs.icn: cdefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' cdefs.nw defns.nw $(CPIF) cdefs.icn +pascaldefs.icn: pascaldefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' pascaldefs.nw defns.nw $(CPIF) pascaldefs.icn +promeladefs.icn: promeladefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' promeladefs.nw defns.nw $(CPIF) promeladefs.icn +lrtldefs.icn: lrtldefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' lrtldefs.nw defns.nw $(CPIF) lrtldefs.icn +asdldefs.icn: asdldefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' asdldefs.nw defns.nw $(CPIF) asdldefs.icn +mmixdefs.icn: mmixdefs.nw defns.nw + notangle -L'#line %-1L "%F"%N' mmixdefs.nw defns.nw $(CPIF) mmixdefs.icn + +autodefs.tex: texdefs.icn + $(ICONT) -o autodefs.tex texdefs.icn + +autodefs.icon: icondefs.icn + $(ICONC) -o autodefs.icon icondefs.icn + +autodefs.yacc: yaccdefs.icn + $(ICONT) -o autodefs.yacc yaccdefs.icn + +autodefs.sml: smldefs.icn + $(ICONT) -o autodefs.sml smldefs.icn + +autodefs.cee: cdefs.icn + $(ICONT) -o autodefs.cee cdefs.icn + +autodefs.pascal: pascaldefs.icn + $(ICONT) -o autodefs.pascal pascaldefs.icn + +autodefs.promela: promeladefs.icn + $(ICONT) -o autodefs.promela promeladefs.icn + +autodefs.lrtl: lrtldefs.icn + $(ICONT) -o autodefs.lrtl lrtldefs.icn + +autodefs.asdl: asdldefs.icn + $(ICONT) -o autodefs.asdl asdldefs.icn + +autodefs.mmix: mmixdefs.icn + $(ICONT) -o autodefs.mmix mmixdefs.icn + +totex: totex.icn + $(ICONC) totex.icn + +totexnr: totexnr.icn + $(ICONT) totexnr.icn + +tohtml: tohtml.icn + $(ICONC) tohtml.icn + +docs2comments: docs2comments.icn + $(ICONT) docs2comments.icn # no longer compiles with iconc + +xchunks: xchunks.icn + $(ICONT) xchunks.icn + +l2h.icn: l2h.nw + notangle -L'#line %-1L "%F"%N' -R'l2h.icn' l2h.nw $(CPIF) l2h.icn +l2h: l2h.icn + $(ICONT) -o l2h l2h.icn # no longer compiles with iconc + +sl2h.icn: l2h.nw + notangle -L'#line %-1L "%F"%N' -R'sl2h.icn' l2h.nw $(CPIF) sl2h.icn +sl2h: sl2h.icn + $(ICONT) -o sl2h sl2h.icn # no longer compiles with iconc + +noindex: noindex.icn + $(ICONT) noindex.icn + +noidx: noidx.icn + $(ICONT) noidx.icn # no longer compiles with iconc + +elide: elide.icn + $(ICONT) elide.icn + +pipedocs: pipedocs.icn + $(ICONT) pipedocs.icn + +pdcached: pdcached.icn + $(ICONT) pdcached.icn + +disambiguate: disambiguate.icn + $(ICONT) disambiguate.icn + +htmltoc: htmltoc.icn + $(ICONT) htmltoc.icn diff --git a/web/noweb/src/icon/asdldefs.icn b/web/noweb/src/icon/asdldefs.icn new file mode 100644 index 0000000000..a1d2a88dbd --- /dev/null +++ b/web/noweb/src/icon/asdldefs.icn @@ -0,0 +1,85 @@ +#line 3 "asdldefs.nw" +procedure main(args) + go() +end +#line 7 "asdldefs.nw" +global idchars +procedure postpass(name, arg) + static kind + initial { idchars := &letters ++ &digits ++ '_.' + kind := "bogus" + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then (arg || "--") ? (tab(find("--") \ 1) ? { + if (optwhite(), any(&lcase), t := tab(many(idchars)), optwhite(), ="=") + then + undotted(t) + while tab(upto(idchars)) do + if (="imports", any(' \t')) then + (tab(upto(idchars)), tab(many(idchars))) + else if any(&ucase) then undotted(tab(many(idchars))) + else tab(many(idchars)) + }) + } + return +end + +procedure undotted(s) + return if upto('.', s) then &null else writedefn(s) +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end +#line 41 "asdldefs.nw" +procedure rcsinfo () + return "$Id: asdldefs.nw,v 1.15 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/asdldefs.nw b/web/noweb/src/icon/asdldefs.nw new file mode 100644 index 0000000000..b7ff2febc8 --- /dev/null +++ b/web/noweb/src/icon/asdldefs.nw @@ -0,0 +1,46 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +\section{Finding definitions in $\lambda$-RTL} +<<*>>= +procedure main(args) + go() +end +<<*>>= +global idchars +procedure postpass(name, arg) + static kind + initial { idchars := &letters ++ &digits ++ '_.' + kind := "bogus" + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then (arg || "--") ? (tab(find("--") \ 1) ? { + if (optwhite(), any(&lcase), t := tab(many(idchars)), optwhite(), ="=") + then + undotted(t) + while tab(upto(idchars)) do + if (="imports", any(' \t')) then + (tab(upto(idchars)), tab(many(idchars))) + else if any(&ucase) then undotted(tab(many(idchars))) + else tab(many(idchars)) + }) + } + return +end + +procedure undotted(s) + return if upto('.', s) then &null else writedefn(s) +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end +<<*>>= +procedure rcsinfo () + return "$Id: asdldefs.nw,v 1.15 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/cdefs.icn b/web/noweb/src/icon/cdefs.icn new file mode 100644 index 0000000000..a74d46fc5d --- /dev/null +++ b/web/noweb/src/icon/cdefs.icn @@ -0,0 +1,180 @@ +#line 2 "cdefs.nw" +global decls_ok +procedure main(args) + decls_ok := !args == "-decl" + go() +end +#line 8 "cdefs.nw" +global typespecs, storespecs, typequals, otherspecs, structlike +procedure postpass(name, arg) + local tok, stat + static kind + initial { + kind := "bogus" + storespecs := set(["typedef", "extern", "static", "auto", "register"]) + typespecs := set(["void", "char", "float", "short", "signed", + "int", "double", "long", "unsigned"]) + typequals := set(["const", "volatile"]) + otherspecs := storespecs ++ typequals + structlike := set(["struct", "union", "enum"]) + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : arg ? { + if kind ~== "code" then return + if any(' \t') then return + if (="#define", tab(many(' \t'))) then return wd(c_ident_token()) + if find("dclproto") then return + if ="}" then { + if c_ident_token() == "while" then fail # don't get tripped by do { ... } while + +#line 61 "cdefs.nw" +while x := declarator() do { + wd(x, stat) + if c_token() == "," then &null else return +} +#line 31 "cdefs.nw" + } else { + specifier_count := 0 + stat := &null # haven't seen static yet + seenType := &null + while ( + (/decls_ok & c_ident_token() == "extern", return) | + (member(typespecs, c_ident_token()), seenType := 1) | # swallow type + (member(otherspecs, tok := c_ident_token()), + stat := look_for_static(stat, tok)) | # swallow a specifier + (member(structlike, c_ident_token()), # struct with optional tag + c_ident_token() | &null) | + (/seenType, any(&ucase, c_ident_token()), seenType := 1) + # assume a typedef'd type, skip + ) do + specifier_count +:= 1 +## write(&errout, "skipped ", specifier_count, " specifiers") + if f := scan_function() then + if /decls_ok & c_token() == (";"|",") then fail else { +## write(&errout, "function ", image(f), " followed by ", +## image(c_token()) | "<EOL>") + wd(f, stat) + return + } + if specifier_count > 0 then { +#line 61 "cdefs.nw" +while x := declarator() do { + wd(x, stat) + if c_token() == "," then &null else return +} +#line 54 "cdefs.nw" + } + } + } + } + return +end +#line 66 "cdefs.nw" +procedure wd(x, stat) + static reserved + initial reserved := set([ + "asm", "auto", "break", "case", "char", "const", "continue", + "default", "double", "do", "else", "enum", "extern", "float", "for", + "goto", "if", "int", "long", "register", "return", "short", + "signed", "sizeof", "static", "struct", "switch", "typedef", "union", + "unsigned", "void", "volatile", "while"]) + if member(reserved, x) then return + return writedefn(x, stat) +end + +procedure prepass(name, arg) + return +end + +procedure c_ident_token() + static alpha, alnum + initial { alpha := '_' ++ &letters; alnum := alpha ++ &digits } + tab(many(' \t')) + if any(alpha) then suspend tab(many(alnum)) +end + +procedure c_token() + static alpha, alnum + initial { alpha := '_' ++ &letters; alnum := alpha ++ &digits } + tab(many(' \t')) + if any(alpha) then suspend tab(many(alnum)) else suspend move(1) +end + +procedure scan_function() + (f := c_ident_token(), +#write(&errout, " try function ", image(f)), + tab(many(' \t')) | &null, + any('('), + *tab(bal()) > 0 | + (="(", *tab(bal(',', '[{(', ')}]')) > 0, =",", optwhite(), pos(0)), +#write(&errout, " caught function trailing ", image(&subject[&pos:0])), + suspend f + ) +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end + +procedure declarator() + while c_token() == "*" do + while member(typequals, c_token()) + (c_token() == "(", d := declarator(), c_token() == ")") | + (d := c_ident_token()) | + fail + while c_token() == ("[", "(") do + (tab(bal('])','[(',')]')), c_token()) + return d +end +#line 123 "cdefs.nw" +procedure look_for_static(stat, tok) + return (tok == "static") | stat +end +#line 127 "cdefs.nw" +procedure rcsinfo () + return "$Id: cdefs.nw,v 1.19 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/cdefs.nw b/web/noweb/src/icon/cdefs.nw new file mode 100644 index 0000000000..186f47d3b3 --- /dev/null +++ b/web/noweb/src/icon/cdefs.nw @@ -0,0 +1,132 @@ +\section{Finding definitions in ANSI C} +<<*>>= +global decls_ok +procedure main(args) + decls_ok := !args == "-decl" + go() +end +<<*>>= +global typespecs, storespecs, typequals, otherspecs, structlike +procedure postpass(name, arg) + local tok, stat + static kind + initial { + kind := "bogus" + storespecs := set(["typedef", "extern", "static", "auto", "register"]) + typespecs := set(["void", "char", "float", "short", "signed", + "int", "double", "long", "unsigned"]) + typequals := set(["const", "volatile"]) + otherspecs := storespecs ++ typequals + structlike := set(["struct", "union", "enum"]) + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : arg ? { + if kind ~== "code" then return + if any(' \t') then return + if (="#define", tab(many(' \t'))) then return wd(c_ident_token()) + if find("dclproto") then return + if ="}" then { + if c_ident_token() == "while" then fail # don't get tripped by do { ... } while + <<eat declarators>> + } else { + specifier_count := 0 + stat := &null # haven't seen static yet + seenType := &null + while ( + (/decls_ok & c_ident_token() == "extern", return) | + (member(typespecs, c_ident_token()), seenType := 1) | # swallow type + (member(otherspecs, tok := c_ident_token()), + stat := look_for_static(stat, tok)) | # swallow a specifier + (member(structlike, c_ident_token()), # struct with optional tag + c_ident_token() | &null) | + (/seenType, any(&ucase, c_ident_token()), seenType := 1) + # assume a typedef'd type, skip + ) do + specifier_count +:= 1 +## write(&errout, "skipped ", specifier_count, " specifiers") + if f := scan_function() then + if /decls_ok & c_token() == (";"|",") then fail else { +## write(&errout, "function ", image(f), " followed by ", +## image(c_token()) | "<EOL>") + wd(f, stat) + return + } + if specifier_count > 0 then {<<eat declarators>>} + } + } + } + return +end +<<eat declarators>>= +while x := declarator() do { + wd(x, stat) + if c_token() == "," then &null else return +} +<<*>>= +procedure wd(x, stat) + static reserved + initial reserved := set([ + "asm", "auto", "break", "case", "char", "const", "continue", + "default", "double", "do", "else", "enum", "extern", "float", "for", + "goto", "if", "int", "long", "register", "return", "short", + "signed", "sizeof", "static", "struct", "switch", "typedef", "union", + "unsigned", "void", "volatile", "while"]) + if member(reserved, x) then return + return writedefn(x, stat) +end + +procedure prepass(name, arg) + return +end + +procedure c_ident_token() + static alpha, alnum + initial { alpha := '_' ++ &letters; alnum := alpha ++ &digits } + tab(many(' \t')) + if any(alpha) then suspend tab(many(alnum)) +end + +procedure c_token() + static alpha, alnum + initial { alpha := '_' ++ &letters; alnum := alpha ++ &digits } + tab(many(' \t')) + if any(alpha) then suspend tab(many(alnum)) else suspend move(1) +end + +procedure scan_function() + (f := c_ident_token(), +#write(&errout, " try function ", image(f)), + tab(many(' \t')) | &null, + any('('), + *tab(bal()) > 0 | + (="(", *tab(bal(',', '[{(', ')}]')) > 0, =",", optwhite(), pos(0)), +#write(&errout, " caught function trailing ", image(&subject[&pos:0])), + suspend f + ) +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end + +procedure declarator() + while c_token() == "*" do + while member(typequals, c_token()) + (c_token() == "(", d := declarator(), c_token() == ")") | + (d := c_ident_token()) | + fail + while c_token() == ("[", "(") do + (tab(bal('])','[(',')]')), c_token()) + return d +end +<<*>>= +procedure look_for_static(stat, tok) + return (tok == "static") | stat +end +<<*>>= +procedure rcsinfo () + return "$Id: cdefs.nw,v 1.19 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/defns.nw b/web/noweb/src/icon/defns.nw new file mode 100644 index 0000000000..f168d25b29 --- /dev/null +++ b/web/noweb/src/icon/defns.nw @@ -0,0 +1,40 @@ +<<*>>= +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +@ +[[indextext]] is a hack to introduce suitable ``[[@index nl]],'' but it +messes up the line counts! +<<*>>= +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & <<flush index>> + else { + if *indextext + *defn > 65 then <<flush index>> + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +<<flush index>>= +{ # write("@index nl") # don't! + indextext := "" +} +<<*>>= +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/disambiguate.icn b/web/noweb/src/icon/disambiguate.icn new file mode 100644 index 0000000000..da547d37d6 --- /dev/null +++ b/web/noweb/src/icon/disambiguate.icn @@ -0,0 +1,67 @@ +#line 7 "disambiguate.nw" +global chunknames + +procedure remember(name) + initial chunknames := table() + if *name = 0 then fail + /chunknames[name[1]] := set() + insert(chunknames[name[1]], name) + return +end +#line 20 "disambiguate.nw" +procedure disambiguate(arg) + local s + if *arg = 0 then fail + search := chunknames[arg[1]] + if /search then fatal("Can't resolve ", arg, "...") + every match(arg, n := !search) do + if /s then s := n + else fatal("Ambiguous abbreviation: <<", arg, "...>> could denote\n\t<<", + s, ">> or\n\t<<", n, ">>") + if *s = 0 then fatal("Can't resolve ", arg, "...") + return s +end +#line 35 "disambiguate.nw" +global lines, defns, uses, names, firstdefnout + +procedure main(args) + lines := [] + while put(lines, line := read()) do + apply(pass1, line) + every apply(pass2, !lines) +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end + +procedure pass1(name, chunkname) + initial chunknames := set() + case name of { + "defn" | "use" : + if chunkname[0-:3] ~== "..." then remember(chunkname) + } + return +end + +procedure pass2(name, arg) + case name of { + "defn" | "use" : + if arg[0:-3] == "..." then arg := disambiguate(arg[1:-3]) + } + write("@", name, (" " || \arg) | "") + if name == "fatal" then exit(1) + return +end +#line 68 "disambiguate.nw" +procedure fatal(L[]) + write!(["@fatal disambiguate "] ||| L) + write!([&errout, "noweb error in disambiguate: "] ||| L) + exit(1) +end + +#line 75 "disambiguate.nw" +procedure rcsinfo () + return "$Id: disambiguate.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/disambiguate.nw b/web/noweb/src/icon/disambiguate.nw new file mode 100644 index 0000000000..8f23d515b1 --- /dev/null +++ b/web/noweb/src/icon/disambiguate.nw @@ -0,0 +1,80 @@ +\section{Disambiguating abbreviated chunk names} +This code disambiguates chunk names ending in [[...]]. +If used, it belongs right after [[markup]] in the pipeline. + +The first pass calls [[remember]] on each name {\em not} ending in dots. +For efficiency, I keep a table of sets indexed by the first character of the name. +<<*>>= +global chunknames + +procedure remember(name) + initial chunknames := table() + if *name = 0 then fail + /chunknames[name[1]] := set() + insert(chunknames[name[1]], name) + return +end +@ + +The second pass calls [[disambiguate]] on each name that {\em does} end in dots. +<<*>>= +procedure disambiguate(arg) + local s + if *arg = 0 then fail + search := chunknames[arg[1]] + if /search then fatal("Can't resolve ", arg, "...") + every match(arg, n := !search) do + if /s then s := n + else fatal("Ambiguous abbreviation: @<<", arg, "...@>> could denote\n\t@<<", + s, "@>> or\n\t@<<", n, "@>>") + if *s = 0 then fatal("Can't resolve ", arg, "...") + return s +end +@ +The +<<*>>= +global lines, defns, uses, names, firstdefnout + +procedure main(args) + lines := [] + while put(lines, line := read()) do + apply(pass1, line) + every apply(pass2, !lines) +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end + +procedure pass1(name, chunkname) + initial chunknames := set() + case name of { + "defn" | "use" : + if chunkname[0-:3] ~== "..." then remember(chunkname) + } + return +end + +procedure pass2(name, arg) + case name of { + "defn" | "use" : + if arg[0:-3] == "..." then arg := disambiguate(arg[1:-3]) + } + write("@", name, (" " || \arg) | "") + if name == "fatal" then exit(1) + return +end +@ +<<*>>= +procedure fatal(L[]) + write!(["@fatal disambiguate "] ||| L) + write!([&errout, "noweb error in disambiguate: "] ||| L) + exit(1) +end + +<<*>>= +procedure rcsinfo () + return "$Id: disambiguate.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/docs2comments.icn b/web/noweb/src/icon/docs2comments.icn new file mode 100644 index 0000000000..0f8e914378 --- /dev/null +++ b/web/noweb/src/icon/docs2comments.icn @@ -0,0 +1,180 @@ +#line 8 "docs2comments.nw" +global format, subst, firstline, lastline, allchunks, chunks, width +record wrap(l, r) # put fore and aft of line +record breakup(strings) # split up these strings with spaces +record tr(old, new) # translate old chars to new +global left_quote, right_quote + +procedure main(args) + format := wrap("/* ", " */") + subst := breakup(["/*","*/"]) + width := 80 + left_quote := "[[" + right_quote := "]]" + while a := get(args) do + case a of { + "-ml" | "-m3" : (format := wrap("(* ", " *)"), subst := breakup(["(*", "*)"])) + "-awk" | "-icn" | "-icon" : format := wrap("# ") + "-lisp" | "-scm" : format := wrap(";;; ") + "-c++" : format := wrap("// ") + "-c" : { format := wrap(" * "); firstline := "/*"; lastline := " */" + subst := breakup(["/*", "*/"]) + } + "-ocamlweb" : { format := wrap(" "); firstline := "(*"; lastline := " *)" + subst := breakup(["(*", "*)"]) + left_quote := "["; right_quote := "]" + } + "-pascal" : { format := wrap("{ ", " }"); subst := tr("{}", "--") } + "-f77" : format := wrap("C ") + "-f90" : format := wrap("! ") + "-tex" : format := wrap("%% ") + "-lua" : format := wrap("-- ") + + "-all" : allchunks := 1 + "-one" : allchunks := &null + default : + a ? + if (="-w", width <- integer(tab(many(&digits))), pos(0)) then + &null + else if ="-L" then + &null # deliberately ignore requests for #line + else { + write("@fatal unknown argument '", a, "' to docs2comments") + exit(1) + } + } + +#line 96 "docs2comments.nw" +chunks := [] +while line := read() do + line ? + if ="@end docs" | ="@end code" then { + if (\holding)[-1] == "" then pull (holding) + put(chunks, code(preceding_defn, \defn_pending, holding) | docs(holding)) +## if type(chunks[-1]) == "code" then +## every write("##### " || ( +## "preceding defn is " || image(preceding_defn) | +## "defn pending is " || image(defn_pending) | +## "Holding chunk with these lines:" | image(!holding))) + defn_pending := &null + holding := &null + chunks := drain(chunks) + } else if ="@begin docs" then { + indocs := 1 + holding := [""] + } else if ="@begin code" then { + indocs := &null + holding := [""] + } else if \indocs then { + if ="@text " then { + grab(tab(0), holding) + } else if ="@quote" & pos(0) then { + grab(left_quote, holding) + } else if ="@endquote" & pos(0) then { + grab(right_quote, holding) + } else if ="@nl" & pos(0) then { + put(\holding, "") + } + } else if ="@defn " then { + defn_pending := tab(0) + if holding[-1] == "" then pull (holding) + preceding_defn := holding + holding := [] + } else { + if match("@xref ") & (\holding)[-1] == "" then pull(holding) + put(\holding, line) + } +drain(put(chunks, docs([]))) +#line 53 "docs2comments.nw" + return +end +#line 57 "docs2comments.nw" +procedure insert_blanks(s, bad) + s ? { + r := "" + while r ||:= tab(find(bad)) do { + r ||:= bad[1] + every i := 2 to *bad do r ||:= " " || bad[i] + =bad + } + return r || tab(0) + } +end +#line 70 "docs2comments.nw" +procedure comment(s) + case type(subst) of { + "breakup" : every s := insert_blanks(s, !subst.strings) + "tr" : s := map(s, subst.old, subst.new) + "null" : &null + default : stop("unknown substitution of type ", type(subst)) + } + if /format.r then + return format.l || s + else { + if *s < width then s ||:= repl(" ", width - *s) + return format.l || s || format.r + } +end +#line 88 "docs2comments.nw" +procedure grab(s, holding) + return (\holding)[-1] := holding[-1] || s +end + +record docs(lines) +record code(preceding, defn, lines) + +#line 138 "docs2comments.nw" +procedure emit_as_comments(c) + type(c) == "docs" | runerr(1, "Unexpected code chunk") + every write("@text ", comment(trailing_nonblank(\c.lines)), "\n@nl") + return +end + +procedure trailing_nonblank(l) + local suspended + every s := !l do + if \suspended | *s > 0 then { + suspended := 1 + suspend s + } +end + + +procedure drain(chunks) + static n + initial n := -1 + if type(c := chunks[-2]) == "code" then { + write("@begin code ", n +:= 1) + every write(!c.preceding | ("@defn " || c.defn) | "@nl") + write("@text ", \firstline, "\n@nl") + every i := (if \allchunks then 1 else *chunks -2) to *chunks - 2 do + emit_as_comments(chunks[i]) + write("@text ", comment("<" || c.defn || ">="), "\n@nl") + write("@text ", \lastline, "\n@nl") + copyxreflines(\c.lines) + bad := &null + (bad := get(\c.lines)) == "@nl" | + { write(&errout, "expected newline after definition; got ", image(bad)); + runerr(1, bad) } + every write(!c.lines) + c := chunks[-1] + if type(c) == "docs" & upto(\c.lines[1], ~' \n\t') then { + write("@text ", \firstline, "\n@nl") + emit_as_comments(c) + write("@text ", \lastline, "\n@nl") + write("@nl") + chunks := [] + } else + chunks := [c] + write("@end code ", n) + } + return chunks +end + +procedure copyxreflines(l) + while match("@xref ", l[1]) do { + #write(&errout, "COPYING ", image(l[1])) + get(l) #write(get(l)) + } + return +end diff --git a/web/noweb/src/icon/docs2comments.nw b/web/noweb/src/icon/docs2comments.nw new file mode 100644 index 0000000000..1a6935e457 --- /dev/null +++ b/web/noweb/src/icon/docs2comments.nw @@ -0,0 +1,192 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- + +\section{Convert documentation chunks to comments} + +Options indicate what language and comment style is preferred, +plus whether to attach one or all nearby doc chunks to code. +One is the default. +<<*>>= +global format, subst, firstline, lastline, allchunks, chunks, width +record wrap(l, r) # put fore and aft of line +record breakup(strings) # split up these strings with spaces +record tr(old, new) # translate old chars to new +global left_quote, right_quote + +procedure main(args) + format := wrap("/* ", " */") + subst := breakup(["/*","*/"]) + width := 80 + left_quote := "[[" + right_quote := "]]" + while a := get(args) do + case a of { + "-ml" | "-m3" : (format := wrap("(* ", " *)"), subst := breakup(["(*", "*)"])) + "-awk" | "-icn" | "-icon" : format := wrap("# ") + "-lisp" | "-scm" : format := wrap(";;; ") + "-c++" : format := wrap("// ") + "-c" : { format := wrap(" * "); firstline := "/*"; lastline := " */" + subst := breakup(["/*", "*/"]) + } + "-ocamlweb" : { format := wrap(" "); firstline := "(*"; lastline := " *)" + subst := breakup(["(*", "*)"]) + left_quote := "["; right_quote := "]" + } + "-pascal" : { format := wrap("{ ", " }"); subst := tr("{}", "--") } + "-f77" : format := wrap("C ") + "-f90" : format := wrap("! ") + "-tex" : format := wrap("%% ") + "-lua" : format := wrap("-- ") + + "-all" : allchunks := 1 + "-one" : allchunks := &null + default : + a ? + if (="-w", width <- integer(tab(many(&digits))), pos(0)) then + &null + else if ="-L" then + &null # deliberately ignore requests for #line + else { + write("@fatal unknown argument '", a, "' to docs2comments") + exit(1) + } + } + <<transform [[&input]]>> + return +end +@ +<<*>>= +procedure insert_blanks(s, bad) + s ? { + r := "" + while r ||:= tab(find(bad)) do { + r ||:= bad[1] + every i := 2 to *bad do r ||:= " " || bad[i] + =bad + } + return r || tab(0) + } +end +@ +<<*>>= +procedure comment(s) + case type(subst) of { + "breakup" : every s := insert_blanks(s, !subst.strings) + "tr" : s := map(s, subst.old, subst.new) + "null" : &null + default : stop("unknown substitution of type ", type(subst)) + } + if /format.r then + return format.l || s + else { + if *s < width then s ||:= repl(" ", width - *s) + return format.l || s || format.r + } +end +@ +[[grab]] concatenates a string [[s]] onto the last line being held in +list [[holding]]. +<<*>>= +procedure grab(s, holding) + return (\holding)[-1] := holding[-1] || s +end + +record docs(lines) +record code(preceding, defn, lines) + +<<transform [[&input]]>>= +chunks := [] +while line := read() do + line ? + if ="@end docs" | ="@end code" then { + if (\holding)[-1] == "" then pull (holding) + put(chunks, code(preceding_defn, \defn_pending, holding) | docs(holding)) +## if type(chunks[-1]) == "code" then +## every write("##### " || ( +## "preceding defn is " || image(preceding_defn) | +## "defn pending is " || image(defn_pending) | +## "Holding chunk with these lines:" | image(!holding))) + defn_pending := &null + holding := &null + chunks := drain(chunks) + } else if ="@begin docs" then { + indocs := 1 + holding := [""] + } else if ="@begin code" then { + indocs := &null + holding := [""] + } else if \indocs then { + if ="@text " then { + grab(tab(0), holding) + } else if ="@quote" & pos(0) then { + grab(left_quote, holding) + } else if ="@endquote" & pos(0) then { + grab(right_quote, holding) + } else if ="@nl" & pos(0) then { + put(\holding, "") + } + } else if ="@defn " then { + defn_pending := tab(0) + if holding[-1] == "" then pull (holding) + preceding_defn := holding + holding := [] + } else { + if match("@xref ") & (\holding)[-1] == "" then pull(holding) + put(\holding, line) + } +drain(put(chunks, docs([]))) +@ +<<*>>= +procedure emit_as_comments(c) + type(c) == "docs" | runerr(1, "Unexpected code chunk") + every write("@text ", comment(trailing_nonblank(\c.lines)), "\n@nl") + return +end + +procedure trailing_nonblank(l) + local suspended + every s := !l do + if \suspended | *s > 0 then { + suspended := 1 + suspend s + } +end + + +procedure drain(chunks) + static n + initial n := -1 + if type(c := chunks[-2]) == "code" then { + write("@begin code ", n +:= 1) + every write(!c.preceding | ("@defn " || c.defn) | "@nl") + write("@text ", \firstline, "\n@nl") + every i := (if \allchunks then 1 else *chunks -2) to *chunks - 2 do + emit_as_comments(chunks[i]) + write("@text ", comment("<" || c.defn || ">="), "\n@nl") + write("@text ", \lastline, "\n@nl") + copyxreflines(\c.lines) + bad := &null + (bad := get(\c.lines)) == "@nl" | + { write(&errout, "expected newline after definition; got ", image(bad)); + runerr(1, bad) } + every write(!c.lines) + c := chunks[-1] + if type(c) == "docs" & upto(\c.lines[1], ~' \n\t') then { + write("@text ", \firstline, "\n@nl") + emit_as_comments(c) + write("@text ", \lastline, "\n@nl") + write("@nl") + chunks := [] + } else + chunks := [c] + write("@end code ", n) + } + return chunks +end + +procedure copyxreflines(l) + while match("@xref ", l[1]) do { + #write(&errout, "COPYING ", image(l[1])) + get(l) #write(get(l)) + } + return +end diff --git a/web/noweb/src/icon/elide.icn b/web/noweb/src/icon/elide.icn new file mode 100644 index 0000000000..0c5e809407 --- /dev/null +++ b/web/noweb/src/icon/elide.icn @@ -0,0 +1,71 @@ +#line 17 "elide.nw" +procedure main(args) + elide := [] + every put(elide, globpat(!args)) + while line := read() do + if match("@begin code ", line) then + { +#line 35 "elide.nw" +accum := [line] +while line := read() & not match("@defn ", line) do + put(accum, line) +line ? { + ="@defn " | fatal("This can't happen") + if globmatch(!elide) then { + while line := get(accum) | read() & not match("@end code ", line) do # drain + if line == "@nl" then write("@index nl") # grotesque, but may keep lines right + } else + every write(!accum | line) +} +#line 22 "elide.nw" + } + else { + write(line) + if match("@fatal ", line) then exit(1) + } + return +end +#line 61 "elide.nw" +procedure globpat(s) + static specials + initial specials := '?*\\' + l := [] + s ? + while not pos(0) do + put(l, + if not any(specials) then + tab(upto(specials)|0) + else case move(1) of { + "?" : &cset + "*" : &null + "\\" : move(1) + }) + return l +end +#line 82 "elide.nw" +procedure doglobmatch(pat, i) + local p + suspend if p := pat[i] then + case type(p) of { + "string" : =p + "cset" : tab(any(p)) + "null" : tab(&pos to *&subject+1) + } || doglobmatch(pat, i+1) + else (pos(0), "") +end +#line 96 "elide.nw" +procedure globmatch(pattern, s) + return if \s then s ? doglobmatch(pattern, 1) + else doglobmatch(pattern, 1) +end +#line 101 "elide.nw" +procedure fatal(L[]) + write!(["@fatal elide "] ||| L) + write!([&errout, "noweb error in elide: "] ||| L) + exit(1) +end +#line 107 "elide.nw" +procedure rcsinfo () + return "$Id: elide.nw,v 1.19 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/elide.nw b/web/noweb/src/icon/elide.nw new file mode 100644 index 0000000000..f135274447 --- /dev/null +++ b/web/noweb/src/icon/elide.nw @@ -0,0 +1,112 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +\section{Eliding unwanted code chunks} + +This filter removes from the [[markup]] token stream any code chunk + whose name matches any of the ``globbing'' patterns given it as + arguments. These are the familiar file name globbing patterns. For + example: [[elide 'RefMan_Ch*']] will prevent weaving a chunk + defined as ``\LA{}RefMan\_Chapter\_14\RA{}''. + +You could also use this filter when tangling, but it's not clear why you'd want to. + +@ +\subsection{Eliding} +The main loop simply copies the input to the output. +We stop only if we see [[@begin code]], because that means we might +need to elide. +<<*>>= +procedure main(args) + elide := [] + every put(elide, globpat(!args)) + while line := read() do + if match("@begin code ", line) then + {<<see about eliding this chunk>>} + else { + write(line) + if match("@fatal ", line) then exit(1) + } + return +end +@ +To see about eliding, we accumulate lines until we see [[@defn]]. +At that point we can either keep the chunk, which means printing the +accumulated lines and returning to the main loop, or elide it, which +means draining the input until the next [[@end code]]. +<<see about eliding this chunk>>= +accum := [line] +while line := read() & not match("@defn ", line) do + put(accum, line) +line ? { + ="@defn " | fatal("This can't happen") + if globmatch(!elide) then { + while line := get(accum) | read() & not match("@end code ", line) do # drain + if line == "@nl" then write("@index nl") # grotesque, but may keep lines right + } else + every write(!accum | line) +} +@ +\subsection{Globbing} + +I do globbing in two stages: first I turn the globbing string into +a pattern. A pattern is a list of the following kinds of data items: +\begin{quote} +\begin{tabular}{ll} +string&match that string\\ +cset&match one character in that cset\\ +nil&match anything\\ +\end{tabular} +\end{quote} +[[globpat]] turns a globbing string into a pattern. +It doesn't handle the {\tt [} metacharacter, but it might one day. +<<*>>= +procedure globpat(s) + static specials + initial specials := '?*\\' + l := [] + s ? + while not pos(0) do + put(l, + if not any(specials) then + tab(upto(specials)|0) + else case move(1) of { + "?" : &cset + "*" : &null + "\\" : move(1) + }) + return l +end +@ +Giving a globbing pattern [[pat]] and an index [[i]], [[doglobmatch]] +returns the string (if any) matched by [[pat[i:0]]]. +[[doglobmatch]] scans the current subject. +<<*>>= +procedure doglobmatch(pat, i) + local p + suspend if p := pat[i] then + case type(p) of { + "string" : =p + "cset" : tab(any(p)) + "null" : tab(&pos to *&subject+1) + } || doglobmatch(pat, i+1) + else (pos(0), "") +end +@ +[[globmatch(p)]] matches the pattern [[p]] against the current +subject, or a subject can be supplied as the second argument. +<<*>>= +procedure globmatch(pattern, s) + return if \s then s ? doglobmatch(pattern, 1) + else doglobmatch(pattern, 1) +end +<<*>>= +procedure fatal(L[]) + write!(["@fatal elide "] ||| L) + write!([&errout, "noweb error in elide: "] ||| L) + exit(1) +end +<<*>>= +procedure rcsinfo () + return "$Id: elide.nw,v 1.19 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/htmltoc.icn b/web/noweb/src/icon/htmltoc.icn new file mode 100644 index 0000000000..fd29051070 --- /dev/null +++ b/web/noweb/src/icon/htmltoc.icn @@ -0,0 +1,218 @@ +#line 37 "htmltoc.nw" +$define sentinel "<tableofcontents>" +$define sentinel_end "</tableofcontents>" +#line 44 "htmltoc.nw" +record ioc(number, level, text) +#line 46 "htmltoc.nw" +global contents +#line 52 "htmltoc.nw" +procedure readfile(f) + local old_contents + intoc := &null + contents := [] + old_contents := [] + no := 0 + + file := list() + while l := read(f) do l ? { +#line 71 "htmltoc.nw" +if =sentinel then { + intoc := "in table of contents" + put(file, l) +} else if =sentinel_end then { + intoc := &null + put(file, l) +} else if \intoc then { + put(old_contents, l) +} else if /intoc then { + if +#line 88 "htmltoc.nw" +(pre := tab(upto('<')), ="<", skip(), tab(any('hH')), n := tab(many(&digits)), + skip(), =">") +#line 80 "htmltoc.nw" + then { + +#line 102 "htmltoc.nw" +if (c := tab(upto('<')), ="</", skip(), tab(any('hH')), =n, skip(), =">") then { + no +:= 1 + c ? c := strip_toc_anchors() || tab(0) + addcontents(no, n, c) + +#line 112 "htmltoc.nw" +put(file, pre || "<h" || n || "><a name=toc" || no || ">" || c || + "</a></h" || n || ">" || tab(0)) +#line 107 "htmltoc.nw" +} else + write(&errout, "Unterminated <h", n, ">", tab(0), "...") +#line 82 "htmltoc.nw" + } else + put(file, l) +} +#line 60 "htmltoc.nw" + } + if \intoc then { + push(old_contents, sentinel_end) + every l := !copy(old_contents) do l ? { +#line 71 "htmltoc.nw" +if =sentinel then { + intoc := "in table of contents" + put(file, l) +} else if =sentinel_end then { + intoc := &null + put(file, l) +} else if \intoc then { + put(old_contents, l) +} else if /intoc then { + if +#line 88 "htmltoc.nw" +(pre := tab(upto('<')), ="<", skip(), tab(any('hH')), n := tab(many(&digits)), + skip(), =">") +#line 80 "htmltoc.nw" + then { + +#line 102 "htmltoc.nw" +if (c := tab(upto('<')), ="</", skip(), tab(any('hH')), =n, skip(), =">") then { + no +:= 1 + c ? c := strip_toc_anchors() || tab(0) + addcontents(no, n, c) + +#line 112 "htmltoc.nw" +put(file, pre || "<h" || n || "><a name=toc" || no || ">" || c || + "</a></h" || n || ">" || tab(0)) +#line 107 "htmltoc.nw" +} else + write(&errout, "Unterminated <h", n, ">", tab(0), "...") +#line 82 "htmltoc.nw" + } else + put(file, l) +} +#line 63 "htmltoc.nw" + } + } + + return file +end +#line 92 "htmltoc.nw" +procedure skip() + suspend tab(many(' \t')) | "" +end +#line 117 "htmltoc.nw" +procedure strip_toc_anchors() + local s, p + if (="<a name=toc", tab(many(&digits)), =">", s := strip_toc_anchors(), ="</a>") then + return s + else { + s := to_next_anchor_or_end_anchor() | runerr(1, "never found an anchor") + if pos(0) | at_end_anchor() then + return s + else + return s || tab_past_anchor_start() || strip_toc_anchors() || + tab_past_anchor_end() + } +end +#line 132 "htmltoc.nw" +procedure at_end_anchor() + &subject[&pos:0] ? + return tab_past_anchor_end() +end + +procedure at_start_anchor() + &subject[&pos:0] ? + return tab_past_anchor_start() +end + +procedure tab_past_anchor_end() + suspend ="<" || optwhite() || ="/" || optwhite() || =("a"|"A") || optwhite() || =">" +end + +procedure tab_past_anchor_start() + suspend ="<" || optwhite() || =("a"|"A") || white() || tab(upto('>')) || =">" +end + +procedure to_next_anchor_or_end_anchor() + return (1(tab(upto('<')), at_start_anchor() | at_end_anchor()) | tab(0)) \ 1 +end + +procedure white() + suspend tab(many(' \t')) +end +procedure optwhite() + suspend white() | "" +end +#line 171 "htmltoc.nw" +procedure addcontents(no, n, s) + if map(s) ~== "contents" & find(n, toclevels) then + put(contents, ioc(no, n, strip_tags(s))) + return +end + +procedure strip_tags(s) + s ? { + r := "" + while r ||:= tab(upto('<')) do (tab(upto('>')), =">") + return r || tab(0) + } +end +#line 191 "htmltoc.nw" +global minlevel + +procedure tocindent(level) + return repl(" ", level-minlevel) +end + +procedure writetoc() + local level + minlevel := 99 + every minlevel >:= (!contents).level + level := minlevel - 1 # triggers opening list + + every l := !contents do { + +#line 215 "htmltoc.nw" +while level > l.level do { + write(tocindent(level), "</ul>") + level -:= 1 +} +while level < l.level do { + level +:= 1 + write(tocindent(level), "<ul compact>") +} +#line 205 "htmltoc.nw" + write(tocindent(level), + "<li><a href=\"#toc", l.number, "\">", l.text, "</a></li>") + } + +#line 226 "htmltoc.nw" +while level >= minlevel do { + write(tocindent(level), "</ul>") + level -:= 1 +} +#line 209 "htmltoc.nw" +end +#line 235 "htmltoc.nw" +procedure add_contents(f) + file := readfile(f) + + every l := !file do { + write(l) + if match(sentinel, l) then writetoc() + } +end +#line 246 "htmltoc.nw" +global toclevels +procedure main(args) + if args[1] ? (="-", toclevels := tab(many(&digits)), pos(0)) then get(args) + else toclevels := "2345" + if *args = 0 then add_contents(&input) + else every add_contents(openfile(!args)) + return +end + +procedure openfile(f) + return open(f) | stop("Cannot open file ", f) +end +#line 259 "htmltoc.nw" +procedure rcsinfo () + return "$Id: htmltoc.nw,v 1.20 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/htmltoc.nw b/web/noweb/src/icon/htmltoc.nw new file mode 100644 index 0000000000..cf80e3ffc5 --- /dev/null +++ b/web/noweb/src/icon/htmltoc.nw @@ -0,0 +1,264 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +\title{htmltoc -- A Table of Contents Generater for HTML} +\author{stephen parker\thanks{Revisions by Norman Ramsey}\\ + \texttt{stephen@stephen.uk.eu.org}} + +\tableofcontents + +\section{Introduction} +\texttt{htmltoc} reads an HTML document on standard input and writes the +same document, but optionally including a table of contents on output. +The motivation for this program was Norman Ramsey's \texttt{htmltoc} +program included with the \texttt{noweb} distribution which this program +has no advantages over other than not being written in perl. + +% noweave mangles the references in rawhtml blocks if you're not +% careful. don't ask me why. +\begin{rawhtml} +This html document is created from a noweb +<a href="http://lila.york.ac.uk/htmltoc/htmltoc.nw">source</a> +document which also produces the notangled +<a href="http://lila.york.ac.uk/htmltoc/htmltoc.icn">icon source</a>. +The <a href="http://lila.york.ac.uk/htmltoc/mkfile">mkfile</a> to control +this is also available; if you haven't got mk then it shouldn't be too +hard to turn it into a Makefile. +\end{rawhtml} + +\section{Implementation} +The Icon source follows the usual pattern. +<<*>>= +<<Preprocessor constants>> +<<Data structures>> +<<Global Variables>> +<<Procedures>> +@ Any text between the marks [["<tableofcontents>"]] and +[["</tableofcontents>"]] is replaced on output with a table +of contents for the document. +<<Preprocessor constants>>= +$define sentinel "<tableofcontents>" +$define sentinel_end "</tableofcontents>" +@ The TOC is created from the header items in the text. These +are stored in an [[ioc]] record. The headers are sequentially +numbered and the level of the heading and the heading text are +stored in a list of [[ioc]]s named [[contents]]. +<<Data structures>>= +record ioc(number, level, text) +<<Global Variables>>= +global contents +@ HTMLtoc must make two passes through the file in order to +generate a TOC before the actual material. Since we'd like +HTMLtoc to run in a pipeline we actually store the entire +input in a list named [[file]]. +<<Procedures>>= +procedure readfile(f) + local old_contents + intoc := &null + contents := [] + old_contents := [] + no := 0 + + file := list() + while l := read(f) do l ? { <<handle line>> } + if \intoc then { + push(old_contents, sentinel_end) + every l := !copy(old_contents) do l ? { <<handle line>> } + } + + return file +end +@ The variable [[intoc]] is [[1]] if we are between the TOC markers +on input. [[no]] is incremented for each header read. +<<handle line>>= +if =sentinel then { + intoc := "in table of contents" + put(file, l) +} else if =sentinel_end then { + intoc := &null + put(file, l) +} else if \intoc then { + put(old_contents, l) +} else if /intoc then { + if <<[[l]] includes a header>> then { + <<add header line to [[contents]] and [[file]]>> + } else + put(file, l) +} +@ We look for a string of the form \verb|<[Hh][0-9]>| which +signifies the beginning of a header. This isn't nice Icon. +<<[[l]] includes a header>>= +(pre := tab(upto('<')), ="<", skip(), tab(any('hH')), n := tab(many(&digits)), + skip(), =">") +@ [[skip]] skips white space, if present. +<<Procedures>>= +procedure skip() + suspend tab(many(' \t')) | "" +end +@ The scanning environment contains a header, the +\verb|<[Hh][0-9]>| has already been consumed, so +the text of the header can by found by scanning for the close of header. +The header number, +[[no]] is incremented and then [[addcontents()]] is +called to add the item to the [[contents]] list. +<<add header line to [[contents]] and [[file]]>>= +if (c := tab(upto('<')), ="</", skip(), tab(any('hH')), =n, skip(), =">") then { + no +:= 1 + c ? c := strip_toc_anchors() || tab(0) + addcontents(no, n, c) + <<append modified line to [[file]]>> +} else + write(&errout, "Unterminated <h", n, ">", tab(0), "...") +@ We also need to label the heading in the text, so +we can reference it from the TOC. +<<append modified line to [[file]]>>= +put(file, pre || "<h" || n || "><a name=toc" || no || ">" || c || + "</a></h" || n || ">" || tab(0)) +@ When stripping these, we rely on their having been put there by this +program. +<<Procedures>>= +procedure strip_toc_anchors() + local s, p + if (="<a name=toc", tab(many(&digits)), =">", s := strip_toc_anchors(), ="</a>") then + return s + else { + s := to_next_anchor_or_end_anchor() | runerr(1, "never found an anchor") + if pos(0) | at_end_anchor() then + return s + else + return s || tab_past_anchor_start() || strip_toc_anchors() || + tab_past_anchor_end() + } +end +@ +<<Procedures>>= +procedure at_end_anchor() + &subject[&pos:0] ? + return tab_past_anchor_end() +end + +procedure at_start_anchor() + &subject[&pos:0] ? + return tab_past_anchor_start() +end + +procedure tab_past_anchor_end() + suspend ="<" || optwhite() || ="/" || optwhite() || =("a"|"A") || optwhite() || =">" +end + +procedure tab_past_anchor_start() + suspend ="<" || optwhite() || =("a"|"A") || white() || tab(upto('>')) || =">" +end + +procedure to_next_anchor_or_end_anchor() + return (1(tab(upto('<')), at_start_anchor() | at_end_anchor()) | tab(0)) \ 1 +end + +procedure white() + suspend tab(many(' \t')) +end +procedure optwhite() + suspend white() | "" +end +@ [[addcontents()]] should simply append the [[ioc]] +record for the header to the [[contents]] list. But +one problem is that the text in the header may not +be simple -- it might contain markup. One case where +we don't want to copy this markup is if it is +a \verb|<a name="|... token, since then there would be +multiple targets for this name. Any markup of the +form \verb|<| ... \verb|>| is stripped from the header -- +this harsh rule may be relaxed in future. +We also avoid adding the line ``Contents'' to the contents. +<<Procedures>>= +procedure addcontents(no, n, s) + if map(s) ~== "contents" & find(n, toclevels) then + put(contents, ioc(no, n, strip_tags(s))) + return +end + +procedure strip_tags(s) + s ? { + r := "" + while r ||:= tab(upto('<')) do (tab(upto('>')), =">") + return r || tab(0) + } +end +@ +The procedure [[writetoc()]] writes the TOC on +output using the [[contents]] list. We keep a current +header level in the integer variable [[level]]. As +we iterate through the [[contents]] list we insert \verb|<ul compact>|s and +\verb|</ul>|s as required for formatting. +<<Procedures>>= +global minlevel + +procedure tocindent(level) + return repl(" ", level-minlevel) +end + +procedure writetoc() + local level + minlevel := 99 + every minlevel >:= (!contents).level + level := minlevel - 1 # triggers opening list + + every l := !contents do { + <<adjust [[level]] to [[l.level]]>> + write(tocindent(level), + "<li><a href=\"#toc", l.number, "\">", l.text, "</a></li>") + } + <<close any lists>> +end +@ We write out a \verb|</ul>| for each level we are beyond the +current item, and a \verb|<ul compact>| for each level we are below +the current. The call to [[repl()]] merely writes the correct +number of tabs so as to make the contents look ok. +<<adjust [[level]] to [[l.level]]>>= +while level > l.level do { + write(tocindent(level), "</ul>") + level -:= 1 +} +while level < l.level do { + level +:= 1 + write(tocindent(level), "<ul compact>") +} +@ At the end of the contents we need to write as many +\verb|</ul>|s as are required. +<<close any lists>>= +while level >= minlevel do { + write(tocindent(level), "</ul>") + level -:= 1 +} +@ The [[add_contents()]] procedure simply reads the input using +[[readfile()]] then writes it out again. If the +sentinel line is found then the TOC is written at +that point. +<<Procedures>>= +procedure add_contents(f) + file := readfile(f) + + every l := !file do { + write(l) + if match(sentinel, l) then writetoc() + } +end +@ +[[main]] makes the program read its arguments or act as a filter. +<<Procedures>>= +global toclevels +procedure main(args) + if args[1] ? (="-", toclevels := tab(many(&digits)), pos(0)) then get(args) + else toclevels := "2345" + if *args = 0 then add_contents(&input) + else every add_contents(openfile(!args)) + return +end + +procedure openfile(f) + return open(f) | stop("Cannot open file ", f) +end +<<*>>= +procedure rcsinfo () + return "$Id: htmltoc.nw,v 1.20 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/icondefs.icn b/web/noweb/src/icon/icondefs.icn new file mode 100644 index 0000000000..2a36826fb6 --- /dev/null +++ b/web/noweb/src/icon/icondefs.icn @@ -0,0 +1,77 @@ +#line 2 "icondefs.nw" +global showlocal +procedure main(args) + showlocal := !args == "-local" + go() +end +#line 8 "icondefs.nw" +procedure postpass(name, arg) + static kind, definers + initial { kind := "bogus" + definers := ["global"] + if \showlocal then every put(definers, "local" | "static") + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if =("procedure "|"record ") then { + tab(many(' ')) + writedefn(tab(upto(' ()'))) + } else if (tab(many(' ')) | "", =!definers, tab(many(' '))) then { + while (not any('#')) & writedefn(tab(upto(', #'))) do tab(many(', ')) + if not any('#') then writedefn(tab(0)) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end +#line 32 "icondefs.nw" +procedure rcsinfo () + return "$Id: icondefs.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/icondefs.nw b/web/noweb/src/icon/icondefs.nw new file mode 100644 index 0000000000..f843011489 --- /dev/null +++ b/web/noweb/src/icon/icondefs.nw @@ -0,0 +1,37 @@ +\section{Finding Icon definitions} +<<*>>= +global showlocal +procedure main(args) + showlocal := !args == "-local" + go() +end +<<*>>= +procedure postpass(name, arg) + static kind, definers + initial { kind := "bogus" + definers := ["global"] + if \showlocal then every put(definers, "local" | "static") + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if =("procedure "|"record ") then { + tab(many(' ')) + writedefn(tab(upto(' ()'))) + } else if (tab(many(' ')) | "", =!definers, tab(many(' '))) then { + while (not any('#')) & writedefn(tab(upto(', #'))) do tab(many(', ')) + if not any('#') then writedefn(tab(0)) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end +<<*>>= +procedure rcsinfo () + return "$Id: icondefs.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/l2h.icn b/web/noweb/src/icon/l2h.icn new file mode 100644 index 0000000000..46f3143733 --- /dev/null +++ b/web/noweb/src/icon/l2h.icn @@ -0,0 +1,2237 @@ +#line 217 "l2h.nw" +procedure star(cs) + suspend cs | (cs || "*") +end +#line 596 "l2h.nw" +procedure asciiCharCode(S) + return emit_text(S, char(2(optwhite(), TeXnumber(), optwhite()))) +end +procedure TeXnumber() + return integer( + (="'", "8r" || tab(many(&digits))) | + (="\"", "16r" || tab(many(&digits))) | + tab(many(&digits))) +end +#line 671 "l2h.nw" +procedure convert(S, optstring) + static specials + initial { + +#line 819 "l2h.nw" +activetab := table(unknown_cs) +activeclosure := table() +#line 969 "l2h.nw" +cstab := table(unknown_cs) +csclosure := table() +#line 987 "l2h.nw" +unknown_set := set() +#line 1015 "l2h.nw" +every begintab | endtab := table(unknown_env) +every begincl | endcl := table() +#line 1028 "l2h.nw" +unknown_envs := set() +#line 1381 "l2h.nw" +liststack := [] +# write(&errout, "Initialized liststack") +suspendstack := [] +#line 1961 "l2h.nw" +countertab := table() +#line 1969 "l2h.nw" +accent_name := table() +accent_valid := table('') +accent_name ["`"] := "grave" +accent_valid["`"] := 'AEIOUaeiou' +accent_name ["'"] := "acute" +accent_valid["'"] := 'AEIOUYaeiouy' +accent_name ["^"] := "circ" +accent_valid["^"] := 'AEIOUaeiou' +accent_name ["hat"] := "circ" +accent_valid["hat"] := 'AEIOUaeiou' +accent_name ["\""] := "uml" +accent_valid["\""] := 'AEIOUaeiouy' +accent_name ["~"] := "tilde" +accent_valid["~"] := 'ANOano' +accent_name ["="] := "bar" +accent_name ["."] := "dot" +accent_name ["u"] := "u" +accent_name ["v"] := "v" +accent_name ["H"] := "H" +accent_name ["t"] := "t" +accent_name ["c"] := "cedil" +accent_valid["c"] := 'Cc' +accent_name ["d"] := "underdot" +accent_name ["b"] := "underbar" +#line 2675 "l2h.nw" +csfunctions := table() +#line 675 "l2h.nw" + +#line 114 "l2h.nw" +substitution(",", " ") +substitution(" ", " ") +substitution("\n", "\n") +substitution("\t", " ") +ignore("raggedright") +ignore("@") +ignore("/") # no italic correction +substitution("", "\n") # \<newline> treated as request for newline +every c := !"$%#{}_" do + substitution(c, c) +substitution("&", "&") +argblock("emph", "em") +every argblock("footnote" | "footnotetext" | "thanks", + " <b>[</b>", "<b>]</b> ") # put footnotes in bold brackets +substitution("today", &date) +#line 132 "l2h.nw" +ignore("textrm") # html can't switch to default font! +argblock("textit", "i") +argblock("textbf", "b") +argblock("textsl", "i") +ignore("textsc") +argblock("texttt", "tt") +ignore("textsf") +ignore("boldmath") +# \boldmath could be done by introducing S.mathfont, but I don't want to! +#line 142 "l2h.nw" +ignore("mathrm") # html can't switch to default font! +argblock("mathit", "i") +argblock("mathbf", "b") +argblock("mathtt", "tt") +ignore("mathsf") +argblock("mathcal", "i") +every ignore("scriptstyle"|"displaystyle"|"scriptscriptstyle") +every ignore("mathord"|"mathbin"|"mathrel") +#line 152 "l2h.nw" +every ignore("tiny" | "scriptsize" | "footnotesize" | "small" | "normalsize" | + "large" | "Large" | "LARGE" | "huge" | "Huge") +#line 160 "l2h.nw" +every accent(key(accent_name)) +every ignore("dag" | "ddag") +substitution("S", "§") +substitution("P", "¶") +substitution("copyright", "©") +substitution("pounds", "£") +substitution("o", "ø") +substitution("O", "Ø") +substitution("aa", "å") +substitution("AA", "Å") +substitution("ae", "æ") +substitution("AE", "&Aelig;") +#line 175 "l2h.nw" +argblockv("part", "h1", &null, "*[") +argblockv("chapter", "h1", &null, "*[") +argblockv("section", "h2", &null, "*[") +argblockv("subsection", "h3", &null, "*[") +argblockv("subsubsection", "h4", &null, "*[") +argblockv("paragraph", "h5", &null, "*[") +argblockv("subparagraph", "h6", &null, "*[") +ignore("appendix") +auxfile("tableofcontents", "toc", + "<p>\n<tableofcontents>\n<b>[Table of contents]</b>\n</tableofcontents>\n<p>", + "<h2>Table of Contents</h2>\n<tableofcontents>\n", "\n</tableofcontents>\n") +cstab["tableofcontents"] := Ctableofcontents # override to call set_toclevel +ignore("listoftables") +ignore("listoffigures") +ignore("addtocontents", "{{") +ignoreenv("filecontents", "{") +#line 198 "l2h.nw" +cstab["("] := Cmath +cstab[")"] := Cmath_end +cstab["["] := Cdisplaymath +cstab["]"] := Cdisplaymath_end +ignoreenv("equation") +every table_env(star("eqnarray"), 0, " ", "<blockquote><i>", "</i></blockquote>") + # also lame +substitution("frac", "<b>frac</b>") +substitution("sqrt", "<b>frac</b>") +every substitution("ldots" | "cdots" | "vdots", "...") +ignore("left") +ignore("right") +ignore("overline") +substitution(":", " ") +substitution(";", " ") +ignore("!") +#line 223 "l2h.nw" +substitution("Diamond", "<>") +substitution("langle", "<") +substitution("rangle", ">") +substitution("le", "<=") +substitution("ne", "!=") +substitution("ge", ">=") +substitution("times", "×") +substitution("divide", "÷") +substitution("bmod", "</i>mod<i>") # better hook in with math +substitution("equiv", "===") +every x := "arccos" | "arcsin" | "arctan" | "arg" | "cos" | "cosh" | + "cot" | "coth" | "csc" | "deg" | "det" | "dim" | "exp" | + "gcd" | "hom" | "lim" | "liminf" | "limsup" | "ln" | "log" | + "max" | "min" | "sec" | "sin" | "sinh" | "sup" | "tan" | "tanh" +do + substitution(x, "</i>" || x || "<i>") +substitution("liminf", "</i>lim inf<i>") +substitution("limsup", "</i>lim sup<i>") +every x := "alpha" | "beta" | "gamma" | "delta" | "epsilon" | "zeta" | "eta" | + "theta" | "iota" | "kappa" | "lambda" | "nu" | "xi" | "pi" | + "rho" | "sigma" | "tau" | "upsilon" | "phi" | "chi" | "psi" | "omega" | + "in" +do + substitution(x, "<b>" || x || "</b>") +substitution("mu", "µ") +every x := "Gamma" | "Delta" | "Theta" | "Lambda" | "Xi" | "Pi" | "Sigma" | + "Upsilon" | "Phi" | "Psi" | "Omega" +do + substitution(x, "<b>" || x || "</b>") +#line 255 "l2h.nw" +substitution("lfloor", "</i>|_<i>") +substitution("rfloor", "</i>_|<i>") +substitution("leq", "<=") +substitution("geq", ">=") +substitution("ll", "«") +substitution("gg", "»") +substitution("Rightarrow", "==>") +substitution("rightarrow", "-->") +substitution("approx", "<u>~</u>") +#line 268 "l2h.nw" +envblock("quote", "blockquote") +envblock("quotation", "blockquote") +envblock("center", "blockquote") +envblock("flushleft", "blockquote") +envblock("flushright", "blockquote") +envblock("verse", "blockquote") +verbatim("verbatim", escape_HTML_specials, "pre") +cstab["verb"] := Cverb +cstab["verb*"] := Cverb +csclosure["verb*"] := 1 +cstab["verbatiminput"] := Cverbatiminput +csclosure["verbatiminput"] := verbatim_cl(escape_HTML_specials) +#line 284 "l2h.nw" +cstab["item"] := Citem +csclosure["item"] := [item_cl("<li>", "", "<li>")] +listenv("itemize", "ul") +listenv("enumerate", "ol") +listenv("description", "dl") +#line 292 "l2h.nw" +ignore("documentstyle", "[{") +ignore("documentclass", "[{") +ignore("usepackage", "[{") +ignore("pagestyle", "{") +ignore("thispagestyle", "{") +ignore("pagenumbering", "{") +ignore("newcounter", "{") +ignore("global") +ignore("etalchar") # used in the .bbl files: \newcommand{\etalchar}[1]{$^{#1}$} +#line 307 "l2h.nw" +argblockv("title", "h1") +argblockv("author","address") +argblockv("date", "b") +substitution("maketitle", "<!--title goes here-->") +ignoreenv("titlepage") +envblock("abstract", "<h2>Abstract</h2><blockquote>", "</blockquote>") +#line 322 "l2h.nw" +cstab["label"] := Clabel +cstab["ref"] := Cref +cstab["pageref"] := Cref +cstab["subpageref"] := Cref +cstab["chunklabel"] := Clabel +#line 332 "l2h.nw" +ignore("bibliographystyle", "{") +auxfile("bibliography", "bbl", "<b>[BibTeX bibliography]</b>", &null, &null, "{") +envblock("thebibliography", "<h2>References</h2>", "", "{") +every cstab["cite" | "citeN" | "opencite" | "openciteN" | "citeyear"] := Ccite +cstab["bibitem"] := Cbibitem +ignore("newblock") +ignore("nocite", "{") +#line 343 "l2h.nw" +every ignore("input" | "include" | "includeonly", "{") +# filecontents not done yet +#line 348 "l2h.nw" +cstab["\\"] := Cbackback +substitution("linebreak", "<br>") +ignore("-") +ignoreenv("sloppypar") +ignore("sloppy") +#line 357 "l2h.nw" +substitution("pagebreak", "<hr>") +substitution("newpage", "<hr>") +substitution("clearpage", "<hr>") +ignore("enlargethispage", "*{") +#line 364 "l2h.nw" +ignore("mbox") +ignore("makebox", "([[") # ( comes from picture area +ignore("fbox") +ignore("framebox", "[[") # could insert horizontal rules, but why? +ignore("newsavebox", 1) +ignore("sbox", 2) +ignore("savebox", "{[[{") +ignore("usebox", 1) +envblock("minipage", "blockquote", &null, "[{") +argblock("parbox", "blockquote", &null, "[{") +#line 377 "l2h.nw" +ignore("hspace", "*{") +ignore("hfil") +ignore("hfill") +ignore("vspace", "*{") +ignore("vfil") +ignore("vfill") +#line 386 "l2h.nw" +ignore("newlength", "{") +ignore("setlength", "{{") +ignore("addtolength", "{{") +#line 392 "l2h.nw" +envblock("picture", "<b>[picture]</b>", "", "((") +ignore("put", "({") +ignore("multiput", "(({{") +ignore("dashbox", "{([") +ignore("line", "({") +ignore("vector", "({") +ignore("shortstack", "[") +ignore("circle", "*{") +ignore("oval", "([") +ignore("frame") +ignore("thinlines") +ignore("thicklines") +#line 408 "l2h.nw" +every envblock(star("figure"), "<hr>", "<hr>", "[") +every envblock(star("table"), "<hr>", "<hr>", "[") +argblock("caption", "b") # captions in bold +#line 415 "l2h.nw" +envblock("tabbing", "blockquote") +# \= is accent +ignore(">") +ignore("+") +ignore("kill") +#line 423 "l2h.nw" +tabular("array", "[") +tabular("tabular", "[") +tabular("tabularx", "{[") +tabular("tabular*", "{[") +every cstab["multicolumn"|"multispan"] := Cmulticolumn +cstab["span"] := Cspan +cstab["noalign"] := Cnoalign +cstab["hline"] := Chline +cstab["toprule"] := Chline +cstab["midrule"] := Chline +cstab["bottomrule"] := Chline +ignore("cline", "{") +ignore("newcolumntype", "{{") +#line 439 "l2h.nw" +ignore("newcommand", "A[[{") +ignore("renewcommand", "A[[{") +ignore("providecommand", "A[[{") +ignore("newenvironment", "{[{{") +ignore("renewenvironment", "{[{{") +ignore("newtheorem", "{{") +#line 450 "l2h.nw" +cstab["setcounter"] := Csetcounter +ignore("addtocounter", "{{") +#line 455 "l2h.nw" +cstab["makeatletter"] := Cmakeatletter +cstab["makeatother"] := Cmakeatother +#line 460 "l2h.nw" +every fontchange("tt" | "ttfamily", "tt") +every fontchange("bf" | "bfseries", "b") +every fontchange("it" | "itshape", "i") +fontchange("sl", "i") +fontchange("em", "em") +ignore("rm") # html can't switch to default font! +ignore("sf") +ignore("sc") +#line 470 "l2h.nw" +ignore("rmfamily") +ignore("normalfont") +#line 473 "l2h.nw" +ignoreenv("document") +#line 475 "l2h.nw" +substitution("LaTeX", "LaTeX") +#line 477 "l2h.nw" +ignore("numberline", "{") +ignore("protect") +ignore("onecolumn") +ignore("twocolumn", "C") +ignore("typeout", "[{") +ignore("closedbib") +#line 484 "l2h.nw" +every ignore("leftmargini" | "leftmarginii" | "labelsep" | "fboxsep", "=") +every ignore("tabcolsep", "=") +every ignore("evensidemargin" | "marginparsep" | "marginparwidth" | + "oddsidemargin" | "textheight" | "textwidth" | "topmargin", "=") +#line 489 "l2h.nw" +ignore("DeclareMathVersion", "{") +ignore("mathversion", "{") +ignore("setpapersize", "{") +ignore("setmarginsrb", "{{{{{{{{") +ignore("marginparwidth", "=") +ignore("marginparsep", "=") +#line 498 "l2h.nw" +ignoreenv("multicols", "{C") +cstab["citeN"] := Ccite +ignore("afterpage", "{") +every cstab["psfig"|"epsfig"] := Cepsfig +cstab["includegraphics"] := Cincludegraphics +ignore("newcolumntype", "{{") +#line 507 "l2h.nw" +cstab["kill"] := Ckill +#line 511 "l2h.nw" +activesubst("~", " ") +argblock("centerline", "<br>", "<br>") +substitution("cr", "<br>") +substitution("hrule", "<hr>") +substitution("vrule", "|") +substitution("hrulefill", "------") +ignore("hyphenation", "{") +ignore("hbox") +ignore("rlap") +ignore("llap") +ignore("vbox") +ignore("vtop") +ignore("hidewidth") +ignore("message", "{") +ignore("relax") +ignore("null") +ignore("offinterlineskip") +ignore("omit") +ignore("newdimen", "{") +ignore("nobreak") +#line 532 "l2h.nw" +cstab["par"] := implicit_paragraph +cstab["smallskip"] := implicit_paragraph +cstab["medskip"] := implicit_paragraph +cstab["bigskip"] := implicit_paragraph +cstab["vskip"] := implicit_paragraph +csclosure["vskip"] := "=" +#line 544 "l2h.nw" +every ignore("begingroup" | "endgroup" | "bgroup" | "egroup") +#line 546 "l2h.nw" +cstab["newif"] := Cnewif +cstab["iffalse"] := Ciffalse +cstab["iftrue"] := Ciftrue +cstab["ifhtml"] := Ciftrue # false in LaTeX, but true when converting! +cstab["else"] := Celse +cstab["fi"] := Cfi +cstab["ifx"] := cstab["if"] := cstab["ifnum"] := Ciffalse +#line 556 "l2h.nw" +ignore("let", "A=") +every ignore("hfuzz" | "parindent" | "parskip" | "baselineskip", "=") +every ignore("hbadness" | "hsize" | "vsize" | "overfullrule" | "tabskip", "=") +every ignore("extrarowheight" | "codemargin", "=") +every ignore("looseness", "=") +substitution("hskip", " ", "=") +ignore("setbox", "{=") +every ignore("box" | "unhbox" | "unvbox", "{") +#line 565 "l2h.nw" +ignore("unskip") +ignore("hss") +ignore("phantom", "{") +every ignore("kern" | "lower" | "spacefactor", "=") # a cheat, but works +every ignore("clubpenalty" | "widowpenalty", "=") +#line 578 "l2h.nw" +every ignore("expandafter" | "indent" | "noindent" | "leavevmode" | "strut") +ignore("def", 1) +#line 581 "l2h.nw" +substitution("TeX", "TeX") +substitution("BibTeX", "BibTeX") +substitution("MF", "METAFONT") +#line 594 "l2h.nw" +cstab["char"] := asciiCharCode +#line 608 "l2h.nw" +macro("nwanchorto", 2, "<a href=\"#$1\">#2</a>") +macro("nwanchorname", 2, "<a name=\"#$1\">#2</a>") +ignore("nwaddbox", "{") +verbatim("latexonly", do_nothing) +verbatim("rawhtml", emit_text) +#line 617 "l2h.nw" +substitution("quad", " ") +#line 624 "l2h.nw" +ignore("noweboptions", 1) +#line 630 "l2h.nw" +substitution("nowebindex", "<nowebindex>") +substitution("nowebchunks", "<nowebchunks>") +ignore("nowebsize") +#line 634 "l2h.nw" +envblock("fields", "blockquote", &null, "[") # lame; could try to <tt> 1st col +envblock("fields*", "blockquote", &null, "{") # lame; could try to <tt> 1st col +ignore("citeauthoryear", "{{{") +ignore("authoryear", "{{") +substitution("bibrule", "--------") +let("bibskip", "par") +every cstab["anoncite"|"authorcite"] := Ccite +#line 644 "l2h.nw" +ignore("pssilent") +ignore("psnoisy") +#line 1012 "l2h.nw" +cstab["begin"] := do_begin +cstab["end"] := do_end +#line 1385 "l2h.nw" +cstab["suspend"] := Csuspend +cstab["resume"] := Cresume +#line 1603 "l2h.nw" +cstab["uppercase"] := Cuppercase +#line 1899 "l2h.nw" +cstab["contentsline"] := Ccontentsline +#line 676 "l2h.nw" + +#line 2677 "l2h.nw" +csfunctions["argblock"] := argblock +csfunctions["argblockv"] := argblockv +csfunctions["envblock"] := envblock +csfunctions["fontchange"] := fontchange +csfunctions["ignore"] := ignore +csfunctions["ignoreenv"] := ignoreenv +csfunctions["let"] := let +csfunctions["letenv"] := letenv +csfunctions["listenv"] := listenv +csfunctions["substitution"] := substitution +csfunctions["activesubst"] := activesubst +csfunctions["closure"] := let_closure +csfunctions["let_closure"] := let_closure +csfunctions["newcommand"] := l2h_macro +csfunctions["macro"] := l2h_macro +csfunctions["environment"] := l2h_environment +csfunctions["tabular"] := tabular +#line 677 "l2h.nw" + specials := '\\{}<>-\'`"%$&~\n\0\1' + } + + if \optstring then return optstring ? convert(S) + else { + +#line 867 "l2h.nw" +l := S.newtext +S.newtext := [] +while c := get(l) do + c.proc!c.args +#line 700 "l2h.nw" +if S.mode == "V" & any(~'\\{}<>%\n\t ') then S.mode := "H" +emit_text(S, tab(upto(specials) | 0)) +while not pos(0) do + if S.mode == "Q" then { # quoting + emit_text(S, tab(upto('\1') | 0)) + if ="\1" then { + emit_text(S, "\1") + S.mode := S.quotemode + } + } else { + if any(S.activechars) then + do_activechar(S, move(1)) + else + case move(1) of { + "\\" : { +#line 941 "l2h.nw" +cs := if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1) +if /S.ignoring | cs == ("else"|"fi") | cstab[cs] === (Ciffalse|Ciftrue) then + do_cs(S, cs) +else + &null # error("### Ignoring \\", cs) +#line 714 "l2h.nw" + } + "{" : { +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 715 "l2h.nw" + } + "}" : { +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 716 "l2h.nw" + } + "%" : { +#line 1066 "l2h.nw" +parse_dynamic_add(S) +delay_newtext(S) +eat_comment(S) +#line 717 "l2h.nw" + } + "\n" : { +#line 1313 "l2h.nw" +emit_text(S, "\n") +if /S.ignoring then Cnewline(S) +#line 718 "l2h.nw" + } + "$" : { +#line 1301 "l2h.nw" +if /S.ignoring then + if ="$" then + if S.mode == "M" then { Cdisplaymath_end(S); S.mode := "V" } + else { Cdisplaymath(S); S.mode := "M" } + else + if S.mode == "M" then { Cmath_end(S); S.mode := "H" } + else { Cmath(S); S.mode := "M" } +#line 719 "l2h.nw" + } + "&" : ampersand(S) + "\0" : {S.quotemode := S.mode; S.mode := "Q"; emit_text(S, "\0")} + # remaining cases simply escape HTML specials + "<" : emit_text(S, "<") + ">" : emit_text(S, ">") + "\"" : emit_text(S, """) + "-" : { +#line 735 "l2h.nw" +if S.mode == "V" then S.mode := "H" +if S.mode == "H" then + if ="--" then emit_text(S, "—") + else if ="-" then emit_text(S, "–") + else emit_text(S, "-") +else + emit_text(S, "-") +#line 726 "l2h.nw" + } + "`" : { +#line 746 "l2h.nw" +if S.mode == "V" then S.mode := "H" +if \html_quotes & S.mode == "H" then + if ="`" then emit_text(S, "“") + else emit_text(S, "‘") +else + emit_text(S, "`") +#line 727 "l2h.nw" + } + "'" : { +#line 753 "l2h.nw" +if S.mode == "V" then S.mode := "H" +if \html_quotes & S.mode == "H" & ="'" then emit_text(S, "”") +else emit_text(S, "'") +#line 728 "l2h.nw" + } + } + if S.mode == "V" & any(~'\\{}<>%\n\t ') then S.mode := "H" + emit_text(S, tab(upto(specials++S.activechars) | 0)) + } +return 1(. S.the_text, S.the_text := "") # what's been converted +#line 683 "l2h.nw" + } +end +#line 744 "l2h.nw" +global html_quotes # render quotes as HTML 4 entities +#line 760 "l2h.nw" +record state(mode, quotemode +#line 788 "l2h.nw" +, text, the_text +#line 804 "l2h.nw" +, ignoring +#line 822 "l2h.nw" +, activechars +#line 844 "l2h.nw" +, newtext +#line 887 "l2h.nw" +, delayed_newtext +#line 897 "l2h.nw" +, open, closes +#line 949 "l2h.nw" +, csletters +#line 1082 "l2h.nw" +, comment +#line 1521 "l2h.nw" +, ifstack +#line 1628 "l2h.nw" +, tables +#line 760 "l2h.nw" + ) + # mode is Q, H, V, or M + # quotemode is saved mode: H, V, or M +#line 766 "l2h.nw" +procedure converter(mode) + /mode := "V" + return state(mode, mode +#line 790 "l2h.nw" +, accumulate_text, "" +#line 806 "l2h.nw" +, &null +#line 824 "l2h.nw" +, '~' +#line 846 "l2h.nw" +, [] +#line 889 "l2h.nw" +, [] +#line 899 "l2h.nw" +, [], [] +#line 951 "l2h.nw" +, &letters +#line 1084 "l2h.nw" +, "" +#line 1523 "l2h.nw" +, [] +#line 1630 "l2h.nw" +, [] +#line 768 "l2h.nw" + ) +end +#line 774 "l2h.nw" +procedure reset(S) + +#line 792 "l2h.nw" +S.text := accumulate_text +S.the_text := "" +#line 808 "l2h.nw" +S.ignoring := &null +#line 826 "l2h.nw" +S.activechars := '~' +#line 848 "l2h.nw" +S.newtext := [] +#line 891 "l2h.nw" +S.delayed_newtext := [] +#line 901 "l2h.nw" +every S.open | S.closes := [] +#line 953 "l2h.nw" +S.csletters := &letters +#line 1086 "l2h.nw" +S.comment := "" +#line 1525 "l2h.nw" +if *S.ifstack > 0 then S.ifstack := [] # keeps GC down +#line 1632 "l2h.nw" +S.tables := [] +#line 776 "l2h.nw" + return S +end +#line 783 "l2h.nw" +procedure accumulate_text(S, text) + S.the_text ||:= text + return +end +#line 800 "l2h.nw" +procedure emit_text(S, text) + return if \S.ignoring then "" else S.text(S, text) +end +#line 813 "l2h.nw" +global activetab, activeclosure +procedure do_activechar(S, c) + (activetab[c])(S, c, activeclosure[c]) + return +end +#line 852 "l2h.nw" +record closure(proc, args) +#line 857 "l2h.nw" +procedure before_next_newtext(S, proc, args) + push(S.newtext, closure(proc, args)) +end + +procedure after_next_newtext(S, proc, args) + put(S.newtext, closure(proc, args)) +end +#line 876 "l2h.nw" +procedure delay_newtext(S) + push(S.delayed_newtext, S.newtext) + S.newtext := [] + return +end + +procedure undelay_newtext(S) + S.newtext := \pop(S.delayed_newtext) | + {write(&errout, "This can't happen: no delayed_newtext"); &null[0]} +end +#line 903 "l2h.nw" +procedure after_next_open(S, proc, args) + return put(S.open, closure(proc, args)) +end + +procedure before_next_close(S, proc, args) + return push(S.closes[1], closure(proc, args)) # lost at top level +end + +procedure after_next_close(S, proc, args) + return put(S.closes[1], closure(proc, args)) # lost at top level +end +#line 960 "l2h.nw" +global cstab, csclosure + +procedure do_cs(S, cs) + tab(many(' \t')) # skip white space following CS + if pos(0) | any('\n') then before_next_newtext(S, skipblanks, [S]) + (cstab[cs])(S, cs, csclosure[cs]) + return +end +#line 976 "l2h.nw" +global show_unknowns +procedure unknown_cs(S, cs, cl) +# if S.text === ignore_text then return # a bit of a hack -- should no longer be needed + if \show_unknowns then S.text(S, "<b>\\" || cs || "</b>") + if not member(unknown_set, cs) then { + write(\unknown_file, "Warning: unknown control sequence \\", cs) + insert(unknown_set, cs) + } + return +end +#line 989 "l2h.nw" +global cstab, csclosure, unknown_set +#line 995 "l2h.nw" +global begintab, endtab, begincl, endcl + +procedure do_begin(S, cs, cl) + (="{", env := tab(upto('}')), ="}") | error("botched \\begin{...}") + +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 1000 "l2h.nw" + (begintab[env])(S, env, begincl[env]) + return +end + +procedure do_end(S, cs, cl) + (="{", env := tab(upto('}')), ="}") | error("botched \\end{...}") + # write(&errout, "calling ", image(endtab[env]), " for \\end{", env, "}") + (endtab[env])(S, env, endcl[env]) + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 1009 "l2h.nw" + return +end +#line 1018 "l2h.nw" +procedure unknown_env(S, env, cl) +### if S.text === ignore_text then return # a bit of a hack # no longer needed + if \show_unknowns then S.text(S, "<b>{" || env || "}</b>") + if not member(unknown_envs, env) then { + write(\unknown_file, "Warning: unknown environment {", env, "}") + insert(unknown_envs, env) + } + return +end +#line 1030 "l2h.nw" +global unknown_envs +#line 1034 "l2h.nw" +procedure warn_unknown(s, type, mark, rmark) + if *s > 0 then { + pushout("Unknown " || type || ": ") + every pushout(((\mark | "")\1) || !sort(s) || ((\rmark | "")\1) || " ") + pushout("\n") + } +end +#line 1042 "l2h.nw" +procedure pushout(s) + static col + initial col := 0 + if find("\n", s) then + s ? { + pushout(tab(upto('\n'))) + while ="\n" do {col := 0; write(&errout)} + pushout(tab(0)) + } + else { + col +:= *s + if col >= 79 then {writes(&errout, "\n "); col := *s + 2} + writes(&errout, s) + } + return +end +#line 1070 "l2h.nw" +procedure eat_comment(S) + S.comment ||:= tab(upto('\n') | 0) + if pos(0) then + before_next_newtext(S, eat_comment, [S]) + else { + undelay_newtext(S) + Ccomment(S) + S.comment := "" + } + return +end +#line 1106 "l2h.nw" +record verbatim_cl(output, terminator, html, translate_blank) + +procedure verbatim(name, output, html) + begintab[name] := Cverbatim + begincl [name] := verbatim_cl(output, &null, html) + return +end + +procedure Cverbatim(S, cs, cl) + if cl === begincl[cs] & /cl.terminator then + cl := begincl[cs] := + verbatim_cl(cl.output, "\\end{" || cs || "}", cl.html, cl.translate_blank) + emit_text(S, tag(\cl.html)) + delay_newtext(S) + do_verbatim(S, cl) + return +end +#line 1128 "l2h.nw" +procedure do_verbatim(S, cl) + if cl.output(S, tab(find(cl.terminator)), cl) then { + =cl.terminator + emit_text(S, endtag(\cl.html)) + undelay_newtext(S) + } else { + cl.output(S, tab(0), cl) + before_next_newtext(S, do_verbatim, [S, cl]) + } + return +end +#line 1142 "l2h.nw" +procedure escape_HTML_specials(S, s, cl) + s ? { + while emit_text(S, tab(upto('&<>" '))) do + case move(1) of { + "\"" : emit_text(S, """) + "&" : emit_text(S, "&") + "<" : emit_text(S, "<") + ">" : emit_text(S, ">") + " " : emit_text(S, if \cl.translate_blank then "·" else " ") + } + emit_text(S, tab(0)) + } + return +end +#line 1160 "l2h.nw" +procedure Cverb(S, cs, cl) + Cverbatim(S, cs, verbatim_cl(escape_HTML_specials, move(1), "tt", cl)) + return +end +#line 1166 "l2h.nw" +procedure Cverbatiminput(S, cs, cl) + local filename, f, line + if ="{" & filename := tab(upto('}')) & ="}" then { + f := \open(filename) | { emit_text(S, "<strong>Could not read file</strong> <tt>") + escape_HTML_specials(S, filename, cl) + emit_text(S, "</tt>") + return + } + emit_text(S, "\n<pre>\n") + while line := read(f) do { + escape_HTML_specials(S, line, cl) + emit_text(S, "\n") + } + emit_text(S, "</pre>\n") + close(f) + } + return +end +#line 1190 "l2h.nw" +procedure csarg(S) + return 2(="{", tab(bal('}', '{', '}')), ="}") | + (optwhite(), + if ="\\" then + "\\" || (tab(many(S.csletters)) | move(1)) + else + move(1)) +end +#line 1225 "l2h.nw" +procedure apply_args(S, p, as, args_wanted) + delay_newtext(S) + do_apply_args(S, closure(p, as), args_wanted, [], "", 0) + return +end + +procedure do_apply_args(S, cl, wanted_count, args_seen, current_arg, brace_depth) + local open_comment + # invariant : we have an open brace +# pushtrace("APPLY") + while *args_seen < wanted_count & not pos(0) do { + while *args_seen < wanted_count & brace_depth = 0 & not pos(0) do { + tab(many(' \t\n')) + case c := move(1) of { + "\\" : put(args_seen, "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1)) + "{" : { current_arg := "" ; brace_depth := 1 } + "}" : { error("Insufficient arguments to macro ", macro.name) } + "%" : if tab(upto('\n')) then ="\n" else open_comment := tab(0) + default : put(args_seen, c) + } + } + while brace_depth > 0 & not pos(0) do { + current_arg ||:= tab(upto('\\{}%') | 0) + case move(1) of { + "%" : if tab(upto('\n')) then ="\n" else open_comment := tab(0) + "\\" : current_arg ||:= "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1) + "{" : { current_arg ||:= "{" ; brace_depth +:= 1 } + "}" : { brace_depth -:= 1 + if brace_depth > 0 then + current_arg ||:= "}" + else { + put(args_seen, current_arg) + current_arg := "" + } + } + } + } + } + if *args_seen = wanted_count then { + undelay_newtext(S) + cl.proc ! (cl.args ||| args_seen) + } else if \open_comment then { + delay_newtext(S) + before_next_newtext(S, skip_comment_and_continue, + [S, closure(do_apply_args, [S, cl, wanted_count, args_seen, + current_arg, brace_depth])]) + } else + before_next_newtext(S, do_apply_args, [S, cl, wanted_count, args_seen, + current_arg, brace_depth]) +# poptrace() + return +end +#line 1284 "l2h.nw" +procedure skip_comment_and_continue(S, cl) + tab(upto('\n') | 0) + if pos(0) then + before_next_newtext(S, skip_comment_and_continue, [S, cl]) + else { + ="\n" + undelay_newtext(S) +# <take actions appropriate to new text>> + } + return +end +#line 1316 "l2h.nw" +procedure Cnewline(S) + tab(many(' \t')) + if match("\n") then implicit_paragraph(S) + if pos(0) then before_next_newtext(S, Cnewline, [S]) +end +#line 1325 "l2h.nw" +procedure skipblanks(S) + tab(many(' \t')) + if ="\n" then Cnewline(S) + else if pos(0) then before_next_newtext(S, skipblanks, [S]) +end +#line 1334 "l2h.nw" +procedure implicit_paragraph(S, cs, cl) + if S.mode ~== "V" then { + S.mode := "V" + Cparagraph(S) + } + cs_ignore(S, cs, \cl) +end +#line 1347 "l2h.nw" +procedure stop_skipping(S) + while S.newtext[1].proc === (Cnewline|skipblanks) do pop(S.newtext) +end +#line 1357 "l2h.nw" +record item_cl(before, after, ifnone) + +procedure Citem(S, cs, cl) + if pos(0) then + after_next_newtext(S, Citem, [S, cs, cl]) + else if ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", convert_bracketed, cl) + } else { + skipblanks(S) + emit_text(S, cl[1].ifnone) + \liststack[1] := \liststack[1] + 1 + } +end +#line 1372 "l2h.nw" +procedure convert_bracketed(S, contents, cl) + emit_text(S, cl[1].before || + convert(converter("H"), "{" || contents || "}") || + cl[1].after) + optwhite() +end +#line 1379 "l2h.nw" +global liststack, suspendstack +#line 1388 "l2h.nw" +procedure listenv(env, html) + begintab[env] := Clist + begincl[env] := html + endtab[env] := Clist_end + endcl[env] := html +end + +procedure push_item_closure(cs) + push(csclosure["item"], + if cs == "description" then item_cl("<dt>", "<dd>", "<dt><dd>") + else item_cl("<li>", "--", "<li>")) +end + +procedure Clist(S, cs, cl) + push(liststack, 1) + push_item_closure(cs) + emit_text(S, tag(cl)) +end + +procedure Cresume(S, cs, cl) + local n, env + (="{", env := tab(upto('}')), ="}") | error("botched \\resume{...}") + n := pop(suspendstack) | error("\\resume not balanced by corresponding \\suspend") + push(liststack, n) + push_item_closure(env) + if env == "enumerate" then + emit_text(S, tag(begincl[env] || " start=\"" || n || "\"")) + else + emit_text(S, tag(begincl[env])) +end + +procedure Clist_end(S, cs, cl) + emit_text(S, endtag(cl)) + pop(csclosure["item"]) + pop(liststack) +end + +procedure Csuspend(S, cs, cl) + local env + (="{", env := tab(upto('}')), ="}") | error("botched \\suspend{...}") + emit_text(S, endtag(endcl[env])) + pop(csclosure["item"]) + push(suspendstack, pop(liststack)) +end +#line 1437 "l2h.nw" +global labels_seen + +procedure Clabel(S, cs, cl) + initial /labels_seen := set() + insert(labels_seen, l := csarg(S)) | fail + emit_text(S, "<a name=\"" || l || "\"><b>[*]</b></a>") +end + +procedure Cref(S, cs, cl) + local prefix, prefix_tag + initial /labels_seen := set() + prefix_tag := (\cl)[1] | "" + prefix := (\cl)[2] | "" + l := prefix || csarg(S) | fail + emit_text(S, prefix_tag || "<a href=\"#" || l || "\">[" || + (if member(labels_seen, l) then "<-" else "->") || "]</a>") +end +#line 1463 "l2h.nw" +procedure Ccite(S, cs, cl, bracketed_text) + if ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", do_cite, cl) + } else + do_cite(S, &null, cl) +end + +procedure do_cite(S, commentary, cl) + local key + if \commentary then + optwhite() + if pos(0) then before_next_newtext(S, do_cite, [S, commentary, cl]) + else { + key := csarg(S) + \commentary := convert(converter("H"), "{" || \commentary || "}") + emit_text(S, "<b>[cite ") + key ? { + while k := tab(upto(",")) & ="," do + emit_text(S, "<a href=\"#NWcite-" || k || "\">" || k || "</a>, ") + if k := tab(0) then + emit_text(S, "<a href=\"#NWcite-" || k || "\">" || k || "</a>") + } + emit_text(S, ", <i>" || \commentary || "</i>") + emit_text(S, "]</b>") + } +end +#line 1491 "l2h.nw" +procedure Cbibitem(S, cs, cl) + local label, key + static counter + initial counter := 0 + if ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", finish_bibitem, []) + } else { + label := "<b>[" || (counter +:= 1) || "]</b>" + apply_args(S, do_bibitem_key, [S, label], 1) + } +end + +procedure do_bibitem_key(S, label, key) + return emit_text(S, "<a name=\"NWcite-" || key || "\">" || label || "</a> ") +end + +procedure finish_bibitem(S, contents, args) + local key, label + optwhite() + label := convert(converter("H"), "{" || contents || "}") + key := apply_args(S, do_bibitem_key, [S, label], 1) +end +#line 1529 "l2h.nw" +record ifrec(on_else, on_fi) +#line 1538 "l2h.nw" +procedure Ciffalse(S, cs, cl) +#error("### \\", cs, " -> false (S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}, ")") + push(S.ifstack, ifrec(S.ignoring, S.ignoring)) + S.ignoring := 1 +end + +procedure Ciftrue(S, cs, cl) +#error("### \\", cs, " -> true (S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}, ")") + push(S.ifstack, ifrec(1, S.ignoring)) +end + +procedure Celse(S, cs, cl) + S.ignoring := S.ifstack[1].on_else +#error("### \\else -> S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}) +end + +procedure Cfi(S, cs, cl) + S.ignoring := S.ifstack[1].on_fi +#error("### \\fi -> S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}) + pop(S.ifstack) +end +#line 1563 "l2h.nw" +procedure Cnewif(S, cs, cl) + local newif, newcs + tab(many(' \t\n')) + if pos(0) then + after_next_newtext(S, Cnewif, [S, cs, cl]) + else { + newif := csarg(S) + newif ? + if ="\\if" & newcs := tab(many(S.csletters)) & pos(0) then { + +#line 1580 "l2h.nw" +cstab[newcs || "false"] := Csetif +cstab[newcs || "true"] := Csetif +cstab["if" || newcs] := Ciffalse +#line 1573 "l2h.nw" + } else + error("\\newif argument botch: " || newif) + } +end +#line 1584 "l2h.nw" +procedure Csetif(S, cs, cl) + local base, tag + if cs ? (base := tab(find("true"|"false")), tag := =("true"|"false"), pos(0)) then { + cstab["if" || base] := if tag == "true" then Ciftrue else Ciffalse + } else { + error("This can't happen --- setif botch (not urgent)") + } +end +#line 1598 "l2h.nw" +procedure Cuppercase(S, cs, cl) + l := map(csarg(S), &lcase, &ucase) | fail + emit_text(S, l) +end +#line 1613 "l2h.nw" +record table_info(index, # number of this cell in the row + alignment, # the alignment of this cell + width, # how many columns this cell will span + alignments, # default alignments for this table + brace_depth, # size of S.closes after start of cell + cell_text) # value of S.text to use to scan this cell +#line 1637 "l2h.nw" +procedure start_table_cell(S, text) + local this, attributes + + text ? { + tab(many(' \t\n')) + if pos(0) then return + } +# write(&errout, "starting cell with ", image(text)) + + this := S.tables[1] | fatal("starting cell with no current table") + S.text := this.cell_text + +if /(\this).brace_depth then write(&errout, "starting table cell, ", image(this), " has null brace depth") + # use this to start the current cell + if this.index = 1 then emit_text(S, "<tr>") + attributes := \this.alignment | aligneq("top") + if this.width > 1 then attributes ||:= " colspan=" || this.width + emit_text(S, "<td" || attributes || ">") + + # now update state for the next cell + this.index +:= this.width # advance to next cell + this.alignment := this.alignments[this.index] | &null + this.width := 1 + # can't set cell_text until we hit & + + +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 1663 "l2h.nw" + emit_text(S, text) + return +end +#line 1670 "l2h.nw" +procedure ampersand(S) + local this + this := S.tables[1] + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 1674 "l2h.nw" + if /this then + emit_text(S, " --- ") + else { + emit_text(S, "") # be sure cell gets started, even if empty + emit_text(S, "</td>") + if S.text ~=== start_table_cell then + this.cell_text := S.text + S.text := start_table_cell + this.brace_depth := *S.closes + 1 # will open at start of cell +#write(&errout, "set brace depth for ", image(this)) + } + tab(many(' \t\n')) +## write(&errout, " past &, text = ", image(S.text), ", next = ", +## image(&subject[&pos:0])) + return +end +#line 1699 "l2h.nw" +procedure Cbackback(S, cs, cl) + local this + this := S.tables[1] + cs_ignore(S, cs, "[", Cbackback_continue, [S, this]) +end + +procedure Cbackback_continue(S, this) +#if /(\this).brace_depth then write(&errout, image(this), " has null brace depth") + if /this | *S.closes > this.brace_depth then { # ordinary \\ + S.text(S, "<br>") + } else { # row terminator +## write(&errout, "ending row with ", image(&subject[&pos:0])) + emit_text(S, "") # be sure cell gets started, even if empty + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 1713 "l2h.nw" + emit_text(S, "</td></tr>\n") + tab(many(' \t\n')) + if S.text ~=== start_table_cell then + this.cell_text := S.text + this.index := 1 + this.alignment := this.alignments[this.index] | &null + this.width := 1 + S.text := start_table_cell + this.brace_depth := *S.closes + 1 # about to open + } +end +#line 1727 "l2h.nw" +procedure Chline(S, cs, cl) + if \S.tables[1] then return + else emit_text(S, "<hr>") + return +end +#line 1737 "l2h.nw" +procedure Ctabular_end(S, cs, cl) + local this + if S.text ~=== start_table_cell | S.tables[1].index > 1 then {# row in progress + emit_text(S, "") # be sure cell gets started, even if empty + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 1742 "l2h.nw" + emit_text(S, "</td></tr>") + } + if S.text === start_table_cell then # abort it + S.text := S.tables[1].cell_text + emit_text(S, "</table>") + xxx := pop(S.tables) +#write(&errout, "popped ", image(xxx)) + return +end +#line 1754 "l2h.nw" +procedure Ctabular(S, cs, cl) + cs_ignore(S, cs, cl, Ctabular_continue, [S]) + return +end + +procedure Ctabular_continue(S) + a := csarg() # alignment +#write(&errout, "Alignment ", a) + emit_text(S, if upto('|', a) then "<table border>" else "<table>") + emit_text(S, "<!-- alignment is " || a || "-->") + a := alignments(a) + emit_text(S, "<!-- " || *a || " columns-->") + push(S.tables, table_info(1, a[1] | "l", 1, a, *S.closes+1, S.text)) +#write(&errout, "pushed ", image(S.tables[1])) + S.text := start_table_cell + optwhite() + return +end +#line 1777 "l2h.nw" +procedure tabular(env, ignore) + begintab[env] := Ctabular + begincl[env] := ignore + endtab[env] := Ctabular_end + endcl[env] := ignore +end +#line 1786 "l2h.nw" +procedure aligneq(a) + return " align=\"" || a || "\"" +end + +procedure valigneq(a) + return " valign=\"" || a || "\"" +end + +procedure alignments(s) + a := [] + s ? { + while not pos(0) do + case move(1) of { + "l" | "X" | "Y" | "p" : + { put(a, aligneq("left") || valigneq("top")); skip_bracket() } + "c" : put(a, aligneq("center")) + "r" : put(a, aligneq("right")) + "m" : { put(a, aligneq("left") || valigneq("center")); skip_bracket() } + "b" : { put(a, aligneq("left") || valigneq("bottom")); skip_bracket() } + "@" | "<" | ">" | "!" : skip_bracket() + "|" : &null + default : &null # unrecognized... + } + } + return a +end +#line 1813 "l2h.nw" +procedure skip_bracket() + if ="{" then { + n := 1 + while n > 0 & not pos(0) do { + tab(upto('{}\\') | 0) + case move(1) of { + "{" : n +:= 1 + "}" : n -:= 1 + "\\" : move(1) + } + } + } + return +end +#line 1831 "l2h.nw" +procedure Cmulticolumn(S, cs, cl) + local this + this := S.tables[1] + n := integer(csarg()) | error("\\multicolumn or \\multispan not followed by integer") + if cs == "multicolumn" then a := alignments(csarg()) +# write(&errout, "\\", cs, " n = ", n, ", a = ", (\a)[1] | "???", +# ", text = ", image(S.text)) + if /this then return # \multicolumn without table? + this.width := n + this.alignment := (\a)[1] + return +end + +procedure Cspan(S, cs, cl) + (\S.tables[1]).width +:= 1 + return +end +#line 1850 "l2h.nw" +procedure Cnoalign(S, cs, cl) + apply_args(S, finish_noalign, [S], 1) + return +end + +procedure finish_noalign(S, arg) + return if \S.ignoring then "" else + accumulate_text(S, "<br>" || convert(converter("V"), "{" || arg || "}") || "<br>") +end +#line 1862 "l2h.nw" +procedure auxfile(cs, ext, placeholder, header, trailer, ignore) + cstab[cs] := Cauxfile + csclosure[cs] := aux_cl(ext, placeholder, header, trailer, \ignore | "") +end +#line 1869 "l2h.nw" +record aux_cl(ext, placeholder, header, trailer, ignore) + +procedure Cauxfile(S, cs, cl) + local auxfile, T + if auxfile := open(basename(\curfile) || "." || cl.ext) then { + T := converter("V") + Cmakeatletter(T) + S.text(S, \cl.header) + while line := read(auxfile) do + S.text(S, convert(T, line || "\n")) + close(auxfile) + S.text(S, \cl.trailer) + } else { + S.text(S, \cl.placeholder) + } + cs_ignore(S, cs, cl.ignore) + if \auxfile then return +end +#line 1888 "l2h.nw" +procedure basename(name) + reverse(name) ? { + tab(upto('.')) & ="." + return reverse(tab(0)) + } +end +#line 1901 "l2h.nw" +procedure Ctableofcontents(S, cs, cl) + S.mode := "V" + Cauxfile(S, cs, cl) + set_toclevel(S) +end +#line 1910 "l2h.nw" +procedure set_toclevel(S, l) + static toclevel, initiallevel + if /initiallevel := \l then + S.text(S, "<ul compact>") + if /l := \initiallevel then + S.text(S, "</ul>") + if /l then return # never set a level + /toclevel := l + while toclevel < l do { + S.text(S, "<ul compact>") + toclevel +:= 1 + } + while toclevel > l do { + S.text(S, "</ul>") + toclevel -:= 1 + } + return +end +#line 1931 "l2h.nw" +procedure Ccontentsline(S, cs, cl) + local type, level + static leveltab + initial { +#line 1945 "l2h.nw" +l := ["part", "chapter", "section", "subsection", "subsubsection", + "paragraph", "subparagraph"] +leveltab := table() +every i := 1 to *l do + leveltab[l[i]] := i - 2 # making section level 1 +#line 1934 "l2h.nw" + } + l := \leveltab[csarg()] | fail + if l > \countertab["tocdepth"] then + cs_ignore(S, cs, "{{") # skip this one + else { + set_toclevel(S, l) + S.text(S, "<li>") + after_next_open(S, after_next_close, [S, cs_ignore, [S, cs, "{"]]) + } +end +#line 1953 "l2h.nw" +global countertab + +procedure Csetcounter(S, cs, cl) + local counter + (counter := csarg(), countertab[counter] := integer(csarg())) | + cs_ignore(S, cs, "{{") +end +#line 1967 "l2h.nw" +global accent_name, accent_valid +#line 1998 "l2h.nw" +procedure accent(cs) + cstab[cs] := Caccent +end + +procedure Caccent(S, cs, cl) + static warned + initial warned := table() + arg := csarg(S) | return + if arg == "\\i" then arg := "i" + if arg == "\\j" then arg := "j" + if *arg = 1 & any(accent_valid[cs], arg) then + S.text(S, "&" || arg || accent_name[cs] || ";") + else { + +#line 2016 "l2h.nw" +/warned[cs] := set() +if not member(warned[cs], arg) then { + write(&errout, "Warning: Can't handle \\", cs, " with arg `", arg, "'") + insert(warned[cs], arg) +} +#line 2012 "l2h.nw" + S.text(S, arg) + } +end +#line 2026 "l2h.nw" +procedure fontchange(tex, html) + cstab[tex] := Cfontchange + csclosure[tex] := html +end +#line 2031 "l2h.nw" +procedure Cfontchange(S, tex, html) + S.text(S, tag(html)) + before_next_close(S, emit_text, [S, endtag(html)]) +end +#line 2051 "l2h.nw" +procedure ignore(cs, template) + /template := "" + cstab[cs] := cs_ignore + csclosure[cs] := template +end + +procedure ignoreenv(env, template) + /template := "" + begintab[env] := cs_ignore + begincl[env] := template + endtab[env] := do_nothing +end +#line 2070 "l2h.nw" +procedure cs_ignore(S, cs, template, proc, args) + local saved_ignore + saved_ignore := S.ignoring + S.ignoring := 1 + if type(template) == "integer" then template := repl("{", template) + return do_ignore(S, template, saved_ignore, proc, args) +end +#line 2084 "l2h.nw" +procedure do_ignore(S, template, saved_ignore, proc, args) + if *template > 0 then + if optwhite() & pos(0) then + after_next_newtext(S, do_ignore, [S, template, saved_ignore, proc, args]) + else + case template[1] of { + "{" : { S.ignoring := 1 + after_next_open(S, ignore_til_close, + [S, template[2:0], saved_ignore, proc, args]) + } + "A" : { csarg(S) # had better be in one input + do_ignore(S, template[2:0], saved_ignore, proc, args) + } + "[" : if optwhite() & ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", ignore_bracket_plus, + [S, template[2:0], saved_ignore, proc, args]) + } else + do_ignore(S, template[2:0], saved_ignore, proc, args) + "C" : # a total cheat, means ``copy optional arg'' + if optwhite() & ="[" then { + S.ignoring := &null + delay_newtext(S) + with_upto_bracket(S, "", copy_bracket_plus, + [S, template[2:0], saved_ignore, proc, args]) + } else + do_ignore(S, template[2:0], saved_ignore, proc, args) + "=" : { delay_newtext(S) + eat_assignment(S, do_ignore, [S, template[2:0], saved_ignore, proc,args]) + } + "*" : { (="*", optwhite()) + do_ignore(S, template[2:0], saved_ignore, proc, args) + } + "(" : { (="(", tab(upto(')')), =")", optwhite()) + do_ignore(S, template[2:0], saved_ignore, proc, args) + } + } + else { + S.ignoring := saved_ignore + (\proc)!(\args) + } +end + +procedure ignore_til_close(S, template, saved_ignore, proc, args) + before_next_close(S, do_ignore, [S, template, saved_ignore, proc, args]) +end +#line 2133 "l2h.nw" +procedure do_nothing(S, cs, cl) + return +end +#line 2144 "l2h.nw" +procedure with_upto_bracket(S, bracketed_text, proc, args) + bracketed_text ||:= tab(upto(']') | 0) + if pos(0) then + before_next_newtext(S, with_upto_bracket, [S, bracketed_text, proc, args]) + else { + ="]" + undelay_newtext(S) + (\proc)(S, bracketed_text, args) + } + return +end +#line 2158 "l2h.nw" +procedure ignore_bracket_plus(S, contents, args) + # contents are ignored + do_ignore!args +end +#line 2164 "l2h.nw" +procedure copy_bracket_plus(S, contents, args) + local should_ignore + should_ignore := args[3] | fail # saved_ignore arg to do_ignore + if /should_ignore then + S.text(S, convert(converter("H"), "{" || contents || "}")) + do_ignore!args +end +#line 2177 "l2h.nw" +procedure eat_assignment(S, proc, args) + static decimal_chars, hex_chars, oct_chars + initial { + decimal_chars := &digits ++ '.,+-' + hex_chars := &digits ++ 'abcdefABCDEF' + oct_chars := '0124567' + } + optwhite() + ="=" # so what if we swallow multiple = signs + optwhite() + if pos(0) then { + before_next_newtext(S, eat_assignment, [S, proc, args]) + return + } else if glue() then { # finished + } else if any(decimal_chars) then { + tab(many(decimal_chars)) + optwhite() + if ="\\" then + tab(many(S.csletters)) | move(1) + # else assume assignment of the form \hangafter=2 + } else if ="\"" then { + tab(many(hex_chars)) & optwhite() + } else if ="\'" then { + tab(many(oct_chars)) & optwhite() + } else if =("\\"|"`\\") then + tab(many(S.csletters)) | move(1) + undelay_newtext(S) + (\proc)!args +end +#line 2207 "l2h.nw" +procedure dimen() + static decimal_chars + initial decimal_chars := &digits ++ '.,' + suspend (optwhite(), + if any('+-') then (move(1), optwhite()) else "", + tab(many(decimal_chars)), optwhite(), + (="true", optwhite()) | &null, + =("em"|"ex"|"pt"|"pc"|"in"|"bp"|"cm"|"mm"|"dd"|"cc"|"sp"|"mu")) +end +#line 2217 "l2h.nw" +procedure glue() + suspend (dimen(), + (optwhite(), ="plus", dimen()) | "", + (optwhite(), ="minus", dimen()) | "") +end +#line 2231 "l2h.nw" +procedure substitution(tex, html, ignore_template) + # ignore mode for now + cstab[tex] := Cemit_ig + csclosure[tex] := emit_ig_cl(html, \ignore_template | "") +end +#line 2239 "l2h.nw" +record emit_ig_cl(html, template) + +procedure Cemit_ig(S, cs, cl) + emit_text(S, cl.html) + if *cl.template > 0 then + cs_ignore(S, cs, cl.template) +end +#line 2249 "l2h.nw" +procedure activesubst(char, html, ignore_template) + local S + # ignore mode for now + activetab[char] := Cemit_ig + activeclosure[char] := emit_ig_cl(html, \ignore_template | "") + S := \dynamic_add_hack | return + if upto(S.activechars, char) then return # already active + if S.activechars ++:= cset(char) then { + before_next_close(S, delete_active_char, [S, char]) + } else impossible("ugh") + return +end + +procedure delete_active_char(S, char) + S.activechars --:= char + return +end +#line 2282 "l2h.nw" +procedure envblock(env, left, right, ignore_template) + /ignore_template := "" + begintab[env] := Cemit_ig + begincl[env] := emit_ig_cl(if /right then tag(left) else left, ignore_template) + endtab[env] := Cemit + endcl[env] := if /right then endtag(left) else right +end +#line 2291 "l2h.nw" +procedure Cemit(S, cs, cl) + S.text(S, cl) +end +#line 2303 "l2h.nw" +record blockpair(left, right, ignore) + +procedure argblock(tex, html, right, ignore) + # called as is envblock + /ignore := "" + cstab[tex] := Cblock + csclosure[tex] := + if /right then blockpair (tag(html), endtag(html), ignore) + else blockpair (html, right, ignore) +end +#line 2316 "l2h.nw" +procedure argblockv(tex, html, right, ignore) + argblock(tex, html, right, ignore) + cstab[tex] := CblockV +end +#line 2321 "l2h.nw" +procedure Cblock(S, cs, cl, done_ignoring) + if /done_ignoring & *cl.ignore > 0 then { + cs_ignore(S, cs, cl.ignore, Cblock, [S, cs, cl, 1]) + } else if pos(0) then { + after_next_newtext(S, do_cs, [S, cs, cl]) + } else if match("{") then { + S.text(S, cl.left) + after_next_open(S, before_next_close, [S, emit_text, [S, cl.right]]) + } else { +# S.text(S, cl.left || csarg(S) || cl.right) + apply_args(S, Cblock_continue, [S, cl], 1) + } + return +end + +procedure Cblock_continue(S, cl, title) + S.text (S, cl.left || title || cl.right) + return +end +#line 2341 "l2h.nw" +procedure CblockV(S, cs, cl) + S.mode := "V" + Cblock(S, cs, cl) + return +end +#line 2353 "l2h.nw" +record macro_defn(name, arg_count, body, mode) +#line 2357 "l2h.nw" +record raw_arg(number) +record converted_arg(number, mode) +#line 2361 "l2h.nw" +procedure expand_macro(S, macro, args) + every a := !macro.body do + case type(a) of { + "string" : emit_text(S, a) + "raw_arg" : emit_text(S, args[a.number]) | impossible("missing arg") + "converted_arg" : S.text(S, convert(S, "{" || args[a.number] || "}")) + } +# poptrace() + return +end +#link pushtrace +#line 2375 "l2h.nw" +procedure do_macro(S, macro, args_seen, current_arg, brace_depth) + # invariant : we have an open brace +# write(&errout, "scanning args for macro ", macro.name) +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count) + while *args_seen < macro.arg_count & not pos(0) do { + while *args_seen < macro.arg_count & brace_depth = 0 & not pos(0) do { +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count, +# " current ", image(current_arg), " braces ", brace_depth) + tab(many(' \t\n')) + case c := move(1) of { + "\\" : put(args_seen, "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1)) + "{" : { current_arg := "" ; brace_depth := 1 } + "}" : { error("Insufficient arguments to macro ", macro.name) } + default : put(args_seen, c) + } + } + while brace_depth > 0 & not pos(0) do { +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count, +# " current ", image(current_arg), " braces ", brace_depth) + current_arg ||:= tab(upto('\\{}') | 0) + case move(1) of { + "\\" : current_arg ||:= "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1) + "{" : { current_arg ||:= "{" ; brace_depth +:= 1 } + "}" : { brace_depth -:= 1 + if brace_depth > 0 then + current_arg ||:= "}" + else { + put(args_seen, current_arg) + current_arg := "" + } + } + } + } + } +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count, +# " current ", image(current_arg), " braces ", brace_depth) + if *args_seen = macro.arg_count then { +# write(&errout, "Arguments for macro ", macro.name, ":") +# every write(&errout, "\t", image(!args_seen)) + expand_macro(S, macro, args_seen) + undelay_newtext(S) + } else + before_next_newtext(S, do_macro, [S, macro, args_seen, current_arg, brace_depth]) + return +end +#line 2428 "l2h.nw" +procedure Cmacro(S, cs, cl) +# pushtrace("MACRO") + delay_newtext(S) +# apply_args(S, closure(expand_macro, [cl]), cl.arg_count) + do_macro(S, cl, [], "", 0) + return +end +#line 2439 "l2h.nw" +procedure macro(name, arg_count, body, mode) + m := macro_defn(name, arg_count, parse_body(body), mode) + cstab[name] := Cmacro + csclosure[name] := m + return +end + +procedure begin_macro(env, arg_count, body, mode) + m := macro_defn(env, arg_count, parse_body(body), mode) + begintab[env] := Cmacro + begincl[env] := m + return +end + +procedure parse_body(body) + b := [] + body ? { + put(b, tab(upto('#') | 0)) + while ="#" do { + put(b, ="#" | (="$", raw_arg(argnum())) | converted_arg(argnum())) | + error("malformed macro arg #", tab(0)) + put(b, tab(upto('#') | 0)) + } + } + return b +end + +procedure argnum() + if any(&digits) then return integer(move(1)) else fail +end +#line 2472 "l2h.nw" +procedure l2h_macro(name, count, body[]) + count := integer(count) | + return error("must give # of arguments to l2h macro ", name) + s := "" + every s ||:= " " || (1(b := !body, type(b) == "string")) + s := s[2:0] # strip leading space if any + return macro(name, count, s) +end +#line 2482 "l2h.nw" +procedure l2h_environment(env, count, body[]) + count := integer(count) | + return error("must give # of arguments to l2h environment ", env) + s := "" + every s ||:= " " || (1(b := !body, type(b) == "string")) + s := s[2:0] # strip leading space if any + return begin_macro(env, count, s) +end +#line 2497 "l2h.nw" +record table_closure(args, amp, open, close) + +procedure table_env(env, args, amp, open, close) + begintab[env] := Ctable + begincl[env] := table_closure(args, amp, + if /close then tag(\open) | &null else open, + if /close then endtag(\open) | &null else close) + endtab[env] := Ctable_end + endcl[env] := [] +end +#line 2508 "l2h.nw" +procedure Ctable(S, env, cl) + local amp +## amp := S.ampersand +## S.ampersand := cl.amp + S.text(S, \cl.open) + push(endcl[env], amp) + cs_ignore(S, env, cl.args) +end + +procedure Ctable_end(S, env, cl) +# S.ampersand := pop(cl) + S.text(S, \begincl[env].close) +end +#line 2524 "l2h.nw" +procedure Cepsfig(S, cs, cl) + apply_args(S, do_epsfig, [S], 1) +end + +procedure do_epsfig(S, arg) + local args + args := [] + arg ? + while not pos(0) do { + tab(many(' \t\n')) + put(args, eqsplit(tab(upto(',') | 0))) + } + if a := !args & a.name == ("file"|"figure") then + emit_text(S, "<a href=" || image(a.value) || "><b>[</b>PostScript figure " || + a.value || "<b>]</b></a>") + else + emit_text(S, "<b>[</b>Ill-understood PostScript figure<b>]</b>") +end + +record apair(name, value) + +procedure eqsplit(s) + p := apair() + s ? (p.name := tab(upto('=')), ="=", p.value := tab(0)) + return p +end +#line 2552 "l2h.nw" +procedure Cincludegraphics(S, cs, cl) + local saved_ignore + saved_ignore := S.ignoring + S.ignoring := 1 + do_ignore(S, "[", saved_ignore, apply_args, [S, do_includegraphics, [S], 1]) +end + +procedure do_includegraphics(S, arg) + local base, ext + if arg ? (base := tab(find(ext := ".ps" | ".eps" | ".epsi")), =ext, pos(0)) then + emit_text(S, "<a href=" || image(arg) || "><b>[</b>PostScript figure " || + arg || "<b>]</b></a>") + else if arg ? (base := tab(find(ext := ".png" | ".gif" | ".jpg")), =ext, pos(0)) then + emit_text(S, "<img src=" || image(arg) || ">") + else + emit_text(S, "<b>[</b>Ill-understood graphics<b>]</b>") +end +#line 2574 "l2h.nw" +procedure let(lhs, rhs) + cstab[lhs] := cstab[rhs] + csclosure[lhs] := csclosure[rhs] +end + +procedure let_closure(lhs, cl[]) + csclosure[lhs] := if *cl = 1 then cl[1] else cl +end + +procedure letenv(lhs, rhs) + begintab[lhs] := begintab[rhs] + endtab[lhs] := endtab[rhs] + begincl[lhs] := begincl[rhs] + endcl[lhs] := endcl[rhs] +end +#line 2595 "l2h.nw" +procedure tag(html) + return "<" || html || ">" +end + +procedure endtag(html) + return "</" || html || ">" +end +#line 2605 "l2h.nw" +procedure Ccomment(S) + if *S.comment > 0 then { + S.text(S, "<!--") + S.comment ? { + while S.text(S, tab(find("--"))) do { + move(2) + S.text(S, "- - ") + } + S.text(S, tab(0)) + } + S.text(S, "-->") + } + S.comment := "" + return +end +#line 2621 "l2h.nw" +procedure Cparagraph(S) + S.text(S, "<p>") +end +#line 2625 "l2h.nw" +procedure Cmath(S) + +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 2627 "l2h.nw" + S.text(S, "<i>") +end + +procedure Cmath_end(S) + S.text(S, "</i>") + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 2633 "l2h.nw" +end +#line 2635 "l2h.nw" +procedure Cdisplaymath(S) + +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 2637 "l2h.nw" + S.text(S, "<blockquote><i>") +end + +procedure Cdisplaymath_end(S) + S.text(S, "</i></blockquote>") + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 2643 "l2h.nw" +end +#line 2645 "l2h.nw" +procedure Cmakeatletter(S) + S.csletters ++:= '@' +end + +procedure Cmakeatother(S) + S.csletters --:= '@' +end +#line 2655 "l2h.nw" +procedure Ckill(S, cs, cl) + S.the_text := "" +end +#line 2673 "l2h.nw" +global csfunctions +#line 2700 "l2h.nw" +global dynamic_add_hack +procedure parse_dynamic_add(S) + if (optwhite(), =("l2h"|"sl2h"), skipwhite(), + p := tab(upto(' \t')), +#line 2717 "l2h.nw" +((p := \csfunctions[p]) | +{ dynamic_warn(p); fail }) +#line 2703 "l2h.nw" + , + skipwhite(), any(~'\n')) then { + a := [] + while (any(~'\n'), l := tab(upto(' \t\n') | 0)) do { + put(a, if p === (l2h_macro|l2h_environment) then l else map(l, "#", " ")) + skipwhite() + } + dynamic_add_hack := S + p!a + dynamic_add_hack := &null + return + } +end +#line 2720 "l2h.nw" +procedure dynamic_warn(p) + static badprocs + initial badprocs := set() + if not member(badprocs, p) then { + write(&errout, "Warning: % l2h ", p, " not recognized -- ignored") + insert(badprocs, p) + } +end +#line 2732 "l2h.nw" +procedure optwhite() + suspend tab(many(' \t')) | "" +end +#line 2737 "l2h.nw" +procedure skipwhite() + suspend tab(many(' \t')) +end +#line 2829 "l2h.nw" +global errstatus +procedure error(args[]) + errstatus := 1 + return write!([&errout, (\curfile || ":") | "line ", curline, ": "] ||| args) +end +#line 2878 "l2h.nw" +procedure fatal(L[]) + write!(["@fatal l2h "] ||| L) + write!([&errout, "noweb error in l2h: "] ||| L) + exit(1) +end +#line 2885 "l2h.nw" +procedure rcsinfo () + return "$Id: l2h.nw,v 1.24 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +#line 2745 "l2h.nw" +procedure main(args) + local line + errstatus := 0 + every arg := !args do + case arg of { + "-show-unknowns" : show_unknowns := 1 + "-html-quotes" : html_quotes := 1 + default : fatal("unknown arg ", image(arg)) + } + while line := read() do + apply(filter, line) + warn_unknown(\unknown_set, "control sequences", "\\") + warn_unknown(\unknown_envs, "environments", "{", "}") + if errstatus > 0 then + write("@fatal l2h Error occurred in l2h conversion") + exit(errstatus) +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 2771 "l2h.nw" +global curfile, curline + +procedure filter(name, arg) + static S, code + initial S := converter("V") +### write(" mode ", S.mode) + case name of { + "begin" : { +#line 2817 "l2h.nw" +write("@", name, (" " || \arg) | "") +#line 2778 "l2h.nw" + ; if match("code ", arg) then code := 1} + "end" : {if match("docs ", arg) then +#line 2795 "l2h.nw" +if S.mode ~== "V" then write("@text <p>") +#line 2780 "l2h.nw" + +#line 2817 "l2h.nw" +write("@", name, (" " || \arg) | "") +#line 2780 "l2h.nw" + ; code := &null; S.mode := "V"} + "quote" : { outtext("\0" ? convert(S)) } + "endquote" : { outtext("\1" ? convert(S)) } + "file" : { +#line 2817 "l2h.nw" +write("@", name, (" " || \arg) | "") +#line 2783 "l2h.nw" + ; curfile := arg; curline := 1} + "line" : { +#line 2817 "l2h.nw" +write("@", name, (" " || \arg) | "") +#line 2784 "l2h.nw" + ; curline := integer(arg)} + "defn" : { write("@", name, " ", convert_use_or_def(arg)) } + "use" : { write("@", name, " ", convert_use_or_def(arg)) } + "text" : {if \code then +#line 2817 "l2h.nw" +write("@", name, (" " || \arg) | "") +#line 2787 "l2h.nw" + else outtext(arg ? convert(S)) } + "nl" : {if \code then +#line 2817 "l2h.nw" +write("@", name, (" " || \arg) | "") +#line 2788 "l2h.nw" + else outtext("\n" ? convert(S)); curline +:= 1} + "fatal" : { +#line 2817 "l2h.nw" +write("@", name, (" " || \arg) | "") +#line 2789 "l2h.nw" + ; exit(1)} + default : { +#line 2817 "l2h.nw" +write("@", name, (" " || \arg) | "") +#line 2790 "l2h.nw" + } + } + return +end +#line 2799 "l2h.nw" +procedure convert_use_or_def(s) + r := "" + s ? { + while r ||:= quickconv(tab(find("[["))) do { + (r ||:= ="[[") | fatal("impossible missing [[") + (r ||:= tab(find("]]")) || tab(many(']'))) | + fatal("impossible missing ]] in ", image(s)) + } + return r || quickconv(tab(0)) + } +end + +procedure quickconv(s) + static C + initial C := converter("H") + return 1(("{" || s || "}" ? convert(C)), reset(C)) +end +#line 2819 "l2h.nw" +procedure outtext(s) + s ? + while not pos(0) do + if ="\n" then write("@nl") + else if ="\0" then write("@quote") + else if ="\1" then write("@endquote") + else write("@text ", tab(upto('\n\0\1') | 0)) + return +end diff --git a/web/noweb/src/icon/l2h.nw b/web/noweb/src/icon/l2h.nw new file mode 100644 index 0000000000..268039c558 --- /dev/null +++ b/web/noweb/src/icon/l2h.nw @@ -0,0 +1,2898 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +\documentclass{article} +\usepackage{noweb,multicol} + +\title{Converting {\LaTeX} to HTML} +\author{Norman Ramsey\\{\tt nr@eecs.harvard.edu}} + +\noweboptions{smallcode} +\setcounter{secnumdepth}{1} + +\begin{document} +@ +\pagenumbering{roman} +\maketitle +\tableofcontents +\pagenumbering{arabic} +@ +\section{Introduction} +This program provides an infrastructure for converting {\LaTeX} to +HTML. +That infrastructure can be used to make a {\tt noweb} filter or to +make a standalone conversion program. +The program is roughly divided into three parts. +Section~\ref{cs-decls} assigns a meaning (treatment) to each control +sequence. +The first part is roughly declarative, and in principle it could be + replaced by a data file. +The declarations can be augmented dynamically by putting formal +comments in a {\LaTeX} or noweb file---the so-called +``nifty \verb+% l2h+ escape hatch,'' which is utterly necessary and utterly +undocumented. +Section~\ref{engine} describes the engine used to do the conversion, +and +Sections \ref{imp-decl}~and~\ref{html-format} gives the procedures +that do the individual conversions. + +This program was motivated by my dissatisfaction with +\texttt{latex2html}. +In particular, \texttt{latex2html} is slow, and its output is full of +chartjunk. +Design decisions are driven by two goals: +\begin{itemize} +\item +Translate input eagerly as it is read in, in one pass whenever +possible. +For example, I take care to translate the body of [[\textbf{...}]] +without reading the entire argument. +Instead, I open the macro by emitting [[<b>]], and I note that a +corresponding [[</b>]] should be emitted when the matching close brace +is reached. +Most environments, including tables, are treated similarly. +The result is that \texttt{l2h} is \emph{fast}; it can comfortably +handle documents of hundreds of pages, whereas \texttt{latex2html} +starts bogging down at around 50~pages.% +\footnote{Measurement taken late in 1994} +\item +Use simple, natural translations to HTML whenever possible, and limit +functionality to simple translation. +For example, I do \emph{not} offer options to split documents up into +sections and to create hyperlinks between sections---that sort of +thing can and should be done by pure HTML tools. +Also, I make no real attempt to do anything fancy with equations or +pictures. +These things have no natural equivalents in HTML. +If you want to run {\LaTeX}, produce images, and embed them, look +elsewhere. +\end{itemize} +Finally, the program has to be able to translate a fragment at a time, +because it needs to work selectively on parts of the noweb pipeline. +For example, the argument to a {\LaTeX} control sequence might be +split into three pieces, one of which could be noweb quoted code. +Passing pieces in and getting results back incrementally +would be completely straightforward in a language with +message-passing concurrency, but we don't have that in Icon. +If I understood co-expressions, I might be able to use them, but +instead I use a continuation-passing, closure-passing style, +constantly creating actions to be executed on future input events. +Significant events include open and close braces as well as the simple +arrival of new text. +This style makes sense if one has some familiarity with continuations +\cite{appel:continuation,appel:compiling}, but for Icon programmers +it's bizarre. + + +{\bf Disclaimers}: +This program may be the worst I have ever written. +It started as a weekend hack, then took on a life of its own. +As I gradually assimilated the weirdness of writing +continuation-passing code in Icon, I came up with better and better +ways of doing things, but all the old ways are still here. +I really ought to clean things up and document them, but that would +not help me get tenure. +Please excuse the weak or absent documentation. + + + +@ +\section{Descriptions of control sequences} +\label{cs-decls} + +This section defines behavior for each control sequence we know how to +convert. +The definitions have a declarative flavor, since most are done by +procedure calls. +These calls initialize the machinery descriped in Section~\ref{cs-tables}. + +{\LaTeX} control sequences come first, using + the same organization as the quick reference card from the +second edition of the {\LaTeX} manual. +Other control sequences follow. +@ +\subsection{{\LaTeX} control sequences} +\subsubsection{Sentences and paragraphs} +<<control-sequence assignments>>= +substitution(",", " ") +substitution(" ", " ") +substitution("\n", "\n") +substitution("\t", " ") +ignore("raggedright") +ignore("@") +ignore("/") # no italic correction +substitution("", "\n") # \<newline> treated as request for newline +every c := !"$%#{}_" do + substitution(c, c) +substitution("&", "&") +argblock("emph", "em") +every argblock("footnote" | "footnotetext" | "thanks", + " <b>[</b>", "<b>]</b> ") # put footnotes in bold brackets +substitution("today", &date) +@ +\subsubsection{Type style} +<<control-sequence assignments>>= +ignore("textrm") # html can't switch to default font! +argblock("textit", "i") +argblock("textbf", "b") +argblock("textsl", "i") +ignore("textsc") +argblock("texttt", "tt") +ignore("textsf") +ignore("boldmath") +# \boldmath could be done by introducing S.mathfont, but I don't want to! +<<control-sequence assignments>>= +ignore("mathrm") # html can't switch to default font! +argblock("mathit", "i") +argblock("mathbf", "b") +argblock("mathtt", "tt") +ignore("mathsf") +argblock("mathcal", "i") +every ignore("scriptstyle"|"displaystyle"|"scriptscriptstyle") +every ignore("mathord"|"mathbin"|"mathrel") +@ HTML has only one size. +<<control-sequence assignments>>= +every ignore("tiny" | "scriptsize" | "footnotesize" | "small" | "normalsize" | + "large" | "Large" | "LARGE" | "huge" | "Huge") +@ +\subsubsection{Accents and symbols} +I've used a document from the W3~consortium to identify escapes for +symbols. +Older browsers won't support these symbols. +<<control-sequence assignments>>= +every accent(key(accent_name)) +every ignore("dag" | "ddag") +substitution("S", "§") +substitution("P", "¶") +substitution("copyright", "©") +substitution("pounds", "£") +substitution("o", "ø") +substitution("O", "Ø") +substitution("aa", "å") +substitution("AA", "Å") +substitution("ae", "æ") +substitution("AE", "&Aelig;") +@ +\subsubsection{Sectioning and table of contents} +<<control-sequence assignments>>= +argblockv("part", "h1", &null, "*[") +argblockv("chapter", "h1", &null, "*[") +argblockv("section", "h2", &null, "*[") +argblockv("subsection", "h3", &null, "*[") +argblockv("subsubsection", "h4", &null, "*[") +argblockv("paragraph", "h5", &null, "*[") +argblockv("subparagraph", "h6", &null, "*[") +ignore("appendix") +auxfile("tableofcontents", "toc", + "<p>\n<tableofcontents>\n<b>[Table of contents]</b>\n</tableofcontents>\n<p>", + "<h2>Table of Contents</h2>\n<tableofcontents>\n", "\n</tableofcontents>\n") +cstab["tableofcontents"] := Ctableofcontents # override to call set_toclevel +ignore("listoftables") +ignore("listoffigures") +ignore("addtocontents", "{{") +ignoreenv("filecontents", "{") +@ +\subsubsection{Mathematical formulas} +Here we see our first assignments to [[cstab]], which is the real +technology underlying these seemingly declarative calls. +I'll assign to [[cstab]] directly when some really special behavior is +called for. In this case, it's going in and out of math mode. +<<control-sequence assignments>>= +cstab["("] := Cmath +cstab[")"] := Cmath_end +cstab["["] := Cdisplaymath +cstab["]"] := Cdisplaymath_end +ignoreenv("equation") +every table_env(star("eqnarray"), 0, " ", "<blockquote><i>", "</i></blockquote>") + # also lame +substitution("frac", "<b>frac</b>") +substitution("sqrt", "<b>frac</b>") +every substitution("ldots" | "cdots" | "vdots", "...") +ignore("left") +ignore("right") +ignore("overline") +substitution(":", " ") +substitution(";", " ") +ignore("!") +@ The [[star]] procedure lets us define \verb+eqnarray+ and +\verb+eqnarray*+ in one fell swoop. +<<*>>= +procedure star(cs) + suspend cs | (cs || "*") +end +@ +There are a gazillion symbols. I'll add them on demand. +<<control-sequence assignments>>= +substitution("Diamond", "<>") +substitution("langle", "<") +substitution("rangle", ">") +substitution("le", "<=") +substitution("ne", "!=") +substitution("ge", ">=") +substitution("times", "×") +substitution("divide", "÷") +substitution("bmod", "</i>mod<i>") # better hook in with math +substitution("equiv", "===") +every x := "arccos" | "arcsin" | "arctan" | "arg" | "cos" | "cosh" | + "cot" | "coth" | "csc" | "deg" | "det" | "dim" | "exp" | + "gcd" | "hom" | "lim" | "liminf" | "limsup" | "ln" | "log" | + "max" | "min" | "sec" | "sin" | "sinh" | "sup" | "tan" | "tanh" +do + substitution(x, "</i>" || x || "<i>") +substitution("liminf", "</i>lim inf<i>") +substitution("limsup", "</i>lim sup<i>") +every x := "alpha" | "beta" | "gamma" | "delta" | "epsilon" | "zeta" | "eta" | + "theta" | "iota" | "kappa" | "lambda" | "nu" | "xi" | "pi" | + "rho" | "sigma" | "tau" | "upsilon" | "phi" | "chi" | "psi" | "omega" | + "in" +do + substitution(x, "<b>" || x || "</b>") +substitution("mu", "µ") +every x := "Gamma" | "Delta" | "Theta" | "Lambda" | "Xi" | "Pi" | "Sigma" | + "Upsilon" | "Phi" | "Psi" | "Omega" +do + substitution(x, "<b>" || x || "</b>") +@ +Here are some lonesome math symbols. +<<control-sequence assignments>>= +substitution("lfloor", "</i>|_<i>") +substitution("rfloor", "</i>_|<i>") +substitution("leq", "<=") +substitution("geq", ">=") +substitution("ll", "«") +substitution("gg", "»") +substitution("Rightarrow", "==>") +substitution("rightarrow", "-->") +substitution("approx", "<u>~</u>") +@ +\subsubsection{Displayed paragraphs} +HTML really has only one kind of displayed paragraph---the block quotation. +<<control-sequence assignments>>= +envblock("quote", "blockquote") +envblock("quotation", "blockquote") +envblock("center", "blockquote") +envblock("flushleft", "blockquote") +envblock("flushright", "blockquote") +envblock("verse", "blockquote") +verbatim("verbatim", escape_HTML_specials, "pre") +cstab["verb"] := Cverb +cstab["verb*"] := Cverb +csclosure["verb*"] := 1 +cstab["verbatiminput"] := Cverbatiminput +csclosure["verbatiminput"] := verbatim_cl(escape_HTML_specials) +@ \verb*+\verb* uses visible blanks+. +@ +\subsubsection{Lists} +<<control-sequence assignments>>= +cstab["item"] := Citem +csclosure["item"] := [item_cl("<li>", "", "<li>")] +listenv("itemize", "ul") +listenv("enumerate", "ol") +listenv("description", "dl") +@ +\subsubsection{Global or ignorable} +<<control-sequence assignments>>= +ignore("documentstyle", "[{") +ignore("documentclass", "[{") +ignore("usepackage", "[{") +ignore("pagestyle", "{") +ignore("thispagestyle", "{") +ignore("pagenumbering", "{") +ignore("newcounter", "{") +ignore("global") +ignore("etalchar") # used in the .bbl files: \newcommand{\etalchar}[1]{$^{#1}$} +@ +\subsubsection{Title page and abstract} +I could be clever and have \verb+\title+ have a side effect +that sticks in the right boilerplate when we see \verb+\begin{document}+, +but for now it's not worth the hassle. +<<control-sequence assignments>>= +argblockv("title", "h1") +argblockv("author","address") +argblockv("date", "b") +substitution("maketitle", "<!--title goes here-->") +ignoreenv("titlepage") +envblock("abstract", "<h2>Abstract</h2><blockquote>", "</blockquote>") +@ +\subsubsection{Cross-reference} +A more ambitious scheme would make labels anchor at preceding +sectioning commands, but it's hard to see how to do that in one pass. +Instead, I just use some conventional glyphs. +I use special procedures for the cross-references so I can have an +arrow pointing either forward or backward, depending on the direction +of the reference. +<<control-sequence assignments>>= +cstab["label"] := Clabel +cstab["ref"] := Cref +cstab["pageref"] := Cref +cstab["subpageref"] := Cref +cstab["chunklabel"] := Clabel +@ +\subsubsection{Bibliography and citation} +For the bibliography, I actually go grubbing for a {\tt .bbl} file if +I can find one. +<<control-sequence assignments>>= +ignore("bibliographystyle", "{") +auxfile("bibliography", "bbl", "<b>[BibTeX bibliography]</b>", &null, &null, "{") +envblock("thebibliography", "<h2>References</h2>", "", "{") +every cstab["cite" | "citeN" | "opencite" | "openciteN" | "citeyear"] := Ccite +cstab["bibitem"] := Cbibitem +ignore("newblock") +ignore("nocite", "{") +@ +\subsubsection{Splitting the input} +All input is ignored. Those things are in their own files. +<<control-sequence assignments>>= +every ignore("input" | "include" | "includeonly", "{") +# filecontents not done yet +@ +\subsubsection{Line breaking} +<<control-sequence assignments>>= +cstab["\\"] := Cbackback +substitution("linebreak", "<br>") +ignore("-") +ignoreenv("sloppypar") +ignore("sloppy") +@ +\subsubsection{Page breaking} +I simulate forced page breaks by horizontal rules. +<<control-sequence assignments>>= +substitution("pagebreak", "<hr>") +substitution("newpage", "<hr>") +substitution("clearpage", "<hr>") +ignore("enlargethispage", "*{") +@ +\subsubsection{Boxes} +<<control-sequence assignments>>= +ignore("mbox") +ignore("makebox", "([[") # ( comes from picture area +ignore("fbox") +ignore("framebox", "[[") # could insert horizontal rules, but why? +ignore("newsavebox", 1) +ignore("sbox", 2) +ignore("savebox", "{[[{") +ignore("usebox", 1) +envblock("minipage", "blockquote", &null, "[{") +argblock("parbox", "blockquote", &null, "[{") +@ +\subsubsection{Space} +<<control-sequence assignments>>= +ignore("hspace", "*{") +ignore("hfil") +ignore("hfill") +ignore("vspace", "*{") +ignore("vfil") +ignore("vfill") +@ +\subsubsection{Length} +<<control-sequence assignments>>= +ignore("newlength", "{") +ignore("setlength", "{{") +ignore("addtolength", "{{") +@ +\subsubsection{Pictures} +<<control-sequence assignments>>= +envblock("picture", "<b>[picture]</b>", "", "((") +ignore("put", "({") +ignore("multiput", "(({{") +ignore("dashbox", "{([") +ignore("line", "({") +ignore("vector", "({") +ignore("shortstack", "[") +ignore("circle", "*{") +ignore("oval", "([") +ignore("frame") +ignore("thinlines") +ignore("thicklines") +@ +\subsubsection{Figures and Tables} +I surround figures and tables with horizontal rules. +<<control-sequence assignments>>= +every envblock(star("figure"), "<hr>", "<hr>", "[") +every envblock(star("table"), "<hr>", "<hr>", "[") +argblock("caption", "b") # captions in bold +@ +\subsubsection{{\tt tabbing} environment} +I can't see how to do anything sensible with {\tt tabbing}. +<<control-sequence assignments>>= +envblock("tabbing", "blockquote") +# \= is accent +ignore(">") +ignore("+") +ignore("kill") +@ +\subsubsection{{\tt array} and {\tt tabular} environment} +<<control-sequence assignments>>= +tabular("array", "[") +tabular("tabular", "[") +tabular("tabularx", "{[") +tabular("tabular*", "{[") +every cstab["multicolumn"|"multispan"] := Cmulticolumn +cstab["span"] := Cspan +cstab["noalign"] := Cnoalign +cstab["hline"] := Chline +cstab["toprule"] := Chline +cstab["midrule"] := Chline +cstab["bottomrule"] := Chline +ignore("cline", "{") +ignore("newcolumntype", "{{") +@ +\subsubsection{Definitions} +<<control-sequence assignments>>= +ignore("newcommand", "A[[{") +ignore("renewcommand", "A[[{") +ignore("providecommand", "A[[{") +ignore("newenvironment", "{[{{") +ignore("renewenvironment", "{[{{") +ignore("newtheorem", "{{") +@ +\subsubsection{Numbering} +We have to have a special [[setcounter]] so we can ignore the right stuff +in the table of contents. +<<control-sequence assignments>>= +cstab["setcounter"] := Csetcounter +ignore("addtocounter", "{{") +@ +\subsubsection{Other {\LaTeX} control sequences} +<<control-sequence assignments>>= +cstab["makeatletter"] := Cmakeatletter +cstab["makeatother"] := Cmakeatother +@ +Here are all the old-style font changes. +<<control-sequence assignments>>= +every fontchange("tt" | "ttfamily", "tt") +every fontchange("bf" | "bfseries", "b") +every fontchange("it" | "itshape", "i") +fontchange("sl", "i") +fontchange("em", "em") +ignore("rm") # html can't switch to default font! +ignore("sf") +ignore("sc") +@ And some new ones +<<control-sequence assignments>>= +ignore("rmfamily") +ignore("normalfont") +<<control-sequence assignments>>= +ignoreenv("document") +<<control-sequence assignments>>= +substitution("LaTeX", "LaTeX") +<<control-sequence assignments>>= +ignore("numberline", "{") +ignore("protect") +ignore("onecolumn") +ignore("twocolumn", "C") +ignore("typeout", "[{") +ignore("closedbib") +<<control-sequence assignments>>= +every ignore("leftmargini" | "leftmarginii" | "labelsep" | "fboxsep", "=") +every ignore("tabcolsep", "=") +every ignore("evensidemargin" | "marginparsep" | "marginparwidth" | + "oddsidemargin" | "textheight" | "textwidth" | "topmargin", "=") +<<control-sequence assignments>>= +ignore("DeclareMathVersion", "{") +ignore("mathversion", "{") +ignore("setpapersize", "{") +ignore("setmarginsrb", "{{{{{{{{") +ignore("marginparwidth", "=") +ignore("marginparsep", "=") +@ +\subsection{Control sequences from various {\LaTeX} packages} +<<control-sequence assignments>>= +ignoreenv("multicols", "{C") +cstab["citeN"] := Ccite +ignore("afterpage", "{") +every cstab["psfig"|"epsfig"] := Cepsfig +cstab["includegraphics"] := Cincludegraphics +ignore("newcolumntype", "{{") +@ +A (perhaps vain) attempt to implement \verb+\kill+. +<<control-sequence assignments>>= +cstab["kill"] := Ckill +@ +\subsection{Plain {\TeX} control sequences} +<<control-sequence assignments>>= +activesubst("~", " ") +argblock("centerline", "<br>", "<br>") +substitution("cr", "<br>") +substitution("hrule", "<hr>") +substitution("vrule", "|") +substitution("hrulefill", "------") +ignore("hyphenation", "{") +ignore("hbox") +ignore("rlap") +ignore("llap") +ignore("vbox") +ignore("vtop") +ignore("hidewidth") +ignore("message", "{") +ignore("relax") +ignore("null") +ignore("offinterlineskip") +ignore("omit") +ignore("newdimen", "{") +ignore("nobreak") +<<control-sequence assignments>>= +cstab["par"] := implicit_paragraph +cstab["smallskip"] := implicit_paragraph +cstab["medskip"] := implicit_paragraph +cstab["bigskip"] := implicit_paragraph +cstab["vskip"] := implicit_paragraph +csclosure["vskip"] := "=" +@ +We can't give the grouping control sequences their real meaning, because +that would blow our brace balance when ignoring definitions and the like. +The proper solution would be to distinguish between grouping and braces, +but that would require much more sophistication than we've got just now. +<<control-sequence assignments>>= +every ignore("begingroup" | "endgroup" | "bgroup" | "egroup") +<<control-sequence assignments>>= +cstab["newif"] := Cnewif +cstab["iffalse"] := Ciffalse +cstab["iftrue"] := Ciftrue +cstab["ifhtml"] := Ciftrue # false in LaTeX, but true when converting! +cstab["else"] := Celse +cstab["fi"] := Cfi +cstab["ifx"] := cstab["if"] := cstab["ifnum"] := Ciffalse +@ +Lots of assignable things: +<<control-sequence assignments>>= +ignore("let", "A=") +every ignore("hfuzz" | "parindent" | "parskip" | "baselineskip", "=") +every ignore("hbadness" | "hsize" | "vsize" | "overfullrule" | "tabskip", "=") +every ignore("extrarowheight" | "codemargin", "=") +every ignore("looseness", "=") +substitution("hskip", " ", "=") +ignore("setbox", "{=") +every ignore("box" | "unhbox" | "unvbox", "{") +<<control-sequence assignments>>= +ignore("unskip") +ignore("hss") +ignore("phantom", "{") +every ignore("kern" | "lower" | "spacefactor", "=") # a cheat, but works +every ignore("clubpenalty" | "widowpenalty", "=") +@ +Backslashes and delimiters. +<<new l2h.nw init declarative statements>>= +substitution("backslash", "\\") +ignore("delimiter", "=") +@ +@ Other stuff to be ignored: +<<control-sequence assignments>>= +every ignore("expandafter" | "indent" | "noindent" | "leavevmode" | "strut") +ignore("def", 1) +<<control-sequence assignments>>= +substitution("TeX", "TeX") +substitution("BibTeX", "BibTeX") +substitution("MF", "METAFONT") +@ +\subsubsection{HTML support for \TeX\ [[\char]]} + +Process the numeric argument of a \TeX\ [[\char]] command that is of the form +`[[\char123]]' or `[[\char 123]]' (the [[\char]] has already been scanned, it +is no longer in the input) +and return the character with that code, which we hope will be ASCII +for reasonable implementations of Icon. +Also gobble any trailing whitespace. +<<control-sequence assignments>>= +cstab["char"] := asciiCharCode +<<*>>= +procedure asciiCharCode(S) + return emit_text(S, char(2(optwhite(), TeXnumber(), optwhite()))) +end +procedure TeXnumber() + return integer( + (="'", "8r" || tab(many(&digits))) | + (="\"", "16r" || tab(many(&digits))) | + tab(many(&digits))) +end +@ +\subsection{HTML support} +<<control-sequence assignments>>= +macro("nwanchorto", 2, "<a href=\"#$1\">#2</a>") +macro("nwanchorname", 2, "<a name=\"#$1\">#2</a>") +ignore("nwaddbox", "{") +verbatim("latexonly", do_nothing) +verbatim("rawhtml", emit_text) +@ +\subsection{Other control sequences} +Here's some stuff that might be plain {\TeX}. +<<control-sequence assignments>>= +substitution("quad", " ") +@ +I get to include my favorite {\TeX} hacks. +We define ignoring loosely; the count denotes the number of balanced-brace pairs. +We also ignore everything before an ignored balanced-brace pair, which means +it works for \verb+\def+. +<<control-sequence assignments>>= +ignore("noweboptions", 1) +@ +Now, here are a couple of righteous hacks! +The idea is that most views will ignore this stuff, but the indexer might +use it to get clever about dumping chunks and all in the right places. +<<control-sequence assignments>>= +substitution("nowebindex", "<nowebindex>") +substitution("nowebchunks", "<nowebchunks>") +ignore("nowebsize") +<<control-sequence assignments>>= +envblock("fields", "blockquote", &null, "[") # lame; could try to <tt> 1st col +envblock("fields*", "blockquote", &null, "{") # lame; could try to <tt> 1st col +ignore("citeauthoryear", "{{{") +ignore("authoryear", "{{") +substitution("bibrule", "--------") +let("bibskip", "par") +every cstab["anoncite"|"authorcite"] := Ccite +@ +This will always have to be patched by hand, but it may be worth it. +<<control-sequence assignments>>= +ignore("pssilent") +ignore("psnoisy") +@ + + +\section{The conversion engine} +\label{engine} + +The converter doesn't have the luxury of working on the whole text at +once; instead it has to accept and convert a piece at a time. +If I really understood co-expressions, I would surely make them sit up +and beg. +Since I don't, I keep some state around, and I pass continuations and +closures like there's no tomorrow. + + +@ +\subsection{Basic conversion} +Here's the basic engine, which works by string scanning. +The initial boilerplate sets up the second argument (if any) as +[[&subject]]. +The characters [[-]], [[']], and~[[`]] are special because they start +{\TeX} ligature. +We also have the odd specials [["\0"]] and [["\1"]], which are +used to delimit quoted code in noweb. +Woe betide the hapless user who has real nulls or 1s in his {\LaTeX} file. +<<*>>= +procedure convert(S, optstring) + static specials + initial { + <<initialization>> + <<control-sequence assignments>> + <<assign to dynamic-add table>> + specials := '\\{}<>-\'`"%$&~\n\0\1' + } + + if \optstring then return optstring ? convert(S) + else { + <<scan, convert, and return result>> + } +end +@ +If I were a good dog, I would make a state diagram. +Since I'm not, I'll just say that we either +accumulate text using the function [[S.text]], which exists for that +purpose, or else we do something special upon encountering a special character. + +The [[<<take actions appropriate to new text>>]] +chunk may do something special with the text in +case we're not in the default state (for example, we may be scanning +for the end of a comment). + +Encountering a non-threatening character throws the converter into +horizontal mode. +<<scan, convert, and return result>>= +<<take actions appropriate to new text>> +if S.mode == "V" & any(~'\\{}<>%\n\t ') then S.mode := "H" +emit_text(S, tab(upto(specials) | 0)) +while not pos(0) do + if S.mode == "Q" then { # quoting + emit_text(S, tab(upto('\1') | 0)) + if ="\1" then { + emit_text(S, "\1") + S.mode := S.quotemode + } + } else { + if any(S.activechars) then + do_activechar(S, move(1)) + else + case move(1) of { + "\\" : {<<control sequence>>} + "{" : {<<take open-group actions>>} + "}" : {<<take close-group actions>>} + "%" : {<<comment>>} + "\n" : {<<newline>>} + "$" : {<<dollar sign>>} + "&" : ampersand(S) + "\0" : {S.quotemode := S.mode; S.mode := "Q"; emit_text(S, "\0")} + # remaining cases simply escape HTML specials + "<" : emit_text(S, "<") + ">" : emit_text(S, ">") + "\"" : emit_text(S, """) + "-" : {<<deal with dash ligatures>>} + "`" : {<<deal with open quotes>>} + "'" : {<<deal with close quotes>>} + } + if S.mode == "V" & any(~'\\{}<>%\n\t ') then S.mode := "H" + emit_text(S, tab(upto(specials++S.activechars) | 0)) + } +return 1(. S.the_text, S.the_text := "") # what's been converted +<<deal with dash ligatures>>= +if S.mode == "V" then S.mode := "H" +if S.mode == "H" then + if ="--" then emit_text(S, "—") + else if ="-" then emit_text(S, "–") + else emit_text(S, "-") +else + emit_text(S, "-") +@ +<<*>>= +global html_quotes # render quotes as HTML 4 entities +<<deal with open quotes>>= +if S.mode == "V" then S.mode := "H" +if \html_quotes & S.mode == "H" then + if ="`" then emit_text(S, "“") + else emit_text(S, "‘") +else + emit_text(S, "`") +<<deal with close quotes>>= +if S.mode == "V" then S.mode := "H" +if \html_quotes & S.mode == "H" & ="'" then emit_text(S, "”") +else emit_text(S, "'") +@ +The definition of a converter's state is distributed. +We've already seen the use of [[mode]]. +<<*>>= +record state(mode, quotemode <<other fields of state>>) + # mode is Q, H, V, or M + # quotemode is saved mode: H, V, or M +@ +To create a new state, the default mode is vertical +<<*>>= +procedure converter(mode) + /mode := "V" + return state(mode, mode <<initial values for other fields of state>>) +end +@ +To avoid repeated memory allocation, we provide a routine to reset a +converter to its initial state. +<<*>>= +procedure reset(S) + <<code to reset [[S]]>> + return S +end +@ +The basic action performed by the +[[S.text]] function is to accumulate converted text in [[S.the_text]]. +[[S.text]] is usually [[accumulate_text]]. +<<*>>= +procedure accumulate_text(S, text) + S.the_text ||:= text + return +end +<<other fields of state>>= +, text, the_text +<<initial values for other fields of state>>= +, accumulate_text, "" +<<code to reset [[S]]>>= +S.text := accumulate_text +S.the_text := "" +@ +[[emit_text]] just uses the current value of [[S.text]], provided we aren't +currently ignoring tokens. +Its primary use is to appear in closures, when we don't know what +[[S.text]] will be when the closure is executed. +<<*>>= +procedure emit_text(S, text) + return if \S.ignoring then "" else S.text(S, text) +end +<<other fields of state>>= +, ignoring +<<initial values for other fields of state>>= +, &null +<<code to reset [[S]]>>= +S.ignoring := &null +@ +Active characters are like control sequences. +The only one active by default is the~[[~]]. +<<*>>= +global activetab, activeclosure +procedure do_activechar(S, c) + (activetab[c])(S, c, activeclosure[c]) + return +end +<<initialization>>= +activetab := table(unknown_cs) +activeclosure := table() +<<other fields of state>>= +, activechars +<<initial values for other fields of state>>= +, '~' +<<code to reset [[S]]>>= +S.activechars := '~' +@ +\subsection{Action and continuation hooks} +We provide hooks so that actions can be taken at various points. +The major ones are: +\begin{description} +\item[\tt newtext] +When the next string is passed in for conversion. +\item[open brace] +After the next open brace or begin environment. +\item[close brace] +Before the next close brace or end environment. +\end{description} +@ +\subsubsection{{\tt newtext}} +[[newtext]] is a list of closures to be executed (actions to take) + when the next input comes. +<<other fields of state>>= +, newtext +<<initial values for other fields of state>>= +, [] +<<code to reset [[S]]>>= +S.newtext := [] +@ +A closure is simply a procedure with arguments. +<<*>>= +record closure(proc, args) +@ +[[before_next_newtext]] and [[after_next_newtext]] +add to the list of actions to be taken (at the left and right, respectively). +<<*>>= +procedure before_next_newtext(S, proc, args) + push(S.newtext, closure(proc, args)) +end + +procedure after_next_newtext(S, proc, args) + put(S.newtext, closure(proc, args)) +end +@ +When taking the actions, be careful to avoid infinite loop, e.g., on empty lines. +<<take actions appropriate to new text>>= +l := S.newtext +S.newtext := [] +while c := get(l) do + c.proc!c.args +@ +Some control sequences temporarily override all actions to be taken on +a new input, using [[delay_newtext]]. + [[undelay_newtext]] restores actions. +<<*>>= +procedure delay_newtext(S) + push(S.delayed_newtext, S.newtext) + S.newtext := [] + return +end + +procedure undelay_newtext(S) + S.newtext := \pop(S.delayed_newtext) | + {write(&errout, "This can't happen: no delayed_newtext"); &null[0]} +end +<<other fields of state>>= +, delayed_newtext +<<initial values for other fields of state>>= +, [] +<<code to reset [[S]]>>= +S.delayed_newtext := [] +@ +\subsubsection{Opening and closing groups} +There's only one list of actions to be taken at the next open, +but there's a whole stack of lists of actions to be taken at closes. +<<other fields of state>>= +, open, closes +<<initial values for other fields of state>>= +, [], [] +<<code to reset [[S]]>>= +every S.open | S.closes := [] +<<*>>= +procedure after_next_open(S, proc, args) + return put(S.open, closure(proc, args)) +end + +procedure before_next_close(S, proc, args) + return push(S.closes[1], closure(proc, args)) # lost at top level +end + +procedure after_next_close(S, proc, args) + return put(S.closes[1], closure(proc, args)) # lost at top level +end +<<take open-group actions>>= +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +<<take close-group actions>>= +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +<<old>>= +procedure Cbegingroup(S, cs, cl) + <<take open-group actions>> +end +<<old>>= +procedure Cendgroup(S, cs, cl) + <<take close-group actions>> +end +<<old control-sequence assignments>>= +cstab["begingroup"] := Cbegingroup +cstab["endgroup"] := Cendgroup +cstab["bgroup"] := Cbegingroup +cstab["egroup"] := Cendgroup +@ +\subsection{Handling control sequences and environments} +OK, to eat a control sequence, first scan it, then execute it using [[do_cs]]. +[[S.csletters]] records the current set of ``letters'' for control +sequences (so we can interpret \verb+\makeatletter+). +<<control sequence>>= +cs := if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1) +if /S.ignoring | cs == ("else"|"fi") | cstab[cs] === (Ciffalse|Ciftrue) then + do_cs(S, cs) +else + &null # error("### Ignoring \\", cs) +<<other fields of state>>= +, csletters +<<initial values for other fields of state>>= +, &letters +<<code to reset [[S]]>>= +S.csletters := &letters +@ +To execute a control sequence, look up its procedure in [[cstab]], +and pass in the name of the control sequence, plus the closure +argument from [[csclosure]]. +\label{cs-tables} +<<*>>= +global cstab, csclosure + +procedure do_cs(S, cs) + tab(many(' \t')) # skip white space following CS + if pos(0) | any('\n') then before_next_newtext(S, skipblanks, [S]) + (cstab[cs])(S, cs, csclosure[cs]) + return +end +<<initialization>>= +cstab := table(unknown_cs) +csclosure := table() +@ +The default action for an unknown control sequence is [[unknown_cs]]. +If the global [[show_unknowns]] is set we dump the control sequence into the +output in bold. We save the unknown sequences for later warning messages. +<<*>>= +global show_unknowns +procedure unknown_cs(S, cs, cl) +# if S.text === ignore_text then return # a bit of a hack -- should no longer be needed + if \show_unknowns then S.text(S, "<b>\\" || cs || "</b>") + if not member(unknown_set, cs) then { + write(\unknown_file, "Warning: unknown control sequence \\", cs) + insert(unknown_set, cs) + } + return +end +<<initialization>>= +unknown_set := set() +<<*>>= +global cstab, csclosure, unknown_set +@ +The control sequences \verb+\begin+ and \verb+\end+ are treated +specially, +so we can have a similar machinery for environments. +<<*>>= +global begintab, endtab, begincl, endcl + +procedure do_begin(S, cs, cl) + (="{", env := tab(upto('}')), ="}") | error("botched \\begin{...}") + <<take open-group actions>> + (begintab[env])(S, env, begincl[env]) + return +end + +procedure do_end(S, cs, cl) + (="{", env := tab(upto('}')), ="}") | error("botched \\end{...}") + # write(&errout, "calling ", image(endtab[env]), " for \\end{", env, "}") + (endtab[env])(S, env, endcl[env]) + <<take close-group actions>> + return +end +<<control-sequence assignments>>= +cstab["begin"] := do_begin +cstab["end"] := do_end +<<initialization>>= +every begintab | endtab := table(unknown_env) +every begincl | endcl := table() +<<*>>= +procedure unknown_env(S, env, cl) +### if S.text === ignore_text then return # a bit of a hack # no longer needed + if \show_unknowns then S.text(S, "<b>{" || env || "}</b>") + if not member(unknown_envs, env) then { + write(\unknown_file, "Warning: unknown environment {", env, "}") + insert(unknown_envs, env) + } + return +end +<<initialization>>= +unknown_envs := set() +<<*>>= +global unknown_envs +@ +\subsection{Issuing warnings about unknown control sequences and environments} +<<*>>= +procedure warn_unknown(s, type, mark, rmark) + if *s > 0 then { + pushout("Unknown " || type || ": ") + every pushout(((\mark | "")\1) || !sort(s) || ((\rmark | "")\1) || " ") + pushout("\n") + } +end +<<*>>= +procedure pushout(s) + static col + initial col := 0 + if find("\n", s) then + s ? { + pushout(tab(upto('\n'))) + while ="\n" do {col := 0; write(&errout)} + pushout(tab(0)) + } + else { + col +:= *s + if col >= 79 then {writes(&errout, "\n "); col := *s + 2} + writes(&errout, s) + } + return +end +@ +\subsection{Procedures related to parsing {\TeX}} +\subsubsection{Comment-skipping} +This logic gobbles text into [[S.comment]] +until a newline is encountered, at which point it calls +[[Ccomment]] to format the comment. +All other new-text actions go on hold until the comment is over. +<<comment>>= +parse_dynamic_add(S) +delay_newtext(S) +eat_comment(S) +<<*>>= +procedure eat_comment(S) + S.comment ||:= tab(upto('\n') | 0) + if pos(0) then + before_next_newtext(S, eat_comment, [S]) + else { + undelay_newtext(S) + Ccomment(S) + S.comment := "" + } + return +end +<<other fields of state>>= +, comment +<<initial values for other fields of state>>= +, "" +<<code to reset [[S]]>>= +S.comment := "" +@ +Verbatim text is a little bit like comment text---we keep swallowing +under special rules until we find a terminator. +There are at least three classes of rules: +\begin{itemize} +\item +Copy text, but escape the HTML specials. +This corresponds to an ordinary {\LaTeX} \texttt{verbatim} +environment. +\item +Copy text while changing nothing. +This correspondes to a \texttt{rawhtml} environment. +\item +Throw everything on the floor. +This corresponds to a \texttt{latexonly} environment. +\end{itemize} +We store an output method, a string that terminates the environment, +and possibly tag for an HTML wrapper around the environment. +<<*>>= +record verbatim_cl(output, terminator, html, translate_blank) + +procedure verbatim(name, output, html) + begintab[name] := Cverbatim + begincl [name] := verbatim_cl(output, &null, html) + return +end + +procedure Cverbatim(S, cs, cl) + if cl === begincl[cs] & /cl.terminator then + cl := begincl[cs] := + verbatim_cl(cl.output, "\\end{" || cs || "}", cl.html, cl.translate_blank) + emit_text(S, tag(\cl.html)) + delay_newtext(S) + do_verbatim(S, cl) + return +end +@ +If we find the terminator, we're finished. +Otherwise, we swallow the whole input and make sure our action on next +input is to continue scanning. +<<*>>= +procedure do_verbatim(S, cl) + if cl.output(S, tab(find(cl.terminator)), cl) then { + =cl.terminator + emit_text(S, endtag(\cl.html)) + undelay_newtext(S) + } else { + cl.output(S, tab(0), cl) + before_next_newtext(S, do_verbatim, [S, cl]) + } + return +end +@ +When writing verbatim text, we still have to convert HTML specials. +<<*>>= +procedure escape_HTML_specials(S, s, cl) + s ? { + while emit_text(S, tab(upto('&<>" '))) do + case move(1) of { + "\"" : emit_text(S, """) + "&" : emit_text(S, "&") + "<" : emit_text(S, "<") + ">" : emit_text(S, ">") + " " : emit_text(S, if \cl.translate_blank then "·" else " ") + } + emit_text(S, tab(0)) + } + return +end +@ +The \verb+\verb+ control sequence's terminator is the first character +following \verb+\verb+. +<<*>>= +procedure Cverb(S, cs, cl) + Cverbatim(S, cs, verbatim_cl(escape_HTML_specials, move(1), "tt", cl)) + return +end +@ +<<*>>= +procedure Cverbatiminput(S, cs, cl) + local filename, f, line + if ="{" & filename := tab(upto('}')) & ="}" then { + f := \open(filename) | { emit_text(S, "<strong>Could not read file</strong> <tt>") + escape_HTML_specials(S, filename, cl) + emit_text(S, "</tt>") + return + } + emit_text(S, "\n<pre>\n") + while line := read(f) do { + escape_HTML_specials(S, line, cl) + emit_text(S, "\n") + } + emit_text(S, "</pre>\n") + close(f) + } + return +end +@ +\subsubsection{Arguments} +It's occasionally necessary to collect the argument of a control +sequence. +[[csarg]] does the job. +<<*>>= +procedure csarg(S) + return 2(="{", tab(bal('}', '{', '}')), ="}") | + (optwhite(), + if ="\\" then + "\\" || (tab(many(S.csletters)) | move(1)) + else + move(1)) +end +@ +[[csarg()]] works only if the whole +argument is in the same line; otherwise it only returns the opening curly +brace, `[[{]]'. Another problem with [[csarg()]] is that it does not cope with +[[%]] or [[\]] in the input (due to the use of the Icon function [[bal()]] to +balance curly brackets), as such a escaped or commented out curly brace is +handled incorrectly. + +The solution provided here is not trivial. The problem is that if we have +`[[\foo{bar]]' in a line and the `[[baz}]]' is in another line then due to the +way how l2h works the Icon command associated with [[foo]] will have to +terminate before the `[[baz}]]' gets read, and as such cannot do anything +useful except register a callback to finish the job. + +@ + +[[apply_arg(S, cl)]] scans an argument (preceded by optional +whitespace), then invokes the closure on that argument. +Its use should subsume [[csarg]], but that may take a while yet. +<<*>>= +@ +[[apply_args(S, p, as, n]] scans [[n]] arguments from the +input, puts them in a list [[args]], then calls [[p!(as ||| args)]]. +This is a bit weak, because we really want to turn off comment +skipping for some arguments. +N.B. the arguments are \emph{not} converted. +<<*>>= +procedure apply_args(S, p, as, args_wanted) + delay_newtext(S) + do_apply_args(S, closure(p, as), args_wanted, [], "", 0) + return +end + +procedure do_apply_args(S, cl, wanted_count, args_seen, current_arg, brace_depth) + local open_comment + # invariant : we have an open brace +# pushtrace("APPLY") + while *args_seen < wanted_count & not pos(0) do { + while *args_seen < wanted_count & brace_depth = 0 & not pos(0) do { + tab(many(' \t\n')) + case c := move(1) of { + "\\" : put(args_seen, "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1)) + "{" : { current_arg := "" ; brace_depth := 1 } + "}" : { error("Insufficient arguments to macro ", macro.name) } + "%" : if tab(upto('\n')) then ="\n" else open_comment := tab(0) + default : put(args_seen, c) + } + } + while brace_depth > 0 & not pos(0) do { + current_arg ||:= tab(upto('\\{}%') | 0) + case move(1) of { + "%" : if tab(upto('\n')) then ="\n" else open_comment := tab(0) + "\\" : current_arg ||:= "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1) + "{" : { current_arg ||:= "{" ; brace_depth +:= 1 } + "}" : { brace_depth -:= 1 + if brace_depth > 0 then + current_arg ||:= "}" + else { + put(args_seen, current_arg) + current_arg := "" + } + } + } + } + } + if *args_seen = wanted_count then { + undelay_newtext(S) + cl.proc ! (cl.args ||| args_seen) + } else if \open_comment then { + delay_newtext(S) + before_next_newtext(S, skip_comment_and_continue, + [S, closure(do_apply_args, [S, cl, wanted_count, args_seen, + current_arg, brace_depth])]) + } else + before_next_newtext(S, do_apply_args, [S, cl, wanted_count, args_seen, + current_arg, brace_depth]) +# poptrace() + return +end +<<*>>= +procedure skip_comment_and_continue(S, cl) + tab(upto('\n') | 0) + if pos(0) then + before_next_newtext(S, skip_comment_and_continue, [S, cl]) + else { + ="\n" + undelay_newtext(S) +# <take actions appropriate to new text>> + } + return +end +@ +\subsubsection{Misc specials} +Ampersands are covered in the table section (\ref{tabular}). +@ +The dollar sign is for entering and exiting math mode: +<<dollar sign>>= +if /S.ignoring then + if ="$" then + if S.mode == "M" then { Cdisplaymath_end(S); S.mode := "V" } + else { Cdisplaymath(S); S.mode := "M" } + else + if S.mode == "M" then { Cmath_end(S); S.mode := "H" } + else { Cmath(S); S.mode := "M" } +@ +Newlines emit themselves, plus start skipping blanks until they get to +some nonblank text. +We have to identify a blank line so we can insert a paragraph marker. +<<newline>>= +emit_text(S, "\n") +if /S.ignoring then Cnewline(S) +<<*>>= +procedure Cnewline(S) + tab(many(' \t')) + if match("\n") then implicit_paragraph(S) + if pos(0) then before_next_newtext(S, Cnewline, [S]) +end +@ +Other procedures might want to skip white space, which includes +newlines, but we don't want to miss a paragraph. +<<*>>= +procedure skipblanks(S) + tab(many(' \t')) + if ="\n" then Cnewline(S) + else if pos(0) then before_next_newtext(S, skipblanks, [S]) +end +@ +Paragraphs count only in horizontal or math mode (and they better not +happen in math mode!). +<<*>>= +procedure implicit_paragraph(S, cs, cl) + if S.mode ~== "V" then { + S.mode := "V" + Cparagraph(S) + } + cs_ignore(S, cs, \cl) +end +@ +Here's a real hack. I use it to stop skipping blanks when the noweb +filter sees text quoted by [[[[...]]]]. +That text is never converted, but we don't want to skip blanks that +follow it. +<<*>>= +procedure stop_skipping(S) + while S.newtext[1].proc === (Cnewline|skipblanks) do pop(S.newtext) +end +@ +\subsubsection{Items} +For items, we actually want to do something with the optional arguments, +namely, convert them. +We wrap them in braces so that any font changes and so on will be +appropriately limited in their effects. +<<*>>= +record item_cl(before, after, ifnone) + +procedure Citem(S, cs, cl) + if pos(0) then + after_next_newtext(S, Citem, [S, cs, cl]) + else if ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", convert_bracketed, cl) + } else { + skipblanks(S) + emit_text(S, cl[1].ifnone) + \liststack[1] := \liststack[1] + 1 + } +end +<<*>>= +procedure convert_bracketed(S, contents, cl) + emit_text(S, cl[1].before || + convert(converter("H"), "{" || contents || "}") || + cl[1].after) + optwhite() +end +<<*>>= +global liststack, suspendstack +<<initialization>>= +liststack := [] +# write(&errout, "Initialized liststack") +suspendstack := [] +<<control-sequence assignments>>= +cstab["suspend"] := Csuspend +cstab["resume"] := Cresume +<<*>>= +procedure listenv(env, html) + begintab[env] := Clist + begincl[env] := html + endtab[env] := Clist_end + endcl[env] := html +end + +procedure push_item_closure(cs) + push(csclosure["item"], + if cs == "description" then item_cl("<dt>", "<dd>", "<dt><dd>") + else item_cl("<li>", "--", "<li>")) +end + +procedure Clist(S, cs, cl) + push(liststack, 1) + push_item_closure(cs) + emit_text(S, tag(cl)) +end + +procedure Cresume(S, cs, cl) + local n, env + (="{", env := tab(upto('}')), ="}") | error("botched \\resume{...}") + n := pop(suspendstack) | error("\\resume not balanced by corresponding \\suspend") + push(liststack, n) + push_item_closure(env) + if env == "enumerate" then + emit_text(S, tag(begincl[env] || " start=\"" || n || "\"")) + else + emit_text(S, tag(begincl[env])) +end + +procedure Clist_end(S, cs, cl) + emit_text(S, endtag(cl)) + pop(csclosure["item"]) + pop(liststack) +end + +procedure Csuspend(S, cs, cl) + local env + (="{", env := tab(upto('}')), ="}") | error("botched \\suspend{...}") + emit_text(S, endtag(endcl[env])) + pop(csclosure["item"]) + push(suspendstack, pop(liststack)) +end +@ +\subsubsection{Labels and references} +These could be done by [[argblock]], except I want to make it possible to have +different text depending on whether the references point forward or backward. +<<*>>= +global labels_seen + +procedure Clabel(S, cs, cl) + initial /labels_seen := set() + insert(labels_seen, l := csarg(S)) | fail + emit_text(S, "<a name=\"" || l || "\"><b>[*]</b></a>") +end + +procedure Cref(S, cs, cl) + local prefix, prefix_tag + initial /labels_seen := set() + prefix_tag := (\cl)[1] | "" + prefix := (\cl)[2] | "" + l := prefix || csarg(S) | fail + emit_text(S, prefix_tag || "<a href=\"#" || l || "\">[" || + (if member(labels_seen, l) then "<-" else "->") || "]</a>") +end +@ +\subsubsection{Citations} +The important thing about a citation key is that it makes a hot line +to the appropriate item in the bibliography. +[[Ccite]] and [[Cbibitem]] work together to make it happen. + +Optional arg might contain blanks, so it might be split, but + I assume the citation key isn't split between inputs. +<<*>>= +procedure Ccite(S, cs, cl, bracketed_text) + if ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", do_cite, cl) + } else + do_cite(S, &null, cl) +end + +procedure do_cite(S, commentary, cl) + local key + if \commentary then + optwhite() + if pos(0) then before_next_newtext(S, do_cite, [S, commentary, cl]) + else { + key := csarg(S) + \commentary := convert(converter("H"), "{" || \commentary || "}") + emit_text(S, "<b>[cite ") + key ? { + while k := tab(upto(",")) & ="," do + emit_text(S, "<a href=\"#NWcite-" || k || "\">" || k || "</a>, ") + if k := tab(0) then + emit_text(S, "<a href=\"#NWcite-" || k || "\">" || k || "</a>") + } + emit_text(S, ", <i>" || \commentary || "</i>") + emit_text(S, "]</b>") + } +end +<<*>>= +procedure Cbibitem(S, cs, cl) + local label, key + static counter + initial counter := 0 + if ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", finish_bibitem, []) + } else { + label := "<b>[" || (counter +:= 1) || "]</b>" + apply_args(S, do_bibitem_key, [S, label], 1) + } +end + +procedure do_bibitem_key(S, label, key) + return emit_text(S, "<a name=\"NWcite-" || key || "\">" || label || "</a> ") +end + +procedure finish_bibitem(S, contents, args) + local key, label + optwhite() + label := convert(converter("H"), "{" || contents || "}") + key := apply_args(S, do_bibitem_key, [S, label], 1) +end +@ +\subsubsection{Conditionals} +The idea here is that an \verb+\if+$\cdots$ control sequence will conditionally +ignore text, and that \verb+\fi+ restores the previous state. +To keep track of state, we have an ``if stack'' that records what +[[S.text]] should be upon encountering \verb+\else+ and \verb+\fi+. +<<other fields of state>>= +, ifstack +<<initial values for other fields of state>>= +, [] +<<code to reset [[S]]>>= +if *S.ifstack > 0 then S.ifstack := [] # keeps GC down +@ +What's on the ifstack is +<<*>>= +record ifrec(on_else, on_fi) +@ It's possible that one day this code will need to be updated to delay +new-text actions (and to do God knows what if +new-text actions have already been delayed). +@ +Every \verb+\if+$\cdots$ is equivalent either to \verb+\iffalse+ +of \verb+\iftrue+, so we begin by defining those, as well as \verb+\else+ +and \verb+\fi+ +<<*>>= +procedure Ciffalse(S, cs, cl) +#error("### \\", cs, " -> false (S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}, ")") + push(S.ifstack, ifrec(S.ignoring, S.ignoring)) + S.ignoring := 1 +end + +procedure Ciftrue(S, cs, cl) +#error("### \\", cs, " -> true (S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}, ")") + push(S.ifstack, ifrec(1, S.ignoring)) +end + +procedure Celse(S, cs, cl) + S.ignoring := S.ifstack[1].on_else +#error("### \\else -> S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}) +end + +procedure Cfi(S, cs, cl) + S.ignoring := S.ifstack[1].on_fi +#error("### \\fi -> S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}) + pop(S.ifstack) +end +@ +Now, all that's left is to handle \verb+\newif+. +This part is all boilerplate. +<<*>>= +procedure Cnewif(S, cs, cl) + local newif, newcs + tab(many(' \t\n')) + if pos(0) then + after_next_newtext(S, Cnewif, [S, cs, cl]) + else { + newif := csarg(S) + newif ? + if ="\\if" & newcs := tab(many(S.csletters)) & pos(0) then { + <<make [[newcs]] a new \verb+\if+-like thing>> + } else + error("\\newif argument botch: " || newif) + } +end +@ +And here we do the real work: +<<make [[newcs]] a new \verb+\if+-like thing>>= +cstab[newcs || "false"] := Csetif +cstab[newcs || "true"] := Csetif +cstab["if" || newcs] := Ciffalse +<<*>>= +procedure Csetif(S, cs, cl) + local base, tag + if cs ? (base := tab(find("true"|"false")), tag := =("true"|"false"), pos(0)) then { + cstab["if" || base] := if tag == "true" then Ciftrue else Ciffalse + } else { + error("This can't happen --- setif botch (not urgent)") + } +end +@ +\subsection{Upper case} + +This is a very simple implementation of [[\uppercase]]: it requires to +have all of its argument immediately. +<<*>>= +procedure Cuppercase(S, cs, cl) + l := map(csarg(S), &lcase, &ucase) | fail + emit_text(S, l) +end +<<control-sequence assignments>>= +cstab["uppercase"] := Cuppercase +@ +\subsection{HTML support for array and tabular environments} +We handle tables by using [[S.text]] to implement a little state machine. +There are only two states: waiting to start a new cell, and the +ordinary state of converting text. + +The rest of the state information is held in a list of [[table_info]] +records that tell us what to expect for the next cell. +<<*>>= +record table_info(index, # number of this cell in the row + alignment, # the alignment of this cell + width, # how many columns this cell will span + alignments, # default alignments for this table + brace_depth, # size of S.closes after start of cell + cell_text) # value of S.text to use to scan this cell +@ This state could conceivably be extended to include pre- and +post-content for each cell, \`a la plain {\TeX}'s [[\halign]] or the +{\LaTeX} [[<{}]] and [[>{}]] directives, but for now I won't bother. + +I should probably also add a [[rows_taken]] field and use it to +implement [[multirow]] support. +@ +Here's a stack that keeps track of all currently active tabular environments. +<<other fields of state>>= +, tables +<<initial values for other fields of state>>= +, [] +<<code to reset [[S]]>>= +S.tables := [] +@ +Accumulating text forces the transition between states. +While I'm at it, I update the state for the next cell. +<<*>>= +procedure start_table_cell(S, text) + local this, attributes + + text ? { + tab(many(' \t\n')) + if pos(0) then return + } +# write(&errout, "starting cell with ", image(text)) + + this := S.tables[1] | fatal("starting cell with no current table") + S.text := this.cell_text + +if /(\this).brace_depth then write(&errout, "starting table cell, ", image(this), " has null brace depth") + # use this to start the current cell + if this.index = 1 then emit_text(S, "<tr>") + attributes := \this.alignment | aligneq("top") + if this.width > 1 then attributes ||:= " colspan=" || this.width + emit_text(S, "<td" || attributes || ">") + + # now update state for the next cell + this.index +:= this.width # advance to next cell + this.alignment := this.alignments[this.index] | &null + this.width := 1 + # can't set cell_text until we hit & + + <<take open-group actions>> + emit_text(S, text) + return +end +@ +Hitting an ampersand closes and opens groups, and it advances to the +next cell. +<<*>>= +procedure ampersand(S) + local this + this := S.tables[1] + <<take close-group actions>> + if /this then + emit_text(S, " --- ") + else { + emit_text(S, "") # be sure cell gets started, even if empty + emit_text(S, "</td>") + if S.text ~=== start_table_cell then + this.cell_text := S.text + S.text := start_table_cell + this.brace_depth := *S.closes + 1 # will open at start of cell +#write(&errout, "set brace depth for ", image(this)) + } + tab(many(' \t\n')) +## write(&errout, " past &, text = ", image(S.text), ", next = ", +## image(&subject[&pos:0])) + return +end +@ +The double backslash is the end of a row, unless it's buried in braces +or there's no table. +We have to be careful about ignoring a square bracket, because if the +[[\\]] is at the end of a line, we won't know until we see the newline +that it's not a bracket, and we don't see the newline until we get the +next text. +We therefore must use a continuation-passing style for this ignore. +<<*>>= +procedure Cbackback(S, cs, cl) + local this + this := S.tables[1] + cs_ignore(S, cs, "[", Cbackback_continue, [S, this]) +end + +procedure Cbackback_continue(S, this) +#if /(\this).brace_depth then write(&errout, image(this), " has null brace depth") + if /this | *S.closes > this.brace_depth then { # ordinary \\ + S.text(S, "<br>") + } else { # row terminator +## write(&errout, "ending row with ", image(&subject[&pos:0])) + emit_text(S, "") # be sure cell gets started, even if empty + <<take close-group actions>> + emit_text(S, "</td></tr>\n") + tab(many(' \t\n')) + if S.text ~=== start_table_cell then + this.cell_text := S.text + this.index := 1 + this.alignment := this.alignments[this.index] | &null + this.width := 1 + S.text := start_table_cell + this.brace_depth := *S.closes + 1 # about to open + } +end +@ +A horizontal line disappears if it's in a table. +<<*>>= +procedure Chline(S, cs, cl) + if \S.tables[1] then return + else emit_text(S, "<hr>") + return +end +@ +An [[\end{tabular}]] terminates the whole affair. +If we're at the beginning of a row, things are easy. +Otherwise, we terminate the current row first. +<<*>>= +procedure Ctabular_end(S, cs, cl) + local this + if S.text ~=== start_table_cell | S.tables[1].index > 1 then {# row in progress + emit_text(S, "") # be sure cell gets started, even if empty + <<take close-group actions>> + emit_text(S, "</td></tr>") + } + if S.text === start_table_cell then # abort it + S.text := S.tables[1].cell_text + emit_text(S, "</table>") + xxx := pop(S.tables) +#write(&errout, "popped ", image(xxx)) + return +end +@ +Finally, the setup of the table itself: +<<*>>= +procedure Ctabular(S, cs, cl) + cs_ignore(S, cs, cl, Ctabular_continue, [S]) + return +end + +procedure Ctabular_continue(S) + a := csarg() # alignment +#write(&errout, "Alignment ", a) + emit_text(S, if upto('|', a) then "<table border>" else "<table>") + emit_text(S, "<!-- alignment is " || a || "-->") + a := alignments(a) + emit_text(S, "<!-- " || *a || " columns-->") + push(S.tables, table_info(1, a[1] | "l", 1, a, *S.closes+1, S.text)) +#write(&errout, "pushed ", image(S.tables[1])) + S.text := start_table_cell + optwhite() + return +end +@ Earlier, the initial value of [[S.tables[1].brace_depth]] was +[[&null]], but when we had alignment of \verb+{c}+, it was never +getting set, so I'm setting it on startup, even though I'm not sure if +that's really right. +<<*>>= +procedure tabular(env, ignore) + begintab[env] := Ctabular + begincl[env] := ignore + endtab[env] := Ctabular_end + endcl[env] := ignore +end +@ +We figure alignments using the tricks in the {\LaTeX} book. +<<*>>= +procedure aligneq(a) + return " align=\"" || a || "\"" +end + +procedure valigneq(a) + return " valign=\"" || a || "\"" +end + +procedure alignments(s) + a := [] + s ? { + while not pos(0) do + case move(1) of { + "l" | "X" | "Y" | "p" : + { put(a, aligneq("left") || valigneq("top")); skip_bracket() } + "c" : put(a, aligneq("center")) + "r" : put(a, aligneq("right")) + "m" : { put(a, aligneq("left") || valigneq("center")); skip_bracket() } + "b" : { put(a, aligneq("left") || valigneq("bottom")); skip_bracket() } + "@" | "<" | ">" | "!" : skip_bracket() + "|" : &null + default : &null # unrecognized... + } + } + return a +end +<<*>>= +procedure skip_bracket() + if ="{" then { + n := 1 + while n > 0 & not pos(0) do { + tab(upto('{}\\') | 0) + case move(1) of { + "{" : n +:= 1 + "}" : n -:= 1 + "\\" : move(1) + } + } + } + return +end +@ +[[\multicolumn]] changes the width and alignment of the current cell. +[[\multispan]] changes only the width. +<<*>>= +procedure Cmulticolumn(S, cs, cl) + local this + this := S.tables[1] + n := integer(csarg()) | error("\\multicolumn or \\multispan not followed by integer") + if cs == "multicolumn" then a := alignments(csarg()) +# write(&errout, "\\", cs, " n = ", n, ", a = ", (\a)[1] | "???", +# ", text = ", image(S.text)) + if /this then return # \multicolumn without table? + this.width := n + this.alignment := (\a)[1] + return +end + +procedure Cspan(S, cs, cl) + (\S.tables[1]).width +:= 1 + return +end +@ +<<*>>= +procedure Cnoalign(S, cs, cl) + apply_args(S, finish_noalign, [S], 1) + return +end + +procedure finish_noalign(S, arg) + return if \S.ignoring then "" else + accumulate_text(S, "<br>" || convert(converter("V"), "{" || arg || "}") || "<br>") +end +@ +\subsection{Reading and converting auxiliary {\LaTeX} files} +<<*>>= +procedure auxfile(cs, ext, placeholder, header, trailer, ignore) + cstab[cs] := Cauxfile + csclosure[cs] := aux_cl(ext, placeholder, header, trailer, \ignore | "") +end +@ +[[Cauxfile]] succeeds if it finds a file, fails otherwise. +<<*>>= +record aux_cl(ext, placeholder, header, trailer, ignore) + +procedure Cauxfile(S, cs, cl) + local auxfile, T + if auxfile := open(basename(\curfile) || "." || cl.ext) then { + T := converter("V") + Cmakeatletter(T) + S.text(S, \cl.header) + while line := read(auxfile) do + S.text(S, convert(T, line || "\n")) + close(auxfile) + S.text(S, \cl.trailer) + } else { + S.text(S, \cl.placeholder) + } + cs_ignore(S, cs, cl.ignore) + if \auxfile then return +end +<<*>>= +procedure basename(name) + reverse(name) ? { + tab(upto('.')) & ="." + return reverse(tab(0)) + } +end +@ +\subsubsection{Table of contents} +We can build a table of contents by reading the .toc file. +Sadly, I haven't figured out how to get hot links yet. +<<control-sequence assignments>>= +cstab["contentsline"] := Ccontentsline +<<*>>= +procedure Ctableofcontents(S, cs, cl) + S.mode := "V" + Cauxfile(S, cs, cl) + set_toclevel(S) +end +@ +[[set_toclevel]] manages the starting and ending of lists. +With no level argument, it resets the toc to the initial level. +<<*>>= +procedure set_toclevel(S, l) + static toclevel, initiallevel + if /initiallevel := \l then + S.text(S, "<ul compact>") + if /l := \initiallevel then + S.text(S, "</ul>") + if /l then return # never set a level + /toclevel := l + while toclevel < l do { + S.text(S, "<ul compact>") + toclevel +:= 1 + } + while toclevel > l do { + S.text(S, "</ul>") + toclevel -:= 1 + } + return +end +@ +Assume one table of contents per converted document. +<<*>>= +procedure Ccontentsline(S, cs, cl) + local type, level + static leveltab + initial { <<assign numbers of sections in leveltab>> } + l := \leveltab[csarg()] | fail + if l > \countertab["tocdepth"] then + cs_ignore(S, cs, "{{") # skip this one + else { + set_toclevel(S, l) + S.text(S, "<li>") + after_next_open(S, after_next_close, [S, cs_ignore, [S, cs, "{"]]) + } +end +<<assign numbers of sections in leveltab>>= +l := ["part", "chapter", "section", "subsection", "subsubsection", + "paragraph", "subparagraph"] +leveltab := table() +every i := 1 to *l do + leveltab[l[i]] := i - 2 # making section level 1 +@ +\subsubsection{Counters} +<<*>>= +global countertab + +procedure Csetcounter(S, cs, cl) + local counter + (counter := csarg(), countertab[counter] := integer(csarg())) | + cs_ignore(S, cs, "{{") +end +<<initialization>>= +countertab := table() +@ +\subsubsection{Accents} +This info is taken from the HTML RFC, section entitled +``ISO Latin~1 character entities.'' +<<*>>= +global accent_name, accent_valid +<<initialization>>= +accent_name := table() +accent_valid := table('') +accent_name ["`"] := "grave" +accent_valid["`"] := 'AEIOUaeiou' +accent_name ["'"] := "acute" +accent_valid["'"] := 'AEIOUYaeiouy' +accent_name ["^"] := "circ" +accent_valid["^"] := 'AEIOUaeiou' +accent_name ["hat"] := "circ" +accent_valid["hat"] := 'AEIOUaeiou' +accent_name ["\""] := "uml" +accent_valid["\""] := 'AEIOUaeiouy' +accent_name ["~"] := "tilde" +accent_valid["~"] := 'ANOano' +accent_name ["="] := "bar" +accent_name ["."] := "dot" +accent_name ["u"] := "u" +accent_name ["v"] := "v" +accent_name ["H"] := "H" +accent_name ["t"] := "t" +accent_name ["c"] := "cedil" +accent_valid["c"] := 'Cc' +accent_name ["d"] := "underdot" +accent_name ["b"] := "underbar" +@ +Initialization calls [[accent]] to indicate that a control +sequence represents an accent. +In fact, [[accent]] is called on all keys of [[accent_name]]. +<<*>>= +procedure accent(cs) + cstab[cs] := Caccent +end + +procedure Caccent(S, cs, cl) + static warned + initial warned := table() + arg := csarg(S) | return + if arg == "\\i" then arg := "i" + if arg == "\\j" then arg := "j" + if *arg = 1 & any(accent_valid[cs], arg) then + S.text(S, "&" || arg || accent_name[cs] || ";") + else { + <<warn about [[cs]] with [[arg]]>> + S.text(S, arg) + } +end +<<warn about [[cs]] with [[arg]]>>= +/warned[cs] := set() +if not member(warned[cs], arg) then { + write(&errout, "Warning: Can't handle \\", cs, " with arg `", arg, "'") + insert(warned[cs], arg) +} +@ +\subsection{Font changes} +A font change changes the font until the next close, when we need to emit +the appropriate end tag. +<<*>>= +procedure fontchange(tex, html) + cstab[tex] := Cfontchange + csclosure[tex] := html +end +<<*>>= +procedure Cfontchange(S, tex, html) + S.text(S, tag(html)) + before_next_close(S, emit_text, [S, endtag(html)]) +end +@ +\section{Implementations of declaratives} +\label{imp-decl} + +\subsection{Ignoring stuff} +There are several different kinds of things that can be ignored: +ordinary arguments, +balanced-brace arguments, optional arguments, assignments (which may +include dimensions), stars, and parenthesized coordinates. +We ignore a sequence of these things by supplying a template to +[[ignore]], in which each character stands for something to be ignored. +We've already seen examples of these things in Section~\ref{cs-decls}. + +We can ignore arguments of control sequences or environments. +In either case, [[cs_ignore]] does the work. +<<*>>= +procedure ignore(cs, template) + /template := "" + cstab[cs] := cs_ignore + csclosure[cs] := template +end + +procedure ignoreenv(env, template) + /template := "" + begintab[env] := cs_ignore + begincl[env] := template + endtab[env] := do_nothing +end +@ +Because ignoring may span many inputs, all [[cs_ignore]] does is set things +up to call [[do_ignore]]. +The major setup is replacing [[S.text]] with a function that does nothing. +Oh, and it converts an integer template +into that many arguments, for historical reasons. +<<*>>= +procedure cs_ignore(S, cs, template, proc, args) + local saved_ignore + saved_ignore := S.ignoring + S.ignoring := 1 + if type(template) == "integer" then template := repl("{", template) + return do_ignore(S, template, saved_ignore, proc, args) +end +@ +Some things are easily ignored (partly because we assume they don't +span inputs). For others, we have special procedures. +The brace-ignoring stuff uses the open and close hooks, because braces +can be nested deeply. +If non-null, [[proc]] is applied to [[args]] after everything is ignored. +<<*>>= +procedure do_ignore(S, template, saved_ignore, proc, args) + if *template > 0 then + if optwhite() & pos(0) then + after_next_newtext(S, do_ignore, [S, template, saved_ignore, proc, args]) + else + case template[1] of { + "{" : { S.ignoring := 1 + after_next_open(S, ignore_til_close, + [S, template[2:0], saved_ignore, proc, args]) + } + "A" : { csarg(S) # had better be in one input + do_ignore(S, template[2:0], saved_ignore, proc, args) + } + "[" : if optwhite() & ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", ignore_bracket_plus, + [S, template[2:0], saved_ignore, proc, args]) + } else + do_ignore(S, template[2:0], saved_ignore, proc, args) + "C" : # a total cheat, means ``copy optional arg'' + if optwhite() & ="[" then { + S.ignoring := &null + delay_newtext(S) + with_upto_bracket(S, "", copy_bracket_plus, + [S, template[2:0], saved_ignore, proc, args]) + } else + do_ignore(S, template[2:0], saved_ignore, proc, args) + "=" : { delay_newtext(S) + eat_assignment(S, do_ignore, [S, template[2:0], saved_ignore, proc,args]) + } + "*" : { (="*", optwhite()) + do_ignore(S, template[2:0], saved_ignore, proc, args) + } + "(" : { (="(", tab(upto(')')), =")", optwhite()) + do_ignore(S, template[2:0], saved_ignore, proc, args) + } + } + else { + S.ignoring := saved_ignore + (\proc)!(\args) + } +end + +procedure ignore_til_close(S, template, saved_ignore, proc, args) + before_next_close(S, do_ignore, [S, template, saved_ignore, proc, args]) +end +@ +Finally, at the end of an ignored environment, do nothing. +<<*>>= +procedure do_nothing(S, cs, cl) + return +end +@ +\subsubsection{Parsing bracketed (optional) arguments} +We may have to deal with optional arguments that are split across lines. +We pass in a continuation for the bracket. +This is a lot like gobbling to a newline, which we had to do with a comment. +As in the other case, we do something stupid if the bracket is +protected (e.g. by a backslash or comment char). +<<*>>= +procedure with_upto_bracket(S, bracketed_text, proc, args) + bracketed_text ||:= tab(upto(']') | 0) + if pos(0) then + before_next_newtext(S, with_upto_bracket, [S, bracketed_text, proc, args]) + else { + ="]" + undelay_newtext(S) + (\proc)(S, bracketed_text, args) + } + return +end +@ +To ignore brackets: +<<*>>= +procedure ignore_bracket_plus(S, contents, args) + # contents are ignored + do_ignore!args +end +@ and to copy them +<<*>>= +procedure copy_bracket_plus(S, contents, args) + local should_ignore + should_ignore := args[3] | fail # saved_ignore arg to do_ignore + if /should_ignore then + S.text(S, convert(converter("H"), "{" || contents || "}")) + do_ignore!args +end +@ +\subsubsection{Ignoring assignments} +Assignments are tricky because they might involve numbers, control +sequences, dimensions, or even glue. +We approximate the syntax from page 275 in the \TeX book. +<<*>>= +procedure eat_assignment(S, proc, args) + static decimal_chars, hex_chars, oct_chars + initial { + decimal_chars := &digits ++ '.,+-' + hex_chars := &digits ++ 'abcdefABCDEF' + oct_chars := '0124567' + } + optwhite() + ="=" # so what if we swallow multiple = signs + optwhite() + if pos(0) then { + before_next_newtext(S, eat_assignment, [S, proc, args]) + return + } else if glue() then { # finished + } else if any(decimal_chars) then { + tab(many(decimal_chars)) + optwhite() + if ="\\" then + tab(many(S.csletters)) | move(1) + # else assume assignment of the form \hangafter=2 + } else if ="\"" then { + tab(many(hex_chars)) & optwhite() + } else if ="\'" then { + tab(many(oct_chars)) & optwhite() + } else if =("\\"|"`\\") then + tab(many(S.csletters)) | move(1) + undelay_newtext(S) + (\proc)!args +end +<<*>>= +procedure dimen() + static decimal_chars + initial decimal_chars := &digits ++ '.,' + suspend (optwhite(), + if any('+-') then (move(1), optwhite()) else "", + tab(many(decimal_chars)), optwhite(), + (="true", optwhite()) | &null, + =("em"|"ex"|"pt"|"pc"|"in"|"bp"|"cm"|"mm"|"dd"|"cc"|"sp"|"mu")) +end +<<*>>= +procedure glue() + suspend (dimen(), + (optwhite(), ="plus", dimen()) | "", + (optwhite(), ="minus", dimen()) | "") +end +@ +\subsection{Substitution} + +\subsubsection{Simple substitution for a single control sequence} + +Even simple substitution isn't so simple, because in addition to the +HTML that we substitute for the {\TeX}, we can also supply a template +of stuff to be ignored (like the optional argument to \verb+\\+). +<<*>>= +procedure substitution(tex, html, ignore_template) + # ignore mode for now + cstab[tex] := Cemit_ig + csclosure[tex] := emit_ig_cl(html, \ignore_template | "") +end +@ +The closure contains HTML to be written and a template to be ignored. +<<*>>= +record emit_ig_cl(html, template) + +procedure Cemit_ig(S, cs, cl) + emit_text(S, cl.html) + if *cl.template > 0 then + cs_ignore(S, cs, cl.template) +end +@ +\subsubsection{Substitution for active characters} +<<*>>= +procedure activesubst(char, html, ignore_template) + local S + # ignore mode for now + activetab[char] := Cemit_ig + activeclosure[char] := emit_ig_cl(html, \ignore_template | "") + S := \dynamic_add_hack | return + if upto(S.activechars, char) then return # already active + if S.activechars ++:= cset(char) then { + before_next_close(S, delete_active_char, [S, char]) + } else impossible("ugh") + return +end + +procedure delete_active_char(S, char) + S.activechars --:= char + return +end +@ +\subsubsection{Substitution for environments} +The [[envblock]] procedure has two forms: +\begin{itemize} +\item +{}[[envblock(]]{\it environment}, {\it tag}[[)]] simply uses +begin- and end-{\it tag} in place of the environment. +\item +{}[[envblock(]]{\it environment}, {\it left}, {\it right}, {\it +ignore}[[)]] +puts the {\it left} text at the beginning of the environment, the {\it +right} text at the end, plus at the beginning of the environment it +ignores the arguments described by {\it ignore}. +\end{itemize} +It's easier to implement than to describe. +<<*>>= +procedure envblock(env, left, right, ignore_template) + /ignore_template := "" + begintab[env] := Cemit_ig + begincl[env] := emit_ig_cl(if /right then tag(left) else left, ignore_template) + endtab[env] := Cemit + endcl[env] := if /right then endtag(left) else right +end +@ [[Cemit]] emits text with nothing to ignore. +<<*>>= +procedure Cemit(S, cs, cl) + S.text(S, cl) +end +@ +\subsubsection{Substitution around arguments of control sequences} +These substitutions place tags at the beginning and end of arguments +to control sequences, instead of surrounding the contents of an +environment. +For example, they specify how to convert [[\section{...}]] to +[[<h1>...</h1>]] and so forth. +The calling convention is as for [[envblock]]. +<<*>>= +record blockpair(left, right, ignore) + +procedure argblock(tex, html, right, ignore) + # called as is envblock + /ignore := "" + cstab[tex] := Cblock + csclosure[tex] := + if /right then blockpair (tag(html), endtag(html), ignore) + else blockpair (html, right, ignore) +end +@ There is a fine point; control sequences labelled with [[argblockv]] +should put the converter into vertical mode. +<<*>>= +procedure argblockv(tex, html, right, ignore) + argblock(tex, html, right, ignore) + cstab[tex] := CblockV +end +<<*>>= +procedure Cblock(S, cs, cl, done_ignoring) + if /done_ignoring & *cl.ignore > 0 then { + cs_ignore(S, cs, cl.ignore, Cblock, [S, cs, cl, 1]) + } else if pos(0) then { + after_next_newtext(S, do_cs, [S, cs, cl]) + } else if match("{") then { + S.text(S, cl.left) + after_next_open(S, before_next_close, [S, emit_text, [S, cl.right]]) + } else { +# S.text(S, cl.left || csarg(S) || cl.right) + apply_args(S, Cblock_continue, [S, cl], 1) + } + return +end + +procedure Cblock_continue(S, cl, title) + S.text (S, cl.left || title || cl.right) + return +end +<<*>>= +procedure CblockV(S, cs, cl) + S.mode := "V" + Cblock(S, cs, cl) + return +end +@ +\subsubsection{Macro substitution} +I'm taking the plunge and describing a ghastly macro language. +Macros have arguments, a body, and an optional terminal mode. +The final mode, if non-null, is the mode to which the conversion +engine should be set. +<<*>>= +record macro_defn(name, arg_count, body, mode) +@ The body is a list of items, where an item may be a raw argument, a +converted argument, or a string. +<<*>>= +record raw_arg(number) +record converted_arg(number, mode) +@ +<<*>>= +procedure expand_macro(S, macro, args) + every a := !macro.body do + case type(a) of { + "string" : emit_text(S, a) + "raw_arg" : emit_text(S, args[a.number]) | impossible("missing arg") + "converted_arg" : S.text(S, convert(S, "{" || args[a.number] || "}")) + } +# poptrace() + return +end +#link pushtrace +@ +Scan arguments and hope comments in arguments just work out. Ha ha. +<<*>>= +procedure do_macro(S, macro, args_seen, current_arg, brace_depth) + # invariant : we have an open brace +# write(&errout, "scanning args for macro ", macro.name) +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count) + while *args_seen < macro.arg_count & not pos(0) do { + while *args_seen < macro.arg_count & brace_depth = 0 & not pos(0) do { +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count, +# " current ", image(current_arg), " braces ", brace_depth) + tab(many(' \t\n')) + case c := move(1) of { + "\\" : put(args_seen, "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1)) + "{" : { current_arg := "" ; brace_depth := 1 } + "}" : { error("Insufficient arguments to macro ", macro.name) } + default : put(args_seen, c) + } + } + while brace_depth > 0 & not pos(0) do { +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count, +# " current ", image(current_arg), " braces ", brace_depth) + current_arg ||:= tab(upto('\\{}') | 0) + case move(1) of { + "\\" : current_arg ||:= "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1) + "{" : { current_arg ||:= "{" ; brace_depth +:= 1 } + "}" : { brace_depth -:= 1 + if brace_depth > 0 then + current_arg ||:= "}" + else { + put(args_seen, current_arg) + current_arg := "" + } + } + } + } + } +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count, +# " current ", image(current_arg), " braces ", brace_depth) + if *args_seen = macro.arg_count then { +# write(&errout, "Arguments for macro ", macro.name, ":") +# every write(&errout, "\t", image(!args_seen)) + expand_macro(S, macro, args_seen) + undelay_newtext(S) + } else + before_next_newtext(S, do_macro, [S, macro, args_seen, current_arg, brace_depth]) + return +end +@ +<<*>>= +procedure Cmacro(S, cs, cl) +# pushtrace("MACRO") + delay_newtext(S) +# apply_args(S, closure(expand_macro, [cl]), cl.arg_count) + do_macro(S, cl, [], "", 0) + return +end +@ +Now, a {\TeX}-like macro facility in which [[#]] is used for converted +parameters and [[#$]] for raw ones. +<<*>>= +procedure macro(name, arg_count, body, mode) + m := macro_defn(name, arg_count, parse_body(body), mode) + cstab[name] := Cmacro + csclosure[name] := m + return +end + +procedure begin_macro(env, arg_count, body, mode) + m := macro_defn(env, arg_count, parse_body(body), mode) + begintab[env] := Cmacro + begincl[env] := m + return +end + +procedure parse_body(body) + b := [] + body ? { + put(b, tab(upto('#') | 0)) + while ="#" do { + put(b, ="#" | (="$", raw_arg(argnum())) | converted_arg(argnum())) | + error("malformed macro arg #", tab(0)) + put(b, tab(upto('#') | 0)) + } + } + return b +end + +procedure argnum() + if any(&digits) then return integer(move(1)) else fail +end +@ +And the dynamic version\ldots +<<*>>= +procedure l2h_macro(name, count, body[]) + count := integer(count) | + return error("must give # of arguments to l2h macro ", name) + s := "" + every s ||:= " " || (1(b := !body, type(b) == "string")) + s := s[2:0] # strip leading space if any + return macro(name, count, s) +end +@ +<<*>>= +procedure l2h_environment(env, count, body[]) + count := integer(count) | + return error("must give # of arguments to l2h environment ", env) + s := "" + every s ||:= " " || (1(b := !body, type(b) == "string")) + s := s[2:0] # strip leading space if any + return begin_macro(env, count, s) +end +@ +\subsection{Table environments} +For tables, we not only have an HTML tag, we also supply some text +for the ampersand. +[[args]] is a template describing the arguments to the environment, +which are ignored. +<<*>>= +record table_closure(args, amp, open, close) + +procedure table_env(env, args, amp, open, close) + begintab[env] := Ctable + begincl[env] := table_closure(args, amp, + if /close then tag(\open) | &null else open, + if /close then endtag(\open) | &null else close) + endtab[env] := Ctable_end + endcl[env] := [] +end +<<*>>= +procedure Ctable(S, env, cl) + local amp +## amp := S.ampersand +## S.ampersand := cl.amp + S.text(S, \cl.open) + push(endcl[env], amp) + cs_ignore(S, env, cl.args) +end + +procedure Ctable_end(S, env, cl) +# S.ampersand := pop(cl) + S.text(S, \begincl[env].close) +end +@ +\subsection{Postscript} +<<*>>= +procedure Cepsfig(S, cs, cl) + apply_args(S, do_epsfig, [S], 1) +end + +procedure do_epsfig(S, arg) + local args + args := [] + arg ? + while not pos(0) do { + tab(many(' \t\n')) + put(args, eqsplit(tab(upto(',') | 0))) + } + if a := !args & a.name == ("file"|"figure") then + emit_text(S, "<a href=" || image(a.value) || "><b>[</b>PostScript figure " || + a.value || "<b>]</b></a>") + else + emit_text(S, "<b>[</b>Ill-understood PostScript figure<b>]</b>") +end + +record apair(name, value) + +procedure eqsplit(s) + p := apair() + s ? (p.name := tab(upto('=')), ="=", p.value := tab(0)) + return p +end +@ +<<*>>= +procedure Cincludegraphics(S, cs, cl) + local saved_ignore + saved_ignore := S.ignoring + S.ignoring := 1 + do_ignore(S, "[", saved_ignore, apply_args, [S, do_includegraphics, [S], 1]) +end + +procedure do_includegraphics(S, arg) + local base, ext + if arg ? (base := tab(find(ext := ".ps" | ".eps" | ".epsi")), =ext, pos(0)) then + emit_text(S, "<a href=" || image(arg) || "><b>[</b>PostScript figure " || + arg || "<b>]</b></a>") + else if arg ? (base := tab(find(ext := ".png" | ".gif" | ".jpg")), =ext, pos(0)) then + emit_text(S, "<img src=" || image(arg) || ">") + else + emit_text(S, "<b>[</b>Ill-understood graphics<b>]</b>") +end +@ +\subsection{Control-sequence assignment} +This procedure is available to be used for dynamic assignment. +One day we might use it to parse \verb+\let+ as well. +<<*>>= +procedure let(lhs, rhs) + cstab[lhs] := cstab[rhs] + csclosure[lhs] := csclosure[rhs] +end + +procedure let_closure(lhs, cl[]) + csclosure[lhs] := if *cl = 1 then cl[1] else cl +end + +procedure letenv(lhs, rhs) + begintab[lhs] := begintab[rhs] + endtab[lhs] := endtab[rhs] + begincl[lhs] := begincl[rhs] + endcl[lhs] := endcl[rhs] +end +@ +\section{HTML formatting} +\label{html-format} + +First, generic procedures used to create beginning and ending tags. +<<*>>= +procedure tag(html) + return "<" || html || ">" +end + +procedure endtag(html) + return "</" || html || ">" +end +@ +Next, a gazillion formatting procedures. +<<*>>= +procedure Ccomment(S) + if *S.comment > 0 then { + S.text(S, "<!--") + S.comment ? { + while S.text(S, tab(find("--"))) do { + move(2) + S.text(S, "- - ") + } + S.text(S, tab(0)) + } + S.text(S, "-->") + } + S.comment := "" + return +end +<<*>>= +procedure Cparagraph(S) + S.text(S, "<p>") +end +<<*>>= +procedure Cmath(S) + <<take open-group actions>> + S.text(S, "<i>") +end + +procedure Cmath_end(S) + S.text(S, "</i>") + <<take close-group actions>> +end +<<*>>= +procedure Cdisplaymath(S) + <<take open-group actions>> + S.text(S, "<blockquote><i>") +end + +procedure Cdisplaymath_end(S) + S.text(S, "</i></blockquote>") + <<take close-group actions>> +end +<<*>>= +procedure Cmakeatletter(S) + S.csletters ++:= '@' +end + +procedure Cmakeatother(S) + S.csletters --:= '@' +end +@ +Approximate \verb+\kill+ by eliminating text. +<<*>>= +procedure Ckill(S, cs, cl) + S.the_text := "" +end +@ +\section{Support for adding control sequences dynamically} + +The idea is to use formal comments of the form: +\begin{quote} +\verb+% l2h function arg arg ...+ +\end{quote} +These comments have the same effect as the procedure calls in +the chunk [[<<control-sequence assignments>>]]. +@ +Our first step is to create a table with the names of the functions we +recognize. +Ordinarly this table would be distributed, but I created it after the +fact with a little quick Unix pipeline. +<<*>>= +global csfunctions +<<initialization>>= +csfunctions := table() +<<assign to dynamic-add table>>= +csfunctions["argblock"] := argblock +csfunctions["argblockv"] := argblockv +csfunctions["envblock"] := envblock +csfunctions["fontchange"] := fontchange +csfunctions["ignore"] := ignore +csfunctions["ignoreenv"] := ignoreenv +csfunctions["let"] := let +csfunctions["letenv"] := letenv +csfunctions["listenv"] := listenv +csfunctions["substitution"] := substitution +csfunctions["activesubst"] := activesubst +csfunctions["closure"] := let_closure +csfunctions["let_closure"] := let_closure +csfunctions["newcommand"] := l2h_macro +csfunctions["macro"] := l2h_macro +csfunctions["environment"] := l2h_environment +csfunctions["tabular"] := tabular +@ +Now, the tough issue is how to parse arguments. I'm going to try the +following initial strategy: arguments are separated by spaces. +To put a space within an argument, use \verb+#+. There is no way to +put a \verb+#+ within an argument. +<<*>>= +global dynamic_add_hack +procedure parse_dynamic_add(S) + if (optwhite(), =("l2h"|"sl2h"), skipwhite(), + p := tab(upto(' \t')), <<make [[p]] a good function or warn and [[fail]]>>, + skipwhite(), any(~'\n')) then { + a := [] + while (any(~'\n'), l := tab(upto(' \t\n') | 0)) do { + put(a, if p === (l2h_macro|l2h_environment) then l else map(l, "#", " ")) + skipwhite() + } + dynamic_add_hack := S + p!a + dynamic_add_hack := &null + return + } +end +<<make [[p]] a good function or warn and [[fail]]>>= +((p := \csfunctions[p]) | +{ dynamic_warn(p); fail }) +<<*>>= +procedure dynamic_warn(p) + static badprocs + initial badprocs := set() + if not member(badprocs, p) then { + write(&errout, "Warning: % l2h ", p, " not recognized -- ignored") + insert(badprocs, p) + } +end +@ +\section{Miscellanous utilities} +[[optwhite]] skips and returns optional white space. +<<*>>= +procedure optwhite() + suspend tab(many(' \t')) | "" +end +@ [[skipwhite]] insists that there must be some white space. +<<*>>= +procedure skipwhite() + suspend tab(many(' \t')) +end +@ +\section{Main program for a noweb filter} +First, this is how we use the converter as a noweb filter. +<<l2h.icn>>= +<<*>> +procedure main(args) + local line + errstatus := 0 + every arg := !args do + case arg of { + "-show-unknowns" : show_unknowns := 1 + "-html-quotes" : html_quotes := 1 + default : fatal("unknown arg ", image(arg)) + } + while line := read() do + apply(filter, line) + warn_unknown(\unknown_set, "control sequences", "\\") + warn_unknown(\unknown_envs, "environments", "{", "}") + if errstatus > 0 then + write("@fatal l2h Error occurred in l2h conversion") + exit(errstatus) +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +@ +This is noweb filter machinery. I really ought to coordinate quoted text +with the converter (so it always shows up in the right place), +but so far I'm too lazy. +<<l2h.icn>>= +global curfile, curline + +procedure filter(name, arg) + static S, code + initial S := converter("V") +### write(" mode ", S.mode) + case name of { + "begin" : {<<out>>; if match("code ", arg) then code := 1} + "end" : {if match("docs ", arg) then <<possible paragraph>> + <<out>>; code := &null; S.mode := "V"} + "quote" : { outtext("\0" ? convert(S)) } + "endquote" : { outtext("\1" ? convert(S)) } + "file" : {<<out>>; curfile := arg; curline := 1} + "line" : {<<out>>; curline := integer(arg)} + "defn" : { write("@", name, " ", convert_use_or_def(arg)) } + "use" : { write("@", name, " ", convert_use_or_def(arg)) } + "text" : {if \code then <<out>> else outtext(arg ? convert(S)) } + "nl" : {if \code then <<out>> else outtext("\n" ? convert(S)); curline +:= 1} + "fatal" : {<<out>>; exit(1)} + default : {<<out>>} + } + return +end +<<possible paragraph>>= +if S.mode ~== "V" then write("@text <p>") +@ A special function is needed to implement {\tt noweb}'s quoting +convention within chunk names. +<<l2h.icn>>= +procedure convert_use_or_def(s) + r := "" + s ? { + while r ||:= quickconv(tab(find("[["))) do { + (r ||:= ="[[") | fatal("impossible missing [[") + (r ||:= tab(find("]]")) || tab(many(']'))) | + fatal("impossible missing ]] in ", image(s)) + } + return r || quickconv(tab(0)) + } +end + +procedure quickconv(s) + static C + initial C := converter("H") + return 1(("{" || s || "}" ? convert(C)), reset(C)) +end +<<out>>= +write("@", name, (" " || \arg) | "") +<<l2h.icn>>= +procedure outtext(s) + s ? + while not pos(0) do + if ="\n" then write("@nl") + else if ="\0" then write("@quote") + else if ="\1" then write("@endquote") + else write("@text ", tab(upto('\n\0\1') | 0)) + return +end +<<*>>= +global errstatus +procedure error(args[]) + errstatus := 1 + return write!([&errout, (\curfile || ":") | "line ", curline, ": "] ||| args) +end +@ +\section{Main program for a simple converter} +<<sl2h.icn>>= +<<*>> +global curfile, curline + +procedure convert_file(f) + static S + initial S := converter("V") + curline := 0 + while line := read(f) do { + curline +:= 1 + writes(convert(S, line || "\n")) + } + return +end + +procedure main(args) + local warn + warn := 1 + errstatus := 0 + every arg := !args do + if arg[1] == "-" then + case arg of { + "-show-unknowns" : show_unknowns := 1 + "-nowarn" : warn := &null + "-html-quotes" : html_quotes := 1 + "-" : { curfile := arg; convert_file(&input) } + default : write(&errout, "Warning: unrecognized option ", arg) + } + else if f := open(curfile <- arg) then + convert_file(f) + else + write(&errout, "Error: Can't open file ", arg) + if /curfile then + convert_file(&input) + if \warn then { + warn_unknown(\unknown_set, "control sequences", "\\") + warn_unknown(\unknown_envs, "environments", "{", "}") + } + exit(errstatus) +end +@ +<<*>>= +procedure fatal(L[]) + write!(["@fatal l2h "] ||| L) + write!([&errout, "noweb error in l2h: "] ||| L) + exit(1) +end +@ +<<*>>= +procedure rcsinfo () + return "$Id: l2h.nw,v 1.24 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ +\section{Chunks} +\nowebchunks + +\begin{multicols}{2}[\section{Index}] +\nowebindex +\end{multicols} +@ +\end{document} diff --git a/web/noweb/src/icon/lrtldefs.icn b/web/noweb/src/icon/lrtldefs.icn new file mode 100644 index 0000000000..6faec732b7 --- /dev/null +++ b/web/noweb/src/icon/lrtldefs.icn @@ -0,0 +1,99 @@ +#line 3 "lrtldefs.nw" +procedure main(args) + go() +end +#line 7 "lrtldefs.nw" +procedure postpass(name, arg) + static kind, definers + initial { kind := "bogus" + definers := ["fun", "val", "structure", "signature", + "type", "rtlop"] + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if =(""|" "|" ") & =!definers & tab(many(' ')) then { + skiptyvars(); optwhite() + if ="[" then + while define_id() + else + define_id() + } + } + return +end + +procedure define_id() + static id1, id2, reserved + initial { id1 := &letters ++ &digits ++ '\'_' + id2 := '!%&$+-/:<=>?@\\~^|#*`' + reserved := set() + every insert(reserved, !"*|:=#_" | "->" | "=>") + } + optwhite() + if id := tab(many(id1 | id2)) then { + member(reserved, id) | writedefn(id) + return id + } + fail +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure skiptyvars() + suspend =("'"|"#") || tab(many(&letters ++ &digits ++ '\'_')) | + ="(" || bal(')', '(', ')') || =")" +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end +#line 55 "lrtldefs.nw" +procedure rcsinfo () + return "$Id: lrtldefs.nw,v 1.17 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/lrtldefs.nw b/web/noweb/src/icon/lrtldefs.nw new file mode 100644 index 0000000000..a928f761ff --- /dev/null +++ b/web/noweb/src/icon/lrtldefs.nw @@ -0,0 +1,60 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +\section{Finding definitions in $\lambda$-RTL} +<<*>>= +procedure main(args) + go() +end +<<*>>= +procedure postpass(name, arg) + static kind, definers + initial { kind := "bogus" + definers := ["fun", "val", "structure", "signature", + "type", "rtlop"] + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if =(""|" "|" ") & =!definers & tab(many(' ')) then { + skiptyvars(); optwhite() + if ="[" then + while define_id() + else + define_id() + } + } + return +end + +procedure define_id() + static id1, id2, reserved + initial { id1 := &letters ++ &digits ++ '\'_' + id2 := '!%&$+-/:<=>?@\\~^|#*`' + reserved := set() + every insert(reserved, !"*|:=#_" | "->" | "=>") + } + optwhite() + if id := tab(many(id1 | id2)) then { + member(reserved, id) | writedefn(id) + return id + } + fail +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure skiptyvars() + suspend =("'"|"#") || tab(many(&letters ++ &digits ++ '\'_')) | + ="(" || bal(')', '(', ')') || =")" +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end +<<*>>= +procedure rcsinfo () + return "$Id: lrtldefs.nw,v 1.17 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/mmixdefs.icn b/web/noweb/src/icon/mmixdefs.icn new file mode 100644 index 0000000000..cd9bf7ffca --- /dev/null +++ b/web/noweb/src/icon/mmixdefs.icn @@ -0,0 +1,71 @@ +#line 3 "mmixdefs.nw" +procedure main(args) + go() +end +#line 7 "mmixdefs.nw" +global idchars +procedure postpass(name, arg) + static kind, lets + initial { idchars := &letters ++ &digits ++ '_:' + lets := &letters ++ '_' + kind := "bogus" + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if (any(lets), t := tab(many(idchars)), any('\t ')) then + writedefn(t) + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end +#line 27 "mmixdefs.nw" +procedure rcsinfo () + return "$Id: mmixdefs.nw,v 1.15 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/mmixdefs.nw b/web/noweb/src/icon/mmixdefs.nw new file mode 100644 index 0000000000..abb7ceda31 --- /dev/null +++ b/web/noweb/src/icon/mmixdefs.nw @@ -0,0 +1,32 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +\section{Finding definitions in MMIX} +<<*>>= +procedure main(args) + go() +end +<<*>>= +global idchars +procedure postpass(name, arg) + static kind, lets + initial { idchars := &letters ++ &digits ++ '_:' + lets := &letters ++ '_' + kind := "bogus" + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if (any(lets), t := tab(many(idchars)), any('\t ')) then + writedefn(t) + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end +<<*>>= +procedure rcsinfo () + return "$Id: mmixdefs.nw,v 1.15 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/noidx.icn b/web/noweb/src/icon/noidx.icn new file mode 100644 index 0000000000..3a829eaa9c --- /dev/null +++ b/web/noweb/src/icon/noidx.icn @@ -0,0 +1,465 @@ +#line 9 "noidx.nw" +global lines # all the input lines +global delay # non-null if markup should be delayed past the first chunk +global anchordist # max distance before code chunk to place defining @xref label + +procedure main(args) + lines := [] + +#line 38 "noidx.nw" +curfile := "standard input?" +lastbeginarg := "never any chunks?" +#line 50 "noidx.nw" +every allchunks | allidents := set() +every indexlabels | defanchors | uses | anchorlabel | indexanchorlabel := table() +#line 284 "noidx.nw" +every chunkud | indexud := table(); +#line 16 "noidx.nw" + delay := &null + +#line 28 "noidx.nw" +while case(a := get(args)) of { + "-delay" : delay := 1 + "-docanchor" : anchordist := integer(get(args)) + default : fatal("unknown argument ", image(a)) +} +#line 18 "noidx.nw" + while put(lines, line := read()) do + apply(pass1, line) + every apply(pass2, !lines) + +#line 340 "noidx.nw" +(if /wrote_trailers then { + wrote_trailers := 1 + write("@nl") + write("@nl") + lognowebchunks() + lognowebindex() +} else &null) +#line 22 "noidx.nw" +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 35 "noidx.nw" +global curfile # unique id of the current @file +global lastbeginarg # identifies last chunk (for -delay) +#line 47 "noidx.nw" +global allchunks, allidents +global indexlabels, defanchors, uses, anchorlabel, indexanchorlabel +#line 57 "noidx.nw" +procedure pass1(name, arg) + static lastdefnlabel, thisusecount, lastanchorlabel, nonblank, textnonblank + initial nonblank := ~' \t' + case name of { + "file" : curfile := uniqueid(arg) + "begin" : { lastbeginarg := arg; textnonblank := &null } + "end" : if match("docs ", arg) & \anchordist & \textnonblank then + { +#line 116 "noidx.nw" +t := []; n := anchordist +lastanchorlabel := newdocslabel() +while lines[-1] ? + if n = 0 | ="@begin docs" then + { put(lines, "@xref label " || lastanchorlabel); lines |||:= t; break } + else + { if ="@nl" & pos(0) then n -:= 1; push(t, pull(lines)) } +#line 64 "noidx.nw" + } + else + lastanchorlabel := &null + "text" : /textnonblank := upto(nonblank, arg) + "defn" : { + insert(allchunks, arg) + slipin("@xref label " || (lastdefnlabel := newdefnlabel(arg))) + /lastanchorlabel := lastdefnlabel + /anchorlabel[arg] := lastanchorlabel + addlabel(defanchors, arg, lastanchorlabel) + addud(chunkud, "defn", arg, lastanchorlabel) + thisusecount := 0 + } + "use" : + if match ("code ", lastbeginarg) then { + insert(allchunks, arg) + slipin("@xref label " || lastdefnlabel || "-u" || (thisusecount +:= 1)) + addlabel(uses, arg, lastanchorlabel) + addud(chunkud, "use", arg, lastanchorlabel) + } else { + /textnonblank := upto(nonblank, arg) # could appear in quoted code + } + "index" : { + +#line 234 "noidx.nw" +{ arg ? { name := tab(upto(' ')|0); arg := if =" " then tab(0) else &null } } +#line 88 "noidx.nw" + case name of { + "use" : { insert(allidents, arg) + addud(indexud, "use", arg, \lastanchorlabel) + } + "defn" | "localdefn" : { + insert(allidents, arg) + (l := \lastanchorlabel) | + slipin("@xref label " || (l := newdocslabel())) + addud(indexud, "defn", arg, l) + /indexanchorlabel[arg] := l + slipin("@xref ref " || l) # bug fix + } + } + } + } + return +end +#line 127 "noidx.nw" +procedure slipin(s) + local last + last := pull(lines) + every put(lines, s | last) + return s +end +#line 134 "noidx.nw" +procedure pass2(name, arg) + static thesedefns, theseuses + static thischunk # null for docs chunk, arg of @defn for code chunk + static defout # number of definitions emitted for each chunk + initial defout := table(0) + case name of { + "begin" : { + if \delay & lastbeginarg == arg then +#line 340 "noidx.nw" +(if /wrote_trailers then { + wrote_trailers := 1 + write("@nl") + write("@nl") + lognowebchunks() + lognowebindex() +} else &null) +#line 142 "noidx.nw" + +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 143 "noidx.nw" + every thesedefns | theseuses := set() + thischunk := &null + } + "defn" : { thischunk := arg; + write("@xref ref " || anchorlabel[arg]) + +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 148 "noidx.nw" + + +#line 195 "noidx.nw" +defout[thischunk] +:= 1 +write("@xref prevdef ", defanchors[thischunk][defout[thischunk] - 1]) # fail if first +write("@xref nextdef ", defanchors[thischunk][defout[thischunk] + 1]) # faif if last +if defout[thischunk] = 1 then { +#line 221 "noidx.nw" +if *defanchors[thischunk] > 1 then { + write("@xref begindefs") + every write("@xref defitem ", defanchors[thischunk][2 to *defanchors[thischunk]]) + write("@xref enddefs") +} +if \uses[thischunk] then { + write("@xref beginuses") + every write("@xref useitem ", !uses[thischunk]) + write("@xref enduses") +} else + write("@xref notused ", thischunk) +#line 198 "noidx.nw" + } +#line 150 "noidx.nw" + } +# must postpone index cross-reference to end of chunk because +# the info is accumulated in [[thesdefns]] and [[theseuses]] on this pass + "end" : { if match("code", arg) then { +#line 200 "noidx.nw" +theseuses --:= thesedefns +if *thesedefns > 0 then { + write("@index begindefs") + every i := !alphasort(thesedefns) do { + every u := !\indexud[i] do u ? if ="use " then write("@index isused ", tab(0)) + write("@index defitem ", i) + } + write("@index enddefs") +} +if *theseuses > 0 then { + l := alphasort(theseuses) + write("@index beginuses") + every i := !alphasort(theseuses) do { + every d := !\indexud[i] do d ? if ="defn " then write("@index isdefined ", tab(0)) + write("@index useitem ", i) + } + write("@index enduses") +} +# every write("@literal \\nwindexuse{", TeXliteral(ident := !l), "}", +# "{", indexlabels[ident], "}{", thislabel, "}") +#line 153 "noidx.nw" + } + +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 154 "noidx.nw" + + } + "use" : { write("@xref ref " || (\anchorlabel[arg] | "nw@notdef")) # was "???" + +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 157 "noidx.nw" + + } + "index" : { + +#line 234 "noidx.nw" +{ arg ? { name := tab(upto(' ')|0); arg := if =" " then tab(0) else &null } } +#line 161 "noidx.nw" + case name of { + "defn" | "localdefn" : { + insert(thesedefns, arg) + # no xref ref because of bug fix + } + "use" : { insert(theseuses, arg) + write("@xref ref ", \indexanchorlabel[arg]) + } + } + name := "index " || name + +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 172 "noidx.nw" + } + "text" : # grotesque hack! for chunks and index in HTML + if /thischunk then # docs mode + case arg of { + "<nowebchunks>" : lognowebchunks() + "<nowebindex>" : lognowebindex() + default : +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 179 "noidx.nw" + } + else +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 181 "noidx.nw" + "fatal" : { +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 181 "noidx.nw" + ; exit(1) } + "trailer" : { +#line 340 "noidx.nw" +(if /wrote_trailers then { + wrote_trailers := 1 + write("@nl") + write("@nl") + lognowebchunks() + lognowebindex() +} else &null) +#line 183 "noidx.nw" + +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 184 "noidx.nw" + } + default : +#line 236 "noidx.nw" +write("@", name, (" " || \arg) | "") +#line 186 "noidx.nw" + } + return +end +#line 238 "noidx.nw" +procedure lualistimage(l) + p := "{ " + s := "" + every i := 1 to *l do { + s ||:= p || "[" || i || "] = " || image(l[i]) + p := ", " + } + return s || " }" +end +#line 255 "noidx.nw" +procedure newdefnlabel(arg) + static defcounts + initial defcounts := table(0) + /defanchors[arg] := [] + k := curfile || "-" || uniqueid(arg) + defcounts[k] +:= 1 + return "NW" || k || "-" || alphacode(defcounts[k]) +end +#line 264 "noidx.nw" +procedure newdocslabel() + static count + initial count := 0 + return "NWD" || curfile || "-" || alphacode(count +:= 1) +end +#line 270 "noidx.nw" +procedure addlabel(tbl, arg, label) + /tbl[arg] := [] + if tbl[arg][-1] == label then &null + else put(tbl[arg], label) + return label +end +#line 277 "noidx.nw" +global chunkud, indexud +procedure addud(udlist, name, arg, label) + /udlist[arg] := [] + s := name || " " || label + return udlist[arg][-1] == s | put(udlist[arg], s) +end +#line 289 "noidx.nw" +procedure strip_extra_uses(udlista) + local old, new, item + old := copy(udlista) + new := [] + while item := get(old) do + item ? + if ="defn " then + +#line 305 "noidx.nw" +{ new[-1] == item | put(new, item) } +#line 297 "noidx.nw" + else if ="use " then + if "defn " || tab(0) == !(old|new) then + &null # write(&errout, "Stripped extra ", item) + else + +#line 305 "noidx.nw" +{ new[-1] == item | put(new, item) } +#line 302 "noidx.nw" + return new +end +#line 309 "noidx.nw" +procedure uniqueid(name) + local key + static idtable, keycounts, badchars, badstars + initial { idtable := table() ; keycounts := table(0) + badchars := ~ (&letters ++ &digits ++ '!$()*+,./:;=?@|') + badstars := repl("*", *badchars) + } + + if not member(idtable, name) then { + # key := make_key(map(name, badchars, badstars)) # deprecated + key := alphacode(crc(name)) + keycounts[key] +:= 1 + idtable[name] := key + if keycounts[key] > 1 then idtable[name] ||:= "." || alphacode(keycounts[key]) + } + return idtable[name] +end +#line 330 "noidx.nw" +procedure make_key(key, len) + static noslash + initial noslash := ~ '/' + key ? return make_key(3(tab(upto('/')), ="/", tab(many(noslash)), pos(0)), *key) | + key[1+:3] || alphacode(\len | *key) | + key || (alphacode(\len) | "") +end +#line 338 "noidx.nw" +global wrote_trailers +#line 350 "noidx.nw" +procedure lognowebchunks(noheader) + static called + if \called then return + else called := 1 + + l := alphasort(allchunks) + write("@xref beginchunks") + while name := get(l) do { + write("@xref chunkbegin ", (\anchorlabel[name] | "nw@notdef"), " ", name) + every write("@xref chunk", !\chunkud[name]) + write("@xref chunkend") + } + write("@xref endchunks") +end +#line 365 "noidx.nw" +procedure lognowebindex() + static called + if \called then return + else called := 1 + + l := alphasort(allidents) + write("@index beginindex") + while name := get(l) do { + write("@index entrybegin ", (\indexanchorlabel[name] | "nw@notdef"), " ", name) + every write("@index entry", !strip_extra_uses(\indexud[name])) + write("@index entryend") + } + write("@index endindex") +end +#line 380 "noidx.nw" +procedure alphasort(x) + t := table() + every s := !x do t[s] := sortkey(s) + t := sort(t, 2) + l := [] + every put(l, (!t)[1]) + return l +end +#line 405 "noidx.nw" +procedure sortkey(s) + return map(s) || "\n" || s # relies on \n sorting lower than other chars +end +#line 409 "noidx.nw" +procedure alphacode(n) + static codes + initial codes := &digits || &letters + return if n < 0 then + "-" || alphacode(-n) + else if n >= *codes then + alphacode(n / *codes) || alphacode(n % *codes) + else + codes[n+1] +end +#line 421 "noidx.nw" +# /* 32-bit Cyclic Redundancy Code implemented by A. Appel 1986 */ +# +# this works only if POLY is a prime polynomial in the field +# of integers modulo 2, of order 32. Since the representation of this +# won't fit in a 32-bit word, the high-order bit is implicit. +# IT MUST ALSO BE THE CASE that the coefficients of orders 31 down to 25 +# are zero. Fortunately, we have a candidate, from +# E. J. Watson, "Primitive Polynomials (Mod 2)", Math. Comp 16 (1962). +# It is: x^32 + x^7 + x^5 + x^3 + x^2 + x^1 + x^0 +# +# Now we reverse the bits to get: +# 111101010000000000000000000000001 in binary (but drop the last 1) +# f 5 0 0 0 0 0 0 in hex +# */ + +procedure crc_table() + local POLY, sum + POLY := 16rf5000000 + t := table() + every i := 0 to 255 do { + sum := 0 + every j := 7 to 0 by -1 do + if iand(i, ishift(1, j)) ~= 0 then + sum := ixor(sum, ishift(POLY, -j)) + t[i] := sum + } + return t +end + +procedure crc(s) + local sum + static table + initial table := crc_table() + sum := 0 + s ? while sum := ixor(ishift(sum, -8), table[iand(ixor(sum, ord(move(1))), 255)]) + return sum +end +#line 460 "noidx.nw" +procedure fatal(L[]) + write!(["@fatal noidx "] ||| L) + write!([&errout, "noweb error in noidx: "] ||| L) + exit(1) +end +#line 466 "noidx.nw" +procedure rcsinfo () + return "$Id: noidx.nw,v 1.22 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/noidx.nw b/web/noweb/src/icon/noidx.nw new file mode 100644 index 0000000000..62fd9176d1 --- /dev/null +++ b/web/noweb/src/icon/noidx.nw @@ -0,0 +1,479 @@ +\documentstyle[noweb]{article} +\pagestyle{noweb}\noweboptions{shortxref} +\begin{document} +Missing ``{\tt @xref tag} {\it label tag},'' where {\it label} is the name of +a label and {\it tag} is a chunk number, page number, sub-page number, or +other identifying mark. +@ +\section{Cross-reference and index support} +<<*>>= +global lines # all the input lines +global delay # non-null if markup should be delayed past the first chunk +global anchordist # max distance before code chunk to place defining @xref label + +procedure main(args) + lines := [] + <<initialization>> + delay := &null + <<swallow [[args]]>> + while put(lines, line := read()) do + apply(pass1, line) + every apply(pass2, !lines) + <<write trailers if not already written>> +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +<<swallow [[args]]>>= +while case(a := get(args)) of { + "-delay" : delay := 1 + "-docanchor" : anchordist := integer(get(args)) + default : fatal("unknown argument ", image(a)) +} +@ +<<*>>= +global curfile # unique id of the current @file +global lastbeginarg # identifies last chunk (for -delay) +<<initialization>>= +curfile := "standard input?" +lastbeginarg := "never any chunks?" +@ +[[anchorlabel]] is the label that references to a code chunk refer to. +The {\LaTeX} back end typically uses the chunk itself, but the HTML +back end will use a spot in the preceding documentation chunk (if +any), as requested by [[-docanchor]] (and non-null [[anchordist]]) +and recorded in [[anchorlabel]]. +<<*>>= +global allchunks, allidents +global indexlabels, defanchors, uses, anchorlabel, indexanchorlabel +<<initialization>>= +every allchunks | allidents := set() +every indexlabels | defanchors | uses | anchorlabel | indexanchorlabel := table() +@ +I set [[textnonblank]] non-null if some text line in the current chunk +contains a non-blank character. +This trick lets me avoid planting anchors in empty documentation chunks. +<<*>>= +procedure pass1(name, arg) + static lastdefnlabel, thisusecount, lastanchorlabel, nonblank, textnonblank + initial nonblank := ~' \t' + case name of { + "file" : curfile := uniqueid(arg) + "begin" : { lastbeginarg := arg; textnonblank := &null } + "end" : if match("docs ", arg) & \anchordist & \textnonblank then + {<<insert and set [[lastanchorlabel]]>>} + else + lastanchorlabel := &null + "text" : /textnonblank := upto(nonblank, arg) + "defn" : { + insert(allchunks, arg) + slipin("@xref label " || (lastdefnlabel := newdefnlabel(arg))) + /lastanchorlabel := lastdefnlabel + /anchorlabel[arg] := lastanchorlabel + addlabel(defanchors, arg, lastanchorlabel) + addud(chunkud, "defn", arg, lastanchorlabel) + thisusecount := 0 + } + "use" : + if match ("code ", lastbeginarg) then { + insert(allchunks, arg) + slipin("@xref label " || lastdefnlabel || "-u" || (thisusecount +:= 1)) + addlabel(uses, arg, lastanchorlabel) + addud(chunkud, "use", arg, lastanchorlabel) + } else { + /textnonblank := upto(nonblank, arg) # could appear in quoted code + } + "index" : { + <<shift [[name]] and [[arg]]>> + case name of { + "use" : { insert(allidents, arg) + addud(indexud, "use", arg, \lastanchorlabel) + } + "defn" | "localdefn" : { + insert(allidents, arg) + (l := \lastanchorlabel) | + slipin("@xref label " || (l := newdocslabel())) + addud(indexud, "defn", arg, l) + /indexanchorlabel[arg] := l + slipin("@xref ref " || l) # bug fix + } + } + } + } + return +end +@ +The bug fix\label{multi-def-bug} +alluded to above occurs when there are multiple definitions of an identifier. +In this case, we can't just use [[indexanchorlabel[id]]], because that refers only to +the first definition. In the {\TeX} back end, that leads to bogus +tags like \hbox{\it x \small\rm 7b 7b 7b} instead of \hbox{\it x +\small\rm 7b 9 12a}; the first tag is repeated again and again. +Because the tag for the current [[@defn]] is lost by the time pass~2 +rolls around, we have to slip it in on pass~1. +@ +<<insert and set [[lastanchorlabel]]>>= +t := []; n := anchordist +lastanchorlabel := newdocslabel() +while lines[-1] ? + if n = 0 | ="@begin docs" then + { put(lines, "@xref label " || lastanchorlabel); lines |||:= t; break } + else + { if ="@nl" & pos(0) then n -:= 1; push(t, pull(lines)) } +@ +[[slipin]] sticks something into [[lines]] just before the current (last) line. +It makes sense only on the first pass. +<<*>>= +procedure slipin(s) + local last + last := pull(lines) + every put(lines, s | last) + return s +end +<<*>>= +procedure pass2(name, arg) + static thesedefns, theseuses + static thischunk # null for docs chunk, arg of @defn for code chunk + static defout # number of definitions emitted for each chunk + initial defout := table(0) + case name of { + "begin" : { + if \delay & lastbeginarg == arg then <<write trailers if not already written>> + <<copy [[name]] and [[arg]] to output>> + every thesedefns | theseuses := set() + thischunk := &null + } + "defn" : { thischunk := arg; + write("@xref ref " || anchorlabel[arg]) + <<copy [[name]] and [[arg]] to output>> + <<write chunk cross-reference>> + } +# must postpone index cross-reference to end of chunk because +# the info is accumulated in [[thesdefns]] and [[theseuses]] on this pass + "end" : { if match("code", arg) then {<<write index cross-reference>>} + <<copy [[name]] and [[arg]] to output>> + } + "use" : { write("@xref ref " || (\anchorlabel[arg] | "nw@notdef")) # was "???" + <<copy [[name]] and [[arg]] to output>> + } + "index" : { + <<shift [[name]] and [[arg]]>> + case name of { + "defn" | "localdefn" : { + insert(thesedefns, arg) + # no xref ref because of bug fix + } + "use" : { insert(theseuses, arg) + write("@xref ref ", \indexanchorlabel[arg]) + } + } + name := "index " || name + <<copy [[name]] and [[arg]] to output>> + } + "text" : # grotesque hack! for chunks and index in HTML + if /thischunk then # docs mode + case arg of { + "<nowebchunks>" : lognowebchunks() + "<nowebindex>" : lognowebindex() + default : <<copy [[name]] and [[arg]] to output>> + } + else <<copy [[name]] and [[arg]] to output>> + "fatal" : { <<copy [[name]] and [[arg]] to output>>; exit(1) } + "trailer" : { <<write trailers if not already written>> + <<copy [[name]] and [[arg]] to output>> + } + default : <<copy [[name]] and [[arg]] to output>> + } + return +end +@ +The case of the [[@index defn]] is the one case where we don't emit a +reference, because the reference has to go in earlier. See +page~\pageref{multi-def-bug} for an explanation. +@ +<<write chunk cross-reference>>= +defout[thischunk] +:= 1 +write("@xref prevdef ", defanchors[thischunk][defout[thischunk] - 1]) # fail if first +write("@xref nextdef ", defanchors[thischunk][defout[thischunk] + 1]) # faif if last +if defout[thischunk] = 1 then {<<write use and def summary for chunk cross-reference>>} +<<write index cross-reference>>= +theseuses --:= thesedefns +if *thesedefns > 0 then { + write("@index begindefs") + every i := !alphasort(thesedefns) do { + every u := !\indexud[i] do u ? if ="use " then write("@index isused ", tab(0)) + write("@index defitem ", i) + } + write("@index enddefs") +} +if *theseuses > 0 then { + l := alphasort(theseuses) + write("@index beginuses") + every i := !alphasort(theseuses) do { + every d := !\indexud[i] do d ? if ="defn " then write("@index isdefined ", tab(0)) + write("@index useitem ", i) + } + write("@index enduses") +} +# every write("@literal \\nwindexuse{", TeXliteral(ident := !l), "}", +# "{", indexlabels[ident], "}{", thislabel, "}") +<<write use and def summary for chunk cross-reference>>= +if *defanchors[thischunk] > 1 then { + write("@xref begindefs") + every write("@xref defitem ", defanchors[thischunk][2 to *defanchors[thischunk]]) + write("@xref enddefs") +} +if \uses[thischunk] then { + write("@xref beginuses") + every write("@xref useitem ", !uses[thischunk]) + write("@xref enduses") +} else + write("@xref notused ", thischunk) +@ +<<shift [[name]] and [[arg]]>>= +{ arg ? { name := tab(upto(' ')|0); arg := if =" " then tab(0) else &null } } +<<copy [[name]] and [[arg]] to output>>= +write("@", name, (" " || \arg) | "") +<<*>>= +procedure lualistimage(l) + p := "{ " + s := "" + every i := 1 to *l do { + s ||:= p || "[" || i || "] = " || image(l[i]) + p := ", " + } + return s || " }" +end +@ +The following code is a change first effective in version~2.10d. +It ensures that labels are the same whether files are marked up one at +a time or in a group. +This change helps ``book page definition marks'' for the 152 text, +which is processed one chapter at a time for weaving but several +chapters in a group for tangling. +<<*>>= +procedure newdefnlabel(arg) + static defcounts + initial defcounts := table(0) + /defanchors[arg] := [] + k := curfile || "-" || uniqueid(arg) + defcounts[k] +:= 1 + return "NW" || k || "-" || alphacode(defcounts[k]) +end +<<*>>= +procedure newdocslabel() + static count + initial count := 0 + return "NWD" || curfile || "-" || alphacode(count +:= 1) +end +<<*>>= +procedure addlabel(tbl, arg, label) + /tbl[arg] := [] + if tbl[arg][-1] == label then &null + else put(tbl[arg], label) + return label +end +<<*>>= +global chunkud, indexud +procedure addud(udlist, name, arg, label) + /udlist[arg] := [] + s := name || " " || label + return udlist[arg][-1] == s | put(udlist[arg], s) +end +<<initialization>>= +every chunkud | indexud := table(); +@ +Because it's silly to have both a use and a definition point to the same chunk, +I strip out uses that list the same chunk as their definitions. +<<*>>= +procedure strip_extra_uses(udlista) + local old, new, item + old := copy(udlista) + new := [] + while item := get(old) do + item ? + if ="defn " then + <<add item if needed>> + else if ="use " then + if "defn " || tab(0) == !(old|new) then + &null # write(&errout, "Stripped extra ", item) + else + <<add item if needed>> + return new +end +<<add item if needed>>= +{ new[-1] == item | put(new, item) } +@ +[[uniqueid]] eliminates both {\TeX} and HTML specials. +<<*>>= +procedure uniqueid(name) + local key + static idtable, keycounts, badchars, badstars + initial { idtable := table() ; keycounts := table(0) + badchars := ~ (&letters ++ &digits ++ '!$()*+,./:;=?@|') + badstars := repl("*", *badchars) + } + + if not member(idtable, name) then { + # key := make_key(map(name, badchars, badstars)) # deprecated + key := alphacode(crc(name)) + keycounts[key] +:= 1 + idtable[name] := key + if keycounts[key] > 1 then idtable[name] ||:= "." || alphacode(keycounts[key]) + } + return idtable[name] +end +@ +The original key routine used the FORTH heuristic on the basename: +first three letters plus the length. This produced too many collisions. +<<*>>= +procedure make_key(key, len) + static noslash + initial noslash := ~ '/' + key ? return make_key(3(tab(upto('/')), ="/", tab(many(noslash)), pos(0)), *key) | + key[1+:3] || alphacode(\len | *key) | + key || (alphacode(\len) | "") +end +<<*>>= +global wrote_trailers +<<write trailers if not already written>>= +(if /wrote_trailers then { + wrote_trailers := 1 + write("@nl") + write("@nl") + lognowebchunks() + lognowebindex() +} else &null) +@ +Now, a special hack, so we can write this stuff in the right place on pass 2. +<<*>>= +procedure lognowebchunks(noheader) + static called + if \called then return + else called := 1 + + l := alphasort(allchunks) + write("@xref beginchunks") + while name := get(l) do { + write("@xref chunkbegin ", (\anchorlabel[name] | "nw@notdef"), " ", name) + every write("@xref chunk", !\chunkud[name]) + write("@xref chunkend") + } + write("@xref endchunks") +end +<<*>>= +procedure lognowebindex() + static called + if \called then return + else called := 1 + + l := alphasort(allidents) + write("@index beginindex") + while name := get(l) do { + write("@index entrybegin ", (\indexanchorlabel[name] | "nw@notdef"), " ", name) + every write("@index entry", !strip_extra_uses(\indexud[name])) + write("@index entryend") + } + write("@index endindex") +end +<<*>>= +procedure alphasort(x) + t := table() + every s := !x do t[s] := sortkey(s) + t := sort(t, 2) + l := [] + every put(l, (!t)[1]) + return l +end +@ +I tried to ignore special characters when sorting. +This turned out to be too clever by half. +Sample: it would sort [[BALANCER_DEBUGGING]] before +[[BALANCE_TRANSFORMATION]], because the underscore didn't count. +<<old, evil code>>= +procedure sortkey(s) + static keep + initial keep := &lcase ++ ' ' + s := map(s) + r := "" + s ? while tab(upto(keep)) do r ||:= move(1) + return r || "\n" || s # relies on \n sorting lower than other chars +end +@ My solution is to move to a much simpler scheme in which the only +thing we do is change case. +<<*>>= +procedure sortkey(s) + return map(s) || "\n" || s # relies on \n sorting lower than other chars +end +<<*>>= +procedure alphacode(n) + static codes + initial codes := &digits || &letters + return if n < 0 then + "-" || alphacode(-n) + else if n >= *codes then + alphacode(n / *codes) || alphacode(n % *codes) + else + codes[n+1] +end +@ +<<*>>= +# /* 32-bit Cyclic Redundancy Code implemented by A. Appel 1986 */ +# +# this works only if POLY is a prime polynomial in the field +# of integers modulo 2, of order 32. Since the representation of this +# won't fit in a 32-bit word, the high-order bit is implicit. +# IT MUST ALSO BE THE CASE that the coefficients of orders 31 down to 25 +# are zero. Fortunately, we have a candidate, from +# E. J. Watson, "Primitive Polynomials (Mod 2)", Math. Comp 16 (1962). +# It is: x^32 + x^7 + x^5 + x^3 + x^2 + x^1 + x^0 +# +# Now we reverse the bits to get: +# 111101010000000000000000000000001 in binary (but drop the last 1) +# f 5 0 0 0 0 0 0 in hex +# */ + +procedure crc_table() + local POLY, sum + POLY := 16rf5000000 + t := table() + every i := 0 to 255 do { + sum := 0 + every j := 7 to 0 by -1 do + if iand(i, ishift(1, j)) ~= 0 then + sum := ixor(sum, ishift(POLY, -j)) + t[i] := sum + } + return t +end + +procedure crc(s) + local sum + static table + initial table := crc_table() + sum := 0 + s ? while sum := ixor(ishift(sum, -8), table[iand(ixor(sum, ord(move(1))), 255)]) + return sum +end +@ +<<*>>= +procedure fatal(L[]) + write!(["@fatal noidx "] ||| L) + write!([&errout, "noweb error in noidx: "] ||| L) + exit(1) +end +<<*>>= +procedure rcsinfo () + return "$Id: noidx.nw,v 1.22 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ +\section{List of chunks} +\nowebchunks + +\twocolumn +\section{Index} +\nowebindex +@ +\end{document} diff --git a/web/noweb/src/icon/noindex.icn b/web/noweb/src/icon/noindex.icn new file mode 100644 index 0000000000..3ba307170b --- /dev/null +++ b/web/noweb/src/icon/noindex.icn @@ -0,0 +1,98 @@ +#line 6 "noindex.nw" +procedure main(args) + if *args ~= 1 then + write(&errout, "Usage: noindex basename") + else { + in := get(args) + if in[-4:0] == ".tex" then in[-4:0] := ".aux" + else if not (in[-4:0] == ".aux") then in ||:= ".aux" + gobble(in, idx := []) + f := open(in[1:-4] || ".nwi", "w") | fatal("Cannot write ", in[1:-4] || ".nwi") + last := "" + every out := stripcount(!alphasort(idx)) do + write(f, last ~== out) & last := out + close(f) + } + return +end +#line 23 "noindex.nw" +procedure gobble(name, idx) + static count + initial count := 0 + in := open(name) | +#line 40 "noindex.nw" +{ write(&errout, "No file ", name, "."); return } +#line 27 "noindex.nw" + while line := read(in) do + line ? + if ="\\@input{" & name := tab(upto('}')) & move(1) & pos(0) then + gobble(name, idx) + else if ="\\nwixadds{" then + put(idx, right(count +:= 1, 6, "0") || " " || tab(0)) + return +end +#line 36 "noindex.nw" +procedure stripcount(s) + s ? { tab(many(&digits)); tab(many(' ')); return "\\nwixaddsx{" || tab(0) } +end +#line 42 "noindex.nw" +procedure alphasort(x) + t := table() + every s := !x do t[s] := sortkey(s) + t := sort(t, 2) + l := [] + every put(l, (!t)[1]) + return l +end +#line 51 "noindex.nw" +procedure sortkey(s) + local count + map(s) ? { + count := tab(many(&digits)) + tab(many(' ')) + if ="c}" then return firstkey() || "\n" || count + else if ="i}" then return firstkey() || "\n" || count + else fatal("not chunk or index") + } +end +#line 62 "noindex.nw" +procedure firstkey() + ="{{" | fatal("bad index or chunk format") + s := (remove_control_sequences() ? tab(bal('}', '{', '}') | 0)) + return alphabet(s) || "\n" || s +end +#line 68 "noindex.nw" +procedure alphabet(s) + static keep + initial keep := &lcase ++ ' \t' + r := "" + s ? { + while tab(upto(keep)) do + if tab(many(' \t')) then + r ||:= " " + else + r ||:= tab(many(&lcase)) | fatal("This can't happen") + } + r ? { tab(many(' ')) ; return tab(0) } # strip leading blanks +end +#line 82 "noindex.nw" +procedure remove_control_sequences() + s := "" + while s ||:= tab(upto('\\')) do { + ="\\" + tab(many(&letters)) | move(1) # skip + tab(many(' \t')) + } + return s || tab(0) +end +#line 93 "noindex.nw" +procedure fatal(L[]) + write!(["@fatal noindex "] ||| L) + write!([&errout, "noweb error in noindex: "] ||| L) + exit(1) +end +#line 99 "noindex.nw" +procedure rcsinfo () + return "$Id: noindex.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/noindex.nw b/web/noweb/src/icon/noindex.nw new file mode 100644 index 0000000000..cad4369b8a --- /dev/null +++ b/web/noweb/src/icon/noindex.nw @@ -0,0 +1,106 @@ +This program is similar to [[makeindex]] in that it grovels through [[.aux]] +files looking for index information, which it writes to a [[.nwi]] file. +It's used when [[noweave -indexfrom]] is used on many files separately; +it combines the separate indices into a single, correctly sorted index. +That index file is read by [[\nowebindex*]]. +<<*>>= +procedure main(args) + if *args ~= 1 then + write(&errout, "Usage: noindex basename") + else { + in := get(args) + if in[-4:0] == ".tex" then in[-4:0] := ".aux" + else if not (in[-4:0] == ".aux") then in ||:= ".aux" + gobble(in, idx := []) + f := open(in[1:-4] || ".nwi", "w") | fatal("Cannot write ", in[1:-4] || ".nwi") + last := "" + every out := stripcount(!alphasort(idx)) do + write(f, last ~== out) & last := out + close(f) + } + return +end +<<*>>= +procedure gobble(name, idx) + static count + initial count := 0 + in := open(name) | <<can't open; return>> + while line := read(in) do + line ? + if ="\\@input{" & name := tab(upto('}')) & move(1) & pos(0) then + gobble(name, idx) + else if ="\\nwixadds{" then + put(idx, right(count +:= 1, 6, "0") || " " || tab(0)) + return +end +<<*>>= +procedure stripcount(s) + s ? { tab(many(&digits)); tab(many(' ')); return "\\nwixaddsx{" || tab(0) } +end +<<can't open; return>>= +{ write(&errout, "No file ", name, "."); return } +<<*>>= +procedure alphasort(x) + t := table() + every s := !x do t[s] := sortkey(s) + t := sort(t, 2) + l := [] + every put(l, (!t)[1]) + return l +end +<<*>>= +procedure sortkey(s) + local count + map(s) ? { + count := tab(many(&digits)) + tab(many(' ')) + if ="c}" then return firstkey() || "\n" || count + else if ="i}" then return firstkey() || "\n" || count + else fatal("not chunk or index") + } +end +<<*>>= +procedure firstkey() + ="{{" | fatal("bad index or chunk format") + s := (remove_control_sequences() ? tab(bal('}', '{', '}') | 0)) + return alphabet(s) || "\n" || s +end +<<*>>= +procedure alphabet(s) + static keep + initial keep := &lcase ++ ' \t' + r := "" + s ? { + while tab(upto(keep)) do + if tab(many(' \t')) then + r ||:= " " + else + r ||:= tab(many(&lcase)) | fatal("This can't happen") + } + r ? { tab(many(' ')) ; return tab(0) } # strip leading blanks +end +<<*>>= +procedure remove_control_sequences() + s := "" + while s ||:= tab(upto('\\')) do { + ="\\" + tab(many(&letters)) | move(1) # skip + tab(many(' \t')) + } + return s || tab(0) +end +@ +<<*>>= +procedure fatal(L[]) + write!(["@fatal noindex "] ||| L) + write!([&errout, "noweb error in noindex: "] ||| L) + exit(1) +end +<<*>>= +procedure rcsinfo () + return "$Id: noindex.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ +\section{Index} +\nowebindex diff --git a/web/noweb/src/icon/noxref.nw b/web/noweb/src/icon/noxref.nw new file mode 100644 index 0000000000..4b0eaa1836 --- /dev/null +++ b/web/noweb/src/icon/noxref.nw @@ -0,0 +1,119 @@ +\section{Cross-reference for noweb/latex} +<<*>>= +global lines, defns, uses, names, firstdefnout + +procedure main(args) + lines := [] + defns := table() + uses := table() + names := table() + while put(lines, line := read()) do + apply(pass1, line) + firstdefnout := set() + every apply(pass2, !lines) +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +<<*>>= +procedure pass1(name, chunkname) + static curfile, defined + initial {curfile := "????"; defined := set()} + case name of { + "file" : curfile := modid(chunkname || (chunkname[4+:3] | chunkname[4:0] | "")) + "defn" | "use" : { + if name == "defn" then tbl := defns else tbl := uses + if name == "defn" & not member(defined, chunkname) then { + label := "sublabel" + insert(defined, chunkname) + } else + label := "label" + /tbl[chunkname] := [] + id := map(name, &lcase, &ucase) || ":" || curfile || ":" || + modid(chunkname) || "-" || (1+*tbl[chunkname]) + put(tbl[chunkname], id) + put(lines, "@literal \\" || label || "{" || id || "}") + names[chunkname] := lettersonly(chunkname) + } + } + return +end +<<*>>= +procedure modid(name) + local key + static idtable, keycounts + initial { idtable := table() ; keycounts := table(0) } + + if not member(idtable, name) then { + key := map(name, " \\{}-[]`#%&~_^", "**************") + if *key > 6 then key := key[1:4] || key[0:-3] + keycounts[key] +:= 1 + idtable[name] := key || if keycounts[key] > 1 then "-" || keycounts[key] else "" + } + return idtable[name] +end +<<*>>= +global thischunk + +procedure pass2(name, arg) + case name of { + "defn" : { + thischunk := arg + write("@defn ", arg, "~{\\footnotesize\\Rm\\subpageref{", defns[arg][1], "}}") + } + "use" : + write("@use ", arg, "~{\\footnotesize\\Rm\\subpageref{", (\defns[arg])[1], "}}") | + write("@use ", arg, "~{\\footnotesize\\Rm (never defined)}") + "end" : { + if match("code", arg) & not member(firstdefnout, thischunk) then { + insert(firstdefnout, thischunk) + if *defns[thischunk] > 1 then { + writes("@literal \\alsodefined{") + every i := 2 to *defns[thischunk] do + writes("\\\\{", defns[thischunk][i], "}") + write("}") + } + if \uses[thischunk] then { + writes("@literal \\used{") + every i := 1 to *uses[thischunk] do + writes("\\\\{", uses[thischunk][i], "}") + write("}") + } else write("@literal \\notused{", escapeTeXspecials(thischunk), "}") + } + write("@", name, " ", arg) + } + "text" : if \arg == "\\nowebchunks" then nowebchunks() + else write("@text", (" " || \arg) | "") + default : write("@", name, (" " || \arg) | "") + } + return +end +<<*>>= +procedure nowebchunks() + l := sort(names,2) + while name := get(l)[1] do { + write("@literal {") + write("@use ", name, "~{\\footnotesize\\Rm\\subpageref{", (\defns[name])[1], "}}") | + write("@use ", name, "~{\\footnotesize\\Rm (never defined)}") + write("@literal }") + if *l > 0 then write("@literal \\\\") + } +end +<<*>>= +procedure lettersonly(s) + static keep + initial keep := &lcase ++ ' ' + s := map(s) + r := "" + s ? while tab(upto(keep)) do r ||:= move(1) + return r +end +<<*>>= +procedure escapeTeXspecials(name) + name ? { + s := "" + while s ||:= tab(upto('{}$&%#^_~\\')) do s ||:= "\\" || move(1) + return s || tab(0) + } +end diff --git a/web/noweb/src/icon/nwl2h.nw b/web/noweb/src/icon/nwl2h.nw new file mode 100644 index 0000000000..3dbc2e58ed --- /dev/null +++ b/web/noweb/src/icon/nwl2h.nw @@ -0,0 +1,79 @@ +<<*>>= +global show_unknowns + +procedure main(args) + local line + every arg := !args do + case arg of { + "-show-unknowns" : show_unknowns := 1 + default : write(&errout, "l2h filter: unknown arg ", image(arg)) + } + while line := read() do + apply(filter, line) + warn_unknown(unknown_set, "control sequences", "\\") + warn_unknown(unknown_envs, "environments", "{", "}") +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +<<*>>= +global curfile, curline + +procedure filter(name, arg) + static S, C, code + initial { S := converter("V"); C := converter("H") } + case name of { + "begin" : {<<out>>; if match("code ", arg) then code := 1} + "end" : {<<out>>; code := &null; S.mode := "V"} + "quote" : {<<out>>; code := 1; stop_skipping(S)} + "endquote" : {<<out>>; code := &null} + "file" : {<<out>>; curfile := arg; curline := 1} + "line" : {<<out>>; curline := integer(arg)} + "defn" : { write("@", name, " ", "{" || arg || "}" ? convert(C)); reset(C) } + "use" : { write("@", name, " ", "{" || arg || "}" ? convert(C)); reset(C) } + "text" : {if \code then <<out>> else outtext(arg ? convert(S))} + "nl" : {if \code then <<out>> else outtext("\n" ? convert(S)); curline +:= 1} + default : {<<out>>} + } + return +end +<<out>>= +write("@", name, (" " || \arg) | "") +<<*>>= +procedure outtext(s) + s ? + while not pos(0) do + if ="\n" then write("@nl") + else write("@text ", tab(upto('\n') | 0)) + return +end +<<*>>= +procedure warn_unknown(s, type, mark, rmark) + if *s > 0 then { + pushout("Unknown " || type || ": ") + every pushout(((\mark | "")\1) || !sort(s) || ((\rmark | "")\1) || " ") + pushout("\n") + } +end +<<*>>= +procedure pushout(s) + static col + initial col := 0 + if find("\n", s) then + s ? { + pushout(tab(upto('\n'))) + while ="\n" do {col := 0; write(&errout)} + pushout(tab(0)) + } + else { + col +:= *s + if col >= 79 then {writes(&errout, "\n "); col := *s + 2} + writes(&errout, s) + } + return +end +<<*>>= +procedure error(args[]) + return write!([&errout, (\curfile || ", ") | "", "line ", curline, ": "] ||| args) +end diff --git a/web/noweb/src/icon/pascaldefs.icn b/web/noweb/src/icon/pascaldefs.icn new file mode 100644 index 0000000000..ccdd434ca2 --- /dev/null +++ b/web/noweb/src/icon/pascaldefs.icn @@ -0,0 +1,96 @@ +#line 2 "pascaldefs.nw" +global showlocal +procedure main(args) + showlocal := !args == "-local" + go() +end +#line 8 "pascaldefs.nw" +procedure postpass(name, arg) + static kind + initial { kind := "bogus" } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if (optwhite(), =("function "|"procedure "), not hasword(arg, "forward")) then{ + tab(many(' ')) + writedefn(tab(upto(' ():;'))) + } else if (optwhite(), x := allupper(), optwhite(), ="=") then { + writedefn(x) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure words() + static alnum + initial alnum := &letters ++ &digits ++ '_' + suspend if any(alnum) then tab(many(alnum)) + else if pos(0) then fail + else if tab(upto(alnum)) then words() +end + +procedure hasword(s, w) + suspend (tab(0) ? words()) == w +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end + +procedure allupper() + static uppers + initial uppers := &ucase ++ &digits ++ '_' + suspend tab(many(uppers)) +end + + +procedure rcsinfo () + return "$Id: pascaldefs.nw,v 1.17 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/pascaldefs.nw b/web/noweb/src/icon/pascaldefs.nw new file mode 100644 index 0000000000..04637bc3bf --- /dev/null +++ b/web/noweb/src/icon/pascaldefs.nw @@ -0,0 +1,55 @@ +\section{Finding Pascal definitions} +<<*>>= +global showlocal +procedure main(args) + showlocal := !args == "-local" + go() +end +<<*>>= +procedure postpass(name, arg) + static kind + initial { kind := "bogus" } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if (optwhite(), =("function "|"procedure "), not hasword(arg, "forward")) then{ + tab(many(' ')) + writedefn(tab(upto(' ():;'))) + } else if (optwhite(), x := allupper(), optwhite(), ="=") then { + writedefn(x) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure words() + static alnum + initial alnum := &letters ++ &digits ++ '_' + suspend if any(alnum) then tab(many(alnum)) + else if pos(0) then fail + else if tab(upto(alnum)) then words() +end + +procedure hasword(s, w) + suspend (tab(0) ? words()) == w +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end + +procedure allupper() + static uppers + initial uppers := &ucase ++ &digits ++ '_' + suspend tab(many(uppers)) +end + + +procedure rcsinfo () + return "$Id: pascaldefs.nw,v 1.17 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/pdcached.icn b/web/noweb/src/icon/pdcached.icn new file mode 100644 index 0000000000..e24102bce3 --- /dev/null +++ b/web/noweb/src/icon/pdcached.icn @@ -0,0 +1,238 @@ +#line 5 "pdcached.nw" +procedure main(args) + cachename := get(args) | stop("pdcached: no cache") + if args[1] == "-nearcode" then + nearcode := get(args) + cmd := get(args) | stop("pdcached: no command") + + cmd := "sed '/^@begin docs /s/[0-9][0-9]*/0/' | unmarkup | " || cmd || + " | markup | grep -v '^@file $'" + + last := &null + loadcache(cachename) + + while line := read() do + {## write("====> process ", image(line), "; last = ", type(last), + ## "(", *\last | "?", "), lastcode = ", image(lastcode)) + if match("@begin code ", line) then { + if type(last) == "list" then + pipeout(last, cmd) + last := "code" + until match("@end code ", line) do { + write(line) + line := read() + } + write(line) +#write("******until completed with ", line) + } else if match("@begin docs ", line) then { + l := [line] + until match("@end docs ", line) do + put(l, line := read()) +#write("******until completed with ", line) + put(l, line) + if /nearcode then { + pipeout(l, cmd) + last := &null + } else if last === "code" & notblank(l) then { + pipeout(l, cmd) + every write("@begin docs 0" | "@nl" | "@end docs 0") + last := &null + } else { + last := l + } + } else { + write(line) + } + } + savecache(cachename) + return +end + +#line 55 "pdcached.nw" +procedure pipeout(lines, cmd) + local cached + static tmp + initial { tmp := "/tmp/pdcached.out" + hitcount := misscount := 0 + } + cached := find_in_cache(lines) + if /cached then { + misscount +:= 1 + f := open(cmd || " > " || tmp, "wp") + every write(f, !lines) + close(f) + f := open(tmp, "r") + cached := [] + while put(cached, read(f)) + close(f) + adjustblanks(lines, cached) + save_in_cache(lines, cached) + } else { + adjustblanks(lines, cached) + hitcount +:= 1 + } + every write(!cached) + return +end +#line 84 "pdcached.nw" +procedure adjustblanks(in, out) + if &fail & find("Applying a primitive", !in) then { + write(&errout, "For ", image(in[1]), "/", image(out[1]), ", notblank(in) = ", + image(notblank(in)) | "<failed>", + "; blankstring(out[1]) = ", image(blankstring(out[1])) | "<failed>") + every i := 1 to *in do write(&errout, " in[", i, "] = ", image( in[i])) + every i := 1 to *out do write(&errout, "out[", i, "] = ", image(out[i])) + } + if notblank(in) then + if notblank(out) then + &null # this is OK, so do nothing + else + remove_initial_blanks(out) + else # input begins with blanks + if notblank(out) then + insert_initial_newline(out) + else + &null # this is OK, so do nothing + return +end + +procedure blankstring(s) + s ? { tab(many(' \t')); return pos(0) } +end +#line 110 "pdcached.nw" +global cache, hitcount, misscount + +procedure strip_chunk_number(s) + s ? + if =("@" || ("begin" | "end") || " " || ("docs" | "code") || " ") then + return tab(1) + else + return s +end + +procedure find_in_cache(lines) + c := cache + every l := strip_chunk_number(!lines) do + c := \c[l] | return &null + return c[&null] +end + +procedure save_in_cache(lines, cached) + c := cache + i := 1 + while l := strip_chunk_number(lines[i]) do { + /c[l] := table() + c := c[l] + i := i + 1 + } + c[&null] := cached + return +end + +link xcode + +procedure loadcache(cachename) + cache := xdecode(c := open(cachename)) | table() + close(\c) + return +end + +link numbers + +procedure savecache(cachename) + write(&errout, "Cache misses ", + frn(real(misscount) * 100.0 / real(misscount + hitcount), 0, 1), "% of ", + misscount+hitcount, " queries") + if misscount = 0 then return + system("lockfile " || cachename || ".lock") + xencoden(cache, cachename || ".new") + rename(cachename || ".new", cachename) | stop("Could not update cache") + remove(cachename || ".lock") + return # forget the other! + + c := open(cachename || ".fast", "w") | stop("cannot open fast cache") + wval(c, cache) + close(c) +end +#line 165 "pdcached.nw" +procedure readval(f) + local stack + stack := [] + while l := read(f) do + l ? case move(1) of { + "s" : push(stack, tab(0)) + "l" : push(stack, []) + "t" : push(stack, table()) + "n" : push(stack, &null) + "a" : { v := pop(stack); put(stack[1], v) } + "k" : { v := pop(stack); k := pop(stack); stack[1][k] := v } + } + return stack[1] +end + +procedure wval(f, v) + return case type(v) of { + "string" : write(f, "s", v) + "list" : wlis (f, v) + "table" : wtab (f, v) + "null" : write(f, "n") + default : stop("writing unknown type") + } +end + +procedure wlis(f, l) + write(f, "l") + every v := !l do { + wval(f, v); write(f, "a") + } + return +end + +procedure wtab(f, t) + write(f, "t") + every k := key(t) do { + wval(f, k); wval(f, t[k]); write(f, "k") + } + return +end +#line 208 "pdcached.nw" +procedure notblank(l) + every x := !l do + x ? + if ="@nl" & pos(0) then + fail + else if ="@text " & { tab(many(' \t')); not(pos(0)) } then + return x +end +#line 217 "pdcached.nw" +procedure remove_initial_blanks(l) + p := [] + while c := get(l) do + c ? + if ="@nl" | (="@text " & { tab(many(' \t')); pos(0) }) then { + &null # skip this baby + } else if =("@text" | "@end docs") then { + while push(l, pop(p)) + return l + } else { + push(p, c) + } + while push(l, pop(p)) + return l +end +#line 233 "pdcached.nw" +procedure insert_initial_newline(l) + p := [] + while c := get(l) do + if match("@text "|"@end docs", c) then { + push(l, c) + push(l, "@nl") + while push(l, pop(p)) + return l + } else { + push(p, c) + } + push(l, "@nl") + while push(l, pop(p)) + return l +end diff --git a/web/noweb/src/icon/pdcached.nw b/web/noweb/src/icon/pdcached.nw new file mode 100644 index 0000000000..b85d3ff9aa --- /dev/null +++ b/web/noweb/src/icon/pdcached.nw @@ -0,0 +1,248 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +This code pipes documentation chunks through a command. +If given option [[-nearcode]], it pipes only documentation chunks that +are next to code chunks; it drops all other documentation chunks. +<<*>>= +procedure main(args) + cachename := get(args) | stop("pdcached: no cache") + if args[1] == "-nearcode" then + nearcode := get(args) + cmd := get(args) | stop("pdcached: no command") + + cmd := "sed '/^@begin docs /s/[0-9][0-9]*/0/' | unmarkup | " || cmd || + " | markup | grep -v '^@file $'" + + last := &null + loadcache(cachename) + + while line := read() do + {## write("====> process ", image(line), "; last = ", type(last), + ## "(", *\last | "?", "), lastcode = ", image(lastcode)) + if match("@begin code ", line) then { + if type(last) == "list" then + pipeout(last, cmd) + last := "code" + until match("@end code ", line) do { + write(line) + line := read() + } + write(line) +#write("******until completed with ", line) + } else if match("@begin docs ", line) then { + l := [line] + until match("@end docs ", line) do + put(l, line := read()) +#write("******until completed with ", line) + put(l, line) + if /nearcode then { + pipeout(l, cmd) + last := &null + } else if last === "code" & notblank(l) then { + pipeout(l, cmd) + every write("@begin docs 0" | "@nl" | "@end docs 0") + last := &null + } else { + last := l + } + } else { + write(line) + } + } + savecache(cachename) + return +end + +<<*>>= +procedure pipeout(lines, cmd) + local cached + static tmp + initial { tmp := "/tmp/pdcached.out" + hitcount := misscount := 0 + } + cached := find_in_cache(lines) + if /cached then { + misscount +:= 1 + f := open(cmd || " > " || tmp, "wp") + every write(f, !lines) + close(f) + f := open(tmp, "r") + cached := [] + while put(cached, read(f)) + close(f) + adjustblanks(lines, cached) + save_in_cache(lines, cached) + } else { + adjustblanks(lines, cached) + hitcount +:= 1 + } + every write(!cached) + return +end +@ +Make sure if it begins blank before processing, it begins blank after +processing. +<<*>>= +procedure adjustblanks(in, out) + if &fail & find("Applying a primitive", !in) then { + write(&errout, "For ", image(in[1]), "/", image(out[1]), ", notblank(in) = ", + image(notblank(in)) | "<failed>", + "; blankstring(out[1]) = ", image(blankstring(out[1])) | "<failed>") + every i := 1 to *in do write(&errout, " in[", i, "] = ", image( in[i])) + every i := 1 to *out do write(&errout, "out[", i, "] = ", image(out[i])) + } + if notblank(in) then + if notblank(out) then + &null # this is OK, so do nothing + else + remove_initial_blanks(out) + else # input begins with blanks + if notblank(out) then + insert_initial_newline(out) + else + &null # this is OK, so do nothing + return +end + +procedure blankstring(s) + s ? { tab(many(' \t')); return pos(0) } +end +@ +<<*>>= +global cache, hitcount, misscount + +procedure strip_chunk_number(s) + s ? + if =("@" || ("begin" | "end") || " " || ("docs" | "code") || " ") then + return tab(1) + else + return s +end + +procedure find_in_cache(lines) + c := cache + every l := strip_chunk_number(!lines) do + c := \c[l] | return &null + return c[&null] +end + +procedure save_in_cache(lines, cached) + c := cache + i := 1 + while l := strip_chunk_number(lines[i]) do { + /c[l] := table() + c := c[l] + i := i + 1 + } + c[&null] := cached + return +end + +link xcode + +procedure loadcache(cachename) + cache := xdecode(c := open(cachename)) | table() + close(\c) + return +end + +link numbers + +procedure savecache(cachename) + write(&errout, "Cache misses ", + frn(real(misscount) * 100.0 / real(misscount + hitcount), 0, 1), "% of ", + misscount+hitcount, " queries") + if misscount = 0 then return + system("lockfile " || cachename || ".lock") + xencoden(cache, cachename || ".new") + rename(cachename || ".new", cachename) | stop("Could not update cache") + remove(cachename || ".lock") + return # forget the other! + + c := open(cachename || ".fast", "w") | stop("cannot open fast cache") + wval(c, cache) + close(c) +end +<<*>>= +procedure readval(f) + local stack + stack := [] + while l := read(f) do + l ? case move(1) of { + "s" : push(stack, tab(0)) + "l" : push(stack, []) + "t" : push(stack, table()) + "n" : push(stack, &null) + "a" : { v := pop(stack); put(stack[1], v) } + "k" : { v := pop(stack); k := pop(stack); stack[1][k] := v } + } + return stack[1] +end + +procedure wval(f, v) + return case type(v) of { + "string" : write(f, "s", v) + "list" : wlis (f, v) + "table" : wtab (f, v) + "null" : write(f, "n") + default : stop("writing unknown type") + } +end + +procedure wlis(f, l) + write(f, "l") + every v := !l do { + wval(f, v); write(f, "a") + } + return +end + +procedure wtab(f, t) + write(f, "t") + every k := key(t) do { + wval(f, k); wval(f, t[k]); write(f, "k") + } + return +end +@ +Manipulating docs chunks. +<<*>>= +procedure notblank(l) + every x := !l do + x ? + if ="@nl" & pos(0) then + fail + else if ="@text " & { tab(many(' \t')); not(pos(0)) } then + return x +end +<<*>>= +procedure remove_initial_blanks(l) + p := [] + while c := get(l) do + c ? + if ="@nl" | (="@text " & { tab(many(' \t')); pos(0) }) then { + &null # skip this baby + } else if =("@text" | "@end docs") then { + while push(l, pop(p)) + return l + } else { + push(p, c) + } + while push(l, pop(p)) + return l +end +<<*>>= +procedure insert_initial_newline(l) + p := [] + while c := get(l) do + if match("@text "|"@end docs", c) then { + push(l, c) + push(l, "@nl") + while push(l, pop(p)) + return l + } else { + push(p, c) + } + push(l, "@nl") + while push(l, pop(p)) + return l +end diff --git a/web/noweb/src/icon/pipedocs.icn b/web/noweb/src/icon/pipedocs.icn new file mode 100644 index 0000000000..fc86e7a03b --- /dev/null +++ b/web/noweb/src/icon/pipedocs.icn @@ -0,0 +1,65 @@ +#line 5 "pipedocs.nw" +procedure main(args) + if args[1] == "-nearcode" then + nearcode := get(args) + cmd := get(args) | stop("pipedocs: no command") + + cmd := "sed '/^@begin docs /s/[0-9][0-9]*/0/' | unmarkup | " || cmd || + " | awk ' NR == 1 && /^[ \t]*$/ {next}\n{print}\n' | markup | grep -v '^@file $'" + + last := &null + + while line := read() do + {## write("====> process ", image(line), "; last = ", type(last), + ## "(", *\last | "?", "), lastcode = ", image(lastcode)) + if match("@begin code ", line) then { + if type(last) == "list" then + pipeout(last, cmd) + last := "code" + until match("@end code ", line) do { + write(line) + line := read() + } + write(line) +#write("******until completed with ", line) + } else if match("@begin docs ", line) then { + l := [line] + until match("@end docs ", line) do + put(l, line := read()) +#write("******until completed with ", line) + put(l, line) + if /nearcode then { + pipeout(l, cmd) + last := &null + } else if last === "code" & notblank(l) then { + pipeout(l, cmd) + every write("@begin docs 0" | "@nl" | "@end docs 0") + last := &null + } else { + last := l + } + } else { + write(line) + } + } + return +end + +#line 52 "pipedocs.nw" +procedure pipeout(lines, cmd) + f := open(cmd, "wp") + every write(f, !lines) + return close(f) +end + +#line 59 "pipedocs.nw" +procedure notblank(l) + every x := !l do + x ? + if ="@nl" & pos(0) then + fail + else if ="@text " & { tab(many(' \t')); not(pos(0)) } then + return x +end + + diff --git a/web/noweb/src/icon/pipedocs.nw b/web/noweb/src/icon/pipedocs.nw new file mode 100644 index 0000000000..bc2ac8df5d --- /dev/null +++ b/web/noweb/src/icon/pipedocs.nw @@ -0,0 +1,69 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +This code pipes documentation chunks through a command. +If given option [[-nearcode]], it pipes only documentation chunks that +are next to code chunks; it drops all other documentation chunks. +<<*>>= +procedure main(args) + if args[1] == "-nearcode" then + nearcode := get(args) + cmd := get(args) | stop("pipedocs: no command") + + cmd := "sed '/^@begin docs /s/[0-9][0-9]*/0/' | unmarkup | " || cmd || + " | awk ' NR == 1 && /^[ \t]*$/ {next}\n{print}\n' | markup | grep -v '^@file $'" + + last := &null + + while line := read() do + {## write("====> process ", image(line), "; last = ", type(last), + ## "(", *\last | "?", "), lastcode = ", image(lastcode)) + if match("@begin code ", line) then { + if type(last) == "list" then + pipeout(last, cmd) + last := "code" + until match("@end code ", line) do { + write(line) + line := read() + } + write(line) +#write("******until completed with ", line) + } else if match("@begin docs ", line) then { + l := [line] + until match("@end docs ", line) do + put(l, line := read()) +#write("******until completed with ", line) + put(l, line) + if /nearcode then { + pipeout(l, cmd) + last := &null + } else if last === "code" & notblank(l) then { + pipeout(l, cmd) + every write("@begin docs 0" | "@nl" | "@end docs 0") + last := &null + } else { + last := l + } + } else { + write(line) + } + } + return +end + +<<*>>= +procedure pipeout(lines, cmd) + f := open(cmd, "wp") + every write(f, !lines) + return close(f) +end + +<<*>>= +procedure notblank(l) + every x := !l do + x ? + if ="@nl" & pos(0) then + fail + else if ="@text " & { tab(many(' \t')); not(pos(0)) } then + return x +end + + diff --git a/web/noweb/src/icon/promeladefs.icn b/web/noweb/src/icon/promeladefs.icn new file mode 100644 index 0000000000..183e53d16b --- /dev/null +++ b/web/noweb/src/icon/promeladefs.icn @@ -0,0 +1,97 @@ +#line 2 "promeladefs.nw" +global showlocal +procedure rcsinfo () + return "$Id: promeladefs.nw,v 1.17 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +procedure main(args) + showlocal := !args == "-local" + go() +end +#line 12 "promeladefs.nw" +procedure postpass(name, arg) + static kind, mtype + initial { kind := "bogus" } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if \mtype then + mtype := write_mtypes() + else if (optwhite(), =("proctype "|"chan ")) then { + tab(many(' ')) + writedefn(tab(upto(' ():;'))) + } else if (optwhite(), ="mtype", optwhite(), ="{") then + mtype := write_mtypes() + } + return +end + +procedure write_mtypes() + static start, alnum + initial { start := &letters ++ '/,}'; alnum := &letters ++ &digits ++ '_' } + optwhite() + while any(start) do { + if ="/*" then tab(upto("*/") | 0) + else if ="," then &null + else if ="}" then return &null + else if any(alnum) then writedefn(tab(many(alnum))) + else if pos(0) then return 1 + else if ="/" then return &null + else { write(&errout, "bad mtype ", tab(0)); return &null } + optwhite(); + } + return if pos(0) then 1 else &null +end + + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end + + +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/promeladefs.nw b/web/noweb/src/icon/promeladefs.nw new file mode 100644 index 0000000000..cda5d81336 --- /dev/null +++ b/web/noweb/src/icon/promeladefs.nw @@ -0,0 +1,56 @@ +\section{Finding Promela definitions} +<<*>>= +global showlocal +procedure rcsinfo () + return "$Id: promeladefs.nw,v 1.17 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +procedure main(args) + showlocal := !args == "-local" + go() +end +<<*>>= +procedure postpass(name, arg) + static kind, mtype + initial { kind := "bogus" } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if \mtype then + mtype := write_mtypes() + else if (optwhite(), =("proctype "|"chan ")) then { + tab(many(' ')) + writedefn(tab(upto(' ():;'))) + } else if (optwhite(), ="mtype", optwhite(), ="{") then + mtype := write_mtypes() + } + return +end + +procedure write_mtypes() + static start, alnum + initial { start := &letters ++ '/,}'; alnum := &letters ++ &digits ++ '_' } + optwhite() + while any(start) do { + if ="/*" then tab(upto("*/") | 0) + else if ="," then &null + else if ="}" then return &null + else if any(alnum) then writedefn(tab(many(alnum))) + else if pos(0) then return 1 + else if ="/" then return &null + else { write(&errout, "bad mtype ", tab(0)); return &null } + optwhite(); + } + return if pos(0) then 1 else &null +end + + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end + + diff --git a/web/noweb/src/icon/sl2h.icn b/web/noweb/src/icon/sl2h.icn new file mode 100644 index 0000000000..22a571c534 --- /dev/null +++ b/web/noweb/src/icon/sl2h.icn @@ -0,0 +1,2167 @@ +#line 217 "l2h.nw" +procedure star(cs) + suspend cs | (cs || "*") +end +#line 596 "l2h.nw" +procedure asciiCharCode(S) + return emit_text(S, char(2(optwhite(), TeXnumber(), optwhite()))) +end +procedure TeXnumber() + return integer( + (="'", "8r" || tab(many(&digits))) | + (="\"", "16r" || tab(many(&digits))) | + tab(many(&digits))) +end +#line 671 "l2h.nw" +procedure convert(S, optstring) + static specials + initial { + +#line 819 "l2h.nw" +activetab := table(unknown_cs) +activeclosure := table() +#line 969 "l2h.nw" +cstab := table(unknown_cs) +csclosure := table() +#line 987 "l2h.nw" +unknown_set := set() +#line 1015 "l2h.nw" +every begintab | endtab := table(unknown_env) +every begincl | endcl := table() +#line 1028 "l2h.nw" +unknown_envs := set() +#line 1381 "l2h.nw" +liststack := [] +# write(&errout, "Initialized liststack") +suspendstack := [] +#line 1961 "l2h.nw" +countertab := table() +#line 1969 "l2h.nw" +accent_name := table() +accent_valid := table('') +accent_name ["`"] := "grave" +accent_valid["`"] := 'AEIOUaeiou' +accent_name ["'"] := "acute" +accent_valid["'"] := 'AEIOUYaeiouy' +accent_name ["^"] := "circ" +accent_valid["^"] := 'AEIOUaeiou' +accent_name ["hat"] := "circ" +accent_valid["hat"] := 'AEIOUaeiou' +accent_name ["\""] := "uml" +accent_valid["\""] := 'AEIOUaeiouy' +accent_name ["~"] := "tilde" +accent_valid["~"] := 'ANOano' +accent_name ["="] := "bar" +accent_name ["."] := "dot" +accent_name ["u"] := "u" +accent_name ["v"] := "v" +accent_name ["H"] := "H" +accent_name ["t"] := "t" +accent_name ["c"] := "cedil" +accent_valid["c"] := 'Cc' +accent_name ["d"] := "underdot" +accent_name ["b"] := "underbar" +#line 2675 "l2h.nw" +csfunctions := table() +#line 675 "l2h.nw" + +#line 114 "l2h.nw" +substitution(",", " ") +substitution(" ", " ") +substitution("\n", "\n") +substitution("\t", " ") +ignore("raggedright") +ignore("@") +ignore("/") # no italic correction +substitution("", "\n") # \<newline> treated as request for newline +every c := !"$%#{}_" do + substitution(c, c) +substitution("&", "&") +argblock("emph", "em") +every argblock("footnote" | "footnotetext" | "thanks", + " <b>[</b>", "<b>]</b> ") # put footnotes in bold brackets +substitution("today", &date) +#line 132 "l2h.nw" +ignore("textrm") # html can't switch to default font! +argblock("textit", "i") +argblock("textbf", "b") +argblock("textsl", "i") +ignore("textsc") +argblock("texttt", "tt") +ignore("textsf") +ignore("boldmath") +# \boldmath could be done by introducing S.mathfont, but I don't want to! +#line 142 "l2h.nw" +ignore("mathrm") # html can't switch to default font! +argblock("mathit", "i") +argblock("mathbf", "b") +argblock("mathtt", "tt") +ignore("mathsf") +argblock("mathcal", "i") +every ignore("scriptstyle"|"displaystyle"|"scriptscriptstyle") +every ignore("mathord"|"mathbin"|"mathrel") +#line 152 "l2h.nw" +every ignore("tiny" | "scriptsize" | "footnotesize" | "small" | "normalsize" | + "large" | "Large" | "LARGE" | "huge" | "Huge") +#line 160 "l2h.nw" +every accent(key(accent_name)) +every ignore("dag" | "ddag") +substitution("S", "§") +substitution("P", "¶") +substitution("copyright", "©") +substitution("pounds", "£") +substitution("o", "ø") +substitution("O", "Ø") +substitution("aa", "å") +substitution("AA", "Å") +substitution("ae", "æ") +substitution("AE", "&Aelig;") +#line 175 "l2h.nw" +argblockv("part", "h1", &null, "*[") +argblockv("chapter", "h1", &null, "*[") +argblockv("section", "h2", &null, "*[") +argblockv("subsection", "h3", &null, "*[") +argblockv("subsubsection", "h4", &null, "*[") +argblockv("paragraph", "h5", &null, "*[") +argblockv("subparagraph", "h6", &null, "*[") +ignore("appendix") +auxfile("tableofcontents", "toc", + "<p>\n<tableofcontents>\n<b>[Table of contents]</b>\n</tableofcontents>\n<p>", + "<h2>Table of Contents</h2>\n<tableofcontents>\n", "\n</tableofcontents>\n") +cstab["tableofcontents"] := Ctableofcontents # override to call set_toclevel +ignore("listoftables") +ignore("listoffigures") +ignore("addtocontents", "{{") +ignoreenv("filecontents", "{") +#line 198 "l2h.nw" +cstab["("] := Cmath +cstab[")"] := Cmath_end +cstab["["] := Cdisplaymath +cstab["]"] := Cdisplaymath_end +ignoreenv("equation") +every table_env(star("eqnarray"), 0, " ", "<blockquote><i>", "</i></blockquote>") + # also lame +substitution("frac", "<b>frac</b>") +substitution("sqrt", "<b>frac</b>") +every substitution("ldots" | "cdots" | "vdots", "...") +ignore("left") +ignore("right") +ignore("overline") +substitution(":", " ") +substitution(";", " ") +ignore("!") +#line 223 "l2h.nw" +substitution("Diamond", "<>") +substitution("langle", "<") +substitution("rangle", ">") +substitution("le", "<=") +substitution("ne", "!=") +substitution("ge", ">=") +substitution("times", "×") +substitution("divide", "÷") +substitution("bmod", "</i>mod<i>") # better hook in with math +substitution("equiv", "===") +every x := "arccos" | "arcsin" | "arctan" | "arg" | "cos" | "cosh" | + "cot" | "coth" | "csc" | "deg" | "det" | "dim" | "exp" | + "gcd" | "hom" | "lim" | "liminf" | "limsup" | "ln" | "log" | + "max" | "min" | "sec" | "sin" | "sinh" | "sup" | "tan" | "tanh" +do + substitution(x, "</i>" || x || "<i>") +substitution("liminf", "</i>lim inf<i>") +substitution("limsup", "</i>lim sup<i>") +every x := "alpha" | "beta" | "gamma" | "delta" | "epsilon" | "zeta" | "eta" | + "theta" | "iota" | "kappa" | "lambda" | "nu" | "xi" | "pi" | + "rho" | "sigma" | "tau" | "upsilon" | "phi" | "chi" | "psi" | "omega" | + "in" +do + substitution(x, "<b>" || x || "</b>") +substitution("mu", "µ") +every x := "Gamma" | "Delta" | "Theta" | "Lambda" | "Xi" | "Pi" | "Sigma" | + "Upsilon" | "Phi" | "Psi" | "Omega" +do + substitution(x, "<b>" || x || "</b>") +#line 255 "l2h.nw" +substitution("lfloor", "</i>|_<i>") +substitution("rfloor", "</i>_|<i>") +substitution("leq", "<=") +substitution("geq", ">=") +substitution("ll", "«") +substitution("gg", "»") +substitution("Rightarrow", "==>") +substitution("rightarrow", "-->") +substitution("approx", "<u>~</u>") +#line 268 "l2h.nw" +envblock("quote", "blockquote") +envblock("quotation", "blockquote") +envblock("center", "blockquote") +envblock("flushleft", "blockquote") +envblock("flushright", "blockquote") +envblock("verse", "blockquote") +verbatim("verbatim", escape_HTML_specials, "pre") +cstab["verb"] := Cverb +cstab["verb*"] := Cverb +csclosure["verb*"] := 1 +cstab["verbatiminput"] := Cverbatiminput +csclosure["verbatiminput"] := verbatim_cl(escape_HTML_specials) +#line 284 "l2h.nw" +cstab["item"] := Citem +csclosure["item"] := [item_cl("<li>", "", "<li>")] +listenv("itemize", "ul") +listenv("enumerate", "ol") +listenv("description", "dl") +#line 292 "l2h.nw" +ignore("documentstyle", "[{") +ignore("documentclass", "[{") +ignore("usepackage", "[{") +ignore("pagestyle", "{") +ignore("thispagestyle", "{") +ignore("pagenumbering", "{") +ignore("newcounter", "{") +ignore("global") +ignore("etalchar") # used in the .bbl files: \newcommand{\etalchar}[1]{$^{#1}$} +#line 307 "l2h.nw" +argblockv("title", "h1") +argblockv("author","address") +argblockv("date", "b") +substitution("maketitle", "<!--title goes here-->") +ignoreenv("titlepage") +envblock("abstract", "<h2>Abstract</h2><blockquote>", "</blockquote>") +#line 322 "l2h.nw" +cstab["label"] := Clabel +cstab["ref"] := Cref +cstab["pageref"] := Cref +cstab["subpageref"] := Cref +cstab["chunklabel"] := Clabel +#line 332 "l2h.nw" +ignore("bibliographystyle", "{") +auxfile("bibliography", "bbl", "<b>[BibTeX bibliography]</b>", &null, &null, "{") +envblock("thebibliography", "<h2>References</h2>", "", "{") +every cstab["cite" | "citeN" | "opencite" | "openciteN" | "citeyear"] := Ccite +cstab["bibitem"] := Cbibitem +ignore("newblock") +ignore("nocite", "{") +#line 343 "l2h.nw" +every ignore("input" | "include" | "includeonly", "{") +# filecontents not done yet +#line 348 "l2h.nw" +cstab["\\"] := Cbackback +substitution("linebreak", "<br>") +ignore("-") +ignoreenv("sloppypar") +ignore("sloppy") +#line 357 "l2h.nw" +substitution("pagebreak", "<hr>") +substitution("newpage", "<hr>") +substitution("clearpage", "<hr>") +ignore("enlargethispage", "*{") +#line 364 "l2h.nw" +ignore("mbox") +ignore("makebox", "([[") # ( comes from picture area +ignore("fbox") +ignore("framebox", "[[") # could insert horizontal rules, but why? +ignore("newsavebox", 1) +ignore("sbox", 2) +ignore("savebox", "{[[{") +ignore("usebox", 1) +envblock("minipage", "blockquote", &null, "[{") +argblock("parbox", "blockquote", &null, "[{") +#line 377 "l2h.nw" +ignore("hspace", "*{") +ignore("hfil") +ignore("hfill") +ignore("vspace", "*{") +ignore("vfil") +ignore("vfill") +#line 386 "l2h.nw" +ignore("newlength", "{") +ignore("setlength", "{{") +ignore("addtolength", "{{") +#line 392 "l2h.nw" +envblock("picture", "<b>[picture]</b>", "", "((") +ignore("put", "({") +ignore("multiput", "(({{") +ignore("dashbox", "{([") +ignore("line", "({") +ignore("vector", "({") +ignore("shortstack", "[") +ignore("circle", "*{") +ignore("oval", "([") +ignore("frame") +ignore("thinlines") +ignore("thicklines") +#line 408 "l2h.nw" +every envblock(star("figure"), "<hr>", "<hr>", "[") +every envblock(star("table"), "<hr>", "<hr>", "[") +argblock("caption", "b") # captions in bold +#line 415 "l2h.nw" +envblock("tabbing", "blockquote") +# \= is accent +ignore(">") +ignore("+") +ignore("kill") +#line 423 "l2h.nw" +tabular("array", "[") +tabular("tabular", "[") +tabular("tabularx", "{[") +tabular("tabular*", "{[") +every cstab["multicolumn"|"multispan"] := Cmulticolumn +cstab["span"] := Cspan +cstab["noalign"] := Cnoalign +cstab["hline"] := Chline +cstab["toprule"] := Chline +cstab["midrule"] := Chline +cstab["bottomrule"] := Chline +ignore("cline", "{") +ignore("newcolumntype", "{{") +#line 439 "l2h.nw" +ignore("newcommand", "A[[{") +ignore("renewcommand", "A[[{") +ignore("providecommand", "A[[{") +ignore("newenvironment", "{[{{") +ignore("renewenvironment", "{[{{") +ignore("newtheorem", "{{") +#line 450 "l2h.nw" +cstab["setcounter"] := Csetcounter +ignore("addtocounter", "{{") +#line 455 "l2h.nw" +cstab["makeatletter"] := Cmakeatletter +cstab["makeatother"] := Cmakeatother +#line 460 "l2h.nw" +every fontchange("tt" | "ttfamily", "tt") +every fontchange("bf" | "bfseries", "b") +every fontchange("it" | "itshape", "i") +fontchange("sl", "i") +fontchange("em", "em") +ignore("rm") # html can't switch to default font! +ignore("sf") +ignore("sc") +#line 470 "l2h.nw" +ignore("rmfamily") +ignore("normalfont") +#line 473 "l2h.nw" +ignoreenv("document") +#line 475 "l2h.nw" +substitution("LaTeX", "LaTeX") +#line 477 "l2h.nw" +ignore("numberline", "{") +ignore("protect") +ignore("onecolumn") +ignore("twocolumn", "C") +ignore("typeout", "[{") +ignore("closedbib") +#line 484 "l2h.nw" +every ignore("leftmargini" | "leftmarginii" | "labelsep" | "fboxsep", "=") +every ignore("tabcolsep", "=") +every ignore("evensidemargin" | "marginparsep" | "marginparwidth" | + "oddsidemargin" | "textheight" | "textwidth" | "topmargin", "=") +#line 489 "l2h.nw" +ignore("DeclareMathVersion", "{") +ignore("mathversion", "{") +ignore("setpapersize", "{") +ignore("setmarginsrb", "{{{{{{{{") +ignore("marginparwidth", "=") +ignore("marginparsep", "=") +#line 498 "l2h.nw" +ignoreenv("multicols", "{C") +cstab["citeN"] := Ccite +ignore("afterpage", "{") +every cstab["psfig"|"epsfig"] := Cepsfig +cstab["includegraphics"] := Cincludegraphics +ignore("newcolumntype", "{{") +#line 507 "l2h.nw" +cstab["kill"] := Ckill +#line 511 "l2h.nw" +activesubst("~", " ") +argblock("centerline", "<br>", "<br>") +substitution("cr", "<br>") +substitution("hrule", "<hr>") +substitution("vrule", "|") +substitution("hrulefill", "------") +ignore("hyphenation", "{") +ignore("hbox") +ignore("rlap") +ignore("llap") +ignore("vbox") +ignore("vtop") +ignore("hidewidth") +ignore("message", "{") +ignore("relax") +ignore("null") +ignore("offinterlineskip") +ignore("omit") +ignore("newdimen", "{") +ignore("nobreak") +#line 532 "l2h.nw" +cstab["par"] := implicit_paragraph +cstab["smallskip"] := implicit_paragraph +cstab["medskip"] := implicit_paragraph +cstab["bigskip"] := implicit_paragraph +cstab["vskip"] := implicit_paragraph +csclosure["vskip"] := "=" +#line 544 "l2h.nw" +every ignore("begingroup" | "endgroup" | "bgroup" | "egroup") +#line 546 "l2h.nw" +cstab["newif"] := Cnewif +cstab["iffalse"] := Ciffalse +cstab["iftrue"] := Ciftrue +cstab["ifhtml"] := Ciftrue # false in LaTeX, but true when converting! +cstab["else"] := Celse +cstab["fi"] := Cfi +cstab["ifx"] := cstab["if"] := cstab["ifnum"] := Ciffalse +#line 556 "l2h.nw" +ignore("let", "A=") +every ignore("hfuzz" | "parindent" | "parskip" | "baselineskip", "=") +every ignore("hbadness" | "hsize" | "vsize" | "overfullrule" | "tabskip", "=") +every ignore("extrarowheight" | "codemargin", "=") +every ignore("looseness", "=") +substitution("hskip", " ", "=") +ignore("setbox", "{=") +every ignore("box" | "unhbox" | "unvbox", "{") +#line 565 "l2h.nw" +ignore("unskip") +ignore("hss") +ignore("phantom", "{") +every ignore("kern" | "lower" | "spacefactor", "=") # a cheat, but works +every ignore("clubpenalty" | "widowpenalty", "=") +#line 578 "l2h.nw" +every ignore("expandafter" | "indent" | "noindent" | "leavevmode" | "strut") +ignore("def", 1) +#line 581 "l2h.nw" +substitution("TeX", "TeX") +substitution("BibTeX", "BibTeX") +substitution("MF", "METAFONT") +#line 594 "l2h.nw" +cstab["char"] := asciiCharCode +#line 608 "l2h.nw" +macro("nwanchorto", 2, "<a href=\"#$1\">#2</a>") +macro("nwanchorname", 2, "<a name=\"#$1\">#2</a>") +ignore("nwaddbox", "{") +verbatim("latexonly", do_nothing) +verbatim("rawhtml", emit_text) +#line 617 "l2h.nw" +substitution("quad", " ") +#line 624 "l2h.nw" +ignore("noweboptions", 1) +#line 630 "l2h.nw" +substitution("nowebindex", "<nowebindex>") +substitution("nowebchunks", "<nowebchunks>") +ignore("nowebsize") +#line 634 "l2h.nw" +envblock("fields", "blockquote", &null, "[") # lame; could try to <tt> 1st col +envblock("fields*", "blockquote", &null, "{") # lame; could try to <tt> 1st col +ignore("citeauthoryear", "{{{") +ignore("authoryear", "{{") +substitution("bibrule", "--------") +let("bibskip", "par") +every cstab["anoncite"|"authorcite"] := Ccite +#line 644 "l2h.nw" +ignore("pssilent") +ignore("psnoisy") +#line 1012 "l2h.nw" +cstab["begin"] := do_begin +cstab["end"] := do_end +#line 1385 "l2h.nw" +cstab["suspend"] := Csuspend +cstab["resume"] := Cresume +#line 1603 "l2h.nw" +cstab["uppercase"] := Cuppercase +#line 1899 "l2h.nw" +cstab["contentsline"] := Ccontentsline +#line 676 "l2h.nw" + +#line 2677 "l2h.nw" +csfunctions["argblock"] := argblock +csfunctions["argblockv"] := argblockv +csfunctions["envblock"] := envblock +csfunctions["fontchange"] := fontchange +csfunctions["ignore"] := ignore +csfunctions["ignoreenv"] := ignoreenv +csfunctions["let"] := let +csfunctions["letenv"] := letenv +csfunctions["listenv"] := listenv +csfunctions["substitution"] := substitution +csfunctions["activesubst"] := activesubst +csfunctions["closure"] := let_closure +csfunctions["let_closure"] := let_closure +csfunctions["newcommand"] := l2h_macro +csfunctions["macro"] := l2h_macro +csfunctions["environment"] := l2h_environment +csfunctions["tabular"] := tabular +#line 677 "l2h.nw" + specials := '\\{}<>-\'`"%$&~\n\0\1' + } + + if \optstring then return optstring ? convert(S) + else { + +#line 867 "l2h.nw" +l := S.newtext +S.newtext := [] +while c := get(l) do + c.proc!c.args +#line 700 "l2h.nw" +if S.mode == "V" & any(~'\\{}<>%\n\t ') then S.mode := "H" +emit_text(S, tab(upto(specials) | 0)) +while not pos(0) do + if S.mode == "Q" then { # quoting + emit_text(S, tab(upto('\1') | 0)) + if ="\1" then { + emit_text(S, "\1") + S.mode := S.quotemode + } + } else { + if any(S.activechars) then + do_activechar(S, move(1)) + else + case move(1) of { + "\\" : { +#line 941 "l2h.nw" +cs := if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1) +if /S.ignoring | cs == ("else"|"fi") | cstab[cs] === (Ciffalse|Ciftrue) then + do_cs(S, cs) +else + &null # error("### Ignoring \\", cs) +#line 714 "l2h.nw" + } + "{" : { +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 715 "l2h.nw" + } + "}" : { +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 716 "l2h.nw" + } + "%" : { +#line 1066 "l2h.nw" +parse_dynamic_add(S) +delay_newtext(S) +eat_comment(S) +#line 717 "l2h.nw" + } + "\n" : { +#line 1313 "l2h.nw" +emit_text(S, "\n") +if /S.ignoring then Cnewline(S) +#line 718 "l2h.nw" + } + "$" : { +#line 1301 "l2h.nw" +if /S.ignoring then + if ="$" then + if S.mode == "M" then { Cdisplaymath_end(S); S.mode := "V" } + else { Cdisplaymath(S); S.mode := "M" } + else + if S.mode == "M" then { Cmath_end(S); S.mode := "H" } + else { Cmath(S); S.mode := "M" } +#line 719 "l2h.nw" + } + "&" : ampersand(S) + "\0" : {S.quotemode := S.mode; S.mode := "Q"; emit_text(S, "\0")} + # remaining cases simply escape HTML specials + "<" : emit_text(S, "<") + ">" : emit_text(S, ">") + "\"" : emit_text(S, """) + "-" : { +#line 735 "l2h.nw" +if S.mode == "V" then S.mode := "H" +if S.mode == "H" then + if ="--" then emit_text(S, "—") + else if ="-" then emit_text(S, "–") + else emit_text(S, "-") +else + emit_text(S, "-") +#line 726 "l2h.nw" + } + "`" : { +#line 746 "l2h.nw" +if S.mode == "V" then S.mode := "H" +if \html_quotes & S.mode == "H" then + if ="`" then emit_text(S, "“") + else emit_text(S, "‘") +else + emit_text(S, "`") +#line 727 "l2h.nw" + } + "'" : { +#line 753 "l2h.nw" +if S.mode == "V" then S.mode := "H" +if \html_quotes & S.mode == "H" & ="'" then emit_text(S, "”") +else emit_text(S, "'") +#line 728 "l2h.nw" + } + } + if S.mode == "V" & any(~'\\{}<>%\n\t ') then S.mode := "H" + emit_text(S, tab(upto(specials++S.activechars) | 0)) + } +return 1(. S.the_text, S.the_text := "") # what's been converted +#line 683 "l2h.nw" + } +end +#line 744 "l2h.nw" +global html_quotes # render quotes as HTML 4 entities +#line 760 "l2h.nw" +record state(mode, quotemode +#line 788 "l2h.nw" +, text, the_text +#line 804 "l2h.nw" +, ignoring +#line 822 "l2h.nw" +, activechars +#line 844 "l2h.nw" +, newtext +#line 887 "l2h.nw" +, delayed_newtext +#line 897 "l2h.nw" +, open, closes +#line 949 "l2h.nw" +, csletters +#line 1082 "l2h.nw" +, comment +#line 1521 "l2h.nw" +, ifstack +#line 1628 "l2h.nw" +, tables +#line 760 "l2h.nw" + ) + # mode is Q, H, V, or M + # quotemode is saved mode: H, V, or M +#line 766 "l2h.nw" +procedure converter(mode) + /mode := "V" + return state(mode, mode +#line 790 "l2h.nw" +, accumulate_text, "" +#line 806 "l2h.nw" +, &null +#line 824 "l2h.nw" +, '~' +#line 846 "l2h.nw" +, [] +#line 889 "l2h.nw" +, [] +#line 899 "l2h.nw" +, [], [] +#line 951 "l2h.nw" +, &letters +#line 1084 "l2h.nw" +, "" +#line 1523 "l2h.nw" +, [] +#line 1630 "l2h.nw" +, [] +#line 768 "l2h.nw" + ) +end +#line 774 "l2h.nw" +procedure reset(S) + +#line 792 "l2h.nw" +S.text := accumulate_text +S.the_text := "" +#line 808 "l2h.nw" +S.ignoring := &null +#line 826 "l2h.nw" +S.activechars := '~' +#line 848 "l2h.nw" +S.newtext := [] +#line 891 "l2h.nw" +S.delayed_newtext := [] +#line 901 "l2h.nw" +every S.open | S.closes := [] +#line 953 "l2h.nw" +S.csletters := &letters +#line 1086 "l2h.nw" +S.comment := "" +#line 1525 "l2h.nw" +if *S.ifstack > 0 then S.ifstack := [] # keeps GC down +#line 1632 "l2h.nw" +S.tables := [] +#line 776 "l2h.nw" + return S +end +#line 783 "l2h.nw" +procedure accumulate_text(S, text) + S.the_text ||:= text + return +end +#line 800 "l2h.nw" +procedure emit_text(S, text) + return if \S.ignoring then "" else S.text(S, text) +end +#line 813 "l2h.nw" +global activetab, activeclosure +procedure do_activechar(S, c) + (activetab[c])(S, c, activeclosure[c]) + return +end +#line 852 "l2h.nw" +record closure(proc, args) +#line 857 "l2h.nw" +procedure before_next_newtext(S, proc, args) + push(S.newtext, closure(proc, args)) +end + +procedure after_next_newtext(S, proc, args) + put(S.newtext, closure(proc, args)) +end +#line 876 "l2h.nw" +procedure delay_newtext(S) + push(S.delayed_newtext, S.newtext) + S.newtext := [] + return +end + +procedure undelay_newtext(S) + S.newtext := \pop(S.delayed_newtext) | + {write(&errout, "This can't happen: no delayed_newtext"); &null[0]} +end +#line 903 "l2h.nw" +procedure after_next_open(S, proc, args) + return put(S.open, closure(proc, args)) +end + +procedure before_next_close(S, proc, args) + return push(S.closes[1], closure(proc, args)) # lost at top level +end + +procedure after_next_close(S, proc, args) + return put(S.closes[1], closure(proc, args)) # lost at top level +end +#line 960 "l2h.nw" +global cstab, csclosure + +procedure do_cs(S, cs) + tab(many(' \t')) # skip white space following CS + if pos(0) | any('\n') then before_next_newtext(S, skipblanks, [S]) + (cstab[cs])(S, cs, csclosure[cs]) + return +end +#line 976 "l2h.nw" +global show_unknowns +procedure unknown_cs(S, cs, cl) +# if S.text === ignore_text then return # a bit of a hack -- should no longer be needed + if \show_unknowns then S.text(S, "<b>\\" || cs || "</b>") + if not member(unknown_set, cs) then { + write(\unknown_file, "Warning: unknown control sequence \\", cs) + insert(unknown_set, cs) + } + return +end +#line 989 "l2h.nw" +global cstab, csclosure, unknown_set +#line 995 "l2h.nw" +global begintab, endtab, begincl, endcl + +procedure do_begin(S, cs, cl) + (="{", env := tab(upto('}')), ="}") | error("botched \\begin{...}") + +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 1000 "l2h.nw" + (begintab[env])(S, env, begincl[env]) + return +end + +procedure do_end(S, cs, cl) + (="{", env := tab(upto('}')), ="}") | error("botched \\end{...}") + # write(&errout, "calling ", image(endtab[env]), " for \\end{", env, "}") + (endtab[env])(S, env, endcl[env]) + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 1009 "l2h.nw" + return +end +#line 1018 "l2h.nw" +procedure unknown_env(S, env, cl) +### if S.text === ignore_text then return # a bit of a hack # no longer needed + if \show_unknowns then S.text(S, "<b>{" || env || "}</b>") + if not member(unknown_envs, env) then { + write(\unknown_file, "Warning: unknown environment {", env, "}") + insert(unknown_envs, env) + } + return +end +#line 1030 "l2h.nw" +global unknown_envs +#line 1034 "l2h.nw" +procedure warn_unknown(s, type, mark, rmark) + if *s > 0 then { + pushout("Unknown " || type || ": ") + every pushout(((\mark | "")\1) || !sort(s) || ((\rmark | "")\1) || " ") + pushout("\n") + } +end +#line 1042 "l2h.nw" +procedure pushout(s) + static col + initial col := 0 + if find("\n", s) then + s ? { + pushout(tab(upto('\n'))) + while ="\n" do {col := 0; write(&errout)} + pushout(tab(0)) + } + else { + col +:= *s + if col >= 79 then {writes(&errout, "\n "); col := *s + 2} + writes(&errout, s) + } + return +end +#line 1070 "l2h.nw" +procedure eat_comment(S) + S.comment ||:= tab(upto('\n') | 0) + if pos(0) then + before_next_newtext(S, eat_comment, [S]) + else { + undelay_newtext(S) + Ccomment(S) + S.comment := "" + } + return +end +#line 1106 "l2h.nw" +record verbatim_cl(output, terminator, html, translate_blank) + +procedure verbatim(name, output, html) + begintab[name] := Cverbatim + begincl [name] := verbatim_cl(output, &null, html) + return +end + +procedure Cverbatim(S, cs, cl) + if cl === begincl[cs] & /cl.terminator then + cl := begincl[cs] := + verbatim_cl(cl.output, "\\end{" || cs || "}", cl.html, cl.translate_blank) + emit_text(S, tag(\cl.html)) + delay_newtext(S) + do_verbatim(S, cl) + return +end +#line 1128 "l2h.nw" +procedure do_verbatim(S, cl) + if cl.output(S, tab(find(cl.terminator)), cl) then { + =cl.terminator + emit_text(S, endtag(\cl.html)) + undelay_newtext(S) + } else { + cl.output(S, tab(0), cl) + before_next_newtext(S, do_verbatim, [S, cl]) + } + return +end +#line 1142 "l2h.nw" +procedure escape_HTML_specials(S, s, cl) + s ? { + while emit_text(S, tab(upto('&<>" '))) do + case move(1) of { + "\"" : emit_text(S, """) + "&" : emit_text(S, "&") + "<" : emit_text(S, "<") + ">" : emit_text(S, ">") + " " : emit_text(S, if \cl.translate_blank then "·" else " ") + } + emit_text(S, tab(0)) + } + return +end +#line 1160 "l2h.nw" +procedure Cverb(S, cs, cl) + Cverbatim(S, cs, verbatim_cl(escape_HTML_specials, move(1), "tt", cl)) + return +end +#line 1166 "l2h.nw" +procedure Cverbatiminput(S, cs, cl) + local filename, f, line + if ="{" & filename := tab(upto('}')) & ="}" then { + f := \open(filename) | { emit_text(S, "<strong>Could not read file</strong> <tt>") + escape_HTML_specials(S, filename, cl) + emit_text(S, "</tt>") + return + } + emit_text(S, "\n<pre>\n") + while line := read(f) do { + escape_HTML_specials(S, line, cl) + emit_text(S, "\n") + } + emit_text(S, "</pre>\n") + close(f) + } + return +end +#line 1190 "l2h.nw" +procedure csarg(S) + return 2(="{", tab(bal('}', '{', '}')), ="}") | + (optwhite(), + if ="\\" then + "\\" || (tab(many(S.csletters)) | move(1)) + else + move(1)) +end +#line 1225 "l2h.nw" +procedure apply_args(S, p, as, args_wanted) + delay_newtext(S) + do_apply_args(S, closure(p, as), args_wanted, [], "", 0) + return +end + +procedure do_apply_args(S, cl, wanted_count, args_seen, current_arg, brace_depth) + local open_comment + # invariant : we have an open brace +# pushtrace("APPLY") + while *args_seen < wanted_count & not pos(0) do { + while *args_seen < wanted_count & brace_depth = 0 & not pos(0) do { + tab(many(' \t\n')) + case c := move(1) of { + "\\" : put(args_seen, "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1)) + "{" : { current_arg := "" ; brace_depth := 1 } + "}" : { error("Insufficient arguments to macro ", macro.name) } + "%" : if tab(upto('\n')) then ="\n" else open_comment := tab(0) + default : put(args_seen, c) + } + } + while brace_depth > 0 & not pos(0) do { + current_arg ||:= tab(upto('\\{}%') | 0) + case move(1) of { + "%" : if tab(upto('\n')) then ="\n" else open_comment := tab(0) + "\\" : current_arg ||:= "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1) + "{" : { current_arg ||:= "{" ; brace_depth +:= 1 } + "}" : { brace_depth -:= 1 + if brace_depth > 0 then + current_arg ||:= "}" + else { + put(args_seen, current_arg) + current_arg := "" + } + } + } + } + } + if *args_seen = wanted_count then { + undelay_newtext(S) + cl.proc ! (cl.args ||| args_seen) + } else if \open_comment then { + delay_newtext(S) + before_next_newtext(S, skip_comment_and_continue, + [S, closure(do_apply_args, [S, cl, wanted_count, args_seen, + current_arg, brace_depth])]) + } else + before_next_newtext(S, do_apply_args, [S, cl, wanted_count, args_seen, + current_arg, brace_depth]) +# poptrace() + return +end +#line 1284 "l2h.nw" +procedure skip_comment_and_continue(S, cl) + tab(upto('\n') | 0) + if pos(0) then + before_next_newtext(S, skip_comment_and_continue, [S, cl]) + else { + ="\n" + undelay_newtext(S) +# <take actions appropriate to new text>> + } + return +end +#line 1316 "l2h.nw" +procedure Cnewline(S) + tab(many(' \t')) + if match("\n") then implicit_paragraph(S) + if pos(0) then before_next_newtext(S, Cnewline, [S]) +end +#line 1325 "l2h.nw" +procedure skipblanks(S) + tab(many(' \t')) + if ="\n" then Cnewline(S) + else if pos(0) then before_next_newtext(S, skipblanks, [S]) +end +#line 1334 "l2h.nw" +procedure implicit_paragraph(S, cs, cl) + if S.mode ~== "V" then { + S.mode := "V" + Cparagraph(S) + } + cs_ignore(S, cs, \cl) +end +#line 1347 "l2h.nw" +procedure stop_skipping(S) + while S.newtext[1].proc === (Cnewline|skipblanks) do pop(S.newtext) +end +#line 1357 "l2h.nw" +record item_cl(before, after, ifnone) + +procedure Citem(S, cs, cl) + if pos(0) then + after_next_newtext(S, Citem, [S, cs, cl]) + else if ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", convert_bracketed, cl) + } else { + skipblanks(S) + emit_text(S, cl[1].ifnone) + \liststack[1] := \liststack[1] + 1 + } +end +#line 1372 "l2h.nw" +procedure convert_bracketed(S, contents, cl) + emit_text(S, cl[1].before || + convert(converter("H"), "{" || contents || "}") || + cl[1].after) + optwhite() +end +#line 1379 "l2h.nw" +global liststack, suspendstack +#line 1388 "l2h.nw" +procedure listenv(env, html) + begintab[env] := Clist + begincl[env] := html + endtab[env] := Clist_end + endcl[env] := html +end + +procedure push_item_closure(cs) + push(csclosure["item"], + if cs == "description" then item_cl("<dt>", "<dd>", "<dt><dd>") + else item_cl("<li>", "--", "<li>")) +end + +procedure Clist(S, cs, cl) + push(liststack, 1) + push_item_closure(cs) + emit_text(S, tag(cl)) +end + +procedure Cresume(S, cs, cl) + local n, env + (="{", env := tab(upto('}')), ="}") | error("botched \\resume{...}") + n := pop(suspendstack) | error("\\resume not balanced by corresponding \\suspend") + push(liststack, n) + push_item_closure(env) + if env == "enumerate" then + emit_text(S, tag(begincl[env] || " start=\"" || n || "\"")) + else + emit_text(S, tag(begincl[env])) +end + +procedure Clist_end(S, cs, cl) + emit_text(S, endtag(cl)) + pop(csclosure["item"]) + pop(liststack) +end + +procedure Csuspend(S, cs, cl) + local env + (="{", env := tab(upto('}')), ="}") | error("botched \\suspend{...}") + emit_text(S, endtag(endcl[env])) + pop(csclosure["item"]) + push(suspendstack, pop(liststack)) +end +#line 1437 "l2h.nw" +global labels_seen + +procedure Clabel(S, cs, cl) + initial /labels_seen := set() + insert(labels_seen, l := csarg(S)) | fail + emit_text(S, "<a name=\"" || l || "\"><b>[*]</b></a>") +end + +procedure Cref(S, cs, cl) + local prefix, prefix_tag + initial /labels_seen := set() + prefix_tag := (\cl)[1] | "" + prefix := (\cl)[2] | "" + l := prefix || csarg(S) | fail + emit_text(S, prefix_tag || "<a href=\"#" || l || "\">[" || + (if member(labels_seen, l) then "<-" else "->") || "]</a>") +end +#line 1463 "l2h.nw" +procedure Ccite(S, cs, cl, bracketed_text) + if ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", do_cite, cl) + } else + do_cite(S, &null, cl) +end + +procedure do_cite(S, commentary, cl) + local key + if \commentary then + optwhite() + if pos(0) then before_next_newtext(S, do_cite, [S, commentary, cl]) + else { + key := csarg(S) + \commentary := convert(converter("H"), "{" || \commentary || "}") + emit_text(S, "<b>[cite ") + key ? { + while k := tab(upto(",")) & ="," do + emit_text(S, "<a href=\"#NWcite-" || k || "\">" || k || "</a>, ") + if k := tab(0) then + emit_text(S, "<a href=\"#NWcite-" || k || "\">" || k || "</a>") + } + emit_text(S, ", <i>" || \commentary || "</i>") + emit_text(S, "]</b>") + } +end +#line 1491 "l2h.nw" +procedure Cbibitem(S, cs, cl) + local label, key + static counter + initial counter := 0 + if ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", finish_bibitem, []) + } else { + label := "<b>[" || (counter +:= 1) || "]</b>" + apply_args(S, do_bibitem_key, [S, label], 1) + } +end + +procedure do_bibitem_key(S, label, key) + return emit_text(S, "<a name=\"NWcite-" || key || "\">" || label || "</a> ") +end + +procedure finish_bibitem(S, contents, args) + local key, label + optwhite() + label := convert(converter("H"), "{" || contents || "}") + key := apply_args(S, do_bibitem_key, [S, label], 1) +end +#line 1529 "l2h.nw" +record ifrec(on_else, on_fi) +#line 1538 "l2h.nw" +procedure Ciffalse(S, cs, cl) +#error("### \\", cs, " -> false (S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}, ")") + push(S.ifstack, ifrec(S.ignoring, S.ignoring)) + S.ignoring := 1 +end + +procedure Ciftrue(S, cs, cl) +#error("### \\", cs, " -> true (S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}, ")") + push(S.ifstack, ifrec(1, S.ignoring)) +end + +procedure Celse(S, cs, cl) + S.ignoring := S.ifstack[1].on_else +#error("### \\else -> S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}) +end + +procedure Cfi(S, cs, cl) + S.ignoring := S.ifstack[1].on_fi +#error("### \\fi -> S.ignoring === ", image(S.ignoring) ? {="procedure "; tab(0)}) + pop(S.ifstack) +end +#line 1563 "l2h.nw" +procedure Cnewif(S, cs, cl) + local newif, newcs + tab(many(' \t\n')) + if pos(0) then + after_next_newtext(S, Cnewif, [S, cs, cl]) + else { + newif := csarg(S) + newif ? + if ="\\if" & newcs := tab(many(S.csletters)) & pos(0) then { + +#line 1580 "l2h.nw" +cstab[newcs || "false"] := Csetif +cstab[newcs || "true"] := Csetif +cstab["if" || newcs] := Ciffalse +#line 1573 "l2h.nw" + } else + error("\\newif argument botch: " || newif) + } +end +#line 1584 "l2h.nw" +procedure Csetif(S, cs, cl) + local base, tag + if cs ? (base := tab(find("true"|"false")), tag := =("true"|"false"), pos(0)) then { + cstab["if" || base] := if tag == "true" then Ciftrue else Ciffalse + } else { + error("This can't happen --- setif botch (not urgent)") + } +end +#line 1598 "l2h.nw" +procedure Cuppercase(S, cs, cl) + l := map(csarg(S), &lcase, &ucase) | fail + emit_text(S, l) +end +#line 1613 "l2h.nw" +record table_info(index, # number of this cell in the row + alignment, # the alignment of this cell + width, # how many columns this cell will span + alignments, # default alignments for this table + brace_depth, # size of S.closes after start of cell + cell_text) # value of S.text to use to scan this cell +#line 1637 "l2h.nw" +procedure start_table_cell(S, text) + local this, attributes + + text ? { + tab(many(' \t\n')) + if pos(0) then return + } +# write(&errout, "starting cell with ", image(text)) + + this := S.tables[1] | fatal("starting cell with no current table") + S.text := this.cell_text + +if /(\this).brace_depth then write(&errout, "starting table cell, ", image(this), " has null brace depth") + # use this to start the current cell + if this.index = 1 then emit_text(S, "<tr>") + attributes := \this.alignment | aligneq("top") + if this.width > 1 then attributes ||:= " colspan=" || this.width + emit_text(S, "<td" || attributes || ">") + + # now update state for the next cell + this.index +:= this.width # advance to next cell + this.alignment := this.alignments[this.index] | &null + this.width := 1 + # can't set cell_text until we hit & + + +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 1663 "l2h.nw" + emit_text(S, text) + return +end +#line 1670 "l2h.nw" +procedure ampersand(S) + local this + this := S.tables[1] + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 1674 "l2h.nw" + if /this then + emit_text(S, " --- ") + else { + emit_text(S, "") # be sure cell gets started, even if empty + emit_text(S, "</td>") + if S.text ~=== start_table_cell then + this.cell_text := S.text + S.text := start_table_cell + this.brace_depth := *S.closes + 1 # will open at start of cell +#write(&errout, "set brace depth for ", image(this)) + } + tab(many(' \t\n')) +## write(&errout, " past &, text = ", image(S.text), ", next = ", +## image(&subject[&pos:0])) + return +end +#line 1699 "l2h.nw" +procedure Cbackback(S, cs, cl) + local this + this := S.tables[1] + cs_ignore(S, cs, "[", Cbackback_continue, [S, this]) +end + +procedure Cbackback_continue(S, this) +#if /(\this).brace_depth then write(&errout, image(this), " has null brace depth") + if /this | *S.closes > this.brace_depth then { # ordinary \\ + S.text(S, "<br>") + } else { # row terminator +## write(&errout, "ending row with ", image(&subject[&pos:0])) + emit_text(S, "") # be sure cell gets started, even if empty + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 1713 "l2h.nw" + emit_text(S, "</td></tr>\n") + tab(many(' \t\n')) + if S.text ~=== start_table_cell then + this.cell_text := S.text + this.index := 1 + this.alignment := this.alignments[this.index] | &null + this.width := 1 + S.text := start_table_cell + this.brace_depth := *S.closes + 1 # about to open + } +end +#line 1727 "l2h.nw" +procedure Chline(S, cs, cl) + if \S.tables[1] then return + else emit_text(S, "<hr>") + return +end +#line 1737 "l2h.nw" +procedure Ctabular_end(S, cs, cl) + local this + if S.text ~=== start_table_cell | S.tables[1].index > 1 then {# row in progress + emit_text(S, "") # be sure cell gets started, even if empty + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 1742 "l2h.nw" + emit_text(S, "</td></tr>") + } + if S.text === start_table_cell then # abort it + S.text := S.tables[1].cell_text + emit_text(S, "</table>") + xxx := pop(S.tables) +#write(&errout, "popped ", image(xxx)) + return +end +#line 1754 "l2h.nw" +procedure Ctabular(S, cs, cl) + cs_ignore(S, cs, cl, Ctabular_continue, [S]) + return +end + +procedure Ctabular_continue(S) + a := csarg() # alignment +#write(&errout, "Alignment ", a) + emit_text(S, if upto('|', a) then "<table border>" else "<table>") + emit_text(S, "<!-- alignment is " || a || "-->") + a := alignments(a) + emit_text(S, "<!-- " || *a || " columns-->") + push(S.tables, table_info(1, a[1] | "l", 1, a, *S.closes+1, S.text)) +#write(&errout, "pushed ", image(S.tables[1])) + S.text := start_table_cell + optwhite() + return +end +#line 1777 "l2h.nw" +procedure tabular(env, ignore) + begintab[env] := Ctabular + begincl[env] := ignore + endtab[env] := Ctabular_end + endcl[env] := ignore +end +#line 1786 "l2h.nw" +procedure aligneq(a) + return " align=\"" || a || "\"" +end + +procedure valigneq(a) + return " valign=\"" || a || "\"" +end + +procedure alignments(s) + a := [] + s ? { + while not pos(0) do + case move(1) of { + "l" | "X" | "Y" | "p" : + { put(a, aligneq("left") || valigneq("top")); skip_bracket() } + "c" : put(a, aligneq("center")) + "r" : put(a, aligneq("right")) + "m" : { put(a, aligneq("left") || valigneq("center")); skip_bracket() } + "b" : { put(a, aligneq("left") || valigneq("bottom")); skip_bracket() } + "@" | "<" | ">" | "!" : skip_bracket() + "|" : &null + default : &null # unrecognized... + } + } + return a +end +#line 1813 "l2h.nw" +procedure skip_bracket() + if ="{" then { + n := 1 + while n > 0 & not pos(0) do { + tab(upto('{}\\') | 0) + case move(1) of { + "{" : n +:= 1 + "}" : n -:= 1 + "\\" : move(1) + } + } + } + return +end +#line 1831 "l2h.nw" +procedure Cmulticolumn(S, cs, cl) + local this + this := S.tables[1] + n := integer(csarg()) | error("\\multicolumn or \\multispan not followed by integer") + if cs == "multicolumn" then a := alignments(csarg()) +# write(&errout, "\\", cs, " n = ", n, ", a = ", (\a)[1] | "???", +# ", text = ", image(S.text)) + if /this then return # \multicolumn without table? + this.width := n + this.alignment := (\a)[1] + return +end + +procedure Cspan(S, cs, cl) + (\S.tables[1]).width +:= 1 + return +end +#line 1850 "l2h.nw" +procedure Cnoalign(S, cs, cl) + apply_args(S, finish_noalign, [S], 1) + return +end + +procedure finish_noalign(S, arg) + return if \S.ignoring then "" else + accumulate_text(S, "<br>" || convert(converter("V"), "{" || arg || "}") || "<br>") +end +#line 1862 "l2h.nw" +procedure auxfile(cs, ext, placeholder, header, trailer, ignore) + cstab[cs] := Cauxfile + csclosure[cs] := aux_cl(ext, placeholder, header, trailer, \ignore | "") +end +#line 1869 "l2h.nw" +record aux_cl(ext, placeholder, header, trailer, ignore) + +procedure Cauxfile(S, cs, cl) + local auxfile, T + if auxfile := open(basename(\curfile) || "." || cl.ext) then { + T := converter("V") + Cmakeatletter(T) + S.text(S, \cl.header) + while line := read(auxfile) do + S.text(S, convert(T, line || "\n")) + close(auxfile) + S.text(S, \cl.trailer) + } else { + S.text(S, \cl.placeholder) + } + cs_ignore(S, cs, cl.ignore) + if \auxfile then return +end +#line 1888 "l2h.nw" +procedure basename(name) + reverse(name) ? { + tab(upto('.')) & ="." + return reverse(tab(0)) + } +end +#line 1901 "l2h.nw" +procedure Ctableofcontents(S, cs, cl) + S.mode := "V" + Cauxfile(S, cs, cl) + set_toclevel(S) +end +#line 1910 "l2h.nw" +procedure set_toclevel(S, l) + static toclevel, initiallevel + if /initiallevel := \l then + S.text(S, "<ul compact>") + if /l := \initiallevel then + S.text(S, "</ul>") + if /l then return # never set a level + /toclevel := l + while toclevel < l do { + S.text(S, "<ul compact>") + toclevel +:= 1 + } + while toclevel > l do { + S.text(S, "</ul>") + toclevel -:= 1 + } + return +end +#line 1931 "l2h.nw" +procedure Ccontentsline(S, cs, cl) + local type, level + static leveltab + initial { +#line 1945 "l2h.nw" +l := ["part", "chapter", "section", "subsection", "subsubsection", + "paragraph", "subparagraph"] +leveltab := table() +every i := 1 to *l do + leveltab[l[i]] := i - 2 # making section level 1 +#line 1934 "l2h.nw" + } + l := \leveltab[csarg()] | fail + if l > \countertab["tocdepth"] then + cs_ignore(S, cs, "{{") # skip this one + else { + set_toclevel(S, l) + S.text(S, "<li>") + after_next_open(S, after_next_close, [S, cs_ignore, [S, cs, "{"]]) + } +end +#line 1953 "l2h.nw" +global countertab + +procedure Csetcounter(S, cs, cl) + local counter + (counter := csarg(), countertab[counter] := integer(csarg())) | + cs_ignore(S, cs, "{{") +end +#line 1967 "l2h.nw" +global accent_name, accent_valid +#line 1998 "l2h.nw" +procedure accent(cs) + cstab[cs] := Caccent +end + +procedure Caccent(S, cs, cl) + static warned + initial warned := table() + arg := csarg(S) | return + if arg == "\\i" then arg := "i" + if arg == "\\j" then arg := "j" + if *arg = 1 & any(accent_valid[cs], arg) then + S.text(S, "&" || arg || accent_name[cs] || ";") + else { + +#line 2016 "l2h.nw" +/warned[cs] := set() +if not member(warned[cs], arg) then { + write(&errout, "Warning: Can't handle \\", cs, " with arg `", arg, "'") + insert(warned[cs], arg) +} +#line 2012 "l2h.nw" + S.text(S, arg) + } +end +#line 2026 "l2h.nw" +procedure fontchange(tex, html) + cstab[tex] := Cfontchange + csclosure[tex] := html +end +#line 2031 "l2h.nw" +procedure Cfontchange(S, tex, html) + S.text(S, tag(html)) + before_next_close(S, emit_text, [S, endtag(html)]) +end +#line 2051 "l2h.nw" +procedure ignore(cs, template) + /template := "" + cstab[cs] := cs_ignore + csclosure[cs] := template +end + +procedure ignoreenv(env, template) + /template := "" + begintab[env] := cs_ignore + begincl[env] := template + endtab[env] := do_nothing +end +#line 2070 "l2h.nw" +procedure cs_ignore(S, cs, template, proc, args) + local saved_ignore + saved_ignore := S.ignoring + S.ignoring := 1 + if type(template) == "integer" then template := repl("{", template) + return do_ignore(S, template, saved_ignore, proc, args) +end +#line 2084 "l2h.nw" +procedure do_ignore(S, template, saved_ignore, proc, args) + if *template > 0 then + if optwhite() & pos(0) then + after_next_newtext(S, do_ignore, [S, template, saved_ignore, proc, args]) + else + case template[1] of { + "{" : { S.ignoring := 1 + after_next_open(S, ignore_til_close, + [S, template[2:0], saved_ignore, proc, args]) + } + "A" : { csarg(S) # had better be in one input + do_ignore(S, template[2:0], saved_ignore, proc, args) + } + "[" : if optwhite() & ="[" then { + delay_newtext(S) + with_upto_bracket(S, "", ignore_bracket_plus, + [S, template[2:0], saved_ignore, proc, args]) + } else + do_ignore(S, template[2:0], saved_ignore, proc, args) + "C" : # a total cheat, means ``copy optional arg'' + if optwhite() & ="[" then { + S.ignoring := &null + delay_newtext(S) + with_upto_bracket(S, "", copy_bracket_plus, + [S, template[2:0], saved_ignore, proc, args]) + } else + do_ignore(S, template[2:0], saved_ignore, proc, args) + "=" : { delay_newtext(S) + eat_assignment(S, do_ignore, [S, template[2:0], saved_ignore, proc,args]) + } + "*" : { (="*", optwhite()) + do_ignore(S, template[2:0], saved_ignore, proc, args) + } + "(" : { (="(", tab(upto(')')), =")", optwhite()) + do_ignore(S, template[2:0], saved_ignore, proc, args) + } + } + else { + S.ignoring := saved_ignore + (\proc)!(\args) + } +end + +procedure ignore_til_close(S, template, saved_ignore, proc, args) + before_next_close(S, do_ignore, [S, template, saved_ignore, proc, args]) +end +#line 2133 "l2h.nw" +procedure do_nothing(S, cs, cl) + return +end +#line 2144 "l2h.nw" +procedure with_upto_bracket(S, bracketed_text, proc, args) + bracketed_text ||:= tab(upto(']') | 0) + if pos(0) then + before_next_newtext(S, with_upto_bracket, [S, bracketed_text, proc, args]) + else { + ="]" + undelay_newtext(S) + (\proc)(S, bracketed_text, args) + } + return +end +#line 2158 "l2h.nw" +procedure ignore_bracket_plus(S, contents, args) + # contents are ignored + do_ignore!args +end +#line 2164 "l2h.nw" +procedure copy_bracket_plus(S, contents, args) + local should_ignore + should_ignore := args[3] | fail # saved_ignore arg to do_ignore + if /should_ignore then + S.text(S, convert(converter("H"), "{" || contents || "}")) + do_ignore!args +end +#line 2177 "l2h.nw" +procedure eat_assignment(S, proc, args) + static decimal_chars, hex_chars, oct_chars + initial { + decimal_chars := &digits ++ '.,+-' + hex_chars := &digits ++ 'abcdefABCDEF' + oct_chars := '0124567' + } + optwhite() + ="=" # so what if we swallow multiple = signs + optwhite() + if pos(0) then { + before_next_newtext(S, eat_assignment, [S, proc, args]) + return + } else if glue() then { # finished + } else if any(decimal_chars) then { + tab(many(decimal_chars)) + optwhite() + if ="\\" then + tab(many(S.csletters)) | move(1) + # else assume assignment of the form \hangafter=2 + } else if ="\"" then { + tab(many(hex_chars)) & optwhite() + } else if ="\'" then { + tab(many(oct_chars)) & optwhite() + } else if =("\\"|"`\\") then + tab(many(S.csletters)) | move(1) + undelay_newtext(S) + (\proc)!args +end +#line 2207 "l2h.nw" +procedure dimen() + static decimal_chars + initial decimal_chars := &digits ++ '.,' + suspend (optwhite(), + if any('+-') then (move(1), optwhite()) else "", + tab(many(decimal_chars)), optwhite(), + (="true", optwhite()) | &null, + =("em"|"ex"|"pt"|"pc"|"in"|"bp"|"cm"|"mm"|"dd"|"cc"|"sp"|"mu")) +end +#line 2217 "l2h.nw" +procedure glue() + suspend (dimen(), + (optwhite(), ="plus", dimen()) | "", + (optwhite(), ="minus", dimen()) | "") +end +#line 2231 "l2h.nw" +procedure substitution(tex, html, ignore_template) + # ignore mode for now + cstab[tex] := Cemit_ig + csclosure[tex] := emit_ig_cl(html, \ignore_template | "") +end +#line 2239 "l2h.nw" +record emit_ig_cl(html, template) + +procedure Cemit_ig(S, cs, cl) + emit_text(S, cl.html) + if *cl.template > 0 then + cs_ignore(S, cs, cl.template) +end +#line 2249 "l2h.nw" +procedure activesubst(char, html, ignore_template) + local S + # ignore mode for now + activetab[char] := Cemit_ig + activeclosure[char] := emit_ig_cl(html, \ignore_template | "") + S := \dynamic_add_hack | return + if upto(S.activechars, char) then return # already active + if S.activechars ++:= cset(char) then { + before_next_close(S, delete_active_char, [S, char]) + } else impossible("ugh") + return +end + +procedure delete_active_char(S, char) + S.activechars --:= char + return +end +#line 2282 "l2h.nw" +procedure envblock(env, left, right, ignore_template) + /ignore_template := "" + begintab[env] := Cemit_ig + begincl[env] := emit_ig_cl(if /right then tag(left) else left, ignore_template) + endtab[env] := Cemit + endcl[env] := if /right then endtag(left) else right +end +#line 2291 "l2h.nw" +procedure Cemit(S, cs, cl) + S.text(S, cl) +end +#line 2303 "l2h.nw" +record blockpair(left, right, ignore) + +procedure argblock(tex, html, right, ignore) + # called as is envblock + /ignore := "" + cstab[tex] := Cblock + csclosure[tex] := + if /right then blockpair (tag(html), endtag(html), ignore) + else blockpair (html, right, ignore) +end +#line 2316 "l2h.nw" +procedure argblockv(tex, html, right, ignore) + argblock(tex, html, right, ignore) + cstab[tex] := CblockV +end +#line 2321 "l2h.nw" +procedure Cblock(S, cs, cl, done_ignoring) + if /done_ignoring & *cl.ignore > 0 then { + cs_ignore(S, cs, cl.ignore, Cblock, [S, cs, cl, 1]) + } else if pos(0) then { + after_next_newtext(S, do_cs, [S, cs, cl]) + } else if match("{") then { + S.text(S, cl.left) + after_next_open(S, before_next_close, [S, emit_text, [S, cl.right]]) + } else { +# S.text(S, cl.left || csarg(S) || cl.right) + apply_args(S, Cblock_continue, [S, cl], 1) + } + return +end + +procedure Cblock_continue(S, cl, title) + S.text (S, cl.left || title || cl.right) + return +end +#line 2341 "l2h.nw" +procedure CblockV(S, cs, cl) + S.mode := "V" + Cblock(S, cs, cl) + return +end +#line 2353 "l2h.nw" +record macro_defn(name, arg_count, body, mode) +#line 2357 "l2h.nw" +record raw_arg(number) +record converted_arg(number, mode) +#line 2361 "l2h.nw" +procedure expand_macro(S, macro, args) + every a := !macro.body do + case type(a) of { + "string" : emit_text(S, a) + "raw_arg" : emit_text(S, args[a.number]) | impossible("missing arg") + "converted_arg" : S.text(S, convert(S, "{" || args[a.number] || "}")) + } +# poptrace() + return +end +#link pushtrace +#line 2375 "l2h.nw" +procedure do_macro(S, macro, args_seen, current_arg, brace_depth) + # invariant : we have an open brace +# write(&errout, "scanning args for macro ", macro.name) +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count) + while *args_seen < macro.arg_count & not pos(0) do { + while *args_seen < macro.arg_count & brace_depth = 0 & not pos(0) do { +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count, +# " current ", image(current_arg), " braces ", brace_depth) + tab(many(' \t\n')) + case c := move(1) of { + "\\" : put(args_seen, "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1)) + "{" : { current_arg := "" ; brace_depth := 1 } + "}" : { error("Insufficient arguments to macro ", macro.name) } + default : put(args_seen, c) + } + } + while brace_depth > 0 & not pos(0) do { +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count, +# " current ", image(current_arg), " braces ", brace_depth) + current_arg ||:= tab(upto('\\{}') | 0) + case move(1) of { + "\\" : current_arg ||:= "\\" || + if pos(0) then "" + else if any(S.csletters) then tab(many(S.csletters)) + else move(1) + "{" : { current_arg ||:= "{" ; brace_depth +:= 1 } + "}" : { brace_depth -:= 1 + if brace_depth > 0 then + current_arg ||:= "}" + else { + put(args_seen, current_arg) + current_arg := "" + } + } + } + } + } +# write(&errout, "seen ", *args_seen, " want ", macro.arg_count, +# " current ", image(current_arg), " braces ", brace_depth) + if *args_seen = macro.arg_count then { +# write(&errout, "Arguments for macro ", macro.name, ":") +# every write(&errout, "\t", image(!args_seen)) + expand_macro(S, macro, args_seen) + undelay_newtext(S) + } else + before_next_newtext(S, do_macro, [S, macro, args_seen, current_arg, brace_depth]) + return +end +#line 2428 "l2h.nw" +procedure Cmacro(S, cs, cl) +# pushtrace("MACRO") + delay_newtext(S) +# apply_args(S, closure(expand_macro, [cl]), cl.arg_count) + do_macro(S, cl, [], "", 0) + return +end +#line 2439 "l2h.nw" +procedure macro(name, arg_count, body, mode) + m := macro_defn(name, arg_count, parse_body(body), mode) + cstab[name] := Cmacro + csclosure[name] := m + return +end + +procedure begin_macro(env, arg_count, body, mode) + m := macro_defn(env, arg_count, parse_body(body), mode) + begintab[env] := Cmacro + begincl[env] := m + return +end + +procedure parse_body(body) + b := [] + body ? { + put(b, tab(upto('#') | 0)) + while ="#" do { + put(b, ="#" | (="$", raw_arg(argnum())) | converted_arg(argnum())) | + error("malformed macro arg #", tab(0)) + put(b, tab(upto('#') | 0)) + } + } + return b +end + +procedure argnum() + if any(&digits) then return integer(move(1)) else fail +end +#line 2472 "l2h.nw" +procedure l2h_macro(name, count, body[]) + count := integer(count) | + return error("must give # of arguments to l2h macro ", name) + s := "" + every s ||:= " " || (1(b := !body, type(b) == "string")) + s := s[2:0] # strip leading space if any + return macro(name, count, s) +end +#line 2482 "l2h.nw" +procedure l2h_environment(env, count, body[]) + count := integer(count) | + return error("must give # of arguments to l2h environment ", env) + s := "" + every s ||:= " " || (1(b := !body, type(b) == "string")) + s := s[2:0] # strip leading space if any + return begin_macro(env, count, s) +end +#line 2497 "l2h.nw" +record table_closure(args, amp, open, close) + +procedure table_env(env, args, amp, open, close) + begintab[env] := Ctable + begincl[env] := table_closure(args, amp, + if /close then tag(\open) | &null else open, + if /close then endtag(\open) | &null else close) + endtab[env] := Ctable_end + endcl[env] := [] +end +#line 2508 "l2h.nw" +procedure Ctable(S, env, cl) + local amp +## amp := S.ampersand +## S.ampersand := cl.amp + S.text(S, \cl.open) + push(endcl[env], amp) + cs_ignore(S, env, cl.args) +end + +procedure Ctable_end(S, env, cl) +# S.ampersand := pop(cl) + S.text(S, \begincl[env].close) +end +#line 2524 "l2h.nw" +procedure Cepsfig(S, cs, cl) + apply_args(S, do_epsfig, [S], 1) +end + +procedure do_epsfig(S, arg) + local args + args := [] + arg ? + while not pos(0) do { + tab(many(' \t\n')) + put(args, eqsplit(tab(upto(',') | 0))) + } + if a := !args & a.name == ("file"|"figure") then + emit_text(S, "<a href=" || image(a.value) || "><b>[</b>PostScript figure " || + a.value || "<b>]</b></a>") + else + emit_text(S, "<b>[</b>Ill-understood PostScript figure<b>]</b>") +end + +record apair(name, value) + +procedure eqsplit(s) + p := apair() + s ? (p.name := tab(upto('=')), ="=", p.value := tab(0)) + return p +end +#line 2552 "l2h.nw" +procedure Cincludegraphics(S, cs, cl) + local saved_ignore + saved_ignore := S.ignoring + S.ignoring := 1 + do_ignore(S, "[", saved_ignore, apply_args, [S, do_includegraphics, [S], 1]) +end + +procedure do_includegraphics(S, arg) + local base, ext + if arg ? (base := tab(find(ext := ".ps" | ".eps" | ".epsi")), =ext, pos(0)) then + emit_text(S, "<a href=" || image(arg) || "><b>[</b>PostScript figure " || + arg || "<b>]</b></a>") + else if arg ? (base := tab(find(ext := ".png" | ".gif" | ".jpg")), =ext, pos(0)) then + emit_text(S, "<img src=" || image(arg) || ">") + else + emit_text(S, "<b>[</b>Ill-understood graphics<b>]</b>") +end +#line 2574 "l2h.nw" +procedure let(lhs, rhs) + cstab[lhs] := cstab[rhs] + csclosure[lhs] := csclosure[rhs] +end + +procedure let_closure(lhs, cl[]) + csclosure[lhs] := if *cl = 1 then cl[1] else cl +end + +procedure letenv(lhs, rhs) + begintab[lhs] := begintab[rhs] + endtab[lhs] := endtab[rhs] + begincl[lhs] := begincl[rhs] + endcl[lhs] := endcl[rhs] +end +#line 2595 "l2h.nw" +procedure tag(html) + return "<" || html || ">" +end + +procedure endtag(html) + return "</" || html || ">" +end +#line 2605 "l2h.nw" +procedure Ccomment(S) + if *S.comment > 0 then { + S.text(S, "<!--") + S.comment ? { + while S.text(S, tab(find("--"))) do { + move(2) + S.text(S, "- - ") + } + S.text(S, tab(0)) + } + S.text(S, "-->") + } + S.comment := "" + return +end +#line 2621 "l2h.nw" +procedure Cparagraph(S) + S.text(S, "<p>") +end +#line 2625 "l2h.nw" +procedure Cmath(S) + +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 2627 "l2h.nw" + S.text(S, "<i>") +end + +procedure Cmath_end(S) + S.text(S, "</i>") + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 2633 "l2h.nw" +end +#line 2635 "l2h.nw" +procedure Cdisplaymath(S) + +#line 915 "l2h.nw" +push(S.closes, []) # fresh set of closing tasks +while c := get(S.open) do + c.proc!c.args +#line 2637 "l2h.nw" + S.text(S, "<blockquote><i>") +end + +procedure Cdisplaymath_end(S) + S.text(S, "</i></blockquote>") + +#line 919 "l2h.nw" +while c := get(S.closes[1]) do + c.proc!c.args +pop(S.closes) +#line 2643 "l2h.nw" +end +#line 2645 "l2h.nw" +procedure Cmakeatletter(S) + S.csletters ++:= '@' +end + +procedure Cmakeatother(S) + S.csletters --:= '@' +end +#line 2655 "l2h.nw" +procedure Ckill(S, cs, cl) + S.the_text := "" +end +#line 2673 "l2h.nw" +global csfunctions +#line 2700 "l2h.nw" +global dynamic_add_hack +procedure parse_dynamic_add(S) + if (optwhite(), =("l2h"|"sl2h"), skipwhite(), + p := tab(upto(' \t')), +#line 2717 "l2h.nw" +((p := \csfunctions[p]) | +{ dynamic_warn(p); fail }) +#line 2703 "l2h.nw" + , + skipwhite(), any(~'\n')) then { + a := [] + while (any(~'\n'), l := tab(upto(' \t\n') | 0)) do { + put(a, if p === (l2h_macro|l2h_environment) then l else map(l, "#", " ")) + skipwhite() + } + dynamic_add_hack := S + p!a + dynamic_add_hack := &null + return + } +end +#line 2720 "l2h.nw" +procedure dynamic_warn(p) + static badprocs + initial badprocs := set() + if not member(badprocs, p) then { + write(&errout, "Warning: % l2h ", p, " not recognized -- ignored") + insert(badprocs, p) + } +end +#line 2732 "l2h.nw" +procedure optwhite() + suspend tab(many(' \t')) | "" +end +#line 2737 "l2h.nw" +procedure skipwhite() + suspend tab(many(' \t')) +end +#line 2829 "l2h.nw" +global errstatus +procedure error(args[]) + errstatus := 1 + return write!([&errout, (\curfile || ":") | "line ", curline, ": "] ||| args) +end +#line 2878 "l2h.nw" +procedure fatal(L[]) + write!(["@fatal l2h "] ||| L) + write!([&errout, "noweb error in l2h: "] ||| L) + exit(1) +end +#line 2885 "l2h.nw" +procedure rcsinfo () + return "$Id: l2h.nw,v 1.24 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +#line 2838 "l2h.nw" +global curfile, curline + +procedure convert_file(f) + static S + initial S := converter("V") + curline := 0 + while line := read(f) do { + curline +:= 1 + writes(convert(S, line || "\n")) + } + return +end + +procedure main(args) + local warn + warn := 1 + errstatus := 0 + every arg := !args do + if arg[1] == "-" then + case arg of { + "-show-unknowns" : show_unknowns := 1 + "-nowarn" : warn := &null + "-html-quotes" : html_quotes := 1 + "-" : { curfile := arg; convert_file(&input) } + default : write(&errout, "Warning: unrecognized option ", arg) + } + else if f := open(curfile <- arg) then + convert_file(f) + else + write(&errout, "Error: Can't open file ", arg) + if /curfile then + convert_file(&input) + if \warn then { + warn_unknown(\unknown_set, "control sequences", "\\") + warn_unknown(\unknown_envs, "environments", "{", "}") + } + exit(errstatus) +end diff --git a/web/noweb/src/icon/smldefs.icn b/web/noweb/src/icon/smldefs.icn new file mode 100644 index 0000000000..43f29ab1b1 --- /dev/null +++ b/web/noweb/src/icon/smldefs.icn @@ -0,0 +1,84 @@ +#line 3 "smldefs.nw" +procedure rcsinfo () + return "$Id: smldefs.nw,v 1.19 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +procedure main(args) + go() +end +#line 11 "smldefs.nw" +procedure postpass(name, arg) + static kind, definers, id1, id2, reserved + initial { kind := "bogus" + definers := ["fun", "val", "structure", "signature", "and", "functor", + "type", "eqtype", "datatype", "withtype", "exception"] + id1 := &letters ++ &digits ++ '\'_' + id2 := '!%&$+-/:<=>?@\\~^|#*`' + reserved := set() + every insert(reserved, !"*|:=#_" | "->" | "=>") + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if =(""|" "|" ") & =!definers & tab(many(' ')) then { + skiptyvars(); optwhite() + writedefn(1(id := tab(many(id1 | id2)), not member(reserved, id))) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure skiptyvars() + suspend ="'" || tab(many(&letters ++ &digits ++ '\'_')) | + ="(" || tab(bal(')', '(', ')')) || =")" +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/smldefs.nw b/web/noweb/src/icon/smldefs.nw new file mode 100644 index 0000000000..1a715ced4a --- /dev/null +++ b/web/noweb/src/icon/smldefs.nw @@ -0,0 +1,44 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +\section{Finding definitions in Standard ML} +<<*>>= +procedure rcsinfo () + return "$Id: smldefs.nw,v 1.19 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +procedure main(args) + go() +end +<<*>>= +procedure postpass(name, arg) + static kind, definers, id1, id2, reserved + initial { kind := "bogus" + definers := ["fun", "val", "structure", "signature", "and", "functor", + "type", "eqtype", "datatype", "withtype", "exception"] + id1 := &letters ++ &digits ++ '\'_' + id2 := '!%&$+-/:<=>?@\\~^|#*`' + reserved := set() + every insert(reserved, !"*|:=#_" | "->" | "=>") + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if =(""|" "|" ") & =!definers & tab(many(' ')) then { + skiptyvars(); optwhite() + writedefn(1(id := tab(many(id1 | id2)), not member(reserved, id))) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end + +procedure skiptyvars() + suspend ="'" || tab(many(&letters ++ &digits ++ '\'_')) | + ="(" || tab(bal(')', '(', ')')) || =")" +end + +procedure optwhite() + suspend tab(many(' \t')) | "" +end diff --git a/web/noweb/src/icon/texdefs.icn b/web/noweb/src/icon/texdefs.icn new file mode 100644 index 0000000000..13ddd4b12a --- /dev/null +++ b/web/noweb/src/icon/texdefs.icn @@ -0,0 +1,73 @@ +#line 2 "texdefs.nw" +procedure rcsinfo () + return "$Id: texdefs.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +procedure main(args) + go() +end +#line 10 "texdefs.nw" +procedure postpass(name, arg) + static kind, idchars, definers, newcommand + initial { kind := "bogus"; idchars := &letters ++ '@' + definers := ["def", "newdimen", "newif", "newcount", "newwrite", + "newbox", "global\\def", "long\\def", "gdef" ] + newcommand := ["newcommand", "renewcommand"] + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? { + if =("\\" || !definers || "\\") then + writedefn("\\" || (tab(many(idchars)) | move(1))) + else if =("\\" || !newcommand || "{") then + writedefn(tab(upto('}'))) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/texdefs.nw b/web/noweb/src/icon/texdefs.nw new file mode 100644 index 0000000000..c530120662 --- /dev/null +++ b/web/noweb/src/icon/texdefs.nw @@ -0,0 +1,32 @@ +\section{Finding {\TeX} definitions} +<<*>>= +procedure rcsinfo () + return "$Id: texdefs.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +procedure main(args) + go() +end +<<*>>= +procedure postpass(name, arg) + static kind, idchars, definers, newcommand + initial { kind := "bogus"; idchars := &letters ++ '@' + definers := ["def", "newdimen", "newif", "newcount", "newwrite", + "newbox", "global\\def", "long\\def", "gdef" ] + newcommand := ["newcommand", "renewcommand"] + } + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? { + if =("\\" || !definers || "\\") then + writedefn("\\" || (tab(many(idchars)) | move(1))) + else if =("\\" || !newcommand || "{") then + writedefn(tab(upto('}'))) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end diff --git a/web/noweb/src/icon/tohtml.icn b/web/noweb/src/icon/tohtml.icn new file mode 100644 index 0000000000..dfea222088 --- /dev/null +++ b/web/noweb/src/icon/tohtml.icn @@ -0,0 +1,489 @@ +#line 10 "tohtml.nw" +# Copyright 1994 by Norman Ramsey. All rights reserved. +# See file COPYRIGHT for more information. +#line 19 "tohtml.nw" +# Don't try to understand this file! Look at icon/tohtml.nw in the noweb source! + +global braw, eraw +procedure main(args) + local delay, raw, where, localindex, noindex, shortxref + +#line 218 "tohtml.nw" +useitemstab := table() +defns := table("") +defns_above := set() # keep track of defining chunks we've seen +#line 25 "tohtml.nw" + every braw | eraw := "" + delay := !args == "-delay" + noindex := !args == "-noindex" + shortxref := if !args == "-longxref" then &null else 1 + localindex := (/noindex, !args == "-localindex") # produce local identifier xref? + raw := !args == "-raw" + if \raw then {braw := "\\begin{rawhtml}"; eraw := "\\end{rawhtml}"} + if !args == "-no-gen-comment" then &null + else + write(braw, "<!-- this file was generated automatically by noweave;", + " better not edit it-->", eraw) + while inputline := read() do inputline ? { + +#line 90 "tohtml.nw" +if ="@text " then { text +:= *(line := tab(0)) + if \code then + writes(( +#line 98 "tohtml.nw" +2(line ? {tab(many(' \t')); not pos(0)}, + linkto(\lastindexref, escapeSpecials(line)), + lastindexref := &null) +#line 92 "tohtml.nw" + ) | escapeSpecials(line)) + else if \quoting then + writes(( +#line 123 "tohtml.nw" +2(line ? {tab(many(' \t')); not pos(0)}, + linklabelto(lastxreflabel, lastindexref, escapeSpecials(line), "bare"), + lastxreflabel := lastindexref := &null) +#line 94 "tohtml.nw" + ) | escapeSpecials(line)) + else + writes(( +#line 107 "tohtml.nw" +1(line ? skip_white_tags() || + linklabel(\lastxreflabel, skip_chars()) || tab(0), + insert(defns_above, \lastxreflabel), + lastxreflabel := &null) +#line 96 "tohtml.nw" + ) | line) } else +#line 207 "tohtml.nw" +if ="@nl" & pos(0) then { +#line 292 "tohtml.nw" +if \shortxref & (\pendinguses | \pendingprev | \pendingnext | \notused) then { + +#line 297 "tohtml.nw" +if \pendinguses & *\useitems > 0 then { + writes(" <b>(") + every i := 1 to *\useitems do { + usedir := if member(defns_above, useitems[i]) then "<-U" else "U->" + writes(if i > 1 then " " else "", linkto(useitems[i], usedir)) + } + writes(")</b>") +} +if \pendingprev | \pendingnext then { + writes(" <b>[") + writes(linkto(\pendingprev, "<-")) + writes("D") + writes(linkto(\pendingnext, "->")) + writes("]</b>") +} +#line 294 "tohtml.nw" + pendinguses := pendingprev := pendingnext := notused := &null +} +#line 208 "tohtml.nw" + write() } else +#line 62 "tohtml.nw" +if ="@begin code " then { code := 1 ; thischunk := &null + +#line 350 "tohtml.nw" +useitems := [] +notused := &null +#line 64 "tohtml.nw" + writes(braw, "<pre>"); ecode := "</pre>" } else +if ="@end code " then { +#line 313 "tohtml.nw" +if /shortxref then { + useitems := useitemstab[\thischunk] + if \pendingprev | \pendingnext | (\pendinguses, (*\useitems > 0 | \notused)) then { + +#line 356 "tohtml.nw" +if ecode == "</pre>" then { + writes("</pre><blockquote>") + ecode := "</blockquote>" +} +#line 317 "tohtml.nw" + +#line 342 "tohtml.nw" +useprefix := "Used " +every i := 1 to *\useitems do { + usedir := if member(defns_above, useitems[i]) then "above" else "below" + usesuffix := if *\useitems > 1 then " (" || i || ")" else "" + writes(useprefix, linkto(useitems[i], usedir || usesuffix)) + useprefix := ", " +} +#line 318 "tohtml.nw" + useitemstab[\thischunk] + if *\useitems > 0 & (\pendingprev | \pendingnext) then + writes("; ") + p := if *\useitems > 0 then "previous" else "Previous" + n := if *\useitems > 0 then "next" else "Next" + if \pendingprev then + if \pendingnext then + writes(linkto(pendingprev, p), " and ", + linkto(pendingnext, "next"), " definitions") + else + writes(linkto(pendingprev, p), " definition") + else + if \pendingnext then + writes(linkto(pendingnext, n), " definition") + if \pendingprev | \pendingnext | *\useitems > 0 then + writes(".") + if \notused then + writes("<br>\nThis code is written to a file (or else not used).") + write("<p>") + pendinguses := pendingprev := pendingnext := useitems := notused := &null + } +} else + &null +#line 66 "tohtml.nw" + code := nil ; previscode := 1 + writes(ecode, eraw) } else +#line 210 "tohtml.nw" +if ="@defn " then { writechunk(lastxreflabel, lastxrefref, "dfn", + thischunk := tab(0), defns[thischunk] || "=") + insert(defns_above, \lastxreflabel) + useitems := \useitemstab[thischunk] + pendinguses := 1 + +#line 274 "tohtml.nw" +every lastxreflabel | lastxrefref := &null +#line 216 "tohtml.nw" + defns[thischunk] := "+" } else +#line 74 "tohtml.nw" +if ="@begin docs " then { if \previscode then writes(if /raw then "<p>" else "\\par") + previscode := &null + text := 0 } else +#line 82 "tohtml.nw" +if ="@end docs " then { write(linklabel(\lastxreflabel, "*")) + lastxreflabel := &null } else +#line 222 "tohtml.nw" +if ="@use " then { writechunk(lastxreflabel, lastxrefref, "i", tab(0)) + +#line 274 "tohtml.nw" +every lastxreflabel | lastxrefref := &null +#line 223 "tohtml.nw" + } else +#line 251 "tohtml.nw" +if ="@xref " then { + if fun := tab(upto(' ')) then {move(1); arg := tab(0)} + else { fun := tab(0); arg := &null } + case fun of { + +#line 265 "tohtml.nw" +"label" : { +#line 276 "tohtml.nw" +warn_unused_xref("label", \lastxreflabel) +#line 265 "tohtml.nw" + ; lastxreflabel := arg } +"ref" : { +#line 278 "tohtml.nw" +warn_unused_xref("ref", \lastxrefref) +#line 266 "tohtml.nw" + ; lastxrefref := arg } +"prevdef" : pendingprev := arg +"nextdef" : pendingnext := arg +"beginuses" : useitems := [] +"useitem" : put(useitems, arg) +"enduses" : useitemstab[\thischunk] := useitems +"notused" : notused := arg +#line 364 "tohtml.nw" +"begindefs" | "defitem" | "enddefs" : &null +#line 367 "tohtml.nw" +"beginchunks" : { write(braw, "<ul>") } +"chunkbegin" : { writes("<li>"); comma := ": "; count := 0 + arg ? { ref := tab(upto(' ')); =" "; name := tab(0) } + writechunk(&null, ref, "i", name) } +"chunkuse" : { writes(comma, linkto(arg, "U" || (count +:= 1))); comma := ", " } +"chunkdefn" : { writes(comma, linkto(arg, "D" || (count +:= 1))); comma := ", " } +"chunkend" : write() +"endchunks" : write("</ul>", eraw) +#line 255 "tohtml.nw" + + default : (\arg|"") ? warn_unknown("xref " || fun) + } +} else +#line 385 "tohtml.nw" +if ="@index " then { + if /noindex then { + if fun := tab(upto(' ')) then {move(1); arg := tab(0)} + else { fun := tab(0); arg := &null } + case fun of { + +#line 376 "tohtml.nw" +"beginindex" : { write(braw, "<ul>") } +"entrybegin" : { writes("<li>"); comma := ": "; count := 0 + arg ? { ref := tab(upto(' ')); =" "; name := tab(0) } + writes(linklabelto("NWI-" || escapeSpecials(name), ref, name, "b")) } +"entryuse" : { writes(comma, linkto(arg, "U" || (count +:= 1))); comma := ", " } +"entrydefn" : { writes(comma, linkto(arg, "D" || (count +:= 1))); comma := ", " } +"entryend" : write() +"endindex" : write("</ul>", eraw) +#line 400 "tohtml.nw" +"use" : { lastindexref := lastxrefref; lastxrefref := &null } +"defn" : { +#line 274 "tohtml.nw" +every lastxreflabel | lastxrefref := &null +#line 401 "tohtml.nw" + } +"localdefn" : { +#line 274 "tohtml.nw" +every lastxreflabel | lastxrefref := &null +#line 402 "tohtml.nw" + } +"nl" : &null # do nothing -- no hope of keeping line numbering +#line 408 "tohtml.nw" +"begindefs" : if \localindex then { + +#line 313 "tohtml.nw" +if /shortxref then { + useitems := useitemstab[\thischunk] + if \pendingprev | \pendingnext | (\pendinguses, (*\useitems > 0 | \notused)) then { + +#line 356 "tohtml.nw" +if ecode == "</pre>" then { + writes("</pre><blockquote>") + ecode := "</blockquote>" +} +#line 317 "tohtml.nw" + +#line 342 "tohtml.nw" +useprefix := "Used " +every i := 1 to *\useitems do { + usedir := if member(defns_above, useitems[i]) then "above" else "below" + usesuffix := if *\useitems > 1 then " (" || i || ")" else "" + writes(useprefix, linkto(useitems[i], usedir || usesuffix)) + useprefix := ", " +} +#line 318 "tohtml.nw" + useitemstab[\thischunk] + if *\useitems > 0 & (\pendingprev | \pendingnext) then + writes("; ") + p := if *\useitems > 0 then "previous" else "Previous" + n := if *\useitems > 0 then "next" else "Next" + if \pendingprev then + if \pendingnext then + writes(linkto(pendingprev, p), " and ", + linkto(pendingnext, "next"), " definitions") + else + writes(linkto(pendingprev, p), " definition") + else + if \pendingnext then + writes(linkto(pendingnext, n), " definition") + if \pendingprev | \pendingnext | *\useitems > 0 then + writes(".") + if \notused then + writes("<br>\nThis code is written to a file (or else not used).") + write("<p>") + pendinguses := pendingprev := pendingnext := useitems := notused := &null + } +} else + &null +#line 410 "tohtml.nw" + if /uglyindex | /shortxref then { + +#line 356 "tohtml.nw" +if ecode == "</pre>" then { + writes("</pre><blockquote>") + ecode := "</blockquote>" +} +#line 412 "tohtml.nw" + writes("Defines ") + } else { + writes("<hr><b>[</b>") + } + comma := "" + } +"isused" : &null +"defitem" : if \localindex then { + writes(comma, linkto("NWI-" || escapeSpecials(arg), + sgmlwrap("code", escapeSpecials(arg)))) + comma := if /uglyindex | /shortxref then ", " else "<b>,</b> " + } +"enddefs" : if \localindex then + write(if /uglyindex | /shortxref then " (links are to index).<p>" + else "<b>]</b>") +"beginuses" | "isdefined" | "useitem" | "enduses" : &null # use local links +#line 390 "tohtml.nw" + + default : (\arg|"") ? warn_unknown("index " || fun) + } + } + # don't get any warnings if not doing indexing +} else +#line 237 "tohtml.nw" +if ="@quote" & pos(0) then { quoting := 1 ; writes(braw, "<code>") } else +if ="@endquote" & pos(0) then { quoting := nil ; writes("</code>", eraw) } else +#line 240 "tohtml.nw" +if ="@file " then { filename := tab(0); +#line 274 "tohtml.nw" +every lastxreflabel | lastxrefref := &null +#line 240 "tohtml.nw" + } else +if ="@literal " then { writes(tab(0)) } else +if ="@header html " then { +#line 246 "tohtml.nw" +writes("<html><head><title>", tab(0), "</title></head><body>") +#line 242 "tohtml.nw" + } else +if ="@trailer html" & pos(0) then { +#line 248 "tohtml.nw" +write("</body></html>") +#line 243 "tohtml.nw" + } else +#line 51 "tohtml.nw" +if match("@fatal ") then { # follows last else + exit(1) +} else if ="@" then + warn_unknown(1(tab(upto(' ')|0), pos(0) | move(1))) +else + fatal("Botched line in noweb pipeline: ", tab(0)) +#line 38 "tohtml.nw" + } + write() +end +#line 131 "tohtml.nw" +procedure skip_white_tags() + suspend thewhite() || + ((="<" || thewhite() || (="/" || thewhite() | "") || + (tab(many(&letters)) | ="!--") || + tab(upto(">")) || =">" || skip_white_tags() | + "") \ 1) +end +#line 139 "tohtml.nw" +procedure skip_chars() + if not any('<') & upto('<') then + suspend tab(upto('<')) + else if any('&') & upto(';') then + suspend (tab(upto(';')) || =";") + else if (any('<') & upto('>')) | any(' \t') then + (write(&errout, "broken skip_chars, report to nr@eecs.harvard.edu: ", image(tab(0))), + &fail) + else if any('<') then + (write(&errout, "warning: can't find end of HTML tag: ", image(tab(0)), + "\n\tquoted code embedded in comment?"), &fail) + else if pos(0) then + fail + else + suspend tab(0) +end +procedure optwhite() + suspend tab(many(' \t')) | "" +end +procedure thewhite() + return optwhite() \ 1 +end +#line 162 "tohtml.nw" +procedure skip_tags_and_char(count) + local tag + /count := 0 + if any('&') & upto(';') then + suspend(tab(upto(';')) || =";") + else if any('<') then + suspend ="<" || (tab(many(' \t')) | "") || + (="/" | (tag := tab(many(&letters)))) || + tab(upto(">")) || =">" || + (if map(tag) == "a" then + tab(upto("<")) || ="<" || optwhite() || ="/" || optwhite() || + (("A"|"a") == tab(many(&letters))) || optwhite || =">" + else "") || + skip_tags_and_char(count+1) + else + suspend (tab(many(' \t')) | "") || + ((move(1) | if count > 0 then "")\1) # succeed at end if count > 0 + +end +#line 228 "tohtml.nw" +procedure writechunk(label, ref, tag, name, suffix) + /suffix := "" + writes(linklabelto(label, ref, + sgmlwrap(tag, "<" || convquotes(name) || ">" || suffix), + "bare")) + return +end +#line 280 "tohtml.nw" +procedure warn_unused_xref(tag, label) + static warned + initial warned := set() + if not member(warned, tag) then { + insert(warned, tag) + write(&errout, "Warning: internal inconsistency in noweb (not urgent)---") + write(&errout, "\tnever used @xref ", tag, " ", label) + } + return +end +#line 436 "tohtml.nw" +procedure linklabelto(label, ref, contents, bare) + local s + s := if \bare then "" else braw + s ||:= if \label | \ref then "<a" else "" + s ||:= " name=" || image(\label) + s ||:= " href=" || image("#" || \ref) + s ||:= if \label | \ref then ">" else "" + s ||:= if \bare then "" else eraw + s ||:= contents + s ||:= if \bare then "" else braw + s ||:= if \label | \ref then "</a>" else "" + s ||:= if \bare then "" else eraw + return s +end +#line 453 "tohtml.nw" +procedure linklabel(label, contents, bare) + return linklabelto(label, &null, contents, bare) +end + +procedure linkto(ref, contents) + return linklabelto(&null, ref, contents, "bare") +end +#line 467 "tohtml.nw" +procedure sgmlwrap(tag, s) + return "<" || tag || ">" || s || "</" || tag || ">" +end +#line 475 "tohtml.nw" +procedure escapeSpecials (l) + static escapes, specials + initial {escapes := table(); + escapes["&"] := "&" + escapes["<"] := "<" + escapes[">"] := ">" + escapes["\""] := """ + specials := '' + every specials ++:= key(escapes) + } + s := "" + l ? { + while s ||:= tab(upto(specials)) do + s ||:= escapes[move(1)] + return s || tab(0) + } +end +#line 496 "tohtml.nw" +procedure convquotes(s) + r := "" + s ? { # don't call escapeSpecials on s; it destroys internal markup + while r ||:= tab(find("[[")) do { + ="[[" | fatal("impossible missing [[") + r ||:= "<code>" || tab(find("]]")) + r ||:= tab(many(']')-2) + ="]]" | fatal("impossible missing ]] in ", image(s)) + r ||:= "</code>" + } + return r || tab(0) + } +end +#line 511 "tohtml.nw" +procedure warn_unknown(tag) + static warned + initial warned := set() + if not member(warned, tag) then { + write(&errout, "Warning: unrecognized escape @", tag, " ", tab(0)) + insert(warned, tag) + } + return +end +#line 522 "tohtml.nw" +procedure fatal(L[]) + write!([&errout, "noweb error in tohtml: "] ||| L) + exit(1) +end +#line 529 "tohtml.nw" +procedure rcsinfo () + return "$Id: tohtml.nw,v 1.22 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/tohtml.nw b/web/noweb/src/icon/tohtml.nw new file mode 100644 index 0000000000..9eb904836c --- /dev/null +++ b/web/noweb/src/icon/tohtml.nw @@ -0,0 +1,534 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +\documentstyle[noweb]{article} +\pagestyle{noweb} +\begin{document} +@ +\section{Converting {\tt noweb} markup to {\tt HTML}} +This copyright applies both to the {\tt noweb} source and to the +generated code. +Thanks to Bill Trost for getting me started with an early version. +<<copyright notice>>= +# Copyright 1994 by Norman Ramsey. All rights reserved. +# See file COPYRIGHT for more information. +@ +The [[-raw]] option brackets HTML with [[\begin{rawhtml}]] and +[[\end{rawhtml}]]; the purpose is to embed HTML in a {\LaTeX} +document before converting the document with {\tt latex2html}. +[[braw]] and [[eraw]] hold those delimiters (or else empty strings). +<<*>>= +<<copyright notice>> +# Don't try to understand this file! Look at icon/tohtml.nw in the noweb source! + +global braw, eraw +procedure main(args) + local delay, raw, where, localindex, noindex, shortxref + <<initialization>> + every braw | eraw := "" + delay := !args == "-delay" + noindex := !args == "-noindex" + shortxref := if !args == "-longxref" then &null else 1 + localindex := (/noindex, !args == "-localindex") # produce local identifier xref? + raw := !args == "-raw" + if \raw then {braw := "\\begin{rawhtml}"; eraw := "\\end{rawhtml}"} + if !args == "-no-gen-comment" then &null + else + write(braw, "<!-- this file was generated automatically by noweave;", + " better not edit it-->", eraw) + while inputline := read() do inputline ? { + <<scan and convert>> + } + write() +end +<<scan and convert>>= +<<@text>> +<<@nl>> +<<code chunks>> +<<@defn>> +<<docs chunks>> +<<@use>> +<<@xref>> +<<@index>> +<<others>> +if match("@fatal ") then { # follows last else + exit(1) +} else if ="@" then + warn_unknown(1(tab(upto(' ')|0), pos(0) | move(1))) +else + fatal("Botched line in noweb pipeline: ", tab(0)) +@ +[[ecode]] is the marker used at the end of the current code chunk. +If there is no cross-reference stuff at the end, we just use [[</pre>]]; +otherwise we terminate whatever environment is used for the cross-reference stuff. +<<code chunks>>= +if ="@begin code " then { code := 1 ; thischunk := &null + <<reset cross-reference info>> + writes(braw, "<pre>"); ecode := "</pre>" } else +if ="@end code " then { <<dump pending cross-reference info (long form)>> + code := nil ; previscode := 1 + writes(ecode, eraw) } else +@ We maintain [[thischunk]] null until we've seen [[@defn]]. + +We want to try to avoid emitting paragraph elements when the +preceding chunk is a code chunk, as tracked by [[previscode]]. +Also, if we do slip in a paragraph, we may use the {\LaTeX} style. +<<docs chunks>>= +if ="@begin docs " then { if \previscode then writes(if /raw then "<p>" else "\\par") + previscode := &null + text := 0 } else +@ +Sometimes it happens that a document-chunk anchor is put in a document chunk that +contains no text. In that case, we put in a phony anchor at the end of the chunk so +we won't lose the cross-reference. +<<docs chunks>>= +if ="@end docs " then { write(linklabel(\lastxreflabel, "*")) + lastxreflabel := &null } else +@ +Normally, if there's a pending anchor, we put it on the first available text line. +There's a bit of a fine point that crops up if the very first piece of text +is quoted code. In that case we have to attach both the label for the +{\it docs} anchor and the ref for the {\it index} anchor. +<<@text>>= +if ="@text " then { text +:= *(line := tab(0)) + if \code then + writes((<<index anchor>>) | escapeSpecials(line)) + else if \quoting then + writes((<<index and docs anchor>>) | escapeSpecials(line)) + else + writes((<<docs anchor>>) | line) } else +<<index anchor>>= +2(line ? {tab(many(' \t')); not pos(0)}, + linkto(\lastindexref, escapeSpecials(line)), + lastindexref := &null) +@ +We anchor on the first nonblank character of the line, unless that's +an SGML tag, in which case we have to +skip past. +None of this crap would be necessary if HTML could anchor to empty text. +<<docs anchor>>= +1(line ? skip_white_tags() || + linklabel(\lastxreflabel, skip_chars()) || tab(0), + insert(defns_above, \lastxreflabel), + lastxreflabel := &null) +<<old docs anchor>>= +2(line ? {tab(many(' \t')); not pos(0)}, + line ? linklabel(\lastxreflabel, + (tab(many(' \t')) | "") || + (skip_tags_and_char() | "*")) || + tab(0), + insert(defns_above, \lastxreflabel), + lastxreflabel := &null) +@ +An indexed identifier is not empty and contains no tags, so we don't +have to worry. +<<index and docs anchor>>= +2(line ? {tab(many(' \t')); not pos(0)}, + linklabelto(lastxreflabel, lastindexref, escapeSpecials(line), "bare"), + lastxreflabel := lastindexref := &null) +@ +Skip as many tags as possible. +Argument is number of tags already skipped; if nonzero, we're willing to succeed +at the end of the string. +<<*>>= +procedure skip_white_tags() + suspend thewhite() || + ((="<" || thewhite() || (="/" || thewhite() | "") || + (tab(many(&letters)) | ="!--") || + tab(upto(">")) || =">" || skip_white_tags() | + "") \ 1) +end +<<*>>= +procedure skip_chars() + if not any('<') & upto('<') then + suspend tab(upto('<')) + else if any('&') & upto(';') then + suspend (tab(upto(';')) || =";") + else if (any('<') & upto('>')) | any(' \t') then + (write(&errout, "broken skip_chars, report to nr@eecs.harvard.edu: ", image(tab(0))), + &fail) + else if any('<') then + (write(&errout, "warning: can't find end of HTML tag: ", image(tab(0)), + "\n\tquoted code embedded in comment?"), &fail) + else if pos(0) then + fail + else + suspend tab(0) +end +procedure optwhite() + suspend tab(many(' \t')) | "" +end +procedure thewhite() + return optwhite() \ 1 +end +<<*>>= +procedure skip_tags_and_char(count) + local tag + /count := 0 + if any('&') & upto(';') then + suspend(tab(upto(';')) || =";") + else if any('<') then + suspend ="<" || (tab(many(' \t')) | "") || + (="/" | (tag := tab(many(&letters)))) || + tab(upto(">")) || =">" || + (if map(tag) == "a" then + tab(upto("<")) || ="<" || optwhite() || ="/" || optwhite() || + (("A"|"a") == tab(many(&letters))) || optwhite || =">" + else "") || + skip_tags_and_char(count+1) + else + suspend (tab(many(' \t')) | "") || + ((move(1) | if count > 0 then "")\1) # succeed at end if count > 0 + +end +@ +The preceding scheme sometimes wraps an anchor around a tag. +If that turns out to be bad, we could try the following alternative: +<<funky new docs anchor>>= +2(line ? {tab(many(' \t')); not pos(0)}, + line ? scan_initial_tags() || + linklabel(\lastxreflabel, + (tab(many(' \t')) | "") || (scan_past_char() | "*")) || + tab(0), + insert(defns_above, \lastxreflabel), + lastxreflabel := &null) +<<procedures to support new docs anchor>>= +procedure scan_initial_tags() + suspend (="<" || (tab(many(' \t')) | "") || + (="/" | (tag := tab(many(&letters)), map(tag) ~== "a", tag)) || + tab(upto(">")) || =">" || scan_initial_tags()) | + "" +end + +procedure scan_past_char() + if any('&') & upto(';') then + suspend(tab(upto(';')) || =";") + else + suspend (tab(many(' \t')) | "") || tab(any(~'<')) +end +<<@nl>>= +if ="@nl" & pos(0) then { <<show definitions and uses on definition line---once>> + write() } else +<<@defn>>= +if ="@defn " then { writechunk(lastxreflabel, lastxrefref, "dfn", + thischunk := tab(0), defns[thischunk] || "=") + insert(defns_above, \lastxreflabel) + useitems := \useitemstab[thischunk] + pendinguses := 1 + <<clear [[lastxref*]]>> + defns[thischunk] := "+" } else +<<initialization>>= +useitemstab := table() +defns := table("") +defns_above := set() # keep track of defining chunks we've seen +<<@use>>= +if ="@use " then { writechunk(lastxreflabel, lastxrefref, "i", tab(0)) + <<clear [[lastxref*]]>> } else +@ +Writing a chunk involves creating an anchor for it. +The anchor is ``bare'' because it's always in an HTML-containing place. +<<*>>= +procedure writechunk(label, ref, tag, name, suffix) + /suffix := "" + writes(linklabelto(label, ref, + sgmlwrap(tag, "<" || convquotes(name) || ">" || suffix), + "bare")) + return +end +@ +<<others>>= +if ="@quote" & pos(0) then { quoting := 1 ; writes(braw, "<code>") } else +if ="@endquote" & pos(0) then { quoting := nil ; writes("</code>", eraw) } else +<<others>>= +if ="@file " then { filename := tab(0); <<clear [[lastxref*]]>> } else +if ="@literal " then { writes(tab(0)) } else +if ="@header html " then { <<write HTML header>> } else +if ="@trailer html" & pos(0) then { <<write HTML trailer>> } else +@ +<<write HTML header>>= +writes("<html><head><title>", tab(0), "</title></head><body>") +<<write HTML trailer>>= +write("</body></html>") +@ +<<@xref>>= +if ="@xref " then { + if fun := tab(upto(' ')) then {move(1); arg := tab(0)} + else { fun := tab(0); arg := &null } + case fun of { + <<cases for @xref>> + default : (\arg|"") ? warn_unknown("xref " || fun) + } +} else +@ +[[useitemstab]] seems to exist to enable us to repeat the +uses for each chunk, even though the [[noidx]] filter only provides them once. +I think it may prove better to provide use information for each instance +of a chunk. +<<cases for @xref>>= +"label" : { <<warn if unused [[lastxreflabel]]>>; lastxreflabel := arg } +"ref" : { <<warn if unused [[lastxrefref]]>>; lastxrefref := arg } +"prevdef" : pendingprev := arg +"nextdef" : pendingnext := arg +"beginuses" : useitems := [] +"useitem" : put(useitems, arg) +"enduses" : useitemstab[\thischunk] := useitems +"notused" : notused := arg +<<clear [[lastxref*]]>>= +every lastxreflabel | lastxrefref := &null +<<warn if unused [[lastxreflabel]]>>= +warn_unused_xref("label", \lastxreflabel) +<<warn if unused [[lastxrefref]]>>= +warn_unused_xref("ref", \lastxrefref) +<<*>>= +procedure warn_unused_xref(tag, label) + static warned + initial warned := set() + if not member(warned, tag) then { + insert(warned, tag) + write(&errout, "Warning: internal inconsistency in noweb (not urgent)---") + write(&errout, "\tnever used @xref ", tag, " ", label) + } + return +end +@ +<<show definitions and uses on definition line---once>>= +if \shortxref & (\pendinguses | \pendingprev | \pendingnext | \notused) then { + <<write out definition-line markup>> + pendinguses := pendingprev := pendingnext := notused := &null +} +<<write out definition-line markup>>= +if \pendinguses & *\useitems > 0 then { + writes(" <b>(") + every i := 1 to *\useitems do { + usedir := if member(defns_above, useitems[i]) then "<-U" else "U->" + writes(if i > 1 then " " else "", linkto(useitems[i], usedir)) + } + writes(")</b>") +} +if \pendingprev | \pendingnext then { + writes(" <b>[") + writes(linkto(\pendingprev, "<-")) + writes("D") + writes(linkto(\pendingnext, "->")) + writes("]</b>") +} +<<dump pending cross-reference info (long form)>>= +if /shortxref then { + useitems := useitemstab[\thischunk] + if \pendingprev | \pendingnext | (\pendinguses, (*\useitems > 0 | \notused)) then { + <<code-to-blockquote>> + <<write out uses with links>> + useitemstab[\thischunk] + if *\useitems > 0 & (\pendingprev | \pendingnext) then + writes("; ") + p := if *\useitems > 0 then "previous" else "Previous" + n := if *\useitems > 0 then "next" else "Next" + if \pendingprev then + if \pendingnext then + writes(linkto(pendingprev, p), " and ", + linkto(pendingnext, "next"), " definitions") + else + writes(linkto(pendingprev, p), " definition") + else + if \pendingnext then + writes(linkto(pendingnext, n), " definition") + if \pendingprev | \pendingnext | *\useitems > 0 then + writes(".") + if \notused then + writes("<br>\nThis code is written to a file (or else not used).") + write("<p>") + pendinguses := pendingprev := pendingnext := useitems := notused := &null + } +} else + &null +<<write out uses with links>>= +useprefix := "Used " +every i := 1 to *\useitems do { + usedir := if member(defns_above, useitems[i]) then "above" else "below" + usesuffix := if *\useitems > 1 then " (" || i || ")" else "" + writes(useprefix, linkto(useitems[i], usedir || usesuffix)) + useprefix := ", " +} +<<reset cross-reference info>>= +useitems := [] +notused := &null +@ +The hack here is to put the supplementary information in a blockquote area +after the code. +<<code-to-blockquote>>= +if ecode == "</pre>" then { + writes("</pre><blockquote>") + ecode := "</blockquote>" +} +@ +The HTML back end ignores [[@xref begindefs]], [[@xref defitem]], and +[[@xref enddefs]]; it uses the [[nextdef]] and [[prevdef]] links instead. +<<cases for @xref>>= +"begindefs" | "defitem" | "enddefs" : &null +@ +<<cases for @xref>>= +"beginchunks" : { write(braw, "<ul>") } +"chunkbegin" : { writes("<li>"); comma := ": "; count := 0 + arg ? { ref := tab(upto(' ')); =" "; name := tab(0) } + writechunk(&null, ref, "i", name) } +"chunkuse" : { writes(comma, linkto(arg, "U" || (count +:= 1))); comma := ", " } +"chunkdefn" : { writes(comma, linkto(arg, "D" || (count +:= 1))); comma := ", " } +"chunkend" : write() +"endchunks" : write("</ul>", eraw) +<<cases for @index>>= +"beginindex" : { write(braw, "<ul>") } +"entrybegin" : { writes("<li>"); comma := ": "; count := 0 + arg ? { ref := tab(upto(' ')); =" "; name := tab(0) } + writes(linklabelto("NWI-" || escapeSpecials(name), ref, name, "b")) } +"entryuse" : { writes(comma, linkto(arg, "U" || (count +:= 1))); comma := ", " } +"entrydefn" : { writes(comma, linkto(arg, "D" || (count +:= 1))); comma := ", " } +"entryend" : write() +"endindex" : write("</ul>", eraw) +<<@index>>= +if ="@index " then { + if /noindex then { + if fun := tab(upto(' ')) then {move(1); arg := tab(0)} + else { fun := tab(0); arg := &null } + case fun of { + <<cases for @index>> + default : (\arg|"") ? warn_unknown("index " || fun) + } + } + # don't get any warnings if not doing indexing +} else +@ +The local identifier cross-reference doesn't show each use; it just shows +the identifiers that are defined, with links to the full index. +<<cases for @index>>= +"use" : { lastindexref := lastxrefref; lastxrefref := &null } +"defn" : { <<clear [[lastxref*]]>> } +"localdefn" : { <<clear [[lastxref*]]>> } +"nl" : &null # do nothing -- no hope of keeping line numbering +@ +I tried an abbreviated index format at the end of the chunk, but it looks +so bad that I've punted on it (for now). Hence the [[\uglyindex]]. +<<cases for @index>>= +"begindefs" : if \localindex then { + <<dump pending cross-reference info (long form)>> + if /uglyindex | /shortxref then { + <<code-to-blockquote>> + writes("Defines ") + } else { + writes("<hr><b>[</b>") + } + comma := "" + } +"isused" : &null +"defitem" : if \localindex then { + writes(comma, linkto("NWI-" || escapeSpecials(arg), + sgmlwrap("code", escapeSpecials(arg)))) + comma := if /uglyindex | /shortxref then ", " else "<b>,</b> " + } +"enddefs" : if \localindex then + write(if /uglyindex | /shortxref then " (links are to index).<p>" + else "<b>]</b>") +"beginuses" | "isdefined" | "useitem" | "enduses" : &null # use local links +@ +\subsection{Support functions} +Here's all our anchor support goo. +Unless the anchor is deemed ``bare,'' the beginning and ending tags +are protected with [[braw]] and [[eraw]]. +This step is necessary to make \verb=noweave -latex+html= work without +trapping {\LaTeX} markup in a \texttt{rawhtml} environment. +<<*>>= +procedure linklabelto(label, ref, contents, bare) + local s + s := if \bare then "" else braw + s ||:= if \label | \ref then "<a" else "" + s ||:= " name=" || image(\label) + s ||:= " href=" || image("#" || \ref) + s ||:= if \label | \ref then ">" else "" + s ||:= if \bare then "" else eraw + s ||:= contents + s ||:= if \bare then "" else braw + s ||:= if \label | \ref then "</a>" else "" + s ||:= if \bare then "" else eraw + return s +end +@ +Here are two abbreviations. +<<*>>= +procedure linklabel(label, contents, bare) + return linklabelto(label, &null, contents, bare) +end + +procedure linkto(ref, contents) + return linklabelto(&null, ref, contents, "bare") +end +@ [[linkto]] is always used ``bare,'' and I've decided that the +inconsistency in calling conversions is worth the savings from not +having to write a meaningless argument everywhere. +Reasonable people could disagree. +@ +Another support function is used for wrapping tags around text: +<<*>>= +procedure sgmlwrap(tag, s) + return "<" || tag || ">" || s || "</" || tag || ">" +end +@ +Lucky for us, {\tt HTML} has few special characters. Unlucky for us, +we have to deal with each one seperately. Nothing much to whine +about, really. +<<*>>= +procedure escapeSpecials (l) + static escapes, specials + initial {escapes := table(); + escapes["&"] := "&" + escapes["<"] := "<" + escapes[">"] := ">" + escapes["\""] := """ + specials := '' + every specials ++:= key(escapes) + } + s := "" + l ? { + while s ||:= tab(upto(specials)) do + s ||:= escapes[move(1)] + return s || tab(0) + } +end +@ +A special function is used to implement {\tt noweb}'s quoting +convention within chunk names. +<<*>>= +procedure convquotes(s) + r := "" + s ? { # don't call escapeSpecials on s; it destroys internal markup + while r ||:= tab(find("[[")) do { + ="[[" | fatal("impossible missing [[") + r ||:= "<code>" || tab(find("]]")) + r ||:= tab(many(']')-2) + ="]]" | fatal("impossible missing ]] in ", image(s)) + r ||:= "</code>" + } + return r || tab(0) + } +end +@ +<<*>>= +procedure warn_unknown(tag) + static warned + initial warned := set() + if not member(warned, tag) then { + write(&errout, "Warning: unrecognized escape @", tag, " ", tab(0)) + insert(warned, tag) + } + return +end +@ +<<*>>= +procedure fatal(L[]) + write!([&errout, "noweb error in tohtml: "] ||| L) + exit(1) +end +@ +\end{document} +<<*>>= +procedure rcsinfo () + return "$Id: tohtml.nw,v 1.22 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +@ diff --git a/web/noweb/src/icon/totex.icn b/web/noweb/src/icon/totex.icn new file mode 100644 index 0000000000..353f695656 --- /dev/null +++ b/web/noweb/src/icon/totex.icn @@ -0,0 +1,456 @@ +#line 5 "totex.nw" +# Copyright 1991 by Norman Ramsey. All rights reserved. +# See file COPYRIGHT for more information. +#line 11 "totex.nw" +procedure rcsinfo () + return "$Id: totex.nw,v 1.21 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +global headercomment, realwrite +procedure main(args) + local delay, name + +#line 46 "totex.nw" +text := 1 +#line 135 "totex.nw" +useitemstab := table() +#line 149 "totex.nw" +defns := table("") +#line 336 "totex.nw" +TeXspecials := '\\{}$&#^_ ~%' +#line 19 "totex.nw" + delay := !args == "-delay" + noindex := !args == "-noindex" + if !args == "-no-gen-comment" then &null + else {realwrite := write; write := firstwrite} + while inputline := read() do inputline ? { + +#line 82 "totex.nw" +if ="@text " then { text +:= *(line := tab(0)) + writes(if \quoting then +#line 88 "totex.nw" +if /noindex & \lastindexref then + "\\nwlinkedidentq{" || TeXliteral(line) || "}{" || lastindexref || "}" +else + TeXliteral(line) +#line 84 "totex.nw" + else if \code then +#line 93 "totex.nw" +if /noindex & \lastindexref then + "\\nwlinkedidentc{" || escape(line, '{}\\') || "}{" || lastindexref || "}" +else + escape(line, '{}\\') + +#line 85 "totex.nw" + else line) + lastindexref := &null } else +#line 99 "totex.nw" +if ="@nl" & pos(0) then { if /code then { +#line 115 "totex.nw" +if text = 0 then writes("\\nwdocspar") +text := 1 +#line 99 "totex.nw" + } + if \quoting then writes("\\nwnewline") + +#line 201 "totex.nw" +if \pendinguses | \pendingprev | \pendingnext then { + writes("\\nwstartdeflinemarkup") + +#line 208 "totex.nw" +if \pendinguses then { + dumpitems(useitems, "nwusesondefline") +} +if \pendingprev | \pendingnext then { + writes("\\nwprevnextdefs{", \pendingprev | "\\relax", "}{", + \pendingnext | "\\relax", "}") +} +#line 204 "totex.nw" + writes("\\nwenddeflinemarkup") + pendinguses := pendingprev := pendingnext := &null +} +#line 102 "totex.nw" + write() } else +#line 71 "totex.nw" +if ="@begin code " then { code := 1 ; writes("\\nwbegincode{", tab(0), "}") + +#line 177 "totex.nw" +every defitems | useitems := [] +notused := &null +#line 72 "totex.nw" + } else +if ="@end code " then { +#line 184 "totex.nw" +dumpitems(defitems, "nwalsodefined") +dumpitems(useitems, "nwused") +writes("\\nwnotused{", \notused, "}") +#line 177 "totex.nw" +every defitems | useitems := [] +notused := &null +#line 74 "totex.nw" + code := &null ; writes("\\nwendcode{}") + lastdefnlabel := pendingprev := pendingnext := &null } else +#line 122 "totex.nw" +if ="@defn " then { writes("\\sublabel{", \lastxreflabel, "}") + writes("\\nwmargintag{", label2tag(\lastxreflabel), "}") + writes("\\moddef{", convquotes(thischunk := tab(0)), + ("~" || label2tag(\lastxrefref)) | "", + "}\\", defns[thischunk], "endmoddef") + useitems := \useitemstab[thischunk] + pendinguses := 1 + lastdefnlabel := lastxreflabel + +#line 216 "totex.nw" +every lastxreflabel | lastxrefref := &null +#line 131 "totex.nw" + defns[thischunk] := "plus" } else +#line 77 "totex.nw" +if ="@begin docs " then { if \delay & match(0) then +#line 110 "totex.nw" +&null +#line 77 "totex.nw" + + else {text := 0; writes("\\nwbegindocs{",tab(0),"}")} } else +if ="@end docs " then { if \delay & match(0) then +#line 112 "totex.nw" +{ writes("\\nwfilename{", filename, "}"); delay := &null } +#line 79 "totex.nw" + + else writes("\\nwenddocs{}") } else +#line 137 "totex.nw" +if ="@use " then { writes("\\LA{}", convquotes(name := tab(0)), + ("~" || label2tag(\lastxrefref)) | "", + "\\RA{}") + +#line 216 "totex.nw" +every lastxreflabel | lastxrefref := &null +#line 140 "totex.nw" + } else +#line 175 "totex.nw" +if ="@xref " then { +#line 189 "totex.nw" +if ="label " then { lastxreflabel := tab(0) } else +if ="ref " then { lastxrefref := tab(0) } else +if ="begindefs" & pos(0) then { } else +if ="defitem " then { put(defitems, tab(0)) } else +if ="enddefs" & pos(0) then { } else +if ="beginuses" & pos(0) then { useitems := [] } else +if ="useitem " then { put(useitems, tab(0)) } else +if ="enduses" & pos(0) then { useitemstab[thischunk] := useitems } else +if ="notused " then { notused := tab(0) } else +if ="nextdef " then { pendingnext := tab(0) } else +if ="prevdef " then { pendingprev := tab(0) } else +#line 294 "totex.nw" +if ="beginchunks" & pos(0) then { } else +if ="chunkbegin " then { label := tab(upto(' ')); =" " + writes("\\nwixlogsorted{c}{{", convquotes(tab(0)), + "}{", label, "}{") } else +if ="chunkuse " then { writes("\\nwixu{", tab(0), "}") } else +if ="chunkdefn " then { writes("\\nwixd{", tab(0), "}") } else +if ="chunkend" & pos(0) then { write("}}%") } else +if ="endchunks" & pos(0) then { } else +#line 175 "totex.nw" + +#line 218 "totex.nw" +warn_unknown("xref " || tab(upto(' \t') | 0)) +#line 175 "totex.nw" + } else +#line 232 "totex.nw" +if ="@index " then { +#line 240 "totex.nw" +if ="nl" & pos(0) then { write(if \code then "\\eatline" else "%")}else +if =("defn "|"localdefn ") then +#line 244 "totex.nw" +/noindex & +#line 241 "totex.nw" + { +#line 253 "totex.nw" +writes("\\nosublabel{", \lastxreflabel, "}") +writes("\\nwindexdefn{\\nwixident{", TeXliteral(name := tab(0)), "}}{", indexlabel(name), "}{", + \lastxrefref, "}") +#line 216 "totex.nw" +every lastxreflabel | lastxrefref := &null +#line 241 "totex.nw" + } else +if ="use " then +#line 244 "totex.nw" +/noindex & +#line 242 "totex.nw" + { +#line 261 "totex.nw" +if /code & /quoting then { + writes("\\protect\\nosublabel{", \lastxreflabel, "}") + writes("\\protect\\nwindexuse{\\nwixident{", TeXliteral(name := tab(0)), "}}{", + indexlabel(name), "}{", \lastxrefref, "}") +} +lastindexref := lastxrefref +#line 216 "totex.nw" +every lastxreflabel | lastxrefref := &null +#line 242 "totex.nw" + } else +#line 272 "totex.nw" +if ="begindefs" & pos(0) then +#line 244 "totex.nw" +/noindex & +#line 272 "totex.nw" + { +#line 184 "totex.nw" +dumpitems(defitems, "nwalsodefined") +dumpitems(useitems, "nwused") +writes("\\nwnotused{", \notused, "}") +#line 177 "totex.nw" +every defitems | useitems := [] +notused := &null +#line 273 "totex.nw" + writes("\\nwidentdefs{") } else +if ="isused " then +#line 244 "totex.nw" +/noindex & +#line 274 "totex.nw" + { "handled by latex" } else +if ="defitem " then +#line 244 "totex.nw" +/noindex & +#line 275 "totex.nw" + { i := tab(0); +#line 284 "totex.nw" +writes("\\\\{{\\nwixident{", TeXliteral(i), "}}{", indexlabel(i), "}}") +#line 275 "totex.nw" + } else +if ="enddefs" & pos(0) then +#line 244 "totex.nw" +/noindex & +#line 276 "totex.nw" + { writes("}") } else +if ="beginuses" & pos(0) then +#line 244 "totex.nw" +/noindex & +#line 277 "totex.nw" + { +#line 184 "totex.nw" +dumpitems(defitems, "nwalsodefined") +dumpitems(useitems, "nwused") +writes("\\nwnotused{", \notused, "}") +#line 177 "totex.nw" +every defitems | useitems := [] +notused := &null +#line 278 "totex.nw" + writes("\\nwidentuses{"); ulist := [] } else +if ="isdefined " then +#line 244 "totex.nw" +/noindex & +#line 279 "totex.nw" + { "latex finds the definitions" } else +if ="useitem " then +#line 244 "totex.nw" +/noindex & +#line 280 "totex.nw" + { i := tab(0); +#line 284 "totex.nw" +writes("\\\\{{\\nwixident{", TeXliteral(i), "}}{", indexlabel(i), "}}") +#line 280 "totex.nw" + + put(ulist, i); } else +if ="enduses" & pos(0) then +#line 244 "totex.nw" +/noindex & +#line 282 "totex.nw" + { writes("}"); +#line 286 "totex.nw" +every i := !ulist do + writes("\\nwindexuse{\\nwixident{", TeXliteral(i), "}}{", indexlabel(i), "}{", \lastdefnlabel, "}") +#line 282 "totex.nw" + } else +#line 303 "totex.nw" +if ="beginindex" & pos(0) then +#line 244 "totex.nw" +/noindex & +#line 303 "totex.nw" + { } else +if ="entrybegin " then +#line 244 "totex.nw" +/noindex & +#line 304 "totex.nw" + { label := tab(upto(' ')); =" "; name := tab(0) + write("\\nwixlogsorted{i}{{\\nwixident{", TeXliteral(name), + "}}{", indexlabel(name), "}}%") } else +if ="entryuse " then +#line 244 "totex.nw" +/noindex & +#line 307 "totex.nw" + { "handled by latex" } else +if ="entrydefn " then +#line 244 "totex.nw" +/noindex & +#line 308 "totex.nw" + { "handled by latex" } else +if ="entryend" & pos(0) then +#line 244 "totex.nw" +/noindex & +#line 309 "totex.nw" + { } else +if ="endindex" & pos(0) then +#line 244 "totex.nw" +/noindex & +#line 310 "totex.nw" + { } else +#line 232 "totex.nw" + +#line 234 "totex.nw" +warn_unknown("index " || tab(upto(' \t') | 0)) +#line 232 "totex.nw" + } else +#line 153 "totex.nw" +if ="@quote" & pos(0) then { quoting := 1 ; writes("{\\Tt{}") } else +if ="@endquote" & pos(0) then { quoting := &null ; writes("\\nwendquote}") } else +if ="@file " then { filename := tab(0); +#line 216 "totex.nw" +every lastxreflabel | lastxrefref := &null +#line 156 "totex.nw" + \delay | writes("\\nwfilename{", filename, "}") + } else +if ="@line " then { } else +if ="@literal " then { writes(tab(0)) } else +if ="@header latex " then { +#line 165 "totex.nw" +writes("\\documentclass{article}\\usepackage{noweb}\\pagestyle{noweb}\\noweboptions{", tab(0), + "}\\begin{document}") +#line 160 "totex.nw" + } else +if ="@header tex " then { writes("\\input nwmac ") } else +if ="@trailer latex" & pos(0) then { write("\\end{document}") } else +if ="@trailer tex" & pos(0) then { write("\\bye") } else +#line 61 "totex.nw" +if ="@fatal " then { # follows last else + # write(&errout, "Noweb error in stage ", tab(upto(' ')), ":", tab(0)) + exit(1) +} else if ="@" then + warn_unknown(1(tab(upto(' ')|0), pos(0) | move(1))) +else + write(&errout, "Botched line in noweb pipeline: ", tab(0)) +#line 25 "totex.nw" + } + write() +end +#line 142 "totex.nw" +procedure label2tag(label) + return "{\\nwtagstyle{}\\subpageref{" || label || "}}" +end +#line 220 "totex.nw" +procedure dumpitems(items, cs) + if *\items > 0 then { + writes("\\", cs, "{") + every writes("\\\\{", !items, "}") + writes("}") + return + } else + fail +end +#line 316 "totex.nw" +procedure firstwrite(L[]) + write := realwrite + put(L, + "% ===> this file was generated automatically by noweave --- better not edit it") + return write!L +end +#line 325 "totex.nw" +procedure escape(line, chars, prefix) + /prefix := "\\" + line ? { + s := "" + while s ||:= tab(upto(chars)) do s ||:= prefix || move(1) + return s || tab(0) + } +end +#line 334 "totex.nw" +global TeXspecials +#line 357 "totex.nw" +procedure TeXliteral(arg) + static nospace, code + initial { codes := ["\\", "nwbackslash", + "{", "nwlbrace", + "}", "nwrbrace", + "$", "$", + "&", "&", + "#", "#", + "^", "char94", + "_", "_", + "%", "%", + "~", "char126"] + code := table() + while (c := get(codes), n := get(codes)) do code[c] := string(n) + if c := !TeXspecials & c ~== " " & not member(code, c) then + fatal("internal error, character-code mismatch, report a bug!") + } + s := "" + arg ? { + while s ||:= tab(upto(TeXspecials)) do { + c := move(1) + if member(code, c) then + s ||:= "{\\" || code[c] || "}" + else + s ||:= "\\" || c + } + return s || tab(0) + } +end +#line 390 "totex.nw" +procedure convquotes(s) + r := "" + s ? { + while r ||:= tab(find("[[")) do { + ="[[" | fatal("impossible missing [[") + r ||:= "\\code{}" || TeXliteral(tab(find("]]"))) + r ||:= tab(many(']')-2) + ="]]" | fatal("impossible missing ]]") + r ||:= "\\edoc{}" + } + return r || tab(0) + } +end +#line 404 "totex.nw" +procedure warn_unknown(tag) + static warned + initial warned := set() + if not member(warned, tag) then { + write(&errout, "Warning: unrecognized escape @", tag, " ", tab(0)) + insert(warned, tag) + } + return +end +#line 416 "totex.nw" +procedure indexlabel(ident) + static badset, trans + initial { + +#line 430 "totex.nw" +trans := table() +trans[" "] := "sp" # space +trans["#"] := "has" # hash +trans["$"] := "do" # dollar +trans["%"] := "pe" # percent +trans["&"] := "am" # ampersand +trans[","] := "com" # commad +trans[":"] := "col" # colon +trans["\\"] := "bs" # backslash +trans["^"] := "hat" # hat +trans["_"] := "un" # underscore +trans["{"] := "lb" # left brace +trans["}"] := "rb" # right brace +trans["~"] := "ti" # tilde +#line 420 "totex.nw" + badset := '' + every badset ++:= key(trans) + } + ident ? { + s := "" + while s ||:= tab(upto(badset)) do s ||:= ":" || trans[move(1)] + return s || tab(0) + } +end +#line 445 "totex.nw" +procedure fatal(L[]) + write!([&errout, "noweb error in tohtml: "] ||| L) + exit(1) +end + diff --git a/web/noweb/src/icon/totex.nw b/web/noweb/src/icon/totex.nw new file mode 100644 index 0000000000..0b3200aae7 --- /dev/null +++ b/web/noweb/src/icon/totex.nw @@ -0,0 +1,450 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- +\section{Converting {\tt noweb} markup to {\TeX} markup (Icon version)} +The copyright applies both to the {\tt noweb} source and to the +generated shell script. +<<copyright notice>>= +# Copyright 1991 by Norman Ramsey. All rights reserved. +# See file COPYRIGHT for more information. +@ +Here's the organization of the source: +<<*>>= +<<copyright notice>> +procedure rcsinfo () + return "$Id: totex.nw,v 1.21 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +global headercomment, realwrite +procedure main(args) + local delay, name + <<initialization>> + delay := !args == "-delay" + noindex := !args == "-noindex" + if !args == "-no-gen-comment" then &null + else {realwrite := write; write := firstwrite} + while inputline := read() do inputline ? { + <<scan and convert>> + } + write() +end +@ The markup carefully adds no newlines not already present in the input, +so that the line numbers of the {\TeX} file will be the same as the +numbers of the corresponding {\tt noweb} file. +The variables are: +\begin{description} +\item[\tt code] Nonnull if converting a code chunk. +\item[\tt quoting] Nonnull if quoting code in documentation. +\item[\tt text] Number of characters written since start of + documentation chunk. +\end{description} +[[text]] is used to write [[\nwdocspar]] if a newline appears at the +beginning of a documentation chunk without any intervening text. +This subtle trick preserves new-paragraph semantics without requiring +the insertion of a blank line that would throw off the line count. +The special control sequences makes a page break at that spot especially likely, +so that small documentation chunks will appear on the some page as the code +chunks they precede. +<<initialization>>= +text := 1 +@ %def text + +Ordering helps improve speed, so I write things in a funny order. +This whole code is a giant [[if ... then ... else if ...]]. +<<scan and convert>>= +<<@text>> +<<@nl>> +<<code chunks>> +<<@defn>> +<<docs chunks>> +<<@use>> +<<@xref>> +<<@index>> +<<others>> +if ="@fatal " then { # follows last else + # write(&errout, "Noweb error in stage ", tab(upto(' ')), ":", tab(0)) + exit(1) +} else if ="@" then + warn_unknown(1(tab(upto(' ')|0), pos(0) | move(1))) +else + write(&errout, "Botched line in noweb pipeline: ", tab(0)) +@ +\subsection{Basic text and chunk boundaries} +<<code chunks>>= +if ="@begin code " then { code := 1 ; writes("\\nwbegincode{", tab(0), "}") + <<reset cross-reference info>> } else +if ="@end code " then { <<dump pending cross-reference info>> + code := &null ; writes("\\nwendcode{}") + lastdefnlabel := pendingprev := pendingnext := &null } else +<<docs chunks>>= +if ="@begin docs " then { if \delay & match(0) then <<delay for [[@begin docs]]>> + else {text := 0; writes("\\nwbegindocs{",tab(0),"}")} } else +if ="@end docs " then { if \delay & match(0) then <<delay for [[@end docs]]>> + else writes("\\nwenddocs{}") } else +<<@text>>= +if ="@text " then { text +:= *(line := tab(0)) + writes(if \quoting then <<possibly indexed quoted [[line]]>> + else if \code then <<possibly indexed code [[line]]>> + else line) + lastindexref := &null } else +<<possibly indexed quoted [[line]]>>= +if /noindex & \lastindexref then + "\\nwlinkedidentq{" || TeXliteral(line) || "}{" || lastindexref || "}" +else + TeXliteral(line) +<<possibly indexed code [[line]]>>= +if /noindex & \lastindexref then + "\\nwlinkedidentc{" || escape(line, '{}\\') || "}{" || lastindexref || "}" +else + escape(line, '{}\\') + +<<@nl>>= +if ="@nl" & pos(0) then { if /code then {<<print [[\nwdocspar]] if no [[text]]>>} + if \quoting then writes("\\nwnewline") + <<show definitions and uses on definition line---once>> + write() } else +@ +Delaying markup is handled by special patterns for the first document chunk. +Because several {\tt noweb} files can be marked up at once, there can be +several document chunks numbered 0. +The later ones are given no special treatment by the simple expedient of +turning [[delay]] off after the first one. +<<delay for [[@begin docs]]>>= +&null +<<delay for [[@end docs]]>>= +{ writes("\\nwfilename{", filename, "}"); delay := &null } +@ +<<print [[\nwdocspar]] if no [[text]]>>= +if text = 0 then writes("\\nwdocspar") +text := 1 +@ +\subsection{Chunk definitions and uses, with possible cross-reference} +Here we start to see the cross-reference markup, driven by [[lastxreflabel]] +and [[lastxrefref]]. +<<@defn>>= +if ="@defn " then { writes("\\sublabel{", \lastxreflabel, "}") + writes("\\nwmargintag{", label2tag(\lastxreflabel), "}") + writes("\\moddef{", convquotes(thischunk := tab(0)), + ("~" || label2tag(\lastxrefref)) | "", + "}\\", defns[thischunk], "endmoddef") + useitems := \useitemstab[thischunk] + pendinguses := 1 + lastdefnlabel := lastxreflabel + <<clear [[lastxref*]]>> + defns[thischunk] := "plus" } else +@ [[useitemstab]] enables us to show uses even on later instances of a chunk, +although the index filter only provides uses with the first chunk. +<<initialization>>= +useitemstab := table() +<<@use>>= +if ="@use " then { writes("\\LA{}", convquotes(name := tab(0)), + ("~" || label2tag(\lastxrefref)) | "", + "\\RA{}") + <<clear [[lastxref*]]>> } else +<<*>>= +procedure label2tag(label) + return "{\\nwtagstyle{}\\subpageref{" || label || "}}" +end +@ +[[defns]] serves only to give the proper distinction between +[[\endmoddef]] and [[\plusendmoddef]]. +<<initialization>>= +defns := table("") +@ +\subsection{Quoting, headers, trailers, \& miscellany} +<<others>>= +if ="@quote" & pos(0) then { quoting := 1 ; writes("{\\Tt{}") } else +if ="@endquote" & pos(0) then { quoting := &null ; writes("\\nwendquote}") } else +if ="@file " then { filename := tab(0); <<clear [[lastxref*]]>> + \delay | writes("\\nwfilename{", filename, "}") + } else +if ="@line " then { } else +if ="@literal " then { writes(tab(0)) } else +if ="@header latex " then { <<write {\LaTeX} header>> } else +if ="@header tex " then { writes("\\input nwmac ") } else +if ="@trailer latex" & pos(0) then { write("\\end{document}") } else +if ="@trailer tex" & pos(0) then { write("\\bye") } else +<<write {\LaTeX} header>>= +writes("\\documentclass{article}\\usepackage{noweb}\\pagestyle{noweb}\\noweboptions{", tab(0), + "}\\begin{document}") +@ +\subsection{Cross-reference and index support} + +\subsubsection{Chunk cross-reference} +We begin with basic cross-reference [[@xref label]] and [[@xref ref]], +then show the chunk cross-reference that comes at the end of a code chunk. +The {\LaTeX} back end ignores [[@xref nextdef]] and [[@xref prevdef]]. +<<@xref>>= +if ="@xref " then { <<@xref tests>> <<bad @xref>> } else +<<reset cross-reference info>>= +every defitems | useitems := [] +notused := &null +@ +By resetting the cross-reference info after dumping, +we make it possible to dump both before index stuff and before +end of chunk, without having to do any checking. +<<dump pending cross-reference info>>= +dumpitems(defitems, "nwalsodefined") +dumpitems(useitems, "nwused") +writes("\\nwnotused{", \notused, "}") +<<reset cross-reference info>> +<<@xref tests>>= +if ="label " then { lastxreflabel := tab(0) } else +if ="ref " then { lastxrefref := tab(0) } else +if ="begindefs" & pos(0) then { } else +if ="defitem " then { put(defitems, tab(0)) } else +if ="enddefs" & pos(0) then { } else +if ="beginuses" & pos(0) then { useitems := [] } else +if ="useitem " then { put(useitems, tab(0)) } else +if ="enduses" & pos(0) then { useitemstab[thischunk] := useitems } else +if ="notused " then { notused := tab(0) } else +if ="nextdef " then { pendingnext := tab(0) } else +if ="prevdef " then { pendingprev := tab(0) } else +<<show definitions and uses on definition line---once>>= +if \pendinguses | \pendingprev | \pendingnext then { + writes("\\nwstartdeflinemarkup") + <<write out definition-line markup>> + writes("\\nwenddeflinemarkup") + pendinguses := pendingprev := pendingnext := &null +} +<<write out definition-line markup>>= +if \pendinguses then { + dumpitems(useitems, "nwusesondefline") +} +if \pendingprev | \pendingnext then { + writes("\\nwprevnextdefs{", \pendingprev | "\\relax", "}{", + \pendingnext | "\\relax", "}") +} +<<clear [[lastxref*]]>>= +every lastxreflabel | lastxrefref := &null +<<bad @xref>>= +warn_unknown("xref " || tab(upto(' \t') | 0)) +<<*>>= +procedure dumpitems(items, cs) + if *\items > 0 then { + writes("\\", cs, "{") + every writes("\\\\{", !items, "}") + writes("}") + return + } else + fail +end +@ +\subsubsection{Identifier cross-reference, i.e.\ index} +<<@index>>= +if ="@index " then { <<@index tests>> <<bad @index>> } else +<<bad @index>>= +warn_unknown("index " || tab(upto(' \t') | 0)) +@ +This first round of stuff just handles the basics: definitions, uses, and newlines. +Unless it's OK to show the index (by \LA{}SI\RA), we handle nothing but +\hbox{[[@index nl]]}. +<<@index tests>>= +if ="nl" & pos(0) then { write(if \code then "\\eatline" else "%")}else +if =("defn "|"localdefn ") then <<SI>> { <<handle index defn>> } else +if ="use " then <<SI>> { <<handle index use>> } else +<<SI>>= +/noindex & +@ +Nothing is involved in handling definitions and uses unless there are cross-reference +labels pending. +An index definition or use has its own [[@xref label]] only if it's in documentation; +if it's in code, we use the anchor label of the definition. +(You don't have to know that to understand what happens here, but I thought you +might like to.) +<<handle index defn>>= +writes("\\nosublabel{", \lastxreflabel, "}") +writes("\\nwindexdefn{\\nwixident{", TeXliteral(name := tab(0)), "}}{", indexlabel(name), "}{", + \lastxrefref, "}") +<<clear [[lastxref*]]>> +@ +The {\LaTeX} back end ignores uses in code; they get bundled up by a previous filter +(the cross-referencer) and handled elsewhere. +<<handle index use>>= +if /code & /quoting then { + writes("\\protect\\nosublabel{", \lastxreflabel, "}") + writes("\\protect\\nwindexuse{\\nwixident{", TeXliteral(name := tab(0)), "}}{", + indexlabel(name), "}{", \lastxrefref, "}") +} +lastindexref := lastxrefref +<<clear [[lastxref*]]>> +@ +Here's the local identifier cross-reference that appears at the end of a code chunk. +We guard everything with \LA{}SI\RA, as before. +<<@index tests>>= +if ="begindefs" & pos(0) then <<SI>> { <<dump pending cross-reference info>> + writes("\\nwidentdefs{") } else +if ="isused " then <<SI>> { "handled by latex" } else +if ="defitem " then <<SI>> { i := tab(0); <<write [[i]] with [[\\]]>> } else +if ="enddefs" & pos(0) then <<SI>> { writes("}") } else +if ="beginuses" & pos(0) then <<SI>> { <<dump pending cross-reference info>> + writes("\\nwidentuses{"); ulist := [] } else +if ="isdefined " then <<SI>> { "latex finds the definitions" } else +if ="useitem " then <<SI>> { i := tab(0); <<write [[i]] with [[\\]]>> + put(ulist, i); } else +if ="enduses" & pos(0) then <<SI>> { writes("}"); <<write [[ulist]]>> } else +<<write [[i]] with [[\\]]>>= +writes("\\\\{{\\nwixident{", TeXliteral(i), "}}{", indexlabel(i), "}}") +<<write [[ulist]]>>= +every i := !ulist do + writes("\\nwindexuse{\\nwixident{", TeXliteral(i), "}}{", indexlabel(i), "}{", \lastdefnlabel, "}") +@ +\subsubsection{The list of chunks and the index} +The treatments of the list of chunks and the index are similar. +Both use [[\nwixlogsorted]], which writes magic goo into the {\tt .aux} file. +The real cross-referencing is done by the underlying {\LaTeX} code. +<<@xref tests>>= +if ="beginchunks" & pos(0) then { } else +if ="chunkbegin " then { label := tab(upto(' ')); =" " + writes("\\nwixlogsorted{c}{{", convquotes(tab(0)), + "}{", label, "}{") } else +if ="chunkuse " then { writes("\\nwixu{", tab(0), "}") } else +if ="chunkdefn " then { writes("\\nwixd{", tab(0), "}") } else +if ="chunkend" & pos(0) then { write("}}%") } else +if ="endchunks" & pos(0) then { } else +<<@index tests>>= +if ="beginindex" & pos(0) then <<SI>> { } else +if ="entrybegin " then <<SI>> { label := tab(upto(' ')); =" "; name := tab(0) + write("\\nwixlogsorted{i}{{\\nwixident{", TeXliteral(name), + "}}{", indexlabel(name), "}}%") } else +if ="entryuse " then <<SI>> { "handled by latex" } else +if ="entrydefn " then <<SI>> { "handled by latex" } else +if ="entryend" & pos(0) then <<SI>> { } else +if ="endindex" & pos(0) then <<SI>> { } else +@ +\subsection{HEader comments} +This godawful hack slips in a comment without messing up our line +numbers. +<<*>>= +procedure firstwrite(L[]) + write := realwrite + put(L, + "% ===> this file was generated automatically by noweave --- better not edit it") + return write!L +end +@ +\subsection{Utility procedures} +<<*>>= +procedure escape(line, chars, prefix) + /prefix := "\\" + line ? { + s := "" + while s ||:= tab(upto(chars)) do s ||:= prefix || move(1) + return s || tab(0) + } +end +<<*>>= +global TeXspecials +<<initialization>>= +TeXspecials := '\\{}$&#^_ ~%' +@ +I can't use [[\\char`\%]] and similar sequences with latex2e, because +[[`]] is an active character that suppresses ligatures. So I got TeX to print out the +actual character codes for me. +This string ([['\\{}$&#^_ ~%']]) should serve as a test. + +Unfortunately, the character codes for these characters are not the +same across fonts. While this is not a problem when everything is in +a typewriter font, it can cause major strangenesses when another font +is used (Icon, for example, is often typeset in a sans-serif font). +Codes for `[[$]]', `[[&]]', `[[#]]', `[[^]]', `[[_]]', `[[~]]' and +`[[%]]' use +font-independent macros. Since there is no font-independent way to +typeset `[[\]]', `[[{]]' and `[[}]]',\footnote{Although both plain +\TeX\ and \LaTeX\ provide `[[\{]]' and `[[\}]], plain \TeX\ only +allows their use in math mode.} +we generate special macros defined in \verb"noweb.sty" and +\verb"nwmac.tex". The default definitions are geared to typewriter +fonts, but they can be redefined as necessary. +<<*>>= +procedure TeXliteral(arg) + static nospace, code + initial { codes := ["\\", "nwbackslash", + "{", "nwlbrace", + "}", "nwrbrace", + "$", "$", + "&", "&", + "#", "#", + "^", "char94", + "_", "_", + "%", "%", + "~", "char126"] + code := table() + while (c := get(codes), n := get(codes)) do code[c] := string(n) + if c := !TeXspecials & c ~== " " & not member(code, c) then + fatal("internal error, character-code mismatch, report a bug!") + } + s := "" + arg ? { + while s ||:= tab(upto(TeXspecials)) do { + c := move(1) + if member(code, c) then + s ||:= "{\\" || code[c] || "}" + else + s ||:= "\\" || c + } + return s || tab(0) + } +end +@ +A special function is used to implement {\tt noweb}'s quoting +convention within chunk names. +<<*>>= +procedure convquotes(s) + r := "" + s ? { + while r ||:= tab(find("[[")) do { + ="[[" | fatal("impossible missing [[") + r ||:= "\\code{}" || TeXliteral(tab(find("]]"))) + r ||:= tab(many(']')-2) + ="]]" | fatal("impossible missing ]]") + r ||:= "\\edoc{}" + } + return r || tab(0) + } +end +<<*>>= +procedure warn_unknown(tag) + static warned + initial warned := set() + if not member(warned, tag) then { + write(&errout, "Warning: unrecognized escape @", tag, " ", tab(0)) + insert(warned, tag) + } + return +end +@ +This gets special characters out of the labels used by identifiers. +<<*>>= +procedure indexlabel(ident) + static badset, trans + initial { + <<initialize [[trans]]>> + badset := '' + every badset ++:= key(trans) + } + ident ? { + s := "" + while s ||:= tab(upto(badset)) do s ||:= ":" || trans[move(1)] + return s || tab(0) + } +end +<<initialize [[trans]]>>= +trans := table() +trans[" "] := "sp" # space +trans["#"] := "has" # hash +trans["$"] := "do" # dollar +trans["%"] := "pe" # percent +trans["&"] := "am" # ampersand +trans[","] := "com" # commad +trans[":"] := "col" # colon +trans["\\"] := "bs" # backslash +trans["^"] := "hat" # hat +trans["_"] := "un" # underscore +trans["{"] := "lb" # left brace +trans["}"] := "rb" # right brace +trans["~"] := "ti" # tilde +<<*>>= +procedure fatal(L[]) + write!([&errout, "noweb error in tohtml: "] ||| L) + exit(1) +end + diff --git a/web/noweb/src/icon/xchunks.icn b/web/noweb/src/icon/xchunks.icn new file mode 100644 index 0000000000..cf1a74b20e --- /dev/null +++ b/web/noweb/src/icon/xchunks.icn @@ -0,0 +1,142 @@ +#line 31 "xchunks.nw" +record chunk(lines, type) + # lines is all the lines of the chunk + # type is "code" or "docs" or "unknown" + +procedure main(args) + local merge, summary + while args[1][1] == "-" do + case args[1] of { + "-merge" : merge := get(args) + "-summary" : { get(args); summary := " (summary)" } + default : break + } + *args > 0 | stop("xchunks needs an external database") + + +#line 136 "xchunks.nw" +db := "markup" +every db ||:= " " || !args +db := open(db, "rp") | stop("cannot pipe from ", image(db)) + +#line 47 "xchunks.nw" + dbchunks := readchunks(db) + defns := defnstable(dbchunks) + # defns maps name to list of code chunks defining that name + if \merge then + every merge_chunks(!defns) + if \summary then + every add_defn_string(!defns, summary) + + thisdoc := readchunks(&input) + every c := !thisdoc do + if c.type ~== "code" | notEmpty(c) | /defns[chunkName(c)] then + every write(!c.lines) + else { + write("@crc_prefix on") + every write(!(!defns[chunkName(c)]).lines) + write("@crc_prefix off") + } +end +#line 69 "xchunks.nw" +procedure readchunks(infile) + local chunks, c + local file, lnum, lines, startline + chunks := [] + lnum := 1 + while line := read(infile) do + line ? + if ="@file " then { + file := tab(0) + lnum := 1 + } else if ="@line " then { + lnum := integer(tab(0)) + } else if ="@begin " then { + lines := [] + put(lines, "@file " || \file) + put(lines, "@line " || lnum) + put(lines, line) + startline := line + c := chunk(lines, tab(upto(' ')|0)) + line := read(infile) | stop("unmatched ", startline) + while line ? not ="@end " do { + put(c.lines, line) + line := read(infile) | stop("unmatched ", startline) + line ? + if ="@file " then { file := tab(0); lnum := 1 } + else if ="@line " then { lnum := integer(tab(0)) } + else if =("@nl"|"@index nl") & pos(0) then { lnum := lnum + 1 } + } + put(c.lines, line) + put(chunks, c) + } else { + put(chunks, chunk([line], "unknown")) + line ? + if ="@file " then { file := tab(0); lnum := 1 } + else if ="@line " then { lnum := integer(tab(0)) } + else if =("@nl"|"@index nl") & pos(0) then { lnum := lnum + 1 } + } + return chunks +end +#line 111 "xchunks.nw" +procedure defnstable(chunks) + t := table() + every c := !chunks & c.type == "code" do { + /t[chunkName(c)] := [] + put(t[chunkName(c)], c) + } + return t +end +#line 124 "xchunks.nw" +procedure chunkName(c) + return (!c.lines ? (="@defn " & tab(0))) | stop("no @defn in code chunk") +end + +procedure notEmpty(c) + static nonwhite + initial nonwhite := ~' \t' + return !c.lines ? ="@use " | (="@text ", upto(nonwhite)) +end +#line 142 "xchunks.nw" +procedure merge_chunks(chunks) + while *chunks > 1 do { + c := get(chunks) + strip_code_tail(c) + strip_code_head(chunks[1]) + every put(c.lines, !chunks[1].lines) + chunks[1] := c + } + return chunks +end +#line 154 "xchunks.nw" +procedure strip_code_tail(c) + if c.lines[-1] ? match("@end code") then + pull(c.lines) + else + stop("Unexpected line") + return c +end + +procedure strip_code_head(c) + local pfx + pfx := [] + if match("@begin code", c.lines[1]) then + get(c.lines) + else + stop("bad line " || c.lines[1]) + while not match("@defn ", c.lines[1]) do + push(pfx, get(c.lines)) + get(c.lines) | stop("this can't happen") + while c.lines[1] ~== "@nl" do + push(pfx, get(c.lines)) + get(c.lines) | stop("this can't happen") + every push(c.lines, !pfx) + return c +end +#line 180 "xchunks.nw" +procedure add_defn_string(chunks, s) + every c := !chunks & i := 1 to *c.lines do + if match("@defn ", c.lines[i]) then + c.lines[i] ||:= s + return chunks +end diff --git a/web/noweb/src/icon/xchunks.nw b/web/noweb/src/icon/xchunks.nw new file mode 100644 index 0000000000..b3ef8fd98d --- /dev/null +++ b/web/noweb/src/icon/xchunks.nw @@ -0,0 +1,186 @@ +% -*- mode: Noweb; noweb-code-mode: icon-mode -*- + +\section{Getting chunks from an external ``dictionary''} + +Mike Smith wants to do an unweblike thing: keep his code and +documentation in separate source files. +I~think he wants to do this so he can enable the \emph{same} code +chunks to appear in \emph{multiple} documents, with guaranteed +consistency, but I~suppose the reasons don't matter. +In any case, he wants syntax for referring to a code chunk from an +external database, and for displaying the definition(s) of that chunk +exactly where he specifies. + +I~suggested solving the problem with a Noweb filter. +He can refer to chunks using the approved source syntax: +\texttt{[{}[<{}<}\emph{chunk name}\texttt{>{}>]{}]}. +To pull in the definitions from the external database, I suggested he +provide an empty definition. +Since such a definition can be written in one line (two lines if the +definition is followed by a documentation chunk), he can pull in many +definitions concisely. + +This program is the noweb filter that does the job. +Named ``\texttt{xchunks},'' short for ``external chunks,'' it pulls in +definitions from an external database. +The external database is itself simply a list of Noweb files. +It's a bit more liberal than defined above; a chunk is considered +empty if its definition contains at most whitespace. + +A late-breaking bug: we need to resynchronize line numbers. +<<*>>= +record chunk(lines, type) + # lines is all the lines of the chunk + # type is "code" or "docs" or "unknown" + +procedure main(args) + local merge, summary + while args[1][1] == "-" do + case args[1] of { + "-merge" : merge := get(args) + "-summary" : { get(args); summary := " (summary)" } + default : break + } + *args > 0 | stop("xchunks needs an external database") + + <<let [[db]] be an open file giving the database pipeline from [[args]]>> + + dbchunks := readchunks(db) + defns := defnstable(dbchunks) + # defns maps name to list of code chunks defining that name + if \merge then + every merge_chunks(!defns) + if \summary then + every add_defn_string(!defns, summary) + + thisdoc := readchunks(&input) + every c := !thisdoc do + if c.type ~== "code" | notEmpty(c) | /defns[chunkName(c)] then + every write(!c.lines) + else { + write("@crc_prefix on") + every write(!(!defns[chunkName(c)]).lines) + write("@crc_prefix off") + } +end +@ +Reading chunks is fairly straightforward; we look for begin and end. +The loop logic is a little less pleasant than I would like. +<<*>>= +procedure readchunks(infile) + local chunks, c + local file, lnum, lines, startline + chunks := [] + lnum := 1 + while line := read(infile) do + line ? + if ="@file " then { + file := tab(0) + lnum := 1 + } else if ="@line " then { + lnum := integer(tab(0)) + } else if ="@begin " then { + lines := [] + put(lines, "@file " || \file) + put(lines, "@line " || lnum) + put(lines, line) + startline := line + c := chunk(lines, tab(upto(' ')|0)) + line := read(infile) | stop("unmatched ", startline) + while line ? not ="@end " do { + put(c.lines, line) + line := read(infile) | stop("unmatched ", startline) + line ? + if ="@file " then { file := tab(0); lnum := 1 } + else if ="@line " then { lnum := integer(tab(0)) } + else if =("@nl"|"@index nl") & pos(0) then { lnum := lnum + 1 } + } + put(c.lines, line) + put(chunks, c) + } else { + put(chunks, chunk([line], "unknown")) + line ? + if ="@file " then { file := tab(0); lnum := 1 } + else if ="@line " then { lnum := integer(tab(0)) } + else if =("@nl"|"@index nl") & pos(0) then { lnum := lnum + 1 } + } + return chunks +end +@ +Building the definitions table is easy. +<<*>>= +procedure defnstable(chunks) + t := table() + every c := !chunks & c.type == "code" do { + /t[chunkName(c)] := [] + put(t[chunkName(c)], c) + } + return t +end +@ +The basic functions [[chunkName]] and [[notEmpty]] require search. +You could imagine caching these, but since they're called twice and at +most once per chunk, respectively, I doubt it's worth it. +<<*>>= +procedure chunkName(c) + return (!c.lines ? (="@defn " & tab(0))) | stop("no @defn in code chunk") +end + +procedure notEmpty(c) + static nonwhite + initial nonwhite := ~' \t' + return !c.lines ? ="@use " | (="@text ", upto(nonwhite)) +end +@ +Finally, here's how we get the database. +<<let [[db]] be an open file giving the database pipeline from [[args]]>>= +db := "markup" +every db ||:= " " || !args +db := open(db, "rp") | stop("cannot pipe from ", image(db)) +@ +To merge adjacent definitions, we strip leading and trailing markup. +<<*>>= +procedure merge_chunks(chunks) + while *chunks > 1 do { + c := get(chunks) + strip_code_tail(c) + strip_code_head(chunks[1]) + every put(c.lines, !chunks[1].lines) + chunks[1] := c + } + return chunks +end +@ +<<*>>= +procedure strip_code_tail(c) + if c.lines[-1] ? match("@end code") then + pull(c.lines) + else + stop("Unexpected line") + return c +end + +procedure strip_code_head(c) + local pfx + pfx := [] + if match("@begin code", c.lines[1]) then + get(c.lines) + else + stop("bad line " || c.lines[1]) + while not match("@defn ", c.lines[1]) do + push(pfx, get(c.lines)) + get(c.lines) | stop("this can't happen") + while c.lines[1] ~== "@nl" do + push(pfx, get(c.lines)) + get(c.lines) | stop("this can't happen") + every push(c.lines, !pfx) + return c +end +@ +<<*>>= +procedure add_defn_string(chunks, s) + every c := !chunks & i := 1 to *c.lines do + if match("@defn ", c.lines[i]) then + c.lines[i] ||:= s + return chunks +end diff --git a/web/noweb/src/icon/yaccdefs.icn b/web/noweb/src/icon/yaccdefs.icn new file mode 100644 index 0000000000..e0313651e8 --- /dev/null +++ b/web/noweb/src/icon/yaccdefs.icn @@ -0,0 +1,67 @@ +#line 2 "yaccdefs.nw" +procedure rcsinfo () + return "$Id: yaccdefs.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +procedure main(args) + go() +end + +procedure postpass(name, arg) + static kind + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if id := tab(many(&letters)) then { + tab(many(' \t')) + if =":" & any(&letters ++ ' ([{') then writedefn(id) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end +#line 1 "defns.nw" +procedure go() + local line + while line := read() do { + apply(prepass, line) + write(line) + if match("@fatal ", line) then exit(1) + apply(postpass, line) + } +end + +procedure apply(pass, line) + line ? (="@" & pass(tab(upto(' ')|0), if =" " then tab(0) else &null)) +end +#line 18 "defns.nw" +procedure writedefn(defn, locl) + static indextext + initial indextext := "" + if /defn then + *indextext > 0 & +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 23 "defns.nw" + else { + if *indextext + *defn > 65 then +#line 31 "defns.nw" +{ # write("@index nl") # don't! + indextext := "" +} +#line 25 "defns.nw" + write(if \locl then "@index localdefn " else "@index defn ", defn) + indextext ||:= " " || defn + } + return +end +#line 35 "defns.nw" +procedure rcsinfo_too () + return "$Id: defns.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end diff --git a/web/noweb/src/icon/yaccdefs.nw b/web/noweb/src/icon/yaccdefs.nw new file mode 100644 index 0000000000..596090cff5 --- /dev/null +++ b/web/noweb/src/icon/yaccdefs.nw @@ -0,0 +1,26 @@ +\section{Finding {\tt yacc} definitions} +<<*>>= +procedure rcsinfo () + return "$Id: yaccdefs.nw,v 1.18 2008/10/06 01:03:05 nr Exp nr $" || + "$Name: v2_12 $" +end +procedure main(args) + go() +end + +procedure postpass(name, arg) + static kind + case name of { + "begin" : arg ? kind := tab(upto(' ')|0) + "text" : if kind == "code" then arg ? + if id := tab(many(&letters)) then { + tab(many(' \t')) + if =":" & any(&letters ++ ' ([{') then writedefn(id) + } + } + return +end + +procedure prepass(name, arg) + if name == "end" then writedefn(&null) # force newline +end |