1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2014-2019, VU University Amsterdam
    7                              CWI, 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(pengines_io,
   37          [ pengine_writeln/1,          % +Term
   38            pengine_nl/0,
   39            pengine_tab/1,
   40            pengine_flush_output/0,
   41            pengine_format/1,           % +Format
   42            pengine_format/2,           % +Format, +Args
   43
   44            pengine_write_term/2,       % +Term, +Options
   45            pengine_write/1,            % +Term
   46            pengine_writeq/1,           % +Term
   47            pengine_display/1,          % +Term
   48            pengine_print/1,            % +Term
   49            pengine_write_canonical/1,  % +Term
   50
   51            pengine_listing/0,
   52            pengine_listing/1,          % +Spec
   53            pengine_portray_clause/1,   % +Term
   54
   55            pengine_read/1,             % -Term
   56            pengine_read_line_to_string/2, % +Stream, -LineAsString
   57            pengine_read_line_to_codes/2, % +Stream, -LineAsCodes
   58
   59            pengine_io_predicate/1,     % ?Head
   60            pengine_bind_io_to_html/1,  % +Module
   61            pengine_io_goal_expansion/2,% +Goal, -Expanded
   62
   63            message_lines_to_html/3     % +Lines, +Classes, -HTML
   64          ]).   65:- autoload(library(apply),[foldl/4,maplist/3,maplist/4]).   66:- autoload(library(backcomp),[thread_at_exit/1]).   67:- autoload(library(debug),[assertion/1]).   68:- autoload(library(error),[must_be/2]).   69:- autoload(library(listing),[listing/1,portray_clause/1]).   70:- autoload(library(lists),[append/2,append/3,subtract/3]).   71:- autoload(library(option),[option/3,merge_options/3]).   72:- autoload(library(pengines),
   73	    [ pengine_self/1,
   74	      pengine_output/1,
   75	      pengine_input/2,
   76	      pengine_property/2
   77	    ]).   78:- autoload(library(prolog_stream),[open_prolog_stream/4]).   79:- autoload(library(readutil),[read_line_to_string/2]).   80:- autoload(library(yall),[(>>)/4]).   81:- autoload(library(http/term_html),[term/4]).   82
   83:- use_module(library(http/html_write),[html/3,print_html/1, op(_,_,_)]).   84:- use_module(library(settings),[setting/4,setting/2]).   85
   86:- use_module(library(sandbox), []).   87:- autoload(library(thread), [call_in_thread/2]).   88
   89:- html_meta send_html(html).
   90:- public send_html/1.   91
   92:- meta_predicate
   93    pengine_format(+,:).   94
   95/** <module> Provide Prolog I/O for HTML clients
   96
   97This module redefines some of  the   standard  Prolog  I/O predicates to
   98behave transparently for HTML clients. It  provides two ways to redefine
   99the standard predicates: using goal_expansion/2   and  by redefining the
  100system predicates using redefine_system_predicate/1. The   latter is the
  101preferred route because it gives a more   predictable  trace to the user
  102and works regardless of the use of other expansion and meta-calling.
  103
  104*Redefining* works by redefining the system predicates in the context of
  105the pengine's module. This  is  configured   using  the  following  code
  106snippet.
  107
  108  ==
  109  :- pengine_application(myapp).
  110  :- use_module(myapp:library(pengines_io)).
  111  pengines:prepare_module(Module, myapp, _Options) :-
  112        pengines_io:pengine_bind_io_to_html(Module).
  113  ==
  114
  115*Using goal_expansion/2* works by  rewriting   the  corresponding  goals
  116using goal_expansion/2 and use the new   definition  to re-route I/O via
  117pengine_input/2 and pengine_output/1. A pengine  application is prepared
  118for using this module with the following code:
  119
  120  ==
  121  :- pengine_application(myapp).
  122  :- use_module(myapp:library(pengines_io)).
  123  myapp:goal_expansion(In,Out) :-
  124        pengine_io_goal_expansion(In, Out).
  125  ==
  126*/
  127
  128:- setting(write_options, list(any), [max_depth(1000)],
  129           'Additional options for stringifying Prolog results').  130
  131
  132                 /*******************************
  133                 *            OUTPUT            *
  134                 *******************************/
  135
  136%!  pengine_writeln(+Term)
  137%
  138%   Emit Term as <span class=writeln>Term<br></span>.
  139
  140pengine_writeln(Term) :-
  141    pengine_output,
  142    !,
  143    pengine_module(Module),
  144    send_html(span(class(writeln),
  145                   [ \term(Term,
  146                           [ module(Module)
  147                           ]),
  148                     br([])
  149                   ])).
  150pengine_writeln(Term) :-
  151    writeln(Term).
  152
  153%!  pengine_nl
  154%
  155%   Emit a <br/> to the pengine.
  156
  157pengine_nl :-
  158    pengine_output,
  159    !,
  160    send_html(br([])).
  161pengine_nl :-
  162    nl.
  163
  164%!  pengine_tab(+N)
  165%
  166%   Emit N spaces
  167
  168pengine_tab(N) :-
  169    pengine_output,
  170    !,
  171    length(List, N),
  172    maplist(=(&(nbsp)), List),
  173    send_html(List).
  174pengine_tab(N) :-
  175    tab(N).
  176
  177
  178%!  pengine_flush_output
  179%
  180%   No-op.  Pengines do not use output buffering (maybe they should
  181%   though).
  182
  183pengine_flush_output :-
  184    pengine_output,
  185    !.
  186pengine_flush_output :-
  187    flush_output.
  188
  189%!  pengine_write_term(+Term, +Options)
  190%
  191%   Writes term as <span class=Class>Term</span>. In addition to the
  192%   options of write_term/2, these options are processed:
  193%
  194%     - class(+Class)
  195%       Specifies the class of the element.  Default is =write=.
  196
  197pengine_write_term(Term, Options) :-
  198    pengine_output,
  199    !,
  200    option(class(Class), Options, write),
  201    pengine_module(Module),
  202    send_html(span(class(Class), \term(Term,[module(Module)|Options]))).
  203pengine_write_term(Term, Options) :-
  204    write_term(Term, Options).
  205
  206%!  pengine_write(+Term) is det.
  207%!  pengine_writeq(+Term) is det.
  208%!  pengine_display(+Term) is det.
  209%!  pengine_print(+Term) is det.
  210%!  pengine_write_canonical(+Term) is det.
  211%
  212%   Redirect the corresponding Prolog output predicates.
  213
  214pengine_write(Term) :-
  215    pengine_write_term(Term, [numbervars(true)]).
  216pengine_writeq(Term) :-
  217    pengine_write_term(Term, [quoted(true), numbervars(true)]).
  218pengine_display(Term) :-
  219    pengine_write_term(Term, [quoted(true), ignore_ops(true)]).
  220pengine_print(Term) :-
  221    current_prolog_flag(print_write_options, Options),
  222    pengine_write_term(Term, Options).
  223pengine_write_canonical(Term) :-
  224    pengine_output,
  225    !,
  226    with_output_to(string(String), write_canonical(Term)),
  227    send_html(span(class([write, cononical]), String)).
  228pengine_write_canonical(Term) :-
  229    write_canonical(Term).
  230
  231%!  pengine_format(+Format) is det.
  232%!  pengine_format(+Format, +Args) is det.
  233%
  234%   As format/1,2. Emits a series  of   strings  with <br/> for each
  235%   newline encountered in the string.
  236%
  237%   @tbd: handle ~w, ~q, etc using term//2.  How can we do that??
  238
  239pengine_format(Format) :-
  240    pengine_format(Format, []).
  241pengine_format(Format, Args) :-
  242    pengine_output,
  243    !,
  244    format(string(String), Format, Args),
  245    split_string(String, "\n", "", Lines),
  246    send_html(\lines(Lines, format)).
  247pengine_format(Format, Args) :-
  248    format(Format, Args).
  249
  250
  251                 /*******************************
  252                 *            LISTING           *
  253                 *******************************/
  254
  255%!  pengine_listing is det.
  256%!  pengine_listing(+Spec) is det.
  257%
  258%   List the content of the current pengine or a specified predicate
  259%   in the pengine.
  260
  261pengine_listing :-
  262    pengine_listing(_).
  263
  264pengine_listing(Spec) :-
  265    pengine_self(Module),
  266    with_output_to(string(String), listing(Module:Spec)),
  267    split_string(String, "", "\n", [Pre]),
  268    send_html(pre(class(listing), Pre)).
  269
  270pengine_portray_clause(Term) :-
  271    pengine_output,
  272    !,
  273    with_output_to(string(String), portray_clause(Term)),
  274    split_string(String, "", "\n", [Pre]),
  275    send_html(pre(class(listing), Pre)).
  276pengine_portray_clause(Term) :-
  277    portray_clause(Term).
  278
  279
  280                 /*******************************
  281                 *         PRINT MESSAGE        *
  282                 *******************************/
  283
  284:- multifile user:message_hook/3.  285
  286%!  user:message_hook(+Term, +Kind, +Lines) is semidet.
  287%
  288%   Send output from print_message/2 to   the  pengine. Messages are
  289%   embedded in a <pre class=msg-Kind></pre> environment.
  290
  291user:message_hook(Term, Kind, Lines) :-
  292    Kind \== silent,
  293    pengine_self(_),
  294    atom_concat('msg-', Kind, Class),
  295    message_lines_to_html(Lines, [Class], HTMlString),
  296    (   source_location(File, Line)
  297    ->  Src = File:Line
  298    ;   Src = (-)
  299    ),
  300    pengine_output(message(Term, Kind, HTMlString, Src)).
  301
  302%!  message_lines_to_html(+MessageLines, +Classes, -HTMLString) is det.
  303%
  304%   Helper that translates the `Lines` argument from user:message_hook/3
  305%   into an HTML string. The  HTML  is   a  <pre>  object with the class
  306%   `'prolog-message'` and the given Classes.
  307
  308message_lines_to_html(Lines, Classes, HTMlString) :-
  309    phrase(html(pre(class(['prolog-message'|Classes]),
  310                    \message_lines(Lines))), Tokens),
  311    with_output_to(string(HTMlString), print_html(Tokens)).
  312
  313message_lines([]) -->
  314    !.
  315message_lines([nl|T]) -->
  316    !,
  317    html('\n'),                     % we are in a <pre> environment
  318    message_lines(T).
  319message_lines([flush]) -->
  320    !.
  321message_lines([ansi(Attributes, Fmt, Args)|T]) -->
  322    !,
  323    {  is_list(Attributes)
  324    -> foldl(style, Attributes, Fmt-Args, HTML)
  325    ;  style(Attributes, Fmt-Args, HTML)
  326    },
  327    html(HTML),
  328    message_lines(T).
  329message_lines([H|T]) -->
  330    html(H),
  331    message_lines(T).
  332
  333style(bold, Content, b(Content)) :- !.
  334style(fg(default), Content, span(style('color: black'), Content)) :- !.
  335style(fg(Color), Content, span(style('color:'+Color), Content)) :- !.
  336style(_, Content, Content).
  337
  338
  339                 /*******************************
  340                 *             INPUT            *
  341                 *******************************/
  342
  343pengine_read(Term) :-
  344    pengine_input,
  345    !,
  346    prompt(Prompt, Prompt),
  347    pengine_input(Prompt, Term).
  348pengine_read(Term) :-
  349    read(Term).
  350
  351pengine_read_line_to_string(From, String) :-
  352    pengine_input,
  353    !,
  354    must_be(oneof([current_input,user_input]), From),
  355    (   prompt(Prompt, Prompt),
  356        Prompt \== ''
  357    ->  true
  358    ;   Prompt = 'line> '
  359    ),
  360    pengine_input(_{type: console, prompt:Prompt}, StringNL),
  361    string_concat(String, "\n", StringNL).
  362pengine_read_line_to_string(From, String) :-
  363    read_line_to_string(From, String).
  364
  365pengine_read_line_to_codes(From, Codes) :-
  366    pengine_read_line_to_string(From, String),
  367    string_codes(String, Codes).
  368
  369
  370                 /*******************************
  371                 *             HTML             *
  372                 *******************************/
  373
  374lines([], _) --> [].
  375lines([H|T], Class) -->
  376    html(span(class(Class), H)),
  377    (   { T == [] }
  378    ->  []
  379    ;   html(br([])),
  380        lines(T, Class)
  381    ).
  382
  383%!  send_html(+HTML) is det.
  384%
  385%   Convert html//1 term into a string and send it to the client
  386%   using pengine_output/1.
  387
  388send_html(HTML) :-
  389    phrase(html(HTML), Tokens),
  390    with_output_to(string(HTMlString), print_html(Tokens)),
  391    pengine_output(HTMlString).
  392
  393
  394%!  pengine_module(-Module) is det.
  395%
  396%   Module (used for resolving operators).
  397
  398pengine_module(Module) :-
  399    pengine_self(Pengine),
  400    !,
  401    pengine_property(Pengine, module(Module)).
  402pengine_module(user).
  403
  404                 /*******************************
  405                 *        OUTPUT FORMAT         *
  406                 *******************************/
  407
  408%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames) is semidet.
  409%
  410%   Provide additional translations for  Prolog   terms  to  output.
  411%   Defines formats are:
  412%
  413%     * 'json-s'
  414%     _Simple_ or _string_ format: Prolog terms are sent using
  415%     quoted write.
  416%     * 'json-html'
  417%     Serialize responses as HTML string.  This is intended for
  418%     applications that emulate the Prolog toplevel.  This format
  419%     carries the following data:
  420%
  421%       - data
  422%         List if answers, where each answer is an object with
  423%         - variables
  424%           Array of objects, each describing a variable.  These
  425%           objects contain these fields:
  426%           - variables: Array of strings holding variable names
  427%           - value: HTML-ified value of the variables
  428%           - substitutions: Array of objects for substitutions
  429%             that break cycles holding:
  430%             - var: Name of the inserted variable
  431%             - value: HTML-ified value
  432%         - residuals
  433%           Array of strings representing HTML-ified residual goals.
  434
  435:- multifile
  436    pengines:event_to_json/3.  437
  438%!  pengines:event_to_json(+PrologEvent, -JSONEvent, +Format, +VarNames)
  439%
  440%   If Format equals `'json-s'` or  `'json-html'`, emit a simplified
  441%   JSON representation of the  data,   suitable  for notably SWISH.
  442%   This deals with Prolog answers and output messages. If a message
  443%   originates from print_message/3,  it   gets  several  additional
  444%   properties:
  445%
  446%     - message:Kind
  447%       Indicate the _kind_ of the message (=error=, =warning=,
  448%       etc.)
  449%     - location:_{file:File, line:Line, ch:CharPos}
  450%       If the message is related to a source location, indicate the
  451%       file and line and, if available, the character location.
  452
  453pengines:event_to_json(success(ID, Answers0, Projection, Time, More), JSON,
  454                       'json-s') :-
  455    !,
  456    JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
  457    maplist(answer_to_json_strings(ID), Answers0, Answers),
  458    add_projection(Projection, JSON0, JSON).
  459pengines:event_to_json(output(ID, Term), JSON, 'json-s') :-
  460    !,
  461    map_output(ID, Term, JSON).
  462
  463add_projection([], JSON, JSON) :- !.
  464add_projection(VarNames, JSON0, JSON0.put(projection, VarNames)).
  465
  466
  467%!  answer_to_json_strings(+Pengine, +AnswerDictIn, -AnswerDict).
  468%
  469%   Translate answer dict with Prolog term   values into answer dict
  470%   with string values.
  471
  472answer_to_json_strings(Pengine, DictIn, DictOut) :-
  473    dict_pairs(DictIn, Tag, Pairs),
  474    maplist(term_string_value(Pengine), Pairs, BindingsOut),
  475    dict_pairs(DictOut, Tag, BindingsOut).
  476
  477term_string_value(Pengine, N-V, N-A) :-
  478    with_output_to(string(A),
  479                   write_term(V,
  480                              [ module(Pengine),
  481                                quoted(true)
  482                              ])).
  483
  484%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames)
  485%
  486%   Implement translation of a Pengine event to =json-html= format. This
  487%   format represents the answer as JSON,  but the variable bindings are
  488%   (structured) HTML strings rather than JSON objects.
  489%
  490%   CHR residual goals are not  bound   to  the projection variables. We
  491%   hacked a bypass to fetch these by returning them in a variable named
  492%   `_residuals`, which must be bound to a term '$residuals'(List). Such
  493%   a variable is removed from  the   projection  and  added to residual
  494%   goals.
  495
  496pengines:event_to_json(success(ID, Answers0, Projection, Time, More),
  497                       JSON, 'json-html') :-
  498    !,
  499    JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
  500    maplist(map_answer(ID), Answers0, ResVars, Answers),
  501    add_projection(Projection, ResVars, JSON0, JSON).
  502pengines:event_to_json(output(ID, Term), JSON, 'json-html') :-
  503    !,
  504    map_output(ID, Term, JSON).
  505
  506map_answer(ID, Bindings0, ResVars, Answer) :-
  507    dict_bindings(Bindings0, Bindings1),
  508    select_residuals(Bindings1, Bindings2, ResVars, Residuals0, Clauses),
  509    append(Residuals0, Residuals1),
  510    prolog:translate_bindings(Bindings2, Bindings3, [], Residuals1,
  511                              ID:Residuals-_HiddenResiduals),
  512    maplist(binding_to_html(ID), Bindings3, VarBindings),
  513    final_answer(ID, VarBindings, Residuals, Clauses, Answer).
  514
  515final_answer(_Id, VarBindings, [], [], Answer) :-
  516    !,
  517    Answer = json{variables:VarBindings}.
  518final_answer(ID, VarBindings, Residuals, [], Answer) :-
  519    !,
  520    residuals_html(Residuals, ID, ResHTML),
  521    Answer = json{variables:VarBindings, residuals:ResHTML}.
  522final_answer(ID, VarBindings, [], Clauses, Answer) :-
  523    !,
  524    clauses_html(Clauses, ID, ClausesHTML),
  525    Answer = json{variables:VarBindings, wfs_residual_program:ClausesHTML}.
  526final_answer(ID, VarBindings, Residuals, Clauses, Answer) :-
  527    !,
  528    residuals_html(Residuals, ID, ResHTML),
  529    clauses_html(Clauses, ID, ClausesHTML),
  530    Answer = json{variables:VarBindings,
  531                  residuals:ResHTML,
  532                  wfs_residual_program:ClausesHTML}.
  533
  534residuals_html([], _, []).
  535residuals_html([H0|T0], Module, [H|T]) :-
  536    term_html_string(H0, [], Module, H, [priority(999)]),
  537    residuals_html(T0, Module, T).
  538
  539clauses_html(Clauses, _ID, HTMLString) :-
  540    with_output_to(string(Program), list_clauses(Clauses)),
  541    phrase(html(pre([class('wfs-residual-program')], Program)), Tokens),
  542    with_output_to(string(HTMLString), print_html(Tokens)).
  543
  544list_clauses([]).
  545list_clauses([H|T]) :-
  546    (   system_undefined(H)
  547    ->  true
  548    ;   portray_clause(H)
  549    ),
  550    list_clauses(T).
  551
  552system_undefined((undefined :- tnot(undefined))).
  553system_undefined((answer_count_restraint :- tnot(answer_count_restraint))).
  554system_undefined((radial_restraint :- tnot(radial_restraint))).
  555
  556dict_bindings(Dict, Bindings) :-
  557    dict_pairs(Dict, _Tag, Pairs),
  558    maplist([N-V,N=V]>>true, Pairs, Bindings).
  559
  560select_residuals([], [], [], [], []).
  561select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
  562    binding_residual(H, Var, Residual),
  563    !,
  564    Vars = [Var|TV],
  565    Residuals = [Residual|TR],
  566    select_residuals(T, Bindings, TV, TR, Clauses).
  567select_residuals([H|T], Bindings, Vars, Residuals, Clauses) :-
  568    binding_residual_clauses(H, Var, Delays, Clauses0),
  569    !,
  570    Vars = [Var|TV],
  571    Residuals = [Delays|TR],
  572    append(Clauses0, CT, Clauses),
  573    select_residuals(T, Bindings, TV, TR, CT).
  574select_residuals([H|T0], [H|T], Vars, Residuals, Clauses) :-
  575    select_residuals(T0, T, Vars, Residuals, Clauses).
  576
  577binding_residual('_residuals' = '$residuals'(Residuals), '_residuals', Residuals) :-
  578    is_list(Residuals).
  579binding_residual('Residuals' = '$residuals'(Residuals), 'Residuals', Residuals) :-
  580    is_list(Residuals).
  581binding_residual('Residual'  = '$residual'(Residual),   'Residual', [Residual]) :-
  582    callable(Residual).
  583
  584binding_residual_clauses(
  585    '_wfs_residual_program' = '$wfs_residual_program'(Delays, Clauses),
  586    '_wfs_residual_program', Residuals, Clauses) :-
  587    phrase(delay_list(Delays), Residuals).
  588
  589delay_list(true) --> !.
  590delay_list((A,B)) --> !, delay_list(A), delay_list(B).
  591delay_list(M:A) --> !, [M:'$wfs_undefined'(A)].
  592delay_list(A) --> ['$wfs_undefined'(A)].
  593
  594add_projection(-, _, JSON, JSON) :- !.
  595add_projection(VarNames0, ResVars0, JSON0, JSON) :-
  596    append(ResVars0, ResVars1),
  597    sort(ResVars1, ResVars),
  598    subtract(VarNames0, ResVars, VarNames),
  599    add_projection(VarNames, JSON0, JSON).
  600
  601
  602%!  binding_to_html(+Pengine, +Binding, -Dict) is det.
  603%
  604%   Convert a variable binding into a JSON Dict. Note that this code
  605%   assumes that the module associated  with   Pengine  has the same
  606%   name as the Pengine.  The module is needed to
  607%
  608%   @arg Binding is a term binding(Vars,Term,Substitutions)
  609
  610binding_to_html(ID, binding(Vars,Term,Substitutions), JSON) :-
  611    JSON0 = json{variables:Vars, value:HTMLString},
  612    binding_write_options(ID, Options),
  613    term_html_string(Term, Vars, ID, HTMLString, Options),
  614    (   Substitutions == []
  615    ->  JSON = JSON0
  616    ;   maplist(subst_to_html(ID), Substitutions, HTMLSubst),
  617        JSON = JSON0.put(substitutions, HTMLSubst)
  618    ).
  619
  620binding_write_options(Pengine, Options) :-
  621    (   current_predicate(Pengine:screen_property/1),
  622        Pengine:screen_property(tabled(true))
  623    ->  Options = []
  624    ;   Options = [priority(699)]
  625    ).
  626
  627%!  term_html_string(+Term, +VarNames, +Module, -HTMLString,
  628%!                   +Options) is det.
  629%
  630%   Translate  Term  into  an  HTML    string   using  the  operator
  631%   declarations from Module. VarNames is a   list of variable names
  632%   that have this value.
  633
  634term_html_string(Term, Vars, Module, HTMLString, Options) :-
  635    setting(write_options, WOptions),
  636    merge_options(WOptions,
  637                  [ quoted(true),
  638                    numbervars(true),
  639                    module(Module)
  640                  | Options
  641                  ], WriteOptions),
  642    phrase(term_html(Term, Vars, WriteOptions), Tokens),
  643    with_output_to(string(HTMLString), print_html(Tokens)).
  644
  645%!  binding_term(+Term, +Vars, +WriteOptions)// is semidet.
  646%
  647%   Hook to render a Prolog result term as HTML. This hook is called
  648%   for each non-variable binding,  passing   the  binding  value as
  649%   Term, the names of the variables as   Vars and a list of options
  650%   for write_term/3.  If the hook fails, term//2 is called.
  651%
  652%   @arg    Vars is a list of variable names or `[]` if Term is a
  653%           _residual goal_.
  654
  655:- multifile binding_term//3.  656
  657term_html(Term, Vars, WriteOptions) -->
  658    { nonvar(Term) },
  659    binding_term(Term, Vars, WriteOptions),
  660    !.
  661term_html(Undef, _Vars, WriteOptions) -->
  662    { nonvar(Undef),
  663      Undef = '$wfs_undefined'(Term),
  664      !
  665    },
  666    html(span(class(wfs_undefined), \term(Term, WriteOptions))).
  667term_html(Term, _Vars, WriteOptions) -->
  668    term(Term, WriteOptions).
  669
  670%!  subst_to_html(+Module, +Binding, -JSON) is det.
  671%
  672%   Render   a   variable   substitution     resulting   from   term
  673%   factorization, in this case breaking a cycle.
  674
  675subst_to_html(ID, '$VAR'(Name)=Value, json{var:Name, value:HTMLString}) :-
  676    !,
  677    binding_write_options(ID, Options),
  678    term_html_string(Value, [Name], ID, HTMLString, Options).
  679subst_to_html(_, Term, _) :-
  680    assertion(Term = '$VAR'(_)).
  681
  682
  683%!  map_output(+ID, +Term, -JSON) is det.
  684%
  685%   Map an output term. This is the same for json-s and json-html.
  686
  687map_output(ID, message(Term, Kind, HTMLString, Src), JSON) :-
  688    atomic(HTMLString),
  689    !,
  690    JSON0 = json{event:output, id:ID, message:Kind, data:HTMLString},
  691    pengines:add_error_details(Term, JSON0, JSON1),
  692    (   Src = File:Line,
  693        \+ JSON1.get(location) = _
  694    ->  JSON = JSON1.put(_{location:_{file:File, line:Line}})
  695    ;   JSON = JSON1
  696    ).
  697map_output(ID, Term, json{event:output, id:ID, data:Data}) :-
  698    (   atomic(Term)
  699    ->  Data = Term
  700    ;   is_dict(Term, json),
  701        ground(json)                % TBD: Check proper JSON object?
  702    ->  Data = Term
  703    ;   term_string(Term, Data)
  704    ).
  705
  706
  707%!  prolog_help:show_html_hook(+HTML)
  708%
  709%   Hook into help/1 to render the help output in the SWISH console.
  710
  711:- multifile
  712    prolog_help:show_html_hook/1.  713
  714prolog_help:show_html_hook(HTML) :-
  715    pengine_output,
  716    pengine_output(HTML).
  717
  718
  719                 /*******************************
  720                 *          SANDBOXING          *
  721                 *******************************/
  722
  723:- multifile
  724    sandbox:safe_primitive/1,       % Goal
  725    sandbox:safe_meta/2.            % Goal, Called
  726
  727sandbox:safe_primitive(pengines_io:pengine_listing(_)).
  728sandbox:safe_primitive(pengines_io:pengine_nl).
  729sandbox:safe_primitive(pengines_io:pengine_tab(_)).
  730sandbox:safe_primitive(pengines_io:pengine_flush_output).
  731sandbox:safe_primitive(pengines_io:pengine_print(_)).
  732sandbox:safe_primitive(pengines_io:pengine_write(_)).
  733sandbox:safe_primitive(pengines_io:pengine_read(_)).
  734sandbox:safe_primitive(pengines_io:pengine_read_line_to_string(_,_)).
  735sandbox:safe_primitive(pengines_io:pengine_read_line_to_codes(_,_)).
  736sandbox:safe_primitive(pengines_io:pengine_write_canonical(_)).
  737sandbox:safe_primitive(pengines_io:pengine_write_term(_,_)).
  738sandbox:safe_primitive(pengines_io:pengine_writeln(_)).
  739sandbox:safe_primitive(pengines_io:pengine_writeq(_)).
  740sandbox:safe_primitive(pengines_io:pengine_portray_clause(_)).
  741sandbox:safe_primitive(system:write_term(_,_)).
  742sandbox:safe_primitive(system:prompt(_,_)).
  743sandbox:safe_primitive(system:statistics(_,_)).
  744
  745sandbox:safe_meta(pengines_io:pengine_format(Format, Args), Calls) :-
  746    sandbox:format_calls(Format, Args, Calls).
  747
  748
  749                 /*******************************
  750                 *         REDEFINITION         *
  751                 *******************************/
  752
  753%!  pengine_io_predicate(?Head)
  754%
  755%   True when Head describes the  head   of  a (system) IO predicate
  756%   that is redefined by the HTML binding.
  757
  758pengine_io_predicate(writeln(_)).
  759pengine_io_predicate(nl).
  760pengine_io_predicate(tab(_)).
  761pengine_io_predicate(flush_output).
  762pengine_io_predicate(format(_)).
  763pengine_io_predicate(format(_,_)).
  764pengine_io_predicate(read(_)).
  765pengine_io_predicate(read_line_to_string(_,_)).
  766pengine_io_predicate(read_line_to_codes(_,_)).
  767pengine_io_predicate(write_term(_,_)).
  768pengine_io_predicate(write(_)).
  769pengine_io_predicate(writeq(_)).
  770pengine_io_predicate(display(_)).
  771pengine_io_predicate(print(_)).
  772pengine_io_predicate(write_canonical(_)).
  773pengine_io_predicate(listing).
  774pengine_io_predicate(listing(_)).
  775pengine_io_predicate(portray_clause(_)).
  776
  777term_expansion(pengine_io_goal_expansion(_,_),
  778               Clauses) :-
  779    findall(Clause, io_mapping(Clause), Clauses).
  780
  781io_mapping(pengine_io_goal_expansion(Head, Mapped)) :-
  782    pengine_io_predicate(Head),
  783    Head =.. [Name|Args],
  784    atom_concat(pengine_, Name, BodyName),
  785    Mapped =.. [BodyName|Args].
  786
  787pengine_io_goal_expansion(_, _).
  788
  789
  790                 /*******************************
  791                 *      REBIND PENGINE I/O      *
  792                 *******************************/
  793
  794:- public
  795    stream_write/2,
  796    stream_read/2,
  797    stream_close/1.  798
  799:- thread_local
  800    pengine_io/2.  801
  802stream_write(Stream, Out) :-
  803    (   pengine_io(_,_)
  804    ->  send_html(pre(class(console), Out))
  805    ;   current_prolog_flag(pengine_main_thread, TID),
  806        thread_signal(TID, stream_write(Stream, Out))
  807    ).
  808stream_read(Stream, Data) :-
  809    (   pengine_io(_,_)
  810    ->  prompt(Prompt, Prompt),
  811        pengine_input(_{type:console, prompt:Prompt}, Data)
  812    ;   current_prolog_flag(pengine_main_thread, TID),
  813        call_in_thread(TID, stream_read(Stream, Data))
  814    ).
  815stream_close(_Stream).
  816
  817%!  pengine_bind_user_streams
  818%
  819%   Bind the pengine user  I/O  streams   to  a  Prolog  stream that
  820%   redirects  the  input  and   output    to   pengine_input/2  and
  821%   pengine_output/1. This results in  less   pretty  behaviour then
  822%   redefining the I/O predicates to  produce   nice  HTML, but does
  823%   provide functioning I/O from included libraries.
  824
  825pengine_bind_user_streams :-
  826    Err = Out,
  827    open_prolog_stream(pengines_io, write, Out, []),
  828    set_stream(Out, buffer(line)),
  829    open_prolog_stream(pengines_io, read,  In, []),
  830    set_stream(In,  alias(user_input)),
  831    set_stream(Out, alias(user_output)),
  832    set_stream(Err, alias(user_error)),
  833    set_stream(In,  alias(current_input)),
  834    set_stream(Out, alias(current_output)),
  835    assertz(pengine_io(In, Out)),
  836    thread_self(Me),
  837    thread_property(Me, id(Id)),
  838    set_prolog_flag(pengine_main_thread, Id),
  839    thread_at_exit(close_io).
  840
  841close_io :-
  842    retract(pengine_io(In, Out)),
  843    !,
  844    close(In, [force(true)]),
  845    close(Out, [force(true)]).
  846close_io.
  847
  848%!  pengine_output is semidet.
  849%!  pengine_input is semidet.
  850%
  851%   True when output (input) is redirected to a pengine.
  852
  853pengine_output :-
  854    current_output(Out),
  855    pengine_io(_, Out).
  856
  857pengine_input :-
  858    current_input(In),
  859    pengine_io(In, _).
  860
  861
  862%!  pengine_bind_io_to_html(+Module)
  863%
  864%   Redefine the built-in predicates for IO   to  send HTML messages
  865%   using pengine_output/1.
  866
  867pengine_bind_io_to_html(Module) :-
  868    forall(pengine_io_predicate(Head),
  869           bind_io(Head, Module)),
  870    pengine_bind_user_streams.
  871
  872bind_io(Head, Module) :-
  873    prompt(_, ''),
  874    redefine_system_predicate(Module:Head),
  875    functor(Head, Name, Arity),
  876    Head =.. [Name|Args],
  877    atom_concat(pengine_, Name, BodyName),
  878    Body =.. [BodyName|Args],
  879    assertz(Module:(Head :- Body)),
  880    compile_predicates([Module:Name/Arity])