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 ]).
When read_history reads a term of the form $silent(Goal), it will
call Goal and pretend it has not seen anything. This hook is used by
the GNU-Emacs interface to for communication between GNU-EMACS and
SWI-Prolog.
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'(_,_)).
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'.
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 !.
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'(_).
no_save.193save_event(Event, Options) :- 194 '$option'(no_save(Dont), Options), 195 memberchk(Event, Dont), 196 !. 197save_event(Event, _) :- 198 '$save_history_event'(Event).
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 !