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)  2010-2021, 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(ansi_term,
   38          [ ansi_format/3,              % +Attr, +Format, +Args
   39            ansi_get_color/2,           % +Which, -rgb(R,G,B)
   40            ansi_hyperlink/2,           % +Stream,+Location
   41            ansi_hyperlink/3            % +Stream,+URL,+Label
   42          ]).   43:- autoload(library(error),[domain_error/2,must_be/2]).   44:- autoload(library(lists),[append/3]).   45:- if(exists_source(library(time))).   46:- autoload(library(time),[call_with_time_limit/2]).   47:- endif.

   73:- multifile
   74    prolog:console_color/2,                     % +Term, -AnsiAttrs
   75    supports_get_color/0,
   76    hyperlink/2.                                % +Stream, +Spec
   77
   78
   79color_term_flag_default(true) :-
   80    stream_property(user_input, tty(true)),
   81    stream_property(user_error, tty(true)),
   82    stream_property(user_output, tty(true)),
   83    \+ getenv('TERM', dumb),
   84    !.
   85color_term_flag_default(false).
   86
   87init_color_term_flag :-
   88    color_term_flag_default(Default),
   89    create_prolog_flag(color_term, Default,
   90                       [ type(boolean),
   91                         keep(true)
   92                       ]),
   93    create_prolog_flag(hyperlink_term, false,
   94                       [ type(boolean),
   95                         keep(true)
   96                       ]).
   97
   98:- init_color_term_flag.   99
  100
  101:- meta_predicate
  102    keep_line_pos(+, 0).  103
  104:- multifile
  105    user:message_property/2.

 ansi_format(+ClassOrAttributes, +Format, +Args) is det

Format text with ANSI attributes. This predicate behaves as format/2 using Format and Args, but if the current_output is a terminal, it adds ANSI escape sequences according to Attributes. For example, to print a text in bold cyan, do

?- ansi_format([bold,fg(cyan)], 'Hello ~w', [world]).

Attributes is either a single attribute, a list thereof or a term that is mapped to concrete attributes based on the current theme (see prolog:console_color/2). The attribute names are derived from the ANSI specification. See the source for sgr_code/2 for details. Some commonly used attributes are:

bold

underline

fg(Color),bg(Color),hfg(Color),hbg(Color)

For fg(Color) and bg(Color), the colour name can be '#RGB' or '#RRGGBB'

fg8(Spec),bg8(Spec)

8-bit color specification. Spec is a colour name, h(Color) or an integer 0..255.

fg(R,G,B),bg(R,G,B)

24-bit (direct color) specification. The components are integers in the range 0..255.

Defined color constants are below. default can be used to access the default color of the terminal.

• black, red, green, yellow, blue, magenta, cyan, white

ANSI sequences are sent if and only if

• The current_output has the property tty(true) (see stream_property/2).
• The Prolog flag color_term is true.

  147ansi_format(Attr, Format, Args) :-
  148    ansi_format(current_output, Attr, Format, Args).
  149
  150ansi_format(Stream, Class, Format, Args) :-
  151    stream_property(Stream, tty(true)),
  152    current_prolog_flag(color_term, true),
  153    !,
  154    class_attrs(Class, Attr),
  155    phrase(sgr_codes_ex(Attr), Codes),
  156    atomic_list_concat(Codes, ;, Code),
  157    with_output_to(
  158        Stream,
  159        (   keep_line_pos(current_output, format('\e[~wm', [Code])),
  160            format(Format, Args),
  161            keep_line_pos(current_output, format('\e[0m'))
  162        )
  163    ),
  164    flush_output.
  165ansi_format(Stream, _Attr, Format, Args) :-
  166    format(Stream, Format, Args).
  167
  168sgr_codes_ex(X) -->
  169    { var(X),
  170      !,
  171      instantiation_error(X)
  172    }.
  173sgr_codes_ex([]) -->
  174    !.
  175sgr_codes_ex([H|T]) -->
  176    !,
  177    sgr_codes_ex(H),
  178    sgr_codes_ex(T).
  179sgr_codes_ex(Attr) -->
  180    (   { sgr_code(Attr, Code) }
  181    ->  (   { is_list(Code) }
  182        ->  list(Code)
  183        ;   [Code]
  184        )
  185    ;   { domain_error(sgr_code, Attr) }
  186    ).
  187
  188list([]) --> [].
  189list([H|T]) --> [H], list(T).

 sgr_code(+Name, -Code)

