@# This requires a hacked version of man2html
@# See here: http://www.kylheku.com/cgit/man
@(bind symhash @(hash :equal-based))
@(bind tagmap @(hash :equal-based))
@(bind tochash @(hash :equal-based))
@(bind closedtxt " <TT>[+]</TT>")
@(bind opentxt " <TT>[-]</TT>")
@(bind xpnall "[expand all]")
@(bind clpsall "[collapse all]")
@(bind closed t)
@(do
   (defvarl dupes (hash))
   (defvarl tagnum (hash :equal-based))
   (defvarl disamb (hash :equal-based))
   (defvarl dist-counter 0)

   (defun hash-str (str)
     (for ((lim (len str)) (i 0) (h 0) g) ((< i lim) h) ((inc i))
       (set h (+ (ash h 4) (int-chr [str i])))
       (set g (logand h #x7c000000))
       (set h (logtrunc (logxor h (logxor (ash g -26) g)) 32))))

   (defun hash-title (title)
     (let* ((h (logtrunc (hash-str title) 32))
            (existing [dupes h]))
       (when existing
         (unless (equal title existing)
           (error "~a ~a hash collision!" existing title)))
       (set [dupes h] title)
       (format nil "N-~,08X" h)))

   (defun toc-tag (sec)
     `TOC-@sec`)

   (set [tagmap "lbAB"] (hash-title "NAME"))

   (defun enumerate (title)
     (let ((num (inc [tagnum title 0])))
       `@title@(if (> num 1) `-@num` "")`))

   (defun process-ambiguities (hash)
     (hash-update hash (do if (eql (length @1) 1)
                         (first @1)
                         (let ((new-tag (format nil "D-~,04X"
                                                (inc dist-counter))))
                           (set [disamb new-tag] (reverse @1))
                           new-tag)))))
Content-type: text/html
@(skip 15)
<h1>TXR</h1>
@(skip)Updated: @YEAR-@MONTH-@DAY<br><a href="#index">Index</a>
@(bind TIME @(make-time-utc (int-str YEAR) (int-str MONTH) (int-str DAY)
                            0 0 0 nil))
@(bind VERSION nil)
@(collect :vars (BODY))
@  (some)
@    (cases)
<a name="@tag">&nbsp;</a>
@      (some)
<h@level>@sec @title</h@level>
@      (or)
<h@level>@sec @title
</h@level>
@      (end)
@      (bind newtag @(hash-title (enumerate title)))
@      (do (set [tagmap tag] newtag))
@      (output :into BODY)
<a name="@newtag">&nbsp;</a>
<h@level><a href="#@(toc-tag sec)" onclick="tocjump('@(toc-tag sec)')">@sec</a> @title</h@level>
@      (end)
@      (cat BODY "\n")
@    (or)
@BODY
@    (end)
@  (and)
<b>TXR</b> - text processing language (version @ver)
@    (set VERSION ver)
@  (end)
@(until)
<hr>
<a name="index">&nbsp;</a><h2>Index</h2>
@(end)
<hr>
@(collect :vars (TOC))
@  (some)
@    (cases)
@      (cases)
<dt><a href="#@tag">@num @rest</a><dd>
@      (or)
<dt><a href="#@tag">@num @rest
</a><dd>
@      (end)
@      (bind TOC `<dt><a name="@(toc-tag num)" class="tocanchor">@num</a> <a href="#@[tagmap tag]">@rest</a></dt>`)
@    (or)
<a name="index">@(skip)
@      (output :into TOC)
<h2>Contents</h2>
<noscript>
<h3>Please turn on Javascript to use the collapsible contents.</h3>
</noscript>
<a href="#/" onclick="toggleall(this)">@xpnall</a>
@      (end)
@    (or)
@TOC
@    (end)
@  (and)
<dt><a href="@nil">@nil TXR LISP</a><dd>
@  (and)
<dt><a href="#@tag">@(coll :vars (sym))<tt>@sym</tt>@(end)
@    (do (let ((n-tag [tagmap tag]))
           (mapdo (do pushnew n-tag [symhash @1]) sym)
           (set [tochash n-tag] rest)))
@  (and)
<dt><a href="#@tag">@num @nil
@    (maybe)
</a><dd>
@    (end)
<dl>
@    (cat TOC)
@    (bind pos @(car (search-regex TOC #/<\/dt/)))
@    (bind id @(gensym))
@    (do (set [TOC pos..pos]
              `<a href="#/" onclick="toggle(this, '@id')" class="toggle">@(if closed closedtxt opentxt)</a>`))
@    (output :into TOC)
@TOC
<dd><dl id="@id" class="tocsec"@(if closed " style=\"display: none\"")>
@    (end)
@  (end)
@(until)
This document was created by
@(end)
@(flatten TOC)
@(do (process-ambiguities symhash))
@(set BODY @(let ((inside-tt nil)
                  (inside-syntax nil))
              (mapcar (do cond
                        ((equal @1 "<tt>") (set inside-tt t) @1)
                        ((equal @1 "</tt>") (set inside-tt nil)
                                            (set inside-syntax nil)
                                            @1)
                        ((equal @1 "<dt>Syntax:<dd>") (set inside-syntax t) @1)
                        ((or (and inside-tt (not inside-syntax))
                             (match-regex @1 #/<dt><tt>/))
                          (regsub #/@?[\(\[][^ )&]+/
                                  (do let* ((at (if (eql [@1 0] #\@)
                                                 (pop @1)))
                                            (tok [@1 1..:])
                                            (bkt [@1 0])
                                            (tag [symhash tok]))
                                    (if tag
                                      `@at@bkt<a href="#@tag">@tok</a>`
                                      `@at@1`)) @1))
                        ((search-regex @1 #/<h[1-9]>/) @1)
                        (t (regsub #/<tt>.%<\/tt>/
                             (do let* ((tok [@1 4 -5])
                                       (tend (break-str tok ") "))
                                       pfx sym sfx tag)
                               (cond
                                 ((match-str tok "@(")
                                  (set pfx "@("
                                       sym [tok 2 tend]
                                       sfx [tok tend .. :]
                                       tag [symhash sym]))
                                 (t (set tag [symhash tok]
                                         sym tok)))
                               (if tag
                                 `<tt>@pfx<a href="#@tag">@sym</a>@sfx</tt>`
                                 @1))
                             @1)))
                      BODY)))
@(bind (d-tag n-tag) @(transpose (hash-pairs disamb)))
@(output)
<!doctype html public "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head><title>Manpage for TXR @VERSION</title>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<style>
.disambiguations dl {
  margin-bottom: 2048px;
}
dl.items dd:-moz-only-whitespace::after {
  content: "\00A0";
}
dl.items dd:empty:after {
  content: "\00A0";
}
dl.items dd {
  overflow: auto;
  min-width: calc(100% - 3em);
  margin-left: 3em;
  margin-bottom: 1ex;
}
dl.items dt {
  float: left;
  padding-right: 1ex;
}
kbd {
  background-color: #eee;
  border-radius: 3px;
  border: 1px solid #b4b4b4;
  box-shadow: 0 1px 1px rgba(0, 0, 0, .2), 0 2px 0 0 rgba(255, 255, 255, .7) inset;
  color: #333;
  display: inline-block;
  font-weight: 700;
  line-height: 1;
  padding: 2px 4px;
  white-space: nowrap;
}
</style>
<script type="text/javascript">
var xpanded = false;
function toggle(link, id) {
  var e = document.getElementById(id);
  if (e.style.display == '') {
    e.style.display = 'none';
    link.innerHTML = '@closedtxt';
  } else {
    e.style.display = '';
    link.innerHTML = '@opentxt';
  }
}
function toggleall(link) {
  var toc = document.getElementsByClassName("TOC");
  var dls = toc[0].getElementsByClassName("tocsec");
  var atoggles = toc[0].getElementsByClassName("toggle");
  var ndisp = xpanded ? 'none' : '';
  var nhtml = xpanded ? '@closedtxt' : '@opentxt'

  for (var i = 0; i < dls.length; i++)
    dls[i].style.display = ndisp;

  for (var i = 0; i < atoggles.length; i++)
    atoggles[i].innerHTML = nhtml;

  link.innerHTML = xpanded ? '@xpnall' : '@clpsall';

  xpanded = !xpanded;
}
function tocjump(hash) {
  var toc = document.getElementsByClassName("TOC");
  var tanch = toc[0].getElementsByClassName("tocanchor");

  for (var i = 0; i < tanch.length; i++) {
     var ta = tanch[i];

     if (ta.name == hash) {
       for (var e = ta.parentNode; e !== null; e = e.parentElement) {
         if (e.tagName == "DL") {
           var dt = e.previousElementSibling;
           e.style.display = '';
           if (dt !== null) {
             var atoggles = dt.getElementsByClassName("toggle");
             if (atoggles.length > 0)
               atoggles[0].innerHTML = '@opentxt';
           }
         }
       }
     }
  }
}
</script>
</head><body>
<h2>Manpage for <a href="#@[tagmap "lbAB"]">TXR </a>@VERSION</h2>
<h2>@(time-string-utc TIME "%b %d, %Y")</h2>
<p>
<form action="https://www.paypal.com/cgi-bin/webscr" method="post">
<input type="hidden" name="cmd" value="_s-xclick">
<input type="hidden" name="encrypted" value="-----BEGIN PKCS7-----MIIHJwYJKoZIhvcNAQcEoIIHGDCCBxQCAQExggEwMIIBLAIBADCBlDCBjjELMAkGA1UEBhMCVVMxCzAJBgNVBAgTAkNBMRYwFAYDVQQHEw1Nb3VudGFpbiBWaWV3MRQwEgYDVQQKEwtQYXlQYWwgSW5jLjETMBEGA1UECxQKbGl2ZV9jZXJ0czERMA8GA1UEAxQIbGl2ZV9hcGkxHDAaBgkqhkiG9w0BCQEWDXJlQHBheXBhbC5jb20CAQAwDQYJKoZIhvcNAQEBBQAEgYBQLZSe0xgg+h5deucBW3W3vj5kgJXsNm+Cmidp8krGwBTXBJJ4b6qreIdiArKKEVD6Lohb0f+267KtCvu28j/Kf6MlVfdsdI0p36jvqjisRGF/wtiJuHsHhbY5Lw27LykuZepzo9P22wAEo4dVi1n2ULhr1O3Fa2bGUJK5zFzZ1jELMAkGBSsOAwIaBQAwgaQGCSqGSIb3DQEHATAUBggqhkiG9w0DBwQI9fi0GhLipgyAgYAhyKuqSfxMrIyaHx9ul4lTPxHrzZu7SiQHPCF7+e3Sr4nxqAREmNJSrWnoE8wDAueBJ0TIcJIY8jFJbtXf/l/uawzD9XEab4WwW3LHU5ei3sOtKZzw0V+z7X+R4/21c0yu/vrvSTzGvZJbZW5T2Vck/EJa3nTqn8lOOPmSIyxRBaCCA4cwggODMIIC7KADAgECAgEAMA0GCSqGSIb3DQEBBQUAMIGOMQswCQYDVQQGEwJVUzELMAkGA1UECBMCQ0ExFjAUBgNVBAcTDU1vdW50YWluIFZpZXcxFDASBgNVBAoTC1BheVBhbCBJbmMuMRMwEQYDVQQLFApsaXZlX2NlcnRzMREwDwYDVQQDFAhsaXZlX2FwaTEcMBoGCSqGSIb3DQEJARYNcmVAcGF5cGFsLmNvbTAeFw0wNDAyMTMxMDEzMTVaFw0zNTAyMTMxMDEzMTVaMIGOMQswCQYDVQQGEwJVUzELMAkGA1UECBMCQ0ExFjAUBgNVBAcTDU1vdW50YWluIFZpZXcxFDASBgNVBAoTC1BheVBhbCBJbmMuMRMwEQYDVQQLFApsaXZlX2NlcnRzMREwDwYDVQQDFAhsaXZlX2FwaTEcMBoGCSqGSIb3DQEJARYNcmVAcGF5cGFsLmNvbTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAwUdO3fxEzEtcnI7ZKZL412XvZPugoni7i7D7prCe0AtaHTc97CYgm7NsAtJyxNLixmhLV8pyIEaiHXWAh8fPKW+R017+EmXrr9EaquPmsVvTywAAE1PMNOKqo2kl4Gxiz9zZqIajOm1fZGWcGS0f5JQ2kBqNbvbg2/Za+GJ/qwUCAwEAAaOB7jCB6zAdBgNVHQ4EFgQUlp98u8ZvF71ZP1LXChvsENZklGswgbsGA1UdIwSBszCBsIAUlp98u8ZvF71ZP1LXChvsENZklGuhgZSkgZEwgY4xCzAJBgNVBAYTAlVTMQswCQYDVQQIEwJDQTEWMBQGA1UEBxMNTW91bnRhaW4gVmlldzEUMBIGA1UEChMLUGF5UGFsIEluYy4xEzARBgNVBAsUCmxpdmVfY2VydHMxETAPBgNVBAMUCGxpdmVfYXBpMRwwGgYJKoZIhvcNAQkBFg1yZUBwYXlwYWwuY29tggEAMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADgYEAgV86VpqAWuXvX6Oro4qJ1tYVIT5DgWpE692Ag422H7yRIr/9j/iKG4Thia/Oflx4TdL+IFJBAyPK9v6zZNZtBgPBynXb048hsP16l2vi0k5Q2JKiPDsEfBhGI+HnxLXEaUWAcVfCsQFvd2A1sxRr67ip5y2wwBelUecP3AjJ+YcxggGaMIIBlgIBATCBlDCBjjELMAkGA1UEBhMCVVMxCzAJBgNVBAgTAkNBMRYwFAYDVQQHEw1Nb3VudGFpbiBWaWV3MRQwEgYDVQQKEwtQYXlQYWwgSW5jLjETMBEGA1UECxQKbGl2ZV9jZXJ0czERMA8GA1UEAxQIbGl2ZV9hcGkxHDAaBgkqhkiG9w0BCQEWDXJlQHBheXBhbC5jb20CAQAwCQYFKw4DAhoFAKBdMBgGCSqGSIb3DQEJAzELBgkqhkiG9w0BBwEwHAYJKoZIhvcNAQkFMQ8XDTEyMDMxMDEwMzczNFowIwYJKoZIhvcNAQkEMRYEFFrxlUHVygBbXOOpW9sAA30sKa+lMA0GCSqGSIb3DQEBAQUABIGAnn2T3mTtic58GXWIZSnV/PruTSwnEpyfVDVDBLyBNIPVabV0a2ra0HQZfHKxvMZNAPN2bpcBLPMubDZEWCcw6XdkOKPyZ9aJ7PEv5i7t6tg3MRR62YwroREHQVedCcRInnBFExQMOrZe/hTY75Xydk9yuIST4VbMO0CuttVz4aE=-----END PKCS7-----
">
<input type="image" src="https://www.paypalobjects.com/en_US/i/btn/btn_donate_LG.gif" border="0" name="submit" alt="PayPal - The safer, easier way to pay online!">
<img alt="" border="0" src="https://www.paypalobjects.com/en_US/i/scr/pixel.gif" width="1" height="1">
</form>
</p>
<div class="toc">
@(repeat)
@TOC
@(end)
</div>
@(repeat)
@BODY
@(first)
@(end)
<div class="disambiguations">
@(repeat)
<a name="@{d-tag}">
  <p>Topics matching <tt>@(hash-revget symhash d-tag)</tt>:
  <dl>
@ (repeat :counter (n 1))
    <dt><a href="#@{n-tag}">@n:</a> @[tochash n-tag]</dt>
@ (end)
  </dl>
</a>
@(end)
</div>
</body>
</html>
@(end)
@(bind (name code) @(let ((ignames '("*-1" "*-2" "*-20"
                                     "*0" "*1" "*2" "*99"
                                     "*n" "*r" "*v"
                                     "--args" "--eargs" "-C"
                                     ".."
                                     "TXR_COMPAT"
                                     "buf-get-" "buf-put-")))
                      (flow (hash-pairs symhash)
                        (remove-if (op in ignames) @1 car)
                        (mapcar (tb ((sym code))
                                  (list (html-decode sym) code)))
                        (nsort @1 : car)
                        transpose)))
@(do (let ((syms (append-each* ((entry [remove-if (op equal "pub")
                                                  (package-alist)
                                                  car])
                                (pkg-name [mapcar car entry])
                                (pkg [mapcar cdr entry]))
                   (let ((fn (casequal pkg-name
                               (("usr" "keyword") (fun tostringp))
                               (t (opip tostringp (join-with ":" pkg-name))))))
                     (mapcar fn (package-symbols pkg))))))
       (mapdo (do unless (in syms @1)
                (format *stderr* "~a: missing from image\n" @1))
              name)))
@(output "stdlib/doc-syms.tl")
(defparml doc-syms
  (hash-from-pairs
@  (repeat)
      (@(tostring name) @(tostring code))
@  (first)
    '((@(tostring name) @(tostring code))
@  (last)
      (@(tostring name) @(tostring code)))))
@  (end)
@(end)