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-2023, University of Amsterdam
    7                              VU University Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(html_write,
   38          [ reply_html_page/2,          % :Head, :Body
   39            reply_html_page/3,          % +Style, :Head, :Body
   40            reply_html_partial/1,       % +HTML
   41
   42                                        % Basic output routines
   43            page//1,                    % :Content
   44            page//2,                    % :Head, :Body
   45            page//3,                    % +Style, :Head, :Body
   46            html//1,                    % :Content
   47
   48                                        % Option processing
   49            html_set_options/1,         % +OptionList
   50            html_current_option/1,      % ?Option
   51
   52                                        % repositioning HTML elements
   53            html_post//2,               % +Id, :Content
   54            html_receive//1,            % +Id
   55            html_receive//2,            % +Id, :Handler
   56            xhtml_ns//2,                % +Id, +Value
   57            html_root_attribute//2,     % +Name, +Value
   58
   59            html/4,                     % {|html||quasi quotations|}
   60
   61                                        % Useful primitives for expanding
   62            html_begin//1,              % +EnvName[(Attribute...)]
   63            html_end//1,                % +EnvName
   64            html_quoted//1,             % +Text
   65            html_quoted_attribute//1,   % +Attribute
   66
   67                                        % Emitting the HTML code
   68            print_html/1,               % +List
   69            print_html/2,               % +Stream, +List
   70            html_print_length/2,        % +List, -Length
   71
   72                                        % Extension support
   73            (html_meta)/1,              % +Spec
   74            op(1150, fx, html_meta)
   75          ]).   76:- use_module(html_quasiquotations, [html/4]).   77:- autoload(library(apply),[maplist/3,maplist/4]).   78:- use_module(library(debug),[debug/3]).   79:- autoload(library(error),
   80	    [must_be/2,domain_error/2,instantiation_error/1]).   81:- autoload(library(lists),
   82	    [permutation/2,selectchk/3,append/3,select/4,list_to_set/2]).   83:- autoload(library(option),[option/2]).   84:- autoload(library(pairs),[group_pairs_by_key/2]).   85:- autoload(library(sgml),[xml_quote_cdata/3,xml_quote_attribute/3]).   86:- autoload(library(uri),[uri_encoded/3]).   87:- autoload(library(url),[www_form_encode/2]).   88:- if(exists_source(library(http/http_dispatch))).   89:- autoload(library(http/http_dispatch), [http_location_by_id/2]).   90:- endif.   91
   92% Quote output
   93:- set_prolog_flag(generate_debug_info, false).   94
   95:- meta_predicate
   96    reply_html_page(+, :, :),
   97    reply_html_page(:, :),
   98    html(:, -, +),
   99    page(:, -, +),
  100    page(:, :, -, +),
  101    pagehead(+, :, -, +),
  102    pagebody(+, :, -, +),
  103    html_receive(+, 3, -, +),
  104    html_post(+, :, -, +).  105
  106:- multifile
  107    expand//1,                      % +HTMLElement
  108    expand_attribute_value//1,      % +HTMLAttributeValue
  109    html_header_hook/1.             % +Style

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

  146                 /*******************************
  147                 *            SETTINGS          *
  148                 *******************************/

 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.

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

 html_current_option(?Option) is nondet

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

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

 init_options is det

Initialise the HTML processing options.

  249init_options :-
  250    (   option_default(Name, Value),
  251        (   current_prolog_flag(Name, _)
  252        ->  true
  253        ;   create_prolog_flag(Name, Value, [])
  254        ),
  255        fail
  256    ;   true
  257    ).
  258
  259:- init_options.

 xml_header(-Header)

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

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

 ns(?Which, ?Atom)

Namespace declarations

  271ns(xhtml, 'http://www.w3.org/1999/xhtml').
  272
  273
  274                 /*******************************
  275                 *             PAGE             *
  276                 *******************************/

 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.

  285page(Content) -->
  286    doctype,
  287    html(html(Content)).
  288
  289page(Head, Body) -->
  290    page(default, Head, Body).
  291
  292page(Style, Head, Body) -->
  293    doctype,
  294    content_type,
  295    html_begin(html),
  296    pagehead(Style, Head),
  297    pagebody(Style, Body),
  298    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 ...

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

 html(+Content:dom)// is det

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

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

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

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

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

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

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

