Compare commits

...

11 Commits

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

@ -1,319 +0,0 @@
/* See the beginning of "manual.css". */
/* Monospace: */
.RktIn, .RktRdr, .RktPn, .RktMeta,
.RktMod, .RktKw, .RktVar, .RktSym,
.RktRes, .RktOut, .RktCmt, .RktVal,
.RktBlk, .RktErr {
font-family: 'Source Code Pro', monospace;
white-space: inherit;
font-size: 1rem;
}
/* this selctor grabs the first linked Racket symbol
in a definition box (i.e., the symbol being defined) */
a.RktValDef, a.RktStxDef, a.RktSymDef,
span.RktValDef, span.RktStxDef, span.RktSymDef
{
font-size: 1.15rem;
color: black;
font-weight: 600;
}
.inheritedlbl {
font-family: 'Fira', sans;
}
.RBackgroundLabelInner {
font-family: inherit;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 95%;
margin-top: 0.5em;
text-align: left;
background-color: inherit;
}
.inherited td {
font-size: 82%;
padding-left: 0.5rem;
line-height: 1.3;
text-indent: 0;
padding-right: 0;
}
.inheritedlbl {
font-style: normal;
}
/* ---------------------------------------- */
/* Racket text styles */
.RktIn {
color: #cc6633;
background-color: #eee;
}
.RktInBG {
background-color: #eee;
}
.refcolumn .RktInBG {
background-color: white;
}
.RktRdr {
}
.RktPn {
color: #843c24;
}
.RktMeta {
color: black;
}
.RktMod {
color: inherit;
}
.RktOpt {
color: black;
}
.RktKw {
color: black;
}
.RktErr {
color: red;
font-style: italic;
font-weight: 400;
}
.RktVar {
position: relative;
left: -1px; font-style: italic;
color: #444;
}
.SVInsetFlow .RktVar {
font-weight: 400;
color: #444;
}
.RktSym {
color: inherit;
}
.RktValLink, .RktStxLink, .RktModLink {
text-decoration: none;
color: #07A;
font-weight: 500;
font-size: 1rem;
}
/* for syntax links within headings */
h2 a.RktStxLink, h3 a.RktStxLink, h4 a.RktStxLink, h5 a.RktStxLink,
h2 a.RktValLink, h3 a.RktValLink, h4 a.RktValLink, h5 a.RktValLink,
h2 .RktSym, h3 .RktSym, h4 .RktSym, h5 .RktSym,
h2 .RktMod, h3 .RktMod, h4 .RktMod, h5 .RktMod,
h2 .RktVal, h3 .RktVal, h4 .RktVal, h5 .RktVal,
h2 .RktPn, h3 .RktPn, h4 .RktPn, h5 .RktPn {
color: #333;
font-size: 1.65rem;
font-weight: 400;
}
.toptoclink .RktStxLink, .toclink .RktStxLink,
.toptoclink .RktValLink, .toclink .RktValLink,
.toptoclink .RktModLink, .toclink .RktModLink {
color: inherit;
}
.tocset .RktValLink, .tocset .RktStxLink, .tocset .RktModLink {
color: black;
font-weight: 400;
font-size: 0.9rem;
}
.tocset td a.tocviewselflink .RktValLink,
.tocset td a.tocviewselflink .RktStxLink,
.tocset td a.tocviewselflink .RktMod,
.tocset td a.tocviewselflink .RktSym {
font-weight: lighter;
color: white;
}
.RktRes {
color: #0000af;
}
.RktOut {
color: #960096;
}
.RktCmt {
color: #c2741f;
}
.RktVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together { /* for definitions grouped together in one box */
width: 100%;
border-top: 2px solid white;
}
tbody > tr:first-child > td > .together {
border-top: 0px; /* erase border on first instance of together */
}
.RktBlk {
white-space: pre;
text-align: left;
}
.highlighted {
font-size: 1rem;
background-color: #fee;
}
.defmodule {
font-family: 'Source Code Pro';
padding: 0.25rem 0.75rem 0.25rem 0.5rem;
margin-bottom: 1rem;
width: 100%;
background-color: hsl(60, 29%, 94%);
}
.defmodule a {
color: #444;
}
.defmodule td span.hspace:first-child {
position: absolute;
width: 0;
display: inline-block;
}
.defmodule .RpackageSpec .Smaller,
.defmodule .RpackageSpec .stt {
font-size: 1rem;
}
.specgrammar {
float: none;
padding-left: 1em;
}
.RBibliography td {
vertical-align: text-top;
padding-top: 1em;
}
.leftindent {
margin-left: 2rem;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.SCodeFlow .Rfilebox {
margin-left: -1em; /* see 17.2 of guide, module languages */
}
.Rfiletitle {
text-align: right;
background-color: #eee;
}
.SCodeFlow .Rfiletitle {
border-top: 1px dotted gray;
border-right: 1px dotted gray;
}
.Rfilename {
border-top: 0;
border-right: 0;
padding-left: 0.5em;
padding-right: 0.5em;
background-color: inherit;
}
.Rfilecontent {
margin: 0.5em;
}
.RpackageSpec {
padding-right: 0;
}
/* ---------------------------------------- */
/* For background labels */
.RBackgroundLabel {
float: right;
width: 0px;
height: 0px;
}
.RBackgroundLabelInner {
position: relative;
width: 25em;
left: -25.5em;
top: 0.20rem; /* sensitive to monospaced font choice */
text-align: right;
z-index: 0;
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
color: gray;
}
.RpackageSpec .Smaller {
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
}
.RForeground {
position: relative;
left: 0px;
top: 0px;
z-index: 1;
}
/* ---------------------------------------- */
/* For section source modules & tags */
.RPartExplain {
background: #eee;
font-size: 0.9rem;
margin-top: 0.2rem;
padding: 0.2rem;
text-align: left;
}

@ -1,82 +0,0 @@
/* For the Racket manual style */
AddOnLoad(function() {
/* Look for header elements that have x-source-module and x-part tag.
For those elements, add a hidden element that explains how to
link to the section, and set the element's onclick() to display
the explanation. */
var tag_names = ["h1", "h2", "h3", "h4", "h5"];
for (var j = 0; j < tag_names.length; j++) {
elems = document.getElementsByTagName(tag_names[j]);
for (var i = 0; i < elems.length; i++) {
var elem = elems.item(i);
AddPartTitleOnClick(elem);
}
}
})
function AddPartTitleOnClick(elem) {
var mod_path = elem.getAttribute("x-source-module");
var tag = elem.getAttribute("x-part-tag");
if (mod_path && tag) {
var info = document.createElement("div");
info.className = "RPartExplain";
/* The "top" tag refers to a whole document: */
var is_top = (tag == "\"top\"");
info.appendChild(document.createTextNode("Link to this "
+ (is_top ? "document" : "section")
+ " with "));
/* Break `secref` into two lines if the module path and tag
are long enough: */
var is_long = (is_top ? false : (mod_path.length + tag.length > 60));
var line1 = document.createElement("div");
var line2 = (is_long ? document.createElement("div") : line1);
function add(dest, str, cn) {
var s = document.createElement("span");
s.className = cn;
s.style.whiteSpace = "nowrap";
s.appendChild(document.createTextNode(str));
dest.appendChild(s);
}
/* Construct a `secref` call with suitable syntax coloring: */
add(line1, "\xA0@", "RktRdr");
add(line1, (is_top ? "other-doc" : "secref"), "RktSym");
add(line1, "[", "RktPn");
if (!is_top)
add(line1, tag, "RktVal");
if (is_long) {
/* indent second line: */
add(line2, "\xA0\xA0\xA0\xA0\xA0\xA0\xA0\xA0", "RktPn");
}
if (!is_top)
add(line2, " #:doc ", "RktPn");
add(line2, "'", "RktVal");
add(line2, mod_path, "RktVal");
add(line2, "]", "RktPn");
info.appendChild(line1);
if (is_long)
info.appendChild(line2);
info.style.display = "none";
/* Add the new element afterthe header: */
var n = elem.nextSibling;
if (n)
elem.parentNode.insertBefore(info, n);
else
elem.parentNode.appendChild(info);
/* Clicking the header shows the explanation element: */
elem.onclick = function () {
if (info.style.display == "none")
info.style.display = "block";
else
info.style.display = "none";
}
}
}

@ -1,721 +0,0 @@
/* See the beginning of "scribble.css".
This file is used by the `scribble/manual` language, along with
"manual-racket.css". */
@import url("manual-fonts.css");
* {
margin: 0;
padding: 0;
}
@media all {html {font-size: 15px;}}
@media all and (max-width:940px){html {font-size: 14px;}}
@media all and (max-width:850px){html {font-size: 13px;}}
@media all and (max-width:830px){html {font-size: 12px;}}
@media all and (max-width:740px){html {font-size: 11px;}}
/* CSS seems backward: List all the classes for which we want a
particular font, so that the font can be changed in one place. (It
would be nicer to reference a font definition from all the places
that we want it.)
As you read the rest of the file, remember to double-check here to
see if any font is set. */
/* Monospace: */
.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft {
font-family: 'Source Code Pro', monospace;
white-space: inherit;
font-size: 1rem;
}
.stt {
font-weight: 500;
}
h2 .stt {
font-size: 2.7rem;
}
.toptoclink .stt {
font-size: inherit;
}
.toclink .stt {
font-size: 90%;
}
.RpackageSpec .stt {
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
}
h3 .stt, h4 .stt, h5 .stt {
color: #333;
font-size: 1.65rem;
font-weight: 400;
}
/* Serif: */
.main, .refcontent, .tocview, .tocsub, .sroman, i {
font-family: 'Charter', serif;
font-size: 1.18rem;
}
/* Sans-serif: */
.version, .versionNoNav, .ssansserif {
font-family: 'Fira', sans-serif;
}
.ssansserif {
font-family: 'Fira';
font-weight: 500;
font-size: 0.9em;
}
.tocset .ssansserif {
font-size: 100%;
}
/* ---------------------------------------- */
p, .SIntrapara {
display: block;
margin: 0 0 1em 0;
line-height: 1.4;
}
li {
list-style-position: outside;
margin-left: 1.2em;
}
h1, h2, h3, h4, h5, h6, h7, h8 {
font-family: 'Fira';
font-weight: 300;
font-size: 1.6rem;
color: #333;
margin-top: inherit;
margin-bottom: 1rem;
line-height: 1.25;
-moz-font-feature-settings: 'tnum=1';
-moz-font-feature-settings: 'tnum' 1;
-webkit-font-feature-settings: 'tnum' 1;
-o-font-feature-settings: 'tnum' 1;
-ms-font-feature-settings: 'tnum' 1;
font-feature-settings: 'tnum' 1;
}
h3, h4, h5, h6, h7, h8 {
border-top: 1px solid black;
}
h2 { /* per-page main title */
font-family: 'Miso';
font-weight: bold;
margin-top: 4rem;
font-size: 3rem;
line-height: 1.1;
width: 90%;
}
h3, h4, h5, h6, h7, h8 {
margin-top: 2em;
padding-top: 0.1em;
margin-bottom: 0.75em;
}
/* ---------------------------------------- */
/* Main */
body {
color: black;
background-color: white;
}
.maincolumn {
width: auto;
margin-top: 4rem;
margin-left: 17rem;
margin-right: 2rem;
margin-bottom: 10rem; /* to avoid fixed bottom nav bar */
max-width: 700px;
min-width: 370px; /* below this size, code samples don't fit */
}
a {
text-decoration: inherit;
}
a, .toclink, .toptoclink, .tocviewlink, .tocviewselflink, .tocviewtoggle, .plainlink,
.techinside, .techoutside:hover, .techinside:hover {
color: #07A;
}
a:hover {
text-decoration: underline;
}
/* ---------------------------------------- */
/* Navigation */
.navsettop, .navsetbottom {
left: 0;
width: 15rem;
height: 6rem;
font-family: 'Fira';
font-size: 0.9rem;
border-bottom: 0px solid hsl(216, 15%, 70%);
background-color: inherit;
padding: 0;
}
.navsettop {
position: absolute;
top: 0;
left: 0;
margin-bottom: 0;
border-bottom: 0;
}
.navsettop a, .navsetbottom a {
color: black;
}
.navsettop a:hover, .navsetbottom a:hover {
background: hsl(216, 78%, 95%);
text-decoration: none;
}
.navleft, .navright {
position: static;
float: none;
margin: 0;
white-space: normal;
}
.navleft a {
display: inline-block;
}
.navright a {
display: inline-block;
text-align: center;
}
.navleft a, .navright a, .navright span {
display: inline-block;
padding: 0.5rem;
min-width: 1rem;
}
.navright {
height: 2rem;
white-space: nowrap;
}
.navsetbottom {
display: none;
}
.nonavigation {
color: #889;
}
.searchform {
display: block;
margin: 0;
padding: 0;
border-bottom: 1px solid #eee;
height: 4rem;
}
.searchbox {
font-size: 1rem;
width: 12rem;
margin: 1rem;
padding: 0.25rem;
vertical-align: middle;
background-color: white;
}
#search_box {
font-size: 0.8rem;
}
/* ---------------------------------------- */
/* Version */
.versionbox {
position: absolute;
float: none;
top: 0.25rem;
left: 17rem;
z-index: 11000;
height: 2em;
font-size: 70%;
font-weight: lighter;
width: inherit;
margin: 0;
}
.version, .versionNoNav {
font-size: inherit;
}
.version:before, .versionNoNav:before {
content: "v.";
}
/* ---------------------------------------- */
/* Margin notes */
/* cancel scribble.css styles: */
.refpara, .refelem {
position: static;
float: none;
height: auto;
width: auto;
margin: 0;
}
.refcolumn {
position: static;
display: block;
width: auto;
font-size: inherit;
margin: 2rem;
margin-left: 2rem;
padding: 0.5em;
padding-left: 0.75em;
padding-right: 1em;
background: hsl(60, 29%, 94%);
border: 1px solid #ccb;
border-left: 0.4rem solid #ccb;
}
.refcontent p {
line-height: 1.5;
margin: 0;
}
.refcontent p + p {
margin-top: 1em;
}
.refcontent a {
font-weight: 400;
}
.refpara, .refparaleft {
top: -1em;
}
@media all and (max-width:600px) {
.refcolumn {
margin-left: 0;
margin-right: 0;
}
}
@media all and (min-width:1260px) {
.refcolumn {
position: absolute;
left: 66rem; right: 3em;
margin: 0;
float: right;
max-width: 18rem;
}
}
.refcontent {
font-family: 'Fira';
font-size: 1rem;
line-height: 1.6;
margin: 0 0 0 0;
}
.refparaleft, .refelemleft {
position: relative;
float: left;
right: 2em;
height: 0em;
width: 13em;
margin: 0em 0em 0em -13em;
}
.refcolumnleft {
background-color: hsl(60, 29%, 94%);
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid hsl(60, 29%, 94%);
margin: 0 0 0 0;
}
/* ---------------------------------------- */
/* Table of contents, left margin */
.tocset {
position: absolute;
float: none;
left: 0;
top: 0rem;
width: 14rem;
padding: 7rem 0.5rem 0.5rem 0.5rem;
background-color: hsl(216, 15%, 70%);
margin: 0;
}
.tocset td {
vertical-align: text-top;
padding-bottom: 0.4rem;
padding-left: 0.2rem;
line-height: 1.1;
font-family: 'Fira';
-moz-font-feature-settings: 'tnum=1';
-moz-font-feature-settings: 'tnum' 1;
-webkit-font-feature-settings: 'tnum' 1;
-o-font-feature-settings: 'tnum' 1;
-ms-font-feature-settings: 'tnum' 1;
font-feature-settings: 'tnum' 1;
}
.tocset td a {
color: black;
font-weight: 400;
}
.tocview {
text-align: left;
background-color: inherit;
}
.tocview td, .tocsub td {
line-height: 1.3;
}
.tocview table, .tocsub table {
width: 90%;
}
.tocset td a.tocviewselflink {
font-weight: lighter;
font-size: 110%; /* monospaced styles below don't need to enlarge */
color: white;
}
.tocviewselflink {
text-decoration: none;
}
.tocsub {
text-align: left;
margin-top: 0.5em;
background-color: inherit;
}
.tocviewlist, .tocsublist {
margin-left: 0.2em;
margin-right: 0.2em;
padding-top: 0.2em;
padding-bottom: 0.2em;
}
.tocviewlist table {
font-size: 82%;
}
.tocviewlisttopspace {
margin-bottom: 1em;
}
.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
margin-left: 0.4em;
border-left: 1px solid #99a;
padding-left: 0.8em;
}
.tocviewsublist {
margin-bottom: 1em;
}
.tocviewsublist table,
.tocviewsublistonly table,
.tocviewsublisttop table,
.tocviewsublistbottom table,
table.tocsublist {
font-size: 1rem;
}
.tocviewsublist td, .tocviewsublistbottom td, .tocviewsublisttop td, .tocsub td,
.tocviewsublistonly td {
font-size: 90%;
}
.tocviewtoggle {
font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
}
.tocsublist td {
padding-left: 0.5rem;
padding-top: 0.25rem;
text-indent: 0;
}
.tocsublinknumber {
font-size: 100%;
}
.tocsublink {
font-size: 82%;
text-decoration: none;
}
.tocsubseclink {
font-size: 100%;
text-decoration: none;
}
.tocsubnonseclink {
font-size: 82%;
text-decoration: none;
margin-left: 1rem;
padding-left: 0;
display: inline-block;
}
/* the label "on this page" */
.tocsubtitle {
display: block;
font-size: 62%;
font-family: 'Fira';
font-weight: bolder;
font-style: normal;
letter-spacing: 2px;
text-transform: uppercase;
margin: 0.5em;
}
.toptoclink {
font-weight: bold;
font-size: 110%;
margin-bottom: 0.5rem;
margin-top: 1.5rem;
display: inline-block;
}
.toclink {
font-size: inherit;
}
/* ---------------------------------------- */
/* Some inline styles */
.indexlink {
text-decoration: none;
}
pre {
margin-left: 2em;
}
blockquote {
margin-left: 2em;
margin-right: 2em;
margin-bottom: 1em;
}
.SCodeFlow {
border-left: 1px dotted black;
padding-left: 1em;
padding-right: 1em;
margin-top: 1em;
margin-bottom: 1em;
margin-left: 0em;
margin-right: 2em;
white-space: nowrap;
line-height: 1.5;
}
.SCodeFlow img {
margin-top: 0.5em;
margin-bottom: 0.5em;
}
.boxed {
margin: 0;
margin-top: 2em;
padding: 0.25em;
padding-bottom: 0.5em;
background: #f3f3f3;
box-sizing:border-box;
border-top: 1px solid #99b;
background: hsl(216, 78%, 95%);
background: -moz-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -webkit-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -o-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -ms-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
}
blockquote > blockquote.SVInsetFlow {
/* resolves issue in e.g. /reference/notation.html */
margin-top: 0em;
}
.leftindent .SVInsetFlow { /* see e.g. section 4.5 of Racket Guide */
margin-top: 1em;
margin-bottom: 1em;
}
.SVInsetFlow a, .SCodeFlow a {
color: #07A;
font-weight: 500;
}
.SubFlow {
display: block;
margin: 0em;
}
.boxed {
width: 100%;
background-color: inherit;
}
.techoutside { text-decoration: none; }
.SAuthorListBox {
position: static;
float: none;
font-family: 'Fira';
font-weight: 300;
font-size: 110%;
margin-top: 1rem;
margin-bottom: 3rem;
width: 30rem;
height: auto;
}
.author > a { /* email links within author block */
font-weight: inherit;
color: inherit;
}
.SAuthorList {
font-size: 82%;
}
.SAuthorList:before {
content: "by ";
}
.author {
display: inline;
white-space: nowrap;
}
/* phone + tablet styles */
@media all and (max-width:720px){
@media all and (max-width:720px){
@media all {html {font-size: 15px;}}
@media all and (max-width:700px){html {font-size: 14px;}}
@media all and (max-width:630px){html {font-size: 13px;}}
@media all and (max-width:610px){html {font-size: 12px;}}
@media all and (max-width:550px){html {font-size: 11px;}}
@media all and (max-width:520px){html {font-size: 10px;}}
.navsettop, .navsetbottom {
display: block;
position: absolute;
width: 100%;
height: 4rem;
border: 0;
background-color: hsl(216, 15%, 70%);
}
.searchform {
display: inline;
border: 0;
}
.navright {
position: absolute;
right: 1.5rem;
margin-top: 1rem;
border: 0px solid red;
}
.navsetbottom {
display: block;
margin-top: 8rem;
}
.tocset {
display: none;
}
.tocset table, .tocset tbody, .tocset tr, .tocset td {
display: inline;
}
.tocview {
display: none;
}
.tocsub .tocsubtitle {
display: none;
}
.versionbox {
top: 4.5rem;
left: 1rem; /* same distance as main-column */
z-index: 11000;
height: 2em;
font-size: 70%;
font-weight: lighter;
}
.maincolumn {
margin-left: 1em;
margin-top: 7rem;
margin-bottom: 0rem;
}
}
}
/* print styles : hide the navigation elements */
@media print {
.tocset,
.navsettop,
.navsetbottom { display: none; }
.maincolumn {
width: auto;
margin-right: 13em;
margin-left: 0;
}
}

