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
  105
  106
  107/** <module> Write HTML text
  108
  109Most   code   doesn't   need  to   use  this   directly;  instead   use
  110library(http/http_server),  which  combines   this  library  with   the
  111typical HTTP libraries that most servers need.
  112
  113The purpose of this library  is  to   simplify  writing  HTML  pages. Of
  114course, it is possible to  use  format/3   to  write  to the HTML stream
  115directly, but this is generally not very satisfactory:
  116
  117        * It is a lot of typing
  118        * It does not guarantee proper HTML syntax.  You have to deal
  119          with HTML quoting, proper nesting and reasonable layout.
  120        * It is hard to use satisfactory abstraction
  121
  122This module tries to remedy these problems.   The idea is to translate a
  123Prolog term into  an  HTML  document.  We   use  DCG  for  most  of  the
  124generation.
  125
  126---++ International documents
  127
  128The library supports the generation of international documents, but this
  129is currently limited to using UTF-8 encoded HTML or XHTML documents.  It
  130is strongly recommended to use the following mime-type.
  131
  132==
  133Content-type: text/html; charset=UTF-8
  134==
  135
  136When generating XHTML documents, the output stream must be in UTF-8
  137encoding.
  138*/
  139
  140
  141                 /*******************************
  142                 *            SETTINGS          *
  143                 *******************************/
  144
  145%!  html_set_options(+Options) is det.
  146%
  147%   Set options for the HTML output.   Options  are stored in prolog
  148%   flags to ensure proper multi-threaded behaviour where setting an
  149%   option is local to the thread  and   new  threads start with the
  150%   options from the parent thread. Defined options are:
  151%
  152%     * dialect(Dialect)
  153%       One of =html4=, =xhtml= or =html5= (default). For
  154%       compatibility reasons, =html= is accepted as an
  155%       alias for =html4=.
  156%
  157%     * doctype(+DocType)
  158%       Set the =|<|DOCTYPE|= DocType =|>|= line for page//1 and
  159%       page//2.
  160%
  161%     * content_type(+ContentType)
  162%       Set the =|Content-type|= for reply_html_page/3
  163%
  164%   Note that the doctype and  content_type   flags  are  covered by
  165%   distinct  prolog  flags:  =html4_doctype=,  =xhtml_doctype=  and
  166%   =html5_doctype= and similar for the   content  type. The Dialect
  167%   must be switched before doctype and content type.
  168
  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).
  202
  203%!  html_current_option(?Option) is nondet.
  204%
  205%   True if Option is an active option for the HTML generator.
  206
  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').
  239
  240%!  init_options is det.
  241%
  242%   Initialise the HTML processing options.
  243
  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.  255
  256%!  xml_header(-Header)
  257%
  258%   First line of XHTML document.  Added by print_html/1.
  259
  260xml_header('<?xml version=\'1.0\' encoding=\'UTF-8\'?>').
  261
  262%!  ns(?Which, ?Atom)
  263%
  264%   Namespace declarations
  265
  266ns(xhtml, 'http://www.w3.org/1999/xhtml').
  267
  268
  269                 /*******************************
  270                 *             PAGE             *
  271                 *******************************/
  272
  273%!  page(+Content:dom)// is det.
  274%!  page(+Head:dom, +Body:dom)// is det.
  275%
  276%   Generate a page including the   HTML  =|<!DOCTYPE>|= header. The
  277%   actual doctype is read from the   option =doctype= as defined by
  278%   html_set_options/1.
  279
  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).
  294
  295%!  doctype//
  296%
  297%   Emit the =|<DOCTYPE ...|= header.  The   doctype  comes from the
  298%   option doctype(DOCTYPE) (see html_set_options/1).   Setting  the
  299%   doctype to '' (empty  atom)   suppresses  the header completely.
  300%   This is to avoid a IE bug in processing AJAX output ...
  301
  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).
  372
  373%!  html(+Content:dom)// is det
  374%
  375%   Generate HTML from Content.  Generates a token sequence for
  376%   print_html/2.
  377
  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).
  504
  505%!  raw(+List, +Module)// is det.
  506%
  507%   Emit unquoted (raw) output used for scripts, etc.
  508
  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].
  538
  539
  540%!  html_begin(+Env)// is det.
  541%!  html_end(+End)// is det
  542%
  543%   For  html_begin//1,  Env  is   a    term   Env(Attributes);  for
  544%   html_end//1  it  is  the  plain    environment  name.  Used  for
  545%   exceptional  cases.  Normal  applications    use   html//1.  The
  546%   following two fragments are identical, where we prefer the first
  547%   as it is more concise and less error-prone.
  548%
  549%   ==
  550%           html(table(border=1, \table_content))
  551%   ==
  552%   ==
  553%           html_begin(table(border=1)
  554%           table_content,
  555%           html_end(table)
  556%   ==
  557
  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).
  589
  590%!  xhtml_empty(+Env, +Attributes)// is det.
  591%
  592%   Emit element in xhtml mode with empty content.
  593
  594xhtml_empty(Env, Attributes) -->
  595    pre_open(Env),
  596    [<],
  597    [Env],
  598    attributes(Attributes),
  599    ['/>'].
  600
  601%!  xhtml_ns(+Id, +Value)//
  602%
  603%   Demand an xmlns:id=Value in the outer   html  tag. This uses the
  604%   html_post/2 mechanism to  post  to   the  =xmlns=  channel. Rdfa
  605%   (http://www.w3.org/2006/07/SWD/RDFa/syntax/), embedding RDF   in
  606%   (x)html provides a typical  usage  scenario   where  we  want to
  607%   publish the required namespaces in the header. We can define:
  608%
  609%   ==
  610%   rdf_ns(Id) -->
  611%           { rdf_global_id(Id:'', Value) },
  612%           xhtml_ns(Id, Value).
  613%   ==
  614%
  615%   After which we can use rdf_ns//1 as  a normal rule in html//1 to
  616%   publish namespaces from library(semweb/rdf_db).   Note that this
  617%   macro only has effect if  the  dialect   is  set  to =xhtml=. In
  618%   =html= mode it is silently ignored.
  619%
  620%   The required =xmlns= receiver  is   installed  by  html_begin//1
  621%   using the =html= tag and thus is   present  in any document that
  622%   opens the outer =html= environment through this library.
  623
  624xhtml_ns(Id, Value) -->
  625    { html_current_option(dialect(xhtml)) },
  626    !,
  627    html_post(xmlns, \attribute(xmlns:Id=Value)).
  628xhtml_ns(_, _) -->
  629    [].
  630
  631%!  html_root_attribute(+Name, +Value)//
  632%
  633%   Add an attribute to the  HTML  root   element  of  the page. For
  634%   example:
  635%
  636%     ==
  637%         html(div(...)),
  638%         html_root_attribute(lang, en),
  639%         ...
  640%     ==
  641
  642html_root_attribute(Name, Value) -->
  643    html_post(html_begin, \attribute(Name=Value)).
  644
  645%!  attributes(+Env, +Attributes)// is det.
  646%
  647%   Emit attributes for Env. Adds XHTML namespace declaration to the
  648%   html tag if not provided by the caller.
  649
  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 ].
  702
  703%!  attribute_value(+Value) is det.
  704%
  705%   Print an attribute value. Value is either   atomic or one of the
  706%   following terms:
  707%
  708%     * A+B
  709%     Concatenation of A and B
  710%     * encode(V)
  711%     Emit URL-encoded version of V.  See www_form_encode/2.
  712%     * An option list
  713%     Emit ?Name1=encode(Value1)&Name2=encode(Value2) ...
  714%     * A term Format-Arguments
  715%     Use format/3 and emit the result as quoted value.
  716%
  717%   The hook html_write:expand_attribute_value//1 can  be defined to
  718%   provide additional `function like'   translations.  For example,
  719%   http_dispatch.pl  defines  location_by_id(ID)  to   refer  to  a
  720%   location on the current server  based   on  the  handler id. See
  721%   http_location_by_id/2.
  722
  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    ;   ['&amp;'],
  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    }.
  786
  787%!  attribute_value_m(+List)//
  788%
  789%   Used for multi-valued attributes, such as class-lists.  E.g.,
  790%
  791%     ==
  792%           body(class([c1, c2]), Body)
  793%     ==
  794%
  795%     Emits =|<body class="c1 c2"> ...|=
  796
  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                 *******************************/
  811
  812%!  html_quoted(Text)// is det.
  813%
  814%   Quote  the  value  for  normal  (CDATA)  text.  Note  that  text
  815%   appearing in the document  structure   is  normally quoted using
  816%   these rules. I.e. the following emits  properly quoted bold text
  817%   regardless of the content of Text:
  818%
  819%   ==
  820%           html(b(Text))
  821%   ==
  822%
  823%   @tbd    Assumes UTF-8 encoding of the output.
  824
  825html_quoted(Text) -->
  826    { xml_quote_cdata(Text, Quoted, utf8) },
  827    [ Quoted ].
  828
  829%!  html_quoted_attribute(+Text)// is det.
  830%
  831%   Quote the value  according  to   the  rules  for  tag-attributes
  832%   included in double-quotes.  Note   that  -like  html_quoted//1-,
  833%   attributed   values   printed   through   html//1   are   quoted
  834%   atomatically.
  835%
  836%   @tbd    Assumes UTF-8 encoding of the output.
  837
  838html_quoted_attribute(Text) -->
  839    { xml_quote_attribute(Text, Quoted, utf8) },
  840    [ Quoted ].
  841
  842%!  cdata_element(?Element)
  843%
  844%   True when Element contains declared CDATA   and thus only =|</|=
  845%   needs to be escaped.
  846
  847cdata_element(script).
  848cdata_element(style).
  849
  850
  851                 /*******************************
  852                 *      REPOSITIONING HTML      *
  853                 *******************************/
  854
  855%!  html_post(+Id, :HTML)// is det.
  856%
  857%   Reposition HTML to  the  receiving   Id.  The  html_post//2 call
  858%   processes HTML using html//1. Embedded   \-commands are executed
  859%   by mailman/1 from  print_html/1   or  html_print_length/2. These
  860%   commands are called in the calling   context of the html_post//2
  861%   call.
  862%
  863%   A typical usage scenario is to  get   required  CSS links in the
  864%   document head in a reusable fashion. First, we define css//1 as:
  865%
  866%   ==
  867%   css(URL) -->
  868%           html_post(css,
  869%                     link([ type('text/css'),
  870%                            rel('stylesheet'),
  871%                            href(URL)
  872%                          ])).
  873%   ==
  874%
  875%   Next we insert the _unique_ CSS links, in the pagehead using the
  876%   following call to reply_html_page/2:
  877%
  878%   ==
  879%           reply_html_page([ title(...),
  880%                             \html_receive(css)
  881%                           ],
  882%                           ...)
  883%   ==
  884
  885html_post(Id, Content) -->
  886    { strip_module(Content, M, C) },
  887    [ mailbox(Id, post(M, C)) ].
  888
  889%!  html_receive(+Id)// is det.
  890%
  891%   Receive posted HTML tokens. Unique   sequences  of tokens posted
  892%   with  html_post//2  are  inserted   at    the   location   where
  893%   html_receive//1 appears.
  894%
  895%   @see    The local predicate sorted_html//1 handles the output of
  896%           html_receive//1.
  897%   @see    html_receive//2 allows for post-processing the posted
  898%           material.
  899
  900html_receive(Id) -->
  901    html_receive(Id, sorted_html).
  902
  903%!  html_receive(+Id, :Handler)// is det.
  904%
  905%   This extended version of html_receive//1   causes  Handler to be
  906%   called to process all messages posted to the channal at the time
  907%   output  is  generated.  Handler  is    called  as  below,  where
  908%   `PostedTerms` is a list of  Module:Term   created  from calls to
  909%   html_post//2. Module is the context module of html_post and Term
  910%   is the unmodified term. Members  in   `PostedTerms`  are  in the
  911%   order posted and may contain duplicates.
  912%
  913%     ==
  914%       phrase(Handler, PostedTerms, HtmlTerms, Rest)
  915%     ==
  916%
  917%   Typically, Handler collects the posted   terms,  creating a term
  918%   suitable for html//1 and finally calls html//1.
  919
  920html_receive(Id, Handler) -->
  921    { strip_module(Handler, M, P) },
  922    [ mailbox(Id, accept(M:P, _)) ].
  923
  924%!  html_noreceive(+Id)// is det.
  925%
  926%   As html_receive//1, but discard posted messages.
  927
  928html_noreceive(Id) -->
  929    [ mailbox(Id, ignore(_,_)) ].
  930
  931%!  mailman(+Tokens) is det.
  932%
  933%   Collect  posted  tokens  and  copy    them  into  the  receiving
  934%   mailboxes. Mailboxes may produce output for  each other, but not
  935%   cyclic. The current scheme to resolve   this is rather naive: It
  936%   simply permutates the mailbox resolution order  until it found a
  937%   working one. Before that, it puts   =head= and =script= boxes at
  938%   the end.
  939
  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).
  968
  969%!  html_token(?Token, +Tokens) is nondet.
  970%
  971%   True if Token is a token in the  token set. This is like member,
  972%   but the toplevel list may contain cdata(Elem, Tokens).
  973
  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).
  982
  983%!  mailboxes(+Tokens, -MailBoxes) is det.
  984%
  985%   Get all mailboxes from the token set.
  986
  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).
 1032
 1033
 1034%!  mail_handlers(+Boxes, -Handlers, -Posters) is det.
 1035%
 1036%   Collect all post(Module,HTML) into Posters  and the remainder in
 1037%   Handlers.  Handlers  consists  of  accept(Handler,  Tokens)  and
 1038%   ignore(_,_).
 1039
 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].
 1051
 1052%!  sorted_html(+Content:list)// is det.
 1053%
 1054%   Default  handlers  for  html_receive//1.  It  sorts  the  posted
 1055%   objects to create a unique list.
 1056%
 1057%   @bug    Elements can differ just on the module.  Ideally we
 1058%           should phrase all members, sort the list of list of
 1059%           tokens and emit the result.  Can we do better?
 1060
 1061sorted_html(List) -->
 1062    { sort(List, Unique) },
 1063    html(Unique).
 1064
 1065%!  head_html(+Content:list)// is det.
 1066%
 1067%   Handler for html_receive(head). Unlike  sorted_html//1, it calls
 1068%   a user hook  html_write:html_head_expansion/2   to  process  the
 1069%   collected head material into a term suitable for html//1.
 1070%
 1071%   @tbd  This  has  been  added   to  facilitate  html_head.pl,  an
 1072%   experimental  library  for  dealing  with   css  and  javascript
 1073%   resources. It feels a bit like a hack, but for now I do not know
 1074%   a better solution.
 1075
 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    [].
 1132
 1133%!  layout(+Tag, -Open, -Close) is det.
 1134%
 1135%   Define required newlines before and after   tags.  This table is
 1136%   rather incomplete. New rules can  be   added  to  this multifile
 1137%   predicate.
 1138%
 1139%   @param Tag      Name of the tag
 1140%   @param Open     Tuple M-N, where M is the number of lines before
 1141%                   the tag and N after.
 1142%   @param Close    Either as Open, or the atom - (minus) to omit the
 1143%                   close-tag or =empty= to indicate the element has
 1144%                   no content model.
 1145%
 1146%   @tbd    Complete table
 1147
 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                 *******************************/
 1208
 1209%!  print_html(+List) is det.
 1210%!  print_html(+Out:stream, +List) is det.
 1211%
 1212%   Print list of atoms and layout instructions.  Currently used layout
 1213%   instructions:
 1214%
 1215%           * nl(N)
 1216%           Use at minimum N newlines here.
 1217%
 1218%           * mailbox(Id, Box)
 1219%           Repositioned tokens (see html_post//2 and
 1220%           html_receive//2)
 1221
 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).
 1275
 1276%!  valid_cdata(+Env, +String) is det.
 1277%
 1278%   True when String is valid content for   a  CDATA element such as
 1279%   =|<script>|=. This implies  it   cannot  contain  =|</script/|=.
 1280%   There is no escape for this and  the script generator must use a
 1281%   work-around using features of the  script language. For example,
 1282%   when  using  JavaScript,  "</script>"   can    be   written   as
 1283%   "<\/script>".
 1284%
 1285%   @see write_json/2, js_arg//1.
 1286%   @error domain_error(cdata, String)
 1287
 1288valid_cdata(Env, String) :-
 1289    atomics_to_string(['</', Env, '>'], End),
 1290    sub_atom_icasechk(String, _, End),
 1291    !,
 1292    domain_error(cdata, String).
 1293valid_cdata(_, _).
 1294
 1295%!  html_print_length(+List, -Len) is det.
 1296%
 1297%   Determine the content length of  a   token  list  produced using
 1298%   html//1. Here is an example on  how   this  is used to output an
 1299%   HTML compatible to HTTP:
 1300%
 1301%   ==
 1302%           phrase(html(DOM), Tokens),
 1303%           html_print_length(Tokens, Len),
 1304%           format('Content-type: text/html; charset=UTF-8~n'),
 1305%           format('Content-length: ~d~n~n', [Len]),
 1306%           print_html(Tokens)
 1307%   ==
 1308
 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).
 1340
 1341
 1342%!  reply_html_page(:Head, :Body) is det.
 1343%!  reply_html_page(+Style, :Head, :Body) is det.
 1344%
 1345%   Provide the complete reply as required  by http_wrapper.pl for a
 1346%   page constructed from Head and   Body. The HTTP =|Content-type|=
 1347%   is provided by html_current_option/1.
 1348
 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                 *******************************/
 1361
 1362%!  html_meta(+Heads) is det.
 1363%
 1364%   This directive can be used  to   declare  that an HTML rendering
 1365%   rule takes HTML content as  argument.   It  has  two effects. It
 1366%   emits  the  appropriate  meta_predicate/1    and  instructs  the
 1367%   built-in editor (PceEmacs) to provide   proper colouring for the
 1368%   arguments.  The  arguments  in  Head  are    the   same  as  for
 1369%   meta_predicate or can be constant =html=.  For example:
 1370%
 1371%     ==
 1372%     :- html_meta
 1373%           page(html,html,?,?).
 1374%     ==
 1375
 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] ]