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