File: HTMLDocument.k

package info (click to toggle)
kaya 0.2.0-6
links: PTS
area: main
in suites: etch, etch-m68k
size: 3,012 kB
ctags: 1,307
sloc: cpp: 6,691; haskell: 4,833; sh: 2,868; yacc: 768; makefile: 700; perl: 87
file content (1737 lines) | stat: -rw-r--r-- 58,724 bytes
/** -*-C-*-ish
    HTMLDocument.k Copyright (C) 2005 Chris Morris

    This file is distributed under the terms of the GNU Lesser General
    Public Licence. See COPYING for licence.
*/

module HTMLDocument;

import Prelude;
import System;
import Crypto;
import Strings;
import Regex;
import public ElementTreeData; // ideally import abstract, if such a thing existed
import ElementTree;
import HTMLnesting;
import XMLentities;
import WebCommon;
import Compress;

/** Part 1: Data type definitions **/

globals {
  Int uniqueid;
  Regex classregex;
  Regex idregex;
}

/* Development notes:
 * We want a special data type for URIs so we can handle encoding properly
 * String will do for now, though.
 */

"The base document data type"
public data HTMLDocument(MetaData head, ElementTree body, Doctype doctype, [Pair<String,String>] httpheaders);

// we don't support meta HTTP-equiv here because that's better handled via
// real HTTP headers, which we may add support for later in HTMLDocument
// abstract because it shouldn't be poked directly
"The HTML meta data type - the <head> of the document"
abstract data MetaData(String doctitle,
		     Dict<String,String> metakeys,
		     [StyleSheet] styles, // order is significant
		     [HeadLink] links);
// yes, I know, it's missing <script> and <style> support. Can't be
// bothered right now. <style> is better handled by stylesheets anyway

"The document type declaration."
public data Doctype = HTML4Strict | XHTML1Strict;

"A CSS stylesheet"
public data StyleSheet([MediaType] media, String uri);
// TODO: extend this to potentially support non-text/css stylesheets
// while keeping text/css as the default behaviour.

"A display media type for a link"
public data MediaType = MTscreen | MTtty | MTtv | MTprojection | MThandheld | MTprint | MTbraille | MTaural | MTall;

// lots more attributes that could be added here
"A <link>"
public data HeadLink(Relationship relate, String uri, String title);

"Whether the relationship is normal (Rel) or reverse (Rev) and the type of relationship. In most cases, Rel is more useful."
public data Relationship = Rel(String rel) | Rev(String rev);

// TODO: Needs a lot more inline elements to be added.
"Inline elements that can be included within a document (non-empty)."
public data InlineElement = Emphasis | StrongEmphasis 
  | Abbreviation(String title) | Citation | Definition | ComputerCode 
  | SampleInput | SampleOutput | Variable // generic phrase elements
  | BiggerText | SmallerText | Bold | Italic | Subscript | Superscript // semi formatting elements
// special inline elements
  | Hyperlink(String uri)
  | InlineQuote(String citeuri)
  | Span(String class)
  | FormLabel;

public data ListType = Ordered | Unordered;

"Initial table data storage type. Initial table data consists of a row-column 2-D header array (which may be blank), a row-column 2-D footer array (also may be blank), and an array of 2-D body arrays (which must have at least one entry). Table data added in this way may only be strings.  It will be assumed that the column count of the first actual row is the column count for the rest of the table, and overrunning cells will be ignored.  (i.e. size(header[0]) else size(footer[0]) else size(sections[0][0])"
public data InitialTableData([[String]] header, [[String]] footer, [[[String]]] sections);

"An inline image. The alt String should contain the same text that you would use if you were unable to add an image at this point."
public data ImageData(String src, String alt, ImageDimensions dim);

"Methods for finding out image dimensions. Specified(width,height)
allows precise specification of image dimensions and for efficiency
this should always be used if those values are known. Unspecified
leaves the calculation to the client user-agent"
public data ImageDimensions = /*AutoFromSrc | AutoFromPath(String filepath) |*/ Specified(Int width, Int height) | Unspecified;

"The method used by a form to submit data"
public data FormType = FormGet | FormPost | FormPostUpload;

"Types of text input"
public data TextInputType = InputText | InputPassword | InputHidden | InputRadio | InputCheck;

"Types of control input"
public data ControlInputType = InputSubmit | InputReset;

"An <option> element or a checkbox/radio value and label. Value may be left as \"\" to default to label"
public data SelectOption(String label, String value, Bool chosen);

"When converting Strings to HTML fragments, convert inline elements only,
or allow block-level elements too?
UltraSafe: all tags and attributes stripped out
InlineOnly: inline elements at safety level.
AllElements: all elements at safety level.
Unchecked: All tags and attributes allowed."
public data WhiteList = UltraSafe | InlineOnly(ConversionSafety sa) | AllElements(ConversionSafety sb) | Unchecked;
// no tags | safe tags | no forms | no JS | all
"What level of safety against malicious input is needed?
Safe: minimal set of tags and attributes allowed
Unsafe: Most tags and attributes allowed (not forms or scripting)
VeryUnsafe: Almost all tags and attributes allowed (not scripting)"
public data ConversionSafety = Safe | Unsafe | VeryUnsafe;

public Exception RequiresElement(String err) = Exception("Required element missing "+err,510);
public Exception RequiresAttribute(String err) = Exception("Required attribute missing "+err,511);
public Exception InvalidRange(String err) = Exception(err,512);
public Exception InvalidNesting(String err) = Exception(err,513);


/** Part 2: General document construction **/

/* ElementTree is entirely generic. It guarantees well-formedness and
   nothing else. So in the interests of producing valid as well as
   well-formed code, modules that use HTMLDocument to generate
   documents shouldn't let people directly touch ElementTree. */

"Generates a skeleton HTML document with the specified DTD and title. Calling this function initialises data for other HTML construction functions, so should be called first"
public HTMLDocument new(Doctype doctype, String title) {
  // If we ever get initialisation of globals in the global block,
  // we can move these two there, where they really belong!
  classregex = compile("^[A-Za-z][A-Za-z0-9-]*$");
  idregex = compile("^[A-Za-z][A-Za-z0-9_:.-]*$");
  initNesting();

  return HTMLDocument(
		      MetaData(title,
			       Dict::new(17,strHash),
			       createArray(5), // styles
			       createArray(20)), // links
		      mkElement("body"),
		      doctype,
		      // change content type if doctype is XHTML
		      [("Content-type","text/html; charset=UTF-8")]);
}

"DEPRECATED synonym for new"
public HTMLDocument newDocument(Doctype doctype, String title) = module::new(doctype,title);


"DEPRECATED synonym for string()"
public String toString(HTMLDocument doc, UnicodeFormat uform = LiteralUTF8) = string(doc,uform);

"Converts the document to string form for output"
public String string(HTMLDocument doc, UnicodeFormat uform = LiteralUTF8) {
  output = headString(doc,uform);
  case doc.doctype of {
    HTML4Strict -> output += string(doc.body,ImpliedSingleton,1,uform,tagFormats,getAlwaysEmpty);
    | XHTML1Strict -> output += string(doc.body,Singleton,1,uform,tagFormats,getAlwaysEmpty);
  }
  output += "\n</html>\n";
  return output;
}

"Converts a part of the document to string form"
public String substring(ElementTree tree, UnicodeFormat uform = LiteralUTF8, Doctype doctype=HTML4Strict) {
  case doctype of {
    HTML4Strict -> return string(tree,ImpliedSingleton,0,uform,tagFormats,getAlwaysEmpty);
    | XHTML1Strict -> return string(tree,Singleton,0,uform,tagFormats,getAlwaysEmpty);
  }
}

