xml_prob

user:generate_message_hook(xml_parse(Message,Document,Culprit,Path)) --> !,
    ['XML Parse: ~a in ~q'-[Message,Document],nl,
    'Culprit: ~q'-[Culprit],nl],
    ( {Path==[]} -> []
    ; ['Path: ~s'-[Path],nl]
).

acquire_pcdata( [], Context, [], Terms, [], WF ) :-
    close_context( Context, Terms, WF ).

acquire_pcdata( [Char|Chars], Context, Chars1, Terms, Residue, WF ) :-
    ( Char =:= "<" ->
    Chars1 = [],
    xml_markup_structure( Chars, Context, Terms, Residue, WF )
    ; Char =:= "&" ->
    reference_in_pcdata( Chars, Context, Chars1, Terms, Residue, WF )
    ;
    Chars1 = [Char|Chars2],
    acquire_pcdata( Chars, Context, Chars2, Terms, Residue, WF )
).

add_xml_error(Msg,Term) :-
    bb_get(xml_prob_current_span,Span),!,
    add_error(xml_prob,Msg,Term,Span).

add_xml_error(Msg,Term) :-
    add_error(xml_prob,Msg,Term).

add_xml_warning(Msg,Term) :-
    bb_get(xml_prob_current_span,Span),!,
    add_warning(xml_prob,Msg,Term,Span).

add_xml_warning(Msg,Term) :-
    add_warning(xml_prob,Msg,Term).