Emit element in xhtml mode with empty content.

  599xhtml_empty(Env, Attributes) -->
  600    pre_open(Env),
  601    [<],
  602    [Env],
  603    attributes(Attributes),
  604    ['/>'].

 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.

  629xhtml_ns(Id, Value) -->
  630    { html_current_option(dialect(xhtml)) },
  631    !,
  632    html_post(xmlns, \attribute(xmlns:Id=Value)).
  633xhtml_ns(_, _) -->
  634    [].

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

  647html_root_attribute(Name, Value) -->
  648    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.

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

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

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

  802attribute_value_m([]) -->
  803    [].
  804attribute_value_m([H|T]) -->
  805    attribute_value_s(H),
  806    (   { T == [] }
  807    ->  []
  808    ;   [' '],
  809        attribute_value_m(T)
  810    ).
  811
  812
  813                 /*******************************
  814                 *         QUOTING RULES        *
  815                 *******************************/

 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.

  830html_quoted(Text) -->
  831    { xml_quote_cdata(Text, Quoted, utf8) },
  832    [ 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.

  843html_quoted_attribute(Text) -->
  844    { xml_quote_attribute(Text, Quoted, utf8) },
  845    [ Quoted ].

 cdata_element(?Element)

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

  852cdata_element(script).
  853cdata_element(style).
  854
  855
  856                 /*******************************
  857                 *      REPOSITIONING HTML      *
  858                 *******************************/

 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)
                        ],
                        ...)

  890html_post(Id, Content) -->
  891    { strip_module(Content, M, C) },
  892    [ 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.

  905html_receive(Id) -->
  906    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.

  925html_receive(Id, Handler) -->
  926    { strip_module(Handler, M, P) },
  927    [ mailbox(Id, accept(M:P, _)) ].

 html_noreceive(+Id)// is det

As html_receive//1, but discard posted messages.

  933html_noreceive(Id) -->
  934    [ 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.

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

  979html_token(Token, [H|T]) :-
  980    html_token_(T, H, Token).
  981
  982html_token_(_, Token, Token) :- !.
  983html_token_(_, cdata(_,Tokens), Token) :-
  984    html_token(Token, Tokens).
  985html_token_([H|T], _, Token) :-
  986    html_token_(T, H, Token).

 mailboxes(+Tokens, -MailBoxes) is det

Get all mailboxes from the token set.

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

 1045mail_handlers([], [], []).
 1046mail_handlers([post(Module,HTML)|T0], H, [Module:HTML|T]) :-
 1047    !,
 1048    mail_handlers(T0, H, T).
 1049mail_handlers([H|T0], [H|T], C) :-
 1050    mail_handlers(T0, T, C).
 1051
 1052extend_args(Term, Extra, NewTerm) :-
 1053    Term =.. [Name|Args],
 1054    append(Args, [Extra], NewArgs),
 1055    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?

 1066sorted_html(List) -->
 1067    { sort(List, Unique) },
 1068    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.

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

 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

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

 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)

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

 1296valid_cdata(Env, String) :-
 1297    atomics_to_string(['</', Env, '>'], End),
 1298    sub_atom_icasechk(String, _, End),
 1299    !,
 1300    domain_error(cdata, String).
 1301valid_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)

 1317html_print_length(List, Len) :-
 1318    mailman(List),
 1319    (   html_current_option(dialect(xhtml))
 1320    ->  xml_header(Hdr),
 1321        atom_length(Hdr, L0),
 1322        L1 is L0+1                  % one for newline
 1323    ;   L1 = 0
 1324    ),
 1325    html_print_length(List, L1, Len).
 1326
 1327html_print_length([], L, L).
 1328html_print_length([nl(N)|T], L0, L) :-
 1329    !,
 1330    join_nl(T, N, Lines, T1),
 1331    L1 is L0 + Lines,               % assume only \n!
 1332    html_print_length(T1, L1, L).
 1333html_print_length([mailbox(_, Box)|T], L0, L) :-
 1334    !,
 1335    (   Box = accept(_, Accepted)
 1336    ->  html_print_length(Accepted, L0, L1)
 1337    ;   L1 = L0
 1338    ),
 1339    html_print_length(T, L1, L).
 1340html_print_length([cdata(_, CDATA)|T], L0, L) :-
 1341    !,
 1342    html_print_length(CDATA, L0, L1),
 1343    html_print_length(T, L1, L).
 1344html_print_length([H|T], L0, L) :-
 1345    atom_length(H, Hlen),
 1346    L1 is L0+Hlen,
 1347    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.

See also

- reply_html_partial/1 to avoid adding a DOCTYPE, and required outer HTML elements such as <html>.

 1360reply_html_page(Head, Body) :-
 1361    reply_html_page(default, Head, Body).
 1362reply_html_page(Style, Head, Body) :-
 1363    html_current_option(content_type(Type)),
 1364    phrase(page(Style, Head, Body), HTML),
 1365    forall(html_header_hook(Style), true),
 1366    format('Content-type: ~w~n~n', [Type]),
 1367    print_html(HTML).

 reply_html_partial(+HTML) is det

Reply with partial HTML document. The reply only contains the element from HTML, i.e., this predicate does not add a DOCTYPE header, <html>, <head> or <body>. It is intended for JavaScript handlers that request a partial document and insert that somewhere into the existing page DOM.

See also

- reply_html_page/3 to reply with a complete (valid) HTML page.

Since

- 9.1.20

 1381reply_html_partial(HTML) :-
 1382    html_current_option(content_type(Type)),
 1383    phrase(html(HTML), Tokens),
 1384    format('Content-type: ~w~n~n', [Type]),
 1385    print_html(Tokens).

 html_header_hook(+Style) is nondet

This multifile hook is called just before the Content-type header is emitted. It allows for emitting additional headers depending on the first argument of reply_html_page/3.

 1396                 /*******************************
 1397                 *     META-PREDICATE SUPPORT   *
 1398                 *******************************/

 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,?,?).

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