String headString(HTMLDocument doc, UnicodeFormat uform) {
  case doc.doctype of {
    HTML4Strict -> output = "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\n\t\"http://www.w3.org/TR/html4/strict.dtd\">\n";
    singletoncloser = createString(0);
    | XHTML1Strict -> output = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n";
    singletoncloser = " /";
  }
  output += "<html>\n";
  output += " <head>\n";
  if (doc.head.doctitle == "") {
    throw(RequiresElement("The document title may not be blank."));
  }
  output += "  <title>" + simpleEncode(doc.head.doctitle,false,uform) + "</title>\n";
  // add code to handle meta/styles/links here 
  for metadata in entries(doc.head.metakeys) {
    output += "  <meta name=\"" + simpleEncode(metadata.fst,false,uform) + "\" value=\"" + simpleEncode(metadata.snd,false,uform) + "\"" + singletoncloser + ">\n";
  }
  for link in doc.head.links {
    output += "  <link ";
    case link.relate of {
      Rel(rel) -> output += "rel=\"" + simpleEncode(rel,false,uform) + "\" ";
      | Rev(rev) -> output += "rev=\"" + simpleEncode(rev,false,uform) + "\" ";
    }
    output += "href=\""+simpleEncode(link.uri,false,uform)+"\"";
    if (link.title != "") {
      output += " title=\""+simpleEncode(link.title,false,uform)+"\"";
    }
    output += singletoncloser + ">\n";
  }
  for stylesheet in doc.head.styles {
    output += "  <link rel=\"stylesheet\" href=\"" + simpleEncode(stylesheet.uri,false,uform) + "\" type=\"text/css\" media=\"";
    output += mediaToString(stylesheet.media);
    output += "\"" + singletoncloser + ">\n";
  }

  output += " </head>";
  return output;
}

"Prints the document to standard output"
public Void write(HTMLDocument doc, UnicodeFormat uform = LiteralUTF8) {
  putStr(headString(doc,uform));
  case doc.doctype of {
    HTML4Strict -> lazyPrint(doc.body,ImpliedSingleton,1,uform,tagFormats,getAlwaysEmpty);
    | XHTML1Strict -> lazyPrint(doc.body,Singleton,1,uform,tagFormats,getAlwaysEmpty);
  }
  putStr("\n</html>\n");
}


private String mediaToString([MediaType] media) {
  nub(media);
  if (elem(MTall,media)) {
    return "all"; // don't need to look in this case
  } else {
    mstr = createArray(size(media));
    for mt in media {
      case mt of {
	MTscreen -> mtstr = "screen";
	| MTtty -> mtstr = "tty";
	| MTtv -> mtstr = "tv";
	| MTprojection -> mtstr = "projection";
	| MThandheld -> mtstr = "handheld";
	| MTprint -> mtstr = "print";
	| MTbraille -> mtstr = "braille";
	| MTaural -> mtstr = "aural";
      }
      push(mstr,mtstr);
    }
    return Strings::join(mstr,',');
  }
}


/** Part 3: Header editing **/


"Adds a HTTP header to the document"
public Void addHTTPHeader(HTMLDocument doc, String name, String value) {
  // TODO: checks for headers such as Content-type that can only appear once
  Pair<String,String> val = (name,value);
  push(doc.httpheaders,val);
}

"Adds a meta-data key/value pair to the document"
public Void addDocumentMetaData(HTMLDocument doc, String key, String value) {
  add(doc.head.metakeys,key,value);
}

"Adds a linked external stylesheet to the document"
public Void addDocumentStylesheet(HTMLDocument doc, [MediaType] media, String uri) {
  push(doc.head.styles,StyleSheet(media,uri));
}

"Adds a document-level <link> to the document"
public Void addDocumentLink(HTMLDocument doc, Relationship relate, String uri,  String title=createString(0)) {
  push(doc.head.links,HeadLink(relate,uri,title));
}

"Changes the document title"
public Void setDocumentTitle(HTMLDocument doc, String newtitle) {
  if (newtitle == "") {
    throw(RequiresElement("The document title may not be blank."));
  }
  doc.head.doctitle = newtitle;
}


/** Part 4: Body editing - common attributes **/


"Sets the CSS class of a HTML element"
public Void setClass(ElementTree element, String classname) {
  // doesn't allow for unicode or escaped character classnames
  // but they're very rarely used. We can add support later.
  classnames = words(classname);
  for cn in classnames {
    if (!quickMatchWith(classregex,classname)) {
      throw(RequiresAttribute("Class format incorrect"));
    }
  }
  module::setAttribute(element,"class",classname);
}

"Sets the ID of a HTML element. IDs must be unique in the document"
public Void setID(ElementTree element, String idname) {
  if (!quickMatchWith(idregex,idname)) {
    throw(RequiresAttribute("ID format incorrect"));
  }
  // Ideally we'd check for duplicate ids at this stage, but since we
  // don't have a way to find the root element, we can't.
  module::setAttribute(element,"id",idname);
}

private String nextUniqueID() {
  if (uniqueid < 1) {
    uniqueid = 1;
  } else {
    uniqueid++;
  }
  return "Kay"+String(uniqueid);
}

"Sets the title attribute for a HTML element"
public Void setTitle(ElementTree element, String title) {
  module::setAttribute(element,"title",title);
}

"Sets an arbitrary attribute on a HTML element"
public Void setAttribute(ElementTree element, String name, String value) {
  ElementTree::setAttribute(element,name,value);
}

"Gets an afttribute value of a HTML element"
public Maybe<String> getAttribute(ElementTree element, String name) {
  return ElementTree::getAttribute(element,name);
}

// TODO: language, directionality, possibly scripting events


/** Part 5: Body editing - adding blocks **/


// TODO: need a decent table editing interface here, as well
// as other block-level elements..

// this should really check for proper header nesting somewhere
"Adds a heading to the end of the chosen document tree"
public ElementTree addHeading(ElementTree parent, Int headinglevel, String initialtext=createString(0)) {
  if (headinglevel < 1 || headinglevel > 6) {
    throw(RequiresElement(headinglevel+" is not a valid heading depth"));
  }
  return addGenericBlock(parent,"h"+String(headinglevel),initialtext);
}

"Adds a paragraph to the end of the chosen document tree"
public ElementTree addParagraph(ElementTree parent, String initialtext=createString(0)) {
  return addGenericBlock(parent,"p",initialtext);
}

"Adds an author address to the end of the chosen document tree"
public ElementTree addAddress(ElementTree parent, String initialtext=createString(0)) {
  return addGenericBlock(parent,"address",initialtext);
}

"Adds a block quotation element to the end of the chosen document tree"
// No initial text option because blockquotes can't directly contain text.
public ElementTree addBlockQuote(ElementTree parent) {
  if (!canContainBlock(parent.name)) {
    throw(InvalidNesting("Can't add block quotation inside "+parent.name));
  }
  // need to check that parent can contain paragraphs (e.g. not ol)
  bquote = mkElement("blockquote");
  pushElement(parent,bquote);
  return bquote;
}

"Adds a generic division to the end of the chosen document tree"
public ElementTree addDivision(ElementTree parent, String initialtext=createString(0), String cssclass=createString(0)) {
  div = addGenericBlock(parent,"div",initialtext);
  if (cssclass != "") {
    setClass(div,cssclass);
  }
  return div;
}

"Adds a preformatted block to the end of the chosen document tree"
public ElementTree addPreformatted(ElementTree parent, String initialtext=createString(0)) {
  return addGenericBlock(parent,"pre",initialtext);
}