@ -1,249 +0,0 @@
/* See the beginning of "scribble.css". */
/* Monospace: */
.RktIn, .RktRdr, .RktPn, .RktMeta,
.RktMod, .RktKw, .RktVar, .RktSym,
.RktRes, .RktOut, .RktCmt, .RktVal,
.RktBlk {
font-family: monospace;
white-space: inherit;
}
/* Serif: */
.inheritedlbl {
font-family: serif;
}
/* Sans-serif: */
.RBackgroundLabelInner {
font-family: sans-serif;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 100%;
margin-top: 0.5em;
text-align: left;
background-color: #ECF5F5;
}
.inherited td {
font-size: 82%;
padding-left: 1em;
text-indent: -0.8em;
padding-right: 0.2em;
}
.inheritedlbl {
font-style: italic;
}
/* ---------------------------------------- */
/* Racket text styles */
.RktIn {
color: #cc6633;
background-color: #eeeeee;
}
.RktInBG {
background-color: #eeeeee;
}
.RktRdr {
}
.RktPn {
color: #843c24;
}
.RktMeta {
color: black;
}
.RktMod {
color: black;
}
.RktOpt {
color: black;
}
.RktKw {
color: black;
}
.RktErr {
color: red;
font-style: italic;
}
.RktVar {
color: #262680;
font-style: italic;
}
.RktSym {
color: #262680;
}
.RktSymDef { /* used with RktSym at def site */
}
.RktValLink {
text-decoration: none;
color: blue;
}
.RktValDef { /* used with RktValLink at def site */
}
.RktModLink {
text-decoration: none;
color: blue;
}
.RktStxLink {
text-decoration: none;
color: black;
}
.RktStxDef { /* used with RktStxLink at def site */
}
.RktRes {
color: #0000af;
}
.RktOut {
color: #960096;
}
.RktCmt {
color: #c2741f;
}
.RktVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together {
width: 100%;
}
.prototype, .argcontract, .RBoxed {
white-space: nowrap;
}
.prototype td {
vertical-align: text-top;
}
.RktBlk {
white-space: inherit;
text-align: left;
}
.RktBlk tr {
white-space: inherit;
}
.RktBlk td {
vertical-align: baseline;
white-space: inherit;
}
.argcontract td {
vertical-align: text-top;
}
.highlighted {
background-color: #ddddff;
}
.defmodule {
width: 100%;
background-color: #F5F5DC;
}
.specgrammar {
float: right;
}
.RBibliography td {
vertical-align: text-top;
}
.leftindent {
margin-left: 1em;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.Rfilebox {
}
.Rfiletitle {
text-align: right;
margin: 0em 0em 0em 0em;
}
.Rfilename {
border-top: 1px solid #6C8585;
border-right: 1px solid #6C8585;
padding-left: 0.5em;
padding-right: 0.5em;
background-color: #ECF5F5;
}
.Rfilecontent {
margin: 0em 0em 0em 0em;
}
.RpackageSpec {
padding-right: 0.5em;
}
/* ---------------------------------------- */
/* For background labels */
.RBackgroundLabel {
float: right;
width: 0px;
height: 0px;
}
.RBackgroundLabelInner {
position: relative;
width: 25em;
left: -25.5em;
top: 0px;
text-align: right;
color: white;
z-index: 0;
font-weight: bold;
}
.RForeground {
position: relative;
left: 0px;
top: 0px;
z-index: 1;
}
/* ---------------------------------------- */
/* History */
.SHistory {
font-size: 82%;
}

@ -1,169 +0,0 @@
// Common functionality for PLT documentation pages
// Page Parameters ------------------------------------------------------------
var page_query_string =
(location.href.search(/\?([^#]+)(?:#|$)/) >= 0) && RegExp.$1;
var page_args =
((function(){
if (!page_query_string) return [];
var args = page_query_string.split(/[&;]/);
for (var i=0; i<args.length; i++) {
var a = args[i];
var p = a.indexOf('=');
if (p >= 0) args[i] = [a.substring(0,p), a.substring(p+1)];
else args[i] = [a, false];
}
return args;
})());
function GetPageArg(key, def) {
for (var i=0; i<page_args.length; i++)
if (page_args[i][0] == key) return decodeURIComponent(page_args[i][1]);
return def;
}
function MergePageArgsIntoLink(a) {
if (page_args.length == 0 ||
(!a.attributes["data-pltdoc"]) || (a.attributes["data-pltdoc"].value == ""))
return;
a.href = MergePageArgsIntoUrl(a.href);
}
function MergePageArgsIntoUrl(href) {
href.search(/^([^?#]*)(?:\?([^#]*))?(#.*)?$/);
if (RegExp.$2.length == 0) {
return RegExp.$1 + "?" + page_query_string + RegExp.$3;
} else {
// need to merge here, precedence to arguments that exist in `a'
var i, j;
var prefix = RegExp.$1, str = RegExp.$2, suffix = RegExp.$3;
var args = str.split(/[&;]/);
for (i=0; i<args.length; i++) {
j = args[i].indexOf('=');
if (j) args[i] = args[i].substring(0,j);
}
var additions = "";
for (i=0; i<page_args.length; i++) {
var exists = false;
for (j=0; j<args.length; j++)
if (args[j] == page_args[i][0]) { exists = true; break; }
if (!exists) str += "&" + page_args[i][0] + "=" + page_args[i][1];
}
return prefix + "?" + str + suffix;
}
}
// Cookies --------------------------------------------------------------------
// Actually, try localStorage (a la HTML 5), first.
function GetCookie(key, def) {
try {
var v = localStorage[key];
if (!v) v = def;
return v;
} catch (e) {
var i, cookiestrs;
try {
if (document.cookie.length <= 0) return def;
cookiestrs = document.cookie.split(/; */);
} catch (e) { return def; }
for (i = 0; i < cookiestrs.length; i++) {
var cur = cookiestrs[i];
var eql = cur.indexOf('=');
if (eql >= 0 && cur.substring(0,eql) == key)
return unescape(cur.substring(eql+1));
}
return def;
}
}
function SetCookie(key, val) {
try {
localStorage[key] = val;
} catch(e) {
var d = new Date();
d.setTime(d.getTime()+(365*24*60*60*1000));
try {
document.cookie =
key + "=" + escape(val) + "; expires="+ d.toGMTString() + "; path=/";
} catch (e) {}
}
}
// note that this always stores a directory name, ending with a "/"
function SetPLTRoot(ver, relative) {
var root = location.protocol + "//" + location.host
+ NormalizePath(location.pathname.replace(/[^\/]*$/, relative));
SetCookie("PLT_Root."+ver, root);
}
// adding index.html works because of the above
function GotoPLTRoot(ver, relative) {
var u = GetCookie("PLT_Root."+ver, null);
if (u == null) return true; // no cookie: use plain up link
// the relative path is optional, default goes to the toplevel start page
if (!relative) relative = "index.html";
location = u + relative;
return false;
}
// Utilities ------------------------------------------------------------------
var normalize_rxs = [/\/\/+/g, /\/\.(\/|$)/, /\/[^\/]*\/\.\.(\/|$)/];
function NormalizePath(path) {
var tmp, i;
for (i = 0; i < normalize_rxs.length; i++)
while ((tmp = path.replace(normalize_rxs[i], "/")) != path) path = tmp;
return path;
}
// `noscript' is problematic in some browsers (always renders as a
// block), use this hack instead (does not always work!)
// document.write("<style>mynoscript { display:none; }</style>");
// Interactions ---------------------------------------------------------------
function DoSearchKey(event, field, ver, top_path) {
var val = field.value;
if (event && event.keyCode == 13) {
var u = GetCookie("PLT_Root."+ver, null);
if (u == null) u = top_path; // default: go to the top path
u += "search/index.html?q=" + encodeURIComponent(val);
u = MergePageArgsIntoUrl(u);
location = u;
return false;
}
return true;
}
function TocviewToggle(glyph, id) {
var s = document.getElementById(id).style;
var expand = s.display == "none";
s.display = expand ? "block" : "none";
glyph.innerHTML = expand ? "&#9660;" : "&#9658;";
}
// Page Init ------------------------------------------------------------------
// Note: could make a function that inspects and uses window.onload to chain to
// a previous one, but this file needs to be required first anyway, since it
// contains utilities for all other files.
var on_load_funcs = [];
function AddOnLoad(fun) { on_load_funcs.push(fun); }
window.onload = function() {
for (var i=0; i<on_load_funcs.length; i++) on_load_funcs[i]();
};
AddOnLoad(function(){
var links = document.getElementsByTagName("a");
for (var i=0; i<links.length; i++) MergePageArgsIntoLink(links[i]);
var label = GetPageArg("ctxtname",false);
if (!label) return;
var indicator = document.getElementById("contextindicator");
if (!indicator) return;
indicator.innerHTML = label;
indicator.style.display = "block";
});

@ -1,480 +0,0 @@
/* This file is used by default by all Scribble documents.
See also "manual.css", which is added by default by the
`scribble/manual` language. */
/* CSS seems backward: List all the classes for which we want a
particular font, so that the font can be changed in one place. (It
would be nicer to reference a font definition from all the places
that we want it.)
As you read the rest of the file, remember to double-check here to
see if any font is set. */
/* Monospace: */
.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft {
font-family: monospace;
}
/* Serif: */
.main, .refcontent, .tocview, .tocsub, .sroman, i {
font-family: serif;
}
/* Sans-serif: */
.version, .versionNoNav, .ssansserif {
font-family: sans-serif;
}
.ssansserif {
font-size: 80%;
font-weight: bold;
}
/* ---------------------------------------- */
p, .SIntrapara {
display: block;
margin: 1em 0;
}
h2 { /* per-page main title */
margin-top: 0;
}
h3, h4, h5, h6, h7, h8 {
margin-top: 1.75em;
margin-bottom: 0.5em;
}
.SSubSubSubSection {
font-weight: bold;
font-size: 0.83em; /* should match h5; from HTML 4 reference */
}
/* Needed for browsers like Opera, and eventually for HTML 4 conformance.
This means that multiple paragraphs in a table element do not have a space
between them. */
table p {
margin-top: 0;
margin-bottom: 0;
}
/* ---------------------------------------- */
/* Main */
body {
color: black;
background-color: #ffffff;
}
table td {
padding-left: 0;
padding-right: 0;
}
.maincolumn {
width: 43em;
margin-right: -40em;
margin-left: 15em;
}
.main {
text-align: left;
}
/* ---------------------------------------- */
/* Navigation */
.navsettop, .navsetbottom {
background-color: #f0f0e0;
padding: 0.25em 0 0.25em 0;
}
.navsettop {
margin-bottom: 1.5em;
border-bottom: 2px solid #e0e0c0;
}
.navsetbottom {
margin-top: 2em;
border-top: 2px solid #e0e0c0;
}
.navleft {
margin-left: 1ex;
position: relative;
float: left;
white-space: nowrap;
}
.navright {
margin-right: 1ex;
position: relative;
float: right;
white-space: nowrap;
}
.nonavigation {
color: #e0e0e0;
}
.searchform {
display: inline;
margin: 0;
padding: 0;
}
.searchbox {
width: 16em;
margin: 0px;
padding: 0px;
background-color: #eee;
border: 1px solid #ddd;
text-align: center;
vertical-align: middle;
}
#contextindicator {
position: fixed;
background-color: #c6f;
color: #000;
font-family: monospace;
font-weight: bold;
padding: 2px 10px;
display: none;
right: 0;
bottom: 0;
}
/* ---------------------------------------- */
/* Version */
.versionbox {
position: relative;
float: right;
left: 2em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.version {
font-size: small;
}
.versionNoNav {
font-size: xx-small; /* avoid overlap with author */
}
.version:before, .versionNoNav:before {
content: "Version ";
}
/* ---------------------------------------- */
/* Margin notes */
.refpara, .refelem {
position: relative;
float: right;
left: 2em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.refpara, .refparaleft {
top: -1em;
}
.refcolumn {
background-color: #F5F5DC;
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid #F5F5DC;
margin: 0 0 0 0;
}
.refcontent {
margin: 0 0 0 0;
}
.refcontent p {
margin-top: 0;
margin-bottom: 0;
}
.refparaleft, .refelemleft {
position: relative;
float: left;
right: 2em;
height: 0em;
width: 13em;
margin: 0em 0em 0em -13em;
}
.refcolumnleft {
background-color: #F5F5DC;
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid #F5F5DC;
margin: 0 0 0 0;
}
/* ---------------------------------------- */
/* Table of contents, inline */
.toclink {
text-decoration: none;
color: blue;
font-size: 85%;
}
.toptoclink {
text-decoration: none;
color: blue;
font-weight: bold;
}
/* ---------------------------------------- */
/* Table of contents, left margin */
.tocset {
position: relative;
float: left;
width: 12.5em;
margin-right: 2em;
}
.tocset td {
vertical-align: text-top;
}
.tocview {
text-align: left;
background-color: #f0f0e0;
}
.tocsub {
text-align: left;
margin-top: 0.5em;
background-color: #f0f0e0;
}
.tocviewlist, .tocsublist {
margin-left: 0.2em;
margin-right: 0.2em;
padding-top: 0.2em;
padding-bottom: 0.2em;
}
.tocviewlist table {
font-size: 82%;
}
.tocviewlisttopspace {
margin-bottom: 1em;
}
.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
margin-left: 0.4em;
border-left: 1px solid #bbf;
padding-left: 0.8em;
}
.tocviewsublist {
margin-bottom: 1em;
}
.tocviewsublist table,
.tocviewsublistonly table,
.tocviewsublisttop table,
.tocviewsublistbottom table {
font-size: 75%;
}
.tocviewtitle * {
font-weight: bold;
}
.tocviewlink {
text-decoration: none;
color: blue;
}
.tocviewselflink {
text-decoration: underline;
color: blue;
}
.tocviewtoggle {
text-decoration: none;
color: blue;
font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
}
.tocsublist td {
padding-left: 1em;
text-indent: -1em;
}
.tocsublinknumber {
font-size: 82%;
}
.tocsublink {
font-size: 82%;
text-decoration: none;
}
.tocsubseclink {
font-size: 82%;
text-decoration: none;
}
.tocsubnonseclink {
font-size: 82%;
text-decoration: none;
padding-left: 0.5em;
}
.tocsubtitle {
font-size: 82%;
font-style: italic;
margin: 0.2em;
}
/* ---------------------------------------- */
/* Some inline styles */
.indexlink {
text-decoration: none;
}
.nobreak {
white-space: nowrap;
}
pre { margin-left: 2em; }
blockquote { margin-left: 2em; }
ol { list-style-type: decimal; }
ol ol { list-style-type: lower-alpha; }
ol ol ol { list-style-type: lower-roman; }
ol ol ol ol { list-style-type: upper-alpha; }
.SCodeFlow {
display: block;
margin-left: 1em;
margin-bottom: 0em;
margin-right: 1em;
margin-top: 0em;
white-space: nowrap;
}
.SVInsetFlow {
display: block;
margin-left: 0em;
margin-bottom: 0em;
margin-right: 0em;
margin-top: 0em;
}
.SubFlow {
display: block;
margin: 0em;
}
.boxed {
width: 100%;
background-color: #E8E8FF;
}
.hspace {
}
.slant {
font-style: oblique;
}
.badlink {
text-decoration: underline;
color: red;
}
.plainlink {
text-decoration: none;
color: blue;
}
.techoutside { text-decoration: underline; color: #b0b0b0; }
.techoutside:hover { text-decoration: underline; color: blue; }
/* .techinside:hover doesn't work with FF, .techinside:hover>
.techinside doesn't work with IE, so use both (and IE doesn't
work with inherit in the second one, so use blue directly) */
.techinside { color: black; }
.techinside:hover { color: blue; }
.techoutside:hover>.techinside { color: inherit; }
.SCentered {
text-align: center;
}
.imageleft {
float: left;
margin-right: 0.3em;
}
.Smaller {
font-size: 82%;
}
.Larger {
font-size: 122%;
}
/* A hack, inserted to break some Scheme ids: */
.mywbr {
display: inline-block;
height: 0;
width: 0;
font-size: 1px;
}
.compact li p {
margin: 0em;
padding: 0em;
}
.noborder img {
border: 0;
}
.SAuthorListBox {
position: relative;
float: right;
left: 2em;
top: -2.5em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.SAuthorList {
font-size: 82%;
}
.SAuthorList:before {
content: "by ";
}
.author {
display: inline;
white-space: nowrap;
}
/* print styles : hide the navigation elements */
@media print {
.tocset,
.navsettop,
.navsetbottom { display: none; }
.maincolumn {
width: auto;
margin-right: 13em;
margin-left: 0;
}
}

@ -1,6 +1,6 @@
#lang info
(define collection "txexpr")
(define scribblings '(("scribblings/txexpr.scrbl" ())))
(define compile-omit-paths '("tests.rkt"))
(define deps '("base"))
(define build-deps '("scribble-lib" "racket-doc"))
(define collection 'multi)
(define deps '("base" "sugar" "typed-racket-lib"
"typed-racket-more"
"rackunit-lib"))
(define build-deps '("scribble-lib" "racket-doc" "typed-racket-doc"))

@ -1,294 +0,0 @@
#lang racket/base
(require (for-syntax racket/base))
(require racket/match xml racket/string racket/list racket/bool)
(module+ safe (require racket/contract))
(define-syntax (define+provide+safe stx)
(syntax-case stx ()
[(_ (proc arg ... . rest-arg) contract body ...)
#'(define+provide+safe proc contract
(λ(arg ... . rest-arg) body ...))]
[(_ name contract body ...)
#'(begin
(define name body ...)
(provide name)
(module+ safe
(provide (contract-out [name contract]))))]))
(define+provide+safe (txexpr-tag? x)
(any/c . -> . boolean?)
(symbol? x))
(define+provide+safe (txexpr-tags? x)
(any/c . -> . boolean?)
(and (list? x) (andmap txexpr-tag? x)))
(define+provide+safe (txexpr-attr? x)
(any/c . -> . boolean?)
(match x
[(list (? symbol?) (? string?)) #t]
[else #f]))
(define (validate-txexpr-attrs x #:context [txexpr-context #f])
; ((any/c) (#:context (or/c #f txexpr?)) . ->* . txexpr-attrs?)
(define (make-reason)
(if (not (list? x))
(format "because ~v is not a list" x)
(let ([bad-attrs (filter (λ(i) (not (txexpr-attr? i))) x)])
(format "because ~a ~a" (string-join (map (λ(ba) (format "~v" ba)) bad-attrs) " and ") (if (> (length bad-attrs) 1)
"are not valid attributes"
"is not in the form '(symbol \"string\")")))))
(match x
[(list (? txexpr-attr?) ...) x]
[else [else (error (string-append "validate-txexpr-attrs: "
(if txexpr-context (format "in ~v, " txexpr-context) "")
(format "~v is not a valid list of attributes ~a" x (make-reason))))]]))
(define+provide+safe (txexpr-attrs? x)
(any/c . -> . boolean?)
(with-handlers ([exn:fail? (λ(exn) #f)])
(and (validate-txexpr-attrs x) #t)))
(define+provide+safe (txexpr-elements? x)
(any/c . -> . boolean?)
(match x
[(list elem ...) (andmap txexpr-element? elem)]
[else #f]))
(define (validate-txexpr-element x #:context [txexpr-context #f])
; ((any/c) (#:context (or/c #f txexpr?)) . ->* . txexpr-element?)
(cond
[(or (string? x) (txexpr? x) (symbol? x)
(valid-char? x) (cdata? x)) x]
[else (error (string-append "validate-txexpr-element: "
(if txexpr-context (format "in ~v, " txexpr-context) "")
(format "~v is not a valid element (must be txexpr, string, symbol, XML char, or cdata)" x)))]))
(define+provide+safe (txexpr-element? x)
(any/c . -> . boolean?)
(with-handlers ([exn:fail? (λ(exn) #f)])
(and (validate-txexpr-element x) #t)))
;; is it a named x-expression?
;; todo: rewrite this recurively so errors can be pinpointed (for debugging)
(define+provide+safe (validate-txexpr x)
(any/c . -> . txexpr?)
(define (validate-txexpr-element-with-context e) (validate-txexpr-element e #:context x))
(define (validate-txexpr-attrs-with-context e) (validate-txexpr-attrs e #:context x))
(when (match x
[(list (? symbol?)) #t]
[(list (? symbol? name) (and attr-list (list (list k v ...) ...)) rest ...)
(and (validate-txexpr-attrs-with-context attr-list)
(andmap validate-txexpr-element-with-context rest))]
[(list (? symbol? name) rest ...)(andmap validate-txexpr-element-with-context rest)]
[else (error (format "validate-txexpr: ~v is not a list starting with a symbol" x))])
x))
(define+provide+safe (txexpr? x)
(any/c . -> . boolean?)
(with-handlers ([exn:fail? (λ(exn) #f)])
(and (validate-txexpr x) #t)))
(define+provide+safe (make-txexpr tag [attrs null] [elements null])
;; todo?: use xexpr/c provides a nicer error message
((symbol?) (txexpr-attrs? txexpr-elements?)
. ->* . txexpr?)
(filter (compose1 not null?) `(,tag ,attrs ,@elements)))
(define+provide+safe (txexpr->values x)
(txexpr? . -> . (values symbol? txexpr-attrs? txexpr-elements?))
(match
; txexpr may or may not have attr
; if not, add null attr so that decomposition only handles one case
(match x
[(list _ (? txexpr-attrs?) _ ...) x]
[else `(,(car x) ,null ,@(cdr x))])
[(list tag attr content ...) (values tag attr content)]))
(define+provide+safe (txexpr->list x)
(txexpr? . -> . list?)
(define-values (tag attrs content) (txexpr->values x))
(list tag attrs content))
;; convenience functions to retrieve only one part of txexpr
(define+provide+safe (get-tag x)
(txexpr? . -> . txexpr-tag?)
(car x))
(define+provide+safe (get-attrs x)
(txexpr? . -> . txexpr-attrs?)
(define-values (tag attrs content) (txexpr->values x))
attrs)
(define+provide+safe (get-elements x)
(txexpr? . -> . txexpr-elements?)
(define-values (tag attrs elements) (txexpr->values x))
elements)
;; helpers. we are getting a string or symbol
(define+provide+safe (->txexpr-attr-key x)
(can-be-txexpr-attr-key? . -> . txexpr-attr-key?)
(if (string? x) (string->symbol x) x))
(define+provide+safe (->txexpr-attr-value x)
(can-be-txexpr-attr-value? . -> . txexpr-attr-value?)
(->string x))
(define+provide+safe (txexpr-attr-key? x)
(any/c . -> . boolean?)
(symbol? x))
(define+provide+safe (can-be-txexpr-attr-key? x)
(any/c . -> . boolean?)
(or (symbol? x) (string? x)))
(define+provide+safe (txexpr-attr-value? x)
(any/c . -> . boolean?)
(string? x))
(define (txexpr-attr-values? xs) (and (list? xs) (andmap txexpr-attr-value? xs)))
(define+provide+safe (can-be-txexpr-attr-value? x)
(any/c . -> . boolean?)
(can-be-txexpr-attr-key? x))
(define (->string x)
(if (symbol? x) (symbol->string x) x))
(define+provide+safe (can-be-txexpr-attrs? x)
(any/c . -> . boolean?)
(ormap (λ(test) (test x)) (list txexpr-attr? txexpr-attrs? can-be-txexpr-attr-key? can-be-txexpr-attr-value?)))
(define (list-of-can-be-txexpr-attrs? xs) (and (list? xs) (andmap can-be-txexpr-attrs? xs)))
(define+provide+safe (attrs->hash . items)
(() #:rest list-of-can-be-txexpr-attrs? . ->* . hash?)
;; can be liberal with input because they're all just nested key/value pairs
;; but still need this function to make sure that 'foo and "foo" are treated as the same hash key
(define (make-key-value-list items)
(if (null? items)
null
(let ([key (->txexpr-attr-key (car items))]
[value (->txexpr-attr-value (cadr items))]
[rest (cddr items)])
(cons (cons key value) (make-key-value-list rest)))))
(make-immutable-hash (make-key-value-list (flatten items))))
(define+provide+safe (hash->attrs hash)
(hash? . -> . txexpr-attrs?)
(hash-map hash list))
(define+provide+safe (attrs-have-key? x key)
((or/c txexpr-attrs? txexpr?) can-be-txexpr-attr-key? . -> . boolean?)
(define attrs (if (txexpr-attrs? x) x (get-attrs x)))
(hash-has-key? (attrs->hash attrs) (->txexpr-attr-key key)))
(define+provide+safe (attrs-equal? x1 x2)
((or/c txexpr-attrs? txexpr?) (or/c txexpr-attrs? txexpr?) . -> . boolean?)
(define attrs-tx1 (attrs->hash (if (txexpr-attrs? x1) x1 (get-attrs x1))))
(define attrs-tx2 (attrs->hash (if (txexpr-attrs? x2) x2 (get-attrs x2))))
(and
(= (length (hash-keys attrs-tx1)) (length (hash-keys attrs-tx2)))
(for/and ([(key value) (in-hash attrs-tx1)])
(equal? (hash-ref attrs-tx2 key) value))))
(define+provide+safe (attr-set tx key value)
(txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?)
(define new-attrs
(hash->attrs (hash-set (attrs->hash (get-attrs tx)) (->txexpr-attr-key key) (->txexpr-attr-value value))))
(make-txexpr (get-tag tx) new-attrs (get-elements tx)))
(define+provide+safe (attr-ref tx key)
(txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-value?)
(with-handlers ([exn:fail? (λ(e) (error (format "attr-ref: no value found for key ~v" key)))])
(hash-ref (attrs->hash (get-attrs tx)) key)))
(define+provide+safe (attr-ref* tx key)
(txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-values?)
(filter-not false?
(flatten
(let loop ([tx tx])
(and (txexpr? tx)
(cons (and (attrs-have-key? tx key)(attr-ref tx key))
(map loop (get-elements tx))))))))
;; convert list of alternating keys & values to attr
(define+provide+safe (merge-attrs . items)
(() #:rest list-of-can-be-txexpr-attrs? . ->* . txexpr-attrs?)
(define attrs-hash (apply attrs->hash items))
;; sort needed for predictable results for unit tests
(define sorted-hash-keys (sort (hash-keys attrs-hash) (λ(a b) (string<? (->string a) (->string b)))))
`(,@(map (λ(key) (list key (hash-ref attrs-hash key))) sorted-hash-keys)))
(define+provide+safe (remove-attrs x)
(txexpr? . -> . txexpr?)
(cond
[(txexpr? x) (let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag null (remove-attrs elements)))]
[(txexpr-elements? x) (map remove-attrs x)]
[else x]))
;; todo: exclude-proc will keep things out, but is there a way to keep things in?
(define+provide+safe (map-elements/exclude proc x exclude-test)
(procedure? txexpr? procedure? . -> . txexpr?)
(cond
[(txexpr? x)
(if (exclude-test x)
x
(let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag attr
(map (λ(x)(map-elements/exclude proc x exclude-test)) elements))))]
;; externally the function only accepts txexpr,
;; but internally we don't care
[else (proc x)]))
(define+provide+safe (map-elements proc x)
(procedure? txexpr? . -> . txexpr?)
(map-elements/exclude proc x (λ(x) #f)))
;; function to split tag out of txexpr
(define+provide+safe (splitf-txexpr tx pred [proc (λ(x) null)])
((txexpr? procedure?) (procedure?) . ->* . (values txexpr? txexpr-elements?))
(define matches null)
(define (do-extraction x)
(cond
[(pred x) (begin ; store matched item and return processed value
(set! matches (cons x matches))
(proc x))]
[(txexpr? x) (let-values([(tag attr body) (txexpr->values x)])
(make-txexpr tag attr (do-extraction body)))]
[(txexpr-elements? x) (filter (compose1 not null?) (map do-extraction x))]
[else x]))
(define tx-extracted (do-extraction tx)) ;; do this first to fill matches
(values tx-extracted (reverse matches)))
(define+provide+safe (xexpr->html x)
(xexpr? . -> . string?)
(define (->cdata x)
(if (cdata? x) x (cdata #f #f x)))
(xexpr->string (let loop ([x x])
(cond
[(txexpr? x) (if (member (get-tag x) '(script style))
(make-txexpr (get-tag x) (get-attrs x) (map ->cdata (get-elements x)))
(make-txexpr (get-tag x) (get-attrs x) (map loop (get-elements x))))]
[else x]))))

@ -1,158 +0,0 @@
#lang racket/base
(require (for-syntax racket/base))
(require (submod "main.rkt" safe) rackunit)
(define-syntax (values->list stx)
(syntax-case stx ()
[(_ values-expr) #'(call-with-values (λ () values-expr) list)]))
(check-true (txexpr-tag?'foo))
(check-false (txexpr-tag? "foo"))
(check-false (txexpr-tag? 3))
(check-true (txexpr-attr? '(key "value")))
(check-false (txexpr-attr? '(key "value" "another")))
(check-false (txexpr-attr? '(key 0 "value")))
(check-true (txexpr-attrs? '()))
(check-true (txexpr-attrs? '((key "value"))))
(check-true (txexpr-attrs? '((key "value") (foo "bar"))))
(check-false (txexpr-attrs? '((key "value") "foo" "bar"))) ; content, not attr
(check-false (txexpr-attrs? '(key "value"))) ; not a nested list
(check-false (txexpr-attrs? '(("key" "value")))) ; two strings
(check-false (txexpr-attrs? '((key value)))) ; two symbols
(check-true (txexpr-element? "string"))
(check-true (txexpr-element? 'amp))
(check-true (txexpr-element? '(p "string")))
(check-true (txexpr-element? 65)) ;; a valid-char
(check-false (txexpr-element? 0)) ;; not a valid-char
(check-true (txexpr-elements? '("p" "foo" "123")))
(check-true (txexpr-elements? '("p" "foo" 123))) ; includes number
(check-true (txexpr-elements? '(p "foo" "123"))) ; includes symbol
(check-false (txexpr-elements? "foo")) ; not a list
(check-false (txexpr-elements? '(((key "value")) "foo" "bar"))) ; includes attr
(check-false (txexpr-elements? '("foo" "bar" ((key "value"))))) ; malformed
(check-true (txexpr? '(p)))
(check-true (txexpr? '(p "foo" "bar")))
(check-true (txexpr? '(p ((key "value")) "foo" "bar")))
(check-true (txexpr? '(p 123))) ; content is a number
(check-false (txexpr? "foo")) ; not a list with symbol
(check-false (txexpr? '(p "foo" "bar" ((key "value"))))) ; malformed
(check-false (txexpr? '("p" "foo" "bar"))) ; no name
(check-equal? (make-txexpr 'p) '(p))
(check-equal? (make-txexpr 'p '((key "value"))) '(p ((key "value"))))
(check-equal? (make-txexpr 'p null '("foo" "bar")) '(p "foo" "bar"))
(check-equal? (make-txexpr 'p '((key "value")) (list "foo" "bar"))
'(p ((key "value")) "foo" "bar"))
(check-equal? (values->list (txexpr->values '(p)))
(values->list (values 'p null null)))
(check-equal? (values->list (txexpr->values '(p "foo")))
(values->list (values 'p null '("foo"))))
(check-equal? (values->list (txexpr->values '(p ((key "value")))))
(values->list (values 'p '((key "value")) null)))
(check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
(values->list (values 'p '((key "value")) '("foo"))))
(check-equal? (values->list (txexpr->values '(p)))
(txexpr->list '(p)))
(check-equal? (values->list (txexpr->values '(p "foo")))
(txexpr->list '(p "foo")))
(check-equal? (values->list (txexpr->values '(p ((key "value")))))
(txexpr->list '(p ((key "value")))))
(check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
(txexpr->list '(p ((key "value")) "foo")))
(check-equal? (get-tag '(p ((key "value"))"foo" "bar" (em "square"))) 'p)
(check-equal? (get-attrs '(p ((key "value"))"foo" "bar" (em "square"))) '((key "value")))
(check-equal? (get-elements '(p ((key "value"))"foo" "bar" (em "square")))
'("foo" "bar" (em "square")))
(check-equal? (->txexpr-attr-key "foo") 'foo)
(check-equal? (->txexpr-attr-key 'foo) 'foo)
(check-equal? (->txexpr-attr-value "foo") "foo")
(check-equal? (->txexpr-attr-value 'foo) "foo")
(check-equal? (attrs->hash '((foo "bar"))) '#hash((foo . "bar")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw")) '#hash((foo . "fraw")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw") 'foo "dog") '#hash((foo . "dog")))
(check-equal? (hash->attrs '#hash((foo . "bar")(hee . "haw"))) '((foo "bar")(hee "haw")))
(check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar")
(check-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) 'color))
(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color"))
(check-false (attrs-have-key? '((color "red")(shape "circle")) 'nonexistent))
(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((color "red")(shape "circle")))))
(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((color "blue")(shape "circle")))))
(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((shape "circle")(color "red")))))
(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((color "red")))))
(check-true (attrs-equal? '((color "red")(shape "circle"))
'((color "red")(shape "circle"))))
(check-false (attrs-equal? '((color "red")(shape "circle"))
'((color "blue")(shape "circle"))))
(check-true (attrs-equal? '((color "red")(shape "circle"))
'((shape "circle")(color "red"))))
(check-false (attrs-equal? '((color "red")(shape "circle"))
'((color "red"))))
(check-equal? (merge-attrs 'foo "bar") '((foo "bar")))
(check-equal? (merge-attrs '(foo "bar")) '((foo "bar")))
(check-equal? (merge-attrs '((foo "bar"))) '((foo "bar")))
(check-equal? (merge-attrs "foo" 'bar) '((foo "bar")))
(check-equal? (merge-attrs "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar")))
(check-equal? (merge-attrs (merge-attrs "foo" "bar" "goo" "gar") "hee" "haw")
'((foo "bar")(goo "gar")(hee "haw")))
(check-equal? (merge-attrs '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))
(check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi"))
(check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi")))
(check-equal? (map-elements (λ(x) (if (string? x) "boing" x))
'(p "foo" "bar" (em "square")))
'(p "boing" "boing" (em "boing")))
(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
(em ((foo "zam")) "goodnight" "moon")) 'foo) '("bar" "zam" "zam"))
(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
(em ((foo "zam")) "goodnight" "moon")) 'nonexistent-key) '())
(define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2")
(em "goodnight" "moon" (meta "foo3" "bar3"))))
(define split-predicate (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate)) list)
(list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
(define split-proc (λ(x) '(div "foo")))
(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate split-proc)) list)
(list '(root (div "foo") "hello" "world" (div "foo") (em "goodnight" "moon" (div "foo"))) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
(check-equal? (xexpr->html '(root (script "3 > 2") "Why is 3 > 2?"))
"<root><script>3 > 2</script>Why is 3 &gt; 2?</root>")

@ -0,0 +1,57 @@
#lang racket/base
(require sugar/define xml racket/match)
(provide (all-defined-out) valid-char? cdata? cdata xexpr->string xexpr?)
(define (txexpr-short? x)
(match x
[(list (? symbol? name) (? xexpr?) ...) #t]
[else #f]))
(define (txexpr? x)
(or (txexpr-short? x)
(match x
[(list (? symbol?) (list (list (? symbol?) (? string?)) ...) (? xexpr?) ...) #t]
[else #f])))
(define (txexpr-tag? x)
(symbol? x))
(define (txexpr-tags? x)
(and (list? x) (andmap txexpr-tag? x)))
(define (txexpr-attr? x)
(match x
[(list (? symbol?) (? string?)) #t]
[else #f]))
(define (txexpr-attrs? x)
(and (list? x) (andmap txexpr-attr? x)))
(define (txexpr-element? x)
(xexpr? x))
(define (txexpr-elements? x)
(and (list? x) (andmap txexpr-element? x)))
(define (txexpr-attr-key? x)
(symbol? x))
(define (can-be-txexpr-attr-key? x)
(or (symbol? x) (string? x)))
(define (txexpr-attr-value? x)
(string? x))
(define (txexpr-attr-values? x)
(and (list? x) (andmap txexpr-attr-value? x)))
(define (can-be-txexpr-attr-value? x)
(or (symbol? x) (string? x)))
(define (can-be-txexpr-attrs? x)
(ormap (λ(test) (test x)) (list txexpr-attr? txexpr-attrs? can-be-txexpr-attr-key? can-be-txexpr-attr-value?)))
(define (list-of-can-be-txexpr-attrs? xs)
(and (list? xs) (andmap can-be-txexpr-attrs? xs)))

@ -0,0 +1,3 @@
#lang info
(define scribblings '(("scribblings/txexpr.scrbl" ())))
(define compile-omit-paths '("tests.rkt"))

@ -0,0 +1,43 @@
#lang racket/base
(require sugar/define)
(require-via-wormhole "../typed/txexpr/main.rkt")
(provide+safe
[xexpr? predicate/c]
[txexpr? predicate/c]
[txexpr-short? predicate/c]
[txexpr-tag? predicate/c]
[txexpr-tags? predicate/c]
[txexpr-attr? predicate/c]
[txexpr-attrs? predicate/c]
[txexpr-element? predicate/c]
[txexpr-elements? predicate/c]
[validate-txexpr (any/c . -> . txexpr?)]
[make-txexpr ((symbol?) (txexpr-attrs? txexpr-elements?) . ->* . txexpr?)]
[txexpr->values (txexpr? . -> . (values symbol? txexpr-attrs? txexpr-elements?))]
[txexpr->list (txexpr? . -> . list?)]
[get-tag (txexpr? . -> . txexpr-tag?)]
[get-attrs (txexpr? . -> . txexpr-attrs?)]
[get-elements (txexpr? . -> . txexpr-elements?)]
[txexpr-attr-key? predicate/c]
[txexpr-attr-value? predicate/c]
[can-be-txexpr-attr-key? predicate/c]
[can-be-txexpr-attr-value? predicate/c]
[->txexpr-attr-key (can-be-txexpr-attr-key? . -> . txexpr-attr-key?)]
[->txexpr-attr-value (can-be-txexpr-attr-value? . -> . txexpr-attr-value?)]
[can-be-txexpr-attrs? predicate/c]
[list-of-can-be-txexpr-attrs? predicate/c]
[attrs->hash (() #:rest (listof can-be-txexpr-attrs?) . ->* . hash?)]
[hash->attrs (hash? . -> . txexpr-attrs?)]
[attr-ref (txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-value?)]
[attr-ref* (txexpr? can-be-txexpr-attr-key? . -> . txexpr-attr-values?)]
[attrs-have-key? ((or/c txexpr-attrs? txexpr?) can-be-txexpr-attr-key? . -> . boolean?)]
[attrs-equal? ((or/c txexpr-attrs? txexpr?) (or/c txexpr-attrs? txexpr?) . -> . boolean?)]
[attr-set (txexpr? can-be-txexpr-attr-key? can-be-txexpr-attr-value? . -> . txexpr?)]
[merge-attrs (() #:rest list-of-can-be-txexpr-attrs? . ->* . txexpr-attrs?)]
[remove-attrs (txexpr? . -> . txexpr?)]
[map-elements/exclude (procedure? txexpr? procedure? . -> . txexpr?)]
[map-elements (procedure? txexpr? . -> . txexpr?)]
[splitf-txexpr ((txexpr? procedure?) (procedure?) . ->* . (values txexpr? txexpr-elements?))]
[xexpr->html (xexpr? . -> . string?)])

@ -1,6 +1,6 @@
#lang scribble/manual
@(require scribble/eval (for-label racket txexpr xml))
@(require scribble/eval (for-label racket txexpr xml (only-in typed/racket require/typed)))
@(define my-eval (make-base-eval))
@(my-eval `(require txexpr xml))
@ -10,7 +10,7 @@
@author[(author+email "Matthew Butterick" "mb@mbtype.com")]
@defmodule[#:multi (txexpr (submod txexpr safe))]
@defmodule[#:multi (txexpr (submod txexpr safe) typed/txexpr)]
A set of small but handy functions for improving the readability and reliability of programs that operate on tagged X-expressions (for short, @italic{txexpr}s).
@ -24,10 +24,14 @@ After that, you can update the package from the command line:
@section{Importing the module}
The module operates in two modes: fast and safe. Fast mode is the default, which you get by importing the module in the usual way: @code{(require txexpr)}.
The module can be invoked three ways: fast, safe, and typed.
Fast mode is the default, which you get by importing the module in the usual way: @code{(require txexpr)}.
Safe mode enables the function contracts documented below. Use safe mode by importing the module as @code{(require (submod txexpr safe))}.
The typed version is invoked as @code{(require typed/txexpr)}. The typed version is implemented ``natively'' in the sense that it is compiled separately with type annotations. It is not a @racket[require/typed] wrapper around the untyped code. This avoids the contract barrier that is otherwise automatically imposed between typed and untyped code.
@section{Whats a txexpr?}
@ -133,6 +137,11 @@ Predicates for @racket[_txexpr]s that implement this grammar:
@deftogether[(
@defproc[
(txexpr-tags?
[v any/c])
boolean?]
@defproc[
(txexpr-attrs?
[v any/c])
@ -143,7 +152,7 @@ boolean?]
[v any/c])
boolean?]
)]
Shorthand for @code{(listof txexpr-attr?)} and @code{(listof txexpr-element?)}.
Shorthand for @code{(listof txexpr-tag?)}, @code{(listof txexpr-attr?)}, and @code{(listof txexpr-element?)}.

@ -0,0 +1,195 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax))
(define-syntax (eval-as-untyped stx)
(syntax-case stx ()
[(_ exprs ...)
(with-syntax ([sym (generate-temporary)])
#'(begin
(module sym racket
(require rackunit (submod txexpr safe))
exprs ...)
(require 'sym)))]))
(define-syntax (eval-as-typed stx)
(syntax-case stx ()
[(_ exprs ...)
(with-syntax ([sym (generate-temporary)])
#'(begin
(module sym typed/racket
(require typed/rackunit typed/txexpr)
exprs ...)
(require 'sym)))]))
(define-syntax-rule (eval-as-typed-and-untyped exprs ...)
(begin
(eval-as-typed exprs ...)
(eval-as-untyped exprs ...)))
(eval-as-typed-and-untyped
(define-syntax (values->list stx)
(syntax-case stx ()
[(_ values-expr) #'(call-with-values (λ () values-expr) list)]))
(check-true (txexpr-tag? 'foo))
(check-false (txexpr-tag? "foo"))
(check-false (txexpr-tag? 3))
(check-false (txexpr-tags? 'foo))
(check-true (txexpr-tags? '(foo bar)))
(check-true (txexpr-attr? '(key "value")))
(check-false (txexpr-attr? '(key "value" "another")))
(check-false (txexpr-attr? '(key 0 "value")))
(check-true (txexpr-attrs? '()))
(check-true (txexpr-attrs? '((key "value"))))
(check-true (txexpr-attrs? '((key "value") (foo "bar"))))
(check-false (txexpr-attrs? '((key "value") "foo" "bar"))) ; content, not attr
(check-false (txexpr-attrs? '(key "value"))) ; not a nested list
(check-false (txexpr-attrs? '(("key" "value")))) ; two strings
(check-false (txexpr-attrs? '((key value)))) ; two symbols
(check-true (txexpr-element? "string"))
(check-true (txexpr-element? 'amp))
(check-true (txexpr-element? '(p "string")))
(check-true (txexpr-element? 65)) ;; a valid-char
(check-false (txexpr-element? 0)) ;; not a valid-char
(check-true (txexpr-elements? '("p" "foo" "123")))
(check-true (txexpr-elements? '("p" "foo" 123))) ; includes number
(check-true (txexpr-elements? '(p "foo" "123"))) ; includes symbol
(check-false (txexpr-elements? "foo")) ; not a list
(check-false (txexpr-elements? '(((key "value")) "foo" "bar"))) ; includes attr
(check-false (txexpr-elements? '("foo" "bar" ((key "value"))))) ; malformed
(check-true (txexpr? '(p)))
(check-true (txexpr? '(p "foo" "bar")))
(check-true (txexpr? '(p ((key "value")) "foo" "bar")))
(check-true (txexpr? '(p 123))) ; content is a number
(check-false (txexpr? "foo")) ; not a list with symbol
(check-false (txexpr? '(p "foo" "bar" ((key "value"))))) ; malformed
(check-false (txexpr? '("p" "foo" "bar"))) ; no name
(check-not-exn (λ _ (validate-txexpr '(p))))
(check-not-exn (λ _ (validate-txexpr '(p "foo" "bar"))))
(check-not-exn (λ _ (validate-txexpr '(p ((key "value")) "foo" "bar"))))
(check-not-exn (λ _ (validate-txexpr '(p 123)))) ; content is a valid-char
;(check-exn (λ _ (validate-txexpr "foo"))) ; not a list with symbol
;(check-exn (λ _ (validate-txexpr '(p "foo" "bar" ((key "value")))))) ; malformed
;(check-exn (λ _ (validate-txexpr '("p" "foo" "bar")))) ; no name
(check-equal? (make-txexpr 'p) '(p))
(check-equal? (make-txexpr 'p '((key "value"))) '(p ((key "value"))))
(check-equal? (make-txexpr 'p null '("foo" "bar")) '(p "foo" "bar"))
(check-equal? (make-txexpr 'p '((key "value")) (list "foo" "bar"))
'(p ((key "value")) "foo" "bar"))
(check-equal? (values->list (txexpr->values '(p)))
(values->list (values 'p null null)))
(check-equal? (values->list (txexpr->values '(p "foo")))
(values->list (values 'p null '("foo"))))
(check-equal? (values->list (txexpr->values '(p ((key "value")))))
(values->list (values 'p '((key "value")) null)))
(check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
(values->list (values 'p '((key "value")) '("foo"))))
(check-equal? (values->list (txexpr->values '(p)))
(txexpr->list '(p)))
(check-equal? (values->list (txexpr->values '(p "foo")))
(txexpr->list '(p "foo")))
(check-equal? (values->list (txexpr->values '(p ((key "value")))))
(txexpr->list '(p ((key "value")))))
(check-equal? (values->list (txexpr->values '(p ((key "value")) "foo")))
(txexpr->list '(p ((key "value")) "foo")))
(check-equal? (get-tag '(p ((key "value"))"foo" "bar" (em "square"))) 'p)
(check-equal? (get-attrs '(p ((key "value"))"foo" "bar" (em "square"))) '((key "value")))
(check-equal? (get-elements '(p ((key "value"))"foo" "bar" (em "square")))
'("foo" "bar" (em "square")))
(check-equal? (->txexpr-attr-key "foo") 'foo)
(check-equal? (->txexpr-attr-key 'foo) 'foo)
(check-equal? (->txexpr-attr-value "foo") "foo")
(check-equal? (->txexpr-attr-value 'foo) "foo")
(check-equal? (attrs->hash '((foo "bar"))) '#hash((foo . "bar")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw")) '#hash((foo . "fraw")))
(check-equal? (attrs->hash '((foo "bar")) '(foo "fraw") 'foo "dog") '#hash((foo . "dog")))
(check-equal? (hash->attrs '#hash((foo . "bar")(hee . "haw"))) '((foo "bar")(hee "haw")))
(check-equal? (attr-ref '(p ((foo "bar"))) 'foo) "bar")
(check-equal? (attr-set '(p ((foo "bar"))) 'foo "fraw") '(p ((foo "fraw"))))
(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) 'color))
(check-true (attrs-have-key? '(p ((color "red")(shape "circle"))) "color"))
(check-false (attrs-have-key? '((color "red")(shape "circle")) 'nonexistent))
(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((color "red")(shape "circle")))))
(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((color "blue")(shape "circle")))))
(check-true (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((shape "circle")(color "red")))))
(check-false (attrs-equal? '(p ((color "red")(shape "circle")))
'(foo ((color "red")))))
(check-true (attrs-equal? '((color "red")(shape "circle"))
'((color "red")(shape "circle"))))
(check-false (attrs-equal? '((color "red")(shape "circle"))
'((color "blue")(shape "circle"))))
(check-true (attrs-equal? '((color "red")(shape "circle"))
'((shape "circle")(color "red"))))
(check-false (attrs-equal? '((color "red")(shape "circle"))
'((color "red"))))
(check-equal? (merge-attrs 'foo "bar") '((foo "bar")))
(check-equal? (merge-attrs '(foo "bar")) '((foo "bar")))
(check-equal? (merge-attrs '((foo "bar"))) '((foo "bar")))
(check-equal? (merge-attrs "foo" 'bar) '((foo "bar")))
(check-equal? (merge-attrs "foo" "bar" "goo" "gar") '((foo "bar")(goo "gar")))
(check-equal? (merge-attrs (merge-attrs "foo" "bar" "goo" "gar") "hee" "haw")
'((foo "bar")(goo "gar")(hee "haw")))
(check-equal? (merge-attrs '((foo "bar")(goo "gar")) "foo" "haw") '((foo "haw")(goo "gar")))
(check-equal? (remove-attrs '(p ((foo "bar")) "hi")) '(p "hi"))
(check-equal? (remove-attrs '(p ((foo "bar")) "hi" (p ((foo "bar")) "hi"))) '(p "hi" (p "hi")))
(check-equal? (map-elements (λ(x) (if (string? x) "boing" x))
'(p "foo" "bar" (em "square")))
'(p "boing" "boing" (em "boing")))
(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
(em ((foo "zam")) "goodnight" "moon")) 'foo) '("bar" "zam" "zam"))
(check-equal? (attr-ref* '(root ((foo "bar")) "hello" "world" (meta ((foo "zam")) "bar2")
(em ((foo "zam")) "goodnight" "moon")) 'nonexistent-key) '())
(define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2")
(em "goodnight" "moon" (meta "foo3" "bar3"))))
(define split-predicate (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate)) list)
(list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
(define split-proc (λ(x) '(div "foo")))
(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate split-proc)) list)
(list '(root (div "foo") "hello" "world" (div "foo") (em "goodnight" "moon" (div "foo"))) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
(check-equal? (xexpr->html '(root (script "3 > 2") "Why is 3 > 2?"))
"<root><script><![CDATA[3 > 2]]></script>Why is 3 &gt; 2?</root>"))

@ -0,0 +1,4 @@
#lang typed/racket/base
(require "txexpr/main.rkt")
(provide (all-from-out "txexpr/main.rkt"))

@ -0,0 +1,76 @@
#lang typed/racket/base
(require (for-syntax racket/base) racket/match typed/sugar/define)
(provide (all-defined-out))
; Section 2.2 of XML 1.1
; (XML 1.0 is slightly different and more restrictive)
(define/typed (valid-char? i)
(Any -> Boolean)
(and (exact-nonnegative-integer? i)
(or (<= #x1 i #xD7FF)
(<= #xE000 i #xFFFD)
(<= #x10000 i #x10FFFF))))
(require/typed
xml
[#:struct location ([line : (Option Natural)]
[char : (Option Natural)]
[offset : Natural])]
[#:struct source ([start : (U location Symbol #f)]
[stop : (U location Symbol #f)])]
[#:struct (cdata source) ([string : String])]
[#:struct comment ([text : String])]
[#:struct (p-i source) ([target-name : Symbol]
[instruction : String])]
[xexpr->string (Xexpr -> String)])
(provide (all-from-out xml) cdata? xexpr->string)
(define-type Valid-Char Natural) ;; overinclusive but that's as good as it gets
(define-type Txexpr-Tag Symbol)
(define-type Txexpr-Attr-Key Symbol)
(define-type Txexpr-Attr-Value String)
(define-type Txexpr-Attr (List Txexpr-Attr-Key Txexpr-Attr-Value))
(define-predicate Txexpr-Attr? Txexpr-Attr)
(define-type Can-Be-Txexpr-Attr-Key (U Symbol String))
(define-type Can-Be-Txexpr-Attr-Value (U Symbol String))
(define-type Txexpr-Attrs (Listof Txexpr-Attr))
(define-type Txexpr-Attr-Hash (HashTable Txexpr-Attr-Key Txexpr-Attr-Value))
(define-type Txexpr-Element Xexpr)
(define-type Txexpr-Elements (Listof Txexpr-Element))
(define-type Txexpr-Full (List* Txexpr-Tag Txexpr-Attrs (Listof Xexpr)))
(define-type Txexpr-Short (Pairof Txexpr-Tag (Listof Xexpr)))
(define-type Txexpr (U Txexpr-Full Txexpr-Short))
(define-type Xexpr (Rec X
(U String
(List* Txexpr-Tag Txexpr-Attrs (Listof X))
(Pairof Txexpr-Tag (Listof X))
Symbol
Valid-Char
cdata
comment
p-i)))
(define-predicate xexpr? Xexpr)
(define-predicate txexpr? Txexpr)
(define-predicate txexpr-short? Txexpr-Short)
(define-predicate txexpr-tag? Txexpr-Tag)
(define-predicate txexpr-tags? (Listof Txexpr-Tag))
(define-predicate txexpr-attr? Txexpr-Attr)
(define-predicate txexpr-attrs? Txexpr-Attrs)
(define-predicate Valid-Char? Valid-Char)
(define/typed (txexpr-element? x)
(Any -> Boolean)
(if (xexpr? x)
(if (Valid-Char? x) (valid-char? x) #t)
#f))
(define-predicate txexpr-elements? (Listof Xexpr))
(define-predicate txexpr-attr-key? Txexpr-Attr-Key)
(define-predicate txexpr-attr-value? Txexpr-Attr-Value)
(define-predicate txexpr-attr-values? (Listof Txexpr-Attr-Value))
(define-predicate can-be-txexpr-attr-key? Can-Be-Txexpr-Attr-Key)
(define-predicate can-be-txexpr-attr-value? Can-Be-Txexpr-Attr-Value)
(define-predicate can-be-txexpr-attr? (List Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value))
(define-type Can-Be-Txexpr-Attr (U Txexpr-Attr Txexpr-Attrs Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value))
(define-predicate can-be-txexpr-attrs? Can-Be-Txexpr-Attr)
(define-predicate list-of-can-be-txexpr-attrs? (Listof Can-Be-Txexpr-Attr))

@ -0,0 +1,251 @@
#lang typed/racket/base
(require (for-syntax typed/racket/base) typed/sugar/define)
(require racket/match racket/string racket/list racket/bool "core-predicates.rkt")
(provide (all-defined-out) (all-from-out "core-predicates.rkt"))
(require typed/sugar/debug)
(define/typed (validate-txexpr-attrs x #:context [txexpr-context #f])
(Txexpr-Attrs [#:context Any] -> Txexpr-Attrs)
(define/typed (make-reason)
(-> String)
(if (not (list? x))
(format "because ~v is not a list" x)
(let ([bad-attrs (filter (λ(i) (not (txexpr-attr? i))) x)])
(format "because ~a ~a" (string-join (map (λ(ba) (format "~v" ba)) bad-attrs) " and ") (if (> (length bad-attrs) 1)
"are not valid attributes"
"is not in the form '(symbol \"string\")")))))
(cond
[(and (list? x) (> (length x) 0) (andmap txexpr-attr? x)) x]
[else (error (string-append "validate-txexpr-attrs: "
(if txexpr-context (format "in ~v, " txexpr-context) "")
(format "~v is not a valid list of attributes ~a" x (make-reason))))]))
(define/typed (validate-txexpr-element x #:context [txexpr-context #f])
(Txexpr-Element [#:context Any] -> Txexpr-Element)
(cond
[(or (string? x) (txexpr? x) (symbol? x)
(valid-char? x) (cdata? x)) x]
[else (error (string-append "validate-txexpr-element: "
(if txexpr-context (format "in ~v, " txexpr-context) "")
(format "~v is not a valid element (must be txexpr, string, symbol, XML char, or cdata)" x)))]))
;; is it a named x-expression?
;; todo: rewrite this recurively so errors can be pinpointed (for debugging)
(define/typed (validate-txexpr x)
(Any -> (Option Txexpr))
(define-syntax-rule (validate-txexpr-attrs-with-context e) (validate-txexpr-attrs e #:context x))
(define-syntax-rule (validate-txexpr-element-with-context e) (validate-txexpr-element e #:context x))
(cond
[(txexpr-short? x) x]
[(txexpr? x) (and
(validate-txexpr-attrs-with-context (get-attrs x))
(andmap (λ:([e : Txexpr-Element]) (validate-txexpr-element-with-context e)) (get-elements x)) x)]
[else (error 'validate-txexpr (format "~v is not a list starting with a symbol" x))]))
(define/typed make-txexpr
(case-> (Symbol -> Txexpr)
(Symbol Txexpr-Attrs -> Txexpr)
(Symbol Txexpr-Attrs (Listof Txexpr-Element) -> Txexpr))
(case-lambda
[(tag) (make-txexpr tag null null)]
[(tag attrs) (make-txexpr tag attrs null)]
[(tag attrs elements)
(define result (cons tag (append (if (empty? attrs) empty (list attrs)) elements)))
(if (txexpr? result)
result
(error 'make-txexpr "This can't happen"))]))
(define/typed (txexpr->values x)
(Txexpr -> (values Txexpr-Tag Txexpr-Attrs Txexpr-Elements))
(if (txexpr-short? x)
(values (car x) '() (cdr x))
(values (car x) (cadr x) (cddr x))))
(define/typed (txexpr->list x)
(Txexpr -> (List Txexpr-Tag Txexpr-Attrs Txexpr-Elements))
(define-values (tag attrs content) (txexpr->values x))
(list tag attrs content))
;; convenience functions to retrieve only one part of txexpr
(define/typed (get-tag x)
(Txexpr -> Txexpr-Tag)
(car x))
(define/typed (get-attrs x)
(Txexpr -> Txexpr-Attrs)
(define-values (tag attrs content) (txexpr->values x))
attrs)
(define/typed (get-elements x)
(Txexpr -> Txexpr-Elements)
(define-values (tag attrs elements) (txexpr->values x))
elements)
;; helpers. we are getting a string or symbol
(define/typed (->txexpr-attr-key x)
(Can-Be-Txexpr-Attr-Key -> Txexpr-Attr-Key)
(if (string? x) (string->symbol x) x))
(define/typed (->txexpr-attr-value x)
(Can-Be-Txexpr-Attr-Value -> Txexpr-Attr-Value)
(->string x))
(define/typed (->string x)
((U Symbol String) -> String)
(if (symbol? x) (symbol->string x) x))
(define/typed (attrs->hash . items-in)
(Can-Be-Txexpr-Attr * -> Txexpr-Attr-Hash)
;; can be liberal with input because they're all just nested key/value pairs
;; but still need this function to make sure that 'foo and "foo" are treated as the same hash key
(define items (reverse
(for/fold: ([items : (Listof (U Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value)) null])
([i (in-list items-in)])
(cond
[(txexpr-attr? i) (append (reverse i) items)]
[(txexpr-attrs? i) (append (append* (map (λ:([a : Txexpr-Attr]) (reverse a)) i)) items)]
[else (cons i items)]))))
(define/typed (make-key-value-list items)
((Listof (U Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value)) -> (Listof (Pairof Txexpr-Attr-Key Txexpr-Attr-Value)))
(if (< (length items) 2)
null
(let ([key (->txexpr-attr-key (car items))]
[value (->txexpr-attr-value (cadr items))]
[rest (cddr items)])
(cons (cons key value) (make-key-value-list rest)))))
(make-immutable-hash (make-key-value-list items)))
(define/typed (hash->attrs attr-hash)
(Txexpr-Attr-Hash -> Txexpr-Attrs)
(map (λ:([k : Txexpr-Attr-Key]) (list k (hash-ref attr-hash k))) (hash-keys attr-hash)))
(define/typed (attrs-have-key? x key)
((U Txexpr-Attrs Txexpr) Can-Be-Txexpr-Attr-Key -> Boolean)
(define attrs (if (txexpr-attrs? x) x (get-attrs x)))
(hash-has-key? (attrs->hash attrs) (->txexpr-attr-key key)))
(define/typed (attrs-equal? x1 x2)
((U Txexpr-Attrs Txexpr) (U Txexpr-Attrs Txexpr) -> Boolean)
(define attrs-tx1 (attrs->hash (if (txexpr-attrs? x1) x1 (get-attrs x1))))
(define attrs-tx2 (attrs->hash (if (txexpr-attrs? x2) x2 (get-attrs x2))))
(and
(= (length (hash-keys attrs-tx1)) (length (hash-keys attrs-tx2)))
(for/and ([(key value) (in-hash attrs-tx1)])
(equal? (hash-ref attrs-tx2 key) value))))
(define/typed (attr-set tx key value)
(Txexpr Can-Be-Txexpr-Attr-Key Can-Be-Txexpr-Attr-Value -> Txexpr)
(define new-attrs
(hash->attrs (hash-set (attrs->hash (get-attrs tx)) (->txexpr-attr-key key) (->txexpr-attr-value value))))
(make-txexpr (get-tag tx) new-attrs (get-elements tx)))
(define/typed (attr-ref tx key)
(Txexpr Can-Be-Txexpr-Attr-Key -> Txexpr-Attr-Value)
(with-handlers ([exn:fail? (λ(e) (error (format "attr-ref: no value found for key ~v" key)))])
(hash-ref (attrs->hash (get-attrs tx)) (->txexpr-attr-key key))))
(define/typed (attr-ref* tx key)
(Txexpr Can-Be-Txexpr-Attr-Key -> (Listof Txexpr-Attr-Value))
(define: results : (Listof Txexpr-Attr-Value) empty)
(let: loop : Void ([tx : Xexpr tx])
(when (and (txexpr? tx) (attrs-have-key? tx key) (attr-ref tx key))
(set! results (cons (attr-ref tx key) results))
(map (λ:([e : Txexpr-Element]) (loop e)) (get-elements tx))
(void)))
(reverse results))
;; convert list of alternating keys & values to attr
(define/typed (merge-attrs . items)
(Can-Be-Txexpr-Attr * -> Txexpr-Attrs)
(define attrs-hash (apply attrs->hash items))
;; sort needed for predictable results for unit tests
(define sorted-hash-keys (sort (hash-keys attrs-hash) (λ:([a : Txexpr-Tag][b : Txexpr-Tag]) (string<? (->string a) (->string b)))))
`(,@(map (λ:([key : Txexpr-Tag]) (list key (hash-ref attrs-hash key))) sorted-hash-keys)))
(define/typed (remove-attrs x)
(Xexpr -> Xexpr)
(if (txexpr? x)
(let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag null (map remove-attrs elements)))
x))
(define/typed (map-elements/exclude proc x exclude-test)
((Xexpr -> Xexpr) Xexpr (Xexpr -> Boolean) -> Xexpr)
(cond
[(txexpr? x)
(if (exclude-test x)
x
(let-values ([(tag attr elements) (txexpr->values x)])
(make-txexpr tag attr
(map (λ:([x : Xexpr])(map-elements/exclude proc x exclude-test)) elements))))]
;; externally the function only accepts txexpr,
;; but internally we don't care
[else (proc x)]))
(define/typed (map-elements proc x)
((Xexpr -> Xexpr) Xexpr -> Xexpr)
(map-elements/exclude proc x (λ(x) #f)))
;; function to split tag out of txexpr
(define deleted-signal (gensym))
(define/typed splitf-txexpr
(case-> (Txexpr (Xexpr -> Boolean) -> (values Txexpr Txexpr-Elements))
(Txexpr (Xexpr -> Boolean) (Xexpr -> Xexpr) -> (values Txexpr Txexpr-Elements)))
(case-lambda
[(tx pred) (splitf-txexpr tx pred (λ:([x : Xexpr]) deleted-signal))]
[(tx pred proc)
(define: matches : Txexpr-Elements null)
(define/typed (do-extraction x)
(Xexpr -> Xexpr)
(cond
[(pred x) (begin ; store matched item and return processed value
(set! matches (cons x matches))
(proc x))]
[(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)])
(make-txexpr tag attr (filter (λ:([e : Xexpr]) (not (equal? e deleted-signal))) (map do-extraction elements))))]
[else x]))
(define: tx-extracted : Xexpr (do-extraction tx)) ;; do this first to fill matches
(values (if (txexpr? tx-extracted)
tx-extracted
(error 'splitf-txexpr "Can't get here")) (reverse matches))]))
(define/typed (xexpr->html x)
(Xexpr -> String)
(define/typed (->cdata x)
(Xexpr -> Xexpr)
(cond
[(cdata? x) x]
[(string? x) (cdata #f #f (format "<![CDATA[~a]]>" x))]
[else x]))
(xexpr->string (let: loop : Xexpr ([x : Xexpr x])
(cond
[(txexpr? x) (if (member (get-tag x) '(script style))
(make-txexpr (get-tag x) (get-attrs x) (map ->cdata (get-elements x)))
(make-txexpr (get-tag x) (get-attrs x) (map loop (get-elements x))))]
[else x]))))
Loading…
Cancel
Save