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)  1985-2020, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module('$history',
   38          [ read_term_with_history/2,           % -Term, +Line
   39            '$save_history_line'/1,             % +Line
   40            '$clean_history'/0,
   41            '$load_history'/0,
   42            '$save_history_event'/1
   43          ]).   44
   45%!  read_term_with_history(-Term, +Options)
   46%
   47%   Read a term guide by Options and  maintain a history similar to most
   48%   Unix shells.
   49%
   50%   When read_history reads a term of   the  form $silent(Goal), it will
   51%   call Goal and pretend it has not seen anything. This hook is used by
   52%   the GNU-Emacs interface to for   communication between GNU-EMACS and
   53%   SWI-Prolog.
   54
   55read_term_with_history(Term, Options) :-
   56    '$option'(prompt(Prompt), Options, '~! ?-'),
   57    '$option'(input(Input), Options, user_input),
   58    repeat,
   59        prompt_history(Prompt),
   60        '$toplevel':read_query_line(Input, Raw),
   61        read_history_(Raw, Term, Options),
   62    !.
   63
   64read_history_(Raw, _Term, Options) :-
   65    '$option'(show(Raw), Options, history),
   66    list_history,
   67    !,
   68    fail.
   69read_history_(Raw, _Term, Options) :-
   70    '$option'(help(Raw), Options, '!help'),
   71    '$option'(show(Show), Options, '!history'),
   72    print_message(help, history(help(Show, Raw))),
   73    !,
   74    fail.
   75read_history_(Raw, Term, Options) :-
   76    expand_history(Raw, Expanded, Changed),
   77    '$save_history_line'(Expanded),
   78    '$option'(module(Module), Options, Var),
   79    (   Module == Var
   80    ->  '$current_typein_module'(Module)
   81    ;   true
   82    ),
   83    '$option'(variable_names(Bindings), Options, Bindings0),
   84    catch(read_term_from_atom(Expanded, Term0,
   85                              [ module(Module),
   86                                variable_names(Bindings0)
   87                              ]),
   88          E,
   89          (   print_message(error, E),
   90              fail
   91          )),
   92    (   var(Term0)
   93    ->  Term = Term0,
   94        Bindings = Bindings0
   95    ;   Term0 = '$silent'(Goal)
   96    ->  user:ignore(Goal),
   97        read_term_with_history(Term, Options)
   98    ;   save_event(Expanded, Options),
   99        (   Changed == true
  100        ->  print_message(query, history(expanded(Expanded)))
  101        ;   true
  102        ),
  103        Term = Term0,
  104        Bindings = Bindings0
  105    ).
  106
  107%   list_history
  108%   Write history events to the current output stream.
  109
  110list_history :-
  111    (   '$history'(Last, _)
  112    ->  true
  113    ;   Last = 0
  114    ),
  115    history_depth_(Depth),
  116    plus(First, Depth, Last),
  117    findall(Nr/Event,
  118            (   between(First, Last, Nr),
  119                '$history'(Nr, Event)
  120            ),
  121            Events),
  122    print_message(query, history(history(Events))).
  123
  124'$clean_history' :-
  125    retractall('$history'(_,_)).
  126
  127%!  '$load_history' is det.
  128%
  129%   Load persistent history using a hook
  130
  131'$load_history' :-
  132    '$clean_history',
  133    current_prolog_flag(history, Depth),
  134    Depth > 0,
  135    catch(prolog:history(current_input, load), _, true), !.
  136'$load_history'.
  137
  138
  139%%   prompt_history(+Prompt)
  140%
  141%    Give prompt, substituting '~!' by the event number.
  142
  143prompt_history('') :-
  144    !,
  145    ttyflush.
  146prompt_history(Prompt) :-
  147    (   '$history'(Last, _)
  148    ->  This is Last + 1
  149    ;   This = 1
  150    ),
  151    atom_codes(Prompt, SP),
  152    atom_codes(This, ST),
  153    (   atom_codes('~!', Repl),
  154        substitute(Repl, ST, SP, String)
  155    ->  prompt1(String)
  156    ;   prompt1(Prompt)
  157    ),
  158    ttyflush.
  159
  160%   substitute(+Old, +New, +String, -Substituted)
  161%   substitute first occurence of Old in String by New
  162
  163substitute(Old, New, String, Substituted) :-
  164    '$append'(Head, OldAndTail, String),
  165    '$append'(Old, Tail, OldAndTail),
  166    !,
  167    '$append'(Head, New, HeadAndNew),
  168    '$append'(HeadAndNew, Tail, Substituted),
  169    !.
  170
  171%!  '$save_history_line'(+Line)
  172%
  173%   Add Line to the command line editing history.
  174
  175:- multifile
  176    prolog:history_line/2.  177
  178'$save_history_line'(end_of_file) :- !.
  179'$save_history_line'(Line) :-
  180    format(string(CompleteLine), '~W~W',
  181           [ Line, [partial(true)],
  182             '.',  [partial(true)]
  183           ]),
  184    catch(prolog:history(user_input, add(CompleteLine)), _, fail),
  185    !.
  186'$save_history_line'(_).
  187
  188%!  save_event(+Event, +Options)
  189%
  190%   Save Event into the  history  system unless it appears in the
  191%   option `no_save`.
  192
  193save_event(Event, Options) :-
  194    '$option'(no_save(Dont), Options),
  195    memberchk(Event, Dont),
  196    !.
  197save_event(Event, _) :-
  198    '$save_history_event'(Event).
  199
  200%!  '$save_history_event'(+Event) is det.
  201%
  202%   Save an input line as text into the !- based history. Event is one
  203%   of
  204%
  205%     * a *string*.  The event is added with a next number at the end.
  206%     * a *pair*.  The event is added with the given sequence number.
  207
  208:- thread_local
  209    '$history'/2.  210
  211'$save_history_event'(Num-String) :-
  212    integer(Num), string(String),
  213    !,
  214    asserta('$history'(Num, String)),
  215    truncate_history(Num).
  216'$save_history_event'(Event) :-
  217    to_string(Event, Event1),
  218    !,
  219    last_event(Num, String),
  220    (   Event1 == String
  221    ->  true
  222    ;   New is Num + 1,
  223        asserta('$history'(New, Event1)),
  224        truncate_history(New)
  225    ).
  226'$save_history_event'(Event) :-
  227    '$type_error'(history_event, Event).
  228
  229last_event(Num, String) :-
  230    '$history'(Num, String),
  231    !.
  232last_event(0, "").
  233
  234to_string(String, String) :-
  235    string(String),
  236    !.
  237to_string(Atom, String) :-
  238    atom_string(Atom, String).
  239
  240truncate_history(New) :-
  241    history_depth_(Depth),
  242    remove_history(New, Depth).
  243
  244remove_history(New, Depth) :-
  245    New - Depth =< 0,
  246    !.
  247remove_history(New, Depth) :-
  248    Remove is New - Depth,
  249    retract('$history'(Remove, _)),
  250    !.
  251remove_history(_, _).
  252
  253%    history_depth_(-Depth)
  254%    Define the depth to which to keep the history.
  255
  256history_depth_(N) :-
  257    current_prolog_flag(history, N),
  258    integer(N),
  259    N > 0,
  260    !.
  261history_depth_(25).
  262
  263%    expand_history(+Raw, -Expanded)
  264%    Expand Raw using the available history list. Expandations performed
  265%    are:
  266%
  267%       !match          % Last event starting <match>
  268%       !n              % Event nr. <n>
  269%       !!              % last event
  270%
  271%    Note: the first character after a '!' should be a letter or number to
  272%    avoid problems with the cut.
  273
  274expand_history(Raw, Expanded, Changed) :-
  275    atom_chars(Raw, RawString),
  276    expand_history2(RawString, ExpandedString, Changed),
  277    atom_chars(Expanded, ExpandedString),
  278    !.
  279
  280expand_history2([!], [!], false) :- !.
  281expand_history2([!, C|Rest], [!|Expanded], Changed) :-
  282    not_event_char(C),
  283    !,
  284    expand_history2([C|Rest], Expanded, Changed).
  285expand_history2([!|Rest], Expanded, true) :-
  286    !,
  287    match_event(Rest, Event, NewRest),
  288    '$append'(Event, RestExpanded, Expanded),
  289    !,
  290    expand_history2(NewRest, RestExpanded, _).
  291expand_history2(['\''|In], ['\''|Out], Changed) :-
  292    !,
  293    skip_quoted(In, '\'', Out, Tin, Tout),
  294    expand_history2(Tin, Tout, Changed).
  295expand_history2(['"'|In], ['"'|Out], Changed) :-
  296    !,
  297    skip_quoted(In, '"', Out, Tin, Tout),
  298    expand_history2(Tin, Tout, Changed).
  299expand_history2([H|T], [H|R], Changed) :-
  300    !,
  301    expand_history2(T, R, Changed).
  302expand_history2([], [], false).
  303
  304skip_quoted([Q|T],Q,[Q|R], T, R) :- !.
  305skip_quoted([\,Q|T0],Q,[\,Q|T], In, Out) :-
  306    !,
  307    skip_quoted(T0, Q, T, In, Out).
  308skip_quoted([Q,Q|T0],Q,[Q,Q|T], In, Out) :-
  309    !,
  310    skip_quoted(T0, Q, T, In, Out).
  311skip_quoted([C|T0],Q,[C|T], In, Out) :-
  312    !,
  313    skip_quoted(T0, Q, T, In, Out).
  314skip_quoted([], _, [], [], []).
  315
  316%   get_last_event(-String)
  317%   return last event typed as a string
  318
  319get_last_event(Event) :-
  320    '$history'(_, Atom),
  321    atom_chars(Atom, Event),
  322    !.
  323get_last_event(_) :-
  324    print_message(query, history(no_event)),
  325    fail.
  326
  327%   match_event(+Spec, -Event, -Rest)
  328%   Use Spec as a specification of and event and return the event as Event
  329%   and what is left of Spec as Rest.
  330
  331match_event(Spec, Event, Rest) :-
  332    find_event(Spec, Event, Rest),
  333    !.
  334match_event(_, _, _) :-
  335    print_message(query, history(no_event)),
  336    fail.
  337
  338not_event_char(C) :- code_type(C, csym), !, fail.
  339not_event_char(!) :- !, fail.
  340not_event_char(_).
  341
  342find_event([!|Left], Event, Left) :-
  343    !,
  344    get_last_event(Event).
  345find_event([N|Rest], Event, Left) :-
  346    code_type(N, digit),
  347    !,
  348    take_number([N|Rest], String, Left),
  349    number_codes(Number, String),
  350    '$history'(Number, Atom),
  351    atom_chars(Atom, Event).
  352find_event(Spec, Event, Left) :-
  353    take_string(Spec, String, Left),
  354    matching_event(String, Event).
  355
  356take_string([C|Rest], [C|String], Left) :-
  357    code_type(C, csym),
  358    !,
  359    take_string(Rest, String, Left).
  360take_string([C|Rest], [], [C|Rest]) :- !.
  361take_string([], [], []).
  362
  363take_number([C|Rest], [C|String], Left) :-
  364    code_type(C, digit),
  365    !,
  366    take_string(Rest, String, Left).
  367take_number([C|Rest], [], [C|Rest]) :- !.
  368take_number([], [], []).
  369
  370%   matching_event(+String, -Event)
  371%
  372%   Return first event with prefix String as a Prolog string.
  373
  374matching_event(String, Event) :-
  375    '$history'(_, AtomEvent),
  376    atom_chars(AtomEvent, Event),
  377    '$append'(String, _, Event),
  378    !