private Bool canContainBlock(String ename) = containsBlock(ename);

private Bool canContainException(String parent, String child) = nestingExceptions((parent,child));

// might make this public later, if people insist...
private ElementTree addGenericBlock(ElementTree parent, String element, String initialtext=createString(0)) {
  // tweak to allow ins and del to be added in an inline context too
  if (canContainBlock(parent.name) || ((element == "del" || element == "ins") && canContainInline(parent.name,false))) {
    // need to check that parent can contain paragraphs (e.g. not ol)
    newelement = mkElement(element);
    pushElement(parent,newelement);
    if (initialtext != "") {
      // because it's only called with initial text if this is possible
      doAddString(newelement,initialtext);
    }
    return newelement;
  } else {
    throw(InvalidNesting("Can't add "+element+" inside "+parent.name));
  }
}

"Adds a list. If the initial contents are larger than the initial size, the overflow will be ignored."
public ElementTree addList(ElementTree parent, ListType ltype, Int initialsize, [String] initialcontents=createArray(1)) {
  if (!canContainBlock(parent.name)) {
    throw(InvalidNesting("Can't add lists inside "+parent.name));
  }
  case ltype of {
    Ordered -> etype = "ol";
    | Unordered -> etype = "ul";
  }
  newlist = mkElement(etype);
  for i in [1..initialsize] {
    listitem = mkElement("li");
    pushElement(newlist,listitem);
    if (initialcontents[i-1] != "") {
      doAddString(listitem,initialcontents[i-1]);
    }
  }
  pushElement(parent,newlist);
  return newlist;
}

"Gets the list item within a list at the specified index"
public ElementTree getListItem(ElementTree list, Int index) {
  if (list.name == "ul" || list.name == "ol") {
    if (index < 0 || size(list.elements) <= index) {
      throw(OutOfBounds);
    }
    // ol and ul should only contain li
    // this will throw a mildly unhelpful exception if CData has crept in
    return list.elements[index].nested;
    
  } else {
    throw(RequiresElement("Parent element is not a list"));
  }
}

"Adds a new list item into a list at the specified index."
public ElementTree addListItem(ElementTree list, Int index, String initialcontents=createString(0)) {
  if (list.name == "ul" || list.name == "ol") {
    listitem = mkElement("li");
    if (initialcontents != "") {
      doAddString(listitem,initialcontents);
    }
    addElementAt(list,listitem,index);
    return listitem;
  } else {
    throw(InvalidNesting("Can't add a list item here - improper nesting"));
  }
}

"Adds a new list item onto the end of a list."
public ElementTree pushListItem(ElementTree list, String initialcontents=createString(0)) {
  if (list.name == "ul" || list.name == "ol") {
    listitem = mkElement("li");
    if (initialcontents != "") {
      doAddString(listitem,initialcontents);
    }
    pushElement(list,listitem);
    return listitem;
  } else {
    throw(InvalidNesting("Can't add a list item here - improper nesting"));
  }
}



/** Part 6: Body editing - adding inline content **/


private Bool canContainInline(String elemname, Bool implyCdata=true) {
  return (containsCData(elemname)
	  || !(isBlock(elemname)
	       || alwaysEmpty(elemname)
	       || pretendEmpty(elemname))
	  || (implyCdata && containsCDataOnly(elemname)));
}

// everything should call this rather than using pushData directly
"Adds text content to an element such as a paragraph"
public Void addString(ElementTree block, String text) {
  if (canContainInline(block.name,true)) {
    doAddString(block,text);
  } else {
    throw(InvalidNesting(block.name+" can't (directly?) contain text"));
  }
}

// except that where we know strings are allowed we can use this
private Void doAddString(ElementTree block, String text) {
  text = entityToLiteral(text);
  pushData(block,text);
}

private ElementTree makeInlineElement(InlineElement inline) {
  case inline of {
    // phrase elements
    Emphasis -> elem = mkElement("em");
    | StrongEmphasis -> elem = mkElement("strong");
    | Abbreviation(title) -> elem = mkElement("abbr");
    if (title != "") { setTitle(elem,title); }
    | Citation -> elem = mkElement("cite");
    | Definition  -> elem = mkElement("dfn");
    | ComputerCode  -> elem = mkElement("code");
    | SampleInput -> elem = mkElement("kbd");
    | SampleOutput -> elem = mkElement("samp");
    | Variable -> elem = mkElement("var");
    | BiggerText -> elem = mkElement("big");
    | SmallerText -> elem = mkElement("small");
    | Bold -> elem = mkElement("b");
    | Italic -> elem = mkElement("i");
    | Subscript -> elem = mkElement("sub");
    | Superscript -> elem = mkElement("sup");
    // special elements
    | Hyperlink(uri) -> elem = mkElement("a");
    module::setAttribute(elem,"href",uri);
    | InlineQuote(citeuri) -> elem = mkElement("q");
    if (citeuri != "") {
      module::setAttribute(elem,"cite",citeuri);
    }
    | Span(class) -> elem = mkElement("span");
    if (class != "") {
      setClass(elem,class);
    }
    | FormLabel -> elem = mkElement("label");
  }
  return elem;
}

"Adds a new inline element (containing some text) to the end of a block"
public ElementTree appendInlineElement(ElementTree block, InlineElement inline, String initialtext) {
  if (canContainInline(block.name,false)) {  
    inl = makeInlineElement(inline);
    doAddString(inl,initialtext);
    pushElement(block,inl);
    return inl;
  } else {
    throw(InvalidNesting("Can't add an inline element here"));
  }
}

"Encloses existing text within an element within an inline element"
public ElementTree addInlineElementAt(ElementTree block, InlineElement inline, Int startpos, Int endpos) {
  // iterates through existing structure, places start tag at startpos
  // (in char) and end tag at endpos (unless this would lead to
  // improper nesting)
  /* This needs making smarter to deal with multi-byte characters in
     UTF-8, but that's possibly better done at a much lower level */
  if (!canContainInline(block.name,false)) {  
    throw(InvalidNesting("Can't add an inline element here"));
  }
  if (startpos < 0) {
    throw(InvalidRange("Can't start before beginning of element"));
  }
  if (startpos > endpos) {
    throw(InvalidRange("Can't start after end"));
  }
  currentpos = 0;
  // if we've always been using pushData and unshiftData then there
  // should never be two adjacent data blocks

  // if we can nest properly, then the nesting level below block at
  // startpos and endpos must be equal, and between startpos and
  // endpos it must never fall below the level at startpos.
  totalsize = 0;
  for i in [0..size(block.elements)-1] {
    blocksizes[i] = totalsize + textSizeOfBlock(block.elements[i]);
    totalsize += blocksizes[i];
  }
  if (totalsize < endpos) {
    throw(InvalidRange("Can't end after end of element"));
  }
  startblock = 0;
  while (blocksizes[startblock] <= startpos) {
    startblock++;
  }
  endblock = startblock;
  while (blocksizes[endblock] <= endpos) {
    endblock++;
  }

  if (startblock == 0) {
    substart = startpos;
  } else {
    substart = startpos - blocksizes[startblock-1];
  }
  if (endblock == 0) {
    subend = endpos;
  } else {
    subend = endpos - blocksizes[endblock-1];
  }


  if (endblock != startblock) {
    case block.elements[endblock] of {
      SubElement(el) -> throw(InvalidNesting("Improper nesting"));
      | CData(c) -> case block.elements[startblock] of {
	SubElement(el) -> throw(InvalidNesting("Improper nesting"));
	| CData(c) -> elem = insertInlineAroundBlocks(block,inline,startblock,substart,endblock,subend);
	    // start in start block, end in end block,
	    // everything in between moves down a layer
      }
    }
  } else {
    case block.elements[endblock] of {
      // call it again on the sub element
      SubElement(el) -> elem = addInlineElementAt(el,inline,substart,subend);
      | CData(c) -> elem = insertInlineToCData(block,inline,substart,subend,endblock); // split into three parts a, <>b</>, c
    }
  }

  return elem;
}
// TODO: specify start and end by word position or by providing a
// substring to delimit.

