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    !.