36
37:- module(editline,
38 [ el_wrap/0, 39 el_wrap/1, 40 el_wrap/4, 41 el_wrap/5, 42 el_wrapped/1, 43 el_unwrap/1, 44
45 el_source/2, 46 el_bind/2, 47 el_addfn/4, 48 el_cursor/2, 49 el_line/2, 50 el_insertstr/2, 51 el_deletestr/2, 52
53 el_history/2, 54 el_history_events/2, 55 el_add_history/2, 56 el_write_history/2, 57 el_read_history/2, 58
59 el_version/1 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, 74 prolog:complete_input/4. 75
76
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
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
143
144el_wrap(ProgName, In, Out, Error) :-
145 el_wrap(ProgName, In, Out, Error, []).
146
153
157
165
170
171
188
218
224
229
233
237
250
256
260
266
273
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
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 316
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
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(_,_) 340 -> Continue = refresh
341 ; matching_open(RevNesting, Close, _, Index)
342 -> string_length(Before, Len), 343 Move is Index-Len,
344 Continue = electric(Move, 500, refresh)
345 ; Continue = refresh_beep 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)] 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 442
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
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
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
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
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
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 636
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) :- 660 !,
661 clear_line.
662search(18, Input, For, Current, Nth, Line) :- 663 !,
664 N2 is Nth+1,
665 search_(Input, For, Current, N2, Line).
666search(19, Input, For, Current, Nth, Line) :- 667 !,
668 N2 is max(1,Nth-1),
669 search_(Input, For, Current, N2, Line).
670search(127, Input, For, Current, _Nth, Line) :- 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 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
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("")