// this function shouldn't need error-checking inside it.
private ElementTree insertInlineToCData(ElementTree block, InlineElement inline, Int startpos, Int endpos, Int blocknumber) {
  initial = block.elements[blocknumber].cdata;
  if (startpos > 0) {
    prefix = substr(initial,0,startpos);
  } else {
    prefix = createString(0);
  }
  if (endpos < length(initial)-1) {
    suffix = substr(initial,endpos+1,(length(initial)-endpos));
  } else {
    suffix = createString(0);
  }
  len = (endpos-startpos)+1;
  if (len < 1) {
    middle = createString(0);
  } else {
    middle = substr(initial,startpos,len);
  }
  
  toshove = createArray(3);
  if (prefix != "") {
    push(toshove,CData(prefix));
  }
  // this code needs making into a function elsewhere  
  elem = makeInlineElement(inline);
  doAddString(elem,middle);
  push(toshove,SubElement(elem));
  if (suffix != "") {
    push(toshove,CData(suffix));
  }
  
  subarrayReplace(block.elements,blocknumber,toshove);


  return elem;
}

// rewrite this to use addidx
private Void subarrayReplace([a] main, Int index, [a] shove) {
  main[index] = shove[0];
  if (size(shove) > 1) {
    difference = size(shove)-1;
    // move everything in main up a few places
    for (i=size(main)-1;i>index;i--) {
      main[i+difference] = main[i];
    }
    // and shove the replacement into the gap
    for (j=1;j<size(shove);j++) {
      main[index+j] = shove[j];
    }
  }
}

// both startblock and endblock are CData blocks
private ElementTree insertInlineAroundBlocks(ElementTree block, InlineElement inline, Int startblock, Int startpos, Int endblock, Int endpos) {
  // start block
  leftstr = block.elements[startblock].cdata;
  if (startpos == 0) {
    leftprefix = createString(0);
    leftsuffix = leftstr;
  } else {
    leftprefix = substr(leftstr,0,startpos);
    leftsuffix = substr(leftstr,startpos,length(leftstr)-startpos);
  }
  rightstr = block.elements[endblock].cdata;
  if (endpos == 0) {
    rightprefix = createString(0);
    rightsuffix = rightstr;
  } else {
    rightprefix = substr(rightstr,0,endpos);
    rightsuffix = substr(rightstr,endpos,length(rightstr)-endpos);
  }
  if (leftprefix != "") {
    block.elements[startblock] = CData(leftprefix);
  } else {
    startblock--; // so we fake having dealt with it.
  }
  if (rightsuffix != "") {
    block.elements[endblock] = CData(rightsuffix);
  } else {
    endblock++; //similarly
  }
  // startblock-endblock >= 2 always at this point.
  elem = makeInlineElement(inline);
  for i in [startblock+1..endblock-1] {
    case block.elements[i] of {
      SubElement(el) -> pushElement(elem,el);
      | CData(cd) -> doAddString(elem,cd);
    }
  }
  for i in [startblock+2..endblock-1] {
    removeAt(block.elements,startblock+2);
  }
  doAddString(elem,rightprefix);
  unshiftData(elem,leftsuffix);
  block.elements[startblock+1] = SubElement(elem);
  return elem;
}

"Adds a line break"
public ElementTree addLineBreak(ElementTree block) {
  if (!canContainInline(block.name,false)) {  
    throw(InvalidNesting("Can't add an line break here"));
  }  
  if (size(block.elements) != 0) {
    lastelem = block.elements[size(block.elements)-1];
    case lastelem of {
      SubElement(el) -> if (el.name == "br") {
	throw(InvalidNesting("Doesn't make sense to have two line breaks in a row."));
      }
      | default -> ;
    }
  }
  br = mkElement("br");
  pushElement(block,br);
  return br;
}

"Adds a horizontal rule"
public ElementTree addHorizontalRule(ElementTree block) {
  if (size(block.elements) != 0) {
    lastelem = block.elements[size(block.elements)-1];
    case lastelem of {
      SubElement(el) -> if (el.name == "hr") {
	throw(InvalidNesting("Doesn't make sense to have two horizontal rules in a row."));
      }
      | default -> ;
    }
  }
  hr = mkElement("hr");
  pushElement(block,hr);
  return hr;
}


"Adds an inline image"
public ElementTree addImage(ElementTree block, ImageData image) {
  if (!canContainInline(block.name,false)) {  
    throw(InvalidNesting("Can't add an image here"));
  }
  img = mkElement("img");
  module::setAttribute(img,"src",image.src);
  module::setAttribute(img,"alt",image.alt);
  case image.dim of {
    Specified(width,height) -> module::setAttribute(img,"width",String(width));
    module::setAttribute(img,"height",String(height));
    // TODO: add support for AutoFromSrc and AutoFromPath
    | default -> ;
  }

  pushElement(block,img);
  return img;
}


/** Part 7: Table editing - adding and editing tables **/


"Add a table to the document"
public ElementTree addTable(ElementTree parent, String captiontext=createString(0)) {
  if (!canContainBlock(parent.name)) {
     throw(InvalidNesting("Can't add table inside "+parent.name));
  }
  table = mkElement("table");
  pushElement(parent,table);
  if (captiontext != "") {
    caption = mkElement("caption");
    doAddString(caption,captiontext);
    pushElement(table,caption);
  }
  return table;
}

"Sets the table caption"
public Void setTableCaption(ElementTree table, String captiontext) {
  if (table.name != "table") {
    throw(RequiresElement("setTableCaption can only be used on table elements!"));
  }

  case table.elements[0] of {
    SubElement(el) -> if (el.name == "caption") {
      removeAt(table.elements,0);
    }
    | default -> ;
  }

  caption = mkElement("caption");
  doAddString(caption,captiontext);
  unshiftElement(table,caption);
}

"Gets the table header container of rows, creating it if it doesn't exist"
public ElementTree getTableHeader(ElementTree table) {
  if (table.name != "table") {
    throw(RequiresElement("Can't get a header from table elements!"));
  }
  for elem in table.elements {
    // should never be raw CData inside a table, so hit them with an
    // exception if they've managed to do it...
    if (elem.nested.name == "thead") {
      // return the existing thead if it's there.
      return elem.nested;
    }
  }
  // so, position it before the tfoot, the first tbody, at the end, in
  // that order.
  thead = mkElement("thead");
  index = -1;
  case findElement(table,"tfoot") of {
    just(x) -> index = x;
    | nothing -> case findElement(table,"tbody") of {
      just(x) -> index = x;
      | nothing -> ;
    }
  }
  if (index == -1) {
    pushElement(table,thead); // on the end
  } else {
    addElementAt(table,thead,index); // in the right place
  }
  return thead;
}

"Gets the table footer container of rows, creating it if it doesn't exist"
public ElementTree getTableFooter(ElementTree table) {
  if (table.name != "table") {
    throw(RequiresElement("Can't get a footer from non-table elements!"));
  }
  for elem in table.elements {
    // should never be raw CData inside a table, so hit them with an
    // exception if they've managed to do it...
    if (elem.nested.name == "tfoot") {
      // return the existing thead if it's there.
      return elem.nested;
    }
  }
  // so, position it before the tfoot, the first tbody, at the end, in
  // that order.
  tfoot = mkElement("tfoot");
  case findElement(table,"tbody") of {
    just(x) -> addElementAt(table,tfoot,x);
    | nothing -> pushElement(table,tfoot);
  }
  return tfoot;
}

