=
=
" ] [ "=foo==" convert-farkup ] unit-test -[ "int main()\n" ] +[ "
int main()" ] [ "[c{int main()}]" convert-farkup ] unit-test -[ "
![](\"lol.jpg\"/)
![\"teh](\"lol.jpg\")
hello\n" ] [ "[{hello}]" convert-farkup ] unit-test +[ "
hello" ] [ "[{hello}]" convert-farkup ] unit-test [ "
Feature comparison:\n
| a | Factor | Java | Lisp |
| Coolness | Yes | No | No |
| Badass | Yes | No | No |
| Enterprise | Yes | Yes | No |
| Kosher | Yes | No | Yes |
This wiki is written in Factor and is hosted on a http://linode.com virtual server.
" + "This wiki is written in Factor and is hosted on a http://linode.com virtual server.
" ] [ "This wiki is written in [[Factor]] and is hosted on a [[http://linode.com|http://linode.com]] virtual server." convert-farkup ] unit-test -[ "" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test +[ "" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test -[ "" ] [ "[[C++]]" convert-farkup ] unit-test +[ "" ] [ "[[C++]]" convert-farkup ] unit-test [ "<foo>
" ] [ "before:\n
{ 1 2 3 } 1 tail\n" ] +[ "
before:\n
{ 1 2 3 } 1 tail" ] [ "before:\n[factor{{ 1 2 3 } 1 tail}]" convert-farkup ] unit-test -[ "
Factor-rific!
" ] +[ "Factor-rific!
" ] [ "[[Factor]]-rific!" convert-farkup ] unit-test [ "[ factor { 1 2 3 }]
" ] @@ -163,7 +163,7 @@ link-no-follow? off convert-farkup string>xml-chunk "a" deep-tag-named "href" swap at url-decode ; -[ "Trader Joe's" ] [ "[[Trader Joe's]]" check-link-escaping ] unit-test +[ "Trader Joe\"s" ] [ "[[Trader Joe\"s]]" check-link-escaping ] unit-test [ "- htmlize-lines -- ] with-string-writer write ; +: render-code ( string mode -- xml ) + [ string-lines ] dip htmlize-lines + [XML
<->XML] ; -GENERIC: (write-farkup) ( farkup -- ) -:
"mode" >>mode render ] with-string-writer
] unit-test
@@ -163,6 +163,8 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ;
[ t ] [
[ "object" inspector render ] with-string-writer
+ USING: splitting sequences ;
+ "\"" split "'" join ! replace " with ' for now
[ "object" value [ describe ] with-html-writer ] with-string-writer
=
] unit-test
diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor
index 6f35ba5d97..c8a4b20ca7 100644
--- a/basis/html/components/components.factor
+++ b/basis/html/components/components.factor
@@ -4,12 +4,12 @@ USING: accessors kernel namespaces io math.parser assocs classes
classes.tuple words arrays sequences splitting mirrors
hashtables combinators continuations math strings inspector
fry locals calendar calendar.format xml.entities
-validators urls present
-xmode.code2html lcs.diff2html farkup
+validators urls present xml.writer xml.interpolate xml
+xmode.code2html lcs.diff2html farkup io.streams.string
html.elements html.streams html.forms ;
IN: html.components
-GENERIC: render* ( value name renderer -- )
+GENERIC: render* ( value name renderer -- xml )
: render ( name renderer -- )
prepare-value
@@ -19,38 +19,36 @@ GENERIC: render* ( value name renderer -- )
[ f swap ]
if
] 2dip
- render*
+ render* write-xml-chunk
[ render-error ] when* ;
( -- field )
field new ;
-M: field render* size>> "text" render-field ;
+M: field render*
+ size>> "text" render-field ;
TUPLE: password size ;
@@ -67,14 +65,12 @@ TUPLE: textarea rows cols ;
: ;
+M: textarea render* ( value name area -- xml )
+ rot [ [ rows>> ] [ cols>> ] bi ] dip
+ [XML XML] ;
! Choice
TUPLE: choice size multiple choices ;
@@ -82,24 +78,23 @@ TUPLE: choice size multiple choices ;
: ( -- choice )
choice new ;
-: render-option ( text selected? -- )
- ;
+: render-option ( text selected? -- xml )
+ "selected" and swap
+ [XML XML] ;
-: render-options ( options selected -- )
- '[ dup _ member? render-option ] each ;
+: render-options ( value choice -- xml )
+ [ choices>> value ] [ multiple>> ] bi
+ [ swap ] [ swap 1array ] if
+ '[ dup _ member? render-option ] map ;
-M: choice render*
- ;
+M:: choice render* ( value name choice -- xml )
+ choice size>> :> size
+ choice multiple>> "true" and :> multiple
+ value choice render-options :> contents
+ [XML XML] ;
! Checkboxes
TUPLE: checkbox label ;
@@ -108,13 +103,10 @@ TUPLE: checkbox label ;
checkbox new ;
M: checkbox render*
-
- label>> escape-string write
- ;
+ [ "true" and ] [ ] [ label>> ] tri*
+ [XML name=<->><-> XML] ;
! Link components
GENERIC: link-title ( obj -- string )
@@ -129,10 +121,9 @@ M: url link-href ;
TUPLE: link target ;
M: link render*
- nip
- > [ =target ] when* dup link-href =href a>
- link-title present escape-string write
- ;
+ nip swap
+ [ target>> ] [ [ link-href ] [ link-title ] bi ] bi*
+ [XML href=<->><-> XML] ;
! XMode code component
TUPLE: code mode ;
@@ -161,7 +152,7 @@ M: farkup render*
nip
[ no-follow>> [ string>boolean link-no-follow? set ] when* ]
[ disable-images>> [ string>boolean disable-images? set ] when* ]
- [ parsed>> string>boolean [ (write-farkup) ] [ write-farkup ] if ]
+ [ parsed>> string>boolean [ (write-farkup) ] [ farkup>xml ] if ]
tri
] with-scope ;
@@ -169,7 +160,8 @@ M: farkup render*
SINGLETON: inspector
M: inspector render*
- 2drop [ describe ] with-html-writer ;
+ 2drop [ [ describe ] with-html-writer ] with-string-writer
+ string>xml-chunk ;
! Diff component
SINGLETON: comparison
@@ -180,4 +172,4 @@ M: comparison render*
! HTML component
SINGLETON: html
-M: html render* 2drop write ;
+M: html render* 2drop string>xml-chunk ;
diff --git a/basis/io/backend/windows/windows.factor b/basis/io/backend/windows/windows.factor
index bf01f1d621..6ecbc49f2a 100755
--- a/basis/io/backend/windows/windows.factor
+++ b/basis/io/backend/windows/windows.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays destructors io io.backend io.buffers
-io.files io.ports io.binary io.timeouts io.encodings.8-bit
+USING: alien alien.c-types arrays destructors io io.backend
+io.buffers io.files io.ports io.binary io.timeouts
windows.errors strings kernel math namespaces sequences windows
windows.kernel32 windows.shell32 windows.types windows.winsock
splitting continuations math.bitwise system accessors ;
@@ -51,6 +51,4 @@ HOOK: add-completion io-backend ( port -- )
: default-security-attributes ( -- obj )
"SECURITY_ATTRIBUTES"
"SECURITY_ATTRIBUTES" heap-size
- over set-SECURITY_ATTRIBUTES-nLength ;
-
-M: windows console-encoding windows-1252 ;
\ No newline at end of file
+ over set-SECURITY_ATTRIBUTES-nLength ;
\ No newline at end of file
diff --git a/basis/lcs/diff2html/diff2html.factor b/basis/lcs/diff2html/diff2html.factor
index ebbb0f3786..ee303cc5a5 100644
--- a/basis/lcs/diff2html/diff2html.factor
+++ b/basis/lcs/diff2html/diff2html.factor
@@ -1,44 +1,42 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: lcs html.elements kernel ;
+USING: lcs xml.interpolate xml.writer kernel strings ;
FROM: accessors => item>> ;
FROM: io => write ;
-FROM: sequences => each if-empty ;
-FROM: xml.entities => escape-string ;
+FROM: sequences => each if-empty when-empty map ;
IN: lcs.diff2html
-GENERIC: diff-line ( obj -- )
+GENERIC: diff-line ( obj -- xml )
-: write-item ( item -- )
- item>> [ " " ] [ escape-string ] if-empty write ;
+: item-string ( item -- string )
+ item>> [ CHAR: no-break-space 1string ] when-empty ;
M: retain diff-line
-
- dup [
-
- write-item
-
- ] bi@
- ;
+ item-string
+ [XML <-> XML]
+ dup [XML <-><-> XML] ;
M: insert diff-line
-
-
-
- write-item
-
- ;
+ item-string [XML
+
+
+ <->
+
+ XML] ;
M: delete diff-line
-
-
- write-item
-
-
- ;
+ item-string [XML
+
+ <->
+
+
+ XML] ;
-: htmlize-diff ( diff -- )
-
- "Old" write "New" write
- [ diff-line ] each
-
;
+: htmlize-diff ( diff -- xml )
+ [ diff-line ] map
+ [XML
+
+ Old New
+ XML] ;
diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor
index 8092d11e4a..efaad748cf 100644
--- a/basis/locals/locals-docs.factor
+++ b/basis/locals/locals-docs.factor
@@ -134,6 +134,7 @@ $nl
}
"In a word with locals, literals expand into code which constructs the literal, and so every invocation pushes a new object:"
{ $example
+ "USE: locals"
"IN: scratchpad"
"TUPLE: person first-name last-name ;"
":: ordinary-word-test ( -- tuple )"
diff --git a/basis/math/complex/complex-docs.factor b/basis/math/complex/complex-docs.factor
index bed3a655b1..1fcc1ead13 100644
--- a/basis/math/complex/complex-docs.factor
+++ b/basis/math/complex/complex-docs.factor
@@ -6,7 +6,7 @@ ARTICLE: "complex-numbers-zero" "Embedding of real numbers in complex numbers"
"Constructing a complex number with an imaginary component equal to an integer zero simply returns the real number corresponding to the real component:"
{ $example "USING: math prettyprint ;" "C{ 1 2 } C{ 3 -2 } + ." "4" }
"Constructing a complex number with an imaginary component equal to floating point zero will still output a new complex number, however:"
-{ $example "USING: math prettyprint ;" "C{ 0.0 2.0 } C{ 0.0 1.0 } * ." "C{ 2.0 0.0 }" }
+{ $example "USING: math prettyprint ;" "C{ 0.0 2.0 } C{ 0.0 1.0 } * ." "C{ -2.0 0.0 }" }
"Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero." ;
ARTICLE: "complex-numbers" "Complex numbers"
diff --git a/basis/math/libm/libm-docs.factor b/basis/math/libm/libm-docs.factor
index 1fe565ee00..72c114487b 100644
--- a/basis/math/libm/libm-docs.factor
+++ b/basis/math/libm/libm-docs.factor
@@ -5,8 +5,8 @@ ARTICLE: "math.libm" "C standard library math functions"
"The words in the " { $vocab-link "math.libm" } " vocabulary call C standard library math functions. They are used to implement words in the " { $vocab-link "math.functions" } " vocabulary."
$nl
"They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
-{ $example "2 acos ." "C{ 0.0 1.316957896924817 }" }
-{ $example "2 facos ." "0.0/0.0" }
+{ $example "USE: math.functions" "2 acos ." "C{ 0.0 1.316957896924817 }" }
+{ $example "USE: math.libm" "2 facos ." "0.0/0.0" }
"Trigonometric functions:"
{ $subsection fcos }
{ $subsection fsin }
diff --git a/basis/stack-checker/stack-checker-docs.factor b/basis/stack-checker/stack-checker-docs.factor
index f208178b10..5b67cd9adc 100644
--- a/basis/stack-checker/stack-checker-docs.factor
+++ b/basis/stack-checker/stack-checker-docs.factor
@@ -21,7 +21,7 @@ $nl
ARTICLE: "inference-combinators" "Combinator stack effects"
"Without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the inferencer encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised."
-{ $example "[ dup call ] infer." "... an error ..." }
+{ $example "[ dup call ] infer." "Literal value expected\n\nType :help for debugging help." }
"On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point:"
{ $example "[ [ 2 + ] call ] infer." "( object -- object )" }
"Consider a combinator such as " { $link keep } ". The combinator itself does not have a stack effect, because it applies " { $link call } " to a potentially arbitrary quotation. However, since the combinator is declared " { $link POSTPONE: inline } ", a given usage of it can have a stack effect:"
@@ -35,7 +35,15 @@ $nl
"Here is an example where the stack effect cannot be inferred:"
{ $code ": foo 0 [ + ] ;" "[ foo reduce ] infer." }
"However if " { $snippet "foo" } " was declared " { $link POSTPONE: inline } ", everything would work, since the " { $link reduce } " combinator is also " { $link POSTPONE: inline } ", and the inferencer can see the literal quotation value at the point it is passed to " { $link call } ":"
-{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" } ;
+{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" }
+"Passing a literal quotation on the data stack through an inlined recursive combinator nullifies its literal status. For example, the following will not infer:"
+{ $example
+ "[ [ reverse ] swap [ reverse ] map swap call ] infer." "Literal value expected\n\nType :help for debugging help."
+}
+"To make this work, pass the quotation on the retain stack instead:"
+{ $example
+ "[ [ reverse ] [ [ reverse ] map ] dip call ] infer." "( object -- object )"
+} ;
ARTICLE: "inference-branches" "Branch stack effects"
"Conditionals such as " { $link if } " and combinators built on " { $link if } " present a problem, in that if the two branches leave the stack at a different height, it is not clear what the stack effect should be. In this case, inference throws a " { $link unbalanced-branches-error } "."
@@ -58,12 +66,14 @@ $nl
$nl
"If a recursive word takes quotation parameters from the stack and calls them, it must be declared " { $link POSTPONE: inline } " (as documented in " { $link "inference-combinators" } ") as well as " { $link POSTPONE: recursive } "."
$nl
-"Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example,"
-{ $see loop }
-"An inline recursive word cannot pass a quotation through the recursive call. For example, the following will not infer:"
-{ $code ": foo ( a b c -- d e f ) [ f foo drop ] when 2dup call ; inline" "[ 1 [ 1+ ] foo ] infer." }
+"Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example, the following will not infer:"
+{ $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Literal value expected\n\nType :help for debugging help." }
+"The following is correct:"
+{ $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" }
+"An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:"
+{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Literal value expected\n\nType :help for debugging help." }
"However a small change can be made:"
-{ $example ": foo ( a b c -- d ) [ 2dup f foo drop ] when call ; inline" "[ 1 [ 1+ ] t foo ] infer." "( -- object )" }
+{ $example ": good ( ? quot: ( ? -- ) -- ) [ good ] 2keep [ not ] dip call ; inline recursive" "[ [ drop ] good ] infer." "( object -- )" }
"An inline recursive word must have a fixed stack effect in its base case. The following will not infer:"
{ $code
": foo ( quot ? -- ) [ f foo ] [ call ] if ; inline"
diff --git a/basis/xml-rpc/xml-rpc.factor b/basis/xml-rpc/xml-rpc.factor
index 602fb90172..d2fd111b39 100644
--- a/basis/xml-rpc/xml-rpc.factor
+++ b/basis/xml-rpc/xml-rpc.factor
@@ -3,7 +3,7 @@
USING: accessors kernel xml arrays math generic http.client
combinators hashtables namespaces io base64 sequences strings
calendar xml.data xml.writer xml.utilities assocs math.parser
-debugger calendar.format math.order ;
+debugger calendar.format math.order xml.interpolate ;
IN: xml-rpc
! * Sending RPC requests
@@ -15,56 +15,70 @@ GENERIC: item>xml ( object -- xml )
M: integer item>xml
dup 31 2^ neg 31 2^ 1 - between?
[ "Integers must fit in 32 bits" throw ] unless
- number>string "i4" build-tag ;
+ number>string [XML <-> XML] ;
UNION: boolean t POSTPONE: f ;
M: boolean item>xml
- "1" "0" ? "boolean" build-tag ;
+ "1" "0" ? [XML <-> XML] ;
M: float item>xml
- number>string "double" build-tag ;
+ number>string [XML <-> XML] ;
-M: string item>xml ! This should change < and &
- "string" build-tag ;
+M: string item>xml
+ [XML <-> XML] ;
: struct-member ( name value -- tag )
- swap dup string?
- [ "Struct member name must be string" throw ] unless
- "name" build-tag swap
- item>xml "value" build-tag
- 2array "member" build-tag* ;
+ over string? [ "Struct member name must be string" throw ] unless
+ item>xml
+ [XML
+
+ <->
+ <->
+
+ XML] ;
M: hashtable item>xml
[ struct-member ] { } assoc>map
- "struct" build-tag* ;
+ [XML <-> XML] ;
M: array item>xml
- [ item>xml "value" build-tag ] map
- "data" build-tag* "array" build-tag ;
+ [ item>xml [XML <-> XML] ] map
+ [XML <-> XML] ;
TUPLE: base64 string ;
C: base64
M: base64 item>xml
- string>> >base64 "base64" build-tag ;
+ string>> >base64
+ [XML <-> XML] ;
: params ( seq -- xml )
- [ item>xml "value" build-tag "param" build-tag ] map
- "params" build-tag* ;
+ [ item>xml [XML <-> XML] ] map
+ [XML <-> XML] ;
: method-call ( name seq -- xml )
- params [ "methodName" build-tag ] dip
- 2array "methodCall" build-tag* build-xml ;
+ params
+
+ <->
+ <->
+
+ XML> ;
: return-params ( seq -- xml )
- params "methodResponse" build-tag build-xml ;
+ params <-> XML> ;
: return-fault ( fault-code fault-string -- xml )
[ "faultString" set "faultCode" set ] H{ } make-assoc item>xml
- "value" build-tag "fault" build-tag "methodResponse" build-tag
- build-xml ;
+
+
+ <->
+
+
+ XML> ;
TUPLE: rpc-method name params ;
diff --git a/basis/xml/data/data-docs.factor b/basis/xml/data/data-docs.factor
index 9a8c535f91..52394ccc5c 100644
--- a/basis/xml/data/data-docs.factor
+++ b/basis/xml/data/data-docs.factor
@@ -4,7 +4,7 @@ IN: xml.data
ABOUT: "xml.data"
ARTICLE: "xml.data" "XML data types"
-{ $vocab-link "xml.data" } " defines a simple document object model for XML. Everything is simply a tuple and can be manipulated as such."
+"The " { $vocab-link "xml.data" } " vocabulary defines a simple document object model for XML. Everything is simply a tuple and can be manipulated as such."
{ $subsection { "xml.data" "classes" } }
{ $subsection { "xml.data" "constructors" } }
"Simple words for manipulating names:"
@@ -49,7 +49,7 @@ ARTICLE: { "xml.data" "constructors" } "XML data constructors"
{ $subsection } ;
HELP: tag
-{ $class-description "tuple representing an XML tag, delegating to a " { $link
+{ $class-description "Tuple representing an XML tag, delegating to a " { $link
name } ", containing the slots attrs (an alist of names to strings) and children (a sequence). Tags implement the sequence protocol by acting like a sequence of its chidren, and the assoc protocol by acting like its attributes." }
{ $see-also name contained-tag xml } ;
@@ -58,32 +58,32 @@ HELP:
{ "attrs" "an alist of names to strings" }
{ "children" sequence }
{ "tag" tag } }
-{ $description "constructs an XML " { $link tag } " with the name (not a string) and tag attributes specified in attrs and children specified" }
+{ $description "Constructs an XML " { $link tag } " with the name (not a string) and tag attributes specified in attrs and children specified." }
{ $see-also tag } ;
HELP: name
-{ $class-description "represents an XML name, with the fields space (a string representing the namespace, as written in the document, tag (a string of the actual name of the tag) and url (a string of the URL that the namespace points to)" }
+{ $class-description "Represents an XML name, with the fields space (a string representing the namespace, as written in the document, tag (a string of the actual name of the tag) and url (a string of the URL that the namespace points to)." }
{ $see-also tag } ;
HELP:
{ $values { "space" "a string" } { "main" "a string" } { "url" "a string" }
{ "name" "an XML tag name" } }
-{ $description "creates a name tuple with the name-space space and the tag-name tag and the tag-url url." }
+{ $description "Creates a name tuple with the namespace prefix space, the the given main part of the name, and the namespace URL given by url." }
{ $see-also name } ;
HELP: contained-tag
-{ $class-description "delegates to tag representing a tag like with no contents. The tag attributes are accessed with tag-attrs" }
+{ $class-description "This is a subclass of " { $link tag } " consisting of tags with no body, like " { $snippet "" } "." }
{ $see-also tag } ;
HELP:
{ $values { "name" "an XML tag name" }
{ "attrs" "an alist from names to strings" }
{ "tag" tag } }
-{ $description "creates an empty tag (like ) with the specified name and tag attributes. This delegates to tag" }
+{ $description "Creates an empty tag (like " { $snippet "" } ") with the specified name and tag attributes." }
{ $see-also contained-tag } ;
HELP: xml
-{ $class-description "tuple representing an XML document, delegating to the main tag, containing the fields prolog (the header ), before (whatever comes between the prolog and the main tag) and after (whatever comes after the main tag)" }
+{ $class-description "Tuple representing an XML document, delegating to the main tag, containing the fields prolog (the header " { $snippet "" } "), before (whatever comes between the prolog and the main tag) and after (whatever comes after the main tag)." }
{ $see-also tag prolog } ;
HELP:
@@ -159,35 +159,35 @@ HELP:
{ $description "Creates an element declaration object, of the class " { $link element-decl } } ;
HELP: attlist-decl
-{ $class-description "Describes the class of element declarations, like ." } ;
+{ $class-description "Describes the class of element declarations, like " { $snippet "" } "." } ;
HELP:
{ $values { "name" name } { "att-defs" string } { "attlist-decl" attlist-decl } }
{ $description "Creates an element declaration object, of the class " { $link attlist-decl } } ;
HELP: entity-decl
-{ $class-description "Describes the class of element declarations, like ." } ;
+{ $class-description "Describes the class of element declarations, like " { $snippet "" } "." } ;
HELP:
{ $values { "name" name } { "def" string } { "pe?" "t or f" } { "entity-decl" entity-decl } }
-{ $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 and f if the object is like , that is, it can be used outside of the DTD." } ;
+{ $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 "" } " and f if the object is like " { $snippet "" } ", 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 " } ;
+{ $class-description "Describes the class of system identifiers within an XML DTD directive, such as " { $snippet "" } } ;
HELP:
{ $values { "system-literal" string } { "system-id" system-id } }
{ $description "Constructs a " { $link system-id } " tuple." } ;
HELP: public-id
-{ $class-description "Describes the class of public identifiers within an XML DTD directive, such as " } ;
+{ $class-description "Describes the class of public identifiers within an XML DTD directive, such as " { $snippet "" } } ;
HELP:
{ $values { "pubid-literal" string } { "system-literal" string } { "public-id" public-id } }
{ $description "Constructs a " { $link system-id } " tuple." } ;
HELP: notation-decl
-{ $class-description "Describes the class of element declarations, like ." } ;
+{ $class-description "Describes the class of element declarations, like " { $snippet "" } "." } ;
HELP:
{ $values { "name" string } { "id" id } { "notation-decl" notation-decl } }
diff --git a/basis/xml/data/data.factor b/basis/xml/data/data.factor
index b014a96180..c44250035a 100644
--- a/basis/xml/data/data.factor
+++ b/basis/xml/data/data.factor
@@ -216,3 +216,6 @@ M: xml like
PREDICATE: contained-tag < tag children>> not ;
PREDICATE: open-tag < tag children>> ;
+
+UNION: xml-data
+ tag comment string directive instruction ;
diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor
index b2280bacb4..57e91cc24e 100644
--- a/basis/xml/elements/elements.factor
+++ b/basis/xml/elements/elements.factor
@@ -3,16 +3,15 @@
USING: kernel namespaces xml.tokenize xml.state xml.name
xml.data accessors arrays make xml.char-classes fry assocs sequences
math xml.errors sets combinators io.encodings io.encodings.iana
-unicode.case xml.dtd strings xml.entities ;
+unicode.case xml.dtd strings xml.entities unicode.categories ;
IN: xml.elements
: take-interpolated ( quot -- interpolated )
interpolating? get [
drop get-char CHAR: > =
- [ next f ] [
- pass-blank " \t\r\n-" take-to
- pass-blank "->" expect
- ] if
+ [ next f ]
+ [ "->" take-string [ blank? ] trim ]
+ if
] [ call ] if ; inline
: interpolate-quote ( -- interpolated )
diff --git a/basis/xml/entities/entities.factor b/basis/xml/entities/entities.factor
index a730474f20..3e768b1b88 100644
--- a/basis/xml/entities/entities.factor
+++ b/basis/xml/entities/entities.factor
@@ -16,6 +16,7 @@ IN: xml.entities
{ CHAR: & "&" }
{ CHAR: ' "'" }
{ CHAR: " """ }
+ { CHAR: < "<" }
} ;
: escape-string-by ( str table -- escaped )
diff --git a/basis/xml/errors/errors-docs.factor b/basis/xml/errors/errors-docs.factor
index b95aecc47a..46c4fbe466 100644
--- a/basis/xml/errors/errors-docs.factor
+++ b/basis/xml/errors/errors-docs.factor
@@ -10,44 +10,68 @@ HELP: notags
{ $class-description "XML parsing error describing the case where an XML document contains no main tag, or any tags at all" } ;
HELP: extra-attrs
-{ $class-description "XML parsing error describing the case where the XML prolog () 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 parsing-error } "." } ;
+{ $class-description "XML parsing error describing the case where the XML prolog (" { $snippet "" } ") 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 } "." } ;
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 parsing-error } "." } ;
+{ $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 } "." } ;
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 parsing-error } " 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 'yes' or 'no'. Delegates to " { $link xml-error-at } " and contains one slot, text, which contains offending value." } ;
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." } ;
HELP: mismatched
-{ $class-description "XML parsing error describing mismatched tags, eg . Contains two slots: open is the name of the opening tag and close is the name of the closing tag. Delegates to " { $link parsing-error } " showing the location of the closing tag" } ;
+{ $class-description "XML parsing error describing mismatched tags, eg " { $snippet "" } ". 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" } ;
HELP: expected
-{ $class-description "XML parsing error describing when an expected token was not present. Delegates to " { $link parsing-error } ". 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, should-be, which has the expected string, and 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 parsing-error } ". Contains one slot, thing, containing a string representing the 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." } ;
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" } ;
+{ $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 quotation for an attribute value is opened but not closed before the end of the document." } ;
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." } ;
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." } ;
-HELP: xml-parse-error
-{ $class-description "the exception class that all parsing errors in XML documents are in." } ;
+HELP: disallowed-char
+{ $class-description "Describes the error where a disallowed character occurs in an XML document." } ;
+
+HELP: missing-close
+{ $class-description "Describes the error where a particular closing token is missing." } ;
+
+HELP: unexpected-end
+{ $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." } ;
+
+HELP: bad-cdata
+{ $class-description "Describes the error where CDATA is used outside of the main tag of an XML document." } ;
+
+HELP: text-w/]]>
+{ $class-description "Describes the error where a text node contains the literal string " { $snippet "]]>" } " which is disallowed." } ;
+
+HELP: attr-w/<
+{ $class-description "Describes the error where an attribute value contains the literal character " { $snippet "<" } " which is disallowed." } ;
+
+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." } ;
+
+HELP: xml-error
+{ $class-description "The exception class that all parsing errors in XML documents are in." } ;
ARTICLE: "xml.errors" "XML parsing errors"
- { $vocab-link "xml.errors" } " provides a rich and highly inspectable set of parsing errors. All XML errors are described by the union class " { $link xml-parse-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 } " but there are many classes contained in that:"
{ $subsection multitags }
{ $subsection notags }
{ $subsection extra-attrs }
@@ -61,7 +85,15 @@ ARTICLE: "xml.errors" "XML parsing errors"
{ $subsection unclosed-quote }
{ $subsection bad-name }
{ $subsection quoteless-attr }
- "Additionally, most of these errors are a kind of " { $link parsing-error } " which provides more information"
+ { $subsection disallowed-char }
+ { $subsection missing-close }
+ { $subsection unexpected-end }
+ { $subsection duplicate-attr }
+ { $subsection bad-cdata }
+ { $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"
$nl
"Note that, in parsing an XML document, only the first error is reported." ;
diff --git a/basis/xml/errors/errors-tests.factor b/basis/xml/errors/errors-tests.factor
index bf02f4b6ca..4204979941 100644
--- a/basis/xml/errors/errors-tests.factor
+++ b/basis/xml/errors/errors-tests.factor
@@ -27,12 +27,16 @@ T{ pre/post-content f "x" t } "x]]> " xml-error-test
T{ duplicate-attr f 1 21 T{ name { space "" } { main "this" } } V{ "a" "b" } } "\u000001 " xml-error-test
+T{ missing-close f 1 9 } "