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    format(string(Fmt), '\e[~~wm~w\e[0m', [Format]),
  141    format(Stream, Fmt, [Code|Args]),
  142    flush_output.
  143ansi_format(Stream, _Attr, Format, Args) :-
  144    format(Stream, Format, Args).
  145
  146sgr_codes_ex(X) -->
  147    { var(X),
  148      !,
  149      instantiation_error(X)
  150    }.
  151sgr_codes_ex([]) -->
  152    !.
  153sgr_codes_ex([H|T]) -->
  154    !,
  155    sgr_codes_ex(H),
  156    sgr_codes_ex(T).
  157sgr_codes_ex(Attr) -->
  158    (   { sgr_code(Attr, Code) }
  159    ->  (   { is_list(Code) }
  160        ->  list(Code)
  161        ;   [Code]
  162        )
  163    ;   { domain_error(sgr_code, Attr) }
  164    ).
  165
  166list([]) --> [].
  167list([H|T]) --> [H], list(T).
  168
  169
  170%!  sgr_code(+Name, -Code)
  171%
  172%   True when code is the Select   Graphic  Rendition code for Name.
  173%   The defined names are given below. Note that most terminals only
  174%   implement this partially.
  175%
  176%     | reset                       | all attributes off    |
  177%     | bold                        |                       |
  178%     | faint                       |       |
  179%     | italic                      |       |
  180%     | underline                   |       |
  181%     | blink(slow)                 |       |
  182%     | blink(rapid)                |       |
  183%     | negative                    |       |
  184%     | conceal                     |       |
  185%     | crossed_out                 |       |
  186%     | font(primary)               |       |
  187%     | font(N)                     | Alternate font (1..8) |
  188%     | fraktur                     |       |
  189%     | underline(double)           |       |
  190%     | intensity(normal)           |       |
  191%     | fg(Name)                    | Color name    |
  192%     | bg(Name)                    | Color name    |
  193%     | framed                      |       |
  194%     | encircled                   |       |
  195%     | overlined                   |       |
  196%     | ideogram(underline)         |       |
  197%     | right_side_line             |       |
  198%     | ideogram(underline(double)) |       |
  199%     | right_side_line(double)     |       |
  200%     | ideogram(overlined)         |       |
  201%     | left_side_line              |       |
  202%     | ideogram(stress_marking)    |       |
  203%     | -Off                        | Switch attributes off |
  204%     | hfg(Name)                   | Color name    |
  205%     | hbg(Name)                   | Color name    |
  206%
  207%   @see http://en.wikipedia.org/wiki/ANSI_escape_code
  208
  209sgr_code(reset, 0).
  210sgr_code(bold,  1).
  211sgr_code(faint, 2).
  212sgr_code(italic, 3).
  213sgr_code(underline, 4).
  214sgr_code(blink(slow), 5).
  215sgr_code(blink(rapid), 6).
  216sgr_code(negative, 7).
  217sgr_code(conceal, 8).
  218sgr_code(crossed_out, 9).
  219sgr_code(font(primary), 10) :- !.
  220sgr_code(font(N), C) :-
  221    C is 10+N.
  222sgr_code(fraktur, 20).
  223sgr_code(underline(double), 21).
  224sgr_code(intensity(normal), 22).
  225sgr_code(fg(Name), C) :-
  226    (   ansi_color(Name, N)
  227    ->  C is N+30
  228    ;   rgb(Name, R, G, B)
  229    ->  sgr_code(fg(R,G,B), C)
  230    ).
  231sgr_code(bg(Name), C) :-
  232    !,
  233    (   ansi_color(Name, N)
  234    ->  C is N+40
  235    ;   rgb(Name, R, G, B)
  236    ->  sgr_code(bg(R,G,B), C)
  237    ).
  238sgr_code(framed, 51).
  239sgr_code(encircled, 52).
  240sgr_code(overlined, 53).
  241sgr_code(ideogram(underline), 60).
  242sgr_code(right_side_line, 60).
  243sgr_code(ideogram(underline(double)), 61).
  244sgr_code(right_side_line(double), 61).
  245sgr_code(ideogram(overlined), 62).
  246sgr_code(left_side_line, 62).
  247sgr_code(ideogram(stress_marking), 64).
  248sgr_code(-X, Code) :-
  249    off_code(X, Code).
  250sgr_code(hfg(Name), C) :-
  251    ansi_color(Name, N),
  252    C is N+90.
  253sgr_code(hbg(Name), C) :-
  254    !,
  255    ansi_color(Name, N),
  256    C is N+100.
  257sgr_code(fg8(Name), [38,5,N]) :-
  258    ansi_color8(Name, N).
  259sgr_code(bg8(Name), [48,5,N]) :-
  260    ansi_color8(Name, N).
  261sgr_code(fg(R,G,B), [38,2,R,G,B]) :-
  262    between(0, 255, R),
  263    between(0, 255, G),
  264    between(0, 255, B).
  265sgr_code(bg(R,G,B), [48,2,R,G,B]) :-
  266    between(0, 255, R),
  267    between(0, 255, G),
  268    between(0, 255, B).
  269
  270off_code(italic_and_franktur, 23).
  271off_code(underline, 24).
  272off_code(blink, 25).
  273off_code(negative, 27).
  274off_code(conceal, 28).
  275off_code(crossed_out, 29).
  276off_code(framed, 54).
  277off_code(overlined, 55).
  278
  279ansi_color8(h(Name), N) :-
  280    !,
  281    ansi_color(Name, N0),
  282    N is N0+8.
  283ansi_color8(Name, N) :-
  284    atom(Name),
  285    !,
  286    ansi_color(Name, N).
  287ansi_color8(N, N) :-
  288    between(0, 255, N).
  289
  290ansi_color(black,   0).
  291ansi_color(red,     1).
  292ansi_color(green,   2).
  293ansi_color(yellow,  3).
  294ansi_color(blue,    4).
  295ansi_color(magenta, 5).
  296ansi_color(cyan,    6).
  297ansi_color(white,   7).
  298ansi_color(default, 9).
  299
  300rgb(Name, R, G, B) :-
  301    atom_codes(Name, [0'#,R1,R2,G1,G2,B1,B2]),
  302    hex_color(R1,R2,R),
  303    hex_color(G1,G2,G),
  304    hex_color(B1,B2,B).
  305rgb(Name, R, G, B) :-
  306    atom_codes(Name, [0'#,R1,G1,B1]),
  307    hex_color(R1,R),
  308    hex_color(G1,G),
  309    hex_color(B1,B).
  310
  311hex_color(D1,D2,V) :-
  312    code_type(D1, xdigit(V1)),
  313    code_type(D2, xdigit(V2)),
  314    V is 16*V1+V2.
  315
  316hex_color(D1,V) :-
  317    code_type(D1, xdigit(V1)),
  318    V is 16*V1+V1.
  319
  320%!  prolog:console_color(+Term, -AnsiAttributes) is semidet.
  321%
  322%   Hook that allows  for  mapping  abstract   terms  to  concrete  ANSI
  323%   attributes. This hook  is  used  by   _theme_  files  to  adjust the
  324%   rendering based on  user  preferences   and  context.  Defaults  are
  325%   defined in the file `boot/messages.pl`.
  326%
  327%   @see library(theme/dark) for an example  implementation and the Term
  328%   values used by the system messages.
  329
  330
  331                 /*******************************
  332                 *             HOOK             *
  333                 *******************************/
  334
  335%!  prolog:message_line_element(+Stream, +Term) is semidet.
  336%
  337%   Hook implementation that deals with  ansi(+Attr, +Fmt, +Args) in
  338%   message specifications.
  339
  340prolog:message_line_element(S, ansi(Class, Fmt, Args)) :-
  341    class_attrs(Class, Attr),
  342    ansi_format(S, Attr, Fmt, Args).
  343prolog:message_line_element(S, ansi(Class, Fmt, Args, Ctx)) :-
  344    class_attrs(Class, Attr),
  345    ansi_format(S, Attr, Fmt, Args),
  346    (   nonvar(Ctx),
  347        Ctx = ansi(_, RI-RA)
  348    ->  keep_line_pos(S, format(S, RI, RA))
  349    ;   true
  350    ).
  351prolog:message_line_element(S, begin(Level, Ctx)) :-
  352    level_attrs(Level, Attr),
  353    stream_property(S, tty(true)),
  354    current_prolog_flag(color_term, true),
  355    !,
  356    (   is_list(Attr)
  357    ->  sgr_codes(Attr, Codes),
  358        atomic_list_concat(Codes, ;, Code)
  359    ;   sgr_code(Attr, Code)
  360    ),
  361    keep_line_pos(S, format(S, '\e[~wm', [Code])),
  362    Ctx = ansi('\e[0m', '\e[0m\e[~wm'-[Code]).
  363prolog:message_line_element(S, end(Ctx)) :-
  364    nonvar(Ctx),
  365    Ctx = ansi(Reset, _),
  366    keep_line_pos(S, write(S, Reset)).
  367
  368sgr_codes([], []).
  369sgr_codes([H0|T0], [H|T]) :-
  370    sgr_code(H0, H),
  371    sgr_codes(T0, T).
  372
  373level_attrs(Level,         Attrs) :-
  374    user:message_property(Level, color(Attrs)),
  375    !.
  376level_attrs(Level,         Attrs) :-
  377    class_attrs(message(Level), Attrs).
  378
  379class_attrs(Class, Attrs) :-
  380    user:message_property(Class, color(Attrs)),
  381    !.
  382class_attrs(Class, Attrs) :-
  383    prolog:console_color(Class, Attrs),
  384    !.
  385class_attrs(Class, Attrs) :-
  386    '$messages':default_theme(Class, Attrs),
  387    !.
  388class_attrs(Attrs, Attrs).
  389
  390%!  keep_line_pos(+Stream, :Goal)
  391%
  392%   Run goal without changing the position   information on Stream. This
  393%   is used to avoid that the exchange   of  ANSI sequences modifies the
  394%   notion of, notably, the `line_pos` notion.
  395
  396keep_line_pos(S, G) :-
  397    stream_property(S, position(Pos)),
  398    !,
  399    setup_call_cleanup(
  400        stream_position_data(line_position, Pos, LPos),
  401        G,
  402        set_stream(S, line_position(LPos))).
  403keep_line_pos(_, G) :-
  404    call(G).
  405
  406%!  ansi_get_color(+Which, -RGB) is semidet.
  407%
  408%   Obtain the RGB color for an ANSI  color parameter. Which is either a
  409%   color alias or  an  integer  ANSI   color  id.  Defined  aliases are
  410%   `foreground` and `background`. This predicate sends a request to the
  411%   console (`user_output`) and reads the reply. This assumes an `xterm`
  412%   compatible terminal.
  413%
  414%   @arg RGB is a term rgb(Red,Green,Blue).  The color components are
  415%   integers in the range 0..65535.
  416
  417
  418:- if(current_predicate(call_with_time_limit/2)).  419ansi_get_color(Which0, RGB) :-
  420    stream_property(user_input, tty(true)),
  421    stream_property(user_output, tty(true)),
  422    stream_property(user_error, tty(true)),
  423    supports_get_color,
  424    (   color_alias(Which0, Which)
  425    ->  true
  426    ;   must_be(between(0,15),Which0)
  427    ->  Which = Which0
  428    ),
  429    catch(keep_line_pos(user_output,
  430                        ansi_get_color_(Which, RGB)),
  431          time_limit_exceeded,
  432          no_xterm).
  433
  434supports_get_color :-
  435    getenv('TERM', Term),
  436    sub_atom(Term, 0, _, _, xterm),
  437    \+ getenv('TERM_PROGRAM', 'Apple_Terminal').
  438
  439color_alias(foreground, 10).
  440color_alias(background, 11).
  441
  442ansi_get_color_(Which, rgb(R,G,B)) :-
  443    format(codes(Id), '~w', [Which]),
  444    hex4(RH),
  445    hex4(GH),
  446    hex4(BH),
  447    phrase(("\e]", Id, ";rgb:", RH, "/", GH, "/", BH, "\a"), Pattern),
  448    call_with_time_limit(0.05,
  449                         with_tty_raw(exchange_pattern(Which, Pattern))),
  450    !,
  451    hex_val(RH, R),
  452    hex_val(GH, G),
  453    hex_val(BH, B).
  454
  455no_xterm :-
  456    print_message(warning, ansi(no_xterm_get_colour)),
  457    fail.
  458
  459hex4([_,_,_,_]).
  460
  461hex_val([D1,D2,D3,D4], V) :-
  462    code_type(D1, xdigit(V1)),
  463    code_type(D2, xdigit(V2)),
  464    code_type(D3, xdigit(V3)),
  465    code_type(D4, xdigit(V4)),
  466    V is (V1<<12)+(V2<<8)+(V3<<4)+V4.
  467
  468exchange_pattern(Which, Pattern) :-
  469    format(user_output, '\e]~w;?\a', [Which]),
  470    flush_output(user_output),
  471    read_pattern(user_input, Pattern, []).
  472
  473read_pattern(From, Pattern, NotMatched0) :-
  474    copy_term(Pattern, TryPattern),
  475    append(Skip, Rest, NotMatched0),
  476    append(Rest, RestPattern, TryPattern),
  477    !,
  478    echo(Skip),
  479    try_read_pattern(From, RestPattern, NotMatched, Done),
  480    (   Done == true
  481    ->  Pattern = TryPattern
  482    ;   read_pattern(From, Pattern, NotMatched)
  483    ).
  484
  485%!  try_read_pattern(+From, +Pattern, -NotMatched)
  486
  487try_read_pattern(_, [], [], true) :-
  488    !.
  489try_read_pattern(From, [H|T], [C|RT], Done) :-
  490    get_code(C),
  491    (   C = H
  492    ->  try_read_pattern(From, T, RT, Done)
  493    ;   RT = [],
  494        Done = false
  495    ).
  496
  497echo([]).
  498echo([H|T]) :-
  499    put_code(user_output, H),
  500    echo(T).
  501
  502:- else.  503ansi_get_color(_Which0, _RGB) :-
  504    fail.
  505:- endif.  506
  507
  508
  509:- multifile prolog:message//1.  510
  511prolog:message(ansi(no_xterm_get_colour)) -->
  512    [ 'Terminal claims to be xterm compatible,'-[], nl,
  513      'but does not report colour info'-[]
  514    ]