include XMLPL package.

This commit is contained in:
Vítor Santos Costa
2012-02-14 12:41:12 +00:00
parent 6c16f4e953
commit 8c556f21ba
34 changed files with 3568 additions and 2 deletions

View File

@@ -0,0 +1,499 @@
/* XML Utilities
*
* Copyright (C) 2001-2005 Binding Time Limited
* Copyright (C) 2005-2011 John Fletcher
*
* Current Release: $Revision: 3.4 $
*
* 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.
*/
% Entity and Namespace map operations: these maps are usually quite small, so
% a linear list lookup is okay. They could be substituted by a logarithmic
% data structure - in extremis.
/* empty_map( ?Map ) is true if Map is a null map.
*/
empty_map( [] ).
/* map_member( +Key, +Map, ?Data ) is true if Map is a ordered map structure
* which records the pair Key-Data. Key must be ground.
*/
map_member( Key0, [Key1-Data1|Rest], Data0 ) :-
( Key0 == Key1 ->
Data0 = Data1
; Key0 @> Key1 ->
map_member( Key0, Rest, Data0 )
).
/* map_store( +Map0, +Key, +Data, ?Map1 ) is true if Map0 is an ordered map
* structure, Key must be ground, and Map1 is identical to Map0 except that
* the pair Key-Data is recorded by Map1.
*/
map_store( [], Key, Data, [Key-Data] ).
map_store( [Key0-Data0|Map0], Key, Data, Map ) :-
( Key == Key0 ->
Map = [Key-Data|Map0]
; Key @< Key0 ->
Map = [Key-Data,Key0-Data0|Map0]
; otherwise -> % >
Map = [Key0-Data0|Map1],
map_store( Map0, Key, Data, Map1 )
).
/* context(?Element, ?PreserveSpace, ?CurrentNS, ?DefaultNS, ?Entities, ?Namespaces )
* is an ADT hiding the "state" arguments for XML Acquisition
*/
initial_context(
Controls,
context(void,PreserveSpace,'','',Entities,Empty,
RemoveAttributePrefixes,AllowAmpersand)
) :-
empty_map( Empty ),
( member( extended_characters(false), Controls ) ->
Entities = Empty
; otherwise ->
extended_character_entities(Entities)
),
( member( format(false), Controls ) ->
PreserveSpace = true
; otherwise ->
PreserveSpace = false
),
( member( remove_attribute_prefixes(true), Controls ) ->
RemoveAttributePrefixes = true
; otherwise ->
RemoveAttributePrefixes = false
),
( member( allow_ampersand(true), Controls ) ->
AllowAmpersand = true
; otherwise ->
AllowAmpersand = false
).
context_update( current_namespace, Context0, URI, Context1 ) :-
Context0 = context(Element,Preserve,_Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Preserve,URI,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp).
context_update( element, Context0, Tag, Context1 ) :-
Context0 = context(_Element,Preserve,Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(tag(Tag),Preserve,Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp).
context_update( default_namespace, Context0, URI, Context1 ):-
Context0 = context(Element,Preserve,Current,_Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Preserve,Current,URI,Entities,
Namespaces,RemoveAttributePrefixes,Amp).
context_update( space_preserve, Context0, Boolean, Context1 ):-
Context0 = context(Element,_Preserve,Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Boolean,Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp).
context_update( ns_prefix(Prefix), Context0, URI, Context1 ) :-
Context0 = context(Element,Preserve,Current,Default,Entities,
Namespaces0,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Preserve,Current,Default,Entities,
Namespaces1,RemoveAttributePrefixes,Amp),
map_store( Namespaces0, Prefix, URI, Namespaces1 ).
context_update( entity(Name), Context0, String, Context1 ) :-
Context0 = context(Element,Preserve,Current,Default,Entities0,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Preserve,Current,Default,Entities1,
Namespaces,RemoveAttributePrefixes,Amp),
map_store( Entities0, Name, String, Entities1 ).
remove_attribute_prefixes( Context ) :-
Context = context(_Element,_Preserve,_Current,_Default,_Entities,
_Namespaces,true,_Amp).
current_tag( Context, Tag ) :-
Context = context(tag(Tag),_Preserve,_Current,_Default,_Entities,
_Namespaces,_RPFA,_Amp).
current_namespace( Context, Current ) :-
Context = context(_Element,_Preserve,Current,_Default,_Entities,
_Namespaces,_RPFA,_Amp).
default_namespace( Context, Default ) :-
Context = context(_Element,_Preserve,_Current,Default,_Entities,
_Namespaces,_RPFA,_Amp).
space_preserve( Context ) :-
Context = context(tag(_Tag),true,_Current,_Default,_Entities,
_Namespaces,_RPFA,_Amp).
specific_namespace( Prefix, Context, URI ) :-
Context = context(_Element,_Preserve,_Current,_Default,_Entities,
Namespaces,_RPFA,_Amp),
map_member( Prefix, Namespaces, URI ).
defined_entity( Reference, Context, String ) :-
Context = context(_Element,_Preserve,_Current,_Default,Entities,
_Namespaces,_RPFA,_Amp),
map_member( Reference, Entities, String ).
close_context( Context, Terms, WellFormed ) :-
Context = context(Element,_Preserve,_Current,_Default,_Entities,
_Namespaces,_RPFA,_Amp),
close_context1( Element, Terms, WellFormed ).
close_context1( void, [], true ).
close_context1( tag(TagChars), [out_of_context(Tag)], false ) :-
atom_chars( Tag, TagChars ).
void_context(
context(void,_Preserve,_Current,_Default,_Entities,_Names,_RPFA,_Amp)
).
allow_ampersand(
context(_Void,_Preserve,_Current,_Default,_Entities,_Names,_RPFA,true)
).
/* pp_string( +String ) prints String onto the current output stream.
* If String contains only 7-bit chars it is printed in shorthand quoted
* format, otherwise it is written as a list.
* If your Prolog uses " to delimit a special string type, just use write/1.
*/
pp_string( Chars ) :-
( member( Char, Chars ),
not_shorthand( Char ) ->
write( Chars )
; otherwise ->
put_quote,
pp_string1( Chars ),
put_quote
).
not_shorthand( Char ) :-
Char > 255.
not_shorthand( Char ) :-
Char < 9.
not_shorthand( 126 ). % ~ gives syntax errors in LPA Prolog
put_quote :-
put( 0'" ). % '
pp_string1( [] ).
pp_string1( [Char|Chars] ) :-
( Char =:= """" -> % Meta-quote
put( Char ),
put( Char ),
pp_string1( Chars )
; Char =:= 13, % Handle Windows border-settings
Chars = [10|Chars1] ->
put( 10 ),
pp_string1( Chars1 )
; otherwise ->
put( Char ),
pp_string1( Chars )
).
xml_declaration_attributes_valid( [] ).
xml_declaration_attributes_valid( [Name=Value|Attributes] ) :-
xml_declaration_attribute_valid( Name, Value ),
xml_declaration_attributes_valid( Attributes ).
xml_declaration_attribute_valid( Name, Value ) :-
lowercase( Value, Lowercase ),
canonical_xml_declaration_attribute( Name, Lowercase ).
canonical_xml_declaration_attribute( version, "1.0" ).
canonical_xml_declaration_attribute( standalone, "yes" ).
canonical_xml_declaration_attribute( standalone, "no" ).
% The encodings here are all valid for the output produced.
canonical_xml_declaration_attribute( encoding, "utf-8" ).
% canonical_xml_declaration_attribute( encoding, "utf-16" ).
% This is erroneous for the output of this library
canonical_xml_declaration_attribute( encoding, "us-ascii" ).
canonical_xml_declaration_attribute( encoding, "ascii" ).
canonical_xml_declaration_attribute( encoding, "iso-8859-1" ).
canonical_xml_declaration_attribute( encoding, "iso-8859-2" ).
canonical_xml_declaration_attribute( encoding, "iso-8859-15" ).
canonical_xml_declaration_attribute( encoding, "windows-1252" ).
% In general, it's better not to specify an encoding.
/* lowercase( +MixedCase, ?Lowercase ) holds when Lowercase and MixedCase are
* lists of character codes, and Lowercase is identical to MixedCase with
* every uppercase character replaced by its lowercase equivalent.
*/
lowercase( [], [] ).
lowercase( [Char|Chars], [Lower|LowerCase] ) :-
( Char >= "A", Char =< "Z" ->
Lower is Char + "a" - "A"
; otherwise ->
Lower = Char
),
lowercase( Chars, LowerCase ).
extended_character_entities( [
"AElig"-[198], % latin capital letter AE
"Aacute"-[193], % latin capital letter A with acute,
"Acirc"-[194], % latin capital letter A with circumflex,
"Agrave"-[192], % latin capital letter A with grave
"Alpha"-[913], % greek capital letter alpha, U+0391
"Aring"-[197], % latin capital letter A with ring above
"Atilde"-[195], % latin capital letter A with tilde,
"Auml"-[196], % latin capital letter A with diaeresis,
"Beta"-[914], % greek capital letter beta, U+0392
"Ccedil"-[199], % latin capital letter C with cedilla,
"Chi"-[935], % greek capital letter chi, U+03A7
"Dagger"-[8225], % double dagger, U+2021 ISOpub
"Delta"-[916], % greek capital letter delta,
"ETH"-[208], % latin capital letter ETH, U+00D0 ISOlat1>
"Eacute"-[201], % latin capital letter E with acute,
"Ecirc"-[202], % latin capital letter E with circumflex,