include XMLPL package.
This commit is contained in:
499
packages/xml/xml_utilities.pl
Normal file
499
packages/xml/xml_utilities.pl
Normal 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,
|
Reference in New Issue
Block a user