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
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 !.
442ansi_hyperlink(Stream, File:Line:Column, Label) :-
443 !,
444 ( url_file_name(URI, File)
445 -> format(Stream, '\e]8;;~w#~d:~d\e\\~w\e]8;;\e\\',
446 [ URI, Line, Column, Label ])
447 ; format(Stream, '~w', [Label])
448 ).
449ansi_hyperlink(Stream, File:Line, Label) :-
450 !,
451 ( url_file_name(URI, File)
452 -> format(Stream, '\e]8;;~w#~w\e\\~w\e]8;;\e\\',
453 [ URI, Line, Label ])
454 ; format(Stream, '~w', [Label])
455 ).
456ansi_hyperlink(Stream, File, Label) :-
457 ( url_file_name(URI, File)
458 -> format(Stream, '\e]8;;~w\e\\~w\e]8;;\e\\',
459 [ URI, Label ])
460 ; format(Stream, '~w', [Label])
461 ).
462
467
468url_file_name(URL, File) :-
469 current_prolog_flag(hyperlink_term, true),
470 absolute_file_name(File, AbsFile),
471 ensure_leading_slash(AbsFile, AbsFile1),
472 url_encode_path(AbsFile1, Encoded),
473 format(string(URL), 'file://~s', [Encoded]).
474
475ensure_leading_slash(Path, SlashPath) :-
476 ( sub_atom(Path, 0, _, _, /)
477 -> SlashPath = Path
478 ; atom_concat(/, Path, SlashPath)
479 ).
480
481url_encode_path(Name, Encoded) :-
482 atom_codes(Name, Codes),
483 phrase(utf8_codes(Codes), UTF8),
484 phrase(encode(UTF8), Encoded).
485
486encode([]) --> [].
487encode([H|T]) --> encode1(H), encode(T).
488
489encode1(C) -->
490 { reserved(C),
491 !,
492 format(codes([C1,C2]), '~`0t~16r~2|', [C])
493 },
494 "%", [C1,C2].
495encode1(C) -->
496 [C].
497
498reserved(C) :- C =< 0'\s.
499reserved(C) :- C >= 127.
500reserved(0'#).
501
507
508keep_line_pos(S, G) :-
509 stream_property(S, position(Pos)),
510 !,
511 setup_call_cleanup(
512 stream_position_data(line_position, Pos, LPos),
513 G,
514 set_stream(S, line_position(LPos))).
515keep_line_pos(_, G) :-
516 call(G).
517
528
529ansi_get_color(Which0, RGB) :-
530 stream_property(user_input, tty(true)),
531 stream_property(user_output, tty(true)),
532 stream_property(user_error, tty(true)),
533 supports_get_color,
534 ( color_alias(Which0, Which)
535 -> true
536 ; must_be(between(0,15),Which0)
537 -> Which = Which0
538 ),
539 catch(keep_line_pos(user_output,
540 ansi_get_color_(Which, RGB)),
541 error(timeout_error(_,_), _),
542 no_xterm).
543
544supports_get_color :-
545 getenv('TERM', Term),
546 sub_atom(Term, 0, _, _, xterm),
547 \+ getenv('TERM_PROGRAM', 'Apple_Terminal').
548
549color_alias(foreground, 10).
550color_alias(background, 11).
551
552ansi_get_color_(Which, rgb(R,G,B)) :-
553 format(codes(Id), '~w', [Which]),
554 hex4(RH),
555 hex4(GH),
556 hex4(BH),
557 phrase(("\e]", Id, ";rgb:", RH, "/", GH, "/", BH, "\a"), Pattern),
558 stream_property(user_input, timeout(Old)),
559 setup_call_cleanup(
560 set_stream(user_input, timeout(0.05)),
561 with_tty_raw(exchange_pattern(Which, Pattern)),
562 set_stream(user_input, timeout(Old))),
563 !,
564 hex_val(RH, R),
565 hex_val(GH, G),
566 hex_val(BH, B).
567
568no_xterm :-
569 print_message(warning, ansi(no_xterm_get_colour)),
570 fail.
571
572hex4([_,_,_,_]).
573
574hex_val([D1,D2,D3,D4], V) :-
575 code_type(D1, xdigit(V1)),
576 code_type(D2, xdigit(V2)),
577 code_type(D3, xdigit(V3)),
578 code_type(D4, xdigit(V4)),
579 V is (V1<<12)+(V2<<8)+(V3<<4)+V4.
580
581exchange_pattern(Which, Pattern) :-
582 format(user_output, '\e]~w;?\a', [Which]),
583 flush_output(user_output),
584 read_pattern(user_input, Pattern, []).
585
586read_pattern(From, Pattern, NotMatched0) :-
587 copy_term(Pattern, TryPattern),
588 append(Skip, Rest, NotMatched0),
589 append(Rest, RestPattern, TryPattern),
590 !,
591 echo(Skip),
592 try_read_pattern(From, RestPattern, NotMatched, Done),
593 ( Done == true
594 -> Pattern = TryPattern
595 ; read_pattern(From, Pattern, NotMatched)
596 ).
597
599
600try_read_pattern(_, [], [], true) :-
601 !.
602try_read_pattern(From, [H|T], [C|RT], Done) :-
603 get_code(C),
604 ( C = H
605 -> try_read_pattern(From, T, RT, Done)
606 ; RT = [],
607 Done = false
608 ).
609
610echo([]).
611echo([H|T]) :-
612 put_code(user_output, H),
613 echo(T).
614
615:- multifile prolog:message//1. 616
617prolog:message(ansi(no_xterm_get_colour)) -->
618 [ 'Terminal claims to be xterm compatible,'-[], nl,
619 'but does not report colour info'-[]
620 ]