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