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-2015, 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(library(error)).   75:- use_module(library(apply)).   76:- use_module(library(lists)).   77:- use_module(library(option)).   78:- use_module(library(pairs)).   79:- use_module(library(sgml)).           % Quote output
   80:- use_module(library(uri)).   81:- use_module(library(debug)).   82:- use_module(html_quasiquotations).   83:- use_module(library(http/http_dispatch), [http_location_by_id/2]).   84
   85:- set_prolog_flag(generate_debug_info, false).   86
   87:- meta_predicate
   88    reply_html_page(+, :, :),
   89    reply_html_page(:, :),
   90    html(:, -, +),
   91    page(:, -, +),
   92    page(:, :, -, +),
   93    pagehead(+, :, -, +),
   94    pagebody(+, :, -, +),
   95    html_receive(+, 3, -, +),
   96    html_post(+, :, -, +).   97
   98:- multifile
   99    expand//1,                      % +HTMLElement
  100    expand_attribute_value//1.      % +HTMLAttributeValue

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

  133                 /*******************************
  134                 *            SETTINGS          *
  135                 *******************************/

 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.

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

 html_current_option(?Option) is nondet

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

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

 init_options is det

Initialise the HTML processing options.

  236init_options :-
  237    (   option_default(Name, Value),
  238        (   current_prolog_flag(Name, _)
  239        ->  true
  240        ;   create_prolog_flag(Name, Value, [])
  241        ),
  242        fail
  243    ;   true
  244    ).
  245
  246:- init_options.

 xml_header(-Header)

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

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

 ns(?Which, ?Atom)

Namespace declarations

  258ns(xhtml, 'http://www.w3.org/1999/xhtml').
  259
  260
  261                 /*******************************
  262                 *             PAGE             *
  263                 *******************************/

 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.

  272page(Content) -->
  273    doctype,
  274    html(html(Content)).
  275
  276page(Head, Body) -->
  277    page(default, Head, Body).
  278
  279page(Style, Head, Body) -->
  280    doctype,
  281    content_type,
  282    html_begin(html),
  283    pagehead(Style, Head),
  284    pagebody(Style, Body),
  285    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 ...

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

 html(+Content:dom)// is det

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

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

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

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

  501raw([], _) -->
  502    [].
  503raw([H|T], Module) -->
  504    raw_element(H, Module),
  505    raw(T, Module).
  506
  507raw_element(Var, _) -->
  508    { var(Var),
  509      !,
  510      instantiation_error(Var)
  511    }.
  512raw_element(\List, Module) -->
  513    { is_list(List)
  514    },
  515    !,
  516    raw(List, Module).
  517raw_element(\Term, Module, In, Rest) :-
  518    !,
  519    call(Module:Term, In, Rest).
  520raw_element(Module:Term, _) -->
  521    !,
  522    raw_element(Term, Module).
  523raw_element(Fmt-Args, _) -->
  524    !,
  525    { format(string(S), Fmt, Args) },
  526    [S].
  527raw_element(Value, _) -->
  528    { must_be(atomic, Value) },
  529    [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)

  550html_begin(Env) -->
  551    { Env =.. [Name|Attributes]
  552    },
  553    html_begin(Name, Attributes).
  554
  555html_begin(Env, Attributes) -->
  556    pre_open(Env),
  557    [<],
  558    [Env],
  559    attributes(Env, Attributes),
  560    (   { layout(Env, _, empty),
  561          html_current_option(dialect(xhtml))
  562        }
  563    ->  ['/>']
  564    ;   [>]
  565    ),
  566    post_open(Env).
  567
  568html_end(Env)   -->                     % empty element or omited close
  569    { layout(Env, _, -),
  570      html_current_option(dialect(html))
  571    ; layout(Env, _, empty)
  572    },
  573    !,
  574    [].
  575html_end(Env)   -->
  576    pre_close(Env),
  577    ['</'],
  578    [Env],
  579    ['>'],
  580    post_close(Env).

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

Emit element in xhtml mode with empty content.

  586xhtml_empty(Env, Attributes) -->
  587    pre_open(Env),
  588    [<],
  589    [Env],
  590    attributes(Attributes),
  591    ['/>'].

 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.

  616xhtml_ns(Id, Value) -->
  617    { html_current_option(dialect(xhtml)) },
  618    !,
  619    html_post(xmlns, \attribute(xmlns:Id=Value)).
  620xhtml_ns(_, _) -->
  621    [].

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

  634html_root_attribute(Name, Value) -->
  635    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.

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

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

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

  792attribute_value_m([]) -->
  793    [].
  794attribute_value_m([H|T]) -->
  795    attribute_value_s(H),
  796    (   { T == [] }
  797    ->  []
  798    ;   [' '],
  799        attribute_value_m(T)
  800    ).
  801
  802
  803                 /*******************************
  804                 *         QUOTING RULES        *
  805                 *******************************/

 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.

  820html_quoted(Text) -->
  821    { xml_quote_cdata(Text, Quoted, utf8) },
  822    [ 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.

  833html_quoted_attribute(Text) -->
  834    { xml_quote_attribute(Text, Quoted, utf8) },
  835    [ Quoted ].

 cdata_element(?Element)

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

  842cdata_element(script).
  843cdata_element(style).
  844
  845
  846                 /*******************************
  847                 *      REPOSITIONING HTML      *
  848                 *******************************/

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

  880html_post(Id, Content) -->
  881    { strip_module(Content, M, C) },
  882    [ 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.

  895html_receive(Id) -->
  896    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.

  915html_receive(Id, Handler) -->
  916    { strip_module(Handler, M, P) },
  917    [ mailbox(Id, accept(M:P, _)) ].

 html_noreceive(+Id)// is det

As html_receive//1, but discard posted messages.

  923html_noreceive(Id) -->
  924    [ 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.

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

  969html_token(Token, [H|T]) :-
  970    html_token_(T, H, Token).
  971
  972html_token_(_, Token, Token) :- !.
  973html_token_(_, cdata(_,Tokens), Token) :-
  974    html_token(Token, Tokens).
  975html_token_([H|T], _, Token) :-
  976    html_token_(T, H, Token).

 mailboxes(+Tokens, -MailBoxes) is det

Get all mailboxes from the token set.

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

 1035mail_handlers([], [], []).
 1036mail_handlers([post(Module,HTML)|T0], H, [Module:HTML|T]) :-
 1037    !,
 1038    mail_handlers(T0, H, T).
 1039mail_handlers([H|T0], [H|T], C) :-
 1040    mail_handlers(T0, T, C).
 1041
 1042extend_args(Term, Extra, NewTerm) :-
 1043    Term =.. [Name|Args],
 1044    append(Args, [Extra], NewArgs),
 1045    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?

 1056sorted_html(List) -->
 1057    { sort(List, Unique) },
 1058    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.

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

 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

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

 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)

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

 1283valid_cdata(Env, String) :-
 1284    atomics_to_string(['</', Env, '>'], End),
 1285    sub_atom_icasechk(String, _, End),
 1286    !,
 1287    domain_error(cdata, String).
 1288valid_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)

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

 1344reply_html_page(Head, Body) :-
 1345    reply_html_page(default, Head, Body).
 1346reply_html_page(Style, Head, Body) :-
 1347    html_current_option(content_type(Type)),
 1348    phrase(page(Style, Head, Body), HTML),
 1349    format('Content-type: ~w~n~n', [Type]),
 1350    print_html(HTML).
 1351
 1352
 1353                 /*******************************
 1354                 *     META-PREDICATE SUPPORT   *
 1355                 *******************************/

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

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