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