"Adds a new table body container of rows"
public ElementTree addTableBodySection(ElementTree table) {
  if (table.name != "table") {
    throw(RequiresElement("Can't get a tbody from non-table elements!"));
  }
  tbody = mkElement("tbody");
  pushElement(table,tbody);
  return tbody;
}

"Gets all table body containers, creating one if none exist"
public [ElementTree] getTableBodySections(ElementTree table) {
  if (table.name != "table") {
    throw(RequiresElement("Can't get a tbody from non-table elements!"));
  }
  case findElement(table,"tbody") of {
    nothing -> return [addTableBodySection(table)];
    | just(x) -> sz = size(table.elements);
    arr = subarray(table.elements,x,sz-x);
    return map(extractSubElement,arr);
  }
}

// this doesn't work with lambda, oddly
private ElementTree extractSubElement(Element val) {
  return val.nested;
}

private Bool isTsect(String name) {
  return (name=="tbody" || name=="thead" || name=="tfoot");
}

"Return the current number of columns in a table"
public Int numTableColumns(ElementTree table) {
  if (table.name != "table") {
    throw(RequiresElement("Can't get number of columns if it's not a table!"));
  }
  // whatever the first row of the table is can't be miscounted
  // by rowspans.
  for i in table.elements {
    // no Cdata should be here
    if (isTsect(i.nested.name)) {
      // ignore empty tsects.
      // any non-empty tsect will have the same number of columns
      if (size(i.nested.elements) != 0) {
	return numTsectColumns(i.nested);
      }
    }
  }
  return 0;
}

private Int numTsectColumns(ElementTree tsect) {
  cols = 0;
  // use the first one to avoid needing rowspan calculations
  for td in tsect.elements[0].nested.elements {
    case lookup(td.nested.attributes,"colspan") of {
      nothing -> cols++;
      | just(c) -> cols += Int(c);
    }
  }
  return cols;
}

"Adds a row to the end of the selected thead, tbody or tfoot of a table"
public ElementTree addTableRow(ElementTree tsect, String class=createString(0)) {
  if (!isTsect(tsect.name)) {
    throw(RequiresElement("Can't add a table row here!"));
  }
  tr = mkElement("tr");
  pushElement(tsect,tr);
  if (class != "") {
    setClass(tr,class);
  }
  columns = numTsectColumns(tsect);
  if (columns > 0) {
    for i in [1..columns] {
      // can do this because we don't let rowspans extend outside the
      // existing tsect rows
      pushElement(tr,mkElement("td"));
    }
  }
  return tr;
}

"Adds some extra columns to the right edge of the table"
public Void addTableColumns(ElementTree table, Int num=1) {
  if (table.name != "table") {
    throw(RequiresElement("Can't add columns if it's not a table!"));
  }
  for j in [1..num] {
    valid = false;
    for i in table.elements {
      // no Cdata should be here
      if (isTsect(i.nested.name)) {
	for tr in i.nested.elements {
	  pushElement(tr.nested,mkElement("td"));
	  valid = true;
	}
      }
    }
    if (!valid) {
      throw(RequiresElement("Can't add columns until the table has at least one row"));
    }
  }
}

"Makes a specified table cell a header cell (and returns the cell)"
public ElementTree makeHeaderCell(ElementTree tsect, Int row, Int col) {
  cell = getTableCell(tsect,row,col);
  cell.name = "th";
  return cell;
}

"Makes a specified table cell a data cell (and returns the cell)"
public ElementTree makeDataCell(ElementTree tsect, Int row, Int col) {
  cell = getTableCell(tsect,row,col);
  cell.name = "td";
  return cell;
}

"Gets a specified cell"
public ElementTree getTableCell(ElementTree tsect, Int row, Int col) {
  // this does some error checking for mHC and mDC
  if (!isTsect(tsect.name)) {
    throw(RequiresElement("Can only get cells from tbody, thead or tfoot!"));
  }
  if (size(tsect.elements) <= row) {
    throw(OutOfBounds);
  }
  if (size(tsect.elements[row].nested.elements) <= col) {
    throw(OutOfBounds);
  }
  return tsect.elements[row].nested.elements[col].nested;
}

"Create a table from given data"
public ElementTree initialiseTable(ElementTree parent, InitialTableData itd, String caption=createString(0)) {
  table = addTable(parent,caption);
  // create the rows
  if (size(itd.header) > 0 && size(itd.header[0]) > 0) {
    thead = getTableHeader(table);
    for i in [1..size(itd.header)] {
      tr = addTableRow(thead);
    }
    fillheader = true;
    cols = size(itd.header[0]);
  } else {
    fillheader = false;
  }
  if (size(itd.footer) > 0 && size(itd.footer[0]) > 0) {
    tfoot = getTableFooter(table);
    for i in [1..size(itd.footer)] {
      tr = addTableRow(tfoot);
    }
    cols = size(itd.footer[0]);
    fillfooter = true;
  } else {
    fillfooter = false;
  }
  if (size(itd.sections) > 0 && size(itd.sections[0]) > 0 && size(itd.sections[0][0]) > 0) {
    tbc = 0;
    for tbodies in itd.sections {
      tbody[tbc] = addTableBodySection(table);
      for i in [1..size(tbodies)] {
	tr = addTableRow(tbody[tbc]);
      } 
      tbc++;
    }
    cols = size(itd.sections[0][0]);
    fillbody = true;
  } else {
    fillbody = false;
  }
  // create the columns
  addTableColumns(table,cols);

  // add the data
  if (fillheader) {
    fillBlockWithData(thead,itd.header,true);
  }
  if (fillfooter) {
    fillBlockWithData(tfoot,itd.footer);
  }
  if (fillbody) {
    for (k=0;k<size(itd.sections);k++) {
      fillBlockWithData(tbody[k],itd.sections[k]);
    }
  }
  return table;
}

// utility function for above
private Void fillBlockWithData(ElementTree block, [[String]] cdata, Bool forceheader=false) {
  for (i=0;i<size(cdata);i++) {
    for (j=0;j<size(cdata[i]);j++) {
      if (forceheader) {
	tc = makeHeaderCell(block,i,j);
      } else {
	tc = getTableCell(block,i,j);
      }
      doAddString(tc,cdata[i][j]);
    }
  }
}

"Lazily create a table from given data"
public ElementTree lazyTable(ElementTree parent, InitialTableData itd, String caption=createString(0)) {
  table = addTable(parent,caption);
  // create the rows
  if (size(itd.header) > 0 && size(itd.header[0]) > 0) {
    fillheader = true;
    cols = size(itd.header[0]);
  } else {
    fillheader = false;
  }
  if (size(itd.footer) > 0 && size(itd.footer[0]) > 0) {
    cols = size(itd.footer[0]);
    fillfooter = true;
  } else {
    fillfooter = false;
  }
  if (size(itd.sections) > 0 && size(itd.sections[0]) > 0 && size(itd.sections[0][0]) > 0) {
    tbc = 0;
    cols = size(itd.sections[0][0]);
    fillbody = true;
  } else {
    fillbody = false;
  }
  
  if (fillheader) {
    appendGenerator(table,lazyTHead@(cols,itd.header));
  }
  if (fillfooter) {
    appendGenerator(table,lazyTFoot@(cols,itd.footer));
  }
  if (fillbody) {
    for tbody in itd.sections {
      appendGenerator(table,lazyTBody@(cols,tbody));
    }
  }
  return table;
}

