35
36:- module(editline,
37 [ el_wrap/0, 38 el_wrap/4, 39 el_wrapped/1, 40 el_unwrap/1, 41
42 el_source/2, 43 el_bind/2, 44 el_addfn/4, 45 el_cursor/2, 46 el_line/2, 47 el_insertstr/2, 48 el_deletestr/2, 49
50 el_history/2, 51 el_history_events/2, 52 el_add_history/2, 53 el_write_history/2, 54 el_read_history/2 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, 77 prolog:complete_input/4. 78
79
87
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
128
135
139
147
152
153
170
200
206
211
215
219
232
238
242
248
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 285
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
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(_,_) 309 -> Continue = refresh
310 ; matching_open(RevNesting, Close, _, Index)
311 -> string_length(Before, Len), 312 Move is Index-Len,
313 Continue = electric(Move, 500, refresh)
314 ; Continue = refresh_beep 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)] 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 411
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
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
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
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
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
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 605
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) :- 629 !,
630 clear_line.
631search(18, Input, For, Current, Nth, Line) :- 632 !,
633 N2 is Nth+1,
634 search_(Input, For, Current, N2, Line).
635search(19, Input, For, Current, Nth, Line) :- 636 !,
637 N2 is max(1,Nth-1),
638 search_(Input, For, Current, N2, Line).
639search(127, Input, For, Current, _Nth, Line) :- 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', [])