alphabet( 0'a ).

alphabet( 0'b ).

alphabet( 0'c ).

alphabet( 0'd ).

alphabet( 0'e ).

alphabet( 0'f ).

alphabet( 0'g ).

alphabet( 0'h ).

alphabet( 0'i ).

alphabet( 0'j ).

alphabet( 0'k ).

alphabet( 0'l ).

alphabet( 0'm ).

alphabet( 0'n ).

alphabet( 0'o ).

alphabet( 0'p ).

alphabet( 0'q ).

alphabet( 0'r ).

alphabet( 0's ).

alphabet( 0't ).

alphabet( 0'u ).

alphabet( 0'v ).

alphabet( 0'w ).

alphabet( 0'x ).

alphabet( 0'y ).

alphabet( 0'z ).

alphabet( 0'A ).

alphabet( 0'B ).

alphabet( 0'C ).

alphabet( 0'D ).

alphabet( 0'E ).

alphabet( 0'F ).

alphabet( 0'G ).

alphabet( 0'H ).

alphabet( 0'I ).

alphabet( 0'J ).

alphabet( 0'K ).

alphabet( 0'L ).

alphabet( 0'M ).

alphabet( 0'N ).

alphabet( 0'O ).

alphabet( 0'P ).

alphabet( 0'Q ).

alphabet( 0'R ).

alphabet( 0'S ).

alphabet( 0'T ).

alphabet( 0'U ).

alphabet( 0'V ).

alphabet( 0'W ).

alphabet( 0'X ).

alphabet( 0'Y ).

alphabet( 0'Z ).

attribute_fault( Attribute, Attribute, 'Illegal Variable' ) :-
    var( Attribute ).

attribute_fault( Name=Value, Name=Value, 'Attribute Name must be atom' ) :-
    \+ atom(Name).

attribute_fault( Name=Value, Name=Value, 'Attribute Value must be chars' ) :-
    \+ is_chars( Value ).

attribute_fault( Attribute, Attribute, 'Malformed Attribute' ) :-
    Attribute \= (_Name=_Value).

attribute_layouts( 0, _Quote, _Namespaces, _Layout, [], [], [] ).

attribute_layouts( NL, Quote, Namespaces, Layout, String, [Char|Plus], Minus ) :-
    ( Char == Quote ->
    String = [],
    Minus = Plus,
    NL = 0
    ; Char =:= "&" ->
    reference_in_value( NL, Namespaces, Quote, Layout, String, Plus, Minus )
    ; Char =:= 10 -> % count linebreaks, same as above
    attribute_layouts( OldL, Quote, Namespaces, false, String, Plus, Minus ),
    NL is OldL+1
    ; Char > 32, Char \== 160 ->
    ( Layout == true ->
    String = [0' ,Char|String1] %'
    ;
    String = [Char|String1]
    ),
    attribute_layouts( NL, Quote, Namespaces, false, String1, Plus, Minus )
    ;
    attribute_layouts( NL, Quote, Namespaces, true, String, Plus, Minus )
). % PATCH end

attribute_leading_layouts( 0, _Quote, _Namespace, [], [], [] ).

attribute_leading_layouts( NL, Quote, Namespaces, String, [Char|Plus], Minus ) :-
    ( Char == Quote ->
    String = [],
    Minus = Plus,
    NL = 0
    ; Char =:= "&" ->
    reference_in_layout( NL, Namespaces, Quote, String, Plus, Minus )
    ; Char =:= 10 -> % count linebreaks for correct XML line numbers, but don't add to attribute value (according to https://www.w3.org/TR/1998/REC-xml-19980210#AVNormalize)
    attribute_layouts( OldL, Quote, Namespaces, false, String, Plus, Minus ),
    NL is OldL+1
    ; Char > 32, Char \== 160 ->
    String = [Char|String1],
    attribute_layouts( NL, Quote, Namespaces, false, String1, Plus, Minus )
    ;
    attribute_leading_layouts( NL, Quote, Namespaces, String, Plus, Minus )
).

attribute_value( NL, String, Namespaces, Name ) --> % PATCH : add counter NL for line breaks in attribute values
    (quote( Quote ) -> []
    ; {atom_codes(AN,Name), add_xml_warning('Expecting starting quotes for value of XML attribute: ',AN),fail}),
    attribute_leading_layouts( NL, Quote, Namespaces, String ).

attributes( Attributes, Seen, Namespaces ) -->
    attributes_count_lf(0, Attributes, Seen, Namespaces ). % PATCH LEUSCHEL: add count parameter

attributes_count_lf(Count0, [Name=Value|Attributes], Seen, Namespaces ) -->
    spaces_count_linebreaks(Count0,C1),
    nmtoken_chars( Name ),
    {\+ member(Name, Seen)},
    spaces_count_linebreaks(C1,C2),
    expect_tokens("=","attributes"),
    spaces_count_linebreaks(C2,C3),
    attribute_value( CountValue, Value, Namespaces, Name ), % Value does not contain the line breaks anymore, so we have to count them in attribute_layouts.
    !,
    {C4 is C3+CountValue},
    attributes_count_lf( C4, Attributes, [Name|Seen], Namespaces ).

attributes_count_lf( 0, [], _Seen, _Namespaces ) --> !, "". % ,{print(no_linefeeds),nl}.

attributes_count_lf( Count, ["$attribute_linefeeds"=Count], _Seen, _Namespaces ) --> "". %, {print(linefeeds(Count)),nl}.

bool_option(X) :- var(X), !, fail.

bool_option(false).

bool_option(true).

canonical_xml_declaration_attribute( version, "1.0" ).

canonical_xml_declaration_attribute( standalone, "yes" ).

canonical_xml_declaration_attribute( standalone, "no" ).

canonical_xml_declaration_attribute( encoding, "utf-8" ).

canonical_xml_declaration_attribute( encoding, "utf-16" ).

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" ).

canonical_xml_declaration_attribute( encoding, Encoding ) :- atom_codes(Atom,Encoding),
    add_xml_warning('Unsupported xml encoding (which can lead to unexpected results): ',Atom).

cdata( Chars, Plus, Minus ) :-
    append( Chars, [0'],0'],0'>|Minus], Plus ), %'
    !.

cdata_generation( [] ) --> "".

cdata_generation( [Char|Chars] ) -->
    ( {legal_xml_unicode( Char )}, !, [Char]
    |
    ),
    cdata_generation( Chars ).

character_entity( "quot", 0'" ). %'"

character_entity( "amp", 0'& ). %'

character_entity( "lt", 0'< ). %'

character_entity( "gt", 0'> ). %'

character_entity( "apos", 0'\' ).

chars( Chars, Plus, Minus ) :-
    append( Chars, Minus, Plus ).

close_context( Context, Terms, WellFormed ) :-
    Context = context(Element,_Preserve,_Current,_Default,_Entities,
    _Namespaces,_RPFA),
    close_context1( Element, Terms, WellFormed ).

close_context1( void, [], true ).

close_context1( tag(TagChars), [out_of_context(Tag)], false ) :-
    atom_codes( Tag, TagChars ).

close_tag( empty, Residue, _Context, [], Residue, true ).

close_tag( push(Tag), Chars, Context0, Contents, Residue, WF ) :-
    context_update( element, Context0, Tag, Context1 ),
    xml_to_document( Chars, Context1, Contents, Residue, WF ).

closing_tag( Context, Chars, Terms, Residue, WellFormed ) :-
    ( closing_tag_name( Tag, Chars, Rest ),
    current_tag( Context, Tag ) ->
    Terms = [],
    Residue = Rest,
    WellFormed = true
    ;
    unparsed( [0'<,0'/|Chars], Context, Terms, Residue, WellFormed )
).

closing_tag_name( Tag ) -->
    nmtoken_chars( Tag ),
    spaces,
    ">".

comment( Chars, Plus, Minus ) :-
    append( Chars, [0'-,0'-,0'>|Minus], Plus ), %'
    !.

context_update( current_namespace, Context0, URI, Context1 ) :-
    Context0 = context(Element,Preserve,_Current,Default,Entities,
    Namespaces,RemoveAttributePrefixes),
    Context1 = context(Element,Preserve,URI,Default,Entities,
    Namespaces,RemoveAttributePrefixes).

context_update( element, Context0, Tag, Context1 ) :-
    Context0 = context(_Element,Preserve,Current,Default,Entities,
    Namespaces,RemoveAttributePrefixes),
    Context1 = context(tag(Tag),Preserve,Current,Default,Entities,
    Namespaces,RemoveAttributePrefixes).

context_update( default_namespace, Context0, URI, Context1 ):-
    Context0 = context(Element,Preserve,Current,_Default,Entities,
    Namespaces,RemoveAttributePrefixes),
    Context1 = context(Element,Preserve,Current,URI,Entities,
    Namespaces,RemoveAttributePrefixes).

context_update( space_preserve, Context0, Boolean, Context1 ):-
    Context0 = context(Element,_Preserve,Current,Default,Entities,
    Namespaces,RemoveAttributePrefixes),
    Context1 = context(Element,Boolean,Current,Default,Entities,
    Namespaces,RemoveAttributePrefixes).

context_update( ns_prefix(Prefix), Context0, URI, Context1 ) :-
    Context0 = context(Element,Preserve,Current,Default,Entities,
    Namespaces0,RemoveAttributePrefixes),
    Context1 = context(Element,Preserve,Current,Default,Entities,
    Namespaces1,RemoveAttributePrefixes),
    map_store( Namespaces0, Prefix, URI, Namespaces1 ).

context_update( entity(Name), Context0, String, Context1 ) :-
    Context0 = context(Element,Preserve,Current,Default,Entities0,
    Namespaces,RemoveAttributePrefixes),
    Context1 = context(Element,Preserve,Current,Default,Entities1,
    Namespaces,RemoveAttributePrefixes),
    map_store( Entities0, Name, String, Entities1 ).

current_namespace( Context, Current ) :-
    Context = context(_Element,_Preserve,Current,_Default,_Entities,
    _Namespaces,_RPFA).

current_tag( Context, Tag ) :-
    Context = context(tag(Tag),_Preserve,_Current,_Default,_Entities,
    _Namespaces,_RPFA).

declaration_acquisition( Chars, Context, Terms, Residue, WF ) :-
    ( declaration_type( Chars, Type, Chars1 ),
    declaration_parse( Type, Context, Term, Context1, Chars1, Rest ) ->
    Terms = [Term|Terms1],
    xml_to_document( Rest, Context1, Terms1, Residue, WF )
    ;
    unparsed( [0'<,0'!|Chars], Context, Terms, Residue, WF )
).

declaration_parse( comment, Namespaces, comment(Comment), Namespaces ) -->
    comment(Comment).

declaration_parse( cdata, Namespaces, cdata(CData), Namespaces ) -->
    cdata( CData ).

declaration_parse( doctype, Namespaces0, doctype(Name, Names), Namespaces ) -->
    doctype( Name, Names, Namespaces0, Namespaces ),
    spaces,
    ">".

declaration_type( [Char1,Char2|Chars1], Class, Rest ) :-
    Chars = [Char1,Char2|Chars1],
    ( declaration_type1( Char1, Char2, Chars1, Class0, Residue ) ->
    Class = Class0,
    Rest = Residue
    ;
    Class = generic,
    Rest = Chars
).

declaration_type1( 0'-, 0'-, Chars, comment, Chars ).

declaration_type1( 0'[, 0'C, Chars, cdata, Residue ) :-
    append( "DATA[", Residue, Chars ).

declaration_type1( 0'D, 0'O, Chars, doctype, Residue ) :-
    append( "CTYPE", Residue, Chars ).

default_namespace( Context, Default ) :-
    Context = context(_Element,_Preserve,_Current,Default,_Entities,
    _Namespaces,_RPFA).

defined_entity( Reference, Context, String ) :-
    Context = context(_Element,_Preserve,_Current,_Default,Entities,
    _Namespaces,_RPFA),
    map_member( Reference, Entities, String ).

digit( C ) --> [C], {digit_table( C )}.

digit_table( 0'0 ).

digit_table( 0'1 ).

digit_table( 0'2 ).

digit_table( 0'3 ).

digit_table( 0'4 ).

digit_table( 0'5 ).

digit_table( 0'6 ).

digit_table( 0'7 ).

digit_table( 0'8 ).

digit_table( 0'9 ).

digits( [Digit|Digits] ) -->
    digit( Digit ),
    digits( Digits ).

digits( [] ) --> [].

doctype( Name, External, Namespaces0, Namespaces1 ) -->
    spaces,
    nmtoken( Name ),
    spaces,
    doctype_id( External0 ),
    spaces,
    doctype1( Namespaces0, Literals, Namespaces1 ),
    {doctype_extension(Literals, External0, External)}.

doctype1( Namespaces0, Literals, Namespaces1 ) -->
    "[",
    !,
    dtd( Namespaces0, Literals, Namespaces1 ),
    expect_tokens("]","doctype").

doctype1( Namespaces, [], Namespaces ) --> "".

doctype_extension( [], External, External ).

doctype_extension( [Literal|Literals], External0, External ) :-
    extended_doctype( External0, [Literal|Literals], External ).

doctype_id( system(URL) ) -->
    "SYSTEM",
    spaces,
    uri( URL ).

doctype_id( public(URN,URL) ) -->
    "PUBLIC",
    spaces,
    uri( URN ),
    spaces,
    uri( URL ).

doctype_id( local ) --> "".

document_generation( Format, xml(Attributes, Document) ) -->
    document_generation_body( Attributes, Format, Document ).

document_generation_body( [], Format, Document ) -->
    generation( Document, "", Format, [], _Format1 ).

document_generation_body( Attributes, Format, Document ) -->
    { Attributes = [_|_],
    xml_declaration_attributes_valid( Attributes )
    },
    ",
    generated_attributes( Attributes, Format, Format0 ),
    "?>",
    indent( true, [] ),
    generation( Document, "", Format0, [], _Format1 ).