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 ( '$select'(variable_names(Bindings), Options, Options1) 84 -> true 85 ; Options1 = Options, 86 i(Bindings) % ignore 87 ), 88 catch(read_term_from_atom(Expanded, Term0, 89 [ module(Module), 90 variable_names(Bindings0) 91 | Options1 92 ]), 93 E, 94 ( print_message(error, E), 95 fail 96 )), 97 ( var(Term0) 98 -> Term = Term0, 99 Bindings = Bindings0 100 ; Term0 = '$silent'(Goal) 101 -> user:ignore(Goal), 102 read_term_with_history(Term, Options) 103 ; save_event(Expanded, Options), 104 ( Changed == true 105 -> print_message(query, history(expanded(Expanded))) 106 ; true 107 ), 108 Term = Term0, 109 Bindings = Bindings0 110 ). 111 112i(_). 113 114% list_history 115% Write history events to the current output stream. 116 117list_history :- 118 ( '$history'(Last, _) 119 -> true 120 ; Last = 0 121 ), 122 history_depth_(Depth), 123 plus(First, Depth, Last), 124 findall(Nr/Event, 125 ( between(First, Last, Nr), 126 '$history'(Nr, Event) 127 ), 128 Events), 129 print_message(query, history(history(Events))). 130 131'$clean_history' :- 132 retractall('$history'(_,_)).
138'$load_history' :- 139 '$clean_history', 140 current_prolog_flag(history, Depth), 141 Depth > 0, 142 catch(prolog:history(current_input, load), _, true), !. 143'$load_history'.
150prompt_history('') :- 151 !, 152 ttyflush. 153prompt_history(Prompt) :- 154 ( '$history'(Last, _) 155 -> This is Last + 1 156 ; This = 1 157 ), 158 atom_codes(Prompt, SP), 159 atom_codes(This, ST), 160 ( atom_codes('~!', Repl), 161 substitute(Repl, ST, SP, String) 162 -> prompt1(String) 163 ; prompt1(Prompt) 164 ), 165 ttyflush. 166 167% substitute(+Old, +New, +String, -Substituted) 168% substitute first occurence of Old in String by New 169 170substitute(Old, New, String, Substituted) :- 171 '$append'(Head, OldAndTail, String), 172 '$append'(Old, Tail, OldAndTail), 173 !, 174 '$append'(Head, New, HeadAndNew), 175 '$append'(HeadAndNew, Tail, Substituted), 176 !.
182:- multifile 183 prolog:history_line/2. 184 185'$save_history_line'(end_of_file) :- !. 186'$save_history_line'(Line) :- 187 format(string(CompleteLine), '~W~W', 188 [ Line, [partial(true)], 189 '.', [partial(true)] 190 ]), 191 catch(prolog:history(user_input, add(CompleteLine)), _, fail), 192 !. 193'$save_history_line'(_).
no_save.200save_event(Event, Options) :- 201 '$option'(no_save(Dont), Options), 202 memberchk(Event, Dont), 203 !. 204save_event(Event, _) :- 205 '$save_history_event'(Event).
215:- thread_local 216 '$history'/2. 217 218'$save_history_event'(Num-String) :- 219 integer(Num), string(String), 220 !, 221 asserta('$history'(Num, String)), 222 truncate_history(Num). 223'$save_history_event'(Event) :- 224 to_string(Event, Event1), 225 !, 226 last_event(Num, String), 227 ( Event1 == String 228 -> true 229 ; New is Num + 1, 230 asserta('$history'(New, Event1)), 231 truncate_history(New) 232 ). 233'$save_history_event'(Event) :- 234 '$type_error'(history_event, Event). 235 236last_event(Num, String) :- 237 '$history'(Num, String), 238 !. 239last_event(0, ""). 240 241to_string(String, String) :- 242 string(String), 243 !. 244to_string(Atom, String) :- 245 atom_string(Atom, String). 246 247truncate_history(New) :- 248 history_depth_(Depth), 249 remove_history(New, Depth). 250 251remove_history(New, Depth) :- 252 New - Depth =< 0, 253 !. 254remove_history(New, Depth) :- 255 Remove is New - Depth, 256 retract('$history'(Remove, _)), 257 !. 258remove_history(_, _). 259 260% history_depth_(-Depth) 261% Define the depth to which to keep the history. 262 263history_depth_(N) :- 264 current_prolog_flag(history, N), 265 integer(N), 266 N > 0, 267 !. 268history_depth_(25). 269 270% expand_history(+Raw, -Expanded) 271% Expand Raw using the available history list. Expandations performed 272% are: 273% 274% !match % Last event starting <match> 275% !n % Event nr. <n> 276% !! % last event 277% 278% Note: the first character after a '!' should be a letter or number to 279% avoid problems with the cut. 280 281expand_history(Raw, Expanded, Changed) :- 282 atom_chars(Raw, RawString), 283 expand_history2(RawString, ExpandedString, Changed), 284 atom_chars(Expanded, ExpandedString), 285 !. 286 287expand_history2([!], [!], false) :- !. 288expand_history2([!, C|Rest], [!|Expanded], Changed) :- 289 not_event_char(C), 290 !, 291 expand_history2([C|Rest], Expanded, Changed). 292expand_history2([!|Rest], Expanded, true) :- 293 !, 294 match_event(Rest, Event, NewRest), 295 '$append'(Event, RestExpanded, Expanded), 296 !, 297 expand_history2(NewRest, RestExpanded, _). 298expand_history2(['\''|In], ['\''|Out], Changed) :- 299 !, 300 skip_quoted(In, '\'', Out, Tin, Tout), 301 expand_history2(Tin, Tout, Changed). 302expand_history2(['"'|In], ['"'|Out], Changed) :- 303 !, 304 skip_quoted(In, '"', Out, Tin, Tout), 305 expand_history2(Tin, Tout, Changed). 306expand_history2([H|T], [H|R], Changed) :- 307 !, 308 expand_history2(T, R, Changed). 309expand_history2([], [], false). 310 311skip_quoted([Q|T],Q,[Q|R], T, R) :- !. 312skip_quoted([\,Q|T0],Q,[\,Q|T], In, Out) :- 313 !, 314 skip_quoted(T0, Q, T, In, Out). 315skip_quoted([Q,Q|T0],Q,[Q,Q|T], In, Out) :- 316 !, 317 skip_quoted(T0, Q, T, In, Out). 318skip_quoted([C|T0],Q,[C|T], In, Out) :- 319 !, 320 skip_quoted(T0, Q, T, In, Out). 321skip_quoted([], _, [], [], []). 322 323% get_last_event(-String) 324% return last event typed as a string 325 326get_last_event(Event) :- 327 '$history'(_, Atom), 328 atom_chars(Atom, Event), 329 !. 330get_last_event(_) :- 331 print_message(query, history(no_event)), 332 fail. 333 334% match_event(+Spec, -Event, -Rest) 335% Use Spec as a specification of and event and return the event as Event 336% and what is left of Spec as Rest. 337 338match_event(Spec, Event, Rest) :- 339 find_event(Spec, Event, Rest), 340 !. 341match_event(_, _, _) :- 342 print_message(query, history(no_event)), 343 fail. 344 345not_event_char(C) :- code_type(C, csym), !, fail. 346not_event_char(!) :- !, fail. 347not_event_char(_). 348 349find_event([!|Left], Event, Left) :- 350 !, 351 get_last_event(Event). 352find_event([N|Rest], Event, Left) :- 353 code_type(N, digit), 354 !, 355 take_number([N|Rest], String, Left), 356 number_codes(Number, String), 357 '$history'(Number, Atom), 358 atom_chars(Atom, Event). 359find_event(Spec, Event, Left) :- 360 take_string(Spec, String, Left), 361 matching_event(String, Event). 362 363take_string([C|Rest], [C|String], Left) :- 364 code_type(C, csym), 365 !, 366 take_string(Rest, String, Left). 367take_string([C|Rest], [], [C|Rest]) :- !. 368take_string([], [], []). 369 370take_number([C|Rest], [C|String], Left) :- 371 code_type(C, digit), 372 !, 373 take_string(Rest, String, Left). 374take_number([C|Rest], [], [C|Rest]) :- !. 375take_number([], [], []). 376 377% matching_event(+String, -Event) 378% 379% Return first event with prefix String as a Prolog string. 380 381matching_event(String, Event) :- 382 '$history'(_, AtomEvent), 383 atom_chars(AtomEvent, Event), 384 '$append'(String, _, Event), 385 !