summaryrefslogtreecommitdiff
path: root/web/noweb/src/icon
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /web/noweb/src/icon
Initial commit
Diffstat (limited to 'web/noweb/src/icon')
-rw-r--r--web/noweb/src/icon/Makefile151
-rw-r--r--web/noweb/src/icon/asdldefs.icn85
-rw-r--r--web/noweb/src/icon/asdldefs.nw46
-rw-r--r--web/noweb/src/icon/cdefs.icn180
-rw-r--r--web/noweb/src/icon/cdefs.nw132
-rw-r--r--web/noweb/src/icon/defns.nw40
-rw-r--r--web/noweb/src/icon/disambiguate.icn67
-rw-r--r--web/noweb/src/icon/disambiguate.nw80
-rw-r--r--web/noweb/src/icon/docs2comments.icn180
-rw-r--r--web/noweb/src/icon/docs2comments.nw192
-rw-r--r--web/noweb/src/icon/elide.icn71
-rw-r--r--web/noweb/src/icon/elide.nw112
-rw-r--r--web/noweb/src/icon/htmltoc.icn218
-rw-r--r--web/noweb/src/icon/htmltoc.nw264
-rw-r--r--web/noweb/src/icon/icondefs.icn77
-rw-r--r--web/noweb/src/icon/icondefs.nw37
-rw-r--r--web/noweb/src/icon/l2h.icn2237
-rw-r--r--web/noweb/src/icon/l2h.nw2898
-rw-r--r--web/noweb/src/icon/lrtldefs.icn99
-rw-r--r--web/noweb/src/icon/lrtldefs.nw60
-rw-r--r--web/noweb/src/icon/mmixdefs.icn71
-rw-r--r--web/noweb/src/icon/mmixdefs.nw32
-rw-r--r--web/noweb/src/icon/noidx.icn465
-rw-r--r--web/noweb/src/icon/noidx.nw479
-rw-r--r--web/noweb/src/icon/noindex.icn98
-rw-r--r--web/noweb/src/icon/noindex.nw106
-rw-r--r--web/noweb/src/icon/noxref.nw119
-rw-r--r--web/noweb/src/icon/nwl2h.nw79
-rw-r--r--web/noweb/src/icon/pascaldefs.icn96
-rw-r--r--web/noweb/src/icon/pascaldefs.nw55
-rw-r--r--web/noweb/src/icon/pdcached.icn238
-rw-r--r--web/noweb/src/icon/pdcached.nw248
-rw-r--r--web/noweb/src/icon/pipedocs.icn65
-rw-r--r--web/noweb/src/icon/pipedocs.nw69
-rw-r--r--web/noweb/src/icon/promeladefs.icn97
-rw-r--r--web/noweb/src/icon/promeladefs.nw56
-rw-r--r--web/noweb/src/icon/sl2h.icn2167
-rw-r--r--web/noweb/src/icon/smldefs.icn84
-rw-r--r--web/noweb/src/icon/smldefs.nw44
-rw-r--r--web/noweb/src/icon/texdefs.icn73
-rw-r--r--web/noweb/src/icon/texdefs.nw32
-rw-r--r--web/noweb/src/icon/tohtml.icn489
-rw-r--r--web/noweb/src/icon/tohtml.nw534
-rw-r--r--web/noweb/src/icon/totex.icn456
-rw-r--r--web/noweb/src/icon/totex.nw450
-rw-r--r--web/noweb/src/icon/xchunks.icn142
-rw-r--r--web/noweb/src/icon/xchunks.nw186
-rw-r--r--web/noweb/src/icon/yaccdefs.icn67
-rw-r--r--web/noweb/src/icon/yaccdefs.nw26
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("&", "&amp;")
+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", "&sect;")
+substitution("P", "&para;")
+substitution("copyright", "&copy;")
+substitution("pounds", "&pound;")
+substitution("o", "&oslash;")
+substitution("O", "&Oslash;")
+substitution("aa", "&aring;")
+substitution("AA", "&Aring;")
+substitution("ae", "&aelig;")
+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", "&lt;&gt;")
+substitution("langle", "&lt;")
+substitution("rangle", "&gt;")
+substitution("le", "&lt;=")
+substitution("ne", "!=")
+substitution("ge", "&gt;=")
+substitution("times", "&times;")
+substitution("divide", "&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", "&micro;")
+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", "&lt;=")
+substitution("geq", "&gt;=")
+substitution("ll", "&laquo;")
+substitution("gg", "&raquo;")
+substitution("Rightarrow", "==&gt;")
+substitution("rightarrow", "--&gt;")
+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("~", "&nbsp;")
+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, "&lt;")
+ ">" : emit_text(S, "&gt;")
+ "\"" : emit_text(S, "&quot;")
+ "-" : {
+#line 735 "l2h.nw"
+if S.mode == "V" then S.mode := "H"
+if S.mode == "H" then
+ if ="--" then emit_text(S, "&mdash;")
+ else if ="-" then emit_text(S, "&ndash;")
+ 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, "&ldquo;")
+ else emit_text(S, "&lsquo;")
+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, "&rdquo;")
+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, "&quot;")
+ "&" : emit_text(S, "&amp;")
+ "<" : emit_text(S, "&lt;")
+ ">" : emit_text(S, "&gt;")
+ " " : emit_text(S, if \cl.translate_blank then "&middot;" 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 "&lt;-" else "-&gt;") || "]</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&nbsp;")
+ 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("&", "&amp;")
+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", "&sect;")
+substitution("P", "&para;")
+substitution("copyright", "&copy;")
+substitution("pounds", "&pound;")
+substitution("o", "&oslash;")
+substitution("O", "&Oslash;")
+substitution("aa", "&aring;")
+substitution("AA", "&Aring;")
+substitution("ae", "&aelig;")
+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", "&lt;&gt;")
+substitution("langle", "&lt;")
+substitution("rangle", "&gt;")
+substitution("le", "&lt;=")
+substitution("ne", "!=")
+substitution("ge", "&gt;=")
+substitution("times", "&times;")
+substitution("divide", "&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", "&micro;")
+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", "&lt;=")
+substitution("geq", "&gt;=")
+substitution("ll", "&laquo;")
+substitution("gg", "&raquo;")
+substitution("Rightarrow", "==&gt;")
+substitution("rightarrow", "--&gt;")
+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("~", "&nbsp;")
+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, "&lt;")
+ ">" : emit_text(S, "&gt;")
+ "\"" : emit_text(S, "&quot;")
+ "-" : {<<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, "&mdash;")
+ else if ="-" then emit_text(S, "&ndash;")
+ 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, "&ldquo;")
+ else emit_text(S, "&lsquo;")
+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, "&rdquo;")
+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, "&quot;")
+ "&" : emit_text(S, "&amp;")
+ "<" : emit_text(S, "&lt;")
+ ">" : emit_text(S, "&gt;")
+ " " : emit_text(S, if \cl.translate_blank then "&middot;" 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 "&lt;-" else "-&gt;") || "]</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&nbsp;")
+ 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("&", "&amp;")
+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", "&sect;")
+substitution("P", "&para;")
+substitution("copyright", "&copy;")
+substitution("pounds", "&pound;")
+substitution("o", "&oslash;")
+substitution("O", "&Oslash;")
+substitution("aa", "&aring;")
+substitution("AA", "&Aring;")
+substitution("ae", "&aelig;")
+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", "&lt;&gt;")
+substitution("langle", "&lt;")
+substitution("rangle", "&gt;")
+substitution("le", "&lt;=")
+substitution("ne", "!=")
+substitution("ge", "&gt;=")
+substitution("times", "&times;")
+substitution("divide", "&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", "&micro;")
+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", "&lt;=")
+substitution("geq", "&gt;=")
+substitution("ll", "&laquo;")
+substitution("gg", "&raquo;")
+substitution("Rightarrow", "==&gt;")
+substitution("rightarrow", "--&gt;")
+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("~", "&nbsp;")
+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, "&lt;")
+ ">" : emit_text(S, "&gt;")
+ "\"" : emit_text(S, "&quot;")
+ "-" : {
+#line 735 "l2h.nw"
+if S.mode == "V" then S.mode := "H"
+if S.mode == "H" then
+ if ="--" then emit_text(S, "&mdash;")
+ else if ="-" then emit_text(S, "&ndash;")
+ 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, "&ldquo;")
+ else emit_text(S, "&lsquo;")
+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, "&rdquo;")
+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, "&quot;")
+ "&" : emit_text(S, "&amp;")
+ "<" : emit_text(S, "&lt;")
+ ">" : emit_text(S, "&gt;")
+ " " : emit_text(S, if \cl.translate_blank then "&middot;" 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 "&lt;-" else "-&gt;") || "]</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&nbsp;")
+ 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 "&lt;-U" else "U-&gt;"
+ writes(if i > 1 then " " else "", linkto(useitems[i], usedir))
+ }
+ writes(")</b>")
+}
+if \pendingprev | \pendingnext then {
+ writes(" <b>[")
+ writes(linkto(\pendingprev, "&lt;-"))
+ writes("D")
+ writes(linkto(\pendingnext, "-&gt;"))
+ 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, "&lt;" || convquotes(name) || "&gt;" || 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["&"] := "&amp;"
+ escapes["<"] := "&lt;"
+ escapes[">"] := "&gt;"
+ escapes["\""] := "&quot;"
+ 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, "&lt;" || convquotes(name) || "&gt;" || 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 "&lt;-U" else "U-&gt;"
+ writes(if i > 1 then " " else "", linkto(useitems[i], usedir))
+ }
+ writes(")</b>")
+}
+if \pendingprev | \pendingnext then {
+ writes(" <b>[")
+ writes(linkto(\pendingprev, "&lt;-"))
+ writes("D")
+ writes(linkto(\pendingnext, "-&gt;"))
+ 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["&"] := "&amp;"
+ escapes["<"] := "&lt;"
+ escapes[">"] := "&gt;"
+ escapes["\""] := "&quot;"
+ 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