1		/* xml_prob.pl : Contains xml_parse/[2,3] a bi-directional XML parser written in
2		* Prolog.
3		*
4		* Copyright (C) 2001-2005 Binding Time Limited
5		* Copyright (C) 2005 John Fletcher
6		*
7		* Current Release: $Revision$
8		*
9		* TERMS AND CONDITIONS:
10		*
11		* This program is offered free of charge, as unsupported source code. You may
12		* use it, copy it, distribute it, modify it or sell it without restriction,
13		* but entirely at your own risk.
14		*
15		*/
16
17		% minimally adapted for SICStus Prolog
18		% Mats Carlsson, 2003-2006
19		% added linefeed counting for attributes (attributes_count_lf,spaces_count_linebreaks)
20		% Michael Leuschel, 2017
21
22		:- module( xml_prob, [
23		xml_parse/2,
24		xml_parse/3,
25		xml_subterm/2,
26		xml_pp/1
27		]).
28
29		:- use_module(module_information,[module_info/2]).
30		:- module_info(group,external_functions).
31		:- module_info(description,'This module transforms XML into a Prolog representation, adaptation of SICStus library module.').
32
33		:- use_module(library(types), [
34		must_be/4,
35		illarg/3,
36		illarg/4
37		]).
38		:- use_module(library(lists), [
39		select/3,
40		is_list/1
41		]).
42
43		%@ This is a package for parsing XML with Prolog, which
44		%@ provides Prolog applications with a simple ``Document Value Model''
45		%@ interface to XML documents. A description of the subset of XML that it
46		%@ supports can be found at:
47		%@ @c [PM] 4.1 link updated 2009-08-14
48		%@ @uref{http://www.binding-time.co.uk/xmlpl.html}
49		%@
50		%@ The package, originally written by Binding Time Ltd., is in the public
51		%@ domain and unsupported. To use the package, enter the query:
52		%@
53		%@ @example
54		%@ @group
55		%@ | ?- use_module(library(xml)).
56		%@ @end group
57		%@ @end example
58		%@
59		%@ The package represents XML documents by the abstract data type
60		%@ @var{document}, which is defined by the following grammar:
61		%@
62		%@ @multitable @columnfractions .2 .3 .5
63		%@ @item @var{document} @tab ::= @code{xml(@var{attributes},@var{content})} @tab @r{@{ well-formed document @}}
64		%@ @item @tab | @code{malformed(@var{attributes},@var{content})} @tab @r{@{ malformed document @}}
65		%@ @item
66		%@ @item @var{attributes} @tab ::= @code{[]}
67		%@ @item @tab | @code{[@var{name}=@var{char-data}|@var{attributes}]}
68		%@ @item
69		%@ @item @var{content} @tab ::= @code{[]}
70		%@ @item @tab | @code{[@var{cterm}|@var{content}]}
71		%@ @item
72		%@ @item @var{cterm} @tab ::= @code{pcdata(@var{char-data})} @tab @r{@{ text @}}
73		%@ @item @tab | @code{comment(@var{char-data})} @tab @r{@{ an XML comment @}}
74		%@ @item @tab | @code{namespace(@var{URI},@var{prefix},@var{element})} @tab @r{@{ a Namespace @}}
75		%@ @item @tab | @code{element(@var{tag},@var{attributes},@var{content})} @tab @r{@{ <@var{tag}>..</@var{tag}> encloses @var{content} or <@var{tag} /> if empty @}}
76		%@ @item @tab | @code{instructions(@var{name},@var{char-data})} @tab @r{@{ A PI <? @var{name} @var{char-data} ?> @}}
77		%@ @item @tab | @code{cdata(@var{char-data})} @tab @r{@{ <![CDATA[@var{char-data}]]> @}}
78		%@ @item @tab | @code{doctype(@var{tag},@var{doctype-id})} @tab @r{@{ DTD <!DOCTYPE .. > @}}
79		%@ @item @tab | @code{unparsed(@var{char-data})} @tab @r{@{ text that hasn't been parsed @}}
80		%@ @item @tab | @code{out_of_context(@var{tag})} @tab @r{@{ @var{tag} is not closed @}}
81		%@ @item
82		%@ @item @var{tag} @tab ::= @dfn{atom} @tab @r{@{ naming an element @}}
83		%@ @item
84		%@ @item @var{name} @tab ::= @dfn{atom} @tab @r{@{ not naming an element @}}
85		%@ @item
86		%@ @item @var{URI} @tab ::= @dfn{atom} @tab @r{@{ giving the URI of a namespace @}}
87		%@ @item
88		%@ @item @var{char-data} @tab ::= @dfn{code-list}
89		%@ @item
90		%@ @item @var{doctype-id} @tab ::= @code{public(@var{char-data},@var{char-data})}
91		%@ @item @tab | @code{public(@var{char-data},@var{dtd-literals})}
92		%@ @item @tab | @code{system(@var{char-data})}
93		%@ @item @tab | @code{system(@var{char-data},@var{dtd-literals})}
94		%@ @item @tab | @code{local}
95		%@ @item @tab | @code{local,@var{dtd-literals}}
96		%@ @item
97		%@ @item @var{dtd-literals} @tab ::= @code{[]}
98		%@ @item @tab | @code{[dtd_literal(@var{char-data})|@var{dtd-literals}]}
99		%@ @end multitable
100		%@
101		%@ The following predicates are exported by the package:
102		%@
103		%@ @table @code
104		%@ @item xml_parse(@var{?Chars}, @var{?Document})
105		%@ @itemx xml_parse(@var{?Chars}, @var{?Document}, @var{+Options})
106		%@ @PLXindex {xml_parse/[2,3] (xml)}
107		%@ Either parses @var{Chars}, a @dfn{code-list}, to @var{Document}, a
108		%@ @var{document}. @var{Chars} is not required to represent strictly
109		%@ well-formed XML.
110		%@ Or generates @var{Chars}, a @dfn{code-list},
111		%@ from @var{Document}, a @var{document}.
112		%@ If @var{Document} is not a valid @var{document} term representing
113		%@ well-formed XML, an exception is raised.
114		%@ In the second usage of the predicate, the only option available is @code{format/1}.
115		%@
116		%@ @var{Options} is a list of zero or more of the following, where
117		%@ @var{Boolean} must be @code{true} or @code{false}:
118		%@
119		%@ @table @code
120		%@ @item format(@var{Boolean})
121		%@ @findex format/1 (xml_parse/3 option)
122		%@ Indent the element content (default @code{true}).
123		%@
124		%@ @item extended_characters(@var{Boolean})
125		%@ @findex extended_characters/1 (xml_parse/3 option)
126		%@ Use the extended character entities for XHTML (default @code{true}).
127		%@
128		%@ @item remove_attribute_prefixes(@var{Boolean})
129		%@ @findex remove_attribute_prefixes/1 (xml_parse/3 option)
130		%@ Remove namespace prefixes from attributes when it's the same as the
131		%@ prefix of the parent element (default @code{false}).
132		%@ @end table
133		%@
134		%@ @item xml_subterm(@var{+Term}, @var{?Subterm})
135		%@ @PLXindex {xml_subterm/2 (xml)}
136		%@ Unifies @var{Subterm} with a sub-term of @var{Term}, a
137		%@ @var{document}. This can be especially useful when trying to test or
138		%@ retrieve a deeply-nested subterm from a document.
139		%@
140		%@ @item xml_pp(@var{+Document})
141		%@ @PLXindex {xml_pp/1 (xml)}
142		%@ ``Pretty prints'' @var{Document}, a @var{document}, on the current
143		%@ output stream.
144		%@ @end table
145
146
147		/* xml_parse(+?Chars, ?+Document[, +Controls]) parses Chars to/from a data
148		* structure of the form xml(<atts>, <content>). <atts> is a list of
149		* <atom>=<string> attributes from the (possibly implicit) XML signature of the
150		* document. <content> is a (possibly empty) list comprising occurrences of :
151		*
152		* pcdata(<string>) : Text
153		* comment(<string>) : An xml comment;
154		* element(<tag>,<atts>,<content>) : <tag>..</tag> encloses <content>
155		* : <tag /> if empty
156		* instructions(<atom>, <string>) : Processing <? <atom> <params> ?>"
157		* cdata( <string> ) : <![CDATA[ <string> ]]>
158		* doctype(<atom>, <doctype id>) : DTD <!DOCTYPE .. >
159		*
160		* The conversions are not completely symmetrical, in that weaker XML is
161		* accepted than can be generated. Specifically, in-bound (Chars -> Document)
162		* does not require strictly well-formed XML. Document is instantiated to the
163		* term malformed(Attributes, Content) if Chars does not represent well-formed
164		* XML. The Content of a malformed/2 structure can contain:
165		*
166		* unparsed( <string> ) : Text which has not been parsed
167		* out_of_context( <tag> ) : <tag> is not closed
168		*
169		* in addition to the standard term types.
170		*
171		* Out-bound (Document -> Chars) parsing _does_ require that Document defines
172		* strictly well-formed XML. If an error is detected a 'domain' exception is
173		* raised.
174		*
175		* The domain exception will attempt to identify the particular sub-term in
176		* error and the message will show a list of its ancestor elements in the form
177		* <tag>{(id)}* where <id> is the value of any attribute _named_ id.
178		*
179		* At this release, the Controls applying to in-bound (Chars -> Document)
180		* parsing are:
181		*
182		* extended_characters(<bool>) : Use the extended character
183		* : entities for XHTML (default true)
184		*
185		* format(<bool>) : Strip layouts when no character data
186		* : appears between elements.
187		* : (default true)
188		*
189		* remove_attribute_prefixes( <bool>) : Remove namespace prefixes from
190		* : attributes when it's the same as the
191		* : prefix of the parent element
192		* : (default false).
193		*
194		* [<bool> is one of 'true' or 'false']
195		*
196		* For out-bound (Document -> Chars) parsing, the only available option is:
197		*
198		* format(<Bool>) : Indent the element content
199		* : (default true)
200		*
201		* Different DCGs for input and output are used because input parsing is
202		* more flexible than output parsing. Errors in input are recorded as part
203		* of the data structure. Output parsing throws an exception if the document
204		* is not well-formed, diagnosis tries to identify the specific culprit term.
205		*/
206		xml_parse( Chars, Document ) :-
207		xml_parse( Chars, Document, [] ).
208
209		xml_parse( Chars, Document, Controls ) :-
210		Goal = xml_parse(Chars,Document,Controls),
211		% format, extended_characters, remove_attribute_prefixes
212		must_be(Controls, proper_list, Goal, 3),
213		xml_options(Controls, opt(true,true,false), Options, Goal, 3),
214		( ground( Chars ) ->
215		xml_to_document( Options, Chars, Document )
216		; ground(Document) ->
217		document_to_xml( Options, Document, Chars )
218		; illarg(var, Goal, 0)
219		), !. /*MC*/
220
221		xml_options([], Opt, Opt, _, _) :- !.
222		xml_options([X|L], Opt0, Opt, Goal, ArgNo) :- !,
223		( callable(X),
224		xml_option(X, Opt0, Opt1) -> true
225		; illarg(domain(term,xml_parse_option), Goal, ArgNo, X)
226		),
227		xml_options(L, Opt1, Opt, Goal, ArgNo).
228
229		xml_option(format(X), opt(_,B,C), opt(X,B,C)) :-
230		bool_option(X).
231		xml_option(extended_characters(X), opt(A,_,C), opt(A,X,C)) :-
232		bool_option(X).
233		xml_option(remove_attribute_prefixes(X), opt(A,B,_), opt(A,B,X)) :-
234		bool_option(X).
235
236		bool_option(X) :- var(X), !, fail.
237		bool_option(false).
238		bool_option(true).
239
240		document_to_xml( opt(Format,_,_), Document, Chars ) :-
241		( document_generation(Format, Document, Chars0, [] ) ->
242		Chars = Chars0
243		; otherwise ->
244		xml_fault( Document, [], Culprit, Path, Message ),
245		throw(xml_parse(Message,Document,Culprit,Path))
246		).
247
248		:- multifile user:generate_message_hook/3.
249		user:generate_message_hook(xml_parse(Message,Document,Culprit,Path)) --> !,
250		['XML Parse: ~a in ~q'-[Message,Document],nl,
251		'Culprit: ~q'-[Culprit],nl],
252		( {Path==[]} -> []
253		; ['Path: ~s'-[Path],nl]
254		).
255
256
257		/* xml_subterm( +XMLTerm, ?Subterm ) unifies Subterm with a sub-term of Term.
258		* Note that XMLTerm is a sub-term of itself.
259		*/
260		xml_subterm( Term, Term ).
261		xml_subterm( xml(_Attributes, Content), Term ) :-
262		xml_subterm( Content, Term ).
263		xml_subterm( [H|T], Term ) :-
264		( xml_subterm( H, Term )
265		; xml_subterm( T, Term )
266		).
267		xml_subterm( element(_Name,_Attributes,Content), Term ) :-
268		xml_subterm( Content, Term ).
269		xml_subterm( namespace(_URI,_Prefix,Content), Term ) :-
270		xml_subterm( Content, Term ).
271
272		/* xml is intended to be a rather modular module: it should be easy to
273		* build a program that can output XML, but not read it, or vice versa.
274		* Similarly, you may be happy to dispense with diagnosis once you are
275		* sure that your code will only try to make valid calls to xml_parse/2.
276		*
277		* It is intended that the code should be very portable too. Clearly,
278		* some small changes will be needed between platforms, but these should
279		* be limited to xml_utilities. xml_utilities contains most of the shared
280		* code and most of the potentially non-portable code.
281		*/
282		/* xml_acquisition.pl : XML -> Document translation.
283		*
284		* $Revision$
285		*
286		*/
287
288		/* xml_to_document( +Options, +XML, ?Document ) translates the list of
289		* character codes XML into the Prolog term Document. Options is
290		* the parsed options list.
291		*/
292		xml_to_document( Options, XML, Document ) :-
293		initial_context( Options, Context ),
294		( xml_declaration( Attributes0, XML, XML1 ) ->
295		Attributes = Attributes0
296		; otherwise ->
297		XML1 = XML,
298		Attributes = []
299		),
300		xml_to_document( XML1, Context, Terms, [], WellFormed ),
301		xml_to_document1( WellFormed, Attributes, Terms, Document ).
302
303		xml_to_document1( true, Attributes, Terms, xml(Attributes, Terms) ).
304		xml_to_document1( false, Attributes, Terms, malformed(Attributes, Terms) ).
305
306		% unparsed( +Unparsed, +Context, ?Terms, ?Residue, ?WellFormed )
307		unparsed( Unparsed, _Context, [unparsed(Unparsed)], [], false ).
308
309		xml_declaration( Attributes ) -->
310		spaces,
311		"<?",
312		nmtoken( xml ),
313		xml_declaration_attributes( Attributes ),
314		spaces,
315		"?>".
316
317		xml_to_document( [], Context, Terms, [], WF ) :-
318		close_context( Context, Terms, WF ).
319		xml_to_document( [Char|Chars], Context, Terms, Residue, WF ) :-
320		( Char =:= "<" ->
321		xml_markup_structure( Chars, Context, Terms, Residue, WF )
322		; Char =:= "&" ->
323		entity_reference( Chars, Context, Terms, Residue, WF )
324		; Char =< " ",
325		\+ space_preserve( Context ) ->
326		layouts( Chars, Context, [Char|T], T, Terms, Residue, WF )
327		; void_context( Context ) ->
328		unparsed( [Char|Chars], Context, Terms, Residue, WF )
329		; otherwise ->
330		Terms = [pcdata([Char|Chars1])|Terms1],
331		acquire_pcdata( Chars, Context, Chars1, Terms1, Residue, WF )
332		).
333
334		layouts( [], Context, _Plus, _Minus, Terms, [], WF ) :-
335		close_context( Context, Terms, WF ).
336		layouts( [Char|Chars], Context, Plus, Minus, Terms, Residue, WF ) :-
337		( Char =:= "<" ->
338		xml_markup_structure( Chars, Context, Terms, Residue, WF )
339		; Char =:= "&" ->
340		entity_reference( Chars, Context, Terms, Residue, WF )
341		; Char =< " " ->
342		Minus = [Char|Minus1],
343		layouts( Chars, Context, Plus, Minus1, Terms, Residue, WF )
344		; void_context( Context ) ->
345		unparsed( [Char|Chars], Context, Terms, Residue, WF )
346		; otherwise ->
347		Terms = [pcdata(Plus)|Terms1],
348		Minus = [Char|Chars1],
349		context_update( space_preserve, Context, true, Context1 ),
350		acquire_pcdata( Chars, Context1, Chars1, Terms1, Residue, WF )
351		).
352
353		acquire_pcdata( [], Context, [], Terms, [], WF ) :-
354		close_context( Context, Terms, WF ).
355		acquire_pcdata( [Char|Chars], Context, Chars1, Terms, Residue, WF ) :-
356		( Char =:= "<" ->
357		Chars1 = [],
358		xml_markup_structure( Chars, Context, Terms, Residue, WF )
359		; Char =:= "&" ->
360		reference_in_pcdata( Chars, Context, Chars1, Terms, Residue, WF )
361		; otherwise ->
362		Chars1 = [Char|Chars2],
363		acquire_pcdata( Chars, Context, Chars2, Terms, Residue, WF )
364		).
365
366		xml_markup_structure( [], Context, Terms, Residue, WF ) :-
367		unparsed( "<", Context, Terms, Residue, WF ).
368		xml_markup_structure( Chars, Context, Terms, Residue, WF ) :-
369		Chars = [Char|Chars1],
370		( Char =:= "/" ->
371		closing_tag( Context, Chars1, Terms, Residue, WF )
372		; Char =:= "?" ->
373		pi_acquisition( Chars1, Context, Terms, Residue, WF )
374		; Char =:= "!" ->
375		declaration_acquisition( Chars1, Context, Terms, Residue, WF )
376		; open_tag(Tag,Context,Attributes,Type, Chars, Chars2 ) ->
377		push_tag( Tag, Chars2, Context, Attributes, Type, Terms, Residue, WF )
378		; otherwise ->
379		unparsed( [0'<|Chars], Context, Terms, Residue, WF ) %'
380		).
381
382		push_tag( Tag, Chars, Context, Attributes, Type, Terms, Residue, WF ) :-
383		new_element(Tag, Chars, Context, Attributes, Type, Term, Rest, WF0),
384		push_tag1( WF0, Context, Term, Rest, Terms, Residue, WF ).
385
386		push_tag1( true, Context, Term, Chars, [Term|Terms], Residue, WF ) :-
387		xml_to_document( Chars, Context, Terms, Residue, WF ).
388		push_tag1( false, _Context, Term, Chars, [Term], Chars, false ).
389
390		new_element( TagChars, Chars, Context, Attributes0, Type, Term, Residue, WF ) :-
391		namespace_attributes( Attributes0, Context, Context1, Attributes1 ),
392		( append( NSChars, [0':|TagChars1], TagChars ), %'
393		specific_namespace( NSChars, Context1, SpecificNamespace ) ->
394		Namespace0 = SpecificNamespace
395		; otherwise ->
396		NSChars = "",
397		TagChars1 = TagChars,
398		default_namespace( Context1, Namespace0 )
399		),
400		current_namespace( Context1, CurrentNamespace ),
401		( Namespace0 == CurrentNamespace ->
402		Term = element(Tag, Attributes, Contents),
403		Context2 = Context1
404		; otherwise ->
405		Term = namespace( Namespace0, NSChars,
406		element(Tag, Attributes, Contents)
407		),
408		context_update( current_namespace, Context1, Namespace0, Context2 )
409		),
410		input_attributes( Attributes1, Context2, Attributes ),
411		atom_codes( Tag, TagChars1 ),
412		close_tag( Type, Chars, Context2, Contents, Residue, WF ).
413
414		close_tag( empty, Residue, _Context, [], Residue, true ).
415		close_tag( push(Tag), Chars, Context0, Contents, Residue, WF ) :-
416		context_update( element, Context0, Tag, Context1 ),
417		xml_to_document( Chars, Context1, Contents, Residue, WF ).
418
419		pi_acquisition( Chars, Context, Terms, Residue, WellFormed ) :-
420		( inline_instruction(Target, Processing, Chars, Rest ),
421		Target \== xml ->
422		Terms = [instructions(Target, Processing)|Terms1],
423		xml_to_document( Rest, Context, Terms1, Residue, WellFormed )
424		; otherwise ->
425		unparsed( [0'<,0'?|Chars], Context, Terms, Residue, WellFormed )
426		).
427
428		declaration_acquisition( Chars, Context, Terms, Residue, WF ) :-
429		( declaration_type( Chars, Type, Chars1 ),
430		declaration_parse( Type, Context, Term, Context1, Chars1, Rest ) ->
431		Terms = [Term|Terms1],
432		xml_to_document( Rest, Context1, Terms1, Residue, WF )
433		; otherwise ->
434		unparsed( [0'<,0'!|Chars], Context, Terms, Residue, WF )
435		).
436
437		open_tag( Tag, Namespaces, Attributes, Termination ) -->
438		nmtoken_chars( Tag ),
439		attributes( Attributes, [], Namespaces ),
440		spaces,
441		open_tag_terminator( Tag, Termination ).
442
443		open_tag_terminator( Tag, push(Tag) ) -->
444		">".
445		open_tag_terminator( _Tag, empty ) -->
446		"/>".
447
448		declaration_parse( comment, Namespaces, comment(Comment), Namespaces ) -->
449		comment(Comment).
450		declaration_parse( cdata, Namespaces, cdata(CData), Namespaces ) -->
451		cdata( CData ).
452		declaration_parse( doctype, Namespaces0, doctype(Name, Names), Namespaces ) -->
453		doctype( Name, Names, Namespaces0, Namespaces ),
454		spaces,
455		">".
456
457		inline_instruction( Target, Processing, Plus, Minus ) :-
458		nmtoken(Target, Plus, Mid0 ),
459		spaces( Mid0, Mid1 ),
460		append( Processing, [0'?,0'>|Minus], Mid1 ),
461		!.
462
463		entity_reference_name( Reference ) -->
464		nmtoken_chars( Reference ),
465		";".
466
467		declaration_type( [Char1,Char2|Chars1], Class, Rest ) :-
468		Chars = [Char1,Char2|Chars1],
469		( declaration_type1( Char1, Char2, Chars1, Class0, Residue ) ->
470		Class = Class0,
471		Rest = Residue
472		; otherwise ->
473		Class = generic,
474		Rest = Chars
475		).
476
477		declaration_type1( 0'-, 0'-, Chars, comment, Chars ).
478		declaration_type1( 0'[, 0'C, Chars, cdata, Residue ) :-
479		append( "DATA[", Residue, Chars ).
480		declaration_type1( 0'D, 0'O, Chars, doctype, Residue ) :-
481		append( "CTYPE", Residue, Chars ).
482
483		closing_tag( Context, Chars, Terms, Residue, WellFormed ) :-
484		( closing_tag_name( Tag, Chars, Rest ),
485		current_tag( Context, Tag ) ->
486		Terms = [],
487		Residue = Rest,
488		WellFormed = true
489		; otherwise ->
490		unparsed( [0'<,0'/|Chars], Context, Terms, Residue, WellFormed )
491		).
492
493		closing_tag_name( Tag ) -->
494		nmtoken_chars( Tag ),
495		spaces,
496		">".
497
498		entity_reference( Chars, Context, Terms, Residue, WF ) :-
499		( standard_character_entity( Char, Chars, Rest ) ->
500		Terms = [pcdata([Char|Chars1])|Terms1],
501		acquire_pcdata( Rest, Context, Chars1, Terms1, Residue, WF )
502		; entity_reference_name( Reference, Chars, Rest ),
503		defined_entity( Reference, Context, String ) ->
504		append( String, Rest, Full ),
505		xml_to_document( Full, Context, Terms, Residue, WF )
506		; otherwise ->
507		unparsed( [0'&|Chars], Context, Terms, Residue, WF ) %'
508		).
509
510		reference_in_pcdata( Chars0, Context, Chars1, Terms, Residue, WF ) :-
511		( standard_character_entity(Char, Chars0, Rest ) ->
512		Chars1 = [Char|Chars2],
513		acquire_pcdata( Rest, Context, Chars2, Terms, Residue, WF )
514		; entity_reference_name(Reference, Chars0, Rest ),
515		defined_entity( Reference, Context, String ) ->
516		append( String, Rest, Full ),
517		acquire_pcdata( Full, Context, Chars1, Terms, Residue, WF )
518		; otherwise ->
519		Chars1 = [],
520		unparsed( [0'&|Chars0], Context, Terms, Residue, WF ) %'
521		).
522
523		namespace_attributes( [], Context, Context, [] ).
524		namespace_attributes( Attributes0, Context0, Context, Attributes ) :-
525		Attributes0 = [_|_],
526		append( "xmlns:", Unqualified, QualifiedNameChars ),
527		( select( "xmlns"=Value, Attributes0, Attributes1 ) ->
528		atom_codes( URI, Value ),
529		context_update( default_namespace, Context0, URI, Context1 ),
530		namespace_attributes( Attributes1, Context1, Context, Attributes )
531		; select( QualifiedNameChars=Value, Attributes0, Attributes1 ) ->
532		Attributes = [QualifiedNameChars=Value|Attributes2],
533		atom_codes( URI, Value ),
534		context_update( ns_prefix(Unqualified), Context0, URI, Context1 ),
535		namespace_attributes( Attributes1, Context1, Context, Attributes2 )
536		; member( "xml:space"="preserve", Attributes0 ) ->
537		Attributes = Attributes0,
538		context_update( space_preserve, Context0, true, Context )
539		; otherwise ->
540		Context = Context0,
541		Attributes = Attributes0
542		).
543
544		input_attributes( [], _Context, [] ).
545		input_attributes( [NameChars=Value|Attributes0], Context,
546		[Name=Value|Attributes] ) :-
547		( remove_attribute_prefixes( Context ),
548		append( NSChars, [0':|NameChars1], NameChars ), %'
549		NSChars \== "xmlns",
550		specific_namespace( NSChars, Context, Namespace ),
551		current_namespace( Context, Namespace ) ->
552		atom_codes( Name, NameChars1 )
553		; otherwise ->
554		atom_codes( Name, NameChars )
555		),
556		input_attributes( Attributes0, Context, Attributes ).
557
558		attributes( Attributes, Seen, Namespaces ) -->
559		attributes_count_lf(0, Attributes, Seen, Namespaces ). % PATCH LEUSCHEL: add count parameter
560
561		attributes_count_lf(Count0, [Name=Value|Attributes], Seen, Namespaces ) -->
562		spaces_count_linebreaks(Count0,C1),
563		nmtoken_chars( Name ),
564		{\+ member(Name, Seen)},
565		spaces_count_linebreaks(C1,C2),
566		"=",
567		spaces_count_linebreaks(C2,C3),
568		attribute_value( Value, Namespaces ),
569		attributes_count_lf( C3, Attributes, [Name|Seen], Namespaces ).
570		attributes_count_lf( 0, [], _Seen, _Namespaces ) --> !, "". % ,{print(no_linefeeds),nl}.
571		attributes_count_lf( Count, ["$attribute_linefeeds"=Count], _Seen, _Namespaces ) --> "". %, {print(linefeeds(Count)),nl}.
572
573		spaces_count_linebreaks(C,C, [], [] ).
574		spaces_count_linebreaks(Count,ResCount, [Char|Chars0], Chars1 ) :-
575		( Char=10 ->
576		Count1 is Count+1, spaces_count_linebreaks(Count1, ResCount, Chars0, Chars1 )
577		; Char =< 32 ->
578		spaces_count_linebreaks(Count,ResCount, Chars0, Chars1 )
579		; otherwise ->
580		Count=ResCount, Chars1 = [Char|Chars0]
581		).
582		% END PATCH
583
584		xml_declaration_attributes( [] ) --> "".
585		xml_declaration_attributes( [Name=Value|Attributes] ) -->
586		spaces,
587		nmtoken( Name ),
588		spaces,
589		"=",
590		spaces,
591		xml_string( Value ),
592		{xml_declaration_attribute_valid(Name, Value)},
593		xml_declaration_attributes( Attributes ),
594		spaces.
595
596		doctype( Name, External, Namespaces0, Namespaces1 ) -->
597		spaces,
598		nmtoken( Name ),
599		spaces,
600		doctype_id( External0 ),
601		spaces,
602		doctype1( Namespaces0, Literals, Namespaces1 ),
603		{doctype_extension(Literals, External0, External)}.
604
605		doctype_extension( [], External, External ).
606		doctype_extension( [Literal|Literals], External0, External ) :-
607		extended_doctype( External0, [Literal|Literals], External ).
608
609		extended_doctype( system(URL), Literals, system(URL,Literals) ).
610		extended_doctype( public(URN,URL), Literals, public(URN,URL,Literals) ).
611		extended_doctype( local, Literals, local(Literals) ).
612
613		doctype1( Namespaces0, Literals, Namespaces1 ) -->
614		"[",
615		!,
616		dtd( Namespaces0, Literals, Namespaces1 ),
617		"]".
618		doctype1( Namespaces, [], Namespaces ) --> "".
619
620		doctype_id( system(URL) ) -->
621		"SYSTEM",
622		spaces,
623		uri( URL ).
624		doctype_id( public(URN,URL) ) -->
625		"PUBLIC",
626		spaces,
627		uri( URN ),
628		spaces,
629		uri( URL ).
630		doctype_id( local ) --> "".
631
632		dtd( Namespaces0, Literals, Namespaces1 ) -->
633		spaces,
634		"<!ENTITY",
635		!,
636		spaces,
637		nmtoken_chars( Name ),
638		spaces,
639		quote( Quote ),
640		entity_value( Quote, Namespaces0, String ),
641		spaces,
642		">",
643		{\+ character_entity( Name, _StandardChar ),
644		% Don't allow < "e; etc. to be updated
645		context_update( entity(Name), Namespaces0, String, Namespaces2 )
646		},
647		dtd( Namespaces2, Literals, Namespaces1 ).
648		dtd( Namespaces0, Literals, Namespaces1 ) -->
649		spaces,
650		"<!--",
651		!,
652		dtd_comment,
653		">",
654		dtd( Namespaces0, Literals, Namespaces1 ).
655		dtd( Namespaces0, [dtd_literal(Literal)|Literals], Namespaces1 ) -->
656		spaces,
657		"<!",
658		!,
659		dtd_literal( Literal ),
660		dtd( Namespaces0, Literals, Namespaces1 ).
661		dtd( Namespaces, [], Namespaces ) --> spaces.
662
663		dtd_literal( [] ) --> ">", !.
664		dtd_literal( Chars ) -->
665		"--",
666		!,
667		dtd_comment,
668		dtd_literal( Chars ).
669		dtd_literal( [Char|Chars] ) -->
670		[Char],
671		dtd_literal( Chars ).
672
673		dtd_comment( Plus, Minus ) :-
674		append( _Chars, [0'-,0'-|Minus], Plus ),
675		!.
676
677		entity_value( Quote, Namespaces, String, [Char|Plus], Minus ) :-
678		( Char == Quote ->
679		String = [],
680		Minus = Plus
681		; Char =:= "&" ->
682		reference_in_entity( Namespaces, Quote, String, Plus, Minus )
683		; otherwise ->
684		String = [Char|String1],
685		entity_value( Quote, Namespaces, String1, Plus, Minus )
686		).
687
688		attribute_value( String, Namespaces ) -->
689		quote( Quote ),
690		attribute_leading_layouts( Quote, Namespaces, String ).
691
692		attribute_leading_layouts( _Quote, _Namespace, [], [], [] ).
693		attribute_leading_layouts( Quote, Namespaces, String, [Char|Plus], Minus ) :-
694		( Char == Quote ->
695		String = [],
696		Minus = Plus
697		; Char =:= "&" ->
698		reference_in_layout( Namespaces, Quote, String, Plus, Minus )
699		; Char > 32, Char \== 160 ->
700		String = [Char|String1],
701		attribute_layouts( Quote, Namespaces, false, String1, Plus, Minus )
702		; otherwise ->
703		attribute_leading_layouts( Quote, Namespaces, String, Plus, Minus )
704		).
705
706		attribute_layouts( _Quote, _Namespaces, _Layout, [], [], [] ).
707		attribute_layouts( Quote, Namespaces, Layout, String, [Char|Plus], Minus ) :-
708		( Char == Quote ->
709		String = [],
710		Minus = Plus
711		; Char =:= "&" ->
712		reference_in_value( Namespaces, Quote, Layout, String, Plus, Minus )
713		; Char > 32, Char \== 160 ->
714		( Layout == true ->
715		String = [0' ,Char|String1] %'
716		; otherwise ->
717		String = [Char|String1]
718		),
719		attribute_layouts( Quote, Namespaces, false, String1, Plus, Minus )
720		; otherwise ->
721		attribute_layouts( Quote, Namespaces, true, String, Plus, Minus )
722		).
723
724		reference_in_layout( NS, Quote, String, Plus, Minus ) :-
725		( standard_character_entity( Char, Plus, Mid ) ->
726		String = [Char|String1],
727		attribute_layouts( Quote, NS, false, String1, Mid, Minus )
728		; entity_reference_name( Name, Plus, Suffix ),
729		defined_entity( Name, NS, Text ) ->
730		append( Text, Suffix, Mid ),
731		attribute_leading_layouts( Quote, NS, String, Mid, Minus )
732		; otherwise -> % Just & is okay in a value
733		String = [0'&|String1], %'
734		attribute_layouts( Quote, NS, false, String1, Plus, Minus )
735		).
736
737		reference_in_value( Namespaces, Quote, Layout, String, Plus, Minus ) :-
738		( standard_character_entity( Char, Plus, Mid ) ->
739		( Layout == true ->
740		String = [0' ,Char|String1] %'
741		; otherwise ->
742		String = [Char|String1]
743		),
744		Layout1 = false
745		; entity_reference_name( Name, Plus, Suffix ),
746		defined_entity( Name, Namespaces, Text ) ->
747		String = String1,
748		append( Text, Suffix, Mid ),
749		Layout1 = Layout
750		; otherwise -> % Just & is okay in a value
751		Mid = Plus,
752		String = [0'&|String1], %'
753		Layout1 = false
754		),
755		attribute_layouts( Quote, Namespaces, Layout1, String1, Mid, Minus ).
756
757		/* References are resolved backwards in Entity defintions so that
758		* circularity is avoided.
759		*/
760		reference_in_entity( Namespaces, Quote, String, Plus, Minus ) :-
761		( standard_character_entity( _SomeChar, Plus, _Rest ) ->
762		String = [0'&|String1], % ' Character entities are unparsed
763		Mid = Plus
764		; entity_reference_name( Name, Plus, Suffix ),
765		defined_entity( Name, Namespaces, Text ) ->
766		String = String1,
767		append( Text, Suffix, Mid )
768		),
769		entity_value( Quote, Namespaces, String1, Mid, Minus ).
770
771		standard_character_entity( Char ) -->
772		"#x", hex_character_reference( Char ), ";".
773		standard_character_entity( Char ) -->
774		"#", digit( Digit ), digits( Digits ), ";",
775		{number_codes( Char, [Digit|Digits])}.
776		standard_character_entity( C ) -->
777		chars( String ),
778		";",
779		!,
780		{character_entity(String, C)}.
781
782		uri( URI ) -->
783		quote( Quote ),
784		uri1( Quote, URI ).
785
786		uri1( Quote, [] ) -->
787		quote( Quote ),
788		!.
789		uri1( Quote, [Char|Chars] ) -->
790		[Char],
791		uri1( Quote, Chars ).
792
793		comment( Chars, Plus, Minus ) :-
794		append( Chars, [0'-,0'-,0'>|Minus], Plus ), %'
795		!.
796
797		cdata( Chars, Plus, Minus ) :-
798		append( Chars, [0'],0'],0'>|Minus], Plus ), %'
799		!.
800		% Syntax Components
801
802		hex_character_reference( Code ) -->
803		hex_character_reference1( 0, Code ).
804
805		hex_character_reference1( Current, Code ) -->
806		hex_digit_char( Value ),
807		!,
808		{New is (Current << 4) + Value},
809		hex_character_reference1( New, Code ).
810		hex_character_reference1( Code, Code ) --> "".
811
812		hex_digit_char( 0 ) --> "0".
813		hex_digit_char( 1 ) --> "1".
814		hex_digit_char( 2 ) --> "2".
815		hex_digit_char( 3 ) --> "3".
816		hex_digit_char( 4 ) --> "4".
817		hex_digit_char( 5 ) --> "5".
818		hex_digit_char( 6 ) --> "6".
819		hex_digit_char( 7 ) --> "7".
820		hex_digit_char( 8 ) --> "8".
821		hex_digit_char( 9 ) --> "9".
822		hex_digit_char( 10 ) --> "A".
823		hex_digit_char( 11 ) --> "B".
824		hex_digit_char( 12 ) --> "C".
825		hex_digit_char( 13 ) --> "D".
826		hex_digit_char( 14 ) --> "E".
827		hex_digit_char( 15 ) --> "F".
828		hex_digit_char( 10 ) --> "a".
829		hex_digit_char( 11 ) --> "b".
830		hex_digit_char( 12 ) --> "c".
831		hex_digit_char( 13 ) --> "d".
832		hex_digit_char( 14 ) --> "e".
833		hex_digit_char( 15 ) --> "f".
834
835		quote( 0'" ) --> %'
836		"""".
837		quote( 0'\' ) -->
838		"'".
839
840		spaces( [], [] ).
841		spaces( [Char|Chars0], Chars1 ) :-
842		( Char =< 32 ->
843		spaces( Chars0, Chars1 )
844		; otherwise ->
845		Chars1 = [Char|Chars0]
846		).
847
848		nmtoken( Name ) -->
849		nmtoken_chars( Chars ),
850		{atom_codes(Name, Chars)}.
851
852		nmtoken_chars( [Char|Chars] ) -->
853		[Char],
854		{nmtoken_first( Char )},
855		nmtoken_chars_tail( Chars ).
856
857		nmtoken_chars_tail( [Char|Chars] ) -->
858		[Char],
859		{nmtoken_char(Char)},
860		!,
861		nmtoken_chars_tail( Chars ).
862		nmtoken_chars_tail([]) --> "".
863
864		nmtoken_first( 0': ).
865		nmtoken_first( 0'_ ).
866		nmtoken_first( Char ) :-
867		alphabet( Char ).
868
869		nmtoken_char( 0'a ).
870		nmtoken_char( 0'b ).
871		nmtoken_char( 0'c ).
872		nmtoken_char( 0'd ).
873		nmtoken_char( 0'e ).
874		nmtoken_char( 0'f ).
875		nmtoken_char( 0'g ).
876		nmtoken_char( 0'h ).
877		nmtoken_char( 0'i ).
878		nmtoken_char( 0'j ).
879		nmtoken_char( 0'k ).
880		nmtoken_char( 0'l ).
881		nmtoken_char( 0'm ).
882		nmtoken_char( 0'n ).
883		nmtoken_char( 0'o ).
884		nmtoken_char( 0'p ).
885		nmtoken_char( 0'q ).
886		nmtoken_char( 0'r ).
887		nmtoken_char( 0's ).
888		nmtoken_char( 0't ).
889		nmtoken_char( 0'u ).
890		nmtoken_char( 0'v ).
891		nmtoken_char( 0'w ).
892		nmtoken_char( 0'x ).
893		nmtoken_char( 0'y ).
894		nmtoken_char( 0'z ).
895		nmtoken_char( 0'A ).
896		nmtoken_char( 0'B ).
897		nmtoken_char( 0'C ).
898		nmtoken_char( 0'D ).
899		nmtoken_char( 0'E ).
900		nmtoken_char( 0'F ).
901		nmtoken_char( 0'G ).
902		nmtoken_char( 0'H ).
903		nmtoken_char( 0'I ).
904		nmtoken_char( 0'J ).
905		nmtoken_char( 0'K ).
906		nmtoken_char( 0'L ).
907		nmtoken_char( 0'M ).
908		nmtoken_char( 0'N ).
909		nmtoken_char( 0'O ).
910		nmtoken_char( 0'P ).
911		nmtoken_char( 0'Q ).
912		nmtoken_char( 0'R ).
913		nmtoken_char( 0'S ).
914		nmtoken_char( 0'T ).
915		nmtoken_char( 0'U ).
916		nmtoken_char( 0'V ).
917		nmtoken_char( 0'W ).
918		nmtoken_char( 0'X ).
919		nmtoken_char( 0'Y ).
920		nmtoken_char( 0'Z ).
921		nmtoken_char( 0'0 ).
922		nmtoken_char( 0'1 ).
923		nmtoken_char( 0'2 ).
924		nmtoken_char( 0'3 ).
925		nmtoken_char( 0'4 ).
926		nmtoken_char( 0'5 ).
927		nmtoken_char( 0'6 ).
928		nmtoken_char( 0'7 ).
929		nmtoken_char( 0'8 ).
930		nmtoken_char( 0'9 ).
931		nmtoken_char( 0'. ).
932		nmtoken_char( 0'- ).
933		nmtoken_char( 0'_ ).
934		nmtoken_char( 0': ).
935
936		xml_string( String ) -->
937		quote( Quote ),
938		xml_string1( Quote, String ).
939
940		xml_string1( Quote, [] ) -->
941		quote( Quote ),
942		!.
943		xml_string1( Quote, [Char|Chars] ) -->
944		[Char],
945		xml_string1( Quote, Chars ).
946
947		alphabet( 0'a ).
948		alphabet( 0'b ).
949		alphabet( 0'c ).
950		alphabet( 0'd ).
951		alphabet( 0'e ).
952		alphabet( 0'f ).
953		alphabet( 0'g ).
954		alphabet( 0'h ).
955		alphabet( 0'i ).
956		alphabet( 0'j ).
957		alphabet( 0'k ).
958		alphabet( 0'l ).
959		alphabet( 0'm ).
960		alphabet( 0'n ).
961		alphabet( 0'o ).
962		alphabet( 0'p ).
963		alphabet( 0'q ).
964		alphabet( 0'r ).
965		alphabet( 0's ).
966		alphabet( 0't ).
967		alphabet( 0'u ).
968		alphabet( 0'v ).
969		alphabet( 0'w ).
970		alphabet( 0'x ).
971		alphabet( 0'y ).
972		alphabet( 0'z ).
973		alphabet( 0'A ).
974		alphabet( 0'B ).
975		alphabet( 0'C ).
976		alphabet( 0'D ).
977		alphabet( 0'E ).
978		alphabet( 0'F ).
979		alphabet( 0'G ).
980		alphabet( 0'H ).
981		alphabet( 0'I ).
982		alphabet( 0'J ).
983		alphabet( 0'K ).
984		alphabet( 0'L ).
985		alphabet( 0'M ).
986		alphabet( 0'N ).
987		alphabet( 0'O ).
988		alphabet( 0'P ).
989		alphabet( 0'Q ).
990		alphabet( 0'R ).
991		alphabet( 0'S ).
992		alphabet( 0'T ).
993		alphabet( 0'U ).
994		alphabet( 0'V ).
995		alphabet( 0'W ).
996		alphabet( 0'X ).
997		alphabet( 0'Y ).
998		alphabet( 0'Z ).
999
1000		digit( C ) --> [C], {digit_table( C )}.
1001
1002		digit_table( 0'0 ).
1003		digit_table( 0'1 ).
1004		digit_table( 0'2 ).
1005		digit_table( 0'3 ).
1006		digit_table( 0'4 ).
1007		digit_table( 0'5 ).
1008		digit_table( 0'6 ).
1009		digit_table( 0'7 ).
1010		digit_table( 0'8 ).
1011		digit_table( 0'9 ).
1012
1013		digits( [Digit|Digits] ) -->
1014		digit( Digit ),
1015		digits( Digits ).
1016		digits( [] ) --> [].
1017
1018		character_entity( "quot", 0'" ). %'
1019		character_entity( "amp", 0'& ). %'
1020		character_entity( "lt", 0'< ). %'
1021		character_entity( "gt", 0'> ). %'
1022		character_entity( "apos", 0'\' ).
1023		/* xml_diagnosis.pl : XML exception diagnosis.
1024		*
1025		* $Revision$
1026		*/
1027
1028		/* xml_fault( +Term, +Indentation, ?SubTerm, ?Path, ?Message ) identifies SubTerm
1029		* as a sub-term of Term which cannot be serialized after Indentation.
1030		* Message is an atom naming the type of error; Path is a string encoding a
1031		* list of SubTerm's ancestor elements in the form <tag>{(id)}* where <tag> is the
1032		* element tag and <id> is the value of any attribute _named_ id.
1033		*/
1034		xml_fault( Term, _Indent, Term, [], 'Illegal Variable' ) :-
1035		var( Term ).
1036		xml_fault( xml(Attributes,_Content), _Indent, Term, [], Message ) :-
1037		member( Attribute, Attributes ),
1038		attribute_fault( Attribute, Term, Message ).
1039		xml_fault( xml(_Attributes,Content), Indent, Culprit, Path, Message ) :-
1040		xml_content_fault( Content, Indent, Culprit, Path, Message ).
1041		xml_fault( Term, _Indent, Term, [], 'Illegal Term' ).
1042
1043		xml_content_fault( Term, _Indent, Term, [], 'Illegal Variable' ) :-
1044		var( Term ).
1045		xml_content_fault( pcdata(Chars), _Indent, Chars, [], 'Invalid Character Data' ) :-
1046		\+ is_chars( Chars ).
1047		xml_content_fault( cdata(Chars), _Indent, Chars, [], 'Invalid Character Data' ) :-
1048		\+ is_chars( Chars ).
1049		xml_content_fault( [H|_T], Indent, Culprit, Path, Message ) :-
1050		xml_content_fault( H, Indent, Culprit, Path, Message ).
1051		xml_content_fault( [_H|T], Indent, Culprit, Path, Message ) :-
1052		xml_content_fault( T, Indent, Culprit, Path, Message ).
1053		xml_content_fault( namespace(_URI,_Prefix,Element), Indent, Culprit, Path, Message ) :-
1054		element_fault( Element, [0' |Indent], Culprit, Path, Message ).
1055		xml_content_fault( Element, Indent, Culprit, Path, Message ) :-
1056		element_fault( Element, [0' |Indent], Culprit, Path, Message ).
1057		xml_content_fault( Term, Indent, Term, [], 'Illegal Term' ) :-
1058		\+ generation(Term, "", false, Indent, _Format, _Plus, _Minus ).
1059
1060		element_fault( element(Tag, _Attributes, _Contents), _Indent, Tag, [], 'Tag must be an atom' ) :-
1061		\+ atom( Tag ).
1062		element_fault( element(Tag, Attributes, _Contents), _Indent, Tag, [], 'Attributes must be instantiated' ) :-
1063		var( Attributes ).
1064		element_fault( element(Tag, Attributes, _Contents), _Indent, Faulty, Path, Message ) :-
1065		fault_path( Tag, Attributes, Path, [] ),
1066		member( Attribute, Attributes ),
1067		attribute_fault( Attribute, Faulty, Message ).
1068		element_fault( element(Tag, Attributes, Contents), Indent, Culprit, Path, Message ) :-
1069		fault_path( Tag, Attributes, Path, Path1 ),
1070		xml_content_fault( Contents, Indent, Culprit, Path1, Message ).
1071
1072		attribute_fault( Attribute, Attribute, 'Illegal Variable' ) :-
1073		var( Attribute ).
1074		attribute_fault( Name=Value, Name=Value, 'Attribute Name must be atom' ) :-
1075		\+ atom(Name).
1076		attribute_fault( Name=Value, Name=Value, 'Attribute Value must be chars' ) :-
1077		\+ is_chars( Value ).
1078		attribute_fault( Attribute, Attribute, 'Malformed Attribute' ) :-
1079		\+ Attribute = (_Name=_Value).
1080
1081		is_chars( Chars ) :-
1082		is_list( Chars ),
1083		\+ (member( Char, Chars ), \+ (integer(Char), Char >=0, Char =< 255)).
1084
1085		fault_path( Tag, Attributes ) -->
1086		{atom_codes( Tag, Chars )},
1087		chars( Chars ),
1088		fault_id( Attributes ),
1089		" ".
1090
1091		fault_id( Attributes ) -->
1092		{member( id=Chars, Attributes ), is_chars( Chars )},
1093		!,
1094		"(", chars(Chars), ")".
1095		fault_id( _Attributes ) --> "".
1096		/* xml_generation.pl : Document -> XML translation
1097		*
1098		* $Revision$
1099		*/
1100
1101		/* document_generation( +Format, +Document ) is a DCG generating Document
1102		* as a list of character codes. Format is true|false defining whether layouts,
1103		* to provide indentation, should be added between the element content of
1104		* the resultant "string". Note that formatting is disabled for elements that
1105		* are interspersed with pcdata/1 terms, such as XHTML's 'inline' elements.
1106		* Also, Format is over-ridden, for an individual element, by an explicit
1107		* 'xml:space'="preserve" attribute.
1108		*/
1109		document_generation( Format, xml(Attributes, Document) ) -->
1110		document_generation_body( Attributes, Format, Document ).
1111
1112		document_generation_body( [], Format, Document ) -->
1113		generation( Document, "", Format, [], _Format1 ).
1114		document_generation_body( Attributes, Format, Document ) -->
1115		{ Attributes = [_|_],
1116		xml_declaration_attributes_valid( Attributes )
1117		},
1118		"<?xml",
1119		generated_attributes( Attributes, Format, Format0 ),
1120		"?>",
1121		indent( true, [] ),
1122		generation( Document, "", Format0, [], _Format1 ).
1123
1124		generation( [], _Prefix, Format, _Indent, Format ) --> [].
1125		generation( [Term|Terms], Prefix, Format0, Indent, Format ) -->
1126		generation( Term, Prefix, Format0, Indent, Format1 ),
1127		generation( Terms, Prefix, Format1, Indent, Format ).
1128		generation( doctype(Name, External), _Prefix, Format, [], Format ) -->
1129		"<!DOCTYPE ",
1130		generated_name( Name ),
1131		generated_external_id( External ),
1132		">".
1133		generation( instructions(Target,Process), _Prefix, Format, Indent, Format ) -->
1134		indent( Format, Indent ),
1135		"<?", generated_name(Target), " ", chars( Process ) ,"?>".
1136		generation( pcdata(Chars), _Prefix, _Format, _Indent, false ) -->
1137		pcdata_generation( Chars ).
1138		generation( comment( Comment ), _Prefix, Format, Indent, Format ) -->
1139		indent( Format, Indent ),
1140		"<!--", chars( Comment ), "-->".
1141		generation( namespace(URI, Prefix, element(Name, Atts, Content)),
1142		_Prefix0, Format, Indent, Format ) -->
1143		indent( Format, Indent ),
1144		"<", generated_prefixed_name( Prefix, Name ),
1145		generated_prefixed_attributes( Prefix, URI, Atts, Format, Format1 ),
1146		generated_content( Content, Format1, Indent, Prefix, Name ).
1147		generation( element(Name, Atts, Content), Prefix, Format, Indent, Format ) -->
1148		indent( Format, Indent ),
1149		"<", generated_prefixed_name( Prefix, Name ),
1150		generated_attributes( Atts, Format, Format1 ),
1151		generated_content( Content, Format1, Indent, Prefix, Name ).
1152		generation( cdata(CData), _Prefix, Format, Indent, Format ) -->
1153		indent( Format, Indent ),
1154		"<![CDATA[", cdata_generation(CData), "]]>".
1155
1156		generated_attributes( [], Format, Format ) --> [].
1157		generated_attributes( [Name=Value|Attributes], Format0, Format ) -->
1158		{( Name == 'xml:space',
1159		Value="preserve" ->
1160		Format1 = false
1161		; otherwise ->
1162		Format1 = Format0
1163		)},
1164		" ",
1165		generated_name( Name ),
1166		"=""",
1167		quoted_string( Value ),
1168		"""",
1169		generated_attributes( Attributes, Format1, Format ).
1170
1171		generated_prefixed_name( [], Name ) -->
1172		generated_name( Name ).
1173		generated_prefixed_name( Prefix, Name ) -->
1174		{Prefix = [_|_]},
1175		chars( Prefix ), ":",
1176		generated_name( Name ).
1177
1178		generated_content( [], _Format, _Indent, _Prefix, _Namespace ) -->
1179		" />". % Leave an extra space for XHTML output.
1180		generated_content( [H|T], Format, Indent, Prefix, Namespace ) -->
1181		">",
1182		generation( H, Prefix, Format, [0' |Indent], Format1 ),
1183		generation( T, Prefix, Format1, [0' |Indent], Format2 ),
1184		indent( Format2, Indent ),
1185		"</", generated_prefixed_name( Prefix, Namespace ), ">".
1186
1187		generated_prefixed_attributes( [_|_Prefix], _URI, Atts, Format0, Format ) -->
1188		generated_attributes( Atts, Format0, Format ).
1189		generated_prefixed_attributes( [], URI, Atts, Format0, Format ) -->
1190		{atom_codes( URI, Namespace ),
1191		findall( Attr, (member(Attr, Atts), \+ Attr=(xmlns=_Val)), Atts1 )
1192		},
1193		generated_attributes( [xmlns=Namespace|Atts1], Format0, Format ).
1194
1195		generated_name( Name, Plus, Minus ) :-
1196		atom_codes( Name, Chars ),
1197		append( Chars, Minus, Plus ).
1198
1199		generated_external_id( local ) --> "".
1200		generated_external_id( local(Literals) ) --> " [",
1201		generated_doctype_literals( Literals ), "\n\t]".
1202		generated_external_id( system(URL) ) -->
1203		" SYSTEM """,
1204		chars( URL ),
1205		"""".
1206		generated_external_id( system(URL,Literals) ) -->
1207		" SYSTEM """,
1208		chars( URL ),
1209		""" [",
1210		generated_doctype_literals( Literals ), "\n\t]".
1211		generated_external_id( public(URN,URL) ) -->
1212		" PUBLIC """,
1213		chars( URN ),
1214		""" """,
1215		chars( URL ),
1216		"""".
1217		generated_external_id( public(URN,URL,Literals) ) -->
1218		" PUBLIC """,
1219		chars( URN ),
1220		""" """,
1221		chars( URL ),
1222		""" [",
1223		generated_doctype_literals( Literals ), "\n\t]".
1224
1225		generated_doctype_literals( [] ) --> "".
1226		generated_doctype_literals( [dtd_literal(String)|Literals] ) --> "\n\t",
1227		"<!", cdata_generation( String ), ">",
1228		generated_doctype_literals( Literals ).
1229
1230		/* quoted_string( +Chars ) is a DCG representing Chars, a list of character
1231		* codes, as a legal XML attribute string. Any leading or trailing layout
1232		* characters are removed. &, " and < characters are replaced by &, "
1233		* and < respectively.
1234		*/
1235		quoted_string( Raw, Plus, Minus ) :-
1236		quoted_string1( Raw, NoLeadingLayouts ),
1237		quoted_string2( NoLeadingLayouts, Layout, Layout, Plus, Minus ).
1238
1239		quoted_string1( [], [] ).
1240		quoted_string1( [Char|Chars], NoLeadingLayouts ) :-
1241		( Char > 32 ->
1242		NoLeadingLayouts = [Char|Chars]
1243		; otherwise ->
1244		quoted_string1( Chars, NoLeadingLayouts )
1245		).
1246
1247		quoted_string2( [], _LayoutPlus, _LayoutMinus, List, List ).
1248		quoted_string2( [Char|Chars], LayoutPlus, LayoutMinus, Plus, Minus ) :-
1249		( Char =< " " ->
1250		Plus = Plus1,
1251		LayoutMinus = [Char|LayoutMinus1],
1252		LayoutPlus = LayoutPlus1
1253		; Char =< 127 ->
1254		Plus = LayoutPlus,
1255		pcdata_7bit( Char, LayoutMinus, Plus1 ),
1256		LayoutPlus1 = LayoutMinus1
1257		; legal_xml_unicode( Char ) ->
1258		Plus = LayoutPlus,
1259		number_codes( Char, Codes ),
1260		pcdata_8bits_plus( Codes, LayoutMinus, Plus1 ),
1261		LayoutPlus1 = LayoutMinus1
1262		; otherwise ->
1263		LayoutPlus = LayoutPlus1,
1264		LayoutMinus = LayoutMinus1,
1265		Plus = Plus1
1266		),
1267		quoted_string2( Chars, LayoutPlus1, LayoutMinus1, Plus1, Minus ).
1268
1269		indent( false, _Indent ) --> [].
1270		indent( true, Indent ) --> "\n",
1271		chars( Indent ).
1272
1273		/* pcdata_generation( +Chars ) is a DCG representing Chars, a list of character
1274		* codes as legal XML "Parsed character data" (PCDATA) string. Any codes
1275		* which cannot be represented by a 7-bit character are replaced by their
1276		* decimal numeric character entity e.g. code 160 (non-breaking space) is
1277		* represented as  . Any character codes disallowed by the XML
1278		* specification are not encoded.
1279		*/
1280		pcdata_generation( [], Plus, Plus ).
1281		pcdata_generation( [Char|Chars], Plus, Minus ) :-
1282		( Char =< 127 ->
1283		pcdata_7bit( Char, Plus, Mid )
1284		; legal_xml_unicode( Char ) ->
1285		number_codes( Char, Codes ),
1286		pcdata_8bits_plus( Codes, Plus, Mid )
1287		; otherwise ->
1288		Plus = Mid
1289		),
1290		pcdata_generation( Chars, Mid, Minus ).
1291
1292		/* pcdata_7bit(+Char) represents the ascii character set in its
1293		* simplest format, using the character entities & " < and >
1294		* which are common to both XML and HTML. The numeric entity ' is used in
1295		* place of ', because browsers don't recognize it in HTML.
1296		*/
1297		pcdata_7bit( 0 ) --> "".
1298		pcdata_7bit( 1 ) --> "".
1299		pcdata_7bit( 2 ) --> "".
1300		pcdata_7bit( 3 ) --> "".
1301		pcdata_7bit( 4 ) --> "".
1302		pcdata_7bit( 5 ) --> "".
1303		pcdata_7bit( 6 ) --> "".
1304		pcdata_7bit( 7 ) --> "".
1305		pcdata_7bit( 8 ) --> "".
1306		pcdata_7bit( 9 ) --> [9].
1307		pcdata_7bit( 10 ) --> [10].
1308		pcdata_7bit( 11 ) --> "".
1309		pcdata_7bit( 12 ) --> "".
1310		pcdata_7bit( 13 ) --> [13].
1311		pcdata_7bit( 14 ) --> "".
1312		pcdata_7bit( 15 ) --> "".
1313		pcdata_7bit( 16 ) --> "".
1314		pcdata_7bit( 17 ) --> "".
1315		pcdata_7bit( 18 ) --> "".
1316		pcdata_7bit( 19 ) --> "".
1317		pcdata_7bit( 20 ) --> "".
1318		pcdata_7bit( 21 ) --> "".
1319		pcdata_7bit( 22 ) --> "".
1320		pcdata_7bit( 23 ) --> "".
1321		pcdata_7bit( 24 ) --> "".
1322		pcdata_7bit( 25 ) --> "".
1323		pcdata_7bit( 26 ) --> "".
1324		pcdata_7bit( 27 ) --> "".
1325		pcdata_7bit( 28 ) --> "".
1326		pcdata_7bit( 29 ) --> "".
1327		pcdata_7bit( 30 ) --> "".
1328		pcdata_7bit( 31 ) --> "".
1329		pcdata_7bit( 32 ) --> " ".
1330		pcdata_7bit( 33 ) --> "!".
1331		pcdata_7bit( 34 ) --> """.
1332		pcdata_7bit( 35 ) --> "#".
1333		pcdata_7bit( 36 ) --> "$".
1334		pcdata_7bit( 37 ) --> "%".
1335		pcdata_7bit( 38 ) --> "&".
1336		pcdata_7bit( 39 ) --> "'".
1337		pcdata_7bit( 40 ) --> "(".
1338		pcdata_7bit( 41 ) --> ")".
1339		pcdata_7bit( 42 ) --> "*".
1340		pcdata_7bit( 43 ) --> "+".
1341		pcdata_7bit( 44 ) --> ",".
1342		pcdata_7bit( 45 ) --> "-".
1343		pcdata_7bit( 46 ) --> ".".
1344		pcdata_7bit( 47 ) --> "/".
1345		pcdata_7bit( 48 ) --> "0".
1346		pcdata_7bit( 49 ) --> "1".
1347		pcdata_7bit( 50 ) --> "2".
1348		pcdata_7bit( 51 ) --> "3".
1349		pcdata_7bit( 52 ) --> "4".
1350		pcdata_7bit( 53 ) --> "5".
1351		pcdata_7bit( 54 ) --> "6".
1352		pcdata_7bit( 55 ) --> "7".
1353		pcdata_7bit( 56 ) --> "8".
1354		pcdata_7bit( 57 ) --> "9".
1355		pcdata_7bit( 58 ) --> ":".
1356		pcdata_7bit( 59 ) --> ";".
1357		pcdata_7bit( 60 ) --> "<".
1358		pcdata_7bit( 61 ) --> "=".
1359		pcdata_7bit( 62 ) --> ">".
1360		pcdata_7bit( 63 ) --> "?".
1361		pcdata_7bit( 64 ) --> "@".
1362		pcdata_7bit( 65 ) --> "A".
1363		pcdata_7bit( 66 ) --> "B".
1364		pcdata_7bit( 67 ) --> "C".
1365		pcdata_7bit( 68 ) --> "D".
1366		pcdata_7bit( 69 ) --> "E".
1367		pcdata_7bit( 70 ) --> "F".
1368		pcdata_7bit( 71 ) --> "G".
1369		pcdata_7bit( 72 ) --> "H".
1370		pcdata_7bit( 73 ) --> "I".
1371		pcdata_7bit( 74 ) --> "J".
1372		pcdata_7bit( 75 ) --> "K".
1373		pcdata_7bit( 76 ) --> "L".
1374		pcdata_7bit( 77 ) --> "M".
1375		pcdata_7bit( 78 ) --> "N".
1376		pcdata_7bit( 79 ) --> "O".
1377		pcdata_7bit( 80 ) --> "P".
1378		pcdata_7bit( 81 ) --> "Q".
1379		pcdata_7bit( 82 ) --> "R".
1380		pcdata_7bit( 83 ) --> "S".
1381		pcdata_7bit( 84 ) --> "T".
1382		pcdata_7bit( 85 ) --> "U".
1383		pcdata_7bit( 86 ) --> "V".
1384		pcdata_7bit( 87 ) --> "W".
1385		pcdata_7bit( 88 ) --> "X".
1386		pcdata_7bit( 89 ) --> "Y".
1387		pcdata_7bit( 90 ) --> "Z".
1388		pcdata_7bit( 91 ) --> "[".
1389		pcdata_7bit( 92 ) --> [92].
1390		pcdata_7bit( 93 ) --> "]".
1391		pcdata_7bit( 94 ) --> "^".
1392		pcdata_7bit( 95 ) --> "_".
1393		pcdata_7bit( 96 ) --> "`".
1394		pcdata_7bit( 97 ) --> "a".
1395		pcdata_7bit( 98 ) --> "b".
1396		pcdata_7bit( 99 ) --> "c".
1397		pcdata_7bit( 100 ) --> "d".
1398		pcdata_7bit( 101 ) --> "e".
1399		pcdata_7bit( 102 ) --> "f".
1400		pcdata_7bit( 103 ) --> "g".
1401		pcdata_7bit( 104 ) --> "h".
1402		pcdata_7bit( 105 ) --> "i".
1403		pcdata_7bit( 106 ) --> "j".
1404		pcdata_7bit( 107 ) --> "k".
1405		pcdata_7bit( 108 ) --> "l".
1406		pcdata_7bit( 109 ) --> "m".
1407		pcdata_7bit( 110 ) --> "n".
1408		pcdata_7bit( 111 ) --> "o".
1409		pcdata_7bit( 112 ) --> "p".
1410		pcdata_7bit( 113 ) --> "q".
1411		pcdata_7bit( 114 ) --> "r".
1412		pcdata_7bit( 115 ) --> "s".
1413		pcdata_7bit( 116 ) --> "t".
1414		pcdata_7bit( 117 ) --> "u".
1415		pcdata_7bit( 118 ) --> "v".
1416		pcdata_7bit( 119 ) --> "w".
1417		pcdata_7bit( 120 ) --> "x".
1418		pcdata_7bit( 121 ) --> "y".
1419		pcdata_7bit( 122 ) --> "z".
1420		pcdata_7bit( 123 ) --> "{".
1421		pcdata_7bit( 124 ) --> "|".
1422		pcdata_7bit( 125 ) --> "}".
1423		pcdata_7bit( 126 ) --> "~".
1424		pcdata_7bit( 127 ) --> "".
1425
1426		pcdata_8bits_plus( Codes ) -->
1427		"&#", chars( Codes ), ";".
1428
1429		/* cdata_generation( +Chars ) is a DCG representing Chars, a list of character
1430		* codes as a legal XML CDATA string. Any character codes disallowed by the XML
1431		* specification are not encoded.
1432		*/
1433		cdata_generation( [] ) --> "".
1434		cdata_generation( [Char|Chars] ) -->
1435		( {legal_xml_unicode( Char )}, !, [Char]
1436		| ""
1437		),
1438		cdata_generation( Chars ).
1439
1440		legal_xml_unicode( 9 ).
1441		legal_xml_unicode( 10 ).
1442		legal_xml_unicode( 13 ).
1443		legal_xml_unicode( Code ) :-
1444		Code >= 32,
1445		Code =< 55295.
1446		legal_xml_unicode( Code ) :-
1447		Code >= 57344,
1448		Code =< 65533.
1449		legal_xml_unicode( Code ) :-
1450		Code >= 65536,
1451		Code =< 1114111.
1452
1453		/* xml_pp: "pretty print" an XML Document on the current output stream.
1454		*
1455		* Current Release: 1.9
1456		*/
1457		/* xml_pp( +XMLDocument ) "pretty prints" XMLDocument on the current
1458		* output stream.
1459		*/
1460		xml_pp( xml(Attributes, Document) ) :-
1461		write( 'xml( ' ), pp_attributes( Attributes, "" ), put_code( 0', ), nl,
1462		xml_pp_list( Document, "\t" ),
1463		format( ' ).~n', [] ).
1464		xml_pp( malformed(Attributes, Document) ) :-
1465		write( 'malformed( ' ), pp_attributes( Attributes, "" ), put_code( 0', ), nl,
1466		xml_pp_list( Document, "\t" ),
1467		format( ' ).~n', [] ).
1468
1469		xml_pp_indented( [], Indent ) :-
1470		format( '~s[]', [Indent] ).
1471		xml_pp_indented( List, Indent ) :-
1472		List = [_|_],
1473		format( '~s', [Indent] ),
1474		xml_pp_list( List, Indent ).
1475		xml_pp_indented( comment(Text), Indent ) :-
1476		format( '~scomment(', [Indent] ), pp_string(Text), put_code( 0') ).
1477		xml_pp_indented( namespace(URI,Prefix,Element), Indent ) :-
1478		format( '~snamespace( ~q, "~s",~n', [Indent,URI,Prefix] ),
1479		xml_pp_indented( Element, [0'\t|Indent] ),
1480		format( '~n~s)', [[0'\t|Indent]] ).
1481		xml_pp_indented( element(Tag,Attributes,Contents), Indent ) :-
1482		format( '~selement( ~q,~n', [Indent,Tag] ),
1483		pp_attributes( Attributes, [0'\t|Indent] ), put_code(0',), nl,
1484		xml_pp_list( Contents, [0'\t|Indent] ), write( ' )' ).
1485		xml_pp_indented( instructions(Target, Processing), Indent ) :-
1486		format( '~sinstructions( ~q, ', [Indent,Target] ),
1487		pp_string(Processing), put_code( 0') ).
1488		xml_pp_indented( doctype(Name, DoctypeId), Indent ) :-
1489		format( '~sdoctype( ~q, ', [Indent,Name] ),
1490		xml_pp_indented( DoctypeId, [0'\t|Indent] ),
1491		write( ' )' ).
1492		xml_pp_indented( cdata(CData), Indent ) :-
1493		format( '~scdata(', [Indent] ), pp_string(CData), put_code( 0') ).
1494		xml_pp_indented( pcdata(PCData), Indent ) :-
1495		format( '~spcdata(', [Indent] ), pp_string(PCData), put_code( 0') ).
1496		xml_pp_indented( public(URN,URL), _Indent ) :-
1497		format( 'public( "~s", "~s" )', [URN,URL] ).
1498		xml_pp_indented( public(URN,URL,Literals), Indent ) :-
1499		format( 'public( "~s", "~s",~n', [URN,URL] ),
1500		xml_pp_list( Literals, [0'\t|Indent] ), write( ' )' ). %'
1501		xml_pp_indented( system(URL), _Indent ) :-
1502		format( 'system( "~s" )', [URL] ).
1503		xml_pp_indented( system(URL,Literals), Indent ) :-
1504		format( 'system( "~s",~n', [URL] ),
1505		xml_pp_list( Literals, [0'\t|Indent] ), write( ' )' ). %'
1506		xml_pp_indented( local, _Indent ) :-
1507		write( local ).
1508		xml_pp_indented( local(Literals), Indent ) :-
1509		write( 'local(' ), nl,
1510		xml_pp_list( Literals, [0'\t|Indent] ), write( ' )' ). %'
1511		xml_pp_indented( dtd_literal(String), Indent ) :-
1512		format( '~sdtd_literal(', [Indent] ), pp_string(String), put_code( 0') ). %'
1513		xml_pp_indented( out_of_context(Tag), Indent ) :-
1514		format( '~s/* SYNTAX ERROR */ out_of_context( ~q )', [Indent,Tag] ).
1515		xml_pp_indented( unparsed(String), Indent ) :-
1516		format( '~s/* SYNTAX ERROR */ unparsed( ', [Indent] ),
1517		pp_string(String), put_code( 0') ).
1518
1519		xml_pp_list( [], Indent ) :-
1520		format( '~s[]', [Indent] ).
1521		xml_pp_list( [H|T], Indent ) :-
1522		format( '~s[~n', [Indent] ),
1523		xml_pp_indented( H, Indent ),
1524		xml_pp_list1( T, Indent ),
1525		format( '~s]', [Indent] ).
1526
1527		xml_pp_list1( [], _Indent ) :-
1528		nl.
1529		xml_pp_list1( [H|T], Indent ) :-
1530		put_code( 0', ), nl,
1531		xml_pp_indented( H, Indent ),
1532		xml_pp_list1( T, Indent ).
1533
1534		% PATCH LEUSCHEL:
1535		pp_attributes( Attributes, Indent ) :-
1536		(select('$attribute_linefeeds'=_Count,Attributes,Rest)
1537		-> pp_attributes2(Rest,Indent) % TO DO: insert linefeeds
1538		; pp_attributes2(Attributes,Indent)).
1539
1540		pp_attributes2( [], Indent ) :-
1541		format( '~s[]', [Indent] ).
1542		pp_attributes2( [Attribute|Attributes], Indent ) :-
1543		format( '~s[', [Indent] ),
1544		pp_attributes1( Attributes, Attribute ),
1545		put_code( 0'] ).
1546		% END PATCH
1547		pp_attributes1( [], Name=Value ) :-
1548		format( '~q=', [Name] ), pp_string( Value ).
1549		pp_attributes1( [H|T], Name=Value ) :-
1550		format( '~q=', [Name] ), pp_string( Value ), write( ', ' ),
1551		pp_attributes1( T, H ).
1552		/* XML Utilities
1553		*
1554		* $Revision$
1555		*/
1556
1557		% Entity and Namespace map operations: these maps are usually quite small, so
1558		% a linear list lookup is okay. They could be substituted by a logarithmic
1559		% data structure - in extremis.
1560
1561		/* empty_map( ?Map ) is true if Map is a null map.
1562		*/
1563		empty_map( [] ).
1564
1565		/* map_member( +Key, +Map, ?Data ) is true if Map is a ordered map structure
1566		* which records the pair Key-Data. Key must be ground.
1567		*/
1568		map_member( Key0, [Key1-Data1|Rest], Data0 ) :-
1569		( Key0 == Key1 ->
1570		Data0 = Data1
1571		; Key0 @> Key1 ->
1572		map_member( Key0, Rest, Data0 )
1573		).
1574
1575		/* map_store( +Map0, +Key, +Data, ?Map1 ) is true if Map0 is an ordered map
1576		* structure, Key must be ground, and Map1 is identical to Map0 except that
1577		* the pair Key-Data is recorded by Map1.
1578		*/
1579		map_store( [], Key, Data, [Key-Data] ).
1580		map_store( [Key0-Data0|Map0], Key, Data, Map ) :-
1581		( Key == Key0 ->
1582		Map = [Key-Data|Map0]
1583		; Key @< Key0 ->
1584		Map = [Key-Data,Key0-Data0|Map0]
1585		; otherwise -> % >
1586		Map = [Key0-Data0|Map1],
1587		map_store( Map0, Key, Data, Map1 )
1588		).
1589
1590		/* context(?Element, ?PreserveSpace, ?CurrentNS, ?DefaultNS, ?Entities, ?Namespaces )
1591		* is an ADT hiding the "state" arguments for XML Acquisition
1592		*/
1593		initial_context(
1594		opt(Fmt,Ext,RemoveAttributePrefixes),
1595		context(void,PreserveSpace,'','',Entities,Empty,
1596		RemoveAttributePrefixes)
1597		) :-
1598		empty_map( Empty ),
1599		( Ext==false ->
1600		Entities = Empty
1601		; otherwise ->
1602		extended_character_entities(Entities)
1603		),
1604		( Fmt==false ->
1605		PreserveSpace = true
1606		; otherwise ->
1607		PreserveSpace = false
1608		).
1609
1610		context_update( current_namespace, Context0, URI, Context1 ) :-
1611		Context0 = context(Element,Preserve,_Current,Default,Entities,
1612		Namespaces,RemoveAttributePrefixes),
1613		Context1 = context(Element,Preserve,URI,Default,Entities,
1614		Namespaces,RemoveAttributePrefixes).
1615		context_update( element, Context0, Tag, Context1 ) :-
1616		Context0 = context(_Element,Preserve,Current,Default,Entities,
1617		Namespaces,RemoveAttributePrefixes),
1618		Context1 = context(tag(Tag),Preserve,Current,Default,Entities,
1619		Namespaces,RemoveAttributePrefixes).
1620		context_update( default_namespace, Context0, URI, Context1 ):-
1621		Context0 = context(Element,Preserve,Current,_Default,Entities,
1622		Namespaces,RemoveAttributePrefixes),
1623		Context1 = context(Element,Preserve,Current,URI,Entities,
1624		Namespaces,RemoveAttributePrefixes).
1625		context_update( space_preserve, Context0, Boolean, Context1 ):-
1626		Context0 = context(Element,_Preserve,Current,Default,Entities,
1627		Namespaces,RemoveAttributePrefixes),
1628		Context1 = context(Element,Boolean,Current,Default,Entities,
1629		Namespaces,RemoveAttributePrefixes).
1630		context_update( ns_prefix(Prefix), Context0, URI, Context1 ) :-
1631		Context0 = context(Element,Preserve,Current,Default,Entities,
1632		Namespaces0,RemoveAttributePrefixes),
1633		Context1 = context(Element,Preserve,Current,Default,Entities,
1634		Namespaces1,RemoveAttributePrefixes),
1635		map_store( Namespaces0, Prefix, URI, Namespaces1 ).
1636		context_update( entity(Name), Context0, String, Context1 ) :-
1637		Context0 = context(Element,Preserve,Current,Default,Entities0,
1638		Namespaces,RemoveAttributePrefixes),
1639		Context1 = context(Element,Preserve,Current,Default,Entities1,
1640		Namespaces,RemoveAttributePrefixes),
1641		map_store( Entities0, Name, String, Entities1 ).
1642
1643		remove_attribute_prefixes( Context ) :-
1644		Context = context(_Element,_Preserve,_Current,_Default,_Entities,
1645		_Namespaces,true).
1646
1647		current_tag( Context, Tag ) :-
1648		Context = context(tag(Tag),_Preserve,_Current,_Default,_Entities,
1649		_Namespaces,_RPFA).
1650
1651		current_namespace( Context, Current ) :-
1652		Context = context(_Element,_Preserve,Current,_Default,_Entities,
1653		_Namespaces,_RPFA).
1654
1655		default_namespace( Context, Default ) :-
1656		Context = context(_Element,_Preserve,_Current,Default,_Entities,
1657		_Namespaces,_RPFA).
1658
1659		space_preserve( Context ) :-
1660		Context = context(_Element,true,_Current,_Default,_Entities,
1661		_Namespaces,_RPFA).
1662
1663		specific_namespace( Prefix, Context, URI ) :-
1664		Context = context(_Element,_Preserve,_Current,_Default,_Entities,
1665		Namespaces,_RPFA),
1666		map_member( Prefix, Namespaces, URI ).
1667
1668		defined_entity( Reference, Context, String ) :-
1669		Context = context(_Element,_Preserve,_Current,_Default,Entities,
1670		_Namespaces,_RPFA),
1671		map_member( Reference, Entities, String ).
1672
1673		close_context( Context, Terms, WellFormed ) :-
1674		Context = context(Element,_Preserve,_Current,_Default,_Entities,
1675		_Namespaces,_RPFA),
1676		close_context1( Element, Terms, WellFormed ).
1677
1678		close_context1( void, [], true ).
1679		close_context1( tag(TagChars), [out_of_context(Tag)], false ) :-
1680		atom_codes( Tag, TagChars ).
1681
1682		void_context(
1683		context(void,_Preserve,_Current,_Default,_Entities,_Namespaces)
1684		).
1685
1686		/* pp_string( +String ) prints String onto the current output stream.
1687		* If String contains only 7-bit chars it is printed in shorthand quoted
1688		* format, otherwise it is written as a list.
1689		* If your Prolog uses " to delimit a special string type, just use write/1.
1690		*/
1691		% [MC] rewritten
1692		pp_string(Chars) :-
1693		put_code(0'"),
1694		pp_string1(Chars),
1695		put_code(0'").
1696
1697		pp_string1([]).
1698		pp_string1([Char|Chars]) :-
1699		pp_string2(Char),
1700		pp_string1(Chars).
1701
1702		pp_string2(0'\a) :- !,
1703		put_code(0'\\),
1704		put_code(0'a).
1705		pp_string2(0'\b) :- !,
1706		put_code(0'\\),
1707		put_code(0'b).
1708		pp_string2(0'\t) :- !,
1709		put_code(0'\\),
1710		put_code(0't).
1711		pp_string2(0'\n) :- !,
1712		put_code(0'\\),
1713		put_code(0'n).
1714		pp_string2(0'\v) :- !,
1715		put_code(0'\\),
1716		put_code(0'v).
1717		pp_string2(0'\f) :- !,
1718		put_code(0'\\),
1719		put_code(0'f).
1720		pp_string2(0'\r) :- !,
1721		put_code(0'\\),
1722		put_code(0'r).
1723		pp_string2(0'\e) :- !,
1724		put_code(0'\\),
1725		put_code(0'e).
1726		pp_string2(0'\d) :- !,
1727		put_code(0'\\),
1728		put_code(0'd).
1729		pp_string2(0'\") :- !,
1730		put_code(0'\\),
1731		put_code(0'").
1732		pp_string2(0'\\) :- !,
1733		put_code(0'\\),
1734		put_code(0'\\).
1735		pp_string2(Char) :-
1736		Char>=32, Char=<126, !,
1737		put_code(Char).
1738		pp_string2(Char) :-
1739		format('\\~8r\\', [Char]).
1740
1741		xml_declaration_attributes_valid( [] ).
1742		xml_declaration_attributes_valid( [Name=Value|Attributes] ) :-
1743		xml_declaration_attribute_valid( Name, Value ),
1744		xml_declaration_attributes_valid( Attributes ).
1745
1746		xml_declaration_attribute_valid( Name, Value ) :-
1747		lowercase( Value, Lowercase ),
1748		canonical_xml_declaration_attribute( Name, Lowercase ).
1749
1750		canonical_xml_declaration_attribute( version, "1.0" ).
1751		canonical_xml_declaration_attribute( standalone, "yes" ).
1752		canonical_xml_declaration_attribute( standalone, "no" ).
1753		canonical_xml_declaration_attribute( encoding, "utf-8" ).
1754		canonical_xml_declaration_attribute( encoding, "utf-16" ).
1755		canonical_xml_declaration_attribute( encoding, "ascii" ).
1756		canonical_xml_declaration_attribute( encoding, "iso-8859-1" ).
1757		canonical_xml_declaration_attribute( encoding, "iso-8859-2" ).
1758		canonical_xml_declaration_attribute( encoding, "iso-8859-15" ).
1759		canonical_xml_declaration_attribute( encoding, "windows-1252" ).
1760
1761		/* lowercase( +MixedCase, ?Lowercase ) holds when Lowercase and MixedCase are
1762		* lists of character codes, and Lowercase is identical to MixedCase with
1763		* every uppercase character replaced by its lowercase equivalent.
1764		*/
1765		lowercase( [], [] ).
1766		lowercase( [Char|Chars], [Lower|LowerCase] ) :-
1767		( Char >= "A", Char =< "Z" ->
1768		Lower is Char + "a" - "A"
1769		; otherwise ->
1770		Lower = Char
1771		),
1772		lowercase( Chars, LowerCase ).
1773
1774		:- dynamic extended_character_entities/1. % no point compiling it
1775		extended_character_entities( [
1776		"Aacute"-[193], % latin capital letter A with acute,
1777		"aacute"-[225], % latin small letter a with acute,
1778		"Acirc"-[194], % latin capital letter A with circumflex,
1779		"acirc"-[226], % latin small letter a with circumflex,
1780		"acute"-[180], % acute accent = spacing acute,
1781		"AElig"-[198], % latin capital letter AE
1782		"aelig"-[230], % latin small letter ae
1783		"Agrave"-[192], % latin capital letter A with grave
1784		"agrave"-[224], % latin small letter a with grave
1785		"alefsym"-[8501], % alef symbol = first transfinite cardinal,
1786		"Alpha"-[913], % greek capital letter alpha, U+0391
1787		"alpha"-[945], % greek small letter alpha,
1788		"and"-[8743], % logical and = wedge, U+2227 ISOtech
1789		"ang"-[8736], % angle, U+2220 ISOamso
1790		"Aring"-[197], % latin capital letter A with ring above
1791		"aring"-[229], % latin small letter a with ring above
1792		"asymp"-[8776], % almost equal to = asymptotic to,
1793		"Atilde"-[195], % latin capital letter A with tilde,
1794		"atilde"-[227], % latin small letter a with tilde,
1795		"Auml"-[196], % latin capital letter A with diaeresis,
1796		"auml"-[228], % latin small letter a with diaeresis,
1797		"bdquo"-[8222], % double low-9 quotation mark, U+201E NEW
1798		"Beta"-[914], % greek capital letter beta, U+0392
1799		"beta"-[946], % greek small letter beta, U+03B2 ISOgrk3
1800		"brvbar"-[166], % broken bar = broken vertical bar,
1801		"bull"-[8226], % bullet = black small circle,
1802		"cap"-[8745], % intersection = cap, U+2229 ISOtech
1803		"Ccedil"-[199], % latin capital letter C with cedilla,
1804		"ccedil"-[231], % latin small letter c with cedilla,
1805		"cedil"-[184], % cedilla = spacing cedilla, U+00B8 ISOdia>
1806		"cent"-[162], % cent sign, U+00A2 ISOnum>
1807		"Chi"-[935], % greek capital letter chi, U+03A7
1808		"chi"-[967], % greek small letter chi, U+03C7 ISOgrk3
1809		"circ"-[710], % modifier letter circumflex accent,
1810		"clubs"-[9827], % black club suit = shamrock,
1811		"cong"-[8773], % approximately equal to, U+2245 ISOtech
1812		"copy"-[169], % copyright sign, U+00A9 ISOnum>
1813		"crarr"-[8629], % downwards arrow with corner leftwards
1814		"cup"-[8746], % union = cup, U+222A ISOtech
1815		"curren"-[164], % currency sign, U+00A4 ISOnum>
1816		"dagger"-[8224], % dagger, U+2020 ISOpub
1817		"Dagger"-[8225], % double dagger, U+2021 ISOpub
1818		"darr"-[8595], % downwards arrow, U+2193 ISOnum
1819		"dArr"-[8659], % downwards double arrow, U+21D3 ISOamsa
1820		"deg"-[176], % degree sign, U+00B0 ISOnum>
1821		"Delta"-[916], % greek capital letter delta,
1822		"delta"-[948], % greek small letter delta,
1823		"diams"-[9830], % black diamond suit, U+2666 ISOpub
1824		"divide"-[247], % division sign, U+00F7 ISOnum>
1825		"Eacute"-[201], % latin capital letter E with acute,
1826		"eacute"-[233], % latin small letter e with acute,
1827		"Ecirc"-[202], % latin capital letter E with circumflex,
1828		"ecirc"-[234], % latin small letter e with circumflex,
1829		"Egrave"-[200], % latin capital letter E with grave,
1830		"egrave"-[232], % latin small letter e with grave,
1831		"empty"-[8709], % empty set = null set = diameter,
1832		"emsp"-[8195], % em space, U+2003 ISOpub
1833		"ensp"-[8194], % en space, U+2002 ISOpub
1834		"Epsilon"-[917], % greek capital letter epsilon, U+0395
1835		"epsilon"-[949], % greek small letter epsilon,
1836		"equiv"-[8801], % identical to, U+2261 ISOtech
1837		"Eta"-[919], % greek capital letter eta, U+0397
1838		"eta"-[951], % greek small letter eta, U+03B7 ISOgrk3
1839		"ETH"-[208], % latin capital letter ETH, U+00D0 ISOlat1>
1840		"eth"-[240], % latin small letter eth, U+00F0 ISOlat1>
1841		"Euml"-[203], % latin capital letter E with diaeresis,
1842		"euml"-[235], % latin small letter e with diaeresis,
1843		"euro"-[8364], % euro sign, U+20AC NEW
1844		"exist"-[8707], % there exists, U+2203 ISOtech
1845		"fnof"-[402], % latin small f with hook = function
1846		"forall"-[8704], % for all, U+2200 ISOtech
1847		"frac12"-[189], % vulgar fraction one half
1848		"frac14"-[188], % vulgar fraction one quarter
1849		"frac34"-[190], % vulgar fraction three quarters
1850		"frasl"-[8260], % fraction slash, U+2044 NEW
1851		"Gamma"-[915], % greek capital letter gamma,
1852		"gamma"-[947], % greek small letter gamma,
1853		"ge"-[8805], % greater-than or equal to,
1854		"harr"-[8596], % left right arrow, U+2194 ISOamsa
1855		"hArr"-[8660], % left right double arrow,
1856		"hearts"-[9829], % black heart suit = valentine,
1857		"hellip"-[8230], % horizontal ellipsis = three dot leader,
1858		"Iacute"-[205], % latin capital letter I with acute,
1859		"iacute"-[237], % latin small letter i with acute,
1860		"Icirc"-[206], % latin capital letter I with circumflex,
1861		"icirc"-[238], % latin small letter i with circumflex,
1862		"iexcl"-[161], % inverted exclamation mark, U+00A1 ISOnum>
1863		"Igrave"-[204], % latin capital letter I with grave,
1864		"igrave"-[236], % latin small letter i with grave,
1865		"image"-[8465], % blackletter capital I = imaginary part,
1866		"infin"-[8734], % infinity, U+221E ISOtech
1867		"int"-[8747], % integral, U+222B ISOtech
1868		"Iota"-[921], % greek capital letter iota, U+0399
1869		"iota"-[953], % greek small letter iota, U+03B9 ISOgrk3
1870		"iquest"-[191], % inverted question mark
1871		"isin"-[8712], % element of, U+2208 ISOtech
1872		"Iuml"-[207], % latin capital letter I with diaeresis,
1873		"iuml"-[239], % latin small letter i with diaeresis,
1874		"Kappa"-[922], % greek capital letter kappa, U+039A
1875		"kappa"-[954], % greek small letter kappa,
1876		"Lambda"-[923], % greek capital letter lambda,
1877		"lambda"-[955], % greek small letter lambda,
1878		"lang"-[9001], % left-pointing angle bracket = bra,
1879		"laquo"-[171], % left-pointing double angle quotation mark
1880		"larr"-[8592], % leftwards arrow, U+2190 ISOnum
1881		"lArr"-[8656], % leftwards double arrow, U+21D0 ISOtech
1882		"lceil"-[8968], % left ceiling = apl upstile,
1883		"ldquo"-[8220], % left double quotation mark,
1884		"le"-[8804], % less-than or equal to, U+2264 ISOtech
1885		"lfloor"-[8970], % left floor = apl downstile,
1886		"lowast"-[8727], % asterisk operator, U+2217 ISOtech
1887		"loz"-[9674], % lozenge, U+25CA ISOpub
1888		"lrm"-[8206], % left-to-right mark, U+200E NEW RFC 2070
1889		"lsaquo"-[8249], % single left-pointing angle quotation mark,
1890		"lsquo"-[8216], % left single quotation mark,
1891		"macr"-[175], % macron = spacing macron = overline
1892		"mdash"-[8212], % em dash, U+2014 ISOpub
1893		"micro"-[181], % micro sign, U+00B5 ISOnum>
1894		"middot"-[183], % middle dot = Georgian comma
1895		"minus"-[8722], % minus sign, U+2212 ISOtech
1896		"Mu"-[924], % greek capital letter mu, U+039C
1897		"mu"-[956], % greek small letter mu, U+03BC ISOgrk3
1898		"nabla"-[8711], % nabla = backward difference,
1899		"nbsp"-[160], % no-break space = non-breaking space,
1900		"ndash"-[8211], % en dash, U+2013 ISOpub
1901		"ne"-[8800], % not equal to, U+2260 ISOtech
1902		"ni"-[8715], % contains as member, U+220B ISOtech
1903		"not"-[172], % not sign, U+00AC ISOnum>
1904		"notin"-[8713], % not an element of, U+2209 ISOtech
1905		"nsub"-[8836], % not a subset of, U+2284 ISOamsn
1906		"Ntilde"-[209], % latin capital letter N with tilde,
1907		"ntilde"-[241], % latin small letter n with tilde,
1908		"Nu"-[925], % greek capital letter nu, U+039D
1909		"nu"-[957], % greek small letter nu, U+03BD ISOgrk3
1910		"Oacute"-[211], % latin capital letter O with acute,
1911		"oacute"-[243], % latin small letter o with acute,
1912		"Ocirc"-[212], % latin capital letter O with circumflex,
1913		"ocirc"-[244], % latin small letter o with circumflex,
1914		"OElig"-[338], % latin capital ligature OE,
1915		"oelig"-[339], % latin small ligature oe, U+0153 ISOlat2
1916		"Ograve"-[210], % latin capital letter O with grave,
1917		"ograve"-[242], % latin small letter o with grave,
1918		"oline"-[8254], % overline = spacing overscore,
1919		"Omega"-[937], % greek capital letter omega,
1920		"omega"-[969], % greek small letter omega,
1921		"Omicron"-[927], % greek capital letter omicron, U+039F
1922		"omicron"-[959], % greek small letter omicron, U+03BF NEW
1923		"oplus"-[8853], % circled plus = direct sum,
1924		"or"-[8744], % logical or = vee, U+2228 ISOtech
1925		"ordf"-[170], % feminine ordinal indicator, U+00AA ISOnum>
1926		"ordm"-[186], % masculine ordinal indicator,
1927		"Oslash"-[216], % latin capital letter O with stroke
1928		"oslash"-[248], % latin small letter o with stroke,
1929		"Otilde"-[213], % latin capital letter O with tilde,
1930		"otilde"-[245], % latin small letter o with tilde,
1931		"otimes"-[8855], % circled times = vector product,
1932		"Ouml"-[214], % latin capital letter O with diaeresis,
1933		"ouml"-[246], % latin small letter o with diaeresis,
1934		"para"-[182], % pilcrow sign = paragraph sign,
1935		"part"-[8706], % partial differential, U+2202 ISOtech
1936		"permil"-[8240], % per mille sign, U+2030 ISOtech
1937		"perp"-[8869], % up tack = orthogonal to = perpendicular,
1938		"Phi"-[934], % greek capital letter phi,
1939		"phi"-[966], % greek small letter phi, U+03C6 ISOgrk3
1940		"Pi"-[928], % greek capital letter pi, U+03A0 ISOgrk3
1941		"pi"-[960], % greek small letter pi, U+03C0 ISOgrk3
1942		"piv"-[982], % greek pi symbol, U+03D6 ISOgrk3
1943		"plusmn"-[177], % plus-minus sign = plus-or-minus sign,
1944		"pound"-[163], % pound sign, U+00A3 ISOnum>
1945		"prime"-[8242], % prime = minutes = feet, U+2032 ISOtech
1946		"Prime"-[8243], % double prime = seconds = inches,
1947		"prod"-[8719], % n-ary product = product sign,
1948		"prop"-[8733], % proportional to, U+221D ISOtech
1949		"Psi"-[936], % greek capital letter psi,
1950		"psi"-[968], % greek small letter psi, U+03C8 ISOgrk3
1951		"radic"-[8730], % square root = radical sign,
1952		"rang"-[9002], % right-pointing angle bracket = ket,
1953		"raquo"-[187], % right-pointing double angle quotation mark
1954		"rarr"-[8594], % rightwards arrow, U+2192 ISOnum
1955		"rArr"-[8658], % rightwards double arrow,
1956		"rceil"-[8969], % right ceiling, U+2309 ISOamsc
1957		"rdquo"-[8221], % right double quotation mark,
1958		"real"-[8476], % blackletter capital R = real part symbol,
1959		"reg"-[174], % registered sign = registered trade mark sign,
1960		"rfloor"-[8971], % right floor, U+230B ISOamsc
1961		"Rho"-[929], % greek capital letter rho, U+03A1
1962		"rho"-[961], % greek small letter rho, U+03C1 ISOgrk3
1963		"rlm"-[8207], % right-to-left mark, U+200F NEW RFC 2070
1964		"rsaquo"-[8250], % single right-pointing angle quotation mark,
1965		"rsquo"-[8217], % right single quotation mark,
1966		"sbquo"-[8218], % single low-9 quotation mark, U+201A NEW
1967		"Scaron"-[352], % latin capital letter S with caron,
1968		"scaron"-[353], % latin small letter s with caron,
1969		"sdot"-[8901], % dot operator, U+22C5 ISOamsb
1970		"sect"-[167], % section sign, U+00A7 ISOnum>
1971		"shy"-[173], % soft hyphen = discretionary hyphen,
1972		"Sigma"-[931], % greek capital letter sigma,
1973		"sigma"-[963], % greek small letter sigma,
1974		"sigmaf"-[962], % greek small letter final sigma,
1975		"sim"-[8764], % tilde operator = varies with = similar to,
1976		"spades"-[9824], % black spade suit, U+2660 ISOpub
1977		"sub"-[8834], % subset of, U+2282 ISOtech
1978		"sube"-[8838], % subset of or equal to, U+2286 ISOtech
1979		"sum"-[8721], % n-ary sumation, U+2211 ISOamsb
1980		"sup"-[8835], % superset of, U+2283 ISOtech
1981		"sup1"-[185], % superscript one = superscript digit one,
1982		"sup2"-[178], % superscript two = superscript digit two
1983		"sup3"-[179], % superscript three = superscript digit three
1984		"supe"-[8839], % superset of or equal to,
1985		"szlig"-[223], % latin small letter sharp s = ess-zed,
1986		"Tau"-[932], % greek capital letter tau, U+03A4
1987		"tau"-[964], % greek small letter tau, U+03C4 ISOgrk3
1988		"there4"-[8756], % therefore, U+2234 ISOtech
1989		"Theta"-[920], % greek capital letter theta,
1990		"theta"-[952], % greek small letter theta,
1991		"thetasym"-[977], % greek small letter theta symbol,
1992		"thinsp"-[8201], % thin space, U+2009 ISOpub
1993		"THORN"-[222], % latin capital letter THORN,
1994		"thorn"-[254], % latin small letter thorn with,
1995		"tilde"-[732], % small tilde, U+02DC ISOdia
1996		"times"-[215], % multiplication sign, U+00D7 ISOnum>
1997		"trade"-[8482], % trade mark sign, U+2122 ISOnum
1998		"Uacute"-[218], % latin capital letter U with acute,
1999		"uacute"-[250], % latin small letter u with acute,
2000		"uarr"-[8593], % upwards arrow, U+2191 ISOnum
2001		"uArr"-[8657], % upwards double arrow, U+21D1 ISOamsa
2002		"Ucirc"-[219], % latin capital letter U with circumflex,
2003		"ucirc"-[251], % latin small letter u with circumflex,
2004		"Ugrave"-[217], % latin capital letter U with grave,
2005		"ugrave"-[249], % latin small letter u with grave,
2006		"uml"-[168], % diaeresis = spacing diaeresis,
2007		"upsih"-[978], % greek upsilon with hook symbol,
2008		"Upsilon"-[933], % greek capital letter upsilon,
2009		"upsilon"-[965], % greek small letter upsilon,
2010		"Uuml"-[220], % latin capital letter U with diaeresis,
2011		"uuml"-[252], % latin small letter u with diaeresis,
2012		"weierp"-[8472], % script capital P = power set
2013		"Xi"-[926], % greek capital letter xi, U+039E ISOgrk3
2014		"xi"-[958], % greek small letter xi, U+03BE ISOgrk3
2015		"Yacute"-[221], % latin capital letter Y with acute,
2016		"yacute"-[253], % latin small letter y with acute,
2017		"yen"-[165], % yen sign = yuan sign, U+00A5 ISOnum>
2018		"yuml"-[255], % latin small letter y with diaeresis,
2019		"Yuml"-[376], % latin capital letter Y with diaeresis,
2020		"Zeta"-[918], % greek capital letter zeta, U+0396
2021		"zeta"-[950], % greek small letter zeta, U+03B6 ISOgrk3
2022		"zwj"-[8205], % zero width joiner, U+200D NEW RFC 2070
2023		"zwnj"-[8204] % zero width non-joiner,
2024		] ).
2025
2026		/* chars( ?Chars, ?Plus, ?Minus ) used as chars( ?Chars ) in a DCG to
2027		* copy the list Chars inline.
2028		*
2029		* This is best expressed in terms of append/3 where append/3 is built-in.
2030		* For other Prologs, a straightforward specification can be used:
2031		*
2032		* chars( [] ) --> "".
2033		* chars( [Char|Chars] ) -->
2034		* [Char],
2035		* chars( Chars ).
2036		*/
2037		chars( Chars, Plus, Minus ) :-
2038		append( Chars, Minus, Plus ).