1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker and Anjo Anjewierden
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2002-2020, 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(html_write,
   37          [ reply_html_page/2,          % :Head, :Body
   38            reply_html_page/3,          % +Style, :Head, :Body
   39
   40                                        % Basic output routines
   41            page//1,                    % :Content
   42            page//2,                    % :Head, :Body
   43            page//3,                    % +Style, :Head, :Body
   44            html//1,                    % :Content
   45
   46                                        % Option processing
   47            html_set_options/1,         % +OptionList
   48            html_current_option/1,      % ?Option
   49
   50                                        % repositioning HTML elements
   51            html_post//2,               % +Id, :Content
   52            html_receive//1,            % +Id
   53            html_receive//2,            % +Id, :Handler
   54            xhtml_ns//2,                % +Id, +Value
   55            html_root_attribute//2,     % +Name, +Value
   56
   57            html/4,                     % {|html||quasi quotations|}
   58
   59                                        % Useful primitives for expanding
   60            html_begin//1,              % +EnvName[(Attribute...)]
   61            html_end//1,                % +EnvName
   62            html_quoted//1,             % +Text
   63            html_quoted_attribute//1,   % +Attribute
   64
   65                                        % Emitting the HTML code
   66            print_html/1,               % +List
   67            print_html/2,               % +Stream, +List
   68            html_print_length/2,        % +List, -Length
   69
   70                                        % Extension support
   71            (html_meta)/1,              % +Spec
   72            op(1150, fx, html_meta)
   73          ]).   74:- use_module(html_quasiquotations, [html/4]).   75:- autoload(library(apply),[maplist/3,maplist/4]).   76:- autoload(library(debug),[debug/3]).   77:- autoload(library(error),
   78	    [must_be/2,domain_error/2,instantiation_error/1]).   79:- autoload(library(lists),
   80	    [permutation/2,selectchk/3,append/3,select/4,list_to_set/2]).   81:- autoload(library(option),[option/2]).   82:- autoload(library(pairs),[group_pairs_by_key/2]).   83:- autoload(library(sgml),[xml_quote_cdata/3,xml_quote_attribute/3]).   84:- autoload(library(uri),[uri_encoded/3]).   85:- autoload(library(url),[www_form_encode/2]).   86:- autoload(library(http/http_dispatch), [http_location_by_id/2]).   87
   88% Quote output
   89:- set_prolog_flag(generate_debug_info, false).   90
   91:- meta_predicate
   92    reply_html_page(+, :, :),
   93    reply_html_page(:, :),
   94    html(:, -, +),
   95    page(:, -, +),
   96    page(:, :, -, +),
   97    pagehead(+, :, -, +),
   98    pagebody(+, :, -, +),
   99    html_receive(+, 3, -, +),
  100    html_post(+, :, -, +).  101
  102:- multifile
  103    expand//1,                      % +HTMLElement
  104    expand_attribute_value//1.      % +HTMLAttributeValue

Content-type: text/html; charset=UTF-8

  141                 /*******************************
  142                 *            SETTINGS          *
  143                 *******************************/

 html_set_options(+Options) is det

Set options for the HTML output. Options are stored in prolog flags to ensure proper multi-threaded behaviour where setting an option is local to the thread and new threads start with the options from the parent thread. Defined options are:

dialect(Dialect)

One of html4, xhtml or html5 (default). For compatibility reasons, html is accepted as an alias for html4.

doctype(+DocType)

Set the <|DOCTYPE DocType > line for page//1 and page//2.

content_type(+ContentType)

Set the Content-type for reply_html_page/3

Note that the doctype and content_type flags are covered by distinct prolog flags: html4_doctype, xhtml_doctype and html5_doctype and similar for the content type. The Dialect must be switched before doctype and content type.

  169html_set_options(Options) :-
  170    must_be(list, Options),
  171    set_options(Options).
  172
  173set_options([]).
  174set_options([H|T]) :-
  175    html_set_option(H),
  176    set_options(T).
  177
  178html_set_option(dialect(Dialect0)) :-
  179    !,
  180    must_be(oneof([html,html4,xhtml,html5]), Dialect0),
  181    (   html_version_alias(Dialect0, Dialect)
  182    ->  true
  183    ;   Dialect = Dialect0
  184    ),
  185    set_prolog_flag(html_dialect, Dialect).
  186html_set_option(doctype(Atom)) :-
  187    !,
  188    must_be(atom, Atom),
  189    current_prolog_flag(html_dialect, Dialect),
  190    dialect_doctype_flag(Dialect, Flag),
  191    set_prolog_flag(Flag, Atom).
  192html_set_option(content_type(Atom)) :-
  193    !,
  194    must_be(atom, Atom),
  195    current_prolog_flag(html_dialect, Dialect),
  196    dialect_content_type_flag(Dialect, Flag),
  197    set_prolog_flag(Flag, Atom).
  198html_set_option(O) :-
  199    domain_error(html_option, O).
  200
  201html_version_alias(html, html4).

 html_current_option(?Option) is nondet