/* LAZY */
ElementTree lazyTHead(Int cols, [[String]] dat) = lazyTBlock("th","thead",cols,dat);
ElementTree lazyTFoot(Int cols, [[String]] dat) = lazyTBlock("td","tfoot",cols,dat);
ElementTree lazyTBody(Int cols, [[String]] dat) = lazyTBlock("td","tbody",cols,dat);

ElementTree lazyTBlock(String cell, String block, Int cols, [[String]] dat) {
  tblock = mkElement(block,size(dat));
  for row in dat {
    appendGenerator(tblock,lazyTRow@(cell,cols,row));
  }
  return tblock;
}

// probably a row at a time is lazy enough.
ElementTree lazyTRow(String cell, Int cols, [String] row) {
  tr = mkElement("tr",cols);
  for i in [0..cols-1] {
    tcell = mkElement(cell);
    doAddString(tcell,row[i]);
    pushElement(tr,tcell);
  }
  return tr;
}



/** Part 8: Form editing - including Kaya state maintenance magic **/


"This adds a form that points to the current application to call a named function. It's similar to the Webapp function in approach. You need to use AddLocalControlInput() to set up state transfers."
// with use of mod_rewrite or similar it might be necessary to call
// setAttribute on the form's action.
public ElementTree addLocalForm(ElementTree parent) {
  form = addForm(parent);
  module::setAttribute(form,"action",progName());
  module::setAttribute(form,"method","post");
  return form;
}

"This adds a form that points to a different application. This requires you to deal with any required state handling between the two applications yourself."
// you could use this as a local form if you had no state worth
// maintaining.
public ElementTree addRemoteForm(ElementTree parent, String action, FormType method) {
  form = addForm(parent);
  module::setAttribute(form,"action",action);
  case method of {
    FormGet -> module::setAttribute(form,"method","get");
    | default -> module::setAttribute(form,"method","post");
  }
  return form;
}

// called by local and remote form
private ElementTree addForm(ElementTree parent) {
  if (!canContainBlock(parent.name)) {
     throw(InvalidNesting("Can't add a form inside "+parent.name));
  }
  form = mkElement("form");
  pushElement(parent,form);
  return form;
}

"Adds a text input to the form"
public ElementTree addTextInput(ElementTree parent, TextInputType itype, String iname, String ivalue=createString(0), Int isize=0) {
  if (!canContainInline(parent.name)) {
     throw(InvalidNesting("Can't add a form input inside "+parent.name));
  }
  if (iname == "") {
     throw(RequiresAttribute("Input name can't be empty."));
  }
  input = mkElement("input");
  pushElement(parent,input);
  module::setAttribute(input,"name",iname);
  module::setAttribute(input,"value",ivalue);
  case itype of {
    InputHidden -> module::setAttribute(input,"type","hidden");
    | InputPassword -> module::setAttribute(input,"type","password");    
    module::setAttribute(input,"size",String(isize));
    | InputText -> module::setAttribute(input,"type","text");
    module::setAttribute(input,"size",String(isize));
    | InputCheck -> module::setAttribute(input,"type","checkbox");
    | InputRadio -> module::setAttribute(input,"type","radio");
  }

  return input;
}

"Adds state and processing function variables to a form. Will have undefined effects if this is not a LocalForm. Only for webapp, not webprog."
public Void addStateFields(ElementTree parent, Void(a) fn, a state) {
  discard = addTextInput(parent,InputHidden,"kaya_function",encode(String(fnid(fn))));
  discard = addTextInput(parent,InputHidden,"kaya_arg",encode(marshal(state,fnid(fn))));
}

"Adds a new fieldset to the form"
public ElementTree addFieldset(ElementTree parent, String legendtext) {
  if (!canContainBlock(parent.name)) {
     throw(InvalidNesting("Can't add a fieldset inside "+parent.name));
  }
  fset = mkElement("fieldset");
  pushElement(parent,fset);
  legend = mkElement("legend");
  doAddString(legend,legendtext);
  pushElement(fset,legend);
  return fset;
}

"Associates some text with a form control"
public Void associateTextAndInput(ElementTree block, Int startpos, Int endpos, ElementTree control) {
  label = addInlineElementAt(block,FormLabel,startpos,endpos);
  doAssociateTandI(label,control);
}

private Void doAssociateTandI(ElementTree label, ElementTree control) {
  // private function so don't need to do this checking
  /*  if (label.name != "label") {
    throw(RequiresElement("The first parameter must be a label element"));
  }
  if (control.name == "input" || control.name == "select" || control.name == "textarea") {
  */
  uid = nextUniqueID();
  module::setAttribute(label,"for",uid);
  setID(control,uid);
  /*  } else {
    throw(RequiresElement("The second parameter must be a form field element"));
    }*/
}

Void normaliseOpt([SelectOption] opts, Bool ismult) {
  for opt in opts {
    if (opt.chosen) {
      if (ismult) {
	opt.chosen = false;
      } else {
	ismult = true;
      }
    } 
  }
}

Int normaliseOptgroups([(String,[SelectOption])] optgroups, Bool allowmult) {
  isize = 0;
  ismult = false;
  for optgroup in optgroups {
    if (optgroup.fst != "") {
      isize++;
    } else {
      isize += size(optgroup.snd);
    }
    if (allowmult==false) {
      normaliseOpt(optgroup.snd,ismult);
    }
  }
  return isize;
}

"Adds a select element with options (and optgroups if the first element of the pairs is not \"\"). Will allow multiple selected if ssize > 0"
public ElementTree addSelectElement(ElementTree block, String name, Int ssize, [(String,[SelectOption])] optgroups) {
  if (!canContainInline(block.name)) {
    throw(InvalidNesting("Can't add a form input inside "+block.name));
  }
  isize = normaliseOptgroups(optgroups,(ssize>0));
  select = mkElement("select",isize);
  module::setAttribute(select,"name",name);
  if (ssize > 0) {
    module::setAttribute(select,"size",String(ssize));
    module::setAttribute(select,"multiple","multiple");
  }
  for optgroup in optgroups {
    if (optgroup.fst != "") {
      og = mkElement("optgroup");
      module::setAttribute(og,"label",optgroup.fst);
      for option in optgroup.snd {
	if (option.value == "") {
	  option.value = option.label;
	}
	opt = mkElement("option");
	module::setAttribute(opt,"value",option.value);
	module::setAttribute(opt,"label",option.label);
	if (option.chosen) {
	  module::setAttribute(opt,"selected","selected");
	}
	doAddString(opt,optgroup.fst+": "+option.label);
	pushElement(og,opt);
      }
      pushElement(select,og);
    } else {
      for option in optgroup.snd {
	if (option.value == "") {
	  option.value = option.label;
	}
	opt = mkElement("option");
	module::setAttribute(opt,"value",option.value);
	if (option.chosen) {
	  module::setAttribute(opt,"selected","selected");
	}
	doAddString(opt,option.label);
	pushElement(select,opt);
      }
    }
  }
  pushElement(block,select);
  return select;
}

