View source with formatted comments or as raw
    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)  2017-2020, VU University Amsterdam
    7                              CWI Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(editline,
   37          [ el_wrap/0,				% wrap user_input, etc.
   38            el_wrap/4,                          % +Prog, +Input, +Output, +Error
   39            el_wrapped/1,                       % +Input
   40            el_unwrap/1,			% +Input
   41
   42            el_source/2,			% +Input, +File
   43            el_bind/2,                          % +Input, +Args
   44            el_addfn/4,                         % +Input, +Name, +Help, :Goal
   45            el_cursor/2,                        % +Input, +Move
   46            el_line/2,                          % +Input, -Line
   47            el_insertstr/2,                     % +Input, +Text
   48            el_deletestr/2,                     % +Input, +Count
   49
   50            el_history/2,                       % +Input, ?Action
   51            el_history_events/2,                % +Input, -Events
   52            el_add_history/2,                   % +Input, +Line
   53            el_write_history/2,                 % +Input, +FileName
   54            el_read_history/2                   % +Input, +FileName
   55          ]).   56:- autoload(library(apply),[maplist/2,maplist/3]).   57:- autoload(library(lists),[reverse/2,max_list/2,append/3,member/2]).   58:- autoload(library(solution_sequences),[call_nth/2]).   59
   60
   61editline_ok :-
   62    \+ current_prolog_flag(console_menu_version, qt),
   63    \+ current_prolog_flag(readline, readline),
   64    stream_property(user_input, tty(true)).
   65
   66:- use_foreign_library(foreign(libedit4pl)).   67
   68:- if(editline_ok).   69:- initialization el_wrap.   70:- endif.   71
   72:- meta_predicate
   73    el_addfn(+,+,+,3).   74
   75:- multifile
   76    el_setup/1,                         % +Input
   77    prolog:complete_input/4.   78
   79
   80/** <module> BSD libedit based command line editing
   81
   82This library wraps the BSD  libedit   command  line  editor. The binding
   83provides a high level API to enable   command line editing on the Prolog
   84user streams and low level predicates  to   apply  the  library on other
   85streams and program the library.
   86*/
   87
   88%!  el_wrap is det.
   89%
   90%   Enable using editline on the standard   user streams if `user_input`
   91%   is connected to a terminal. This is   the  high level predicate used
   92%   for most purposes. The remainder of the library interface deals with
   93%   low level predicates  that  allows   for  applying  and  programming
   94%   libedit in non-standard situations.
   95%
   96%   The library is registered  with  _ProgName_   set  to  =swipl=  (see
   97%   el_wrap/4).
   98
   99el_wrap :-
  100    el_wrapped(user_input),
  101    !.
  102el_wrap :-
  103    stream_property(user_input, tty(true)), !,
  104    el_wrap(swipl, user_input, user_output, user_error),
  105    add_prolog_commands(user_input),
  106    forall(el_setup(user_input), true).
  107el_wrap.
  108
  109add_prolog_commands(Input) :-
  110    el_addfn(Input, complete, 'Complete atoms and files', complete),
  111    el_addfn(Input, show_completions, 'List completions', show_completions),
  112    el_addfn(Input, electric, 'Indicate matching bracket', electric),
  113    el_addfn(Input, isearch_history, 'Incremental search in history',
  114             isearch_history),
  115    el_bind(Input, ["^I",  complete]),
  116    el_bind(Input, ["^[?", show_completions]),
  117    el_bind(Input, ["^R",  isearch_history]),
  118    bind_electric(Input),
  119    el_source(Input, _).
  120
  121%!  el_wrap(+ProgName:atom, +In:stream, +Out:stream, +Error:stream) is det.
  122%
  123%   Enable editline on  the  stream-triple   <In,Out,Error>.  From  this
  124%   moment on In is a handle to the command line editor.
  125%
  126%   @arg ProgName is the name of the invoking program, used when reading
  127%   the editrc(5) file to determine which settings to use.
  128
  129%!  el_setup(+In:stream) is nondet.
  130%
  131%   This hooks is called as   forall(el_setup(Input),  true) _after_ the
  132%   input stream has been wrapped, the default Prolog commands have been
  133%   added and the  default  user  setup   file  has  been  sourced using
  134%   el_source/2. It can be used to define and bind additional commands.
  135
  136%!  el_wrapped(+In:stream) is semidet.
  137%
  138%   True if In is a stream wrapped by el_wrap/3.
  139
  140%!  el_unwrap(+In:stream) is det.
  141%
  142%   Remove the libedit wrapper for In and   the related output and error
  143%   streams.
  144%
  145%   @bug The wrapper creates =|FILE*|= handles that cannot be closed and
  146%   thus wrapping and unwrapping implies a (modest) memory leak.
  147
  148%!  el_source(+In:stream, +File) is det.
  149%
  150%   Initialise editline by reading the contents of File.  If File is
  151%   unbound try =|$HOME/.editrc|=
  152
  153
  154%!  el_bind(+In:stream, +Args) is det.
  155%
  156%   Invoke the libedit `bind` command  with   the  given  arguments. The
  157%   example below lists the current key bindings.
  158%
  159%   ```
  160%   ?- el_bind(user_input, ['-a']).
  161%   ```
  162%
  163%   The predicate el_bind/2 is typically used   to bind commands defined
  164%   using el_addfn/4. Note that the C proxy   function has only the last
  165%   character of the command as context to find the Prolog binding. This
  166%   implies we cannot both  bind  e.g.,  "^[?"  *and  "?"  to  a  Prolog
  167%   function.
  168%
  169%   @see editrc(5) for more information.
  170
  171%!  el_addfn(+Input:stream, +Command, +Help, :Goal) is det.
  172%
  173%   Add a new command to the command  line editor associated with Input.
  174%   Command is the name of the command,  Help is the help string printed
  175%   with e.g. =|bind -a|= (see el_bind/2)  and   Goal  is  called of the
  176%   associated key-binding is activated.  Goal is called as
  177%
  178%       call(:Goal, +Input, +Char, -Continue)
  179%
  180%   where Input is the input stream providing access to the editor, Char
  181%   the activating character and Continue must   be instantated with one
  182%   of the known continuation  codes  as   defined  by  libedit: `norm`,
  183%   `newline`, `eof`, `arghack`, `refresh`,   `refresh_beep`,  `cursor`,
  184%   `redisplay`, `error` or `fatal`. In addition, the following Continue
  185%   code is provided.
  186%
  187%     * electric(Move, TimeOut, Continue)
  188%     Show _electric caret_ at Move positions to the left of the normal
  189%     cursor positions for the given TimeOut.  Continue as defined by
  190%     the Continue value.
  191%
  192%   The registered Goal typically used el_line/2 to fetch the input line
  193%   and el_cursor/2, el_insertstr/2 and/or  el_deletestr/2 to manipulate
  194%   the input line.
  195%
  196%   Normally el_bind/2 is used to associate   the defined command with a
  197%   keyboard sequence.
  198%
  199%   @see el_set(3) =EL_ADDFN= for details.
  200
  201%!  el_line(+Input:stream, -Line) is det.
  202%
  203%   Fetch the currently buffered input line. Line is a term line(Before,
  204%   After), where `Before` is  a  string   holding  the  text before the
  205%   cursor and `After` is a string holding the text after the cursor.
  206
  207%!  el_cursor(+Input:stream, +Move:integer) is det.
  208%
  209%   Move the cursor Move  character   forwards  (positive)  or backwards
  210%   (negative).
  211
  212%!  el_insertstr(+Input:stream, +Text) is det.
  213%
  214%   Insert Text at the cursor.
  215
  216%!  el_deletestr(+Input:stream, +Count) is det.
  217%
  218%   Delete Count characters before the cursor.
  219
  220%!  el_history(+In:stream, ?Action) is det.
  221%
  222%   Perform a generic action on the history. This provides an incomplete
  223%   interface to history() from libedit.  Supported actions are:
  224%
  225%     * clear
  226%     Clear the history.
  227%     * setsize(+Integer)
  228%     Set size of history to size elements.
  229%     * setunique(+Boolean)
  230%     Set flag that adjacent identical event strings should not be
  231%     entered into the history.
  232
  233%!  el_history_events(+In:stream, -Events:list(pair)) is det.
  234%
  235%   Unify Events with a list of pairs   of  the form `Num-String`, where
  236%   `Num` is the event number  and   `String`  is  the associated string
  237%   without terminating newline.
  238
  239%!  el_add_history(+In:stream, +Line:text) is det.
  240%
  241%   Add a line to the command line history.
  242
  243%!  el_read_history(+In:stream, +File:file) is det.
  244%
  245%   Read the history saved using el_write_history/2.
  246%
  247%   @arg File is a file specification for absolute_file_name/3.
  248
  249%!  el_write_history(+In:stream, +File:file) is det.
  250%
  251%   Save editline history to File.  The   history  may be reloaded using
  252%   el_read_history/2.
  253%
  254%   @arg File is a file specification for absolute_file_name/3.
  255
  256
  257:- multifile
  258    prolog:history/2.  259
  260prolog:history(Input, add(Line)) :-
  261    el_add_history(Input, Line).
  262prolog:history(Input, load(File)) :-
  263    el_read_history(Input, File).
  264prolog:history(Input, save(File)) :-
  265    el_write_history(Input, File).
  266prolog:history(Input, load) :-
  267    el_history_events(Input, Events),
  268    '$reverse'(Events, RevEvents),
  269    forall('$member'(Ev, RevEvents),
  270           add_event(Ev)).
  271
  272add_event(Num-String) :-
  273    remove_dot(String, String1),
  274    '$save_history_event'(Num-String1).
  275
  276remove_dot(String0, String) :-
  277    string_concat(String, ".", String0),
  278    !.
  279remove_dot(String, String).
  280
  281
  282		 /*******************************
  283		 *        ELECTRIC CARET	*
  284		 *******************************/
  285
  286%!  bind_electric(+Input) is det.
  287%
  288%   Bind known close statements for electric input
  289
  290bind_electric(Input) :-
  291    forall(bracket(_Open, Close), bind_code(Input, Close, electric)),
  292    forall(quote(Close), bind_code(Input, Close, electric)).
  293
  294bind_code(Input, Code, Command) :-
  295    string_codes(Key, [Code]),
  296    el_bind(Input, [Key, Command]).
  297
  298
  299%!  electric(+Input, +Char, -Continue) is det.
  300
  301electric(Input, Char, Continue) :-
  302    string_codes(Str, [Char]),
  303    el_insertstr(Input, Str),
  304    el_line(Input, line(Before, _)),
  305    (   string_codes(Before, Codes),
  306        nesting(Codes, 0, Nesting),
  307        reverse(Nesting, [Close|RevNesting])
  308    ->  (   Close = open(_,_)                   % open quote
  309        ->  Continue = refresh
  310        ;   matching_open(RevNesting, Close, _, Index)
  311        ->  string_length(Before, Len),         % Proper match
  312            Move is Index-Len,
  313            Continue = electric(Move, 500, refresh)
  314        ;   Continue = refresh_beep             % Not properly nested
  315        )
  316    ;   Continue = refresh_beep
  317    ).
  318
  319matching_open_index(String, Index) :-
  320    string_codes(String, Codes),
  321    nesting(Codes, 0, Nesting),
  322    reverse(Nesting, [Close|RevNesting]),
  323    matching_open(RevNesting, Close, _, Index).
  324
  325matching_open([Open|Rest], Close, Rest, Index) :-
  326    Open = open(Index,_),
  327    match(Open, Close),
  328    !.
  329matching_open([Close1|Rest1], Close, Rest, Index) :-
  330    Close1 = close(_,_),
  331    matching_open(Rest1, Close1, Rest2, _),
  332    matching_open(Rest2, Close, Rest, Index).
  333
  334match(open(_,Open),close(_,Close)) :-
  335    (   bracket(Open, Close)
  336    ->  true
  337    ;   Open == Close,
  338        quote(Open)
  339    ).
  340
  341bracket(0'(, 0')).
  342bracket(0'[, 0']).
  343bracket(0'{, 0'}).
  344
  345quote(0'\').
  346quote(0'\").
  347quote(0'\`).
  348
  349nesting([], _, []).
  350nesting([H|T], I, Nesting) :-
  351    (   bracket(H, _Close)
  352    ->  Nesting = [open(I,H)|Nest]
  353    ;   bracket(_Open, H)
  354    ->  Nesting = [close(I,H)|Nest]
  355    ),
  356    !,
  357    I2 is I+1,
  358    nesting(T, I2, Nest).
  359nesting([0'0, 0'\'|T], I, Nesting) :-
  360    !,
  361    phrase(skip_code, T, T1),
  362    difflist_length(T, T1, Len),
  363    I2 is I+Len+2,
  364    nesting(T1, I2, Nesting).
  365nesting([H|T], I, Nesting) :-
  366    quote(H),
  367    !,
  368    (   phrase(skip_quoted(H), T, T1)
  369    ->  difflist_length(T, T1, Len),
  370        I2 is I+Len+1,
  371        Nesting = [open(I,H),close(I2,H)|Nest],
  372        nesting(T1, I2, Nest)
  373    ;   Nesting = [open(I,H)]                   % Open quote
  374    ).
  375nesting([_|T], I, Nesting) :-
  376    I2 is I+1,
  377    nesting(T, I2, Nesting).
  378
  379difflist_length(List, Tail, Len) :-
  380    difflist_length(List, Tail, 0, Len).
  381
  382difflist_length(List, Tail, Len0, Len) :-
  383    List == Tail,
  384    !,
  385    Len = Len0.
  386difflist_length([_|List], Tail, Len0, Len) :-
  387    Len1 is Len0+1,
  388    difflist_length(List, Tail, Len1, Len).
  389
  390skip_quoted(H) -->
  391    [H],
  392    !.
  393skip_quoted(H) -->
  394    "\\", [H],
  395    !,
  396    skip_quoted(H).
  397skip_quoted(H) -->
  398    [_],
  399    skip_quoted(H).
  400
  401skip_code -->
  402    "\\", [_],
  403    !.
  404skip_code -->
  405    [_].
  406
  407
  408		 /*******************************
  409		 *           COMPLETION		*
  410		 *******************************/
  411
  412%!  complete(+Input, +Char, -Continue) is det.
  413%
  414%   Implementation of the registered `complete`   editline function. The
  415%   predicate is called with three arguments,  the first being the input
  416%   stream used to access  the  libedit   functions  and  the second the
  417%   activating character. The last argument tells   libedit  what to do.
  418%   Consult el_set(3), =EL_ADDFN= for details.
  419
  420
  421:- dynamic
  422    last_complete/2.  423
  424complete(Input, _Char, Continue) :-
  425    el_line(Input, line(Before, After)),
  426    ensure_input_completion,
  427    prolog:complete_input(Before, After, Delete, Completions),
  428    (   Completions = [One]
  429    ->  string_length(Delete, Len),
  430        el_deletestr(Input, Len),
  431        complete_text(One, Text),
  432        el_insertstr(Input, Text),
  433        Continue = refresh
  434    ;   Completions == []
  435    ->  Continue = refresh_beep
  436    ;   get_time(Now),
  437        retract(last_complete(TLast, Before)),
  438        Now - TLast < 2
  439    ->  nl(user_error),
  440        list_alternatives(Completions),
  441        Continue = redisplay
  442    ;   retractall(last_complete(_,_)),
  443        get_time(Now),
  444        asserta(last_complete(Now, Before)),
  445        common_competion(Completions, Extend),
  446        (   Delete == Extend
  447        ->  Continue = refresh_beep
  448        ;   string_length(Delete, Len),
  449            el_deletestr(Input, Len),
  450            el_insertstr(Input, Extend),
  451            Continue = refresh
  452        )
  453    ).
  454
  455:- dynamic
  456    input_completion_loaded/0.  457
  458ensure_input_completion :-
  459    input_completion_loaded,
  460    !.
  461ensure_input_completion :-
  462    predicate_property(prolog:complete_input(_,_,_,_),
  463                       number_of_clauses(N)),
  464    N > 0,
  465    !.
  466ensure_input_completion :-
  467    exists_source(library(console_input)),
  468    !,
  469    use_module(library(console_input), []),
  470    asserta(input_completion_loaded).
  471ensure_input_completion.
  472
  473
  474%!  show_completions(+Input, +Char, -Continue) is det.
  475%
  476%   Editline command to show possible completions.
  477
  478show_completions(Input, _Char, Continue) :-
  479    el_line(Input, line(Before, After)),
  480    prolog:complete_input(Before, After, _Delete, Completions),
  481    nl(user_error),
  482    list_alternatives(Completions),
  483    Continue = redisplay.
  484
  485complete_text(Text-_Comment, Text) :- !.
  486complete_text(Text, Text).
  487
  488%!  common_competion(+Alternatives, -Common) is det.
  489%
  490%   True when Common is the common prefix of all candidate Alternatives.
  491
  492common_competion(Alternatives, Common) :-
  493    maplist(atomic, Alternatives),
  494    !,
  495    common_prefix(Alternatives, Common).
  496common_competion(Alternatives, Common) :-
  497    maplist(complete_text, Alternatives, AltText),
  498    !,
  499    common_prefix(AltText, Common).
  500
  501%!  common_prefix(+Atoms, -Common) is det.
  502%
  503%   True when Common is the common prefix of all Atoms.
  504
  505common_prefix([A1|T], Common) :-
  506    common_prefix_(T, A1, Common).
  507
  508common_prefix_([], Common, Common).
  509common_prefix_([H|T], Common0, Common) :-
  510    common_prefix(H, Common0, Common1),
  511    common_prefix_(T, Common1, Common).
  512
  513%!  common_prefix(+A1, +A2, -Prefix:string) is det.
  514%
  515%   True when Prefix is the common prefix of the atoms A1 and A2
  516
  517common_prefix(A1, A2, Prefix) :-
  518    sub_atom(A1, 0, _, _, A2),
  519    !,
  520    Prefix = A2.
  521common_prefix(A1, A2, Prefix) :-
  522    sub_atom(A2, 0, _, _, A1),
  523    !,
  524    Prefix = A1.
  525common_prefix(A1, A2, Prefix) :-
  526    atom_codes(A1, C1),
  527    atom_codes(A2, C2),
  528    list_common_prefix(C1, C2, C),
  529    string_codes(Prefix, C).
  530
  531list_common_prefix([H|T0], [H|T1], [H|T]) :-
  532    !,
  533    list_common_prefix(T0, T1, T).
  534list_common_prefix(_, _, []).
  535
  536
  537
  538%!  list_alternatives(+Alternatives)
  539%
  540%   List possible completions at the current point.
  541%
  542%   @tbd currently ignores the Comment in Text-Comment alternatives.
  543
  544list_alternatives(Alternatives) :-
  545    maplist(atomic, Alternatives),
  546    !,
  547    length(Alternatives, Count),
  548    maplist(atom_length, Alternatives, Lengths),
  549    max_list(Lengths, Max),
  550    tty_size(_, Cols),
  551    ColW is Max+2,
  552    Columns is max(1, Cols // ColW),
  553    RowCount is (Count+Columns-1)//Columns,
  554    length(Rows, RowCount),
  555    to_matrix(Alternatives, Rows, Rows),
  556    (   RowCount > 11
  557    ->  length(First, 10),
  558        Skipped is RowCount - 10,
  559        append(First, _, Rows),
  560        maplist(write_row(ColW), First),
  561        format(user_error, '... skipped ~D rows~n', [Skipped])
  562    ;   maplist(write_row(ColW), Rows)
  563    ).
  564list_alternatives(Alternatives) :-
  565    maplist(complete_text, Alternatives, AltText),
  566    list_alternatives(AltText).
  567
  568to_matrix([], _, Rows) :-
  569    !,
  570    maplist(close_list, Rows).
  571to_matrix([H|T], [RH|RT], Rows) :-
  572    !,
  573    add_list(RH, H),
  574    to_matrix(T, RT, Rows).
  575to_matrix(List, [], Rows) :-
  576    to_matrix(List, Rows, Rows).
  577
  578add_list(Var, Elem) :-
  579    var(Var), !,
  580    Var = [Elem|_].
  581add_list([_|T], Elem) :-
  582    add_list(T, Elem).
  583
  584close_list(List) :-
  585    append(List, [], _),
  586    !.
  587
  588write_row(ColW, Row) :-
  589    length(Row, Columns),
  590    make_format(Columns, ColW, Format),
  591    format(user_error, Format, Row).
  592
  593make_format(N, ColW, Format) :-
  594    format(string(PerCol), '~~w~~t~~~d+', [ColW]),
  595    Front is N - 1,
  596    length(LF, Front),
  597    maplist(=(PerCol), LF),
  598    append(LF, ['~w~n'], Parts),
  599    atomics_to_string(Parts, Format).
  600
  601
  602		 /*******************************
  603		 *             SEARCH		*
  604		 *******************************/
  605
  606%!  isearch_history(+Input, +Char, -Continue) is det.
  607%
  608%   Incremental search through the history.  The behavior is based
  609%   on GNU readline.
  610
  611isearch_history(Input, _Char, Continue) :-
  612    el_line(Input, line(Before, After)),
  613    string_concat(Before, After, Current),
  614    string_length(Current, Len),
  615    search_print('', "", Current),
  616    search(Input, "", Current, 1, Line),
  617    el_deletestr(Input, Len),
  618    el_insertstr(Input, Line),
  619    Continue = redisplay.
  620
  621search(Input, For, Current, Nth, Line) :-
  622    el_getc(Input, Next),
  623    Next \== -1,
  624    !,
  625    search(Next, Input, For, Current, Nth, Line).
  626search(_Input, _For, _Current, _Nth, "").
  627
  628search(7, _Input, _, Current, _, Current) :-    % C-g: abort
  629    !,
  630    clear_line.
  631search(18, Input, For, Current, Nth, Line) :-   % C-r: search previous
  632    !,
  633    N2 is Nth+1,
  634    search_(Input, For, Current, N2, Line).
  635search(19, Input, For, Current, Nth, Line) :-   % C-s: search next
  636    !,
  637    N2 is max(1,Nth-1),
  638    search_(Input, For, Current, N2, Line).
  639search(127, Input, For, Current, _Nth, Line) :- % DEL/BS: shorten search
  640    sub_string(For, 0, _, 1, For1),
  641    !,
  642    search_(Input, For1, Current, 1, Line).
  643search(Char, Input, For, Current, Nth, Line) :-
  644    code_type(Char, cntrl),
  645    !,
  646    search_end(Input, For, Current, Nth, Line),
  647    el_push(Input, Char).
  648search(Char, Input, For, Current, _Nth, Line) :-
  649    format(string(For1), '~w~c', [For,Char]),
  650    search_(Input, For1, Current, 1, Line).
  651
  652search_(Input, For1, Current, Nth, Line) :-
  653    (   find_in_history(Input, For1, Current, Nth, Candidate)
  654    ->  search_print('', For1, Candidate)
  655    ;   search_print('failed ', For1, Current)
  656    ),
  657    search(Input, For1, Current, Nth, Line).
  658
  659search_end(Input, For, Current, Nth, Line) :-
  660    (   find_in_history(Input, For, Current, Nth, Line)
  661    ->  true
  662    ;   Line = Current
  663    ),
  664    clear_line.
  665
  666find_in_history(_, "", Current, _, Current) :-
  667    !.
  668find_in_history(Input, For, _, Nth, Line) :-
  669    el_history_events(Input, History),
  670    call_nth(( member(_N-Line, History),
  671               sub_string(Line, _, _, _, For)
  672             ),
  673             Nth),
  674    !.
  675
  676search_print(State, Search, Current) :-
  677    format(user_error, '\r(~wreverse-i-search)`~w\': ~w\e[0K',
  678           [State, Search, Current]).
  679
  680clear_line :-
  681    format(user_error, '\r\e[0K', [])