True when code is the Select Graphic Rendition code for Name. The defined names are given below. Note that most terminals only implement this partially.

reset	all attributes off
bold
faint
italic
underline
blink(slow)
blink(rapid)
negative
conceal
crossed_out
font(primary)
font(N)	Alternate font (1..8)
fraktur
underline(double)
intensity(normal)
fg(Name)	Color name
bg(Name)	Color name
framed
encircled
overlined
ideogram(underline)
right_side_line
ideogram(underline(double))
right_side_line(double)
ideogram(overlined)
left_side_line
ideogram(stress_marking)
-Off	Switch attributes off
hfg(Name)	Color name
hbg(Name)	Color name

See also

- http://en.wikipedia.org/wiki/ANSI_escape_code

  231sgr_code(reset, 0).
  232sgr_code(bold,  1).
  233sgr_code(faint, 2).
  234sgr_code(italic, 3).
  235sgr_code(underline, 4).
  236sgr_code(blink(slow), 5).
  237sgr_code(blink(rapid), 6).
  238sgr_code(negative, 7).
  239sgr_code(conceal, 8).
  240sgr_code(crossed_out, 9).
  241sgr_code(font(primary), 10) :- !.
  242sgr_code(font(N), C) :-
  243    C is 10+N.
  244sgr_code(fraktur, 20).
  245sgr_code(underline(double), 21).
  246sgr_code(intensity(normal), 22).
  247sgr_code(fg(Name), C) :-
  248    (   ansi_color(Name, N)
  249    ->  C is N+30
  250    ;   rgb(Name, R, G, B)
  251    ->  sgr_code(fg(R,G,B), C)
  252    ).
  253sgr_code(bg(Name), C) :-
  254    !,
  255    (   ansi_color(Name, N)
  256    ->  C is N+40
  257    ;   rgb(Name, R, G, B)
  258    ->  sgr_code(bg(R,G,B), C)
  259    ).
  260sgr_code(framed, 51).
  261sgr_code(encircled, 52).
  262sgr_code(overlined, 53).
  263sgr_code(ideogram(underline), 60).
  264sgr_code(right_side_line, 60).
  265sgr_code(ideogram(underline(double)), 61).
  266sgr_code(right_side_line(double), 61).
  267sgr_code(ideogram(overlined), 62).
  268sgr_code(left_side_line, 62).
  269sgr_code(ideogram(stress_marking), 64).
  270sgr_code(-X, Code) :-
  271    off_code(X, Code).
  272sgr_code(hfg(Name), C) :-
  273    ansi_color(Name, N),
  274    C is N+90.
  275sgr_code(hbg(Name), C) :-
  276    !,
  277    ansi_color(Name, N),
  278    C is N+100.
  279sgr_code(fg8(Name), [38,5,N]) :-
  280    ansi_color8(Name, N).
  281sgr_code(bg8(Name), [48,5,N]) :-
  282    ansi_color8(Name, N).
  283sgr_code(fg(R,G,B), [38,2,R,G,B]) :-
  284    between(0, 255, R),
  285    between(0, 255, G),
  286    between(0, 255, B).
  287sgr_code(bg(R,G,B), [48,2,R,G,B]) :-
  288    between(0, 255, R),
  289    between(0, 255, G),
  290    between(0, 255, B).
  291
  292off_code(italic_and_franktur, 23).
  293off_code(underline, 24).
  294off_code(blink, 25).
  295off_code(negative, 27).
  296off_code(conceal, 28).
  297off_code(crossed_out, 29).
  298off_code(framed, 54).
  299off_code(overlined, 55).
  300
  301ansi_color8(h(Name), N) :-
  302    !,
  303    ansi_color(Name, N0),
  304    N is N0+8.
  305ansi_color8(Name, N) :-
  306    atom(Name),
  307    !,
  308    ansi_color(Name, N).
  309ansi_color8(N, N) :-
  310    between(0, 255, N).
  311
  312ansi_color(black,   0).
  313ansi_color(red,     1).
  314ansi_color(green,   2).
  315ansi_color(yellow,  3).
  316ansi_color(blue,    4).
  317ansi_color(magenta, 5).
  318ansi_color(cyan,    6).
  319ansi_color(white,   7).
  320ansi_color(default, 9).
  321
  322rgb(Name, R, G, B) :-
  323    atom_codes(Name, [0'#,R1,R2,G1,G2,B1,B2]),
  324    hex_color(R1,R2,R),
  325    hex_color(G1,G2,G),
  326    hex_color(B1,B2,B).
  327rgb(Name, R, G, B) :-
  328    atom_codes(Name, [0'#,R1,G1,B1]),
  329    hex_color(R1,R),
  330    hex_color(G1,G),
  331    hex_color(B1,B).
  332
  333hex_color(D1,D2,V) :-
  334    code_type(D1, xdigit(V1)),
  335    code_type(D2, xdigit(V2)),
  336    V is 16*V1+V2.
  337
  338hex_color(D1,V) :-
  339    code_type(D1, xdigit(V1)),
  340    V is 16*V1+V1.

 prolog:console_color(+Term, -AnsiAttributes) is semidet

Hook that allows for mapping abstract terms to concrete ANSI attributes. This hook is used by theme files to adjust the rendering based on user preferences and context. Defaults are defined in the file boot/messages.pl.

See also

- library(theme/dark) for an example implementation and the Term values used by the system messages.

  353                 /*******************************
  354                 *             HOOK             *
  355                 *******************************/

 prolog:message_line_element(+Stream, +Term) is semidet

Hook implementation that deals with ansi(+Attr, +Fmt, +Args) in message specifications.

  362prolog:message_line_element(S, ansi(Class, Fmt, Args)) :-
  363    class_attrs(Class, Attr),
  364    ansi_format(S, Attr, Fmt, Args).
  365prolog:message_line_element(S, ansi(Class, Fmt, Args, Ctx)) :-
  366    class_attrs(Class, Attr),
  367    ansi_format(S, Attr, Fmt, Args),
  368    (   nonvar(Ctx),
  369        Ctx = ansi(_, RI-RA)
  370    ->  keep_line_pos(S, format(S, RI, RA))
  371    ;   true
  372    ).
  373prolog:message_line_element(S, url(Location)) :-
  374    ansi_hyperlink(S, Location).
  375prolog:message_line_element(S, url(URL, Label)) :-
  376    ansi_hyperlink(S, URL, Label).
  377prolog:message_line_element(S, begin(Level, Ctx)) :-
  378    level_attrs(Level, Attr),
  379    stream_property(S, tty(true)),
  380    current_prolog_flag(color_term, true),
  381    !,
  382    (   is_list(Attr)
  383    ->  sgr_codes(Attr, Codes),
  384        atomic_list_concat(Codes, ;, Code)
  385    ;   sgr_code(Attr, Code)
  386    ),
  387    keep_line_pos(S, format(S, '\e[~wm', [Code])),
  388    Ctx = ansi('\e[0m', '\e[0m\e[~wm'-[Code]).
  389prolog:message_line_element(S, end(Ctx)) :-
  390    nonvar(Ctx),
  391    Ctx = ansi(Reset, _),
  392    keep_line_pos(S, write(S, Reset)).
  393
  394sgr_codes([], []).
  395sgr_codes([H0|T0], [H|T]) :-
  396    sgr_code(H0, H),
  397    sgr_codes(T0, T).
  398
  399level_attrs(Level,         Attrs) :-
  400    user:message_property(Level, color(Attrs)),
  401    !.
  402level_attrs(Level,         Attrs) :-
  403    class_attrs(message(Level), Attrs).
  404
  405class_attrs(Class, Attrs) :-
  406    user:message_property(Class, color(Attrs)),
  407    !.
  408class_attrs(Class, Attrs) :-
  409    prolog:console_color(Class, Attrs),
  410    !.
  411class_attrs(Class, Attrs) :-
  412    '$messages':default_theme(Class, Attrs),
  413    !.
  414class_attrs(Attrs, Attrs).

 ansi_hyperlink(+Stream, +Location) is det

 ansi_hyperlink(+Stream, +URL, +Label) is det

Create a hyperlink for a terminal emulator. The file is fairly easy, but getting the line and column across is not as there seems to be no established standard. The current implementation emits, i.e., inserting a capital L before the line.

``file://AbsFileName[#LLine[:Column]]``

See also

- https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda

  428ansi_hyperlink(Stream, Location) :-
  429    hyperlink(Stream, url(Location)),
  430    !.
  431ansi_hyperlink(Stream, File:Line:Column) :-
  432    !,
  433    (   url_file_name(URI, File)
  434    ->  format(Stream, '\e]8;;~w#~d:~d\e\\~w:~d:~d\e]8;;\e\\',
  435               [ URI, Line, Column, File, Line, Column ])
  436    ;   format(Stream, '~w:~w:~w', [File, Line, Column])
  437    ).
  438ansi_hyperlink(Stream, File:Line) :-
  439    !,
  440    (   url_file_name(URI, File)
  441    ->  format(Stream, '\e]8;;~w#~w\e\\~w:~d\e]8;;\e\\',
  442               [ URI, Line, File, Line ])
  443    ;   format(Stream, '~w:~w', [File, Line])
  444    ).
  445ansi_hyperlink(Stream, File) :-
  446    (   url_file_name(URI, File)
  447    ->  format(Stream, '\e]8;;~w\e\\~w\e]8;;\e\\',
  448               [ URI, File ])
  449    ;   format(Stream, '~w', [File])
  450    ).
  451
  452ansi_hyperlink(Stream, URL, Label) :-
  453    hyperlink(Stream, url(URL, Label)),
  454    !.
  455ansi_hyperlink(Stream, URL, Label) :-
  456    (   current_prolog_flag(hyperlink_term, true)
  457    ->  format(Stream, '\e]8;;~w\e\\~w\e]8;;\e\\',
  458               [ URL, Label ])
  459    ;   format(Stream, '~w', [Label])
  460    ).

 hyperlink(+Stream, +Spec) is semidet

Multifile hook that may be used to redefine ansi_hyperlink/2,3. If this predicate succeeds the system assumes the link has been written to Stream.

Arguments:

Spec	- is either url(Location) or url(URL, Label). See ansi_hyperlink/2,3 for details.

  471:- dynamic has_lib_uri/1 as volatile.  472
  473url_file_name(URL, File) :-
  474    current_prolog_flag(hyperlink_term, true),
  475    (   has_lib_uri(true)
  476    ->  uri_file_name(URL, File)
  477    ;   exists_source(library(uri))
  478    ->  use_module(library(uri), [uri_file_name/2]),
  479        uri_file_name(URL, File),
  480        asserta(has_lib_uri(true))
  481    ;   asserta(has_lib_uri(false)),
  482        fail
  483    ).

 keep_line_pos(+Stream, :Goal)

Run goal without changing the position information on Stream. This is used to avoid that the exchange of ANSI sequences modifies the notion of, notably, the line_pos notion.

  491keep_line_pos(S, G) :-
  492    stream_property(S, position(Pos)),
  493    !,
  494    setup_call_cleanup(
  495        stream_position_data(line_position, Pos, LPos),
  496        G,
  497        set_stream(S, line_position(LPos))).
  498keep_line_pos(_, G) :-
  499    call(G).

 ansi_get_color(+Which, -RGB) is semidet

Obtain the RGB color for an ANSI color parameter. Which is either a color alias or an integer ANSI color id. Defined aliases are foreground and background. This predicate sends a request to the console (user_output) and reads the reply. This assumes an xterm compatible terminal.

Arguments:

RGB	- is a term rgb(Red,Green,Blue). The color components are integers in the range 0..65535.

  513:- if(current_predicate(call_with_time_limit/2)).  514ansi_get_color(Which0, RGB) :-
  515    stream_property(user_input, tty(true)),
  516    stream_property(user_output, tty(true)),
  517    stream_property(user_error, tty(true)),
  518    supports_get_color,
  519    (   color_alias(Which0, Which)
  520    ->  true
  521    ;   must_be(between(0,15),Which0)
  522    ->  Which = Which0
  523    ),
  524    catch(keep_line_pos(user_output,
  525                        ansi_get_color_(Which, RGB)),
  526          time_limit_exceeded,
  527          no_xterm).
  528
  529supports_get_color :-
  530    getenv('TERM', Term),
  531    sub_atom(Term, 0, _, _, xterm),
  532    \+ getenv('TERM_PROGRAM', 'Apple_Terminal').
  533
  534color_alias(foreground, 10).
  535color_alias(background, 11).
  536
  537ansi_get_color_(Which, rgb(R,G,B)) :-
  538    format(codes(Id), '~w', [Which]),
  539    hex4(RH),
  540    hex4(GH),
  541    hex4(BH),
  542    phrase(("\e]", Id, ";rgb:", RH, "/", GH, "/", BH, "\a"), Pattern),
  543    call_with_time_limit(0.05,
  544                         with_tty_raw(exchange_pattern(Which, Pattern))),
  545    !,
  546    hex_val(RH, R),
  547    hex_val(GH, G),
  548    hex_val(BH, B).
  549
  550no_xterm :-
  551    print_message(warning, ansi(no_xterm_get_colour)),
  552    fail.
  553
  554hex4([_,_,_,_]).
  555
  556hex_val([D1,D2,D3,D4], V) :-
  557    code_type(D1, xdigit(V1)),
  558    code_type(D2, xdigit(V2)),
  559    code_type(D3, xdigit(V3)),
  560    code_type(D4, xdigit(V4)),
  561    V is (V1<<12)+(V2<<8)+(V3<<4)+V4.
  562
  563exchange_pattern(Which, Pattern) :-
  564    format(user_output, '\e]~w;?\a', [Which]),
  565    flush_output(user_output),
  566    read_pattern(user_input, Pattern, []).
  567
  568read_pattern(From, Pattern, NotMatched0) :-
  569    copy_term(Pattern, TryPattern),
  570    append(Skip, Rest, NotMatched0),
  571    append(Rest, RestPattern, TryPattern),
  572    !,
  573    echo(Skip),
  574    try_read_pattern(From, RestPattern, NotMatched, Done),
  575    (   Done == true
  576    ->  Pattern = TryPattern
  577    ;   read_pattern(From, Pattern, NotMatched)
  578    ).

 try_read_pattern(+From, +Pattern, -NotMatched)

  582try_read_pattern(_, [], [], true) :-
  583    !.
  584try_read_pattern(From, [H|T], [C|RT], Done) :-
  585    get_code(C),
  586    (   C = H
  587    ->  try_read_pattern(From, T, RT, Done)
  588    ;   RT = [],
  589        Done = false
  590    ).
  591
  592echo([]).
  593echo([H|T]) :-
  594    put_code(user_output, H),
  595    echo(T).
  596
  597:- else.  598ansi_get_color(_Which0, _RGB) :-
  599    fail.
  600:- endif.  601
  602
  603
  604:- multifile prolog:message//1.  605
  606prolog:message(ansi(no_xterm_get_colour)) -->
  607    [ 'Terminal claims to be xterm compatible,'-[], nl,
  608      'but does not report colour info'-[]
  609    ]