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-2020, VU University Amsterdam
    7                              CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(ansi_term,
   37          [ ansi_format/3,              % +Attr, +Format, +Args
   38            ansi_get_color/2            % +Which, -rgb(R,G,B)
   39          ]).   40:- autoload(library(error),[domain_error/2,must_be/2]).   41:- autoload(library(lists),[append/2,append/3]).   42:- if(exists_source(library(time))).   43:- autoload(library(time),[call_with_time_limit/2]).   44:- endif.   45
   46
   47/** <module> Print decorated text to ANSI consoles
   48
   49This library allows for exploiting the color and attribute facilities of
   50most modern terminals using ANSI escape sequences. This library provides
   51the following:
   52
   53  - ansi_format/3 allows writing messages to the terminal with ansi
   54    attributes.
   55  - It defines the hook prolog:message_line_element/2, which provides
   56    ansi attributes for print_message/2.
   57
   58@see    http://en.wikipedia.org/wiki/ANSI_escape_code
   59*/
   60
   61:- multifile
   62    prolog:console_color/2,                     % +Term, -AnsiAttrs
   63    supports_get_color/0.   64
   65
   66color_term_flag_default(true) :-
   67    stream_property(user_input, tty(true)),
   68    stream_property(user_error, tty(true)),
   69    stream_property(user_output, tty(true)),
   70    \+ getenv('TERM', dumb),
   71    !.
   72color_term_flag_default(false).
   73
   74init_color_term_flag :-
   75    color_term_flag_default(Default),
   76    create_prolog_flag(color_term, Default,
   77                       [ type(boolean),
   78                         keep(true)
   79                       ]).
   80
   81:- init_color_term_flag.   82
   83
   84:- meta_predicate
   85    keep_line_pos(+, 0).   86
   87:- multifile
   88    user:message_property/2.   89
   90%!  ansi_format(+ClassOrAttributes, +Format, +Args) is det.
   91%
   92%   Format text with ANSI  attributes.   This  predicate  behaves as
   93%   format/2 using Format and Args, but if the =current_output= is a
   94%   terminal, it adds ANSI escape sequences according to Attributes.
   95%   For example, to print a text in bold cyan, do
   96%
   97%     ==
   98%     ?- ansi_format([bold,fg(cyan)], 'Hello ~w', [world]).
   99%     ==
  100%
  101%   Attributes is either a single attribute, a   list  thereof or a term
  102%   that is mapped to concrete  attributes   based  on the current theme
  103%   (see prolog:console_color/2). The attribute names   are derived from
  104%   the ANSI specification. See the source   for sgr_code/2 for details.
  105%   Some commonly used attributes are:
  106%
  107%     - bold
  108%     - underline
  109%     - fg(Color), bg(Color), hfg(Color), hbg(Color)
  110%       For fg(Color) and bg(Color), the colour name can be '#RGB' or
  111%       '#RRGGBB'
  112%     - fg8(Spec), bg8(Spec)
  113%       8-bit color specification.  Spec is a colour name, h(Color)
  114%       or an integer 0..255.
  115%     - fg(R,G,B), bg(R,G,B)
  116%       24-bit (direct color) specification.  The components are
  117%       integers in the range 0..255.
  118%
  119%   Defined color constants are below.  =default=   can  be  used to
  120%   access the default color of the terminal.
  121%
  122%     - black, red, green, yellow, blue, magenta, cyan, white
  123%
  124%   ANSI sequences are sent if and only if
  125%
  126%     - The =current_output= has the property tty(true) (see
  127%       stream_property/2).
  128%     - The Prolog flag =color_term= is =true=.
  129
  130ansi_format(Attr, Format, Args) :-
  131    ansi_format(current_output, Attr, Format, Args).
  132
  133ansi_format(Stream, Class, Format, Args) :-
  134    stream_property(Stream, tty(true)),
  135    current_prolog_flag(color_term, true),
  136    !,
  137    class_attrs(Class, Attr),
  138    phrase(sgr_codes_ex(Attr), Codes),
  139    atomic_list_concat(Codes, ;, Code),
  140    with_output_to(
  141        Stream,
  142        (   keep_line_pos(current_output, format('\e[~wm', [Code])),
  143            format(Format, Args),
  144            keep_line_pos(current_output, format('\e[0m'))
  145        )
  146    ),
  147    flush_output.
  148ansi_format(Stream, _Attr, Format, Args) :-
  149    format(Stream, Format, Args).
  150
  151sgr_codes_ex(X) -->
  152    { var(X),
  153      !,
  154      instantiation_error(X)
  155    }.
  156sgr_codes_ex([]) -->
  157    !.
  158sgr_codes_ex([H|T]) -->
  159    !,
  160    sgr_codes_ex(H),
  161    sgr_codes_ex(T).
  162sgr_codes_ex(Attr) -->
  163    (   { sgr_code(Attr, Code) }
  164    ->  (   { is_list(Code) }
  165        ->  list(Code)
  166        ;   [Code]
  167        )
  168    ;   { domain_error(sgr_code, Attr) }
  169    ).
  170
  171list([]) --> [].
  172list([H|T]) --> [H], list(T).
  173
  174
  175%!  sgr_code(+Name, -Code)
  176%
  177%   True when code is the Select   Graphic  Rendition code for Name.
  178%   The defined names are given below. Note that most terminals only
  179%   implement this partially.
  180%
  181%     | reset                       | all attributes off    |
  182%     | bold                        |                       |
  183%     | faint                       |       |
  184%     | italic                      |       |
  185%     | underline                   |       |
  186%     | blink(slow)                 |       |
  187%     | blink(rapid)                |       |
  188%     | negative                    |       |
  189%     | conceal                     |       |
  190%     | crossed_out                 |       |
  191%     | font(primary)               |       |
  192%     | font(N)                     | Alternate font (1..8) |
  193%     | fraktur                     |       |
  194%     | underline(double)           |       |
  195%     | intensity(normal)           |       |
  196%     | fg(Name)                    | Color name    |
  197%     | bg(Name)                    | Color name    |
  198%     | framed                      |       |
  199%     | encircled                   |       |
  200%     | overlined                   |       |
  201%     | ideogram(underline)         |       |
  202%     | right_side_line             |       |
  203%     | ideogram(underline(double)) |       |
  204%     | right_side_line(double)     |       |
  205%     | ideogram(overlined)         |       |
  206%     | left_side_line              |       |
  207%     | ideogram(stress_marking)    |       |
  208%     | -Off                        | Switch attributes off |
  209%     | hfg(Name)                   | Color name    |
  210%     | hbg(Name)                   | Color name    |
  211%
  212%   @see http://en.wikipedia.org/wiki/ANSI_escape_code
  213
  214sgr_code(reset, 0).
  215sgr_code(bold,  1).
  216sgr_code(faint, 2).
  217sgr_code(italic, 3).
  218sgr_code(underline, 4).
  219sgr_code(blink(slow), 5).
  220sgr_code(blink(rapid), 6).
  221sgr_code(negative, 7).
  222sgr_code(conceal, 8).
  223sgr_code(crossed_out, 9).
  224sgr_code(font(primary), 10) :- !.
  225sgr_code(font(N), C) :-
  226    C is 10+N.
  227sgr_code(fraktur, 20).
  228sgr_code(underline(double), 21).
  229sgr_code(intensity(normal), 22).
  230sgr_code(fg(Name), C) :-
  231    (   ansi_color(Name, N)
  232    ->  C is N+30
  233    ;   rgb(Name, R, G, B)
  234    ->  sgr_code(fg(R,G,B), C)
  235    ).
  236sgr_code(bg(Name), C) :-
  237    !,
  238    (   ansi_color(Name, N)
  239    ->  C is N+40
  240    ;   rgb(Name, R, G, B)
  241    ->  sgr_code(bg(R,G,B), C)
  242    ).
  243sgr_code(framed, 51).
  244sgr_code(encircled, 52).
  245sgr_code(overlined, 53).
  246sgr_code(ideogram(underline), 60).
  247sgr_code(right_side_line, 60).
  248sgr_code(ideogram(underline(double)), 61).
  249sgr_code(right_side_line(double), 61).
  250sgr_code(ideogram(overlined), 62).
  251sgr_code(left_side_line, 62).
  252sgr_code(ideogram(stress_marking), 64).
  253sgr_code(-X, Code) :-
  254    off_code(X, Code).
  255sgr_code(hfg(Name), C) :-
  256    ansi_color(Name, N),
  257    C is N+90.
  258sgr_code(hbg(Name), C) :-
  259    !,
  260    ansi_color(Name, N),
  261    C is N+100.
  262sgr_code(fg8(Name), [38,5,N]) :-
  263    ansi_color8(Name, N).
  264sgr_code(bg8(Name), [48,5,N]) :-
  265    ansi_color8(Name, N).
  266sgr_code(fg(R,G,B), [38,2,R,G,B]) :-
  267    between(0, 255, R),
  268    between(0, 255, G),
  269    between(0, 255, B).
  270sgr_code(bg(R,G,B), [48,2,R,G,B]) :-
  271    between(0, 255, R),
  272    between(0, 255, G),
  273    between(0, 255, B).
  274
  275off_code(italic_and_franktur, 23).
  276off_code(underline, 24).
  277off_code(blink, 25).
  278off_code(negative, 27).
  279off_code(conceal, 28).
  280off_code(crossed_out, 29).
  281off_code(framed, 54).
  282off_code(overlined, 55).
  283
  284ansi_color8(h(Name), N) :-
  285    !,
  286    ansi_color(Name, N0),
  287    N is N0+8.
  288ansi_color8(Name, N) :-
  289    atom(Name),
  290    !,
  291    ansi_color(Name, N).
  292ansi_color8(N, N) :-
  293    between(0, 255, N).
  294
  295ansi_color(black,   0).
  296ansi_color(red,     1).
  297ansi_color(green,   2).
  298ansi_color(yellow,  3).
  299ansi_color(blue,    4).
  300ansi_color(magenta, 5).
  301ansi_color(cyan,    6).
  302ansi_color(white,   7).
  303ansi_color(default, 9).
  304
  305rgb(Name, R, G, B) :-
  306    atom_codes(Name, [0'#,R1,R2,G1,G2,B1,B2]),
  307    hex_color(R1,R2,R),
  308    hex_color(G1,G2,G),
  309    hex_color(B1,B2,B).
  310rgb(Name, R, G, B) :-
  311    atom_codes(Name, [0'#,R1,G1,B1]),
  312    hex_color(R1,R),
  313    hex_color(G1,G),
  314    hex_color(B1,B).
  315
  316hex_color(D1,D2,V) :-
  317    code_type(D1, xdigit(V1)),
  318    code_type(D2, xdigit(V2)),
  319    V is 16*V1+V2.
  320
  321hex_color(D1,V) :-
  322    code_type(D1, xdigit(V1)),
  323    V is 16*V1+V1.
  324
  325%!  prolog:console_color(+Term, -AnsiAttributes) is semidet.
  326%
  327%   Hook that allows  for  mapping  abstract   terms  to  concrete  ANSI
  328%   attributes. This hook  is  used  by   _theme_  files  to  adjust the
  329%   rendering based on  user  preferences   and  context.  Defaults  are
  330%   defined in the file `boot/messages.pl`.
  331%
  332%   @see library(theme/dark) for an example  implementation and the Term
  333%   values used by the system messages.
  334
  335
  336                 /*******************************
  337                 *             HOOK             *
  338                 *******************************/
  339
  340%!  prolog:message_line_element(+Stream, +Term) is semidet.
  341%
  342%   Hook implementation that deals with  ansi(+Attr, +Fmt, +Args) in
  343%   message specifications.
  344
  345prolog:message_line_element(S, ansi(Class, Fmt, Args)) :-
  346    class_attrs(Class, Attr),
  347    ansi_format(S, Attr, Fmt, Args).
  348prolog:message_line_element(S, ansi(Class, Fmt, Args, Ctx)) :-
  349    class_attrs(Class, Attr),
  350    ansi_format(S, Attr, Fmt, Args),
  351    (   nonvar(Ctx),
  352        Ctx = ansi(_, RI-RA)
  353    ->  keep_line_pos(S, format(S, RI, RA))
  354    ;   true
  355    ).
  356prolog:message_line_element(S, begin(Level, Ctx)) :-
  357    level_attrs(Level, Attr),
  358    stream_property(S, tty(true)),
  359    current_prolog_flag(color_term, true),
  360    !,
  361    (   is_list(Attr)
  362    ->  sgr_codes(Attr, Codes),
  363        atomic_list_concat(Codes, ;, Code)
  364    ;   sgr_code(Attr, Code)
  365    ),
  366    keep_line_pos(S, format(S, '\e[~wm', [Code])),
  367    Ctx = ansi('\e[0m', '\e[0m\e[~wm'-[Code]).
  368prolog:message_line_element(S, end(Ctx)) :-
  369    nonvar(Ctx),
  370    Ctx = ansi(Reset, _),
  371    keep_line_pos(S, write(S, Reset)).
  372
  373sgr_codes([], []).
  374sgr_codes([H0|T0], [H|T]) :-
  375    sgr_code(H0, H),
  376    sgr_codes(T0, T).
  377
  378level_attrs(Level,         Attrs) :-
  379    user:message_property(Level, color(Attrs)),
  380    !.
  381level_attrs(Level,         Attrs) :-
  382    class_attrs(message(Level), Attrs).
  383
  384class_attrs(Class, Attrs) :-
  385    user:message_property(Class, color(Attrs)),
  386    !.
  387class_attrs(Class, Attrs) :-
  388    prolog:console_color(Class, Attrs),
  389    !.
  390class_attrs(Class, Attrs) :-
  391    '$messages':default_theme(Class, Attrs),
  392    !.
  393class_attrs(Attrs, Attrs).
  394
  395%!  keep_line_pos(+Stream, :Goal)
  396%
  397%   Run goal without changing the position   information on Stream. This
  398%   is used to avoid that the exchange   of  ANSI sequences modifies the
  399%   notion of, notably, the `line_pos` notion.
  400
  401keep_line_pos(S, G) :-
  402    stream_property(S, position(Pos)),
  403    !,
  404    setup_call_cleanup(
  405        stream_position_data(line_position, Pos, LPos),
  406        G,
  407        set_stream(S, line_position(LPos))).
  408keep_line_pos(_, G) :-
  409    call(G).
  410
  411%!  ansi_get_color(+Which, -RGB) is semidet.
  412%
  413%   Obtain the RGB color for an ANSI  color parameter. Which is either a
  414%   color alias or  an  integer  ANSI   color  id.  Defined  aliases are
  415%   `foreground` and `background`. This predicate sends a request to the
  416%   console (`user_output`) and reads the reply. This assumes an `xterm`
  417%   compatible terminal.
  418%
  419%   @arg RGB is a term rgb(Red,Green,Blue).  The color components are
  420%   integers in the range 0..65535.
  421
  422
  423:- if(current_predicate(call_with_time_limit/2)).  424ansi_get_color(Which0, RGB) :-
  425    stream_property(user_input, tty(true)),
  426    stream_property(user_output, tty(true)),
  427    stream_property(user_error, tty(true)),
  428    supports_get_color,
  429    (   color_alias(Which0, Which)
  430    ->  true
  431    ;   must_be(between(0,15),Which0)
  432    ->  Which = Which0
  433    ),
  434    catch(keep_line_pos(user_output,
  435                        ansi_get_color_(Which, RGB)),
  436          time_limit_exceeded,
  437          no_xterm).
  438
  439supports_get_color :-
  440    getenv('TERM', Term),
  441    sub_atom(Term, 0, _, _, xterm),
  442    \+ getenv('TERM_PROGRAM', 'Apple_Terminal').
  443
  444color_alias(foreground, 10).
  445color_alias(background, 11).
  446
  447ansi_get_color_(Which, rgb(R,G,B)) :-
  448    format(codes(Id), '~w', [Which]),
  449    hex4(RH),
  450    hex4(GH),
  451    hex4(BH),
  452    phrase(("\e]", Id, ";rgb:", RH, "/", GH, "/", BH, "\a"), Pattern),
  453    call_with_time_limit(0.05,
  454                         with_tty_raw(exchange_pattern(Which, Pattern))),
  455    !,
  456    hex_val(RH, R),
  457    hex_val(GH, G),
  458    hex_val(BH, B).
  459
  460no_xterm :-
  461    print_message(warning, ansi(no_xterm_get_colour)),
  462    fail.
  463
  464hex4([_,_,_,_]).
  465
  466hex_val([D1,D2,D3,D4], V) :-
  467    code_type(D1, xdigit(V1)),
  468    code_type(D2, xdigit(V2)),
  469    code_type(D3, xdigit(V3)),
  470    code_type(D4, xdigit(V4)),
  471    V is (V1<<12)+(V2<<8)+(V3<<4)+V4.
  472
  473exchange_pattern(Which, Pattern) :-
  474    format(user_output, '\e]~w;?\a', [Which]),
  475    flush_output(user_output),
  476    read_pattern(user_input, Pattern, []).
  477
  478read_pattern(From, Pattern, NotMatched0) :-
  479    copy_term(Pattern, TryPattern),
  480    append(Skip, Rest, NotMatched0),
  481    append(Rest, RestPattern, TryPattern),
  482    !,
  483    echo(Skip),
  484    try_read_pattern(From, RestPattern, NotMatched, Done),
  485    (   Done == true
  486    ->  Pattern = TryPattern
  487    ;   read_pattern(From, Pattern, NotMatched)
  488    ).
  489
  490%!  try_read_pattern(+From, +Pattern, -NotMatched)
  491
  492try_read_pattern(_, [], [], true) :-
  493    !.
  494try_read_pattern(From, [H|T], [C|RT], Done) :-
  495    get_code(C),
  496    (   C = H
  497    ->  try_read_pattern(From, T, RT, Done)
  498    ;   RT = [],
  499        Done = false
  500    ).
  501
  502echo([]).
  503echo([H|T]) :-
  504    put_code(user_output, H),
  505    echo(T).
  506
  507:- else.  508ansi_get_color(_Which0, _RGB) :-
  509    fail.
  510:- endif.  511
  512
  513
  514:- multifile prolog:message//1.  515
  516prolog:message(ansi(no_xterm_get_colour)) -->
  517    [ 'Terminal claims to be xterm compatible,'-[], nl,
  518      'but does not report colour info'-[]
  519    ]