home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / htprep.icn < prev    next >
Text File  |  2000-11-03  |  7KB  |  328 lines
  1. ############################################################################
  2. #
  3. #    File:     htprep.icn
  4. #
  5. #    Subject:  Program to prepare HTML files
  6. #
  7. #    Author:   Gregg M. Townsend
  8. #
  9. #    Date:     November 3, 2000
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  usage:  htprep [file]
  18. #
  19. #  Htprep is a filter for preparing HTML files (used, e.g., by Mosaic)
  20. #  from a simpler and less error-prone input language.
  21. #
  22. #  The following transformations are applied:
  23. #
  24. #    input        output
  25. #    ------------    ------------
  26. #    {}        
  27. #    {!comment}    <!--comment-->
  28. #    {tag}        <tag>
  29. #    {tag ... }    <tag> ... <\tag>
  30. #      att=val...      att="val"...   
  31. #    {@url ...    <a href="url" ...
  32. #    {:lbl ...    <a name="lbl" ...
  33. #
  34. #  Any input character can be preceded by a backslash (\) to prevent 
  35. #  special interpretation by htprep.
  36. #
  37. #  Output is normally to stdout, but the command
  38. #    {divert fname}
  39. #  redirects output to the named file.  This can be used to produce
  40. #  multiple related output files from a single input file.
  41. #
  42. ############################################################################
  43.  
  44. $define SIGNATURE "<!-- Created by HTPREP -->"
  45. $define WSPACE ' \t'        # whitespace cset
  46.  
  47.  
  48. record tag(label, line)        # tag record
  49. global tagstack            # currently open tags
  50.  
  51. global cmdtable            # table of known special commands
  52.  
  53. global infile            # input file
  54. global outfile            # output file
  55. global stdout            # standard output, if usable
  56.  
  57. global lineno            # current input line number
  58. global errors            # error count
  59.  
  60. global idset            # identifier characters
  61.  
  62.  
  63. #  main procedure
  64.  
  65. procedure main(args)
  66.    local line, t
  67.  
  68.    idset := &letters ++ &digits ++ '.-_:'
  69.    
  70.    lineno := 0
  71.    errors := 0
  72.    tagstack := []
  73.  
  74.    stdout := &output
  75.  
  76.    cmdtable := table()
  77.    cmdtable["divert"] := divert
  78.  
  79.    if *args = 0 then
  80.       infile := &input
  81.    else
  82.       infile := open(args[1]) | stop("can't open ", args[1])
  83.  
  84.    while line := in() do {
  85.       lineno +:= 1
  86.       line := braces(line)
  87.       out(line)
  88.       }
  89.  
  90.    while t := pop(tagstack) do
  91.       warn("unclosed tag {", t.label, "} from line ", t.line)
  92.  
  93.    if errors > 0 then
  94.       stop
  95.    else
  96.       return
  97. end
  98.  
  99.  
  100.  
  101. #  braces(line) -- process items identified by braces ('{}')
  102.  
  103. procedure braces(line)
  104.    local c, s, t
  105.  
  106.    line ? {
  107.       s := ""
  108.       while s ||:= tab(upto('{}')) do {
  109.          c := move(1)
  110.          if c == "{" then
  111.             s ||:= newtag()
  112.          else {      # "}"
  113.             if t := pop(tagstack) then {
  114.                if t.label == "!" then
  115.                   s ||:= "-->"
  116.                else
  117.                   s ||:= "</" || t.label || ">"
  118.                }
  119.             else
  120.                lwarn("tag stack underflow")
  121.             }
  122.          }
  123.       return s ||:= tab(0)
  124.       }
  125. end
  126.  
  127.  
  128.  
  129. #  newtag() -- process text following left brace ('{')
  130.  
  131. procedure newtag()
  132.    local label, s, c
  133.  
  134.    if ="}" then
  135.       return ""
  136.    if ="!" then {
  137.       push(tagstack, tag("!", lineno))
  138.       return "<!--"
  139.       }
  140.  
  141.    if c := tab(any('@:')) then {
  142.       label := "a"
  143.       if c == "@" then
  144.          s := "<a href="
  145.       else
  146.          s := "<a name="
  147.       s ||:= attval()
  148.       }
  149.    else {
  150.       label := tab(many(idset)) | (lwarn("unlabeled tag") & "noname")
  151.       s := "<" || label
  152.       }
  153.  
  154.    if \cmdtable[map(label)] then
  155.       return s := docommand(label)
  156.  
  157.    while s ||:= attrib()
  158.    tab(many(WSPACE))
  159.    ="}" | push(tagstack, tag(label, lineno))
  160.    return s || ">"
  161. end
  162.  
  163.  
  164.  
  165. #  attrib() -- match and return attribute
  166.  
  167. procedure attrib()
  168.    return tab(many(WSPACE)) || tab(many(idset)) || ="=" || attval()
  169. end
  170.  
  171.  
  172.  
  173. #  attval() -- match and return attribute value
  174.  
  175. procedure attval()
  176.    static valset
  177.    initial valset := &cset[34+:94] -- '\'\\"{}'
  178.    return (="\"" || tab(upto('"')) || move(1)) |
  179.       (="'" || tab(upto('\'')) || move(1)) |
  180.       aquote(tab(many(valset)))
  181. end
  182.  
  183.  
  184.  
  185. #  aquote(s) -- quote attribute value, but only if needed
  186.  
  187. procedure aquote(s)
  188.    if many(idset, s) = *s + 1 then
  189.       return s
  190.    else
  191.       return '"' || s || '"'
  192. end
  193.  
  194.  
  195.  
  196. #  docommand(label) -- process a tag recognized as a command
  197.  
  198. procedure docommand(label)
  199.    local p, atts, words, id, s
  200.  
  201.    p := cmdtable[label]
  202.    atts := table()
  203.    words := []
  204.    while s := attrib() do s ? {
  205.       tab(many(WSPACE))
  206.       id := tab(many(idset))
  207.       move(2)
  208.       atts[id] := tab(-1)
  209.       }
  210.    while tab(many(WSPACE)) & (s := tab(bal(' }', '{', '}'))) do
  211.       put(words, s)
  212.    tab(many(WSPACE))
  213.    ="}" | lwarn(label, ": unterminated command")
  214.    return p(atts, words) | ""
  215. end
  216.  
  217.  
  218.  
  219. #  in() -- read next line, interpreting escapes
  220. #
  221. #  Reads the next line from infile, removing leading and trailing whitespace.
  222. #
  223. #  If an ASCII character is preceded by a backslash, the character's eighth
  224. #  bit is set to prevent its recognition as a special character, and the
  225. #  backslash is retained.  If it's not an ASCII character (that is, if the
  226. #  eighth bit is already set) the backslash is simply discarded.
  227.  
  228. procedure in()
  229.    local s
  230.  
  231.    trim(read(infile), WSPACE) ? {
  232.       tab(many(WSPACE))
  233.       s := ""
  234.       while s ||:= tab(upto('\\')) do {
  235.          move(1)
  236.          if any(&ascii) then
  237.             s ||:= "\\" || char(128 + ord(move(1)))
  238.          else
  239.             s ||:= move(1)
  240.          }
  241.       return s ||:= tab(0)
  242.       }
  243.    fail
  244. end
  245.  
  246.  
  247.  
  248. # divert(attlist, wordlist) -- process "divert" command
  249. #
  250. # If an error is seen, a message is issued and subsequent output is
  251. # simply discarded.
  252.  
  253. procedure divert(atts, words)
  254.    local fname, f
  255.  
  256.    close(\outfile)            # always close current file
  257.    outfile := stdout := &null        # no current file, and no fallback
  258.  
  259.    if *words ~= 1 then {
  260.       lwarn("usage: {divert filename}")
  261.       fail
  262.       }
  263.  
  264.    fname := get(words)
  265.    if f := open(fname) then {
  266.       if read(f) ~== SIGNATURE then {
  267.          lwarn("divert: won't overwrite non-htprep file ", fname)
  268.          close(f)
  269.          fail
  270.          }
  271.       close(f)
  272.       }
  273.  
  274.    if outfile := open(fname, "w") then {
  275.       out(SIGNATURE)
  276.       return ""
  277.       }
  278.    else {
  279.       lwarn("divert: can't open ", fname)
  280.       fail
  281.       }
  282. end
  283.  
  284.  
  285.  
  286. #  out(s) -- write line, interpreting escapes
  287. #
  288. #  When a backslash is seen, the backslash is discarded and the eighth
  289. #  bit of the following character is cleared.
  290.  
  291. procedure out(s)
  292.    local c
  293.  
  294.    if /outfile := (\stdout | fail) then
  295.       write(outfile, SIGNATURE)        # if first write to &output
  296.  
  297.    s ? {
  298.       while writes(outfile, tab(upto('\\'))) do {
  299.          move(1)
  300.          writes(outfile, char(iand(127, ord(move(1)))))
  301.          }
  302.       write(outfile, tab(0))
  303.       }
  304.    return
  305. end
  306.  
  307.  
  308.  
  309. #  lwarn(s, ...) -- issue warning with line number  
  310.  
  311. procedure lwarn(a[])
  312.    push(a, "line " || lineno || ": ")
  313.    warn ! a
  314.    return
  315. end
  316.  
  317.  
  318.  
  319. # warn(s,...) -- issue warning message
  320.  
  321. procedure warn(a[])
  322.    push(a, "  ")
  323.    push(a, &errout)
  324.    write ! a
  325.    errors +:= 1
  326.    return
  327. end
  328.