include XMLPL package.

packages/xml/xml_generation.pl

@@ -0,0 +1,389 @@
+/* xml_generation.pl : Document -> XML translation
+
+ *
+
+ * Copyright (C) 2001-2005 Binding Time Limited
+
+ * Copyright (C) 2005-2011 John Fletcher
+
+ *
+
+ * Current Release: $Revision: 3.7 $
+
+ * 
+
+ * TERMS AND CONDITIONS:
+
+ *
+
+ * This program is offered free of charge, as unsupported source code. You may
+
+ * use it, copy it, distribute it, modify it or sell it without restriction,
+
+ * but entirely at your own risk.
+
+ */
+
+
+
+:- ensure_loaded( xml_utilities ).
+
+
+
+/* document_generation( +Format, +Document ) is a DCG generating Document
+
+ * as a list of character codes. Format is true|false defining whether layouts,
+
+ * to provide indentation, should be added between the element content of
+
+ * the resultant "string". Note that formatting is disabled for elements that
+
+ * are interspersed with pcdata/1 terms, such as XHTML's 'inline' elements.
+
+ * Also, Format is over-ridden, for an individual element, by an explicit
+
+ * 'xml:space'="preserve" attribute.
+
+ */
+
+document_generation( Format, xml(Attributes, Document) ) -->
+
+	document_generation_body( Attributes, Format, Document ).
+
+
+
+document_generation_body( [], Format, Document ) -->
+
+	generation( Document, "", Format, [], _Format1 ).
+
+document_generation_body( Attributes, Format, Document ) -->
+
+	{	Attributes = [_|_],
+
+		xml_declaration_attributes_valid( Attributes )
+
+	},
+
+	"<?xml",
+
+	generated_attributes( Attributes, Format, Format0 ),
+
+	"?>",
+
+	indent( true, [] ),
+
+	generation( Document, "", Format0, [], _Format1 ).
+
+
+
+generation( [], _Prefix, Format, _Indent, Format ) --> [].
+
+generation( [Term|Terms], Prefix, Format0, Indent, Format ) -->
+
+	generation( Term, Prefix, Format0, Indent, Format1 ),
+
+	generation( Terms, Prefix, Format1, Indent, Format ).
+
+generation( doctype(Name, External), _Prefix, Format, [], Format ) -->
+
+	"<!DOCTYPE ",
+
+	generated_name( Name ),
+
+	generated_external_id( External ),
+
+	">".
+
+generation( instructions(Target,Process), _Prefix, Format, Indent, Format ) -->
+
+	indent( Format, Indent ),
+
+	"<?", generated_name(Target), " ", chars( Process ) ,"?>".
+
+generation( pcdata(Chars), _Prefix, Format0, _Indent, Format1 ) -->
+
+	pcdata_generation( Chars ),
+
+	{character_data_format( Chars, Format0, Format1 )}.
+
+generation( comment( Comment ), _Prefix, Format, Indent, Format ) -->
+
+	indent( Format, Indent ),
+
+	"<!--", chars( Comment ), "-->".
+
+generation( namespace(URI, Prefix, element(Name, Atts, Content)),
+
+		_Prefix0, Format, Indent, Format ) -->
+
+	indent( Format, Indent ),
+
+	"<", generated_prefixed_name( Prefix, Name ),
+
+	generated_prefixed_attributes( Prefix, URI, Atts, Format, Format1 ), 
+
+	generated_content( Content, Format1, Indent, Prefix, Name ).
+
+generation( element(Name, Atts, Content), Prefix, Format, Indent, Format ) -->
+
+	indent( Format, Indent ),
+
+	"<", generated_prefixed_name( Prefix, Name ),
+
+	generated_attributes( Atts, Format, Format1 ), 
+
+	generated_content( Content, Format1, Indent, Prefix, Name ).
+
+generation( cdata(CData), _Prefix, Format0, _Indent, Format1 ) -->
+
+	"<![CDATA[", cdata_generation(CData), "]]>",
+
+	{character_data_format( CData, Format0, Format1 )}.
+
+
+
+generated_attributes( [], Format, Format  ) --> [].
+
+generated_attributes( [Name=Value|Attributes], Format0, Format  ) -->
+
+	{(	Name == 'xml:space',
+
+		Value="preserve" ->
+
+			Format1 = false
+
+	  ; otherwise ->
+
+			Format1 = Format0
+
+	  )},
+
+	" ",
+
+	generated_name( Name ),
+
+	"=""",
+
+	quoted_string( Value ),
+
+	"""",
+
+	generated_attributes( Attributes, Format1, Format  ).
+
+
+
+generated_prefixed_name( [], Name ) -->
+
+	generated_name( Name ).
+
+generated_prefixed_name( Prefix, Name ) -->
+
+	{Prefix = [_|_]},
+
+	chars( Prefix ), ":",
+
+	generated_name( Name ).
+
+
+
+generated_content( [], _Format, _Indent, _Prefix, _Namespace ) -->
+
+	" />". % Leave an extra space for XHTML output.
+
+generated_content( [H|T], Format, Indent, Prefix, Namespace ) -->
+
+	">",
+
+	generation( H, Prefix, Format, [0' |Indent], Format1 ),
+
+	generation( T, Prefix, Format1, [0' |Indent], Format2 ),
+
+	indent( Format2, Indent ),
+
+	"</", generated_prefixed_name( Prefix, Namespace ), ">".
+
+
+
+generated_prefixed_attributes( [_|_Prefix], _URI, Atts, Format0, Format ) -->
+
+	generated_attributes( Atts, Format0, Format  ).
+
+generated_prefixed_attributes( [], URI, Atts, Format0, Format  ) -->
+
+	{atom_codes( URI, Namespace ),
+
+	 findall( Attr, (member(Attr, Atts), \+ Attr=(xmlns=_Val)), Atts1 )
+
+	},
+
+	generated_attributes( [xmlns=Namespace|Atts1], Format0, Format  ).
+
+
+
+generated_name( Name, Plus, Minus ) :-
+
+	atom_codes( Name, Chars ),
+
+	append( Chars, Minus, Plus ).
+
+
+
+generated_external_id( local ) --> "".
+
+generated_external_id( local(Literals) ) --> " [",
+
+	generated_doctype_literals( Literals ), "
+
+	]".
+
+generated_external_id( system(URL) ) -->
+
+	" SYSTEM """,
+
+	chars( URL ),
+
+	"""".
+
+generated_external_id( system(URL,Literals) ) -->
+
+	" SYSTEM """,
+
+	chars( URL ),
+
+	""" [",
+
+	generated_doctype_literals( Literals ), "
+
+	]".
+
+generated_external_id( public(URN,URL) ) -->
+
+	" PUBLIC """,
+
+	chars( URN ),
+
+	""" """,
+
+	chars( URL ),
+
+	"""".
+
+generated_external_id( public(URN,URL,Literals) ) -->
+
+	" PUBLIC """,
+
+	chars( URN ),
+
+	""" """,
+
+	chars( URL ),
+
+	""" [",
+
+	generated_doctype_literals( Literals ), "
+
+	]".
+
+
+
+generated_doctype_literals( [] ) --> "".
+
+generated_doctype_literals( [dtd_literal(String)|Literals] ) --> "
+
+	<!", cdata_generation( String ), ">",
+
+	generated_doctype_literals( Literals ).
+
+
+
+/* quoted_string( +Chars ) is a DCG representing Chars, a list of character
+
+ * codes, as a legal XML attribute string. Any leading or trailing layout
+
+ * characters are removed. &, " and < characters are replaced by &amp;, &quot;
+
+ * and &lt; respectively, .
+
+ */
+
+quoted_string( Raw, Plus, Minus ) :-
+
+	quoted_string1( Raw, NoLeadingLayouts ),
+
+	quoted_string2( NoLeadingLayouts, Layout, Layout, Plus, Minus ).
+
+
+
+quoted_string1( [], [] ).
+
+quoted_string1( [Char|Chars], NoLeadingLayouts ) :-
+
+	( Char > 32 ->
+
+		NoLeadingLayouts = [Char|Chars]
+
+	; otherwise ->
+
+		quoted_string1( Chars, NoLeadingLayouts )
+
+	).
+
+
+
+quoted_string2( [], _LayoutPlus, _LayoutMinus, List, List ).
+
+quoted_string2( [Char|Chars], LayoutPlus, LayoutMinus, Plus, Minus ) :-
+
+	( Char =< " " ->
+
+		Plus = Plus1,
+
+		LayoutMinus = [Char|LayoutMinus1],
+
+		LayoutPlus = LayoutPlus1
+
+	; Char == 34 ->
+
+		Plus = LayoutPlus,
+
+		escaped_quote( LayoutMinus, Plus1 ),
+
+		LayoutPlus1 = LayoutMinus1
+
+	; Char == 39 ->
+
+		Plus = LayoutPlus,
+
+		apos( LayoutMinus, Plus1 ),
+
+		LayoutPlus1 = LayoutMinus1
+
+	; Char =< 127 ->
+
+		Plus = LayoutPlus,
+
+		pcdata_7bit( Char, LayoutMinus, Plus1 ),
+
+		LayoutPlus1 = LayoutMinus1
+
+	; legal_xml_unicode( Char ) ->
+
+		Plus = LayoutPlus,
+
+		number_codes( Char, Codes ),
+
+		pcdata_8bits_plus( Codes, LayoutMinus, Plus1 ),
+
+		LayoutPlus1 = LayoutMinus1
+
+	; otherwise ->
+
+		LayoutPlus = LayoutPlus1,
+
+		LayoutMinus = LayoutMinus1,
+
+		Plus = Plus1
+
+	),
+
+	quoted_string2( Chars, LayoutPlus1, LayoutMinus1, Plus1, Minus ).