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-2016, 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_history/6,
   39            '$save_history_line'/1,             % +Line
   40            '$clean_history'/0,
   41            '$load_history'/0,
   42            '$save_history_event'/1
   43          ]).   44
   45%%  read_history(+History, +Help, +DontStore, +Prompt, -Term, -Bindings)
   46%
   47%   Give a prompt using Prompt. The   sequence  '%w' is substituted with
   48%   the current event number. Then read a term from the input stream and
   49%   perform the history expansion. Return  the   expanded  term  and the
   50%   bindings of the variables as with  read/2. entering the term History
   51%   makes read_history/5 print the  history.   Help  specifies  the help
   52%   command. DontStore is a list of events that need not be stored.
   53
   54%   When read_history reads a term of   the  form $silent(Goal), it will
   55%   call Goal and pretend it has not seen anything. This hook is used by
   56%   the GNU-Emacs interface to for   communication between GNU-EMACS and
   57%   SWI-Prolog.
   58
   59read_history(History, Help, DontStore, Prompt, Term, Bindings) :-
   60    repeat,
   61        prompt_history(Prompt),
   62        '$toplevel':read_query_line(user_input, Raw),
   63        read_history_(History, Help, DontStore, Raw, Term, Bindings),
   64    !.
   65
   66read_history_(History, _, _, History, _, _) :-
   67    list_history,
   68    !,
   69    fail.
   70read_history_(Show, Help, _, Help, _, _) :-
   71    print_message(help, history(help(Show, Help))),
   72    !,
   73    fail.
   74read_history_(History, Help, DontStore, Raw, Term, Bindings) :-
   75    expand_history(Raw, Expanded, Changed),
   76    '$save_history_line'(Expanded),
   77    '$current_typein_module'(TypeIn),
   78    catch(read_term_from_atom(Expanded, Term0,
   79                              [ variable_names(Bindings0),
   80                                module(TypeIn)
   81                              ]),
   82          E,
   83          (   print_message(error, E),
   84              fail
   85          )),
   86    (   var(Term0)
   87    ->  Term = Term0,
   88        Bindings = Bindings0
   89    ;   Term0 = '$silent'(Goal)
   90    ->  user:ignore(Goal),
   91        read_history(History, Help, DontStore, '', Term, Bindings)
   92    ;   save_event(DontStore, Expanded),
   93        (   Changed == true
   94        ->  print_message(query, history(expanded(Expanded)))
   95        ;   true
   96        ),
   97        Term = Term0,
   98        Bindings = Bindings0
   99    ).
  100
  101
  102%   list_history
  103%   Write history events to the current output stream.
  104
  105list_history :-
  106    (   '$history'(Last, _)
  107    ->  true
  108    ;   Last = 0
  109    ),
  110    history_depth_(Depth),
  111    plus(First, Depth, Last),
  112    findall(Nr/Event,
  113            (   between(First, Last, Nr),
  114                '$history'(Nr, Event)
  115            ),
  116            Events),
  117    print_message(query, history(history(Events))).
  118
  119'$clean_history' :-
  120    retractall('$history'(_,_)).
  121
  122%!  '$load_history' is det.
  123%
  124%   Load persistent history using a hook
  125
  126'$load_history' :-
  127    '$clean_history',
  128    current_prolog_flag(history, Depth),
  129    Depth > 0,
  130    catch(prolog:history(current_input, load), _, true), !.
  131'$load_history'.
  132
  133
  134%%   prompt_history(+Prompt)
  135%
  136%    Give prompt, substituting '~!' by the event number.
  137
  138prompt_history('') :-
  139    !,
  140    ttyflush.
  141prompt_history(Prompt) :-
  142    (   '$history'(Last, _)
  143    ->  This is Last + 1
  144    ;   This = 1
  145    ),
  146    atom_codes(Prompt, SP),
  147    atom_codes(This, ST),
  148    (   atom_codes('~!', Repl),
  149        substitute(Repl, ST, SP, String)
  150    ->  prompt1(String)
  151    ;   prompt1(Prompt)
  152    ),
  153    ttyflush.
  154
  155%   substitute(+Old, +New, +String, -Substituted)
  156%   substitute first occurence of Old in String by New
  157
  158substitute(Old, New, String, Substituted) :-
  159    '$append'(Head, OldAndTail, String),
  160    '$append'(Old, Tail, OldAndTail),
  161    !,
  162    '$append'(Head, New, HeadAndNew),
  163    '$append'(HeadAndNew, Tail, Substituted),
  164    !.
  165
  166%!  '$save_history_line'(+Line)
  167%
  168%   Add Line to the command line editing history.
  169
  170:- multifile
  171    prolog:history_line/2.  172
  173'$save_history_line'(end_of_file) :- !.
  174'$save_history_line'(Line) :-
  175    format(string(CompleteLine), '~W~W',
  176           [ Line, [partial(true)],
  177             '.',  [partial(true)]
  178           ]),
  179    catch(prolog:history(user_input, add(CompleteLine)), _, fail),
  180    !.
  181'$save_history_line'(_).
  182
  183%!  save_event(+DoNotSave, +Event)
  184%
  185%   Save Event into the  history  system  if   it  is  not  a  member of
  186%   DoNotSave.
  187
  188save_event(Dont, Event) :-
  189    memberchk(Event, Dont),
  190    !.
  191save_event(_, Event) :-
  192    '$save_history_event'(Event).
  193
  194%!  '$save_history_event'(+Event) is det.
  195%
  196%   Save an input line as text into the !- based history. Event is one
  197%   of
  198%
  199%     * a *string*.  The event is added with a next number at the end.
  200%     * a *pair*.  The event is added with the given sequence number.
  201
  202:- thread_local
  203    '$history'/2.  204
  205'$save_history_event'(Num-String) :-
  206    integer(Num), string(String),
  207    !,
  208    asserta('$history'(Num, String)),
  209    truncate_history(Num).
  210'$save_history_event'(Event) :-
  211    to_string(Event, Event1),
  212    !,
  213    last_event(Num, String),
  214    (   Event1 == String
  215    ->  true
  216    ;   New is Num + 1,
  217        asserta('$history'(New, Event1)),
  218        truncate_history(New)
  219    ).
  220'$save_history_event'(Event) :-
  221    '$type_error'(history_event, Event).
  222
  223last_event(Num, String) :-
  224    '$history'(Num, String),
  225    !.
  226last_event(0, "").
  227
  228to_string(String, String) :-
  229    string(String),
  230    !.
  231to_string(Atom, String) :-
  232    atom_string(Atom, String).
  233
  234truncate_history(New) :-
  235    history_depth_(Depth),
  236    remove_history(New, Depth).
  237
  238remove_history(New, Depth) :-
  239    New - Depth =< 0,
  240    !.
  241remove_history(New, Depth) :-
  242    Remove is New - Depth,
  243    retract('$history'(Remove, _)),
  244    !.
  245remove_history(_, _).
  246
  247%    history_depth_(-Depth)
  248%    Define the depth to which to keep the history.
  249
  250history_depth_(N) :-
  251    current_prolog_flag(history, N),
  252    integer(N),
  253    N > 0,
  254    !.
  255history_depth_(25).
  256
  257%    expand_history(+Raw, -Expanded)
  258%    Expand Raw using the available history list. Expandations performed
  259%    are:
  260%
  261%       !match          % Last event starting <match>
  262%       !n              % Event nr. <n>
  263%       !!              % last event
  264%
  265%    Note: the first character after a '!' should be a letter or number to
  266%    avoid problems with the cut.
  267
  268expand_history(Raw, Expanded, Changed) :-
  269    atom_chars(Raw, RawString),
  270    expand_history2(RawString, ExpandedString, Changed),
  271    atom_chars(Expanded, ExpandedString),
  272    !.
  273
  274expand_history2([!], [!], false) :- !.
  275expand_history2([!, C|Rest], [!|Expanded], Changed) :-
  276    not_event_char(C),
  277    !,
  278    expand_history2([C|Rest], Expanded, Changed).
  279expand_history2([!|Rest], Expanded, true) :-
  280    !,
  281    match_event(Rest, Event, NewRest),
  282    '$append'(Event, RestExpanded, Expanded),
  283    !,
  284    expand_history2(NewRest, RestExpanded, _).
  285expand_history2(['\''|In], ['\''|Out], Changed) :-
  286    !,
  287    skip_quoted(In, '\'', Out, Tin, Tout),
  288    expand_history2(Tin, Tout, Changed).
  289expand_history2(['"'|In], ['"'|Out], Changed) :-
  290    !,
  291    skip_quoted(In, '"', Out, Tin, Tout),
  292    expand_history2(Tin, Tout, Changed).
  293expand_history2([H|T], [H|R], Changed) :-
  294    !,
  295    expand_history2(T, R, Changed).
  296expand_history2([], [], false).
  297
  298skip_quoted([Q|T],Q,[Q|R], T, R) :- !.
  299skip_quoted([\,Q|T0],Q,[\,Q|T], In, Out) :-
  300    !,
  301    skip_quoted(T0, Q, T, In, Out).
  302skip_quoted([Q,Q|T0],Q,[Q,Q|T], In, Out) :-
  303    !,
  304    skip_quoted(T0, Q, T, In, Out).
  305skip_quoted([C|T0],Q,[C|T], In, Out) :-
  306    !,
  307    skip_quoted(T0, Q, T, In, Out).
  308skip_quoted([], _, [], [], []).
  309
  310%   get_last_event(-String)
  311%   return last event typed as a string
  312
  313get_last_event(Event) :-
  314    '$history'(_, Atom),
  315    atom_chars(Atom, Event),
  316    !.
  317get_last_event(_) :-
  318    print_message(query, history(no_event)),
  319    fail.
  320
  321%   match_event(+Spec, -Event, -Rest)
  322%   Use Spec as a specification of and event and return the event as Event
  323%   and what is left of Spec as Rest.
  324
  325match_event(Spec, Event, Rest) :-
  326    find_event(Spec, Event, Rest),
  327    !.
  328match_event(_, _, _) :-
  329    print_message(query, history(no_event)),
  330    fail.
  331
  332not_event_char(C) :- code_type(C, csym), !, fail.
  333not_event_char(!) :- !, fail.
  334not_event_char(_).
  335
  336find_event([!|Left], Event, Left) :-
  337    !,
  338    get_last_event(Event).
  339find_event([N|Rest], Event, Left) :-
  340    code_type(N, digit),
  341    !,
  342    take_number([N|Rest], String, Left),
  343    number_codes(Number, String),
  344    '$history'(Number, Atom),
  345    atom_chars(Atom, Event).
  346find_event(Spec, Event, Left) :-
  347    take_string(Spec, String, Left),
  348    matching_event(String, Event).
  349
  350take_string([C|Rest], [C|String], Left) :-
  351    code_type(C, csym),
  352    !,
  353    take_string(Rest, String, Left).
  354take_string([C|Rest], [], [C|Rest]) :- !.
  355take_string([], [], []).
  356
  357take_number([C|Rest], [C|String], Left) :-
  358    code_type(C, digit),
  359    !,
  360    take_string(Rest, String, Left).
  361take_number([C|Rest], [], [C|Rest]) :- !.
  362take_number([], [], []).
  363
  364%   matching_event(+String, -Event)
  365%
  366%   Return first event with prefix String as a Prolog string.
  367
  368matching_event(String, Event) :-
  369    '$history'(_, AtomEvent),
  370    atom_chars(AtomEvent, Event),
  371    '$append'(String, _, Event),
  372    !