"Adds a lazy select element with options (and optgroups if the first element of the pairs is not \"\"). Will allow multiple selected if ssize > 0. Obviously lazy select elements cannot be autoFill()ed"
public ElementTree addLazySelect(ElementTree block, String name, Int ssize, [(String,[SelectOption])] optgroups) {
  if (!canContainInline(block.name)) {
    throw(InvalidNesting("Can't add a form input inside "+block.name));
  }
  isize = normaliseOptgroups(optgroups,(ssize>0));
  select = mkElement("select",isize);
  module::setAttribute(select,"name",name);
  if (ssize > 0) {
    module::setAttribute(select,"size",String(ssize));
    module::setAttribute(select,"multiple","multiple");
  }
  for optgroup in optgroups {
    if (optgroup.fst != "") {
      appendGenerator(select,lazyOptgroup@(optgroup));
    } else {
      for option in optgroup.snd {
	appendGenerator(select,lazyOption@(option,createString(0)));
      }
    }
  }
  pushElement(block,select);
  return select;
}

ElementTree lazyOptgroup((String,[SelectOption]) optgroup) {
  og = mkElement("optgroup");
  module::setAttribute(og,"label",optgroup.fst);
  for option in optgroup.snd {
    appendGenerator(og,lazyOption@(option,optgroup.fst));
  }
  return og;
}

ElementTree lazyOption(SelectOption option, String group) {
  opt = mkElement("option");
  if (option.value == "") {
    option.value = option.label;
  } else {
    module::setAttribute(opt,"value",option.value);
  }
  module::setAttribute(opt,"label",option.label);
  if (option.chosen) {
    module::setAttribute(opt,"selected","selected");
  }
  if (group != "") {
    doAddString(opt,group+": "+option.label);
  } else {
    doAddString(opt,option.label);
  }
  return opt;
}

"Adds a select element with options (and optgroups if the first element of the pairs is not \"\"). Will allow multiple selected if ssize > 0. Optionally, the select element may be lazy, which saves run-time memory, at the cost of not being able to use autoFill() on it."
public ElementTree addLabelledSelect(ElementTree block, String labeltext, String name, Int ssize, [(String,[SelectOption])] optgroups, Bool lazy=false) {
  div = addDivision(block);
  label = appendInlineElement(div,FormLabel,labeltext);
  if (!lazy) {
    control = addSelectElement(div,name,ssize,optgroups);
  } else {
    control = addLazySelect(div,name,ssize,optgroups);
  }
  doAssociateTandI(label,control);
  return div;

}

"Provides a string to call in a local function to be used as a URL (e.g. in a href or src attribute)"
// obviously this only passes the defined state, though you can put
// additional parameters on the end.
public String localControlURL(String label, b(a) fn, a state) {
  name = "kaya_control";
  val = urlEncode(encodeControlState(@fn,state));
  return progName() + "?" + name + "=" + val;
}

"Return an encoded representation of the application state and the handler
function that can be stored in a URL or an external data store (for use with Webprog::storeFunction)."
public String encodeControlState(b(a) fn, a state) {
  return encode(compressString(marshal((@fn,state),228)));
}

"Adds a submit button to call a local function"
public ElementTree addLocalControlInput(ElementTree parent, String label, b(a) fn, a state) {
  if (!canContainInline(parent.name)) {
     throw(InvalidNesting("Can't add a form input inside "+parent.name));
  }
  input = mkElement("input");
  pushElement(parent,input);
  module::setAttribute(input,"type","submit");
  module::setAttribute(input,"value",label);

  submitid = nextUniqueID();
  module::setAttribute(input,"name","kaya_submit_"+submitid);

  stateinfo = encode(compressString(marshal((fn,state),Int(substr(submitid,3,length(submitid)-3)))));
  hinput = addTextInput(parent,InputHidden,"kaya_control_"+submitid,stateinfo);
  
  return input;
}

"Adds a submit or reset button to the form to call remote functions"
public ElementTree addRemoteControlInput(ElementTree parent, ControlInputType itype, String iname=createString(0), String ivalue=createString(0)) {
  if (!canContainInline(parent.name)) {
     throw(InvalidNesting("Can't add a form input inside "+parent.name));
  }
  input = mkElement("input");
  pushElement(parent,input);
  case itype of {
    InputSubmit -> module::setAttribute(input,"type","submit");
    if (iname != "") {
      module::setAttribute(input,"name",iname);
    }
    | InputReset -> module::setAttribute(input,"type","reset");
  }
  if (ivalue != "") {
    module::setAttribute(input,"value",ivalue);
  }

  return input;
}

"Adds a list of checkboxes or radio buttons in a fieldset. "
// gives them all the same name for symmetry with <select (multiple)>
// survey engines may want some standard options arrays.
public ElementTree addOptionList(ElementTree parent, String legend, String iname, [SelectOption] options, Bool allowmultiple=true) {
  fset = addFieldset(parent,legend);
  if (allowmultiple) {
    itype = InputCheck;
  } else {
    itype = InputRadio;
    canmark = true;
  }
  for option in options { 
    div = addDivision(fset);
    if (option.value == "") {
      option.value = option.label;
    }
    control = addTextInput(div,itype,iname,option.value);
    if (option.chosen && (allowmultiple || canmark)) {
      module::setAttribute(control,"checked","checked");
      canmark = false;
    }
    label = appendInlineElement(div,FormLabel,option.label);
    doAssociateTandI(label,control);
  }
  return fset;
}

"Adds a labelled checkbox to a form."
public ElementTree addOption(ElementTree parent, String iname, SelectOption option) {
  div = addDivision(parent);
  if (option.value == "") {
    control = addTextInput(div,InputCheck,iname,option.label);
  } else {
    control = addTextInput(div,InputCheck,iname,option.value);
  }
  if (option.chosen) {
    module::setAttribute(control,"checked","checked");
  }
  label = appendInlineElement(div,FormLabel,option.label);
  doAssociateTandI(label,control);
  return div;
}

"Adds a labelled text element"
public ElementTree addLabelledInput(ElementTree parent, String labeltext, TextInputType itype, String iname, String ivalue=createString(0), Int isize=0) {
  div = addDivision(parent);
  label = appendInlineElement(div,FormLabel,labeltext);
  control = addTextInput(div,itype,iname,ivalue,isize);
  doAssociateTandI(label,control);
  return div;
}

"Adds a text input area"
public ElementTree addTextarea(ElementTree parent, String name, String initialtext=createString(0), Int rows=5, Int cols=40) {
  if (!canContainInline(parent.name)) {
     throw(InvalidNesting("Can't add a form input inside "+parent.name));
  }
  if (rows < 1 || cols < 1) {
     throw(RequiresAttribute("Must have at least one row and column."));
  }
  ta = mkElement("textarea");
  module::setAttribute(ta,"name",name);
  if (initialtext != "") {
    doAddString(ta,initialtext);
  }
  module::setAttribute(ta,"rows",String(rows));
  module::setAttribute(ta,"cols",String(cols));
  pushElement(parent,ta);
  return ta;
}

"Adds a labelled text area"
public ElementTree addLabelledTextarea(ElementTree parent, String name, String labeltext, String initialtext=createString(0), Int rows=5, Int cols=40) {
  div = addDivision(parent);
  label = appendInlineElement(div,FormLabel,labeltext);
  br = addLineBreak(div);
  control = addTextarea(div,name,initialtext,rows,cols);
  doAssociateTandI(label,control);
  return div;
}


/** Part 9: element retrieval **/


"Returns all (non-anonymous, non-lazy) child elements of a particular element"
public [ElementTree] getChildren(ElementTree parent) {
  els = createArray(size(parent.elements));
  for elem in parent.elements {
    case elem of {
      SubElement(el) -> push(els,el);
      | default -> ;
    }
  }
  return els;
}

"Returns an anonymous element tree suitable for appending to"
public ElementTree anonymousBlock () {
  return mkElement("div");
}

"Returns a copy of an element tree (including descendants)"
public ElementTree copyTree(ElementTree orig) {
  return copy(orig);
}