True if Option is an active option for the HTML generator.

  207html_current_option(dialect(Dialect)) :-
  208    current_prolog_flag(html_dialect, Dialect).
  209html_current_option(doctype(DocType)) :-
  210    current_prolog_flag(html_dialect, Dialect),
  211    dialect_doctype_flag(Dialect, Flag),
  212    current_prolog_flag(Flag, DocType).
  213html_current_option(content_type(ContentType)) :-
  214    current_prolog_flag(html_dialect, Dialect),
  215    dialect_content_type_flag(Dialect, Flag),
  216    current_prolog_flag(Flag, ContentType).
  217
  218dialect_doctype_flag(html4, html4_doctype).
  219dialect_doctype_flag(html5, html5_doctype).
  220dialect_doctype_flag(xhtml, xhtml_doctype).
  221
  222dialect_content_type_flag(html4, html4_content_type).
  223dialect_content_type_flag(html5, html5_content_type).
  224dialect_content_type_flag(xhtml, xhtml_content_type).
  225
  226option_default(html_dialect, html5).
  227option_default(html4_doctype,
  228               'HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" \c
  229               "http://www.w3.org/TR/html4/loose.dtd"').
  230option_default(html5_doctype,
  231               'html').
  232option_default(xhtml_doctype,
  233               'html PUBLIC "-//W3C//DTD XHTML 1.0 \c
  234               Transitional//EN" \c
  235               "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"').
  236option_default(html4_content_type, 'text/html; charset=UTF-8').
  237option_default(html5_content_type, 'text/html; charset=UTF-8').
  238option_default(xhtml_content_type, 'application/xhtml+xml; charset=UTF-8').

 init_options is det

Initialise the HTML processing options.

  244init_options :-
  245    (   option_default(Name, Value),
  246        (   current_prolog_flag(Name, _)
  247        ->  true
  248        ;   create_prolog_flag(Name, Value, [])
  249        ),
  250        fail
  251    ;   true
  252    ).
  253
  254:- init_options.

 xml_header(-Header)

First line of XHTML document. Added by print_html/1.

  260xml_header('<?xml version=\'1.0\' encoding=\'UTF-8\'?>').

 ns(?Which, ?Atom)

Namespace declarations

  266ns(xhtml, 'http://www.w3.org/1999/xhtml').
  267
  268
  269                 /*******************************
  270                 *             PAGE             *
  271                 *******************************/

 page(+Content:dom)// is det

 page(+Head:dom, +Body:dom)// is det

Generate a page including the HTML <!DOCTYPE> header. The actual doctype is read from the option doctype as defined by html_set_options/1.

  280page(Content) -->
  281    doctype,
  282    html(html(Content)).
  283
  284page(Head, Body) -->
  285    page(default, Head, Body).
  286
  287page(Style, Head, Body) -->
  288    doctype,
  289    content_type,
  290    html_begin(html),
  291    pagehead(Style, Head),
  292    pagebody(Style, Body),
  293    html_end(html).

 doctype//

Emit the <DOCTYPE ... header. The doctype comes from the option doctype(DOCTYPE) (see html_set_options/1). Setting the doctype to '' (empty atom) suppresses the header completely. This is to avoid a IE bug in processing AJAX output ...

  302doctype -->
  303    { html_current_option(doctype(DocType)),
  304      DocType \== ''
  305    },
  306    !,
  307    [ '<!DOCTYPE ', DocType, '>' ].
  308doctype -->
  309    [].
  310
  311content_type -->
  312    { html_current_option(content_type(Type))
  313    },
  314    !,
  315    html_post(head, meta([ 'http-equiv'('content-type'),
  316                           content(Type)
  317                         ], [])).
  318content_type -->
  319    { html_current_option(dialect(html5)) },
  320    !,
  321    html_post(head, meta('charset=UTF-8')).
  322content_type -->
  323    [].
  324
  325pagehead(_, Head) -->
  326    { functor(Head, head, _)
  327    },
  328    !,
  329    html(Head).
  330pagehead(Style, Head) -->
  331    { strip_module(Head, M, _),
  332      hook_module(M, HM, head//2)
  333    },
  334    HM:head(Style, Head),
  335    !.
  336pagehead(_, Head) -->
  337    { strip_module(Head, M, _),
  338      hook_module(M, HM, head//1)
  339    },
  340    HM:head(Head),
  341    !.
  342pagehead(_, Head) -->
  343    html(head(Head)).
  344
  345
  346pagebody(_, Body) -->
  347    { functor(Body, body, _)
  348    },
  349    !,
  350    html(Body).
  351pagebody(Style, Body) -->
  352    { strip_module(Body, M, _),
  353      hook_module(M, HM, body//2)
  354    },
  355    HM:body(Style, Body),
  356    !.
  357pagebody(_, Body) -->
  358    { strip_module(Body, M, _),
  359      hook_module(M, HM, body//1)
  360    },
  361    HM:body(Body),
  362    !.
  363pagebody(_, Body) -->
  364    html(body(Body)).
  365
  366
  367hook_module(M, M, PI) :-
  368    current_predicate(M:PI),
  369    !.
  370hook_module(_, user, PI) :-
  371    current_predicate(user:PI).

 html(+Content:dom)// is det

Generate HTML from Content. Generates a token sequence for print_html/2.

  378html(Spec) -->
  379    { strip_module(Spec, M, T) },
  380    qhtml(T, M).
  381
  382qhtml(Var, _) -->
  383    { var(Var),
  384      !,
  385      instantiation_error(Var)
  386    }.
  387qhtml([], _) -->
  388    !,
  389    [].
  390qhtml([H|T], M) -->
  391    !,
  392    html_expand(H, M),
  393    qhtml(T, M).
  394qhtml(X, M) -->
  395    html_expand(X, M).
  396
  397html_expand(Var, _) -->
  398    { var(Var),
  399      !,
  400      instantiation_error(Var)
  401    }.
  402html_expand(Term, Module) -->
  403    do_expand(Term, Module),
  404    !.
  405html_expand(Term, _Module) -->
  406    { print_message(error, html(expand_failed(Term))) }.
  407
  408
  409do_expand(Token, _) -->                 % call user hooks
  410    expand(Token),
  411    !.
  412do_expand(Fmt-Args, _) -->
  413    !,
  414    { format(string(String), Fmt, Args)
  415    },
  416    html_quoted(String).
  417do_expand(\List, Module) -->
  418    { is_list(List)
  419    },
  420    !,
  421    raw(List, Module).
  422do_expand(\Term, Module, In, Rest) :-
  423    !,
  424    call(Module:Term, In, Rest).
  425do_expand(Module:Term, _) -->
  426    !,
  427    qhtml(Term, Module).
  428do_expand(&(Entity), _) -->
  429    !,
  430    {   integer(Entity)
  431    ->  format(string(String), '&#~d;', [Entity])
  432    ;   format(string(String), '&~w;', [Entity])
  433    },
  434    [ String ].
  435do_expand(Token, _) -->
  436    { atomic(Token)
  437    },
  438    !,
  439    html_quoted(Token).
  440do_expand(element(Env, Attributes, Contents), M) -->
  441    !,
  442    (   { Contents == [],
  443          html_current_option(dialect(xhtml))
  444        }
  445    ->  xhtml_empty(Env, Attributes)
  446    ;   html_begin(Env, Attributes),
  447        qhtml(Env, Contents, M),
  448        html_end(Env)
  449    ).
  450do_expand(Term, M) -->
  451    { Term =.. [Env, Contents]
  452    },
  453    !,
  454    (   { layout(Env, _, empty)
  455        }
  456    ->  html_begin(Env, Contents)
  457    ;   (   { Contents == [],
  458              html_current_option(dialect(xhtml))
  459            }
  460        ->  xhtml_empty(Env, [])
  461        ;   html_begin(Env),
  462            qhtml(Env, Contents, M),
  463            html_end(Env)
  464        )
  465    ).
  466do_expand(Term, M) -->
  467    { Term =.. [Env, Attributes, Contents],
  468      check_non_empty(Contents, Env, Term)
  469    },
  470    !,
  471    (   { Contents == [],
  472          html_current_option(dialect(xhtml))
  473        }
  474    ->  xhtml_empty(Env, Attributes)
  475    ;   html_begin(Env, Attributes),
  476        qhtml(Env, Contents, M),
  477        html_end(Env)
  478    ).
  479
  480qhtml(Env, Contents, M) -->
  481    { cdata_element(Env),
  482      phrase(cdata(Contents, M), Tokens)
  483    },
  484    !,
  485    [ cdata(Env, Tokens) ].
  486qhtml(_, Contents, M) -->
  487    qhtml(Contents, M).
  488
  489
  490check_non_empty([], _, _) :- !.
  491check_non_empty(_, Tag, Term) :-
  492    layout(Tag, _, empty),
  493    !,
  494    print_message(warning,
  495                  format('Using empty element with content: ~p', [Term])).
  496check_non_empty(_, _, _).
  497
  498cdata(List, M) -->
  499    { is_list(List) },
  500    !,
  501    raw(List, M).
  502cdata(One, M) -->
  503    raw_element(One, M).

 raw(+List, +Module)// is det

Emit unquoted (raw) output used for scripts, etc.

  509raw([], _) -->
  510    [].
  511raw([H|T], Module) -->
  512    raw_element(H, Module),
  513    raw(T, Module).
  514
  515raw_element(Var, _) -->
  516    { var(Var),
  517      !,
  518      instantiation_error(Var)
  519    }.
  520raw_element(\List, Module) -->
  521    { is_list(List)
  522    },
  523    !,
  524    raw(List, Module).
  525raw_element(\Term, Module, In, Rest) :-
  526    !,
  527    call(Module:Term, In, Rest).
  528raw_element(Module:Term, _) -->
  529    !,
  530    raw_element(Term, Module).
  531raw_element(Fmt-Args, _) -->
  532    !,
  533    { format(string(S), Fmt, Args) },
  534    [S].
  535raw_element(Value, _) -->
  536    { must_be(atomic, Value) },
  537    [Value].

 html_begin(+Env)// is det

 html_end(+End)// is det

For html_begin//1, Env is a term Env(Attributes); for html_end//1 it is the plain environment name. Used for exceptional cases. Normal applications use html//1. The following two fragments are identical, where we prefer the first as it is more concise and less error-prone.

        html(table(border=1, \table_content))

        html_begin(table(border=1)
        table_content,
        html_end(table)

  558html_begin(Env) -->
  559    { Env =.. [Name|Attributes]
  560    },
  561    html_begin(Name, Attributes).
  562
  563html_begin(Env, Attributes) -->
  564    pre_open(Env),
  565    [<],
  566    [Env],
  567    attributes(Env, Attributes),
  568    (   { layout(Env, _, empty),
  569          html_current_option(dialect(xhtml))
  570        }
  571    ->  ['/>']
  572    ;   [>]
  573    ),
  574    post_open(Env).
  575
  576html_end(Env)   -->                     % empty element or omited close
  577    { layout(Env, _, -),
  578      html_current_option(dialect(html))
  579    ; layout(Env, _, empty)
  580    },
  581    !,
  582    [].
  583html_end(Env)   -->
  584    pre_close(Env),
  585    ['</'],
  586    [Env],
  587    ['>'],
  588    post_close(Env).

 xhtml_empty(+Env, +Attributes)// is det

Emit element in xhtml mode with empty content.

  594xhtml_empty(Env, Attributes) -->
  595    pre_open(Env),
  596    [<],
  597    [Env],
  598    attributes(Attributes),
  599    ['/>'].

 xhtml_ns(+Id, +Value)//

Demand an xmlns:id=Value in the outer html tag. This uses the html_post/2 mechanism to post to the xmlns channel. Rdfa (http://www.w3.org/2006/07/SWD/RDFa/syntax/), embedding RDF in (x)html provides a typical usage scenario where we want to publish the required namespaces in the header. We can define:

rdf_ns(Id) -->
        { rdf_global_id(Id:'', Value) },
        xhtml_ns(Id, Value).

After which we can use rdf_ns//1 as a normal rule in html//1 to publish namespaces from library(semweb/rdf_db). Note that this macro only has effect if the dialect is set to xhtml. In html mode it is silently ignored.

The required xmlns receiver is installed by html_begin//1 using the html tag and thus is present in any document that opens the outer html environment through this library.

  624xhtml_ns(Id, Value) -->
  625    { html_current_option(dialect(xhtml)) },
  626    !,
  627    html_post(xmlns, \attribute(xmlns:Id=Value)).
  628xhtml_ns(_, _) -->
  629    [].

 html_root_attribute(+Name, +Value)//

Add an attribute to the HTML root element of the page. For example:

    html(div(...)),
    html_root_attribute(lang, en),
    ...

  642html_root_attribute(Name, Value) -->
  643    html_post(html_begin, \attribute(Name=Value)).

 attributes(+Env, +Attributes)// is det

Emit attributes for Env. Adds XHTML namespace declaration to the html tag if not provided by the caller.

  650attributes(html, L) -->
  651    !,
  652    (   { html_current_option(dialect(xhtml)) }
  653    ->  (   { option(xmlns(_), L) }
  654        ->  attributes(L)
  655        ;   { ns(xhtml, NS) },
  656            attributes([xmlns(NS)|L])
  657        ),
  658        html_receive(xmlns)
  659    ;   attributes(L),
  660        html_noreceive(xmlns)
  661    ),
  662    html_receive(html_begin).
  663attributes(_, L) -->
  664    attributes(L).
  665
  666attributes([]) -->
  667    !,
  668    [].
  669attributes([H|T]) -->
  670    !,
  671    attribute(H),
  672    attributes(T).
  673attributes(One) -->
  674    attribute(One).
  675
  676attribute(Name=Value) -->
  677    !,
  678    [' '], name(Name), [ '="' ],
  679    attribute_value(Value),
  680    ['"'].
  681attribute(NS:Term) -->
  682    !,
  683    { Term =.. [Name, Value]
  684    },
  685    !,
  686    attribute((NS:Name)=Value).
  687attribute(Term) -->
  688    { Term =.. [Name, Value]
  689    },
  690    !,
  691    attribute(Name=Value).
  692attribute(Atom) -->                     % Value-abbreviated attribute
  693    { atom(Atom)
  694    },
  695    [ ' ', Atom ].
  696
  697name(NS:Name) -->
  698    !,
  699    [NS, :, Name].
  700name(Name) -->
  701    [ Name ].

 attribute_value(+Value) is det

Print an attribute value. Value is either atomic or one of the following terms:

• A+B Concatenation of A and B
• encode(V) Emit URL-encoded version of V. See www_form_encode/2.
• An option list Emit ?Name1=encode(Value1)&Name2=encode(Value2) ...
• A term Format-Arguments Use format/3 and emit the result as quoted value.

The hook expand_attribute_value//1 can be defined to provide additional `function like' translations. For example, http_dispatch.pl defines location_by_id(ID) to refer to a location on the current server based on the handler id. See http_location_by_id/2.

  723attribute_value(List) -->
  724    { is_list(List) },
  725    !,
  726    attribute_value_m(List).
  727attribute_value(Value) -->
  728    attribute_value_s(Value).
  729
  730% emit a single attribute value
  731
  732attribute_value_s(Var) -->
  733    { var(Var),
  734      !,
  735      instantiation_error(Var)
  736    }.
  737attribute_value_s(A+B) -->
  738    !,
  739    attribute_value(A),
  740    (   { is_list(B) }
  741    ->  (   { B == [] }
  742        ->  []
  743        ;   [?], search_parameters(B)
  744        )
  745    ;   attribute_value(B)
  746    ).
  747attribute_value_s(encode(Value)) -->
  748    !,
  749    { uri_encoded(query_value, Value, Encoded) },
  750    [ Encoded ].
  751attribute_value_s(Value) -->
  752    expand_attribute_value(Value),
  753    !.
  754attribute_value_s(Fmt-Args) -->
  755    !,
  756    { format(string(Value), Fmt, Args) },
  757    html_quoted_attribute(Value).
  758attribute_value_s(Value) -->
  759    html_quoted_attribute(Value).
  760
  761search_parameters([H|T]) -->
  762    search_parameter(H),
  763    (   {T == []}
  764    ->  []
  765    ;   ['&'],
  766        search_parameters(T)
  767    ).
  768
  769search_parameter(Var) -->
  770    { var(Var),
  771      !,
  772      instantiation_error(Var)
  773    }.
  774search_parameter(Name=Value) -->
  775    { www_form_encode(Value, Encoded) },
  776    [Name, =, Encoded].
  777search_parameter(Term) -->
  778    { Term =.. [Name, Value],
  779      !,
  780      www_form_encode(Value, Encoded)
  781    },
  782    [Name, =, Encoded].
  783search_parameter(Term) -->
  784    { domain_error(search_parameter, Term)
  785    }.

 attribute_value_m(+List)//

Used for multi-valued attributes, such as class-lists. E.g.,

      body(class([c1, c2]), Body)

Emits <body class="c1 c2"> ...

  797attribute_value_m([]) -->
  798    [].
  799attribute_value_m([H|T]) -->
  800    attribute_value_s(H),
  801    (   { T == [] }
  802    ->  []
  803    ;   [' '],
  804        attribute_value_m(T)
  805    ).
  806
  807
  808                 /*******************************
  809                 *         QUOTING RULES        *
  810                 *******************************/

 html_quoted(Text)// is det

Quote the value for normal (CDATA) text. Note that text appearing in the document structure is normally quoted using these rules. I.e. the following emits properly quoted bold text regardless of the content of Text:

        html(b(Text))

To be done

- Assumes UTF-8 encoding of the output.

  825html_quoted(Text) -->
  826    { xml_quote_cdata(Text, Quoted, utf8) },
  827    [ Quoted ].

 html_quoted_attribute(+Text)// is det

Quote the value according to the rules for tag-attributes included in double-quotes. Note that -like html_quoted//1-, attributed values printed through html//1 are quoted atomatically.

To be done

- Assumes UTF-8 encoding of the output.

  838html_quoted_attribute(Text) -->
  839    { xml_quote_attribute(Text, Quoted, utf8) },
  840    [ Quoted ].

 cdata_element(?Element)

True when Element contains declared CDATA and thus only </ needs to be escaped.

  847cdata_element(script).
  848cdata_element(style).
  849
  850
  851                 /*******************************
  852                 *      REPOSITIONING HTML      *
  853                 *******************************/

 html_post(+Id, :HTML)// is det

Reposition HTML to the receiving Id. The html_post//2 call processes HTML using html//1. Embedded \-commands are executed by mailman/1 from print_html/1 or html_print_length/2. These commands are called in the calling context of the html_post//2 call.

A typical usage scenario is to get required CSS links in the document head in a reusable fashion. First, we define css//1 as:

css(URL) -->
        html_post(css,
                  link([ type('text/css'),
                         rel('stylesheet'),
                         href(URL)
                       ])).

Next we insert the unique CSS links, in the pagehead using the following call to reply_html_page/2:

        reply_html_page([ title(...),
                          \html_receive(css)
                        ],
                        ...)

  885html_post(Id, Content) -->
  886    { strip_module(Content, M, C) },
  887    [ mailbox(Id, post(M, C)) ].

 html_receive(+Id)// is det

Receive posted HTML tokens. Unique sequences of tokens posted with html_post//2 are inserted at the location where html_receive//1 appears.

See also

- The local predicate sorted_html//1 handles the output of html_receive//1.

- html_receive//2 allows for post-processing the posted material.

  900html_receive(Id) -->
  901    html_receive(Id, sorted_html).

 html_receive(+Id, :Handler)// is det

This extended version of html_receive//1 causes Handler to be called to process all messages posted to the channal at the time output is generated. Handler is called as below, where PostedTerms is a list of Module:Term created from calls to html_post//2. Module is the context module of html_post and Term is the unmodified term. Members in PostedTerms are in the order posted and may contain duplicates.

  phrase(Handler, PostedTerms, HtmlTerms, Rest)

Typically, Handler collects the posted terms, creating a term suitable for html//1 and finally calls html//1.

  920html_receive(Id, Handler) -->
  921    { strip_module(Handler, M, P) },
  922    [ mailbox(Id, accept(M:P, _)) ].

 html_noreceive(+Id)// is det

As html_receive//1, but discard posted messages.

  928html_noreceive(Id) -->
  929    [ mailbox(Id, ignore(_,_)) ].

 mailman(+Tokens) is det

Collect posted tokens and copy them into the receiving mailboxes. Mailboxes may produce output for each other, but not cyclic. The current scheme to resolve this is rather naive: It simply permutates the mailbox resolution order until it found a working one. Before that, it puts head and script boxes at the end.

  940mailman(Tokens) :-
  941    (   html_token(mailbox(_, accept(_, Accepted)), Tokens)
  942    ->  true
  943    ),
  944    var(Accepted),                 % not yet executed
  945    !,
  946    mailboxes(Tokens, Boxes),
  947    keysort(Boxes, Keyed),
  948    group_pairs_by_key(Keyed, PerKey),
  949    move_last(PerKey, script, PerKey1),
  950    move_last(PerKey1, head, PerKey2),
  951    (   permutation(PerKey2, PerKeyPerm),
  952        (   mail_ids(PerKeyPerm)
  953        ->  !
  954        ;   debug(html(mailman),
  955                  'Failed mail delivery order; retrying', []),
  956            fail
  957        )
  958    ->  true
  959    ;   print_message(error, html(cyclic_mailboxes))
  960    ).
  961mailman(_).
  962
  963move_last(Box0, Id, Box) :-
  964    selectchk(Id-List, Box0, Box1),
  965    !,
  966    append(Box1, [Id-List], Box).
  967move_last(Box, _, Box).

 html_token(?Token, +Tokens) is nondet

True if Token is a token in the token set. This is like member, but the toplevel list may contain cdata(Elem, Tokens).

  974html_token(Token, [H|T]) :-
  975    html_token_(T, H, Token).
  976
  977html_token_(_, Token, Token) :- !.
  978html_token_(_, cdata(_,Tokens), Token) :-
  979    html_token(Token, Tokens).
  980html_token_([H|T], _, Token) :-
  981    html_token_(T, H, Token).

 mailboxes(+Tokens, -MailBoxes) is det

Get all mailboxes from the token set.

  987mailboxes(Tokens, MailBoxes) :-
  988    mailboxes(Tokens, MailBoxes, []).
  989
  990mailboxes([], List, List).
  991mailboxes([mailbox(Id, Value)|T0], [Id-Value|T], Tail) :-
  992    !,
  993    mailboxes(T0, T, Tail).
  994mailboxes([cdata(_Type, Tokens)|T0], Boxes, Tail) :-
  995    !,
  996    mailboxes(Tokens, Boxes, Tail0),
  997    mailboxes(T0, Tail0, Tail).
  998mailboxes([_|T0], T, Tail) :-
  999    mailboxes(T0, T, Tail).
 1000
 1001mail_ids([]).
 1002mail_ids([H|T0]) :-
 1003    mail_id(H, NewPosts),
 1004    add_new_posts(NewPosts, T0, T),
 1005    mail_ids(T).
 1006
 1007mail_id(Id-List, NewPosts) :-
 1008    mail_handlers(List, Boxes, Content),
 1009    (   Boxes = [accept(MH:Handler, In)]
 1010    ->  extend_args(Handler, Content, Goal),
 1011        phrase(MH:Goal, In),
 1012        mailboxes(In, NewBoxes),
 1013        keysort(NewBoxes, Keyed),
 1014        group_pairs_by_key(Keyed, NewPosts)
 1015    ;   Boxes = [ignore(_, _)|_]
 1016    ->  NewPosts = []
 1017    ;   Boxes = [accept(_,_),accept(_,_)|_]
 1018    ->  print_message(error, html(multiple_receivers(Id))),
 1019        NewPosts = []
 1020    ;   print_message(error, html(no_receiver(Id))),
 1021        NewPosts = []
 1022    ).
 1023
 1024add_new_posts([], T, T).
 1025add_new_posts([Id-Posts|NewT], T0, T) :-
 1026    (   select(Id-List0, T0, Id-List, T1)
 1027    ->  append(List0, Posts, List)
 1028    ;   debug(html(mailman), 'Stuck with new posts on ~q', [Id]),
 1029        fail
 1030    ),
 1031    add_new_posts(NewT, T1, T).

 mail_handlers(+Boxes, -Handlers, -Posters) is det

Collect all post(Module,HTML) into Posters and the remainder in Handlers. Handlers consists of accept(Handler, Tokens) and ignore(_,_).

 1040mail_handlers([], [], []).
 1041mail_handlers([post(Module,HTML)|T0], H, [Module:HTML|T]) :-
 1042    !,
 1043    mail_handlers(T0, H, T).
 1044mail_handlers([H|T0], [H|T], C) :-
 1045    mail_handlers(T0, T, C).
 1046
 1047extend_args(Term, Extra, NewTerm) :-
 1048    Term =.. [Name|Args],
 1049    append(Args, [Extra], NewArgs),
 1050    NewTerm =.. [Name|NewArgs].

 sorted_html(+Content:list)// is det

Default handlers for html_receive//1. It sorts the posted objects to create a unique list.

bug

- Elements can differ just on the module. Ideally we should phrase all members, sort the list of list of tokens and emit the result. Can we do better?

 1061sorted_html(List) -->
 1062    { sort(List, Unique) },
 1063    html(Unique).

 head_html(+Content:list)// is det

Handler for html_receive(head). Unlike sorted_html//1, it calls a user hook html_head_expansion/2 to process the collected head material into a term suitable for html//1.

To be done

- This has been added to facilitate html_head.pl, an experimental library for dealing with css and javascript resources. It feels a bit like a hack, but for now I do not know a better solution.

 1076head_html(List) -->
 1077    { list_to_set(List, Unique),
 1078      html_expand_head(Unique, NewList)
 1079    },
 1080    html(NewList).
 1081
 1082:- multifile
 1083    html_head_expansion/2. 1084
 1085html_expand_head(List0, List) :-
 1086    html_head_expansion(List0, List1),
 1087    List0 \== List1,
 1088    !,
 1089    html_expand_head(List1, List).
 1090html_expand_head(List, List).
 1091
 1092
 1093                 /*******************************
 1094                 *             LAYOUT           *
 1095                 *******************************/
 1096
 1097pre_open(Env) -->
 1098    { layout(Env, N-_, _)
 1099    },
 1100    !,
 1101    [ nl(N) ].
 1102pre_open(_) --> [].
 1103
 1104post_open(Env) -->
 1105    { layout(Env, _-N, _)
 1106    },
 1107    !,
 1108    [ nl(N) ].
 1109post_open(_) -->
 1110    [].
 1111
 1112pre_close(head) -->
 1113    !,
 1114    html_receive(head, head_html),
 1115    { layout(head, _, N-_) },
 1116    [ nl(N) ].
 1117pre_close(Env) -->
 1118    { layout(Env, _, N-_)
 1119    },
 1120    !,
 1121    [ nl(N) ].
 1122pre_close(_) -->
 1123    [].
 1124
 1125post_close(Env) -->
 1126    { layout(Env, _, _-N)
 1127    },
 1128    !,
 1129    [ nl(N) ].
 1130post_close(_) -->
 1131    [].

 layout(+Tag, -Open, -Close) is det

Define required newlines before and after tags. This table is rather incomplete. New rules can be added to this multifile predicate.

Arguments:

Tag	- Name of the tag
Open	- Tuple M-N, where M is the number of lines before the tag and N after.
Close	- Either as Open, or the atom - (minus) to omit the close-tag or empty to indicate the element has no content model.

To be done

- Complete table

 1148:- multifile
 1149    layout/3. 1150
 1151layout(table,      2-1, 1-2).
 1152layout(blockquote, 2-1, 1-2).
 1153layout(pre,        2-1, 0-2).
 1154layout(textarea,   1-1, 0-1).
 1155layout(center,     2-1, 1-2).
 1156layout(dl,         2-1, 1-2).
 1157layout(ul,         1-1, 1-1).
 1158layout(ol,         2-1, 1-2).
 1159layout(form,       2-1, 1-2).
 1160layout(frameset,   2-1, 1-2).
 1161layout(address,    2-1, 1-2).
 1162
 1163layout(head,       1-1, 1-1).
 1164layout(body,       1-1, 1-1).
 1165layout(script,     1-1, 1-1).
 1166layout(style,      1-1, 1-1).
 1167layout(select,     1-1, 1-1).
 1168layout(map,        1-1, 1-1).
 1169layout(html,       1-1, 1-1).
 1170layout(caption,    1-1, 1-1).
 1171layout(applet,     1-1, 1-1).
 1172
 1173layout(tr,         1-0, 0-1).
 1174layout(option,     1-0, 0-1).
 1175layout(li,         1-0, 0-1).
 1176layout(dt,         1-0, -).
 1177layout(dd,         0-0, -).
 1178layout(title,      1-0, 0-1).
 1179
 1180layout(h1,         2-0, 0-2).
 1181layout(h2,         2-0, 0-2).
 1182layout(h3,         2-0, 0-2).
 1183layout(h4,         2-0, 0-2).
 1184
 1185layout(iframe,     1-1, 1-1).
 1186
 1187layout(hr,         1-1, empty).         % empty elements
 1188layout(br,         0-1, empty).
 1189layout(img,        0-0, empty).
 1190layout(meta,       1-1, empty).
 1191layout(base,       1-1, empty).
 1192layout(link,       1-1, empty).
 1193layout(input,      0-0, empty).
 1194layout(frame,      1-1, empty).
 1195layout(col,        0-0, empty).
 1196layout(area,       1-0, empty).
 1197layout(input,      1-0, empty).
 1198layout(param,      1-0, empty).
 1199
 1200layout(p,          2-1, -).             % omited close
 1201layout(td,         0-0, 0-0).
 1202
 1203layout(div,        1-0, 0-1).
 1204
 1205                 /*******************************
 1206                 *           PRINTING           *
 1207                 *******************************/

 print_html(+List) is det

 print_html(+Out:stream, +List) is det

Print list of atoms and layout instructions. Currently used layout instructions:

nl(N)

Use at minimum N newlines here.

mailbox(Id, Box)

Repositioned tokens (see html_post//2 and html_receive//2)

 1222print_html(List) :-
 1223    current_output(Out),
 1224    mailman(List),
 1225    write_html(List, Out).
 1226print_html(Out, List) :-
 1227    (   html_current_option(dialect(xhtml))
 1228    ->  stream_property(Out, encoding(Enc)),
 1229        (   Enc == utf8
 1230        ->  true
 1231        ;   print_message(warning, html(wrong_encoding(Out, Enc)))
 1232        ),
 1233        xml_header(Hdr),
 1234        write(Out, Hdr), nl(Out)
 1235    ;   true
 1236    ),
 1237    mailman(List),
 1238    write_html(List, Out),
 1239    flush_output(Out).
 1240
 1241write_html([], _).
 1242write_html([nl(N)|T], Out) :-
 1243    !,
 1244    join_nl(T, N, Lines, T2),
 1245    write_nl(Lines, Out),
 1246    write_html(T2, Out).
 1247write_html([mailbox(_, Box)|T], Out) :-
 1248    !,
 1249    (   Box = accept(_, Accepted)
 1250    ->  write_html(Accepted, Out)
 1251    ;   true
 1252    ),
 1253    write_html(T, Out).
 1254write_html([cdata(Env, Tokens)|T], Out) :-
 1255    !,
 1256    with_output_to(string(CDATA), write_html(Tokens, current_output)),
 1257    valid_cdata(Env, CDATA),
 1258    write(Out, CDATA),
 1259    write_html(T, Out).
 1260write_html([H|T], Out) :-
 1261    write(Out, H),
 1262    write_html(T, Out).
 1263
 1264join_nl([nl(N0)|T0], N1, N, T) :-
 1265    !,
 1266    N2 is max(N0, N1),
 1267    join_nl(T0, N2, N, T).
 1268join_nl(L, N, N, L).
 1269
 1270write_nl(0, _) :- !.
 1271write_nl(N, Out) :-
 1272    nl(Out),
 1273    N1 is N - 1,
 1274    write_nl(N1, Out).

 valid_cdata(+Env, +String) is det

True when String is valid content for a CDATA element such as <script>. This implies it cannot contain </script/. There is no escape for this and the script generator must use a work-around using features of the script language. For example, when using JavaScript, "</script>" can be written as "<\/script>".

Errors

- domain_error(cdata, String)

See also

- write_json/2, js_arg//1.

 1288valid_cdata(Env, String) :-
 1289    atomics_to_string(['</', Env, '>'], End),
 1290    sub_atom_icasechk(String, _, End),
 1291    !,
 1292    domain_error(cdata, String).
 1293valid_cdata(_, _).

 html_print_length(+List, -Len) is det

Determine the content length of a token list produced using html//1. Here is an example on how this is used to output an HTML compatible to HTTP:

        phrase(html(DOM), Tokens),
        html_print_length(Tokens, Len),
        format('Content-type: text/html; charset=UTF-8~n'),
        format('Content-length: ~d~n~n', [Len]),
        print_html(Tokens)

 1309html_print_length(List, Len) :-
 1310    mailman(List),
 1311    (   html_current_option(dialect(xhtml))
 1312    ->  xml_header(Hdr),
 1313        atom_length(Hdr, L0),
 1314        L1 is L0+1                  % one for newline
 1315    ;   L1 = 0
 1316    ),
 1317    html_print_length(List, L1, Len).
 1318
 1319html_print_length([], L, L).
 1320html_print_length([nl(N)|T], L0, L) :-
 1321    !,
 1322    join_nl(T, N, Lines, T1),
 1323    L1 is L0 + Lines,               % assume only \n!
 1324    html_print_length(T1, L1, L).
 1325html_print_length([mailbox(_, Box)|T], L0, L) :-
 1326    !,
 1327    (   Box = accept(_, Accepted)
 1328    ->  html_print_length(Accepted, L0, L1)
 1329    ;   L1 = L0
 1330    ),
 1331    html_print_length(T, L1, L).
 1332html_print_length([cdata(_, CDATA)|T], L0, L) :-
 1333    !,
 1334    html_print_length(CDATA, L0, L1),
 1335    html_print_length(T, L1, L).
 1336html_print_length([H|T], L0, L) :-
 1337    atom_length(H, Hlen),
 1338    L1 is L0+Hlen,
 1339    html_print_length(T, L1, L).

 reply_html_page(:Head, :Body) is det

 reply_html_page(+Style, :Head, :Body) is det

Provide the complete reply as required by http_wrapper.pl for a page constructed from Head and Body. The HTTP Content-type is provided by html_current_option/1.

 1349reply_html_page(Head, Body) :-
 1350    reply_html_page(default, Head, Body).
 1351reply_html_page(Style, Head, Body) :-
 1352    html_current_option(content_type(Type)),
 1353    phrase(page(Style, Head, Body), HTML),
 1354    format('Content-type: ~w~n~n', [Type]),
 1355    print_html(HTML).
 1356
 1357
 1358                 /*******************************
 1359                 *     META-PREDICATE SUPPORT   *
 1360                 *******************************/

 html_meta(+Heads) is det

This directive can be used to declare that an HTML rendering rule takes HTML content as argument. It has two effects. It emits the appropriate meta_predicate/1 and instructs the built-in editor (PceEmacs) to provide proper colouring for the arguments. The arguments in Head are the same as for meta_predicate or can be constant html. For example:

:- html_meta
      page(html,html,?,?).

 1376html_meta(Spec) :-
 1377    throw(error(context_error(nodirective, html_meta(Spec)), _)).
 1378
 1379html_meta_decls(Var, _, _) :-
 1380    var(Var),
 1381    !,
 1382    instantiation_error(Var).
 1383html_meta_decls((A,B), (MA,MB), [MH|T]) :-
 1384    !,
 1385    html_meta_decl(A, MA, MH),
 1386    html_meta_decls(B, MB, T).
 1387html_meta_decls(A, MA, [MH]) :-
 1388    html_meta_decl(A, MA, MH).
 1389
 1390html_meta_decl(Head, MetaHead,
 1391               html_write:html_meta_head(GenHead, Module, Head)) :-
 1392    functor(Head, Name, Arity),
 1393    functor(GenHead, Name, Arity),
 1394    prolog_load_context(module, Module),
 1395    Head =.. [Name|HArgs],
 1396    maplist(html_meta_decl, HArgs, MArgs),
 1397    MetaHead =.. [Name|MArgs].
 1398
 1399html_meta_decl(html, :) :- !.
 1400html_meta_decl(Meta, Meta).
 1401
 1402system:term_expansion((:- html_meta(Heads)),
 1403                      [ (:- meta_predicate(Meta))
 1404                      | MetaHeads
 1405                      ]) :-
 1406    html_meta_decls(Heads, Meta, MetaHeads).
 1407
 1408:- multifile
 1409    html_meta_head/3. 1410
 1411html_meta_colours(Head, Goal, built_in-Colours) :-
 1412    Head =.. [_|MArgs],
 1413    Goal =.. [_|Args],
 1414    maplist(meta_colours, MArgs, Args, Colours).
 1415
 1416meta_colours(html, HTML, Colours) :-
 1417    !,
 1418    html_colours(HTML, Colours).
 1419meta_colours(I, _, Colours) :-
 1420    integer(I), I>=0,
 1421    !,
 1422    Colours = meta(I).
 1423meta_colours(_, _, classify).
 1424
 1425html_meta_called(Head, Goal, Called) :-
 1426    Head =.. [_|MArgs],
 1427    Goal =.. [_|Args],
 1428    meta_called(MArgs, Args, Called, []).
 1429
 1430meta_called([], [], Called, Called).
 1431meta_called([html|MT], [A|AT], Called, Tail) :-
 1432    !,
 1433    phrase(called_by(A), Called, Tail1),
 1434    meta_called(MT, AT, Tail1, Tail).
 1435meta_called([0|MT], [A|AT], [A|CT0], CT) :-
 1436    !,
 1437    meta_called(MT, AT, CT0, CT).
 1438meta_called([I|MT], [A|AT], [A+I|CT0], CT) :-
 1439    integer(I), I>0,
 1440    !,
 1441    meta_called(MT, AT, CT0, CT).
 1442meta_called([_|MT], [_|AT], Called, Tail) :-
 1443    !,
 1444    meta_called(MT, AT, Called, Tail).
 1445
 1446
 1447:- html_meta
 1448    html(html,?,?),
 1449    page(html,?,?),
 1450    page(html,html,?,?),
 1451    page(+,html,html,?,?),
 1452    pagehead(+,html,?,?),
 1453    pagebody(+,html,?,?),
 1454    reply_html_page(html,html),
 1455    reply_html_page(+,html,html),
 1456    html_post(+,html,?,?). 1457
 1458
 1459                 /*******************************
 1460                 *      PCE EMACS SUPPORT       *
 1461                 *******************************/
 1462
 1463:- multifile
 1464    prolog_colour:goal_colours/2,
 1465    prolog_colour:style/2,
 1466    prolog_colour:message//1,
 1467    prolog:called_by/2. 1468
 1469prolog_colour:goal_colours(Goal, Colours) :-
 1470    html_meta_head(Goal, _Module, Head),
 1471    html_meta_colours(Head, Goal, Colours).
 1472prolog_colour:goal_colours(html_meta(_),
 1473                           built_in-[meta_declarations([html])]).
 1474
 1475                                        % TBD: Check with do_expand!
 1476html_colours(Var, classify) :-
 1477    var(Var),
 1478    !.
 1479html_colours(\List, html_raw-[list-Colours]) :-
 1480    is_list(List),
 1481    !,
 1482    list_colours(List, Colours).
 1483html_colours(\_, html_call-[dcg]) :- !.
 1484html_colours(_:Term, built_in-[classify,Colours]) :-
 1485    !,
 1486    html_colours(Term, Colours).
 1487html_colours(&(Entity), functor-[entity(Entity)]) :- !.
 1488html_colours(List, list-ListColours) :-
 1489    List = [_|_],
 1490    !,
 1491    list_colours(List, ListColours).
 1492html_colours(Format-Args, functor-[FormatColor,ArgsColors]) :-
 1493    !,
 1494    format_colours(Format, FormatColor),
 1495    format_arg_colours(Args, Format, ArgsColors).
 1496html_colours(Term, TermColours) :-
 1497    compound(Term),
 1498    compound_name_arguments(Term, Name, Args),
 1499    Name \== '.',
 1500    !,
 1501    (   Args = [One]
 1502    ->  TermColours = html(Name)-ArgColours,
 1503        (   layout(Name, _, empty)
 1504        ->  attr_colours(One, ArgColours)
 1505        ;   html_colours(One, Colours),
 1506            ArgColours = [Colours]
 1507        )
 1508    ;   Args = [AList,Content]
 1509    ->  TermColours = html(Name)-[AColours, Colours],
 1510        attr_colours(AList, AColours),
 1511        html_colours(Content, Colours)
 1512    ;   TermColours = error
 1513    ).
 1514html_colours(_, classify).
 1515
 1516list_colours(Var, classify) :-
 1517    var(Var),
 1518    !.
 1519list_colours([], []).
 1520list_colours([H0|T0], [H|T]) :-
 1521    !,
 1522    html_colours(H0, H),
 1523    list_colours(T0, T).
 1524list_colours(Last, Colours) :-          % improper list
 1525    html_colours(Last, Colours).
 1526
 1527attr_colours(Var, classify) :-
 1528    var(Var),
 1529    !.
 1530attr_colours([], classify) :- !.
 1531attr_colours(Term, list-Elements) :-
 1532    Term = [_|_],
 1533    !,
 1534    attr_list_colours(Term, Elements).
 1535attr_colours(Name=Value, built_in-[html_attribute(Name), VColour]) :-
 1536    !,
 1537    attr_value_colour(Value, VColour).
 1538attr_colours(NS:Term, built_in-[ html_xmlns(NS),
 1539                                 html_attribute(Name)-[classify]
 1540                               ]) :-
 1541    compound(Term),
 1542    compound_name_arity(Term, Name, 1).
 1543attr_colours(Term, html_attribute(Name)-[VColour]) :-
 1544    compound(Term),
 1545    compound_name_arity(Term, Name, 1),
 1546    !,
 1547    Term =.. [Name,Value],
 1548    attr_value_colour(Value, VColour).
 1549attr_colours(Name, html_attribute(Name)) :-
 1550    atom(Name),
 1551    !.
 1552attr_colours(Term, classify) :-
 1553    compound(Term),
 1554    compound_name_arity(Term, '.', 2),
 1555    !.
 1556attr_colours(_, error).
 1557
 1558attr_list_colours(Var, classify) :-
 1559    var(Var),
 1560    !.
 1561attr_list_colours([], []).
 1562attr_list_colours([H0|T0], [H|T]) :-
 1563    attr_colours(H0, H),
 1564    attr_list_colours(T0, T).
 1565
 1566attr_value_colour(Var, classify) :-
 1567    var(Var).
 1568attr_value_colour(location_by_id(ID), sgml_attr_function-[Colour]) :-
 1569    !,
 1570    location_id(ID, Colour).
 1571attr_value_colour(#(ID), sgml_attr_function-[Colour]) :-
 1572    !,
 1573    location_id(ID, Colour).
 1574attr_value_colour(A+B, sgml_attr_function-[CA,CB]) :-
 1575    !,
 1576    attr_value_colour(A, CA),
 1577    attr_value_colour(B, CB).
 1578attr_value_colour(encode(_), sgml_attr_function-[classify]) :- !.
 1579attr_value_colour(Atom, classify) :-
 1580    atomic(Atom),
 1581    !.
 1582attr_value_colour([_|_], classify) :- !.
 1583attr_value_colour(_Fmt-_Args, classify) :- !.
 1584attr_value_colour(Term, classify) :-
 1585    compound(Term),
 1586    compound_name_arity(Term, '.', 2),
 1587    !.
 1588attr_value_colour(_, error).
 1589
 1590location_id(ID, classify) :-
 1591    var(ID),
 1592    !.
 1593location_id(ID, Class) :-
 1594    (   catch(http_location_by_id(ID, Location), _, fail)
 1595    ->  Class = http_location_for_id(Location)
 1596    ;   Class = http_no_location_for_id(ID)
 1597    ).
 1598location_id(_, classify).
 1599
 1600format_colours(Format, format_string) :- atom(Format), !.
 1601format_colours(Format, format_string) :- string(Format), !.
 1602format_colours(_Format, type_error(text)).
 1603
 1604format_arg_colours(Args, _Format, classify) :- is_list(Args), !.
 1605format_arg_colours(_, _, type_error(list)).
 1606
 1607:- op(990, xfx, :=).                    % allow compiling without XPCE
 1608:- op(200, fy, @). 1609
 1610prolog_colour:style(html(_),                    [colour(magenta4), bold(true)]).
 1611prolog_colour:style(entity(_),                  [colour(magenta4)]).
 1612prolog_colour:style(html_attribute(_),          [colour(magenta4)]).
 1613prolog_colour:style(html_xmlns(_),              [colour(magenta4)]).
 1614prolog_colour:style(format_string(_),           [colour(magenta4)]).
 1615prolog_colour:style(sgml_attr_function,         [colour(blue)]).
 1616prolog_colour:style(http_location_for_id(_),    [bold(true)]).
 1617prolog_colour:style(http_no_location_for_id(_), [colour(red), bold(true)]).
 1618
 1619
 1620prolog_colour:message(html(Element)) -->
 1621    [ '~w: SGML element'-[Element] ].
 1622prolog_colour:message(entity(Entity)) -->
 1623    [ '~w: SGML entity'-[Entity] ].
 1624prolog_colour:message(html_attribute(Attr)) -->
 1625    [ '~w: SGML attribute'-[Attr] ].
 1626prolog_colour:message(sgml_attr_function) -->
 1627    [ 'SGML Attribute function'-[] ].
 1628prolog_colour:message(http_location_for_id(Location)) -->
 1629    [ 'ID resolves to ~w'-[Location] ].
 1630prolog_colour:message(http_no_location_for_id(ID)) -->
 1631    [ '~w: no such ID'-[ID] ].
 1632
 1633
 1634%       prolog:called_by(+Goal, -Called)
 1635%
 1636%       Hook into library(pce_prolog_xref).  Called is a list of callable
 1637%       or callable+N to indicate (DCG) arglist extension.
 1638
 1639
 1640prolog:called_by(Goal, Called) :-
 1641    html_meta_head(Goal, _Module, Head),
 1642    html_meta_called(Head, Goal, Called).
 1643
 1644called_by(Term) -->
 1645    called_by(Term, _).
 1646
 1647called_by(Var, _) -->
 1648    { var(Var) },
 1649    !,
 1650    [].
 1651called_by(\G, M) -->
 1652    !,
 1653    (   { is_list(G) }
 1654    ->  called_by(G, M)
 1655    ;   {atom(M)}
 1656    ->  [(M:G)+2]
 1657    ;   [G+2]
 1658    ).
 1659called_by([], _) -->
 1660    !,
 1661    [].
 1662called_by([H|T], M) -->
 1663    !,
 1664    called_by(H, M),
 1665    called_by(T, M).
 1666called_by(M:Term, _) -->
 1667    !,
 1668    (   {atom(M)}
 1669    ->  called_by(Term, M)
 1670    ;   []
 1671    ).
 1672called_by(Term, M) -->
 1673    { compound(Term),
 1674      !,
 1675      Term =.. [_|Args]
 1676    },
 1677    called_by(Args, M).
 1678called_by(_, _) -->
 1679    [].
 1680
 1681:- multifile
 1682    prolog:hook/1. 1683
 1684prolog:hook(body(_,_,_)).
 1685prolog:hook(body(_,_,_,_)).
 1686prolog:hook(head(_,_,_)).
 1687prolog:hook(head(_,_,_,_)).
 1688
 1689
 1690                 /*******************************
 1691                 *            MESSAGES          *
 1692                 *******************************/
 1693
 1694:- multifile
 1695    prolog:message/3. 1696
 1697prolog:message(html(expand_failed(What))) -->
 1698    [ 'Failed to translate to HTML: ~p'-[What] ].
 1699prolog:message(html(wrong_encoding(Stream, Enc))) -->
 1700    [ 'XHTML demands UTF-8 encoding; encoding of ~p is ~w'-[Stream, Enc] ].
 1701prolog:message(html(multiple_receivers(Id))) -->
 1702    [ 'html_post//2: multiple receivers for: ~p'-[Id] ].
 1703prolog:message(html(no_receiver(Id))) -->
 1704    [ 'html_post//2: no receivers for: ~p'-[Id] ]