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-2023, 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, instantiation_error/1]).   44:- autoload(library(lists), [append/3]).   45:- autoload(library(uri), [uri_file_name/2]).   46:- if(exists_source(library(time))).   47:- autoload(library(time), [call_with_time_limit/2]).   48:- endif.   49
   50
   51/** <module> Print decorated text to ANSI consoles
   52
   53This library allows for exploiting the color and attribute facilities of
   54most modern terminals using ANSI escape sequences. This library provides
   55the following:
   56
   57  - ansi_format/3 allows writing messages to the terminal with ansi
   58    attributes.
   59  - It defines the hook prolog:message_line_element/2, which provides
   60    ansi attributes and hyperlinks for print_message/2.
   61
   62The behavior of this library is controlled by two Prolog flags:
   63
   64  - `color_term`
   65    When `true`, activate the color output for this library.  Otherwise
   66    simply call format/3.
   67  - `hyperlink_term`
   68    Emit terminal hyperlinks for url(Location) and url(URL, Label)
   69    elements of Prolog messages.
   70
   71@see    http://en.wikipedia.org/wiki/ANSI_escape_code
   72*/
   73
   74:- multifile
   75    prolog:console_color/2,                     % +Term, -AnsiAttrs
   76    supports_get_color/0,
   77    hyperlink/2.                                % +Stream, +Spec
   78
   79
   80color_term_flag_default(true) :-
   81    stream_property(user_input, tty(true)),
   82    stream_property(user_error, tty(true)),
   83    stream_property(user_output, tty(true)),
   84    \+ getenv('TERM', dumb),
   85    !.
   86color_term_flag_default(false).
   87
   88init_color_term_flag :-
   89    color_term_flag_default(Default),
   90    create_prolog_flag(color_term, Default,
   91                       [ type(boolean),
   92                         keep(true)
   93                       ]),
   94    create_prolog_flag(hyperlink_term, false,
   95                       [ type(boolean),
   96                         keep(true)
   97                       ]).
   98
   99:- init_color_term_flag.  100
  101
  102:- meta_predicate
  103    keep_line_pos(+, 0).  104
  105:- multifile
  106    user:message_property/2.  107
  108%!  ansi_format(+ClassOrAttributes, +Format, +Args) is det.
  109%
  110%   Format text with ANSI  attributes.   This  predicate  behaves as
  111%   format/2 using Format and Args, but if the =current_output= is a
  112%   terminal, it adds ANSI escape sequences according to Attributes.
  113%   For example, to print a text in bold cyan, do
  114%
  115%     ==
  116%     ?- ansi_format([bold,fg(cyan)], 'Hello ~w', [world]).
  117%     ==
  118%
  119%   Attributes is either a single attribute, a   list  thereof or a term
  120%   that is mapped to concrete  attributes   based  on the current theme
  121%   (see prolog:console_color/2). The attribute names   are derived from
  122%   the ANSI specification. See the source   for sgr_code/2 for details.
  123%   Some commonly used attributes are:
  124%
  125%     - bold
  126%     - underline
  127%     - fg(Color), bg(Color), hfg(Color), hbg(Color)
  128%       For fg(Color) and bg(Color), the colour name can be '#RGB' or
  129%       '#RRGGBB'
  130%     - fg8(Spec), bg8(Spec)
  131%       8-bit color specification.  Spec is a colour name, h(Color)
  132%       or an integer 0..255.
  133%     - fg(R,G,B), bg(R,G,B)
  134%       24-bit (direct color) specification.  The components are
  135%       integers in the range 0..255.
  136%
  137%   Defined color constants are below.  =default=   can  be  used to
  138%   access the default color of the terminal.
  139%
  140%     - black, red, green, yellow, blue, magenta, cyan, white
  141%
  142%   ANSI sequences are sent if and only if
  143%
  144%     - The =current_output= has the property tty(true) (see
  145%       stream_property/2).
  146%     - The Prolog flag =color_term= is =true=.
  147
  148ansi_format(Attr, Format, Args) :-
  149    ansi_format(current_output, Attr, Format, Args).
  150
  151ansi_format(Stream, Class, Format, Args) :-
  152    stream_property(Stream, tty(true)),
  153    current_prolog_flag(color_term, true),
  154    !,
  155    class_attrs(Class, Attr),
  156    phrase(sgr_codes_ex(Attr), Codes),
  157    atomic_list_concat(Codes, ;, Code),
  158    with_output_to(
  159        Stream,
  160        (   keep_line_pos(current_output, format('\e[~wm', [Code])),
  161            format(Format, Args),
  162            keep_line_pos(current_output, format('\e[0m'))
  163        )
  164    ),
  165    flush_output.
  166ansi_format(Stream, _Attr, Format, Args) :-
  167    format(Stream, Format, Args).
  168
  169sgr_codes_ex(X) -->
  170    { var(X),
  171      !,
  172      instantiation_error(X)
  173    }.
  174sgr_codes_ex([]) -->
  175    !.
  176sgr_codes_ex([H|T]) -->
  177    !,
  178    sgr_codes_ex(H),
  179    sgr_codes_ex(T).
  180sgr_codes_ex(Attr) -->
  181    (   { sgr_code(Attr, Code) }
  182    ->  (   { is_list(Code) }
  183        ->  list(Code)
  184        ;   [Code]
  185        )
  186    ;   { domain_error(sgr_code, Attr) }
  187    ).
  188
  189list([]) --> [].
  190list([H|T]) --> [H], list(T).
  191
  192
  193%!  sgr_code(+Name, -Code)
  194%
  195%   True when code is the Select   Graphic  Rendition code for Name.
  196%   The defined names are given below. Note that most terminals only
  197%   implement this partially.
  198%
  199%     | reset                       | all attributes off    |
  200%     | bold                        |                       |
  201%     | faint                       |       |
  202%     | italic                      |       |
  203%     | underline                   |       |
  204%     | blink(slow)                 |       |
  205%     | blink(rapid)                |       |
  206%     | negative                    |       |
  207%     | conceal                     |       |
  208%     | crossed_out                 |       |
  209%     | font(primary)               |       |
  210%     | font(N)                     | Alternate font (1..8) |
  211%     | fraktur                     |       |
  212%     | underline(double)           |       |
  213%     | intensity(normal)           |       |
  214%     | fg(Name)                    | Color name    |
  215%     | bg(Name)                    | Color name    |
  216%     | framed                      |       |
  217%     | encircled                   |       |
  218%     | overlined                   |       |
  219%     | ideogram(underline)         |       |
  220%     | right_side_line             |       |
  221%     | ideogram(underline(double)) |       |
  222%     | right_side_line(double)     |       |
  223%     | ideogram(overlined)         |       |
  224%     | left_side_line              |       |
  225%     | ideogram(stress_marking)    |       |
  226%     | -Off                        | Switch attributes off |
  227%     | hfg(Name)                   | Color name    |
  228%     | hbg(Name)                   | Color name    |
  229%
  230%   @see http://en.wikipedia.org/wiki/ANSI_escape_code
  231
  232sgr_code(reset, 0).
  233sgr_code(bold,  1).
  234sgr_code(faint, 2).
  235sgr_code(italic, 3).
  236sgr_code(underline, 4).
  237sgr_code(blink(slow), 5).
  238sgr_code(blink(rapid), 6).
  239sgr_code(negative, 7).
  240sgr_code(conceal, 8).
  241sgr_code(crossed_out, 9).
  242sgr_code(font(primary), 10) :- !.
  243sgr_code(font(N), C) :-
  244    C is 10+N.
  245sgr_code(fraktur, 20).
  246sgr_code(underline(double), 21).
  247sgr_code(intensity(normal), 22).
  248sgr_code(fg(Name), C) :-
  249    (   ansi_color(Name, N)
  250    ->  C is N+30
  251    ;   rgb(Name, R, G, B)
  252    ->  sgr_code(fg(R,G,B), C)
  253    ).
  254sgr_code(bg(Name), C) :-
  255    !,
  256    (   ansi_color(Name, N)
  257    ->  C is N+40
  258    ;   rgb(Name, R, G, B)
  259    ->  sgr_code(bg(R,G,B), C)
  260    ).
  261sgr_code(framed, 51).
  262sgr_code(encircled, 52).
  263sgr_code(overlined, 53).
  264sgr_code(ideogram(underline), 60).
  265sgr_code(right_side_line, 60).
  266sgr_code(ideogram(underline(double)), 61).
  267sgr_code(right_side_line(double), 61).
  268sgr_code(ideogram(overlined), 62).
  269sgr_code(left_side_line, 62).
  270sgr_code(ideogram(stress_marking), 64).
  271sgr_code(-X, Code) :-
  272    off_code(X, Code).
  273sgr_code(hfg(Name), C) :-
  274    ansi_color(Name, N),
  275    C is N+90.
  276sgr_code(hbg(Name), C) :-
  277    !,
  278    ansi_color(Name, N),
  279    C is N+100.
  280sgr_code(fg8(Name), [38,5,N]) :-
  281    ansi_color8(Name, N).
  282sgr_code(bg8(Name), [48,5,N]) :-
  283    ansi_color8(Name, N).
  284sgr_code(fg(R,G,B), [38,2,R,G,B]) :-
  285    between(0, 255, R),
  286    between(0, 255, G),
  287    between(0, 255, B).
  288sgr_code(bg(R,G,B), [48,2,R,G,B]) :-
  289    between(0, 255, R),
  290    between(0, 255, G),
  291    between(0, 255, B).
  292
  293off_code(italic_and_franktur, 23).
  294off_code(underline, 24).
  295off_code(blink, 25).
  296off_code(negative, 27).
  297off_code(conceal, 28).
  298off_code(crossed_out, 29).
  299off_code(framed, 54).
  300off_code(overlined, 55).
  301
  302ansi_color8(h(Name), N) :-
  303    !,
  304    ansi_color(Name, N0),
  305    N is N0+8.
  306ansi_color8(Name, N) :-
  307    atom(Name),
  308    !,
  309    ansi_color(Name, N).
  310ansi_color8(N, N) :-
  311    between(0, 255, N).
  312
  313ansi_color(black,   0).
  314ansi_color(red,     1).
  315ansi_color(green,   2).
  316ansi_color(yellow,  3).
  317ansi_color(blue,    4).
  318ansi_color(magenta, 5).
  319ansi_color(cyan,    6).
  320ansi_color(white,   7).
  321ansi_color(default, 9).
  322
  323rgb(Name, R, G, B) :-
  324    atom_codes(Name, [0'#,R1,R2,G1,G2,B1,B2]),
  325    hex_color(R1,R2,R),
  326    hex_color(G1,G2,G),
  327    hex_color(B1,B2,B).
  328rgb(Name, R, G, B) :-
  329    atom_codes(Name, [0'#,R1,G1,B1]),
  330    hex_color(R1,R),
  331    hex_color(G1,G),
  332    hex_color(B1,B).
  333
  334hex_color(D1,D2,V) :-
  335    code_type(D1, xdigit(V1)),
  336    code_type(D2, xdigit(V2)),
  337    V is 16*V1+V2.
  338
  339hex_color(D1,V) :-
  340    code_type(D1, xdigit(V1)),
  341    V is 16*V1+V1.
  342
  343%!  prolog:console_color(+Term, -AnsiAttributes) is semidet.
  344%
  345%   Hook that allows  for  mapping  abstract   terms  to  concrete  ANSI
  346%   attributes. This hook  is  used  by   _theme_  files  to  adjust the
  347%   rendering based on  user  preferences   and  context.  Defaults  are
  348%   defined in the file `boot/messages.pl`.
  349%
  350%   @see library(theme/dark) for an example  implementation and the Term
  351%   values used by the system messages.
  352
  353
  354                 /*******************************
  355                 *             HOOK             *
  356                 *******************************/
  357
  358%!  prolog:message_line_element(+Stream, +Term) is semidet.
  359%
  360%   Hook implementation that deals with  ansi(+Attr, +Fmt, +Args) in
  361%   message specifications.
  362
  363prolog:message_line_element(S, ansi(Class, Fmt, Args)) :-
  364    class_attrs(Class, Attr),
  365    ansi_format(S, Attr, Fmt, Args).
  366prolog:message_line_element(S, ansi(Class, Fmt, Args, Ctx)) :-
  367    class_attrs(Class, Attr),
  368    ansi_format(S, Attr, Fmt, Args),
  369    (   nonvar(Ctx),
  370        Ctx = ansi(_, RI-RA)
  371    ->  keep_line_pos(S, format(S, RI, RA))
  372    ;   true
  373    ).
  374prolog:message_line_element(S, url(Location)) :-
  375    ansi_hyperlink(S, Location).
  376prolog:message_line_element(S, url(URL, Label)) :-
  377    ansi_hyperlink(S, URL, Label).
  378prolog:message_line_element(S, begin(Level, Ctx)) :-
  379    level_attrs(Level, Attr),
  380    stream_property(S, tty(true)),
  381    current_prolog_flag(color_term, true),
  382    !,
  383    (   is_list(Attr)
  384    ->  sgr_codes(Attr, Codes),
  385        atomic_list_concat(Codes, ;, Code)
  386    ;   sgr_code(Attr, Code)
  387    ),
  388    keep_line_pos(S, format(S, '\e[~wm', [Code])),
  389    Ctx = ansi('\e[0m', '\e[0m\e[~wm'-[Code]).
  390prolog:message_line_element(S, end(Ctx)) :-
  391    nonvar(Ctx),
  392    Ctx = ansi(Reset, _),
  393    keep_line_pos(S, write(S, Reset)).
  394
  395sgr_codes([], []).
  396sgr_codes([H0|T0], [H|T]) :-
  397    sgr_code(H0, H),
  398    sgr_codes(T0, T).
  399
  400level_attrs(Level,         Attrs) :-
  401    user:message_property(Level, color(Attrs)),
  402    !.
  403level_attrs(Level,         Attrs) :-
  404    class_attrs(message(Level), Attrs).
  405
  406class_attrs(Class, Attrs) :-
  407    user:message_property(Class, color(Attrs)),
  408    !.
  409class_attrs(Class, Attrs) :-
  410    prolog:console_color(Class, Attrs),
  411    !.
  412class_attrs(Class, Attrs) :-
  413    '$messages':default_theme(Class, Attrs),
  414    !.
  415class_attrs(Attrs, Attrs).
  416
  417%!  ansi_hyperlink(+Stream, +Location) is det.
  418%!  ansi_hyperlink(+Stream, +URL, +Label) is det.
  419%
  420%   Create a hyperlink for a terminal emulator. The file is fairly easy,
  421%   but getting the line and column across is   not as there seems to be
  422%   no established standard. The  current   implementation  emits, i.e.,
  423%   inserting a capital ``L`` before the line.
  424%
  425%       ``file://AbsFileName[#LLine[:Column]]``
  426%
  427%   @see https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda
  428
  429ansi_hyperlink(Stream, Location) :-
  430    hyperlink(Stream, url(Location)),
  431    !.
  432ansi_hyperlink(Stream, Location) :-
  433    location_label(Location, Label),
  434    ansi_hyperlink(Stream, Location, Label).
  435
  436location_label(File:Line:Column, Label) =>
  437    format(string(Label), '~w:~w:~w', [File,Line,Column]).
  438location_label(File:Line, Label) =>
  439    format(string(Label), '~w:~w', [File,Line]).
  440location_label(File, Label) =>
  441    format(string(Label), '~w', [File]).
  442
  443ansi_hyperlink(Stream, Location, Label) :-
  444    hyperlink(Stream, url(Location, Label)),
  445    !.
  446ansi_hyperlink(Stream, File:Line:Column, Label) :-
  447    !,
  448    (   url_file_name(URI, File)
  449    ->  format(Stream, '\e]8;;~w#~d:~d\e\\~w\e]8;;\e\\',
  450               [ URI, Line, Column, Label ])
  451    ;   format(Stream, '~w', [Label])
  452    ).
  453ansi_hyperlink(Stream, File:Line, Label) :-
  454    !,
  455    (   url_file_name(URI, File)
  456    ->  format(Stream, '\e]8;;~w#~w\e\\~w\e]8;;\e\\',
  457               [ URI, Line, Label ])
  458    ;   format(Stream, '~w:~w', [File, Line])
  459    ).
  460ansi_hyperlink(Stream, File, Label) :-
  461    (   url_file_name(URI, File)
  462    ->  format(Stream, '\e]8;;~w\e\\~w\e]8;;\e\\',
  463               [ URI, Label ])
  464    ;   format(Stream, '~w', [File])
  465    ).
  466
  467
  468
  469%!  hyperlink(+Stream, +Spec) is semidet.
  470%
  471%   Multifile hook that may be used   to redefine ansi_hyperlink/2,3. If
  472%   this predicate succeeds the system assumes the link has been written
  473%   to Stream.
  474%
  475%   @arg  Spec  is  either  url(Location)    or   url(URL,  Label).  See
  476%   ansi_hyperlink/2,3 for details.
  477
  478:- dynamic has_lib_uri/1 as volatile.  479
  480url_file_name(URL, File) :-
  481    current_prolog_flag(hyperlink_term, true),
  482    (   has_lib_uri(true)
  483    ->  uri_file_name(URL, File)
  484    ;   exists_source(library(uri))
  485    ->  use_module(library(uri), [uri_file_name/2]),
  486        uri_file_name(URL, File),
  487        asserta(has_lib_uri(true))
  488    ;   asserta(has_lib_uri(false)),
  489        fail
  490    ).
  491
  492%!  keep_line_pos(+Stream, :Goal)
  493%
  494%   Run goal without changing the position   information on Stream. This
  495%   is used to avoid that the exchange   of  ANSI sequences modifies the
  496%   notion of, notably, the `line_pos` notion.
  497
  498keep_line_pos(S, G) :-
  499    stream_property(S, position(Pos)),
  500    !,
  501    setup_call_cleanup(
  502        stream_position_data(line_position, Pos, LPos),
  503        G,
  504        set_stream(S, line_position(LPos))).
  505keep_line_pos(_, G) :-
  506    call(G).
  507
  508%!  ansi_get_color(+Which, -RGB) is semidet.
  509%
  510%   Obtain the RGB color for an ANSI  color parameter. Which is either a
  511%   color alias or  an  integer  ANSI   color  id.  Defined  aliases are
  512%   `foreground` and `background`. This predicate sends a request to the
  513%   console (`user_output`) and reads the reply. This assumes an `xterm`
  514%   compatible terminal.
  515%
  516%   @arg RGB is a term rgb(Red,Green,Blue).  The color components are
  517%   integers in the range 0..65535.
  518
  519
  520:- if(current_predicate(call_with_time_limit/2)).  521ansi_get_color(Which0, RGB) :-
  522    stream_property(user_input, tty(true)),
  523    stream_property(user_output, tty(true)),
  524    stream_property(user_error, tty(true)),
  525    supports_get_color,
  526    (   color_alias(Which0, Which)
  527    ->  true
  528    ;   must_be(between(0,15),Which0)
  529    ->  Which = Which0
  530    ),
  531    catch(keep_line_pos(user_output,
  532                        ansi_get_color_(Which, RGB)),
  533          time_limit_exceeded,
  534          no_xterm).
  535
  536supports_get_color :-
  537    getenv('TERM', Term),
  538    sub_atom(Term, 0, _, _, xterm),
  539    \+ getenv('TERM_PROGRAM', 'Apple_Terminal').
  540
  541color_alias(foreground, 10).
  542color_alias(background, 11).
  543
  544ansi_get_color_(Which, rgb(R,G,B)) :-
  545    format(codes(Id), '~w', [Which]),
  546    hex4(RH),
  547    hex4(GH),
  548    hex4(BH),
  549    phrase(("\e]", Id, ";rgb:", RH, "/", GH, "/", BH, "\a"), Pattern),
  550    call_with_time_limit(0.05,
  551                         with_tty_raw(exchange_pattern(Which, Pattern))),
  552    !,
  553    hex_val(RH, R),
  554    hex_val(GH, G),
  555    hex_val(BH, B).
  556
  557no_xterm :-
  558    print_message(warning, ansi(no_xterm_get_colour)),
  559    fail.
  560
  561hex4([_,_,_,_]).
  562
  563hex_val([D1,D2,D3,D4], V) :-
  564    code_type(D1, xdigit(V1)),
  565    code_type(D2, xdigit(V2)),
  566    code_type(D3, xdigit(V3)),
  567    code_type(D4, xdigit(V4)),
  568    V is (V1<<12)+(V2<<8)+(V3<<4)+V4.
  569
  570exchange_pattern(Which, Pattern) :-
  571    format(user_output, '\e]~w;?\a', [Which]),
  572    flush_output(user_output),
  573    read_pattern(user_input, Pattern, []).
  574
  575read_pattern(From, Pattern, NotMatched0) :-
  576    copy_term(Pattern, TryPattern),
  577    append(Skip, Rest, NotMatched0),
  578    append(Rest, RestPattern, TryPattern),
  579    !,
  580    echo(Skip),
  581    try_read_pattern(From, RestPattern, NotMatched, Done),
  582    (   Done == true
  583    ->  Pattern = TryPattern
  584    ;   read_pattern(From, Pattern, NotMatched)
  585    ).
  586
  587%!  try_read_pattern(+From, +Pattern, -NotMatched)
  588
  589try_read_pattern(_, [], [], true) :-
  590    !.
  591try_read_pattern(From, [H|T], [C|RT], Done) :-
  592    get_code(C),
  593    (   C = H
  594    ->  try_read_pattern(From, T, RT, Done)
  595    ;   RT = [],
  596        Done = false
  597    ).
  598
  599echo([]).
  600echo([H|T]) :-
  601    put_code(user_output, H),
  602    echo(T).
  603
  604:- else.  605ansi_get_color(_Which0, _RGB) :-
  606    fail.
  607:- endif.  608
  609
  610
  611:- multifile prolog:message//1.  612
  613prolog:message(ansi(no_xterm_get_colour)) -->
  614    [ 'Terminal claims to be xterm compatible,'-[], nl,
  615      'but does not report colour info'-[]
  616    ]