"Adds an existing block to the end of the specified element"
public Void appendExisting(ElementTree dest, ElementTree block) {
  if (!canContainException(dest.name,block.name)) {
    if (isBlock(block.name)) {
      if (!canContainBlock(dest.name)) {
	throw(InvalidNesting("Can't add a block-level element here"));
      }
    } else {
      if (!canContainInline(dest.name)) {
	throw(InvalidNesting("Can't add an inline element here"));
      }
    }
  }
  pushElement(dest,block);
}

"Adds an existing block to the start of the specified element"
public Void prependExisting(ElementTree dest, ElementTree block) {
  if (!canContainException(dest.name,block.name)) {
    if (isBlock(block.name)) {
      if (!canContainBlock(dest.name)) {
	throw(InvalidNesting("Can't add a block-level element here"));
      }
    } else {
      if (!canContainInline(dest.name)) {
	throw(InvalidNesting("Can't add an inline element here"));
      }
    }
  }
  unshiftElement(dest,block);
}

"Adds a function to generate a block that will exist later to the end of the specified element"
public Void appendGenerator(ElementTree dest, ElementTree() generator) {
  pushGenerator(dest,@generator);
}

"Adds a function to generate a block that will exist later to the start of the specified element"
public Void prependGenerator(ElementTree dest, ElementTree() generator) {
  unshiftGenerator(dest,@generator);
}

"Moves a block in one position to another position"
public Void moveBlock(ElementTree parentsrc, Int srcidx, ElementTree parentdest, Int destidx) {
  if (srcidx >= size(parentsrc.elements)) {
    throw(OutOfBounds);
  }
  case parentsrc.elements[srcidx] of {
    CData(cd) -> inline = true; cdata = true; cname = "";
    | SubElement(el) -> inline = !isBlock(el.name); cdata = false; cname = el.name;
  }
  if (!canContainException(parentdest.name,cname)) {
    if (!inline) {
      if (!canContainBlock(parentdest.name)) {
	throw(InvalidNesting("Can't add a block-level element here"));
      }
    } else {
      if (!canContainInline(parentdest.name) && !(cdata && containsCDataOnly(parentdest.name))) {
	throw(InvalidNesting("Can't add an inline element here"));
      }
    }
  }
  case parentsrc.elements[srcidx] of {
    SubElement(el) -> addElementAt(parentdest,el,destidx);
    | CData(cd) -> addDataAt(parentdest,cd,destidx);
  }
}

private ElementTree mkElement(String name, Int expected=0) {
  return newElement(name,expected);
}


/** Part 10: Conversion from Strings */

"Reads a string, converts it to HTML, and appends into the document at the specified location. The doctype is the doctype of the input string, not the document it is being read into."
public Void readFromString(ElementTree location, String input, WhiteList safety, Doctype doctype) {
  wl = whitelistHTML(safety);
  case doctype of {
    HTML4Strict -> ie = impliedClosings;
    | XHTML1Strict -> ie = Dict::new(3,strHash); // no implicit closing in XHTML
  }
  tmpbase = elementTree(input,"tmpbase",wl,ie,isAlwaysEmpty);
  els = getElements(tmpbase);
  for el in els {
    case el of {
      SubElement(sel) -> pushElement(location,sel);
      | CData(scd) -> pushData(location,scd);
    }
  }
}

Dict<String,[String]> impliedClosings() {
  ics = Dict::new(17,strHash);
  add(ics,"td",["td","/tr","tr","/table","/tbody","/tfoot","/thead","tbody","tfoot"]);
  add(ics,"tr",["/tr","tr","/table","/tbody","/tfoot","/thead","tbody","tfoot"]);
  add(ics,"thead",["/table","tbody","tfoot"]);
  add(ics,"tbody",["/table","tbody"]);
  add(ics,"tfoot",["/table","tbody"]);
  add(ics,"li",["li","/ul","/ol"]);
  add(ics,"p",["address","blockquote","div","h1","h2","h3","h4","h5","h6","hr","p","pre","ul","ol","dl","table","form","fieldset","/address","/blockquote","/div","/form","/fieldset"]);
  add(ics,"dd",["dd","dt","/dl"]);
  add(ics,"dt",["dd","dt","/dl"]);
  return ics;
}

ExistDict<String> tagFormats() {
  // defaults to not breaking
  //  full = ["body","blockquote","ul","ol","hr","table","thead","tfoot","tbody","tr","form","fieldset","select","optgroup"];
  //  outer = ["h1","h2","h3","h4","h5","h6","p","address","div","pre","li","br","caption","td","th","legend","option","textarea"];
  tags = ["body","blockquote","ul","ol","hr","table","thead","tfoot","tbody","tr","form","fieldset","select","optgroup","h1","h2","h3","h4","h5","h6","p","address","div","pre","li","br","caption","td","th","legend","option","textarea"];
  ed = newExist(47,strHash);
  for i in [0..size(tags)-1] {
    add(ed,tags[i]);
  }
  return ed;
}

[String] genericAttribs = ["class","id","lang","dir","title"];

ConversionSafety getSafety(WhiteList w) {
  case w of {
    InlineOnly(s) -> return s;
    | AllElements(s) -> return s;
  }
}

Dict<String,[String]> whitelistHTML(WhiteList wconf) {
  wl = Dict::new(79,strHash);
  if (wconf == Unchecked) {
    add(wl,"*",["*"]); // whitelist everything
    return wl;
  } else if (wconf == UltraSafe) {
    add(wl,createString(0),createArray(1)); // blacklist everything, act as a tag stripper
    return wl;
  }

  safeinline = ["b","i","em","strong","u","ins","del","code","kbd","samp","var","cite","dfn","abbr","big","small","sup","sub","q","span","br"];
  case getSafety(wconf) of {
    Safe -> ;
    | Unsafe -> concat(safeinline,["a","img"]);
    | default -> concat(safeinline,["a","img","label","input","select","option","optgroup","textarea"]);
  }

  for name in safeinline {
    attribs = genericAttribs();
    case getSafety(wconf) of {
      Safe -> ;
      | default -> push(attribs,"style");
    }
    case name of {
      "a" -> concat(attribs,["href"]); // only in Unsafe or worse as above
      | "img" -> concat(attribs,["src","alt","width","height"]); // likewise
      | "label" -> concat(attribs,["for"]);
      | "input" -> concat(attribs,["name","value","type","size"]);
      | "select" -> concat(attribs,["name","size","multiple"]);
      | "option" -> concat(attribs,["label","value"]);
      | "optgroup" -> concat(attribs,["label"]);
      | default -> ;
    }
    add(wl,name,attribs);
  }
  case wconf of {
    InlineOnly(s) -> return wl;
    | default -> ;
  }

  safeblock = ["p","pre","div","ol","li","ul","dl","dd","dt","h1","h2","h3","h4","h5","h6","address","blockquote","table","tr","td","th","tbody","tfoot","thead","caption","hr","col","colgroup"];
  case getSafety(wconf) of {
    VeryUnsafe -> concat(safeblock,["form","fieldset","legend"]);
    | default -> ;
  } 

  for name in safeblock {
    attribs = genericAttribs();
    case getSafety(wconf) of {
      Safe -> ;
      | default -> concat(attribs,["style"]);
    }
    case name of {
      "form" -> concat(attribs,["action","method"]);
      | "td" -> concat(attribs,["colspan","rowspan","headers"]);
      | "th" -> concat(attribs,["colspan","rowspan","scope"]);
      | default -> ;
    }
    add(wl,name,attribs);
  }
  return wl;
}