1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker & Richard O'Keefe
   4    E-mail:        J.Wielemaker@vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (c)  2004-2016, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(sgml_write,
  37          [ html_write/2,               %          +Data, +Options
  38            html_write/3,               % +Stream, +Data, +Options
  39            sgml_write/2,               %          +Data, +Options
  40            sgml_write/3,               % +Stream, +Data, +Options
  41            xml_write/2,                %          +Data, +Options
  42            xml_write/3                 % +Stream, +Data, +Options
  43          ]).
  44:- use_module(library(lists)).
  45:- use_module(library(sgml)).
  46:- use_module(library(assoc)).
  47:- use_module(library(option)).
  48:- use_module(library(error)).
  49
  50:- predicate_options(xml_write/2, 2, [pass_to(xml_write/3, 3)]).
  51:- predicate_options(xml_write/3, 3,
  52                     [ dtd(any),
  53                       doctype(atom),
  54                       public(atom),
  55                       system(atom),
  56                       header(boolean),
  57                       nsmap(list),
  58                       indent(nonneg),
  59                       layout(boolean),
  60                       net(boolean),
  61                       cleanns(boolean)
  62                     ]).
  63
  64:- multifile
  65    xmlns/2.                        % NS, URI
  66
  67/** <module> XML/SGML writer module
  68
  69This library provides the inverse functionality   of  the sgml.pl parser
  70library, writing XML, SGML and HTML documents from the parsed output. It
  71is intended to allow rewriting in a  different dialect or encoding or to
  72perform document transformation in Prolog on the parsed representation.
  73
  74The current implementation is  particularly   keen  on getting character
  75encoding and the use of character  entities   right.  Some work has been
  76done providing layout, but space handling in   XML  and SGML make this a
  77very hazardous area.
  78
  79The Prolog-based low-level character and  escape   handling  is the real
  80bottleneck in this library and will probably be   moved  to C in a later
  81stage.
  82
  83@see    library(http/html_write) provides a high-level library for
  84        emitting HTML and XHTML.
  85*/
  86
  87%!  xml_write(+Data, +Options) is det.
  88%!  sgml_write(+Data, +Options) is det.
  89%!  html_write(+Data, +Options) is det.
  90%!  xml_write(+Stream, +Data, +Options) is det.
  91%!  sgml_write(+Stream, +Data, +Options) is det.
  92%!  html_write(+Stream, +Data, +Options) is det.
  93%
  94%   Write a term as created by the SGML/XML parser to a stream in
  95%   SGML or XML format.  Options:
  96%
  97%           * cleanns(Bool)
  98%           If `true` (default), remove duplicate `xmlns`
  99%           attributes.
 100%           * dtd(DTD)
 101%           The DTD.  This is needed for SGML documents that contain
 102%           elements with content model EMPTY.  Characters which may
 103%           not be written directly in the Stream's encoding will be
 104%           written using character data entities from the DTD if at
 105%           all possible, otherwise as numeric character references.
 106%           Note that the DTD will NOT be written out at all; as yet
 107%           there is no way to write out an internal subset,  though
 108%           it would not be hard to add one.
 109%
 110%           * doctype(DocType)
 111%           Document type for the SGML document type declaration.
 112%           If omitted it is taken from the root element.  There is
 113%           never any point in having this be disagree with the
 114%           root element.  A <!DOCTYPE> declaration will be written
 115%           if and only if at least one of doctype(_), public(_), or
 116%           system(_) is provided in Options.
 117%
 118%           * public(PubId)
 119%           The public identifier to be written in the <!DOCTYPE> line.
 120%
 121%           * system(SysId)
 122%           The system identifier to be written in the <!DOCTYPE> line.
 123%
 124%           * header(Bool)
 125%           If Bool is 'false', do not emit the <xml ...> header
 126%           line.  (xml_write/3 only)
 127%
 128%           * nsmap(Map:list(Id=URI))
 129%           When emitting embedded XML, assume these namespaces
 130%           are already defined from the environment.  (xml_write/3
 131%           only).
 132%
 133%           * indent(Indent)
 134%           Indentation of the document (for embedding)
 135%
 136%           * layout(Bool)
 137%           Emit/do not emit layout characters to make output
 138%           readable.
 139%
 140%           * net(Bool)
 141%           Use/do not use Null End Tags.
 142%           For XML, this applies only to empty elements, so you get
 143%
 144%           ==
 145%               <foo/>      (default, net(true))
 146%               <foo></foo> (net(false))
 147%           ==
 148%
 149%           For SGML, this applies to empty elements, so you get
 150%
 151%           ==
 152%               <foo>       (if foo is declared to be EMPTY in the DTD)
 153%               <foo></foo> (default, net(false))
 154%               <foo//      (net(true))
 155%           ==
 156%
 157%           and also to elements with character content not containing /
 158%
 159%           ==
 160%               <b>xxx</b>  (default, net(false))
 161%               <b/xxx/     (net(true)).
 162%           ==
 163%
 164%   Note that if the stream is UTF-8, the system will write special
 165%   characters as UTF-8 sequences, while if it is ISO Latin-1 it
 166%   will use (character) entities if there is a DTD that provides
 167%   them, otherwise it will use numeric character references.
 168
 169xml_write(Data, Options) :-
 170    current_output(Stream),
 171    xml_write(Stream, Data, Options).
 172
 173xml_write(Stream0, Data, Options) :-
 174    fix_user_stream(Stream0, Stream),
 175    (   stream_property(Stream, encoding(text))
 176    ->  set_stream(Stream, encoding(utf8)),
 177        call_cleanup(xml_write(Stream, Data, Options),
 178                     set_stream(Stream, encoding(text)))
 179    ;   new_state(xml, State),
 180        init_state(Options, State),
 181        get_state(State, nsmap, NSMap),
 182        add_missing_namespaces(Data, NSMap, Data1),
 183        emit_xml_encoding(Stream, Options),
 184        emit_doctype(Options, Data, Stream),
 185        write_initial_indent(State, Stream),
 186        emit(Data1, Stream, State)
 187    ).
 188
 189
 190sgml_write(Data, Options) :-
 191    current_output(Stream),
 192    sgml_write(Stream, Data, Options).
 193
 194sgml_write(Stream0, Data, Options) :-
 195    fix_user_stream(Stream0, Stream),
 196    (   stream_property(Stream, encoding(text))
 197    ->  set_stream(Stream, encoding(utf8)),
 198        call_cleanup(sgml_write(Stream, Data, Options),
 199                     set_stream(Stream, encoding(text)))
 200    ;   new_state(sgml, State),
 201        init_state(Options, State),
 202        write_initial_indent(State, Stream),
 203        emit_doctype(Options, Data, Stream),
 204        emit(Data, Stream, State)
 205    ).
 206
 207
 208html_write(Data, Options) :-
 209    current_output(Stream),
 210    html_write(Stream, Data, Options).
 211
 212html_write(Stream, Data, Options) :-
 213    sgml_write(Stream, Data,
 214               [ dtd(html)
 215               | Options
 216               ]).
 217
 218fix_user_stream(user, user_output) :- !.
 219fix_user_stream(Stream, Stream).
 220
 221
 222init_state([], _).
 223init_state([H|T], State) :-
 224    update_state(H, State),
 225    init_state(T, State).
 226
 227update_state(dtd(DTD), State) :-
 228    !,
 229    (   atom(DTD)
 230    ->  dtd(DTD, DTDObj)
 231    ;   DTDObj = DTD
 232    ),
 233    set_state(State, dtd, DTDObj),
 234    dtd_character_entities(DTDObj, EntityMap),
 235    set_state(State, entity_map, EntityMap).
 236update_state(nsmap(Map), State) :-
 237    !,
 238    set_state(State, nsmap, Map).
 239update_state(cleanns(Bool), State) :-
 240    !,
 241    must_be(boolean, Bool),
 242    set_state(State, cleanns, Bool).
 243update_state(indent(Indent), State) :-
 244    !,
 245    must_be(integer, Indent),
 246    set_state(State, indent, Indent).
 247update_state(layout(Bool), State) :-
 248    !,
 249    must_be(boolean, Bool),
 250    set_state(State, layout, Bool).
 251update_state(doctype(_), _) :- !.
 252update_state(public(_),  _) :- !.
 253update_state(system(_),  _) :- !.
 254update_state(net(Bool), State) :-
 255    !,
 256    must_be(boolean, Bool),
 257    set_state(State, net, Bool).
 258update_state(header(Bool), _) :-
 259    !,
 260    must_be(boolean, Bool).
 261update_state(Option, _) :-
 262    domain_error(xml_write_option, Option).
 263
 264%       emit_xml_encoding(+Stream, +Options)
 265%
 266%       Emit the XML fileheader with   encoding information. Setting the
 267%       right encoding on the output stream  must be done before calling
 268%       xml_write/3.
 269
 270emit_xml_encoding(Out, Options) :-
 271    option(header(Hdr), Options, true),
 272    Hdr == true,
 273    !,
 274    stream_property(Out, encoding(Encoding)),
 275    (   (   Encoding == utf8
 276        ;   Encoding == wchar_t
 277        )
 278    ->  format(Out, '<?xml version="1.0" encoding="UTF-8"?>~n~n', [])
 279    ;   Encoding == iso_latin_1
 280    ->  format(Out, '<?xml version="1.0" encoding="ISO-8859-1"?>~n~n', [])
 281    ;   domain_error(xml_encoding, Encoding)
 282    ).
 283emit_xml_encoding(_, _).
 284
 285
 286%!  emit_doctype(+Options, +Data, +Stream)
 287%
 288%   Emit the document-type declaration.
 289%   There is a problem with the first clause if we are emitting SGML:
 290%   the SGML DTDs for HTML up to HTML 4 *do not allow* any 'version'
 291%   attribute; so the only time this is useful is when it is illegal!
 292
 293emit_doctype(_Options, Data, Out) :-
 294    (   Data = [_|_], memberchk(element(html,Att,_), Data)
 295    ;   Data = element(html,Att,_)
 296    ),
 297    memberchk(version=Version, Att),
 298    !,
 299    format(Out, '<!DOCTYPE HTML PUBLIC "~w">~n~n', [Version]).
 300emit_doctype(Options, Data, Out) :-
 301    (   memberchk(public(PubId), Options) -> true
 302    ;   PubId = (-)
 303    ),
 304    (   memberchk(system(SysId), Options) -> true
 305    ;   SysId = (-)
 306    ),
 307    \+ (PubId == (-),
 308        SysId == (-),
 309        \+ memberchk(doctype(_), Options)
 310    ),
 311    (   Data = element(DocType,_,_)
 312    ;   Data = [_|_], memberchk(element(DocType,_,_), Data)
 313    ;   memberchk(doctype(DocType), Options)
 314    ),
 315    !,
 316    write_doctype(Out, DocType, PubId, SysId).
 317emit_doctype(_, _, _).
 318
 319write_doctype(Out, DocType, -, -) :-
 320    !,
 321    format(Out, '<!DOCTYPE ~w []>~n~n', [DocType]).
 322write_doctype(Out, DocType, -, SysId) :-
 323    !,
 324    format(Out, '<!DOCTYPE ~w SYSTEM "~w">~n~n', [DocType,SysId]).
 325write_doctype(Out, DocType, PubId, -) :-
 326    !,
 327    format(Out, '<!DOCTYPE ~w PUBLIC "~w">~n~n', [DocType,PubId]).
 328write_doctype(Out, DocType, PubId, SysId) :-
 329    format(Out, '<!DOCTYPE ~w PUBLIC "~w" "~w">~n~n', [DocType,PubId,SysId]).
 330
 331
 332%!  emit(+Element, +Out, +State, +Options)
 333%
 334%   Emit a single element
 335
 336emit(Var, _, _) :-
 337    var(Var),
 338    !,
 339    instantiation_error(Var).
 340emit([], _, _) :- !.
 341emit([H|T], Out, State) :-
 342    !,
 343    emit(H, Out, State),
 344    emit(T, Out, State).
 345emit(CDATA, Out, State) :-
 346    atomic(CDATA),
 347    !,
 348    sgml_write_content(Out, CDATA, State).
 349emit(Element, Out, State) :-
 350    \+ \+ emit_element(Element, Out, State).
 351
 352emit_element(pi(PI), Out, State) :-
 353    !,
 354    get_state(State, entity_map, EntityMap),
 355    write(Out, <?),
 356    write_quoted(Out, PI, '', EntityMap),
 357    (   get_state(State, dialect, xml) ->
 358        write(Out, ?>)
 359    ;   write(Out, >)
 360    ).
 361emit_element(element(Name, Attributes, Content), Out, State) :-
 362    !,
 363    must_be(list, Attributes),
 364    must_be(list, Content),
 365    (   get_state(State, dialect, xml)
 366    ->  update_nsmap(Attributes, CleanAttrs, State),
 367        (   get_state(State, cleanns, true)
 368        ->  WriteAttrs = CleanAttrs
 369        ;   WriteAttrs = Attributes
 370        )
 371    ;   WriteAttrs = Attributes
 372    ),
 373    att_length(WriteAttrs, State, Alen),
 374    (   Alen > 60,
 375        get_state(State, layout, true)
 376    ->  Sep = nl,
 377        AttIndent = 4
 378    ;   Sep = sp,
 379        AttIndent = 0
 380    ),
 381    put_char(Out, '<'),
 382    emit_name(Name, Out, State),
 383    (   AttIndent > 0
 384    ->  \+ \+ ( inc_indent(State, AttIndent),
 385                attributes(WriteAttrs, Sep, Out, State)
 386              )
 387    ;   attributes(WriteAttrs, Sep, Out, State)
 388    ),
 389    content(Content, Out, Name, State).
 390emit_element(E, _, _) :-
 391    type_error(xml_dom, E).
 392
 393attributes([], _, _, _).
 394attributes([H|T], Sep, Out, State) :-
 395    (   Sep == nl
 396    ->  write_indent(State, Out)
 397    ;   put_char(Out, ' ')
 398    ),
 399    attribute(H, Out, State),
 400    attributes(T, Sep, Out, State).
 401
 402attribute(Name=Value, Out, State) :-
 403    emit_name(Name, Out, State),
 404    put_char(Out, =),
 405    sgml_write_attribute(Out, Value, State).
 406
 407att_length(Atts, State, Len) :-
 408    att_length(Atts, State, 0, Len).
 409
 410att_length([], _, Len, Len).
 411att_length([A0|T], State, Len0, Len) :-
 412    alen(A0, State, AL),
 413    Len1 is Len0 + 1 + AL,
 414    att_length(T, State, Len1, Len).
 415
 416alen(ns(NS, _URI):Name=Value, _State, Len) :-
 417    !,
 418    atom_length(Value, AL),
 419    vlen(Name, NL),
 420    atom_length(NS, NsL),
 421    Len is AL+NL+NsL+3.
 422alen(URI:Name=Value, State, Len) :-
 423    !,
 424    atom_length(Value, AL),
 425    vlen(Name, NL),
 426    get_state(State, nsmap, Nsmap),
 427    (   memberchk(NS=URI, Nsmap)
 428    ->  atom_length(NS, NsL)
 429    ;   atom_length(URI, NsL)
 430    ),
 431    Len is AL+NL+NsL+3.
 432alen(Name=Value, _, Len) :-
 433    atom_length(Name, NL),
 434    vlen(Value, AL),
 435    Len is AL+NL+3.
 436
 437vlen(Value, Len) :-
 438    is_list(Value),
 439    !,
 440    vlen_list(Value, 0, Len).
 441vlen(Value, Len) :-
 442    atom_length(Value, Len).
 443
 444vlen_list([], L, L).
 445vlen_list([H|T], L0, L) :-
 446    atom_length(H, HL),
 447    (   L0 == 0
 448    ->  L1 is L0 + HL
 449    ;   L1 is L0 + HL + 1
 450    ),
 451    vlen_list(T, L1, L).
 452
 453
 454emit_name(Name, Out, _) :-
 455    atom(Name),
 456    !,
 457    write(Out, Name).
 458emit_name(ns(NS,_URI):Name, Out, _State) :-
 459    !,
 460    (  NS == ''
 461    -> write(Out, Name)
 462    ;  format(Out, '~w:~w', [NS, Name])
 463    ).
 464emit_name(URI:Name, Out, State) :-
 465    get_state(State, nsmap, NSMap),
 466    memberchk(NS=URI, NSMap),
 467    !,
 468    (   NS == []
 469    ->  write(Out, Name)
 470    ;   format(Out, '~w:~w', [NS, Name])
 471    ).
 472emit_name(Term, Out, _) :-              % error?
 473    write(Out, Term).
 474
 475%!  update_nsmap(+Attributes, -Attributes1, !State)
 476%
 477%   Modify the nsmap of State to reflect modifications due to xmlns
 478%   arguments.
 479%
 480%   @arg    Attributes1 is a copy of Attributes with all redundant
 481%           namespace attributes deleted.
 482
 483update_nsmap(Attributes, Attributes1, State) :-
 484    get_state(State, nsmap, Map0),
 485    update_nsmap(Attributes, Attributes1, Map0, Map),
 486    set_state(State, nsmap, Map).
 487
 488update_nsmap([], [], Map, Map).
 489update_nsmap([xmlns:NS=URI|T], Attrs, Map0, Map) :-
 490    !,
 491    (   memberchk(NS=URI, Map0)
 492    ->  update_nsmap(T, Attrs, Map0, Map)
 493    ;   set_nsmap(NS, URI, Map0, Map1),
 494        Attrs = [xmlns:NS=URI|Attrs1],
 495        update_nsmap(T, Attrs1, Map1, Map)
 496    ).
 497update_nsmap([xmlns=URI|T], Attrs, Map0, Map) :-
 498    !,
 499    (   memberchk([]=URI, Map0)
 500    ->  update_nsmap(T, Attrs, Map0, Map)
 501    ;   set_nsmap([], URI, Map0, Map1),
 502        Attrs = [xmlns=URI|Attrs1],
 503        update_nsmap(T, Attrs1, Map1, Map)
 504    ).
 505update_nsmap([H|T0], [H|T], Map0, Map) :-
 506    !,
 507    update_nsmap(T0, T, Map0, Map).
 508
 509set_nsmap(NS, URI, Map0, Map) :-
 510    select(NS=_, Map0, Map1),
 511    !,
 512    Map = [NS=URI|Map1].
 513set_nsmap(NS, URI, Map, [NS=URI|Map]).
 514
 515
 516%!  content(+Content, +Out, +Element, +State, +Options)
 517%
 518%   Emit the content part of a structure  as well as the termination
 519%   for the content. For empty content   we have three versions: XML
 520%   style '/>', SGML declared EMPTY element (nothing) or normal SGML
 521%   element (we must close with the same element name).
 522
 523content([], Out, Element, State) :-    % empty element
 524    !,
 525    (   get_state(State, net, true)
 526    ->  (   get_state(State, dialect, xml) ->
 527            write(Out, />)
 528        ;   empty_element(State, Element) ->
 529            write(Out, >)
 530        ;   write(Out, //)
 531        )
 532    ;/* get_state(State, net, false) */
 533        write(Out, >),
 534        (   get_state(State, dialect, sgml),
 535            empty_element(State, Element)
 536        ->  true
 537        ;   emit_close(Element, Out, State)
 538        )
 539    ).
 540content([CDATA], Out, Element, State) :-
 541    atomic(CDATA),
 542    !,
 543    (   get_state(State, dialect, sgml),
 544        get_state(State, net, true),
 545        \+ sub_atom(CDATA, _, _, _, /),
 546        write_length(CDATA, Len, []),
 547        Len < 20
 548    ->  write(Out, /),
 549        sgml_write_content(Out, CDATA, State),
 550        write(Out, /)
 551    ;   verbatim_element(Element, State)
 552    ->  write(Out, >),
 553        write(Out, CDATA),
 554        emit_close(Element, Out, State)
 555    ;/* XML or not NET */
 556            write(Out, >),
 557        sgml_write_content(Out, CDATA, State),
 558        emit_close(Element, Out, State)
 559    ).
 560content(Content, Out, Element, State) :-
 561    get_state(State, layout, true),
 562    /* If xml:space='preserve' is present, */
 563        /* we MUST NOT tamper with white space at all. */
 564        \+ (Element = element(_,Atts,_),
 565        memberchk('xml:space'=preserve, Atts)
 566    ),
 567    element_content(Content, Elements),
 568    !,
 569    format(Out, >, []),
 570    \+ \+ (
 571        inc_indent(State),
 572        write_element_content(Elements, Out, State)
 573    ),
 574    write_indent(State, Out),
 575    emit_close(Element, Out, State).
 576content(Content, Out, Element, State) :-
 577    format(Out, >, []),
 578    write_mixed_content(Content, Out, Element, State),
 579    emit_close(Element, Out, State).
 580
 581verbatim_element(Element, State) :-
 582    verbatim_element(Element),
 583    get_state(State, dtd, DTD),
 584    DTD \== (-),
 585    dtd_property(DTD, doctype(html)).
 586
 587verbatim_element(script).
 588verbatim_element(style).
 589
 590emit_close(Element, Out, State) :-
 591    write(Out, '</'),
 592    emit_name(Element, Out, State),
 593    write(Out, '>').
 594
 595
 596write_mixed_content([], _, _, _).
 597write_mixed_content([H|T], Out, Element, State) :-
 598    write_mixed_content_element(H, Out, State),
 599    write_mixed_content(T, Out, Element, State).
 600
 601write_mixed_content_element(H, Out, State) :-
 602    (   atom(H)
 603    ->  sgml_write_content(Out, H, State)
 604    ;   string(H)
 605    ->  sgml_write_content(Out, H, State)
 606    ;   functor(H, element, 3)
 607    ->  emit(H, Out, State)
 608    ;   functor(H, pi, 1)
 609    ->  emit(H, Out, State)
 610    ;   var(H)
 611    ->  instantiation_error(H)
 612    ;   H = sdata(Data)             % cannot be written without entity!
 613    ->  print_message(warning, sgml_write(sdata_as_cdata(Data))),
 614        sgml_write_content(Out, Data, State)
 615    ;   type_error(sgml_content, H)
 616    ).
 617
 618
 619element_content([], []).
 620element_content([element(Name,Atts,C)|T0], [element(Name,Atts,C)|T]) :-
 621    !,
 622    element_content(T0, T).
 623element_content([Blank|T0], T) :-
 624    atom(Blank),
 625    atom_codes(Blank, Codes),
 626    all_blanks(Codes),
 627    element_content(T0, T).
 628
 629all_blanks([]).
 630all_blanks([H|T]) :-
 631    code_type(H, space),
 632    all_blanks(T).
 633
 634write_element_content([], _, _).
 635write_element_content([H|T], Out, State) :-
 636    write_indent(State, Out),
 637    emit(H, Out, State),
 638    write_element_content(T, Out, State).
 639
 640
 641                 /*******************************
 642                 *           NAMESPACES         *
 643                 *******************************/
 644
 645%!  add_missing_namespaces(+DOM0, +NsMap, -DOM)
 646%
 647%   Add xmlns:NS=URI definitions to the toplevel element(s) to
 648%   deal with missing namespaces.
 649
 650add_missing_namespaces([], _, []) :- !.
 651add_missing_namespaces([H0|T0], Def, [H|T]) :-
 652    !,
 653    add_missing_namespaces(H0, Def, H),
 654    add_missing_namespaces(T0, Def, T).
 655add_missing_namespaces(Elem0, Def, Elem) :-
 656    Elem0 = element(Name, Atts0, Content),
 657    !,
 658    missing_namespaces(Elem0, Def, Missing),
 659    (   Missing == []
 660    ->  Elem = Elem0
 661    ;   add_missing_ns(Missing, Atts0, Atts),
 662        Elem = element(Name, Atts, Content)
 663    ).
 664add_missing_namespaces(DOM, _, DOM).    % CDATA, etc.
 665
 666add_missing_ns([], Atts, Atts).
 667add_missing_ns([H|T], Atts0, Atts) :-
 668    generate_ns(H, NS),
 669    add_missing_ns(T, [xmlns:NS=H|Atts0], Atts).
 670
 671%!  generate_ns(+URI, -NS) is det.
 672%
 673%   Generate a namespace (NS) identifier for URI.
 674
 675generate_ns(URI, NS) :-
 676    xmlns(NS, URI),
 677    !.
 678generate_ns(URI, NS) :-
 679    default_ns(URI, NS),
 680    !.
 681generate_ns(_, NS) :-
 682    gensym(xns, NS).
 683
 684%!  xmlns(?NS, ?URI) is nondet.
 685%
 686%   Hook to define human readable  abbreviations for XML namespaces.
 687%   xml_write/3 tries these locations:
 688%
 689%     1. This hook
 690%     2. Defaults (see below)
 691%     3. rdf_db:ns/2 for RDF-DB integration
 692%
 693%   Default XML namespaces are:
 694%
 695%     | xsi    | http://www.w3.org/2001/XMLSchema-instance |
 696%     | xs     | http://www.w3.org/2001/XMLSchema          |
 697%     | xhtml  | http://www.w3.org/1999/xhtml              |
 698%     | soap11 | http://schemas.xmlsoap.org/soap/envelope/ |
 699%     | soap12 | http://www.w3.org/2003/05/soap-envelope   |
 700%
 701%   @see xml_write/2, rdf_register_ns/2.
 702
 703:- multifile
 704    rdf_db:ns/2.
 705
 706default_ns('http://www.w3.org/2001/XMLSchema-instance', xsi).
 707default_ns('http://www.w3.org/2001/XMLSchema',          xs).
 708default_ns('http://www.w3.org/1999/xhtml',              xhtml).
 709default_ns('http://schemas.xmlsoap.org/soap/envelope/', soap11).
 710default_ns('http://www.w3.org/2003/05/soap-envelope',   soap12).
 711default_ns(URI, NS) :-
 712    rdf_db:ns(NS, URI).
 713
 714%!  missing_namespaces(+DOM, +NSMap, -Missing)
 715%
 716%   Return a list of URIs appearing in DOM that are not covered
 717%   by xmlns definitions.
 718
 719missing_namespaces(DOM, Defined, Missing) :-
 720    missing_namespaces(DOM, Defined, [], Missing).
 721
 722missing_namespaces([], _, L, L) :- !.
 723missing_namespaces([H|T], Def, L0, L) :-
 724    !,
 725    missing_namespaces(H, Def, L0, L1),
 726    missing_namespaces(T, Def, L1, L).
 727missing_namespaces(element(Name, Atts, Content), Def, L0, L) :-
 728    !,
 729    update_nsmap(Atts, _, Def, Def1),
 730    missing_ns(Name, Def1, L0, L1),
 731    missing_att_ns(Atts, Def1, L1, L2),
 732    missing_namespaces(Content, Def1, L2, L).
 733missing_namespaces(_, _, L, L).
 734
 735missing_att_ns([], _, M, M).
 736missing_att_ns([Name=_|T], Def, M0, M) :-
 737    missing_ns(Name, Def, M0, M1),
 738    missing_att_ns(T, Def, M1, M).
 739
 740missing_ns(ns(NS, URI):_, Def, M0, M) :-
 741    !,
 742    (  memberchk(NS=URI, Def)
 743    -> M = M0
 744    ;  NS == ''
 745    -> M = M0
 746    ;  M = [URI|M0]
 747    ).
 748missing_ns(URI:_, Def, M0, M) :-
 749    !,
 750    (   (   memberchk(_=URI, Def)
 751        ;   memberchk(URI, M0)
 752        ;   URI = xml               % predefined ones
 753        ;   URI = xmlns
 754        )
 755    ->  M = M0
 756    ;   M = [URI|M0]
 757    ).
 758missing_ns(_, _, M, M).
 759
 760                 /*******************************
 761                 *         QUOTED WRITE         *
 762                 *******************************/
 763
 764sgml_write_attribute(Out, Values, State) :-
 765    is_list(Values),
 766    !,
 767    get_state(State, entity_map, EntityMap),
 768    put_char(Out, '"'),
 769    write_quoted_list(Values, Out, '"<&\r\n\t', EntityMap),
 770    put_char(Out, '"').
 771sgml_write_attribute(Out, Value, State) :-
 772    is_text(Value),
 773    !,
 774    get_state(State, entity_map, EntityMap),
 775    put_char(Out, '"'),
 776    write_quoted(Out, Value, '"<&\r\n\t', EntityMap),
 777    put_char(Out, '"').
 778sgml_write_attribute(Out, Value, _State) :-
 779    number(Value),
 780    !,
 781    format(Out, '"~w"', [Value]).
 782sgml_write_attribute(_, Value, _) :-
 783    type_error(sgml_attribute_value, Value).
 784
 785write_quoted_list([], _, _, _).
 786write_quoted_list([H|T], Out, Escape, EntityMap) :-
 787    write_quoted(Out, H, Escape, EntityMap),
 788    (   T == []
 789    ->  true
 790    ;   put_char(Out, ' '),
 791        write_quoted_list(T, Out, Escape, EntityMap)
 792    ).
 793
 794
 795sgml_write_content(Out, Value, State) :-
 796    is_text(Value),
 797    !,
 798    get_state(State, entity_map, EntityMap),
 799    write_quoted(Out, Value, '<&>\r', EntityMap).
 800sgml_write_content(Out, Value, _) :-
 801    write(Out, Value).
 802
 803is_text(Value) :- atom(Value), !.
 804is_text(Value) :- string(Value), !.
 805
 806write_quoted(Out, Atom, Escape, EntityMap) :-
 807    atom(Atom),
 808    !,
 809    atom_codes(Atom, Codes),
 810    writeq(Codes, Out, Escape, EntityMap).
 811write_quoted(Out, String, Escape, EntityMap) :-
 812    string(String),
 813    !,
 814    string_codes(String, Codes),
 815    writeq(Codes, Out, Escape, EntityMap).
 816write_quoted(_, String, _, _) :-
 817    type_error(atom_or_string, String).
 818
 819
 820%!  writeq(+Text:codes, +Out:stream, +Escape:atom, +Escape:assoc) is det.
 821
 822writeq([], _, _, _).
 823writeq([H|T], Out, Escape, EntityMap) :-
 824    (   char_code(HC, H),
 825        sub_atom(Escape, _, _, _, HC)
 826    ->  write_entity(H, Out, EntityMap)
 827    ;   H >= 256
 828    ->  (   stream_property(Out, encoding(Enc)),
 829            unicode_encoding(Enc)
 830        ->  put_code(Out, H)
 831        ;   write_entity(H, Out, EntityMap)
 832        )
 833    ;   put_code(Out, H)
 834    ),
 835    writeq(T, Out, Escape, EntityMap).
 836
 837unicode_encoding(utf8).
 838unicode_encoding(wchar_t).
 839unicode_encoding(unicode_le).
 840unicode_encoding(unicode_be).
 841
 842write_entity(Code, Out, EntityMap) :-
 843    (   get_assoc(Code, EntityMap, EntityName)
 844    ->  format(Out, '&~w;', [EntityName])
 845    ;   format(Out, '&#x~16R;', [Code])
 846    ).
 847
 848
 849                 /*******************************
 850                 *          INDENTATION         *
 851                 *******************************/
 852
 853write_initial_indent(State, Out) :-
 854    (   get_state(State, indent, Indent),
 855        Indent > 0
 856    ->  emit_indent(Indent, Out)
 857    ;   true
 858    ).
 859
 860write_indent(State, _) :-
 861    get_state(State, layout, false),
 862    !.
 863write_indent(State, Out) :-
 864    get_state(State, indent, Indent),
 865    emit_indent(Indent, Out).
 866
 867emit_indent(Indent, Out) :-
 868    Tabs is Indent // 8,
 869    Spaces is Indent mod 8,
 870    format(Out, '~N', []),
 871    write_n(Tabs, '\t', Out),
 872    write_n(Spaces, ' ', Out).
 873
 874write_n(N, Char, Out) :-
 875    (   N > 0
 876    ->  put_char(Out, Char),
 877        N2 is N - 1,
 878        write_n(N2, Char, Out)
 879    ;   true
 880    ).
 881
 882inc_indent(State) :-
 883    inc_indent(State, 2).
 884
 885inc_indent(State, Inc) :-
 886    state(indent, Arg),
 887    arg(Arg, State, I0),
 888    I is I0 + Inc,
 889    setarg(Arg, State, I).
 890
 891
 892                 /*******************************
 893                 *         DTD HANDLING         *
 894                 *******************************/
 895
 896%!  empty_element(+State, +Element)
 897%
 898%   True if Element is declared  with   EMPTY  content in the (SGML)
 899%   DTD.
 900
 901empty_element(State, Element) :-
 902    get_state(State, dtd, DTD),
 903    DTD \== (-),
 904    dtd_property(DTD, element(Element, _, empty)).
 905
 906%!  dtd_character_entities(+DTD, -Map)
 907%
 908%   Return an assoc mapping character entities   to their name. Note
 909%   that the entity representation is a bit dubious. Entities should
 910%   allow for a wide-character version and avoid the &#..; trick.
 911
 912dtd_character_entities(DTD, Map) :-
 913    empty_assoc(Empty),
 914    dtd_property(DTD, entities(Entities)),
 915    fill_entity_map(Entities, DTD, Empty, Map).
 916
 917fill_entity_map([], _, Map, Map).
 918fill_entity_map([H|T], DTD, Map0, Map) :-
 919    (   dtd_property(DTD, entity(H, CharEntity)),
 920        atom(CharEntity),
 921        (   sub_atom(CharEntity, 0, _, _, '&#'),
 922            sub_atom(CharEntity, _, _, 0, ';')
 923        ->  sub_atom(CharEntity, 2, _, 1, Name),
 924            atom_number(Name, Code)
 925        ;   atom_length(CharEntity, 1),
 926            char_code(CharEntity, Code)
 927        )
 928    ->  put_assoc(Code, Map0, H, Map1),
 929        fill_entity_map(T, DTD, Map1, Map)
 930    ;   fill_entity_map(T, DTD, Map0, Map)
 931    ).
 932
 933
 934
 935                 /*******************************
 936                 *            FIELDS            *
 937                 *******************************/
 938
 939state(indent,     1).                   % current indentation
 940state(layout,     2).                   % use layout (true/false)
 941state(dtd,        3).                   % DTD for entity names
 942state(entity_map, 4).                   % compiled entity-map
 943state(dialect,    5).                   % xml/sgml
 944state(nsmap,      6).                   % defined namespaces
 945state(net,        7).                   % Should null end-tags be used?
 946state(cleanns,    8).                   % Remove duplicate xmlns declarations
 947
 948new_state(Dialect,
 949    state(
 950        0,              % indent
 951        true,           % layout
 952        -,              % DTD
 953        EntityMap,      % entity_map
 954        Dialect,        % dialect
 955        [],             % NS=Full map
 956        Net,            % Null End-Tags?
 957        true            % Remove duplicate xmlns declarations
 958    )) :-
 959    (   Dialect == sgml
 960    ->  Net = false,
 961        empty_assoc(EntityMap)
 962    ;   Net = true,
 963        xml_entities(EntityMap)
 964    ).
 965
 966get_state(State, Field, Value) :-
 967    state(Field, Arg),
 968    arg(Arg, State, Value).
 969
 970set_state(State, Field, Value) :-
 971    state(Field, Arg),
 972    setarg(Arg, State, Value).
 973
 974term_expansion(xml_entities(map),
 975               xml_entities(Map)) :-
 976    list_to_assoc([ 0'< - lt,
 977                    0'& - amp,
 978                    0'> - gt,
 979                    0'\' - apos,
 980                    0'\" - quot
 981                  ], Map).
 982xml_entities(map).
 983
 984                 /*******************************
 985                 *            MESSAGES          *
 986                 *******************************/
 987
 988:- multifile
 989    prolog:message/3.
 990
 991prolog:message(sgml_write(sdata_as_cdata(Data))) -->
 992    [ 'SGML-write: emitting SDATA as CDATA: "~p"'-[Data] ].