View source with formatted comments or as raw
    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-2017, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(pengines_io,
   36          [ pengine_writeln/1,          % +Term
   37            pengine_nl/0,
   38            pengine_flush_output/0,
   39            pengine_format/1,           % +Format
   40            pengine_format/2,           % +Format, +Args
   41
   42            pengine_write_term/2,       % +Term, +Options
   43            pengine_write/1,            % +Term
   44            pengine_writeq/1,           % +Term
   45            pengine_display/1,          % +Term
   46            pengine_print/1,            % +Term
   47            pengine_write_canonical/1,  % +Term
   48
   49            pengine_listing/0,
   50            pengine_listing/1,          % +Spec
   51            pengine_portray_clause/1,   % +Term
   52
   53            pengine_read/1,             % -Term
   54            pengine_read_line_to_string/2, % +Stream, -LineAsString
   55            pengine_read_line_to_codes/2, % +Stream, -LineAsCodes
   56
   57            pengine_io_predicate/1,     % ?Head
   58            pengine_bind_io_to_html/1,  % +Module
   59            pengine_io_goal_expansion/2 % +Goal, -Expanded
   60          ]).   61:- use_module(library(lists)).   62:- use_module(library(pengines)).   63:- use_module(library(option)).   64:- use_module(library(debug)).   65:- use_module(library(error)).   66:- use_module(library(apply)).   67:- use_module(library(settings)).   68:- use_module(library(listing)).   69:- use_module(library(yall)).   70:- use_module(library(sandbox), []).   71:- use_module(library(http/html_write)).   72:- use_module(library(http/term_html)).   73:- if(exists_source(library(prolog_stream))).   74:- use_module(library(prolog_stream)).   75:- endif.   76:- html_meta send_html(html).   77
   78:- meta_predicate
   79    pengine_format(+,:).   80
   81/** <module> Provide Prolog I/O for HTML clients
   82
   83This module redefines some of  the   standard  Prolog  I/O predicates to
   84behave transparently for HTML clients. It  provides two ways to redefine
   85the standard predicates: using goal_expansion/2   and  by redefining the
   86system predicates using redefine_system_predicate/1. The   latter is the
   87preferred route because it gives a more   predictable  trace to the user
   88and works regardless of the use of other expansion and meta-calling.
   89
   90*Redefining* works by redefining the system predicates in the context of
   91the pengine's module. This  is  configured   using  the  following  code
   92snippet.
   93
   94  ==
   95  :- pengine_application(myapp).
   96  :- use_module(myapp:library(pengines_io)).
   97  pengines:prepare_module(Module, myapp, _Options) :-
   98        pengines_io:pengine_bind_io_to_html(Module).
   99  ==
  100
  101*Using goal_expansion/2* works by  rewriting   the  corresponding  goals
  102using goal_expansion/2 and use the new   definition  to re-route I/O via
  103pengine_input/2 and pengine_output/1. A pengine  application is prepared
  104for using this module with the following code:
  105
  106  ==
  107  :- pengine_application(myapp).
  108  :- use_module(myapp:library(pengines_io)).
  109  myapp:goal_expansion(In,Out) :-
  110        pengine_io_goal_expansion(In, Out).
  111  ==
  112*/
  113
  114:- setting(write_options, list(any), [max_depth(1000)],
  115           'Additional options for stringifying Prolog results').  116
  117
  118                 /*******************************
  119                 *            OUTPUT            *
  120                 *******************************/
  121
  122%!  pengine_writeln(+Term)
  123%
  124%   Emit Term as <span class=writeln>Term<br></span>.
  125
  126pengine_writeln(Term) :-
  127    pengine_output,
  128    !,
  129    pengine_module(Module),
  130    send_html(span(class(writeln),
  131                   [ \term(Term,
  132                           [ module(Module)
  133                           ]),
  134                     br([])
  135                   ])).
  136pengine_writeln(Term) :-
  137    writeln(Term).
  138
  139%!  pengine_nl
  140%
  141%   Emit a <br/> to the pengine.
  142
  143pengine_nl :-
  144    pengine_output,
  145    !,
  146    send_html(br([])).
  147pengine_nl :-
  148    nl.
  149
  150%!  pengine_flush_output
  151%
  152%   No-op.  Pengines do not use output buffering (maybe they should
  153%   though).
  154
  155pengine_flush_output :-
  156    pengine_output,
  157    !.
  158pengine_flush_output :-
  159    flush_output.
  160
  161%!  pengine_write_term(+Term, +Options)
  162%
  163%   Writes term as <span class=Class>Term</span>. In addition to the
  164%   options of write_term/2, these options are processed:
  165%
  166%     - class(+Class)
  167%       Specifies the class of the element.  Default is =write=.
  168
  169pengine_write_term(Term, Options) :-
  170    pengine_output,
  171    !,
  172    option(class(Class), Options, write),
  173    pengine_module(Module),
  174    send_html(span(class(Class), \term(Term,[module(Module)|Options]))).
  175pengine_write_term(Term, Options) :-
  176    write_term(Term, Options).
  177
  178%!  pengine_write(+Term) is det.
  179%!  pengine_writeq(+Term) is det.
  180%!  pengine_display(+Term) is det.
  181%!  pengine_print(+Term) is det.
  182%!  pengine_write_canonical(+Term) is det.
  183%
  184%   Redirect the corresponding Prolog output predicates.
  185
  186pengine_write(Term) :-
  187    pengine_write_term(Term, []).
  188pengine_writeq(Term) :-
  189    pengine_write_term(Term, [quoted(true), numbervars(true)]).
  190pengine_display(Term) :-
  191    pengine_write_term(Term, [quoted(true), ignore_ops(true)]).
  192pengine_print(Term) :-
  193    current_prolog_flag(print_write_options, Options),
  194    pengine_write_term(Term, Options).
  195pengine_write_canonical(Term) :-
  196    pengine_output,
  197    !,
  198    with_output_to(string(String), write_canonical(Term)),
  199    send_html(span(class([write, cononical]), String)).
  200pengine_write_canonical(Term) :-
  201    write_canonical(Term).
  202
  203%!  pengine_format(+Format) is det.
  204%!  pengine_format(+Format, +Args) is det.
  205%
  206%   As format/1,2. Emits a series  of   strings  with <br/> for each
  207%   newline encountered in the string.
  208%
  209%   @tbd: handle ~w, ~q, etc using term//2.  How can we do that??
  210
  211pengine_format(Format) :-
  212    pengine_format(Format, []).
  213pengine_format(Format, Args) :-
  214    pengine_output,
  215    !,
  216    format(string(String), Format, Args),
  217    split_string(String, "\n", "", Lines),
  218    send_html(\lines(Lines, format)).
  219pengine_format(Format, Args) :-
  220    format(Format, Args).
  221
  222
  223                 /*******************************
  224                 *            LISTING           *
  225                 *******************************/
  226
  227%!  pengine_listing is det.
  228%!  pengine_listing(+Spec) is det.
  229%
  230%   List the content of the current pengine or a specified predicate
  231%   in the pengine.
  232
  233pengine_listing :-
  234    pengine_listing(_).
  235
  236pengine_listing(Spec) :-
  237    pengine_self(Module),
  238    with_output_to(string(String), listing(Module:Spec)),
  239    split_string(String, "", "\n", [Pre]),
  240    send_html(pre(class(listing), Pre)).
  241
  242pengine_portray_clause(Term) :-
  243    pengine_output,
  244    !,
  245    with_output_to(string(String), portray_clause(Term)),
  246    split_string(String, "", "\n", [Pre]),
  247    send_html(pre(class(listing), Pre)).
  248pengine_portray_clause(Term) :-
  249    portray_clause(Term).
  250
  251
  252                 /*******************************
  253                 *         PRINT MESSAGE        *
  254                 *******************************/
  255
  256:- multifile user:message_hook/3.  257
  258%!  user:message_hook(+Term, +Kind, +Lines) is semidet.
  259%
  260%   Send output from print_message/2 to   the  pengine. Messages are
  261%   embedded in a <pre class=msg-Kind></pre> environment.
  262
  263user:message_hook(Term, Kind, Lines) :-
  264    Kind \== silent,
  265    pengine_self(_),
  266    atom_concat('msg-', Kind, Class),
  267    phrase(html(pre(class(['prolog-message', Class]),
  268                    \message_lines(Lines))), Tokens),
  269    with_output_to(string(HTMlString), print_html(Tokens)),
  270    (   source_location(File, Line)
  271    ->  Src = File:Line
  272    ;   Src = (-)
  273    ),
  274    pengine_output(message(Term, Kind, HTMlString, Src)).
  275
  276message_lines([]) --> [].
  277message_lines([nl|T]) -->
  278    !,
  279    html('\n'),                     % we are in a <pre> environment
  280    message_lines(T).
  281message_lines([flush]) -->
  282    [].
  283message_lines([H|T]) -->
  284    !,
  285    html(H),
  286    message_lines(T).
  287
  288
  289                 /*******************************
  290                 *             INPUT            *
  291                 *******************************/
  292
  293pengine_read(Term) :-
  294    pengine_input,
  295    !,
  296    prompt(Prompt, Prompt),
  297    pengine_input(Prompt, Term).
  298pengine_read(Term) :-
  299    read(Term).
  300
  301pengine_read_line_to_string(From, String) :-
  302    pengine_input,
  303    !,
  304    must_be(oneof([current_input,user_input]), From),
  305    (   prompt(Prompt, Prompt),
  306        Prompt \== ''
  307    ->  true
  308    ;   Prompt = 'line> '
  309    ),
  310    pengine_input(_{type: console, prompt:Prompt}, StringNL),
  311    string_concat(String, "\n", StringNL).
  312pengine_read_line_to_string(From, String) :-
  313    read_line_to_string(From, String).
  314
  315pengine_read_line_to_codes(From, Codes) :-
  316    pengine_read_line_to_string(From, String),
  317    string_codes(String, Codes).
  318
  319
  320                 /*******************************
  321                 *             HTML             *
  322                 *******************************/
  323
  324lines([], _) --> [].
  325lines([H|T], Class) -->
  326    html(span(class(Class), H)),
  327    (   { T == [] }
  328    ->  []
  329    ;   html(br([])),
  330        lines(T, Class)
  331    ).
  332
  333%!  send_html(+HTML) is det.
  334%
  335%   Convert html//1 term into a string and send it to the client
  336%   using pengine_output/1.
  337
  338send_html(HTML) :-
  339    phrase(html(HTML), Tokens),
  340    with_output_to(string(HTMlString), print_html(Tokens)),
  341    pengine_output(HTMlString).
  342
  343
  344%!  pengine_module(-Module) is det.
  345%
  346%   Module (used for resolving operators).
  347
  348pengine_module(Module) :-
  349    pengine_self(Pengine),
  350    !,
  351    pengine_property(Pengine, module(Module)).
  352pengine_module(user).
  353
  354                 /*******************************
  355                 *        OUTPUT FORMAT         *
  356                 *******************************/
  357
  358%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames) is semidet.
  359%
  360%   Provide additional translations for  Prolog   terms  to  output.
  361%   Defines formats are:
  362%
  363%     * 'json-s'
  364%     _Simple_ or _string_ format: Prolog terms are sent using
  365%     quoted write.
  366%     * 'json-html'
  367%     Serialize responses as HTML string.  This is intended for
  368%     applications that emulate the Prolog toplevel.  This format
  369%     carries the following data:
  370%
  371%       - data
  372%         List if answers, where each answer is an object with
  373%         - variables
  374%           Array of objects, each describing a variable.  These
  375%           objects contain these fields:
  376%           - variables: Array of strings holding variable names
  377%           - value: HTML-ified value of the variables
  378%           - substitutions: Array of objects for substitutions
  379%             that break cycles holding:
  380%             - var: Name of the inserted variable
  381%             - value: HTML-ified value
  382%         - residuals
  383%           Array of strings representing HTML-ified residual goals.
  384
  385:- multifile
  386    pengines:event_to_json/3.  387
  388%!  pengines:event_to_json(+PrologEvent, -JSONEvent, +Format, +VarNames)
  389%
  390%   If Format equals `'json-s'` or  `'json-html'`, emit a simplified
  391%   JSON representation of the  data,   suitable  for notably SWISH.
  392%   This deals with Prolog answers and output messages. If a message
  393%   originates from print_message/3,  it   gets  several  additional
  394%   properties:
  395%
  396%     - message:Kind
  397%       Indicate the _kind_ of the message (=error=, =warning=,
  398%       etc.)
  399%     - location:_{file:File, line:Line, ch:CharPos}
  400%       If the message is related to a source location, indicate the
  401%       file and line and, if available, the character location.
  402
  403pengines:event_to_json(success(ID, Answers0, Projection, Time, More), JSON,
  404                       'json-s') :-
  405    !,
  406    JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
  407    maplist(answer_to_json_strings(ID), Answers0, Answers),
  408    add_projection(Projection, JSON0, JSON).
  409pengines:event_to_json(output(ID, Term), JSON, 'json-s') :-
  410    !,
  411    map_output(ID, Term, JSON).
  412
  413add_projection([], JSON, JSON) :- !.
  414add_projection(VarNames, JSON0, JSON0.put(projection, VarNames)).
  415
  416
  417%!  answer_to_json_strings(+Pengine, +AnswerDictIn, -AnswerDict).
  418%
  419%   Translate answer dict with Prolog term   values into answer dict
  420%   with string values.
  421
  422answer_to_json_strings(Pengine, DictIn, DictOut) :-
  423    dict_pairs(DictIn, Tag, Pairs),
  424    maplist(term_string_value(Pengine), Pairs, BindingsOut),
  425    dict_pairs(DictOut, Tag, BindingsOut).
  426
  427term_string_value(Pengine, N-V, N-A) :-
  428    with_output_to(string(A),
  429                   write_term(V,
  430                              [ module(Pengine),
  431                                quoted(true)
  432                              ])).
  433
  434%!  pengines:event_to_json(+Event, -JSON, +Format, +VarNames)
  435%
  436%   Implement translation of a Pengine  event to =json-html= format.
  437%   This format represents the answer  as   JSON,  but  the variable
  438%   bindings are (structured) HTML strings rather than JSON objects.
  439%
  440%   CHR residual goals are not bound to the projection variables. We
  441%   hacked a bypass to fetch these by   returning them in a variable
  442%   named   `Residuals`,   which   must   be   bound   to   a   term
  443%   '$residuals'(List).  Such  a  variable  is    removed  from  the
  444%   projection and added to residual goals.
  445
  446pengines:event_to_json(success(ID, Answers0, Projection, Time, More),
  447                       JSON, 'json-html') :-
  448    !,
  449    JSON0 = json{event:success, id:ID, time:Time, data:Answers, more:More},
  450    maplist(map_answer(ID), Answers0, ResVars, Answers),
  451    add_projection(Projection, ResVars, JSON0, JSON).
  452pengines:event_to_json(output(ID, Term), JSON, 'json-html') :-
  453    !,
  454    map_output(ID, Term, JSON).
  455
  456map_answer(ID, Bindings0, ResVars, Answer) :-
  457    dict_bindings(Bindings0, Bindings1),
  458    select_residuals(Bindings1, Bindings2, ResVars, Residuals0),
  459    append(Residuals0, Residuals1),
  460    prolog:translate_bindings(Bindings2, Bindings3, [], Residuals1,
  461                              ID:Residuals-_HiddenResiduals),
  462    maplist(binding_to_html(ID), Bindings3, VarBindings),
  463    (   Residuals == []
  464    ->  Answer = json{variables:VarBindings}
  465    ;   residuals_html(Residuals, ID, ResHTML),
  466        Answer = json{variables:VarBindings, residuals:ResHTML}
  467    ).
  468
  469residuals_html([], _, []).
  470residuals_html([H0|T0], Module, [H|T]) :-
  471    term_html_string(H0, [], Module, H, [priority(999)]),
  472    residuals_html(T0, Module, T).
  473
  474dict_bindings(Dict, Bindings) :-
  475    dict_pairs(Dict, _Tag, Pairs),
  476    maplist([N-V,N=V]>>true, Pairs, Bindings).
  477
  478select_residuals([], [], [], []).
  479select_residuals([H|T], Bindings, Vars, Residuals) :-
  480    binding_residual(H, Var, Residual),
  481    !,
  482    Vars = [Var|TV],
  483    Residuals = [Residual|TR],
  484    select_residuals(T, Bindings, TV, TR).
  485select_residuals([H|T0], [H|T], Vars, Residuals) :-
  486    select_residuals(T0, T, Vars, Residuals).
  487
  488binding_residual('_residuals' = '$residuals'(Residuals), '_residuals', Residuals) :-
  489    is_list(Residuals).
  490binding_residual('Residuals' = '$residuals'(Residuals), 'Residuals', Residuals) :-
  491    is_list(Residuals).
  492binding_residual('Residual'  = '$residual'(Residual),   'Residual', [Residual]) :-
  493    callable(Residual).
  494
  495add_projection(-, _, JSON, JSON) :- !.
  496add_projection(VarNames0, ResVars0, JSON0, JSON) :-
  497    append(ResVars0, ResVars1),
  498    sort(ResVars1, ResVars),
  499    subtract(VarNames0, ResVars, VarNames),
  500    add_projection(VarNames, JSON0, JSON).
  501
  502
  503%!  binding_to_html(+Pengine, +Binding, -Dict) is det.
  504%
  505%   Convert a variable binding into a JSON Dict. Note that this code
  506%   assumes that the module associated  with   Pengine  has the same
  507%   name as the Pengine.  The module is needed to
  508%
  509%   @arg Binding is a term binding(Vars,Term,Substitutions)
  510
  511binding_to_html(ID, binding(Vars,Term,Substitutions), JSON) :-
  512    JSON0 = json{variables:Vars, value:HTMLString},
  513    term_html_string(Term, Vars, ID, HTMLString, [priority(699)]),
  514    (   Substitutions == []
  515    ->  JSON = JSON0
  516    ;   maplist(subst_to_html(ID), Substitutions, HTMLSubst),
  517        JSON = JSON0.put(substitutions, HTMLSubst)
  518    ).
  519
  520%!  term_html_string(+Term, +VarNames, +Module, -HTMLString,
  521%!                   +Options) is det.
  522%
  523%   Translate  Term  into  an  HTML    string   using  the  operator
  524%   declarations from Module. VarNames is a   list of variable names
  525%   that have this value.
  526
  527term_html_string(Term, Vars, Module, HTMLString, Options) :-
  528    setting(write_options, WOptions),
  529    merge_options(WOptions,
  530                  [ quoted(true),
  531                    numbervars(true),
  532                    module(Module)
  533                  | Options
  534                  ], WriteOptions),
  535    phrase(term_html(Term, Vars, WriteOptions), Tokens),
  536    with_output_to(string(HTMLString), print_html(Tokens)).
  537
  538%!  binding_term(+Term, +Vars, +WriteOptions)// is semidet.
  539%
  540%   Hook to render a Prolog result term as HTML. This hook is called
  541%   for each non-variable binding,  passing   the  binding  value as
  542%   Term, the names of the variables as   Vars and a list of options
  543%   for write_term/3.  If the hook fails, term//2 is called.
  544%
  545%   @arg    Vars is a list of variable names or `[]` if Term is a
  546%           _residual goal_.
  547
  548:- multifile binding_term//3.  549
  550term_html(Term, Vars, WriteOptions) -->
  551    { nonvar(Term) },
  552    binding_term(Term, Vars, WriteOptions),
  553    !.
  554term_html(Term, _Vars, WriteOptions) -->
  555    term(Term, WriteOptions).
  556
  557%!  subst_to_html(+Module, +Binding, -JSON) is det.
  558%
  559%   Render   a   variable   substitution     resulting   from   term
  560%   factorization, in this case breaking a cycle.
  561
  562subst_to_html(ID, '$VAR'(Name)=Value, json{var:Name, value:HTMLString}) :-
  563    !,
  564    term_html_string(Value, [Name], ID, HTMLString, [priority(699)]).
  565subst_to_html(_, Term, _) :-
  566    assertion(Term = '$VAR'(_)).
  567
  568
  569%!  map_output(+ID, +Term, -JSON) is det.
  570%
  571%   Map an output term. This is the same for json-s and json-html.
  572
  573map_output(ID, message(Term, Kind, HTMLString, Src), JSON) :-
  574    atomic(HTMLString),
  575    !,
  576    JSON0 = json{event:output, id:ID, message:Kind, data:HTMLString},
  577    pengines:add_error_details(Term, JSON0, JSON1),
  578    (   Src = File:Line,
  579        \+ JSON1.get(location) = _
  580    ->  JSON = JSON1.put(_{location:_{file:File, line:Line}})
  581    ;   JSON = JSON1
  582    ).
  583map_output(ID, Term, json{event:output, id:ID, data:Data}) :-
  584    (   atomic(Term)
  585    ->  Data = Term
  586    ;   is_dict(Term, json),
  587        ground(json)                % TBD: Check proper JSON object?
  588    ->  Data = Term
  589    ;   term_string(Term, Data)
  590    ).
  591
  592
  593                 /*******************************
  594                 *          SANDBOXING          *
  595                 *******************************/
  596
  597:- multifile
  598    sandbox:safe_primitive/1,       % Goal
  599    sandbox:safe_meta/2.            % Goal, Called
  600
  601sandbox:safe_primitive(pengines_io:pengine_listing(_)).
  602sandbox:safe_primitive(pengines_io:pengine_nl).
  603sandbox:safe_primitive(pengines_io:pengine_print(_)).
  604sandbox:safe_primitive(pengines_io:pengine_write(_)).
  605sandbox:safe_primitive(pengines_io:pengine_read(_)).
  606sandbox:safe_primitive(pengines_io:pengine_write_canonical(_)).
  607sandbox:safe_primitive(pengines_io:pengine_write_term(_,_)).
  608sandbox:safe_primitive(pengines_io:pengine_writeln(_)).
  609sandbox:safe_primitive(pengines_io:pengine_writeq(_)).
  610sandbox:safe_primitive(pengines_io:pengine_portray_clause(_)).
  611sandbox:safe_primitive(system:write_term(_,_)).
  612sandbox:safe_primitive(system:prompt(_,_)).
  613sandbox:safe_primitive(system:statistics(_,_)).
  614
  615sandbox:safe_meta(pengines_io:pengine_format(Format, Args), Calls) :-
  616    sandbox:format_calls(Format, Args, Calls).
  617
  618
  619                 /*******************************
  620                 *         REDEFINITION         *
  621                 *******************************/
  622
  623%!  pengine_io_predicate(?Head)
  624%
  625%   True when Head describes the  head   of  a (system) IO predicate
  626%   that is redefined by the HTML binding.
  627
  628pengine_io_predicate(writeln(_)).
  629pengine_io_predicate(nl).
  630pengine_io_predicate(flush_output).
  631pengine_io_predicate(format(_)).
  632pengine_io_predicate(format(_,_)).
  633pengine_io_predicate(read(_)).
  634pengine_io_predicate(read_line_to_string(_,_)).
  635pengine_io_predicate(read_line_to_codes(_,_)).
  636pengine_io_predicate(write_term(_,_)).
  637pengine_io_predicate(write(_)).
  638pengine_io_predicate(writeq(_)).
  639pengine_io_predicate(display(_)).
  640pengine_io_predicate(print(_)).
  641pengine_io_predicate(write_canonical(_)).
  642pengine_io_predicate(listing).
  643pengine_io_predicate(listing(_)).
  644pengine_io_predicate(portray_clause(_)).
  645
  646term_expansion(pengine_io_goal_expansion(_,_),
  647               Clauses) :-
  648    findall(Clause, io_mapping(Clause), Clauses).
  649
  650io_mapping(pengine_io_goal_expansion(Head, Mapped)) :-
  651    pengine_io_predicate(Head),
  652    Head =.. [Name|Args],
  653    atom_concat(pengine_, Name, BodyName),
  654    Mapped =.. [BodyName|Args].
  655
  656pengine_io_goal_expansion(_, _).
  657
  658
  659                 /*******************************
  660                 *      REBIND PENGINE I/O      *
  661                 *******************************/
  662
  663:- public
  664    stream_write/2,
  665    stream_read/2,
  666    stream_close/1.  667
  668:- thread_local
  669    pengine_io/2.  670
  671stream_write(_Stream, Out) :-
  672    send_html(pre(class(console), Out)).
  673stream_read(_Stream, Data) :-
  674    prompt(Prompt, Prompt),
  675    pengine_input(_{type:console, prompt:Prompt}, Data).
  676stream_close(_Stream).
  677
  678%!  pengine_bind_user_streams
  679%
  680%   Bind the pengine user  I/O  streams   to  a  Prolog  stream that
  681%   redirects  the  input  and   output    to   pengine_input/2  and
  682%   pengine_output/1. This results in  less   pretty  behaviour then
  683%   redefining the I/O predicates to  produce   nice  HTML, but does
  684%   provide functioning I/O from included libraries.
  685
  686pengine_bind_user_streams :-
  687    Err = Out,
  688    open_prolog_stream(pengines_io, write, Out, []),
  689    set_stream(Out, buffer(line)),
  690    open_prolog_stream(pengines_io, read,  In, []),
  691    set_stream(In,  alias(user_input)),
  692    set_stream(Out, alias(user_output)),
  693    set_stream(Err, alias(user_error)),
  694    set_stream(In,  alias(current_input)),
  695    set_stream(Out, alias(current_output)),
  696    assertz(pengine_io(In, Out)),
  697    thread_at_exit(close_io).
  698
  699close_io :-
  700    retract(pengine_io(In, Out)),
  701    !,
  702    close(In, [force(true)]),
  703    close(Out, [force(true)]).
  704close_io.
  705
  706%!  pengine_output is semidet.
  707%!  pengine_input is semidet.
  708%
  709%   True when output (input) is redirected to a pengine.
  710
  711pengine_output :-
  712    current_output(Out),
  713    pengine_io(_, Out).
  714
  715pengine_input :-
  716    current_input(In),
  717    pengine_io(In, _).
  718
  719
  720%!  pengine_bind_io_to_html(+Module)
  721%
  722%   Redefine the built-in predicates for IO   to  send HTML messages
  723%   using pengine_output/1.
  724
  725pengine_bind_io_to_html(Module) :-
  726    forall(pengine_io_predicate(Head),
  727           bind_io(Head, Module)),
  728    pengine_bind_user_streams.
  729
  730bind_io(Head, Module) :-
  731    prompt(_, ''),
  732    redefine_system_predicate(Module:Head),
  733    functor(Head, Name, Arity),
  734    Head =.. [Name|Args],
  735    atom_concat(pengine_, Name, BodyName),
  736    Body =.. [BodyName|Args],
  737    assertz(Module:(Head :- Body)),
  738    compile_predicates([Module:Name/Arity])