36
37:- module(ansi_term,
38 [ ansi_format/3, 39 ansi_get_color/2, 40 ansi_hyperlink/2, 41 ansi_hyperlink/3 42 ]). 43:- autoload(library(error), [domain_error/2, must_be/2, instantiation_error/1]). 44:- autoload(library(lists), [append/3]). 45:- autoload(library(utf8), [utf8_codes/3]). 46
69
70:- multifile
71 prolog:console_color/2, 72 supports_get_color/0,
73 hyperlink/2, 74 tty_url_hook/2. 75
76color_term_flag_default(true) :-
77 stream_property(user_input, tty(true)),
78 stream_property(user_error, tty(true)),
79 stream_property(user_output, tty(true)),
80 \+ getenv('TERM', dumb),
81 !.
82color_term_flag_default(false).
83
84init_color_term_flag :-
85 color_term_flag_default(Default),
86 create_prolog_flag(color_term, Default,
87 [ type(boolean),
88 keep(true)
89 ]),
90 create_prolog_flag(hyperlink_term, false,
91 [ type(boolean),
92 keep(true)
93 ]).
94
95:- init_color_term_flag. 96
97
98:- meta_predicate
99 keep_line_pos(+, 0). 100
101:- multifile
102 user:message_property/2. 103
143
144ansi_format(Attr, Format, Args) :-
145 ansi_format(current_output, Attr, Format, Args).
146
147ansi_format(Stream, Class, Format, Args) :-
148 stream_property(Stream, tty(true)),
149 current_prolog_flag(color_term, true),
150 !,
151 class_attrs(Class, Attr),
152 phrase(sgr_codes_ex(Attr), Codes),
153 atomic_list_concat(Codes, ;, Code),
154 with_output_to(
155 Stream,
156 ( keep_line_pos(current_output, format('\e[~wm', [Code])),
157 format(Format, Args),
158 keep_line_pos(current_output, format('\e[0m'))
159 )
160 ),
161 flush_output.
162ansi_format(Stream, _Attr, Format, Args) :-
163 format(Stream, Format, Args).
164
165sgr_codes_ex(X) -->
166 { var(X),
167 !,
168 instantiation_error(X)
169 }.
170sgr_codes_ex([]) -->
171 !.
172sgr_codes_ex([H|T]) -->
173 !,
174 sgr_codes_ex(H),
175 sgr_codes_ex(T).
176sgr_codes_ex(Attr) -->
177 ( { sgr_code(Attr, Code) }
178 -> ( { is_list(Code) }
179 -> list(Code)
180 ; [Code]
181 )
182 ; { domain_error(sgr_code, Attr) }
183 ).
184
185list([]) --> [].
186list([H|T]) --> [H], list(T).
187
188
227
228sgr_code(reset, 0).
229sgr_code(bold, 1).
230sgr_code(faint, 2).
231sgr_code(italic, 3).
232sgr_code(underline, 4).
233sgr_code(blink(slow), 5).
234sgr_code(blink(rapid), 6).
235sgr_code(negative, 7).
236sgr_code(conceal, 8).
237sgr_code(crossed_out, 9).
238sgr_code(font(primary), 10) :- !.
239sgr_code(font(N), C) :-
240 C is 10+N.
241sgr_code(fraktur, 20).
242sgr_code(underline(double), 21).
243sgr_code(intensity(normal), 22).
244sgr_code(fg(Name), C) :-
245 ( ansi_color(Name, N)
246 -> C is N+30
247 ; rgb(Name, R, G, B)
248 -> sgr_code(fg(R,G,B), C)
249 ).
250sgr_code(bg(Name), C) :-
251 !,
252 ( ansi_color(Name, N)
253 -> C is N+40
254 ; rgb(Name, R, G, B)
255 -> sgr_code(bg(R,G,B), C)
256 ).
257sgr_code(framed, 51).
258sgr_code(encircled, 52).
259sgr_code(overlined, 53).
260sgr_code(ideogram(underline), 60).
261sgr_code(right_side_line, 60).
262sgr_code(ideogram(underline(double)), 61).
263sgr_code(right_side_line(double), 61).
264sgr_code(ideogram(overlined), 62).
265sgr_code(left_side_line, 62).
266sgr_code(ideogram(stress_marking), 64).
267sgr_code(-X, Code) :-
268 off_code(X, Code).
269sgr_code(hfg(Name), C) :-
270 ansi_color(Name, N),
271 C is N+90.
272sgr_code(hbg(Name), C) :-
273 !,
274 ansi_color(Name, N),
275 C is N+100.
276sgr_code(fg8(Name), [38,5,N]) :-
277 ansi_color8(Name, N).
278sgr_code(bg8(Name), [48,5,N]) :-
279 ansi_color8(Name, N).
280sgr_code(fg(R,G,B), [38,2,R,G,B]) :-
281 between(0, 255, R),
282 between(0, 255, G),
283 between(0, 255, B).
284sgr_code(bg(R,G,B), [48,2,R,G,B]) :-
285 between(0, 255, R),
286 between(0, 255, G),
287 between(0, 255, B).
288
289off_code(italic_and_franktur, 23).
290off_code(underline, 24).
291off_code(blink, 25).
292off_code(negative, 27).
293off_code(conceal, 28).
294off_code(crossed_out, 29).
295off_code(framed, 54).
296off_code(overlined, 55).
297
298ansi_color8(h(Name), N) :-
299 !,
300 ansi_color(Name, N0),
301 N is N0+8.
302ansi_color8(Name, N) :-
303 atom(Name),
304 !,
305 ansi_color(Name, N).
306ansi_color8(N, N) :-
307 between(0, 255, N).
308
309ansi_color(black, 0).
310ansi_color(red, 1).
311ansi_color(green, 2).
312ansi_color(yellow, 3).
313ansi_color(blue, 4).
314ansi_color(magenta, 5).
315ansi_color(cyan, 6).
316ansi_color(white, 7).
317ansi_color(default, 9).
318
319rgb(Name, R, G, B) :-
320 atom_codes(Name, [0'#,R1,R2,G1,G2,B1,B2]),
321 hex_color(R1,R2,R),
322 hex_color(G1,G2,G),
323 hex_color(B1,B2,B).
324rgb(Name, R, G, B) :-
325 atom_codes(Name, [0'#,R1,G1,B1]),
326 hex_color(R1,R),
327 hex_color(G1,G),
328 hex_color(B1,B).
329
330hex_color(D1,D2,V) :-
331 code_type(D1, xdigit(V1)),
332 code_type(D2, xdigit(V2)),
333 V is 16*V1+V2.
334
335hex_color(D1,V) :-
336 code_type(D1, xdigit(V1)),
337 V is 16*V1+V1.
338
348
349
350 353
358
359prolog:message_line_element(S, ansi(Class, Fmt, Args)) :-
360 class_attrs(Class, Attr),
361 ansi_format(S, Attr, Fmt, Args).
362prolog:message_line_element(S, ansi(Class, Fmt, Args, Ctx)) :-
363 class_attrs(Class, Attr),
364 ansi_format(S, Attr, Fmt, Args),
365 ( nonvar(Ctx),
366 Ctx = ansi(_, RI-RA)
367 -> keep_line_pos(S, format(S, RI, RA))
368 ; true
369 ).
370prolog:message_line_element(S, url(Location)) :-
371 ansi_hyperlink(S, Location).
372prolog:message_line_element(S, url(URL, Label)) :-
373 ansi_hyperlink(S, URL, Label).
374prolog:message_line_element(S, begin(Level, Ctx)) :-
375 level_attrs(Level, Attr),
376 stream_property(S, tty(true)),
377 current_prolog_flag(color_term, true),
378 !,
379 ( is_list(Attr)
380 -> sgr_codes(Attr, Codes),
381 atomic_list_concat(Codes, ;, Code)
382 ; sgr_code(Attr, Code)
383 ),
384 keep_line_pos(S, format(S, '\e[~wm', [Code])),
385 Ctx = ansi('\e[0m', '\e[0m\e[~wm'-[Code]).
386prolog:message_line_element(S, end(Ctx)) :-
387 nonvar(Ctx),
388 Ctx = ansi(Reset, _),
389 keep_line_pos(S, write(S, Reset)).
390
391sgr_codes([], []).
392sgr_codes([H0|T0], [H|T]) :-
393 sgr_code(H0, H),
394 sgr_codes(T0, T).
395
396level_attrs(Level, Attrs) :-
397 user:message_property(Level, color(Attrs)),
398 !.
399level_attrs(Level, Attrs) :-
400 class_attrs(message(Level), Attrs).
401
402class_attrs(Class, Attrs) :-
403 user:message_property(Class, color(Attrs)),
404 !.
405class_attrs(Class, Attrs) :-
406 prolog:console_color(Class, Attrs),
407 !.
408class_attrs(Class, Attrs) :-
409 '$messages':default_theme(Class, Attrs),
410 !.
411class_attrs(Attrs, Attrs).
412
424
425ansi_hyperlink(Stream, Location) :-
426 hyperlink(Stream, url(Location)),
427 !.
428ansi_hyperlink(Stream, Location) :-
429 location_label(Location, Label),
430 ansi_hyperlink(Stream, Location, Label).
431
432location_label(File:Line:Column, Label) =>
433 format(string(Label), '~w:~w:~w', [File,Line,Column]).
434location_label(File:Line, Label) =>
435 format(string(Label), '~w:~w', [File,Line]).
436location_label(File, Label) =>
437 format(string(Label), '~w', [File]).
438
439ansi_hyperlink(Stream, Location, Label),
440 hyperlink(Stream, url(Location, Label)) =>
441 true.
442ansi_hyperlink(Stream, Location, Label) =>
443 ( location_url(Location, URL)
444 -> keep_line_pos(Stream,
445 format(Stream, '\e]8;;~w\e\\', [URL])),
446 format(Stream, '~w', [Label]),
447 keep_line_pos(Stream,
448 format(Stream, '\e]8;;\e\\', []))
449 ; format(Stream, '~w', [Label])
450 ).
451
452is_url(URL) :-
453 ( atom(URL)
454 -> true
455 ; string(URL)
456 ),
457 url_prefix(Prefix),
458 sub_string(URL, 0, _, _, Prefix).
459
460url_prefix('http://').
461url_prefix('https://').
462url_prefix('file://').
463
469
470location_url(Location, URL),
471 tty_url_hook(Location, URL0) =>
472 URL = URL0.
473location_url(File:Line:Column, URL) =>
474 url_file_name(FileURL, File),
475 format(string(URL), '~w#~d:~d', [FileURL, Line, Column]).
476location_url(File:Line, URL) =>
477 url_file_name(FileURL, File),
478 format(string(URL), '~w#~w', [FileURL, Line]).
479location_url(File, URL) =>
480 url_file_name(URL, File).
481
485
486
491
492url_file_name(URL, File) :-
493 is_url(File), !,
494 current_prolog_flag(hyperlink_term, true),
495 URL = File.
496url_file_name(URL, File) :-
497 current_prolog_flag(hyperlink_term, true),
498 absolute_file_name(File, AbsFile),
499 ensure_leading_slash(AbsFile, AbsFile1),
500 url_encode_path(AbsFile1, Encoded),
501 format(string(URL), 'file://~s', [Encoded]).
502
503ensure_leading_slash(Path, SlashPath) :-
504 ( sub_atom(Path, 0, _, _, /)
505 -> SlashPath = Path
506 ; atom_concat(/, Path, SlashPath)
507 ).
508
509url_encode_path(Name, Encoded) :-
510 atom_codes(Name, Codes),
511 phrase(utf8_codes(Codes), UTF8),
512 phrase(encode(UTF8), Encoded).
513
514encode([]) --> [].
515encode([H|T]) --> encode1(H), encode(T).
516
517encode1(C) -->
518 { reserved(C),
519 !,
520 format(codes([C1,C2]), '~`0t~16r~2|', [C])
521 },
522 "%", [C1,C2].
523encode1(C) -->
524 [C].
525
526reserved(C) :- C =< 0'\s.
527reserved(C) :- C >= 127.
528reserved(0'#).
529
535
536keep_line_pos(S, G) :-
537 stream_property(S, position(Pos)),
538 !,
539 setup_call_cleanup(
540 stream_position_data(line_position, Pos, LPos),
541 G,
542 set_stream(S, line_position(LPos))).
543keep_line_pos(_, G) :-
544 call(G).
545
556
557ansi_get_color(Which0, RGB) :-
558 \+ current_prolog_flag(console_menu, true),
559 stream_property(user_input, tty(true)),
560 stream_property(user_output, tty(true)),
561 stream_property(user_error, tty(true)),
562 supports_get_color,
563 ( color_alias(Which0, Which)
564 -> true
565 ; must_be(between(0,15),Which0)
566 -> Which = Which0
567 ),
568 catch(keep_line_pos(user_output,
569 ansi_get_color_(Which, RGB)),
570 error(timeout_error(_,_), _),
571 no_xterm).
572
573supports_get_color :-
574 getenv('TERM', Term),
575 sub_atom(Term, 0, _, _, xterm),
576 \+ getenv('TERM_PROGRAM', 'Apple_Terminal').
577
578color_alias(foreground, 10).
579color_alias(background, 11).
580
581ansi_get_color_(Which, rgb(R,G,B)) :-
582 format(codes(Id), '~w', [Which]),
583 hex4(RH),
584 hex4(GH),
585 hex4(BH),
586 phrase(("\e]", Id, ";rgb:", RH, "/", GH, "/", BH, "\a"), Pattern),
587 stream_property(user_input, timeout(Old)),
588 setup_call_cleanup(
589 set_stream(user_input, timeout(0.05)),
590 with_tty_raw(exchange_pattern(Which, Pattern)),
591 set_stream(user_input, timeout(Old))),
592 !,
593 hex_val(RH, R),
594 hex_val(GH, G),
595 hex_val(BH, B).
596
597no_xterm :-
598 print_message(warning, ansi(no_xterm_get_colour)),
599 fail.
600
601hex4([_,_,_,_]).
602
603hex_val([D1,D2,D3,D4], V) :-
604 code_type(D1, xdigit(V1)),
605 code_type(D2, xdigit(V2)),
606 code_type(D3, xdigit(V3)),
607 code_type(D4, xdigit(V4)),
608 V is (V1<<12)+(V2<<8)+(V3<<4)+V4.
609
610exchange_pattern(Which, Pattern) :-
611 format(user_output, '\e]~w;?\a', [Which]),
612 flush_output(user_output),
613 read_pattern(user_input, Pattern, []).
614
615read_pattern(From, Pattern, NotMatched0) :-
616 copy_term(Pattern, TryPattern),
617 append(Skip, Rest, NotMatched0),
618 append(Rest, RestPattern, TryPattern),
619 !,
620 echo(Skip),
621 try_read_pattern(From, RestPattern, NotMatched, Done),
622 ( Done == true
623 -> Pattern = TryPattern
624 ; read_pattern(From, Pattern, NotMatched)
625 ).
626
628
629try_read_pattern(_, [], [], true) :-
630 !.
631try_read_pattern(From, [H|T], [C|RT], Done) :-
632 get_code(C),
633 ( C = H
634 -> try_read_pattern(From, T, RT, Done)
635 ; RT = [],
636 Done = false
637 ).
638
639echo([]).
640echo([H|T]) :-
641 put_code(user_output, H),
642 echo(T).
643
644:- multifile prolog:message//1. 645
646prolog:message(ansi(no_xterm_get_colour)) -->
647 [ 'Terminal claims to be xterm compatible,'-[], nl,
648 'but does not report colour info'-[]
649 ]