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