kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/ext/http/http/html_write.pl

@@ -0,0 +1,1425 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker and Anjo Anjewierden
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2002-2025, University of Amsterdam
+                              VU University Amsterdam
+                              SWI-Prolog Solutions b.v.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(html_write,
+          [ reply_html_page/2,          % :Head, :Body
+            reply_html_page/3,          % +Style, :Head, :Body
+            reply_html_partial/1,       % +HTML
+
+                                        % Basic output routines
+            page//1,                    % :Content
+            page//2,                    % :Head, :Body
+            page//3,                    % +Style, :Head, :Body
+            html//1,                    % :Content
+
+                                        % Option processing
+            html_set_options/1,         % +OptionList
+            html_current_option/1,      % ?Option
+
+                                        % repositioning HTML elements
+            html_post//2,               % +Id, :Content
+            html_receive//1,            % +Id
+            html_receive//2,            % +Id, :Handler
+            xhtml_ns//2,                % +Id, +Value
+            html_root_attribute//2,     % +Name, +Value
+
+            html/4,                     % {|html||quasi quotations|}
+
+                                        % Useful primitives for expanding
+            html_begin//1,              % +EnvName[(Attribute...)]
+            html_end//1,                % +EnvName
+            html_quoted//1,             % +Text
+            html_quoted_attribute//1,   % +Attribute
+
+                                        % Emitting the HTML code
+            print_html/1,               % +List
+            print_html/2,               % +Stream, +List
+            html_print_length/2,        % +List, -Length
+
+                                        % Extension support
+            (html_meta)/1,              % +Spec
+            op(1150, fx, html_meta)
+          ]).
+:- use_module(html_quasiquotations, [html/4]).
+:- use_module(library(debug),[debug/3]).
+:- use_module(html_decl, [(html_meta)/1, html_no_content/1, op(_,_,_)]).
+:- autoload(library(error),
+	    [must_be/2,domain_error/2,instantiation_error/1]).
+:- autoload(library(lists),
+	    [permutation/2,selectchk/3,append/3,select/4,list_to_set/2]).
+:- autoload(library(option),[option/2]).
+:- autoload(library(pairs),[group_pairs_by_key/2]).
+:- autoload(library(sgml),[xml_quote_cdata/3,xml_quote_attribute/3]).
+:- autoload(library(uri),[uri_encoded/3]).
+:- autoload(library(url),[www_form_encode/2]).
+
+% Quote output
+:- set_prolog_flag(generate_debug_info, false).
+
+:- meta_predicate
+    reply_html_page(+, :, :),
+    reply_html_page(:, :),
+    html(:, -, +),
+    page(:, -, +),
+    page(:, :, -, +),
+    pagehead(+, :, -, +),
+    pagebody(+, :, -, +),
+    html_receive(+, 3, -, +),
+    html_post(+, :, -, +).
+
+:- multifile
+    expand//1,                      % +HTMLElement
+    expand_attribute_value//1,      % +HTMLAttributeValue
+    html_header_hook/1.             % +Style
+
+
+/** <module> Write HTML text
+
+Most   code   doesn't   need  to   use  this   directly;  instead   use
+library(http/http_server),  which  combines   this  library  with   the
+typical HTTP libraries that most servers need.
+
+The purpose of this library  is  to   simplify  writing  HTML  pages. Of
+course, it is possible to  use  format/3   to  write  to the HTML stream
+directly, but this is generally not very satisfactory:
+
+        * It is a lot of typing
+        * It does not guarantee proper HTML syntax.  You have to deal
+          with HTML quoting, proper nesting and reasonable layout.
+        * It is hard to use satisfactory abstraction
+
+This module tries to remedy these problems.   The idea is to translate a
+Prolog term into  an  HTML  document.  We   use  DCG  for  most  of  the
+generation.
+
+---++ International documents
+
+The library supports the generation of international documents, but this
+is currently limited to using UTF-8 encoded HTML or XHTML documents.  It
+is strongly recommended to use the following mime-type.
+
+==
+Content-type: text/html; charset=UTF-8
+==
+
+When generating XHTML documents, the output stream must be in UTF-8
+encoding.
+*/
+
+
+                 /*******************************
+                 *            SETTINGS          *
+                 *******************************/
+
+%!  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.
+
+html_set_options(Options) :-
+    must_be(list, Options),
+    set_options(Options).
+
+set_options([]).
+set_options([H|T]) :-
+    html_set_option(H),
+    set_options(T).
+
+html_set_option(dialect(Dialect0)) :-
+    !,
+    must_be(oneof([html,html4,xhtml,html5]), Dialect0),
+    (   html_version_alias(Dialect0, Dialect)
+    ->  true
+    ;   Dialect = Dialect0
+    ),
+    set_prolog_flag(html_dialect, Dialect).
+html_set_option(doctype(Atom)) :-
+    !,
+    must_be(atom, Atom),
+    current_prolog_flag(html_dialect, Dialect),
+    dialect_doctype_flag(Dialect, Flag),
+    set_prolog_flag(Flag, Atom).
+html_set_option(content_type(Atom)) :-
+    !,
+    must_be(atom, Atom),
+    current_prolog_flag(html_dialect, Dialect),
+    dialect_content_type_flag(Dialect, Flag),
+    set_prolog_flag(Flag, Atom).
+html_set_option(O) :-
+    domain_error(html_option, O).
+
+html_version_alias(html, html4).
+
+%!  html_current_option(?Option) is nondet.
+%
+%   True if Option is an active option for the HTML generator.
+
+html_current_option(dialect(Dialect)) :-
+    current_prolog_flag(html_dialect, Dialect).
+html_current_option(doctype(DocType)) :-
+    current_prolog_flag(html_dialect, Dialect),
+    dialect_doctype_flag(Dialect, Flag),
+    current_prolog_flag(Flag, DocType).
+html_current_option(content_type(ContentType)) :-
+    current_prolog_flag(html_dialect, Dialect),
+    dialect_content_type_flag(Dialect, Flag),
+    current_prolog_flag(Flag, ContentType).
+
+dialect_doctype_flag(html4, html4_doctype).
+dialect_doctype_flag(html5, html5_doctype).
+dialect_doctype_flag(xhtml, xhtml_doctype).
+
+dialect_content_type_flag(html4, html4_content_type).
+dialect_content_type_flag(html5, html5_content_type).
+dialect_content_type_flag(xhtml, xhtml_content_type).
+
+option_default(html_dialect, html5).
+option_default(html4_doctype,
+               'HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" \c
+               "http://www.w3.org/TR/html4/loose.dtd"').
+option_default(html5_doctype,
+               'html').
+option_default(xhtml_doctype,
+               'html PUBLIC "-//W3C//DTD XHTML 1.0 \c
+               Transitional//EN" \c
+               "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"').
+option_default(html4_content_type, 'text/html; charset=UTF-8').
+option_default(html5_content_type, 'text/html; charset=UTF-8').
+option_default(xhtml_content_type, 'application/xhtml+xml; charset=UTF-8').
+
+%!  init_options is det.
+%
+%   Initialise the HTML processing options.
+
+init_options :-
+    (   option_default(Name, Value),
+        (   current_prolog_flag(Name, _)
+        ->  true
+        ;   create_prolog_flag(Name, Value, [])
+        ),
+        fail
+    ;   true
+    ).
+
+:- init_options.
+
+%!  xml_header(-Header)
+%
+%   First line of XHTML document.  Added by print_html/1.
+
+xml_header('<?xml version=\'1.0\' encoding=\'UTF-8\'?>').
+
+%!  ns(?Which, ?Atom)
+%
+%   Namespace declarations
+
+ns(xhtml, 'http://www.w3.org/1999/xhtml').
+
+
+                 /*******************************
+                 *             PAGE             *
+                 *******************************/
+
+%!  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.
+
+page(Content) -->
+    doctype,
+    html(html(Content)).
+
+page(Head, Body) -->
+    page(default, Head, Body).
+
+page(Style, Head, Body) -->
+    doctype,
+    content_type,
+    html_begin(html),
+    pagehead(Style, Head),
+    pagebody(Style, Body),
+    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 ...
+
+doctype -->
+    { html_current_option(doctype(DocType)),
+      DocType \== ''
+    },
+    !,
+    [ '<!DOCTYPE ', DocType, '>' ].
+doctype -->
+    [].
+
+content_type -->
+    { html_current_option(content_type(Type))
+    },
+    !,
+    html_post(head, meta([ 'http-equiv'('content-type'),
+                           content(Type)
+                         ], [])).
+content_type -->
+    { html_current_option(dialect(html5)) },
+    !,
+    html_post(head, meta('charset=UTF-8')).
+content_type -->
+    [].
+
+pagehead(_, Head) -->
+    { functor(Head, head, _)
+    },
+    !,
+    html(Head).
+pagehead(Style, Head) -->
+    { strip_module(Head, M, _),
+      hook_module(M, HM, head//2)
+    },
+    HM:head(Style, Head),
+    !.
+pagehead(_, Head) -->
+    { strip_module(Head, M, _),
+      hook_module(M, HM, head//1)
+    },
+    HM:head(Head),
+    !.
+pagehead(_, Head) -->
+    html(head(Head)).
+
+
+pagebody(_, Body) -->
+    { functor(Body, body, _)
+    },
+    !,
+    html(Body).
+pagebody(Style, Body) -->
+    { strip_module(Body, M, _),
+      hook_module(M, HM, body//2)
+    },
+    HM:body(Style, Body),
+    !.
+pagebody(_, Body) -->
+    { strip_module(Body, M, _),
+      hook_module(M, HM, body//1)
+    },
+    HM:body(Body),
+    !.
+pagebody(_, Body) -->
+    html(body(Body)).
+
+
+hook_module(M, M, PI) :-
+    current_predicate(M:PI),
+    !.
+hook_module(_, user, PI) :-
+    current_predicate(user:PI).
+
+%!  html(+Content:dom)// is det
+%
+%   Generate HTML from Content.  Generates a token sequence for
+%   print_html/2.
+
+html(Spec) -->
+    { strip_module(Spec, M, T) },
+    qhtml(T, M).
+
+qhtml(Var, _) -->
+    { var(Var),
+      !,
+      instantiation_error(Var)
+    }.
+qhtml([], _) -->
+    !,
+    [].
+qhtml([H|T], M) -->
+    !,
+    html_expand(H, M),
+    qhtml(T, M).
+qhtml(X, M) -->
+    html_expand(X, M).
+
+html_expand(Var, _) -->
+    { var(Var),
+      !,
+      instantiation_error(Var)
+    }.
+html_expand(Term, Module) -->
+    do_expand(Term, Module),
+    !.
+html_expand(Term, _Module) -->
+    { print_message(error, html(expand_failed(Term))) }.
+
+
+do_expand(Token, _) -->                 % call user hooks
+    expand(Token),
+    !.
+do_expand(Fmt-Args, _) -->
+    !,
+    { format(string(String), Fmt, Args)
+    },
+    html_quoted(String).
+do_expand(\List, Module) -->
+    { is_list(List)
+    },
+    !,
+    raw(List, Module).
+do_expand(\Term, Module, In, Rest) :-
+    !,
+    call(Module:Term, In, Rest).
+do_expand(Module:Term, _) -->
+    !,
+    qhtml(Term, Module).
+do_expand(&(Entity), _) -->
+    !,
+    {   integer(Entity)
+    ->  format(string(String), '&#~d;', [Entity])
+    ;   format(string(String), '&~w;', [Entity])
+    },
+    [ String ].
+do_expand(Token, _) -->
+    { atomic(Token)
+    },
+    !,
+    html_quoted(Token).
+do_expand(element(Env, Attributes, Contents), M) -->
+    !,
+    (   { Contents == [],
+          html_current_option(dialect(xhtml))
+        }
+    ->  xhtml_empty(Env, Attributes)
+    ;   html_begin(Env, Attributes),
+        qhtml(Env, Contents, M),
+        html_end(Env)
+    ).
+do_expand(Term, M) -->
+    { Term =.. [Env, Contents]
+    },
+    !,
+    (   { html_no_content(Env) }
+    ->  html_begin(Env, Contents)
+    ;   (   { Contents == [],
+              html_current_option(dialect(xhtml))
+            }
+        ->  xhtml_empty(Env, [])
+        ;   html_begin(Env),
+            qhtml(Env, Contents, M),
+            html_end(Env)
+        )
+    ).
+do_expand(Term, M) -->
+    { Term =.. [Env, Attributes, Contents],
+      check_non_empty(Contents, Env, Term)
+    },
+    !,
+    (   { Contents == [],
+          html_current_option(dialect(xhtml))
+        }
+    ->  xhtml_empty(Env, Attributes)
+    ;   html_begin(Env, Attributes),
+        qhtml(Env, Contents, M),
+        html_end(Env)
+    ).
+
+qhtml(Env, Contents, M) -->
+    { cdata_element(Env),
+      phrase(cdata(Contents, M), Tokens)
+    },
+    !,
+    [ cdata(Env, Tokens) ].
+qhtml(_, Contents, M) -->
+    qhtml(Contents, M).
+
+
+check_non_empty([], _, _) :- !.
+check_non_empty(_, Tag, Term) :-
+    html_no_content(Tag),
+    !,
+    print_message(warning,
+                  format('Using empty element with content: ~p', [Term])).
+check_non_empty(_, _, _).
+
+cdata(List, M) -->
+    { is_list(List) },
+    !,
+    raw(List, M).
+cdata(One, M) -->
+    raw_element(One, M).
+
+%!  raw(+List, +Module)// is det.
+%
+%   Emit unquoted (raw) output used for scripts, etc.
+
+raw([], _) -->
+    [].
+raw([H|T], Module) -->
+    raw_element(H, Module),
+    raw(T, Module).
+
+raw_element(Var, _) -->
+    { var(Var),
+      !,
+      instantiation_error(Var)
+    }.
+raw_element(\List, Module) -->
+    { is_list(List)
+    },
+    !,
+    raw(List, Module).
+raw_element(\Term, Module, In, Rest) :-
+    !,
+    call(Module:Term, In, Rest).
+raw_element(Module:Term, _) -->
+    !,
+    raw_element(Term, Module).
+raw_element(Fmt-Args, _) -->
+    !,
+    { format(string(S), Fmt, Args) },
+    [S].
+raw_element(Value, _) -->
+    { must_be(atomic, Value) },
+    [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)
+%   ==
+
+html_begin(Env) -->
+    { Env =.. [Name|Attributes]
+    },
+    html_begin(Name, Attributes).
+
+html_begin(Env, Attributes) -->
+    pre_open(Env),
+    [<],
+    [Env],
+    attributes(Env, Attributes),
+    (   { html_no_content(Env),
+          html_current_option(dialect(xhtml))
+        }
+    ->  ['/>']
+    ;   [>]
+    ),
+    post_open(Env).
+
+html_end(Env)   -->                     % empty element or omited close
+    { html_no_content(Env)
+    ; layout(Env, _, -),
+      html_current_option(dialect(html))
+    },
+    !,
+    [].
+html_end(Env)   -->
+    pre_close(Env),
+    ['</'],
+    [Env],
+    ['>'],
+    post_close(Env).
+
+%!  xhtml_empty(+Env, +Attributes)// is det.
+%
+%   Emit element in xhtml mode with empty content.
+
+xhtml_empty(Env, Attributes) -->
+    pre_open(Env),
+    [<],
+    [Env],
+    attributes(Attributes),
+    ['/>'].
+
+%!  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.
+
+xhtml_ns(Id, Value) -->
+    { html_current_option(dialect(xhtml)) },
+    !,
+    html_post(xmlns, \attribute(xmlns:Id=Value)).
+xhtml_ns(_, _) -->
+    [].
+
+%!  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),
+%         ...
+%     ==
+
+html_root_attribute(Name, Value) -->
+    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.
+
+attributes(html, L) -->
+    !,
+    (   { html_current_option(dialect(xhtml)) }
+    ->  (   { option(xmlns(_), L) }
+        ->  attributes(L)
+        ;   { ns(xhtml, NS) },
+            attributes([xmlns(NS)|L])
+        ),
+        html_receive(xmlns)
+    ;   attributes(L),
+        html_noreceive(xmlns)
+    ),
+    html_receive(html_begin).
+attributes(_, L) -->
+    attributes(L).
+
+attributes([]) -->
+    !,
+    [].
+attributes([H|T]) -->
+    !,
+    attribute(H),
+    attributes(T).
+attributes(One) -->
+    attribute(One).
+
+attribute(Name=Value) -->
+    !,
+    [' '], name(Name), [ '="' ],
+    attribute_value(Value),
+    ['"'].
+attribute(NS:Term) -->
+    !,
+    { Term =.. [Name, Value]
+    },
+    !,
+    attribute((NS:Name)=Value).
+attribute(Term) -->
+    { Term =.. [Name, Value]
+    },
+    !,
+    attribute(Name=Value).
+attribute(Atom) -->                     % Value-abbreviated attribute
+    { atom(Atom)
+    },
+    [ ' ', Atom ].
+
+name(NS:Name) -->
+    !,
+    [NS, :, Name].
+name(Name) -->
+    [ 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 html_write: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.
+
+attribute_value(List) -->
+    { is_list(List) },
+    !,
+    attribute_value_m(List).
+attribute_value(Value) -->
+    attribute_value_s(Value).
+
+% emit a single attribute value
+
+attribute_value_s(Var) -->
+    { var(Var),
+      !,
+      instantiation_error(Var)
+    }.
+attribute_value_s(A+B) -->
+    !,
+    attribute_value(A),
+    (   { is_list(B) }
+    ->  (   { B == [] }
+        ->  []
+        ;   [?], search_parameters(B)
+        )
+    ;   attribute_value(B)
+    ).
+attribute_value_s(encode(Value)) -->
+    !,
+    { uri_encoded(query_value, Value, Encoded) },
+    [ Encoded ].
+attribute_value_s(Value) -->
+    expand_attribute_value(Value),
+    !.
+attribute_value_s(Fmt-Args) -->
+    !,
+    { format(string(Value), Fmt, Args) },
+    html_quoted_attribute(Value).
+attribute_value_s(Value) -->
+    html_quoted_attribute(Value).
+
+search_parameters([H|T]) -->
+    search_parameter(H),
+    (   {T == []}
+    ->  []
+    ;   ['&amp;'],
+        search_parameters(T)
+    ).
+
+search_parameter(Var) -->
+    { var(Var),
+      !,
+      instantiation_error(Var)
+    }.
+search_parameter(Name=Value) -->
+    { www_form_encode(Value, Encoded) },
+    [Name, =, Encoded].
+search_parameter(Term) -->
+    { Term =.. [Name, Value],
+      !,
+      www_form_encode(Value, Encoded)
+    },
+    [Name, =, Encoded].
+search_parameter(Term) -->
+    { domain_error(search_parameter, Term)
+    }.
+
+%!  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"> ...|=
+
+attribute_value_m([]) -->
+    [].
+attribute_value_m([H|T]) -->
+    attribute_value_s(H),
+    (   { T == [] }
+    ->  []
+    ;   [' '],
+        attribute_value_m(T)
+    ).
+
+
+                 /*******************************
+                 *         QUOTING RULES        *
+                 *******************************/
+
+%!  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))
+%   ==
+%
+%   @tbd    Assumes UTF-8 encoding of the output.
+
+html_quoted(Text) -->
+    { xml_quote_cdata(Text, Quoted, utf8) },
+    [ 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
+%   automatically.
+%
+%   @tbd    Assumes UTF-8 encoding of the output.
+
+html_quoted_attribute(Text) -->
+    { xml_quote_attribute(Text, Quoted, utf8) },
+    [ Quoted ].
+
+%!  cdata_element(?Element)
+%
+%   True when Element contains declared CDATA   and thus only =|</|=
+%   needs to be escaped.
+
+cdata_element(script).
+cdata_element(style).
+
+
+                 /*******************************
+                 *      REPOSITIONING HTML      *
+                 *******************************/
+
+%!  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)
+%                           ],
+%                           ...)
+%   ==
+
+html_post(Id, Content) -->
+    { strip_module(Content, M, C) },
+    [ 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    The local predicate sorted_html//1 handles the output of
+%           html_receive//1.
+%   @see    html_receive//2 allows for post-processing the posted
+%           material.
+
+html_receive(Id) -->
+    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 channel 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.
+
+html_receive(Id, Handler) -->
+    { strip_module(Handler, M, P) },
+    [ mailbox(Id, accept(M:P, _)) ].
+
+%!  html_noreceive(+Id)// is det.
+%
+%   As html_receive//1, but discard posted messages.
+
+html_noreceive(Id) -->
+    [ 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  permutes  the mailbox resolution order  until it found a
+%   working one. Before that, it puts   =head= and =script= boxes at
+%   the end.
+
+mailman(Tokens) :-
+    (   html_token(mailbox(_, accept(_, Accepted)), Tokens)
+    ->  true
+    ),
+    var(Accepted),                 % not yet executed
+    !,
+    mailboxes(Tokens, Boxes),
+    keysort(Boxes, Keyed),
+    group_pairs_by_key(Keyed, PerKey),
+    move_last(PerKey, script, PerKey1),
+    move_last(PerKey1, head, PerKey2),
+    (   permutation(PerKey2, PerKeyPerm),
+        (   mail_ids(PerKeyPerm)
+        ->  !
+        ;   debug(html(mailman),
+                  'Failed mail delivery order; retrying', []),
+            fail
+        )
+    ->  true
+    ;   print_message(error, html(cyclic_mailboxes))
+    ).
+mailman(_).
+
+move_last(Box0, Id, Box) :-
+    selectchk(Id-List, Box0, Box1),
+    !,
+    append(Box1, [Id-List], Box).
+move_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).
+
+html_token(Token, [H|T]) :-
+    html_token_(T, H, Token).
+
+html_token_(_, Token, Token) :- !.
+html_token_(_, cdata(_,Tokens), Token) :-
+    html_token(Token, Tokens).
+html_token_([H|T], _, Token) :-
+    html_token_(T, H, Token).
+
+%!  mailboxes(+Tokens, -MailBoxes) is det.
+%
+%   Get all mailboxes from the token set.
+
+mailboxes(Tokens, MailBoxes) :-
+    mailboxes(Tokens, MailBoxes, []).
+
+mailboxes([], List, List).
+mailboxes([mailbox(Id, Value)|T0], [Id-Value|T], Tail) :-
+    !,
+    mailboxes(T0, T, Tail).
+mailboxes([cdata(_Type, Tokens)|T0], Boxes, Tail) :-
+    !,
+    mailboxes(Tokens, Boxes, Tail0),
+    mailboxes(T0, Tail0, Tail).
+mailboxes([_|T0], T, Tail) :-
+    mailboxes(T0, T, Tail).
+
+mail_ids([]).
+mail_ids([H|T0]) :-
+    mail_id(H, NewPosts),
+    add_new_posts(NewPosts, T0, T),
+    mail_ids(T).
+
+mail_id(Id-List, NewPosts) :-
+    mail_handlers(List, Boxes, Content),
+    (   Boxes = [accept(MH:Handler, In)]
+    ->  extend_args(Handler, Content, Goal),
+        phrase(MH:Goal, In),
+        mailboxes(In, NewBoxes),
+        keysort(NewBoxes, Keyed),
+        group_pairs_by_key(Keyed, NewPosts)
+    ;   Boxes = [ignore(_, _)|_]
+    ->  NewPosts = []
+    ;   Boxes = [accept(_,_),accept(_,_)|_]
+    ->  print_message(error, html(multiple_receivers(Id))),
+        NewPosts = []
+    ;   print_message(error, html(no_receiver(Id))),
+        NewPosts = []
+    ).
+
+add_new_posts([], T, T).
+add_new_posts([Id-Posts|NewT], T0, T) :-
+    (   select(Id-List0, T0, Id-List, T1)
+    ->  append(List0, Posts, List)
+    ;   debug(html(mailman), 'Stuck with new posts on ~q', [Id]),
+        fail
+    ),
+    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(_,_).
+
+mail_handlers([], [], []).
+mail_handlers([post(Module,HTML)|T0], H, [Module:HTML|T]) :-
+    !,
+    mail_handlers(T0, H, T).
+mail_handlers([H|T0], [H|T], C) :-
+    mail_handlers(T0, T, C).
+
+extend_args(Term, Extra, NewTerm) :-
+    Term =.. [Name|Args],
+    append(Args, [Extra], NewArgs),
+    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?
+
+sorted_html(List) -->
+    { sort(List, Unique) },
+    html(Unique).
+
+%!  head_html(+Content:list)// is det.
+%
+%   Handler for html_receive(head). Unlike  sorted_html//1, it calls
+%   a user hook  html_write:html_head_expansion/2   to  process  the
+%   collected head material into a term suitable for html//1.
+%
+%   @tbd  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.
+
+head_html(List) -->
+    { list_to_set(List, Unique),
+      html_expand_head(Unique, NewList)
+    },
+    html(NewList).
+
+:- multifile
+    html_head_expansion/2.
+
+html_expand_head(List0, List) :-
+    html_head_expansion(List0, List1),
+    List0 \== List1,
+    !,
+    html_expand_head(List1, List).
+html_expand_head(List, List).
+
+
+                 /*******************************
+                 *             LAYOUT           *
+                 *******************************/
+
+pre_open(Env) -->
+    { layout(Env, N-_, _)
+    },
+    !,
+    [ nl(N) ].
+pre_open(_) --> [].
+
+post_open(Env) -->
+    { layout(Env, _-N, _)
+    },
+    !,
+    [ nl(N) ].
+post_open(_) -->
+    [].
+
+pre_close(head) -->
+    !,
+    html_receive(head, head_html),
+    { layout(head, _, N-_) },
+    [ nl(N) ].
+pre_close(Env) -->
+    { layout(Env, _, N-_)
+    },
+    !,
+    [ nl(N) ].
+pre_close(_) -->
+    [].
+
+post_close(Env) -->
+    { layout(Env, _, _-N)
+    },
+    !,
+    [ nl(N) ].
+post_close(_) -->
+    [].
+
+%!  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.
+%
+%   @arg Tag      Name of the tag
+%   @arg Open     Tuple M-N, where M is the number of lines before
+%                 the tag and N after.
+%   @arg Close    Either as Open, or the atom - (minus) to omit the
+%                 close-tag.
+%
+%   @tbd    Complete table
+
+:- multifile
+    layout/3.
+
+layout(table,      2-1, 1-2).
+layout(blockquote, 2-1, 1-2).
+layout(pre,        2-1, 0-2).
+layout(textarea,   1-1, 0-1).
+layout(center,     2-1, 1-2).
+layout(dl,         2-1, 1-2).
+layout(ul,         1-1, 1-1).
+layout(ol,         2-1, 1-2).
+layout(form,       2-1, 1-2).
+layout(frameset,   2-1, 1-2).
+layout(address,    2-1, 1-2).
+
+layout(head,       1-1, 1-1).
+layout(body,       1-1, 1-1).
+layout(script,     1-1, 1-1).
+layout(style,      1-1, 1-1).
+layout(select,     1-1, 1-1).
+layout(map,        1-1, 1-1).
+layout(html,       1-1, 1-1).
+layout(caption,    1-1, 1-1).
+layout(applet,     1-1, 1-1).
+
+layout(tr,         1-0, 0-1).
+layout(option,     1-0, 0-1).
+layout(li,         1-0, 0-1).
+layout(dt,         1-0, -).
+layout(dd,         0-0, -).
+layout(title,      1-0, 0-1).
+
+layout(h1,         2-0, 0-2).
+layout(h2,         2-0, 0-2).
+layout(h3,         2-0, 0-2).
+layout(h4,         2-0, 0-2).
+
+layout(iframe,     1-1, 1-1).
+
+layout(area,       1-0, -).
+layout(base,       1-1, -).
+layout(br,         0-1, -).
+layout(col,        0-0, -).
+layout(embed,      1-1, -).
+layout(hr,         1-1, -).
+layout(img,        0-0, -).
+layout(input,      1-0, -).
+layout(link,       1-1, -).
+layout(meta,       1-1, -).
+layout(param,      1-0, -).
+layout(source,     1-0, -).
+layout(track,	   1-0, -).
+layout(wbr,	   0-0, -).
+
+layout(p,          2-1, -).             % omited close
+layout(td,         0-0, 0-0).
+
+layout(div,        1-0, 0-1).
+
+                 /*******************************
+                 *           PRINTING           *
+                 *******************************/
+
+%!  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)
+
+print_html(List) :-
+    current_output(Out),
+    mailman(List),
+    write_html(List, Out).
+print_html(Out, List) :-
+    (   html_current_option(dialect(xhtml))
+    ->  stream_property(Out, encoding(Enc)),
+        (   Enc == utf8
+        ->  true
+        ;   print_message(warning, html(wrong_encoding(Out, Enc)))
+        ),
+        xml_header(Hdr),
+        write(Out, Hdr), nl(Out)
+    ;   true
+    ),
+    mailman(List),
+    write_html(List, Out),
+    flush_output(Out).
+
+write_html([], _).
+write_html([nl(N)|T], Out) :-
+    !,
+    join_nl(T, N, Lines, T2),
+    write_nl(Lines, Out),
+    write_html(T2, Out).
+write_html([mailbox(_, Box)|T], Out) :-
+    !,
+    (   Box = accept(_, Accepted),
+        nonvar(Accepted)
+    ->  write_html(Accepted, Out)
+    ;   true
+    ),
+    write_html(T, Out).
+write_html([cdata(Env, Tokens)|T], Out) :-
+    !,
+    with_output_to(string(CDATA), write_html(Tokens, current_output)),
+    valid_cdata(Env, CDATA),
+    write(Out, CDATA),
+    write_html(T, Out).
+write_html([H|T], Out) :-
+    write(Out, H),
+    write_html(T, Out).
+
+join_nl([nl(N0)|T0], N1, N, T) :-
+    !,
+    N2 is max(N0, N1),
+    join_nl(T0, N2, N, T).
+join_nl(L, N, N, L).
+
+write_nl(0, _) :- !.
+write_nl(N, Out) :-
+    nl(Out),
+    N1 is N - 1,
+    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>".
+%
+%   @see write_json/2, js_arg//1.
+%   @error domain_error(cdata, String)
+
+valid_cdata(Env, String) :-
+    atomics_to_string(['</', Env, '>'], End),
+    sub_atom_icasechk(String, _, End),
+    !,
+    domain_error(cdata, String).
+valid_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)
+%   ==
+
+html_print_length(List, Len) :-
+    mailman(List),
+    (   html_current_option(dialect(xhtml))
+    ->  xml_header(Hdr),
+        atom_length(Hdr, L0),
+        L1 is L0+1                  % one for newline
+    ;   L1 = 0
+    ),
+    html_print_length(List, L1, Len).
+
+html_print_length([], L, L).
+html_print_length([nl(N)|T], L0, L) :-
+    !,
+    join_nl(T, N, Lines, T1),
+    L1 is L0 + Lines,               % assume only \n!
+    html_print_length(T1, L1, L).
+html_print_length([mailbox(_, Box)|T], L0, L) :-
+    !,
+    (   Box = accept(_, Accepted)
+    ->  html_print_length(Accepted, L0, L1)
+    ;   L1 = L0
+    ),
+    html_print_length(T, L1, L).
+html_print_length([cdata(_, CDATA)|T], L0, L) :-
+    !,
+    html_print_length(CDATA, L0, L1),
+    html_print_length(T, L1, L).
+html_print_length([H|T], L0, L) :-
+    atom_length(H, Hlen),
+    L1 is L0+Hlen,
+    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  reply_html_partial/1  to  avoid  adding   a  ``DOCTYPE``,  and
+%   required outer HTML elements such as ``<html>``.
+
+reply_html_page(Head, Body) :-
+    reply_html_page(default, Head, Body).
+reply_html_page(Style, Head, Body) :-
+    html_current_option(content_type(Type)),
+    phrase(page(Style, Head, Body), HTML),
+    forall(html_header_hook(Style), true),
+    format('Content-type: ~w~n~n', [Type]),
+    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 reply_html_page/3 to reply with a complete (valid) HTML page.
+%   @since 9.1.20
+
+reply_html_partial(HTML) :-
+    html_current_option(content_type(Type)),
+    phrase(html(HTML), Tokens),
+    format('Content-type: ~w~n~n', [Type]),
+    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.
+
+
+:- html_meta
+    html(html,?,?),
+    page(html,?,?),
+    page(html,html,?,?),
+    page(+,html,html,?,?),
+    pagehead(+,html,?,?),
+    pagebody(+,html,?,?),
+    reply_html_page(html,html),
+    reply_html_page(+,html,html),
+    html_post(+,html,?,?).
+
+
+:- multifile
+    prolog:hook/1.
+
+prolog:hook(body(_,_,_)).
+prolog:hook(body(_,_,_,_)).
+prolog:hook(head(_,_,_)).
+prolog:hook(head(_,_,_,_)).
+
+
+                 /*******************************
+                 *            MESSAGES          *
+                 *******************************/
+
+:- multifile
+    prolog:message/3.
+
+prolog:message(html(expand_failed(What))) -->
+    [ 'Failed to translate to HTML: ~p'-[What] ].
+prolog:message(html(wrong_encoding(Stream, Enc))) -->
+    [ 'XHTML demands UTF-8 encoding; encoding of ~p is ~w'-[Stream, Enc] ].
+prolog:message(html(multiple_receivers(Id))) -->
+    [ 'html_post//2: multiple receivers for: ~p'-[Id] ].
+prolog:message(html(no_receiver(Id))) -->
+    [ 'html_post//2: no receivers for: ~p'-[Id] ].