[ prolog-encoding ]
[ drop utf8 decode-input ] if ;
-: something ( -- )
+: go-utf8 ( -- )
check utf8 decode-input next next ;
: start< ( -- tag )
! What if first letter of processing instruction is non-ASCII?
get-next {
{ 0 [ next next start-utf16le ] }
- { CHAR: ? [ something instruct dup instruct-encoding ] }
- { CHAR: ! [ something direct ] }
+ { CHAR: ? [ go-utf8 instruct dup instruct-encoding ] }
+ { CHAR: ! [ go-utf8 direct ] }
[ check start<name ]
} case ;
HELP: <xml>
{ $values { "prolog" "an XML prolog" } { "before" "a sequence of XML elements" }
{ "body" tag } { "after" "a sequence of XML elements" } { "xml" "an XML document" } }
-{ $description "creates an XML document, delegating to the main tag, with the specified prolog, before, and after" }
+{ $description "Creates an XML document. The " { $snippet "before" } " and " { $snippet "after" } " slots store what comes before and after the main tag, and " { $snippet "body" } "contains the main tag itself." }
{ $see-also xml <tag> } ;
HELP: prolog
HELP: <prolog>
{ $values { "version" "a string, 1.0 or 1.1" }
{ "encoding" "a string" } { "standalone" "a boolean" } { "prolog" "an XML prolog" } }
-{ $description "creates an XML prolog tuple" }
+{ $description "Creates an XML prolog tuple." }
{ $see-also prolog <xml> } ;
HELP: comment
-{ $class-description "represents a comment in XML. Has one slot, text, which contains the string of the comment" }
+{ $class-description "Represents a comment in XML. This tuple has one slot, " { $snippet "text" } ", which contains the string of the comment." }
{ $see-also <comment> } ;
HELP: <comment>
-{ $values { "text" "a string" } { "comment" "a comment" } }
-{ $description "creates an XML comment tuple" }
+{ $values { "text" string } { "comment" comment } }
+{ $description "Creates an XML " { $link comment } " tuple." }
{ $see-also comment } ;
HELP: instruction
-{ $class-description "represents an XML instruction, such as <?xsl stylesheet='foo.xml'?>. Contains one slot, text, which contains the string between the question marks." }
+{ $class-description "Represents an XML instruction, such as " { $snippet "<?xsl stylesheet='foo.xml'?>" } ". Contains one slot, " { $snippet "text" } ", which contains the string between the question marks." }
{ $see-also <instruction> } ;
HELP: <instruction>
{ $values { "text" "a string" } { "instruction" "an XML instruction" } }
-{ $description "creates an XML parsing instruction, such as <?xsl stylesheet='foo.xml'?>." }
+{ $description "Creates an XML parsing instruction, like " { $snippet "<?xsl stylesheet='foo.xml'?>" } "." }
{ $see-also instruction } ;
HELP: opener
-{ $class-description "describes an opening tag, like <a>. Contains two slots, name and attrs containing, respectively, the name of the tag and its attributes. Usually, the name-url will be f." }
-{ $see-also closer contained } ;
+{ $class-description "Describes an opening tag, like " { $snippet "<a>" } ". Contains two slots, " { $snippet "name" } " and " { $snippet "attrs" } " containing, respectively, the name of the tag and its attributes." } ;
HELP: closer
-{ $class-description "describes a closing tag, like </a>. Contains one slot, name, containing the tag's name. Usually, the name-url will be f." }
-{ $see-also opener contained } ;
+{ $class-description "Describes a closing tag, like " { $snippet "</a>" } ". Contains one slot, " { $snippet "name" } ", containing the closer's name." } ;
HELP: contained
-{ $class-description "represents a self-closing tag, like <a/>. Contains two slots, name and attrs containing, respectively, the name of the tag and its attributes. Usually, the name-url will be f." }
-{ $see-also opener closer } ;
+{ $class-description "Represents a self-closing tag, like " { $snippet "<a/>" } ". Contains two slots," { $snippet "name" } " and " { $snippet "attrs" } " containing, respectively, the name of the tag and its attributes." } ;
+
+{ opener closer contained } related-words
HELP: open-tag
-{ $class-description "represents a tag that does have children, ie is not a contained tag" }
-{ $notes "the constructor used for this class is simply " { $link <tag> } "." }
+{ $class-description "Represents a tag that does have children, ie. is not a contained tag" }
+{ $notes "The constructor used for this class is simply " { $link <tag> } "." }
{ $see-also tag contained-tag } ;
HELP: names-match?
{ $values { "name1" "a name" } { "name2" "a name" } { "?" "t or f" } }
-{ $description "checks to see if the two names match, that is, if all fields are equal, ignoring fields whose value is f in either name." }
+{ $description "Checks to see if the two names match, that is, if all fields are equal, ignoring fields whose value is f in either name." }
{ $example "USING: prettyprint xml.data ;" "T{ name f \"rpc\" \"methodCall\" f } T{ name f f \"methodCall\" \"http://www.xmlrpc.org/\" } names-match? ." "t" }
{ $see-also name } ;
{ $description "Creates an entity declaration object, of the class " { $link entity-decl } ". The pe? slot should be t if the object is a DTD-internal entity, like " { $snippet "<!ENTITY % foo 'bar'>" } " and f if the object is like " { $snippet "<!ENTITY foo 'bar'>" } ", that is, it can be used outside of the DTD." } ;
HELP: system-id
-{ $class-description "Describes the class of system identifiers within an XML DTD directive, such as " { $snippet "<!DOCTYPE greeting " { $emphasis "SYSTEM 'hello.dtd'" } ">" } } ;
+{ $class-description "Describes the class of system identifiers within an XML DTD directive, such as " { $snippet "<!DOCTYPE greeting " { $emphasis "SYSTEM 'hello.dtd'" } ">" } "." } ;
HELP: <system-id>
{ $values { "system-literal" string } { "system-id" system-id } }
"For entities used in HTML/XHTML, see " { $vocab-link "xml.entities.html" } ;
HELP: entities
-{ $description "a hash table from default XML entity names (like & and <) to the characters they represent. This is automatically included when parsing any XML document." }
+{ $description "A hash table from default XML entity names (like " { $snippet "&" } " and " { $snippet "<" } ") to the characters they represent. This is automatically included when parsing any XML document." }
{ $see-also with-entities } ;
HELP: with-entities
-{ $values { "entities" "a hash table of strings to chars" }
- { "quot" "a quotation ( -- )" } }
-{ $description "calls the quotation using the given table of entity values (symbolizing, eg, that &foo; represents CHAR: a) on top of the default XML entities" } ;
+{ $values { "entities" "a hash table of strings to strings" } { "quot" "a quotation ( -- )" } }
+{ $description "Calls the quotation using the given table of entity values (symbolizing, eg, that " { $snippet "&foo;" } " represents " { $snippet "\"a\"" } ") on top of the default XML entities" } ;
ARTICLE: "xml.entities.html" "HTML entities"
{ $vocab-link "xml.entities.html" } " defines words for using entities defined in HTML/XHTML."
- { $subsection html-entities }
- { $subsection with-html-entities } ;
+{ $subsection html-entities }
+{ $subsection with-html-entities } ;
HELP: html-entities
-{ $description "a hash table from HTML entity names to their character values" }
+{ $description "A hash table from HTML entity names to their character values." }
{ $see-also entities with-html-entities } ;
HELP: with-html-entities
{ $values { "quot" "a quotation ( -- )" } }
-{ $description "calls the given quotation using HTML entity values" }
+{ $description "Calls the given quotation using HTML entity values." }
{ $see-also html-entities with-entities } ;
USING: help.markup help.syntax ;
IN: xml.errors
+<PRIVATE
+
+: $xml-error ( element -- )
+ "Bad XML document for the error" $heading $code ;
+
+PRIVATE>
+
HELP: multitags
-{ $class-description "XML parsing error describing the case where there is more than one main tag in a document. Contains no slots" } ;
+{ $class-description "XML parsing error describing the case where there is more than one main tag in a document." }
+{ $xml-error "<a/>\n<b/>" } ;
HELP: notags
-{ $class-description "XML parsing error describing the case where an XML document contains no main tag, or any tags at all" } ;
+{ $class-description "XML parsing error describing the case where an XML document contains no main tag, or any tags at all" }
+{ $xml-error "<?xml version='1.0'?>" } ;
HELP: extra-attrs
-{ $class-description "XML parsing error describing the case where the XML prolog (" { $snippet "<?xml ...?>" } ") contains attributes other than the three allowed ones, standalone, version and encoding. Contains one slot, attrs, which is a hashtable of all the extra attributes' names. Delegates to " { $link xml-error-at } "." } ;
+{ $class-description "XML parsing error describing the case where the XML prolog (" { $snippet "<?xml ...?>" } ") contains attributes other than the three allowed ones, " { $snippet "standalone" } ", " { $snippet "version" } " and " { $snippet "encoding" } ". Contains one slot, " { $snippet "attrs" } ", which is a hashtable of all the extra attributes' names. This is a subclass of " { $link xml-error-at } "." }
+{ $xml-error "<?xml version='1.0' reason='because I said so'?>\n<foo/>" } ;
HELP: nonexist-ns
-{ $class-description "XML parsing error describing the case where a namespace doesn't exist but it is used in a tag. Contains one slot, name, which contains the name of the undeclared namespace, and delegates to " { $link xml-error-at } "." } ;
+{ $class-description "XML parsing error describing the case where a namespace doesn't exist but it is used in a tag. Contains one slot, " { $snippet "name" } ", which contains the name of the undeclared namespace, and is a subclass of " { $link xml-error-at } "." }
+{ $xml-error "<a:b>c</a:b>" } ;
HELP: not-yes/no
-{ $class-description "XML parsing error used to describe the case where standalone is set in the XML prolog to something other than 'yes' or 'no'. Delegates to " { $link xml-error-at } " and contains one slot, text, which contains offending value." } ;
+{ $class-description "XML parsing error used to describe the case where standalone is set in the XML prolog to something other than " { $snippet "yes" } " or " { $snippet "no" } ". This is a subclass of " { $link xml-error-at } " and contains one slot, text, which contains offending value." }
+{ $xml-error "<?xml version='1.0' standalone='maybe'?>\n<x/>" } ;
HELP: unclosed
-{ $class-description "XML parsing error used to describe the case where the XML document contains classes which are not closed by the end of the document. Contains one slot, tags, a sequence of names." } ;
+{ $class-description "XML parsing error used to describe the case where the XML document contains classes which are not closed by the end of the document. Contains one slot, " { $snippet "tags" } ", a sequence of names." }
+{ $xml-error "<x>some text" } ;
HELP: mismatched
-{ $class-description "XML parsing error describing mismatched tags, eg " { $snippet "<a></c>" } ". Contains two slots: open is the name of the opening tag and close is the name of the closing tag. Delegates to " { $link xml-error-at } " showing the location of the closing tag" } ;
+{ $class-description "XML parsing error describing mismatched tags. Contains two slots: " { $snippet "open" } " is the name of the opening tag and " { $snippet "close" } " is the name of the closing tag. This is a subclass of " { $link xml-error-at } " showing the location of the closing tag" }
+{ $xml-error "<a></c>" } ;
HELP: expected
-{ $class-description "XML parsing error describing when an expected token was not present. Delegates to " { $link xml-error-at } ". Contains two slots, should-be, which has the expected string, and was, which has the actual string." } ;
+{ $class-description "XML parsing error describing when an expected token was not present. Delegates to " { $link xml-error-at } ". Contains two slots, " { $snippet "should-be" } ", which has the expected string, and " { $snippet "was" } ", which has the actual string." } ;
HELP: no-entity
-{ $class-description "XML parsing error describing the use of an undefined entity in a case where standalone is marked yes. Delegates to " { $link xml-error-at } ". Contains one slot, thing, containing a string representing the entity." } ;
+{ $class-description "XML parsing error describing the use of an undefined entity. This is a subclass of " { $link xml-error-at } ". Contains one slot, thing, containing a string representing the entity." }
+{ $xml-error "<x>&foo;</x>" } ;
HELP: pre/post-content
-{ $class-description "Describes the error where a non-whitespace string is used before or after the main tag in an XML document. Contains two slots: string contains the offending string, and pre? is t if it occured before the main tag and f if it occured after" } ;
-
-HELP: unclosed-quote
-{ $class-description "Describes the error where a quotation for an attribute value is opened but not closed before the end of the document." } ;
+{ $class-description "Describes the error where a non-whitespace string is used before or after the main tag in an XML document. Contains two slots: " { $snippet "string" } " contains the offending string, and " { $snippet "pre?" } " is " { $snippet "t" } " if it occured before the main tag and " { $snippet "f" } " if it occured after." }
+{ $xml-error "hello\n<main-tag/>" } ;
HELP: bad-name
-{ $class-description "Describes the error where a name is used, for example in an XML tag or attribute key, which is invalid." } ;
+{ $class-description "Describes the error where a name is used, for example in an XML tag or attribute key, which is invalid." }
+{ $xml-error "<%>\n</%>" } ;
HELP: quoteless-attr
-{ $class-description "Describes the error where an attribute of an XML tag is missing quotes around a value." } ;
+{ $class-description "Describes the error where an attribute of an XML tag is missing quotes around a value." }
+{ $xml-error "<tag foo=bar/>" } ;
HELP: disallowed-char
{ $class-description "Describes the error where a disallowed character occurs in an XML document." } ;
{ $class-description "Describes the error where a document unexpectedly ends, and the XML parser expected it to continue." } ;
HELP: duplicate-attr
-{ $class-description "Describes the error where there is more than one attribute of the same key." } ;
+{ $class-description "Describes the error where there is more than one attribute of the same key." }
+{ $xml-error "<tag value='1' value='2'/>" } ;
HELP: bad-cdata
-{ $class-description "Describes the error where CDATA is used outside of the main tag of an XML document." } ;
+{ $class-description "Describes the error where CDATA is used outside of the main tag of an XML document." }
+{ $xml-error "<x>y</x>\n<![CDATA[]]>" } ;
HELP: text-w/]]>
-{ $class-description "Describes the error where a text node contains the literal string " { $snippet "]]>" } " which is disallowed." } ;
+{ $class-description "Describes the error where a text node contains the literal string " { $snippet "]]>" } " which is disallowed." }
+{ $xml-error "<x>Here's some text: ]]> there it was</x>" } ;
HELP: attr-w/<
-{ $class-description "Describes the error where an attribute value contains the literal character " { $snippet "<" } " which is disallowed." } ;
+{ $class-description "Describes the error where an attribute value contains the literal character " { $snippet "<" } " which is disallowed." }
+{ $xml-error "<x value='bar<baz'/>" } ;
HELP: misplaced-directive
-{ $class-description "Describes the error where an internal DTD directive is used outside of a DOCTYPE or DTD file, or where a DOCTYPE occurs somewhere other than before the main tag of an XML document." } ;
+{ $class-description "Describes the error where an internal DTD directive is used outside of a DOCTYPE or DTD file, or where a DOCTYPE occurs somewhere other than before the main tag of an XML document." }
+{ $xml-error "<x><!ENTITY foo 'bar'></x>" } ;
HELP: xml-error
{ $class-description "The exception class that all parsing errors in XML documents are in." } ;
ARTICLE: "xml.errors" "XML parsing errors"
-"The " { $vocab-link "xml.errors" } " vocabulary provides a rich and highly inspectable set of parsing errors. All XML errors are described by the union class " { $link xml-error } " but there are many classes contained in that:"
+"The " { $vocab-link "xml.errors" } " vocabulary provides a rich and highly inspectable set of parsing errors. All XML errors are described by the union class " { $link xml-error } "."
{ $subsection multitags }
{ $subsection notags }
{ $subsection extra-attrs }
{ $subsection text-w/]]> }
{ $subsection attr-w/< }
{ $subsection misplaced-directive }
- "Additionally, most of these errors are a kind of " { $link xml-error-at } " which provides more information"
+ "Additionally, most of these errors are a kind of " { $link xml-error-at } " which provides more information about where the error occurred."
$nl
"Note that, in parsing an XML document, only the first error is reported." ;
\r
HELP: read-xml-chunk\r
{ $values { "stream" "an input stream" } { "seq" "a sequence of elements" } }\r
-{ $description "Rather than parse a document, as " { $link read-xml } " does, this word parses and returns a sequence of XML elements (tags, strings, etc), ie a document fragment. This is useful for pieces of XML which may have more than one main tag." }\r
+{ $description "Rather than parse a document, as " { $link read-xml } " does, this word parses and returns a sequence of XML elements (tags, strings, etc), ie a document fragment. This is useful for pieces of XML which may have more than one main tag. The encoding is not automatically detected, and a stream with an encoding (ie. one which returns strings from " { $link read } ") should be used as input." }\r
{ $see-also read-xml } ;\r
\r
HELP: each-element\r
{ $values { "stream" "an input stream" } { "quot" "a quotation ( xml-elem -- )" } }\r
-{ $description "Parses the XML document, and whenever an event is encountered (a tag piece, comment, parsing instruction, directive or string element), the quotation is called with that event on the stack. The quotation has all responsibility to deal with the event properly, and it is advised that generic words be used in dispatching on the event class." }\r
-{ $notes "It is important to note that this is not SAX, merely an event-based XML view" }\r
+{ $description "Parses the XML document, and whenever an event is encountered (a tag piece, comment, parsing instruction, directive or string element), the quotation is called with that event on the stack. The quotation has all responsibility to deal with the event properly. The encoding of the stream is automatically detected, so a binary input stream should be used." }\r
{ $see-also read-xml } ;\r
\r
HELP: pull-xml\r
-{ $class-description "Represents the state of a pull-parser for XML. Has one slot, scope, which is a namespace which contains all relevant state information." }\r
+{ $class-description "Represents the state of a pull-parser for XML. Has one slot, " { $snippet "scope" } ", which is a namespace which contains all relevant state information." }\r
{ $see-also <pull-xml> pull-event pull-elem } ;\r
\r
HELP: <pull-xml>\r
-{ $values { "pull-xml" "a pull-xml tuple" } }\r
+{ $values { "pull-xml" pull-xml } }\r
{ $description "Creates an XML pull-based parser which reads from " { $link input-stream } ", executing all initial XML commands to set up the parser." }\r
{ $see-also pull-xml pull-elem pull-event } ;\r
\r
{ $subsection pull-elem } ;\r
\r
ARTICLE: "xml" "XML parser"\r
-"The " { $vocab-link "xml" } " vocabulary implements the XML 1.0 and 1.1 standards, converting strings of text into XML and vice versa."\r
+"The " { $vocab-link "xml" } " vocabulary implements the XML 1.0 and 1.1 standards, converting strings of text into XML and vice versa. The parser checks for well-formedness but is not validating. There is only partial support for processing DTDs."\r
{ $subsection { "xml" "reading" } }\r
{ $subsection { "xml" "events" } }\r
{ $vocab-subsection "Writing XML" "xml.writer" }\r
USING: accessors arrays io io.encodings.binary io.files
io.streams.string kernel namespaces sequences strings io.encodings.utf8
xml.data xml.errors xml.elements ascii xml.entities
-xml.writer xml.state xml.autoencoding assocs xml.tokenize xml.name ;
+xml.writer xml.state xml.autoencoding assocs xml.tokenize
+combinators.short-circuit xml.name ;
IN: xml
<PRIVATE
M: object process add-child ;
M: prolog process
- xml-stack get { V{ { f V{ "" } } } V{ { f V{ } } } } member?
+ xml-stack get
+ { V{ { f V{ "" } } } V{ { f V{ } } } } member?
[ bad-prolog ] unless drop ;
+: before-main? ( -- ? )
+ xml-stack get {
+ [ length 1 = ]
+ [ first second [ tag? ] contains? not ]
+ } 1&& ;
+
M: directive process
- xml-stack get dup length 1 =
- swap first second [ tag? ] contains? not and
- [ misplaced-directive ] unless
- add-child ;
+ before-main? [ misplaced-directive ] unless add-child ;
M: contained process
[ name>> ] [ attrs>> ] bi
projects / factor.git / commitdiff