1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org/projects/xpce/
    6    Copyright (c)  2011-2025, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(prolog_colour,
   39          [ prolog_colourise_stream/3,  % +Stream, +SourceID, :ColourItem
   40            prolog_colourise_stream/4,  % +Stream, +SourceID, :ColourItem, +Opts
   41            prolog_colourise_term/4,    % +Stream, +SourceID, :ColourItem, +Opts
   42            prolog_colourise_query/3,   % +String, +SourceID, :ColourItem
   43            syntax_colour/2,            % +Class, -Attributes
   44            syntax_message//1           % +Class
   45          ]).   46:- use_module(library(record),[(record)/1, op(_,_,record)]).   47:- use_module(library(debug),[debug/3]).   48:- autoload(library(apply),[maplist/3]).   49:- autoload(library(error),[is_of_type/2]).   50:- autoload(library(lists),[member/2,append/3]).   51:- autoload(library(operators),
   52	    [push_operators/1,pop_operators/0,push_op/3]).   53:- autoload(library(option),[option/3]).   54:- autoload(library(predicate_options),
   55	    [current_option_arg/2,current_predicate_options/3]).   56:- autoload(library(prolog_clause),[predicate_name/2]).   57:- autoload(library(prolog_source),
   58	    [ load_quasi_quotation_syntax/2,
   59	      read_source_term_at_location/3,
   60	      prolog_canonical_source/2
   61	    ]).   62:- autoload(library(prolog_xref),
   63	    [ xref_option/2,
   64	      xref_public_list/3,
   65	      xref_op/2,
   66	      xref_prolog_flag/4,
   67	      xref_module/2,
   68	      xref_meta/3,
   69	      xref_source_file/4,
   70	      xref_defined/3,
   71	      xref_called/3,
   72	      xref_defined_class/3,
   73	      xref_exported/2,
   74	      xref_hook/1
   75	    ]).   76
   77:- meta_predicate
   78    prolog_colourise_stream(+, +, 3),
   79    prolog_colourise_stream(+, +, 3, +),
   80    prolog_colourise_query(+, +, 3),
   81    prolog_colourise_term(+, +, 3, +).   82
   83:- predicate_options(prolog_colourise_term/4, 4,
   84                     [ subterm_positions(-any)
   85                     ]).   86:- predicate_options(prolog_colourise_stream/4, 4,
   87                     [ operators(list(any))
   88                     ]).   89
   90/** <module> Prolog syntax colouring support.
   91
   92This module defines reusable code to colourise Prolog source.
   93
   94@tbd: The one-term version
   95*/
   96
   97
   98:- multifile
   99    style/2,                        % +ColourClass, -Attributes
  100    message//1,                     % +ColourClass
  101    term_colours/2,                 % +SourceTerm, -ColourSpec
  102    goal_colours/2,                 % +Goal, -ColourSpec
  103    goal_colours/3,                 % +Goal, +Class, -ColourSpec
  104    directive_colours/2,            % +Goal, -ColourSpec
  105    goal_classification/2,          % +Goal, -Class
  106    vararg_goal_classification/3.   % +Name, +Arity, -Class
  107
  108
  109:- record
  110    colour_state(source_id_list,
  111                 module,
  112                 stream,
  113                 closure,
  114                 singletons,
  115                 current_variable).  116
  117colour_state_source_id(State, SourceID) :-
  118    colour_state_source_id_list(State, SourceIDList),
  119    member(SourceID, SourceIDList).
  120
  121%!  prolog_colourise_stream(+Stream, +SourceID, :ColourItem) is det.
  122%!  prolog_colourise_stream(+Stream, +SourceID, :ColourItem, +Opts) is det.
  123%
  124%   Determine colour fragments for the data   on Stream. SourceID is
  125%   the  canonical  identifier  of  the  input    as  known  to  the
  126%   cross-referencer, i.e., as created using xref_source(SourceID).
  127%
  128%   ColourItem is a closure  that  is   called  for  each identified
  129%   fragment with three additional arguments:
  130%
  131%     * The syntactical category
  132%     * Start position (character offset) of the fragment
  133%     * Length of the fragment (in characters).
  134%
  135%   Options
  136%
  137%     - operators(+Ops)
  138%       Provide an initial list of additional operators.
  139
  140prolog_colourise_stream(Fd, SourceId, ColourItem) :-
  141    prolog_colourise_stream(Fd, SourceId, ColourItem, []).
  142prolog_colourise_stream(Fd, SourceId, ColourItem, Options) :-
  143    to_list(SourceId, SourceIdList),
  144    make_colour_state([ source_id_list(SourceIdList),
  145                        stream(Fd),
  146                        closure(ColourItem)
  147                      ],
  148                      TB),
  149    option(operators(Ops), Options, []),
  150    setup_call_cleanup(
  151        save_settings(TB, Ops, State),
  152        colourise_stream(Fd, TB),
  153        restore_settings(State)).
  154
  155to_list(List, List) :-
  156    is_list(List),
  157    !.
  158to_list(One, [One]).
  159
  160
  161colourise_stream(Fd, TB) :-
  162    (   peek_char(Fd, #)            % skip #! script line
  163    ->  skip(Fd, 10)
  164    ;   true
  165    ),
  166    repeat,
  167        colour_state_module(TB, SM),
  168        character_count(Fd, Start),
  169        catch(read_term(Fd, Term,
  170                        [ subterm_positions(TermPos),
  171                          singletons(Singletons0),
  172                          module(SM),
  173                          comments(Comments)
  174                        ]),
  175              E,
  176              read_error(E, TB, Start, Fd)),
  177        fix_operators(Term, SM, TB),
  178        warnable_singletons(Singletons0, Singletons),
  179        colour_state_singletons(TB, Singletons),
  180        (   colourise_term(Term, TB, TermPos, Comments)
  181        ->  true
  182        ;   arg(1, TermPos, From),
  183            print_message(warning,
  184                          format('Failed to colourise ~p at index ~d~n',
  185                                 [Term, From]))
  186        ),
  187        Term == end_of_file,
  188    !.
  189
  190save_settings(TB, Ops, state(Style, Flags, OSM, Xref)) :-
  191    (   source_module(TB, SM)
  192    ->  true
  193    ;   SM = prolog_colour_ops
  194    ),
  195    set_xref(Xref, true),
  196    '$set_source_module'(OSM, SM),
  197    colour_state_module(TB, SM),
  198    maplist(qualify_op(SM), Ops, QOps),
  199    push_operators(QOps),
  200    syntax_flags(Flags),
  201    '$style_check'(Style, Style).
  202
  203qualify_op(M, op(P,T,[]), Q)            => Q = op(P,T,M:[]).
  204qualify_op(M, op(P,T,N), Q), atom(N)    => Q = op(P,T,M:N).
  205qualify_op(M, op(P,T,L), Q), is_list(Q) =>
  206    Q = op(P, T, QL),
  207    maplist(qualify_op_name(M), L, QL).
  208qualify_op(_, Op, Q)			=> Q = Op.
  209
  210qualify_op_name(M, N,  Q), atom(N) => Q = M:N.
  211qualify_op_name(M, [], Q)          => Q = M:[].
  212qualify_op_name(_, V,  Q)          => Q = V.
  213
  214restore_settings(state(Style, Flags, OSM, Xref)) :-
  215    restore_syntax_flags(Flags),
  216    '$style_check'(_, Style),
  217    pop_operators,
  218    '$set_source_module'(OSM),
  219    set_xref(_, Xref).
  220
  221set_xref(Old, New) :-
  222    current_prolog_flag(xref, Old),
  223    !,
  224    set_prolog_flag(xref, New).
  225set_xref(false, New) :-
  226    set_prolog_flag(xref, New).
  227
  228
  229syntax_flags(Pairs) :-
  230    findall(set_prolog_flag(Flag, Value),
  231            syntax_flag(Flag, Value),
  232            Pairs).
  233
  234syntax_flag(Flag, Value) :-
  235    syntax_flag(Flag),
  236    current_prolog_flag(Flag, Value).
  237
  238restore_syntax_flags([]).
  239restore_syntax_flags([set_prolog_flag(Flag, Value)|T]) :-
  240    set_prolog_flag(Flag, Value),
  241    restore_syntax_flags(T).
  242
  243%!  source_module(+State, -Module) is semidet.
  244%
  245%   True when Module is the module context   into  which the file is
  246%   loaded. This is the module of the file if File is a module file,
  247%   or the load context of  File  if   File  is  not included or the
  248%   module context of the file into which the file was included.
  249
  250source_module(TB, Module) :-
  251    colour_state_source_id_list(TB, []),
  252    !,
  253    colour_state_module(TB, Module).
  254source_module(TB, Module) :-
  255    colour_state_source_id(TB, SourceId),
  256    xref_option(SourceId, module(Module)),
  257    !.
  258source_module(TB, Module) :-
  259    (   colour_state_source_id(TB, File),
  260        atom(File)
  261    ;   colour_state_stream(TB, Fd),
  262        is_stream(Fd),
  263        stream_property(Fd, file_name(File))
  264    ),
  265    module_context(File, [], Module).
  266
  267module_context(File, _, Module) :-
  268    source_file_property(File, module(Module)),
  269    !.
  270module_context(File, Seen, Module) :-
  271    source_file_property(File, included_in(File2, _Line)),
  272    \+ memberchk(File, Seen),
  273    !,
  274    module_context(File2, [File|Seen], Module).
  275module_context(File, _, Module) :-
  276    source_file_property(File, load_context(Module, _, _)).
  277
  278
  279%!  read_error(+Error, +TB, +Start, +Stream) is failure.
  280%
  281%   If this is a syntax error, create a syntax-error fragment.
  282
  283read_error(Error, TB, Start, EndSpec) :-
  284    (   syntax_error(Error, Id, CharNo)
  285    ->  message_to_string(error(syntax_error(Id), _), Msg),
  286        (   integer(EndSpec)
  287        ->  End = EndSpec
  288        ;   character_count(EndSpec, End)
  289        ),
  290        show_syntax_error(TB, CharNo:Msg, Start-End),
  291        fail
  292    ;   throw(Error)
  293    ).
  294
  295syntax_error(error(syntax_error(Id), stream(_S, _Line, _LinePos, CharNo)),
  296             Id, CharNo).
  297syntax_error(error(syntax_error(Id), file(_S, _Line, _LinePos, CharNo)),
  298             Id, CharNo).
  299syntax_error(error(syntax_error(Id), string(_Text, CharNo)),
  300             Id, CharNo).
  301
  302%!  warnable_singletons(+Singletons, -Warn) is det.
  303%
  304%   Warn is the subset of the singletons that we warn about.
  305
  306warnable_singletons([], []).
  307warnable_singletons([H|T0], List) :-
  308    H = (Name=_Var),
  309    (   '$is_named_var'(Name)
  310    ->  List = [H|T]
  311    ;   List = T
  312    ),
  313    warnable_singletons(T0, T).
  314
  315%!  colour_item(+Class, +TB, +Pos) is det.
  316
  317colour_item(Class, TB, Pos) :-
  318    arg(1, Pos, Start),
  319    arg(2, Pos, End),
  320    Len is End - Start,
  321    colour_state_closure(TB, Closure),
  322    call(Closure, Class, Start, Len).
  323
  324
  325%!  safe_push_op(+Prec, +Type, :Name, +State)
  326%
  327%   Define operators into the default source module and register
  328%   them to be undone by pop_operators/0.
  329
  330safe_push_op(P, T, N0, State) :-
  331    colour_state_module(State, CM),
  332    strip_module(CM:N0, M, N),
  333    (   is_list(N),
  334        N \== []                                % define list as operator
  335    ->  acyclic_term(N),
  336        forall(member(Name, N),
  337               safe_push_op(P, T, M:Name, State))
  338    ;   push_op(P, T, M:N)
  339    ),
  340    debug(colour, ':- ~w.', [op(P,T,M:N)]).
  341
  342%!  fix_operators(+Term, +Module, +State) is det.
  343%
  344%   Fix flags that affect the  syntax,   such  as operators and some
  345%   style checking options. Src is the  canonical source as required
  346%   by the cross-referencer.
  347
  348fix_operators((:- Directive), M, Src) :-
  349    callable(Directive),
  350    acyclic_term(Directive),
  351    catch(process_directive(Directive, M, Src), error(_,_), true),
  352    !.
  353fix_operators(_, _, _).
  354
  355:- multifile
  356    prolog:xref_update_syntax/2.  357
  358process_directive(Directive, M, _Src),
  359    ground(Directive),
  360    prolog:xref_update_syntax((:- Directive), M) =>
  361    true.
  362process_directive(style_check(X), _, _), ground(X) =>
  363    style_check(X).
  364process_directive(set_prolog_flag(Flag, Value), M, _),
  365    ground(Flag+Value),
  366    syntax_flag(Flag) =>
  367    set_prolog_flag(M:Flag, Value).
  368process_directive(M:op(P,T,N), _, Src), ground(M) =>
  369    process_directive(op(P,T,N), M, Src).
  370process_directive(op(P,T,N), M, Src), ground(op(P,T,N)) =>
  371    safe_push_op(P, T, M:N, Src).
  372process_directive(module(_Name, Export), M, Src), ground(Export) =>
  373    forall(member(op(P,A,N), Export),
  374           safe_push_op(P,A,M:N, Src)).
  375process_directive(use_module(Spec), _, Src), ground(Spec) =>
  376    catch(process_use_module1(Spec, Src), _, true).
  377process_directive(use_module(Spec, Imports), _, Src), ground(Spec), is_list(Imports) =>
  378    catch(process_use_module2(Spec, Imports, Src), _, true).
  379process_directive(Directive, _, Src), ground(Directive) =>
  380    prolog_source:expand((:-Directive), Src, _).
  381
  382syntax_flag(character_escapes).
  383syntax_flag(var_prefix).
  384syntax_flag(allow_variable_name_as_functor).
  385syntax_flag(allow_dot_in_atom).
  386
  387%!  process_use_module1(+Imports, +Src)
  388%
  389%   Get the exported operators from the referenced files.
  390
  391process_use_module1([], _) :- !.
  392process_use_module1([H|T], Src) :-
  393    !,
  394    process_use_module1(H, Src),
  395    process_use_module1(T, Src).
  396process_use_module1(File, Src) :-
  397    (   xref_public_list(File, Src,
  398                         [ exports(Exports),
  399                           silent(true),
  400                           path(Path)
  401                         ])
  402    ->  forall(member(op(P,T,N), Exports),
  403               safe_push_op(P,T,N,Src)),
  404        colour_state_module(Src, SM),
  405        (   member(Syntax/4, Exports),
  406            load_quasi_quotation_syntax(SM:Path, Syntax),
  407            fail
  408        ;   true
  409        )
  410    ;   true
  411    ).
  412
  413process_use_module2(File, Imports, Src) :-
  414    (   xref_public_list(File, Src,
  415                         [ exports(Exports),
  416                           silent(true),
  417                           path(Path)
  418                         ])
  419    ->  forall(( member(op(P,T,N), Exports),
  420                 member(op(P,T,N), Imports)),
  421               safe_push_op(P,T,N,Src)),
  422        colour_state_module(Src, SM),
  423        (   member(Syntax/4, Exports),
  424            member(Syntax/4, Imports),
  425            load_quasi_quotation_syntax(SM:Path, Syntax),
  426            fail
  427        ;   true
  428        )
  429    ;   true
  430    ).
  431
  432%!  prolog_colourise_query(+Query:string, +SourceId, :ColourItem)
  433%
  434%   Colourise a query, to be executed in the context of SourceId.
  435%
  436%   @arg    SourceId Execute Query in the context of
  437%           the cross-referenced environment SourceID.
  438
  439prolog_colourise_query(QueryString, SourceID, ColourItem) :-
  440    query_colour_state(SourceID, ColourItem, TB),
  441    setup_call_cleanup(
  442        save_settings(TB, [], State),
  443        colourise_query(QueryString, TB),
  444        restore_settings(State)).
  445
  446query_colour_state(module(Module), ColourItem, TB) :-
  447    !,
  448    make_colour_state([ source_id_list([]),
  449                        module(Module),
  450                        closure(ColourItem)
  451                      ],
  452                      TB).
  453query_colour_state(SourceID, ColourItem, TB) :-
  454    to_list(SourceID, SourceIDList),
  455    make_colour_state([ source_id_list(SourceIDList),
  456                        closure(ColourItem)
  457                      ],
  458                      TB).
  459
  460
  461colourise_query(QueryString, TB) :-
  462    colour_state_module(TB, SM),
  463    string_length(QueryString, End),
  464    (   catch(term_string(Query, QueryString,
  465                          [ subterm_positions(TermPos),
  466                            singletons(Singletons0),
  467                            module(SM),
  468                            comments(Comments)
  469                          ]),
  470              E,
  471              read_error(E, TB, 0, End))
  472    ->  warnable_singletons(Singletons0, Singletons),
  473        colour_state_singletons(TB, Singletons),
  474        colourise_comments(Comments, TB),
  475        (   Query == end_of_file
  476        ->  true
  477        ;   colourise_body(Query, TB, TermPos)
  478        )
  479    ;   true                        % only a syntax error
  480    ).
  481
  482%!  prolog_colourise_term(+Stream, +SourceID, :ColourItem, +Options)
  483%
  484%   Colourise    the    next     term      on     Stream.     Unlike
  485%   prolog_colourise_stream/3, this predicate assumes  it is reading
  486%   a single term rather than the   entire stream. This implies that
  487%   it cannot adjust syntax according to directives that precede it.
  488%
  489%   Options:
  490%
  491%     - subterm_positions(-TermPos)
  492%       Return complete term-layout.  If an error is read, this is a
  493%       term error_position(StartClause, EndClause, ErrorPos)
  494%     - current_variable(+VarName)
  495%       Variable to highlight
  496
  497prolog_colourise_term(Stream, SourceId, ColourItem, Options) :-
  498    to_list(SourceId, SourceIdList),
  499    make_colour_state([ source_id_list(SourceIdList),
  500                        stream(Stream),
  501                        closure(ColourItem)
  502                      ],
  503                      TB),
  504    option(subterm_positions(TermPos), Options, _),
  505    findall(Op, xref_op(SourceId, Op), Ops),
  506    debug(colour, 'Ops from ~p: ~p', [SourceId, Ops]),
  507    findall(Opt, xref_flag_option(SourceId, Opt), Opts),
  508    character_count(Stream, Start),
  509    (   source_module(TB, Module)
  510    ->  true
  511    ;   Module = prolog_colour_ops
  512    ),
  513    read_source_term_at_location(
  514        Stream, Term,
  515        [ module(Module),
  516          operators(Ops),
  517          error(Error),
  518          subterm_positions(TermPos),
  519          variable_names(VarNames),
  520          singletons(Singletons0),
  521          comments(Comments)
  522        | Opts
  523        ]),
  524    (   var(Error)
  525    ->  warnable_singletons(Singletons0, Singletons),
  526        colour_state_singletons(TB, Singletons),
  527        set_current_variable(TB, VarNames, Options),
  528        colour_item(range, TB, TermPos),            % Call to allow clearing
  529        colourise_term(Term, TB, TermPos, Comments)
  530    ;   character_count(Stream, End),
  531        TermPos = error_position(Start, End, Pos),
  532        colour_item(range, TB, TermPos),
  533        show_syntax_error(TB, Error, Start-End),
  534        Error = Pos:_Message
  535    ).
  536
  537xref_flag_option(TB, var_prefix(Bool)) :-
  538    xref_prolog_flag(TB, var_prefix, Bool, _Line).
  539
  540show_syntax_error(TB, Pos:Message, Range) :-
  541    integer(Pos),
  542    !,
  543    End is Pos + 1,
  544    colour_item(syntax_error(Message, Range), TB, Pos-End).
  545show_syntax_error(TB, _:Message, Range) :-
  546    colour_item(syntax_error(Message, Range), TB, Range).
  547
  548%!  singleton(@Var, +TB) is semidet.
  549%
  550%   True when Var is a singleton.
  551
  552singleton(Var, TB) :-
  553    colour_state_singletons(TB, Singletons),
  554    member_var(Var, Singletons).
  555
  556member_var(V, [_=V2|_]) :-
  557    V == V2,
  558    !.
  559member_var(V, [_|T]) :-
  560    member_var(V, T).
  561
  562set_current_variable(TB, VarNames, Options) :-
  563    option(current_variable(Name), Options),
  564    memberchk(Name=CV, VarNames),
  565    !,
  566    colour_state_current_variable(TB, CV).
  567set_current_variable(_, _, _).
  568
  569current_variable(Var, TB) :-
  570    colour_state_current_variable(TB, Current),
  571    Var == Current.
  572
  573
  574%!  colourise_term(+Term, +TB, +Termpos, +Comments)
  575%
  576%   Colourise the next Term.
  577%
  578%   @bug    The colour spec is closed with =fullstop=, but the
  579%           position information does not include the full stop
  580%           location, so all we can do is assume it is behind the
  581%           term.
  582
  583colourise_term(Term, TB, TermPos, Comments) :-
  584    colourise_comments(Comments, TB),
  585    (   Term == end_of_file
  586    ->  true
  587    ;   colourise_term(Term, TB, TermPos),
  588        colourise_fullstop(TB, TermPos)
  589    ).
  590
  591colourise_fullstop(TB, TermPos) :-
  592    arg(2, TermPos, EndTerm),
  593    Start is EndTerm,
  594    End is Start+1,
  595    colour_item(fullstop, TB, Start-End).
  596
  597colourise_comments(-, _).
  598colourise_comments([], _).
  599colourise_comments([H|T], TB) :-
  600    colourise_comment(H, TB),
  601    colourise_comments(T, TB).
  602
  603colourise_comment((-)-_, _) :- !.
  604colourise_comment(Pos-Comment, TB) :-
  605    comment_style(Comment, Style),
  606    stream_position_data(char_count, Pos, Start),
  607    string_length(Comment, Len),
  608    End is Start + Len + 1,
  609    colour_item(comment(Style), TB, Start-End).
  610
  611comment_style(Comment, structured) :-           % Starts %%, %! or /**
  612    structured_comment_start(Start),
  613    sub_string(Comment, 0, Len, _, Start),
  614    Next is Len+1,
  615    string_code(Next, Comment, NextCode),
  616    code_type(NextCode, space),
  617    !.
  618comment_style(Comment, line) :-                 % Starts %
  619    sub_string(Comment, 0, _, _, '%'),
  620    !.
  621comment_style(_, block).                        % Starts /*
  622
  623%!  structured_comment_start(-Start)
  624%
  625%   Copied from library(pldoc/doc_process). Unfortunate,   but we do
  626%   not want to force loading pldoc.
  627
  628structured_comment_start('%%').
  629structured_comment_start('%!').
  630structured_comment_start('/**').
  631
  632%!  colourise_term(+Term, +TB, +Pos)
  633%
  634%   Colorise a file toplevel term.
  635
  636colourise_term(Var, TB, Start-End) :-
  637    var(Var),
  638    !,
  639    colour_item(instantiation_error, TB, Start-End).
  640colourise_term(_, _, Pos) :-
  641    var(Pos),
  642    !.
  643colourise_term(Term, TB, parentheses_term_position(PO,PC,Pos)) :-
  644    !,
  645    colour_item(parentheses, TB, PO-PC),
  646    colourise_term(Term, TB, Pos).
  647colourise_term(Term, TB, Pos) :-
  648    term_colours(Term, FuncSpec-ArgSpecs),
  649    !,
  650    Pos = term_position(F,T,FF,FT,ArgPos),
  651    colour_item(term, TB, F-T),     % TBD: Allow specifying by term_colours/2?
  652    specified_item(FuncSpec, Term, TB, FF-FT),
  653    specified_items(ArgSpecs, Term, TB, ArgPos).
  654colourise_term((Pre=>Body), TB,
  655               term_position(F,T,FF,FT,[PP,BP])) :-
  656    nonvar(Pre),
  657    Pre = (Head,Cond),
  658    PP = term_position(_HF,_HT,_HFF,_HFT,[HP,CP]),
  659    !,
  660    colour_item(clause,         TB, F-T),
  661    colour_item(neck(=>),       TB, FF-FT),
  662    colourise_clause_head(Head, TB, HP),
  663    colour_item(rule_condition, TB, CP),
  664    colourise_body(Cond, Head,  TB, CP),
  665    colourise_body(Body, Head,  TB, BP).
  666colourise_term(Term, TB,
  667               term_position(F,T,FF,FT,[HP,BP])) :-
  668    neck(Term, Head, Body, Neck),
  669    !,
  670    colour_item(clause,         TB, F-T),
  671    colour_item(neck(Neck),     TB, FF-FT),
  672    colourise_clause_head(Head, TB, HP),
  673    colourise_body(Body, Head,  TB, BP).
  674colourise_term(((Head,RHC) --> Body), TB,
  675               term_position(F,T,FF,FT,
  676                             [ term_position(_,_,_,_,[HP,RHCP]),
  677                               BP
  678                             ])) :-
  679    !,
  680    colour_item(grammar_rule,       TB, F-T),
  681    colour_item(dcg_right_hand_ctx, TB, RHCP),
  682    colourise_term_arg(RHC, TB, RHCP),
  683    colour_item(neck(-->),          TB, FF-FT),
  684    colourise_extended_head(Head, 2, TB, HP),
  685    colourise_dcg(Body, Head,       TB, BP).
  686colourise_term((Head --> Body), TB,                     % TBD: expansion!
  687               term_position(F,T,FF,FT,[HP,BP])) :-
  688    !,
  689    colour_item(grammar_rule,       TB, F-T),
  690    colour_item(neck(-->),          TB, FF-FT),
  691    colourise_extended_head(Head, 2, TB, HP),
  692    colourise_dcg(Body, Head,       TB, BP).
  693colourise_term(((Head,RHC) ==> Body), TB,
  694               term_position(F,T,FF,FT,
  695                             [ term_position(_,_,_,_,[HP,RHCP]),
  696                               BP
  697                             ])) :-
  698    !,
  699    extend(Head, 2, HeadEx),
  700    colour_item(grammar_rule,        TB, F-T),
  701    colour_item(rule_condition,      TB, RHCP),
  702    colourise_body(RHC, HeadEx,      TB, RHCP),
  703    colour_item(neck(==>),           TB, FF-FT),
  704    colourise_extended_head(Head, 2, TB, HP),
  705    colourise_dcg(Body, Head,        TB, BP).
  706colourise_term((Head ==> Body), TB,                     % TBD: expansion!
  707               term_position(F,T,FF,FT,[HP,BP])) :-
  708    !,
  709    colour_item(grammar_rule,       TB, F-T),
  710    colour_item(neck(==>),          TB, FF-FT),
  711    colourise_extended_head(Head, 2, TB, HP),
  712    colourise_dcg(Body, Head,       TB, BP).
  713colourise_term(:->(Head, Body), TB,
  714               term_position(F,T,FF,FT,[HP,BP])) :-
  715    !,
  716    colour_item(method,             TB, F-T),
  717    colour_item(neck(:->), TB, FF-FT),
  718    colour_method_head(send(Head),  TB, HP),
  719    colourise_method_body(Body,     TB, BP).
  720colourise_term(:<-(Head, Body), TB,
  721               term_position(F,T,FF,FT,[HP,BP])) :-
  722    !,
  723    colour_item(method,            TB, F-T),
  724    colour_item(neck(:<-), TB, FF-FT),
  725    colour_method_head(get(Head),  TB, HP),
  726    colourise_method_body(Body,    TB, BP).
  727colourise_term((:- Directive), TB, Pos) :-
  728    !,
  729    colour_item(directive, TB, Pos),
  730    Pos = term_position(_F,_T,FF,FT,[ArgPos]),
  731    colour_item(neck(directive), TB, FF-FT),
  732    colourise_directive(Directive, TB, ArgPos).
  733colourise_term((?- Directive), TB, Pos) :-
  734    !,
  735    colourise_term((:- Directive), TB, Pos).
  736colourise_term(end_of_file, _, _) :- !.
  737colourise_term(Fact, TB, Pos) :-
  738    !,
  739    colour_item(clause, TB, Pos),
  740    colourise_clause_head(Fact, TB, Pos).
  741
  742neck((Head  :- Body), Head, Body, :-).
  743neck((Head  => Body), Head, Body, =>).
  744neck(?=>(Head, Body), Head, Body, ?=>).
  745
  746%!  colourise_extended_head(+Head, +ExtraArgs, +TB, +Pos) is det.
  747%
  748%   Colourise a clause-head that  is   extended  by  term_expansion,
  749%   getting ExtraArgs more  arguments  (e.g.,   DCGs  add  two  more
  750%   arguments.
  751
  752colourise_extended_head(Head, N, TB, Pos) :-
  753    extend(Head, N, TheHead),
  754    colourise_clause_head(TheHead, TB, Pos).
  755
  756extend(M:Head, N, M:ExtHead) :-
  757    nonvar(Head),
  758    !,
  759    extend(Head, N, ExtHead).
  760extend(Head, N, ExtHead) :-
  761    compound(Head),
  762    !,
  763    compound_name_arguments(Head, Name, Args),
  764    length(Extra, N),
  765    append(Args, Extra, NArgs),
  766    compound_name_arguments(ExtHead, Name, NArgs).
  767extend(Head, N, ExtHead) :-
  768    atom(Head),
  769    !,
  770    length(Extra, N),
  771    compound_name_arguments(ExtHead, Head, Extra).
  772extend(Head, _, Head).
  773
  774
  775colourise_clause_head(_, _, Pos) :-
  776    var(Pos),
  777    !.
  778colourise_clause_head(Head, TB, parentheses_term_position(PO,PC,Pos)) :-
  779    colour_item(parentheses, TB, PO-PC),
  780    colourise_clause_head(Head, TB, Pos).
  781colourise_clause_head(M:Head, TB, QHeadPos) :-
  782    QHeadPos = term_position(_,_,QF,QT,[MPos,HeadPos]),
  783    head_colours(M:Head, meta-[_, ClassSpec-ArgSpecs]),
  784    !,
  785    colourise_module(M, TB, MPos),
  786    colour_item(functor, TB, QF-QT),
  787    functor_position(HeadPos, FPos, ArgPos),
  788    (   ClassSpec == classify
  789    ->  classify_head(TB, Head, Class)
  790    ;   Class = ClassSpec
  791    ),
  792    colour_item(head_term(Class, Head), TB, QHeadPos),
  793    colour_item(head(Class, Head), TB, FPos),
  794    specified_items(ArgSpecs, Head, TB, ArgPos).
  795colourise_clause_head(#(Macro), TB, term_position(_,_,HF,HT,[MPos])) :-
  796    expand_macro(TB, Macro, Head),
  797    !,
  798    macro_term_string(Head, String),
  799    functor_position(MPos, FPos, _),
  800    classify_head(TB, Head, Class),
  801    colour_item(macro(String), TB, HF-HT),
  802    colour_item(head_term(Class, Head), TB, MPos),
  803    colour_item(head(Class, Head), TB, FPos),
  804    colourise_term_args(Macro, TB, MPos).
  805colourise_clause_head(Head, TB, Pos) :-
  806    head_colours(Head, ClassSpec-ArgSpecs),
  807    !,
  808    functor_position(Pos, FPos, ArgPos),
  809    (   ClassSpec == classify
  810    ->  classify_head(TB, Head, Class)
  811    ;   Class = ClassSpec
  812    ),
  813    colour_item(head_term(Class, Head), TB, Pos),
  814    colour_item(head(Class, Head), TB, FPos),
  815    specified_items(ArgSpecs, Head, TB, ArgPos).
  816colourise_clause_head(:=(Eval, Ret), TB,
  817                      term_position(_,_,AF,AT,
  818                                    [ term_position(_,_,SF,ST,
  819                                                    [ SelfPos,
  820                                                      FuncPos
  821                                                    ]),
  822                                      RetPos
  823                                    ])) :-
  824    Eval =.. [.,M,Func],
  825    FuncPos = term_position(_,_,FF,FT,_),
  826    !,
  827    colourise_term_arg(M, TB, SelfPos),
  828    colour_item(func_dot, TB, SF-ST),               % .
  829    colour_item(dict_function(Func), TB, FF-FT),
  830    colourise_term_args(Func, TB, FuncPos),
  831    colour_item(dict_return_op, TB, AF-AT),         % :=
  832    colourise_term_arg(Ret, TB, RetPos).
  833colourise_clause_head(Head, TB, Pos) :-
  834    functor_position(Pos, FPos, _),
  835    classify_head(TB, Head, Class),
  836    colour_item(head_term(Class, Head), TB, Pos),
  837    colour_item(head(Class, Head), TB, FPos),
  838    colourise_term_args(Head, TB, Pos).
  839
  840%!  colourise_extern_head(+Head, +Module, +TB, +Pos)
  841%
  842%   Colourise the head specified as Module:Head. Normally used for
  843%   adding clauses to multifile predicates in other modules.
  844
  845colourise_extern_head(Head, M, TB, Pos) :-
  846    functor_position(Pos, FPos, _),
  847    colour_item(head(extern(M), Head), TB, FPos),
  848    colourise_term_args(Head, TB, Pos).
  849
  850colour_method_head(SGHead, TB, Pos) :-
  851    arg(1, SGHead, Head),
  852    functor_name(SGHead, SG),
  853    functor_position(Pos, FPos, _),
  854    colour_item(method(SG), TB, FPos),
  855    colourise_term_args(Head, TB, Pos).
  856
  857%!  functor_position(+Term, -FunctorPos, -ArgPosList)
  858%
  859%   Get the position of a functor   and  its argument. Unfortunately
  860%   this goes wrong for lists, who have two `functor-positions'.
  861
  862functor_position(term_position(_,_,FF,FT,ArgPos), FF-FT, ArgPos) :- !.
  863functor_position(list_position(F,_T,Elms,none), F-FT, Elms) :-
  864    !,
  865    FT is F + 1.
  866functor_position(dict_position(_,_,FF,FT,KVPos), FF-FT, KVPos) :- !.
  867functor_position(brace_term_position(F,T,Arg), F-T, [Arg]) :- !.
  868functor_position(Pos, Pos, []).
  869
  870colourise_module(Term, TB, Pos) :-
  871    (   var(Term)
  872    ;   atom(Term)
  873    ),
  874    !,
  875    colour_item(module(Term), TB, Pos).
  876colourise_module(_, TB, Pos) :-
  877    colour_item(type_error(module), TB, Pos).
  878
  879%!  colourise_directive(+Body, +TB, +Pos)
  880%
  881%   Colourise the body of a directive.
  882
  883colourise_directive(_,_,Pos) :-
  884    var(Pos),
  885    !.
  886colourise_directive(Dir, TB, parentheses_term_position(PO,PC,Pos)) :-
  887    !,
  888    colour_item(parentheses, TB, PO-PC),
  889    colourise_directive(Dir, TB, Pos).
  890colourise_directive((A,B), TB, term_position(_,_,_,_,[PA,PB])) :-
  891    !,
  892    colourise_directive(A, TB, PA),
  893    colourise_directive(B, TB, PB).
  894colourise_directive(Body, TB, Pos) :-
  895    nonvar(Body),
  896    directive_colours(Body, ClassSpec-ArgSpecs),   % specified
  897    !,
  898    functor_position(Pos, FPos, ArgPos),
  899    (   ClassSpec == classify
  900    ->  goal_classification(TB, Body, [], Class)
  901    ;   Class = ClassSpec
  902    ),
  903    colour_item(goal(Class, Body), TB, FPos),
  904    specified_items(ArgSpecs, Body, TB, ArgPos).
  905colourise_directive(Body, TB, Pos) :-
  906    colourise_body(Body, TB, Pos).
  907
  908
  909%       colourise_body(+Body, +TB, +Pos)
  910%
  911%       Breaks down to colourise_goal/3.
  912
  913colourise_body(Body, TB, Pos) :-
  914    colourise_body(Body, [], TB, Pos).
  915
  916colourise_body(Body, Origin, TB, Pos) :-
  917    colour_item(body, TB, Pos),
  918    colourise_goals(Body, Origin, TB, Pos).
  919
  920%!  colourise_method_body(+MethodBody, +TB, +Pos)
  921%
  922%   Colourise the optional "comment":: as pce(comment) and proceed
  923%   with the body.
  924%
  925%   @tbd    Get this handled by a hook.
  926
  927colourise_method_body(_, _, Pos) :-
  928    var(Pos),
  929    !.
  930colourise_method_body(Body, TB, parentheses_term_position(PO,PC,Pos)) :-
  931    !,
  932    colour_item(parentheses, TB, PO-PC),
  933    colourise_method_body(Body, TB, Pos).
  934colourise_method_body(::(_Comment,Body), TB,
  935                      term_position(_F,_T,_FF,_FT,[CP,BP])) :-
  936    !,
  937    colour_item(comment(string), TB, CP),
  938    colourise_body(Body, TB, BP).
  939colourise_method_body(Body, TB, Pos) :-         % deal with pri(::) < 1000
  940    Body =.. [F,A,B],
  941    control_op(F),
  942    !,
  943    Pos = term_position(_F,_T,FF,FT,
  944                        [ AP,
  945                          BP
  946                        ]),
  947    colour_item(control, TB, FF-FT),
  948    colourise_method_body(A, TB, AP),
  949    colourise_body(B, TB, BP).
  950colourise_method_body(Body, TB, Pos) :-
  951    colourise_body(Body, TB, Pos).
  952
  953control_op(',').
  954control_op((;)).
  955control_op((->)).
  956control_op((*->)).
  957
  958%!  colourise_goals(+Body, +Origin, +TB, +Pos)
  959%
  960%   Colourise the goals in a body.
  961
  962colourise_goals(_, _, _, Pos) :-
  963    var(Pos),
  964    !.
  965colourise_goals(Body, Origin, TB, parentheses_term_position(PO,PC,Pos)) :-
  966    !,
  967    colour_item(parentheses, TB, PO-PC),
  968    colourise_goals(Body, Origin, TB, Pos).
  969colourise_goals(Body, Origin, TB, term_position(_,_,FF,FT,ArgPos)) :-
  970    body_compiled(Body),
  971    !,
  972    colour_item(control, TB, FF-FT),
  973    colourise_subgoals(ArgPos, 1, Body, Origin, TB).
  974colourise_goals(Goal, Origin, TB, Pos) :-
  975    colourise_goal(Goal, Origin, TB, Pos).
  976
  977colourise_subgoals([], _, _, _, _).
  978colourise_subgoals([Pos|T], N, Body, Origin, TB) :-
  979    arg(N, Body, Arg),
  980    colourise_goals(Arg, Origin, TB, Pos),
  981    NN is N + 1,
  982    colourise_subgoals(T, NN, Body, Origin, TB).
  983
  984%!  colourise_dcg(+Body, +Head, +TB, +Pos)
  985%
  986%   Breaks down to colourise_dcg_goal/3.
  987
  988colourise_dcg(Body, Head, TB, Pos) :-
  989    colour_item(dcg, TB, Pos),
  990    (   dcg_extend(Head, Origin)
  991    ->  true
  992    ;   Origin = Head
  993    ),
  994    colourise_dcg_goals(Body, Origin, TB, Pos).
  995
  996colourise_dcg_goals(Var, _, TB, Pos) :-
  997    var(Var),
  998    !,
  999    colour_item(goal(meta,Var), TB, Pos).
 1000colourise_dcg_goals(_, _, _, Pos) :-
 1001    var(Pos),
 1002    !.
 1003colourise_dcg_goals(Body, Origin, TB, parentheses_term_position(PO,PC,Pos)) :-
 1004    !,
 1005    colour_item(parentheses, TB, PO-PC),
 1006    colourise_dcg_goals(Body, Origin, TB, Pos).
 1007colourise_dcg_goals({Body}, Origin, TB, brace_term_position(F,T,Arg)) :-
 1008    !,
 1009    colour_item(dcg(plain), TB, F-T),
 1010    colourise_goals(Body, Origin, TB, Arg).
 1011colourise_dcg_goals([], _, TB, Pos) :-
 1012    !,
 1013    colour_item(dcg(terminal), TB, Pos).
 1014colourise_dcg_goals(List, _, TB, list_position(F,T,Elms,Tail)) :-
 1015    List = [_|_],
 1016    !,
 1017    colour_item(dcg(terminal), TB, F-T),
 1018    colourise_list_args(Elms, Tail, List, TB, classify).
 1019colourise_dcg_goals(_, _, TB, string_position(F,T)) :-
 1020    integer(F),
 1021    !,
 1022    colour_item(dcg(string), TB, F-T).
 1023colourise_dcg_goals(Body, Origin, TB, term_position(_,_,FF,FT,ArgPos)) :-
 1024    dcg_body_compiled(Body),       % control structures
 1025    !,
 1026    colour_item(control, TB, FF-FT),
 1027    colourise_dcg_subgoals(ArgPos, 1, Body, Origin, TB).
 1028colourise_dcg_goals(Goal, Origin, TB, Pos) :-
 1029    colourise_dcg_goal(Goal, Origin, TB, Pos).
 1030
 1031colourise_dcg_subgoals([], _, _, _, _).
 1032colourise_dcg_subgoals([Pos|T], N, Body, Origin, TB) :-
 1033    arg(N, Body, Arg),
 1034    colourise_dcg_goals(Arg, Origin, TB, Pos),
 1035    NN is N + 1,
 1036    colourise_dcg_subgoals(T, NN, Body, Origin, TB).
 1037
 1038dcg_extend(Term, _) :-
 1039    var(Term), !, fail.
 1040dcg_extend(M:Term, M:Goal) :-
 1041    dcg_extend(Term, Goal).
 1042dcg_extend(Term, Goal) :-
 1043    compound(Term),
 1044    !,
 1045    compound_name_arguments(Term, Name, Args),
 1046    append(Args, [_,_], NArgs),
 1047    compound_name_arguments(Goal, Name, NArgs).
 1048dcg_extend(Term, Goal) :-
 1049    atom(Term),
 1050    !,
 1051    compound_name_arguments(Goal, Term, [_,_]).
 1052
 1053dcg_body_compiled(G) :-
 1054    body_compiled(G),
 1055    !.
 1056dcg_body_compiled((_|_)).
 1057
 1058%       colourise_dcg_goal(+Goal, +Origin, +TB, +Pos).
 1059
 1060colourise_dcg_goal(!, Origin, TB, TermPos) :-
 1061    !,
 1062    colourise_goal(!, Origin, TB, TermPos).
 1063colourise_dcg_goal(Goal, Origin, TB, TermPos) :-
 1064    dcg_extend(Goal, TheGoal),
 1065    !,
 1066    colourise_goal(TheGoal, Origin, TB, TermPos).
 1067colourise_dcg_goal(Goal, _, TB, Pos) :-
 1068    colourise_term_args(Goal, TB, Pos).
 1069
 1070
 1071%!  colourise_goal(+Goal, +Origin, +TB, +Pos)
 1072%
 1073%   Colourise access to a single goal.
 1074%
 1075%   @tbd Quasi Quotations are coloured as a general term argument.
 1076%   Possibly we should do something with the goal information it
 1077%   refers to, in particular if this goal is not defined.
 1078
 1079                                        % Deal with list as goal (consult)
 1080colourise_goal(_,_,_,Pos) :-
 1081    var(Pos),
 1082    !.
 1083colourise_goal(Goal, Origin, TB, parentheses_term_position(PO,PC,Pos)) :-
 1084    !,
 1085    colour_item(parentheses, TB, PO-PC),
 1086    colourise_goal(Goal, Origin, TB, Pos).
 1087colourise_goal(Goal, _, TB, Pos) :-
 1088    Pos = list_position(F,T,Elms,TailPos),
 1089    Goal = [_|_],
 1090    !,
 1091    FT is F + 1,
 1092    AT is T - 1,
 1093    colour_item(goal_term(built_in, Goal), TB, Pos),
 1094    colour_item(goal(built_in, Goal), TB, F-FT),
 1095    colour_item(goal(built_in, Goal), TB, AT-T),
 1096    colourise_file_list(Goal, TB, Elms, TailPos, any).
 1097colourise_goal(Goal, Origin, TB, Pos) :-
 1098    Pos = list_position(F,T,Elms,Tail),
 1099    callable(Goal),
 1100    Goal =.. [_,GH,GT|_],
 1101    !,
 1102    goal_classification(TB, Goal, Origin, Class),
 1103    FT is F + 1,
 1104    AT is T - 1,
 1105    colour_item(goal_term(Class, Goal), TB, Pos),
 1106    colour_item(goal(Class, Goal), TB, F-FT),
 1107    colour_item(goal(Class, Goal), TB, AT-T),
 1108    colourise_list_args(Elms, Tail, [GH|GT], TB, classify).
 1109colourise_goal(Goal, _Origin, TB, Pos) :-
 1110    Pos = quasi_quotation_position(_F,_T,_QQType,_QQTypePos,_CPos),
 1111    !,
 1112    colourise_term_arg(Goal, TB, Pos).
 1113colourise_goal(#(Macro), Origin, TB, term_position(_,_,HF,HT,[MPos])) :-
 1114    expand_macro(TB, Macro, Goal),
 1115    !,
 1116    macro_term_string(Goal, String),
 1117    goal_classification(TB, Goal, Origin, Class),
 1118    (   MPos = term_position(_,_,FF,FT,_ArgPos)
 1119    ->  FPos = FF-FT
 1120    ;   FPos = MPos
 1121    ),
 1122    colour_item(macro(String), TB, HF-HT),
 1123    colour_item(goal_term(Class, Goal), TB, MPos),
 1124    colour_item(goal(Class, Goal), TB, FPos),
 1125    colourise_goal_args(Goal, TB, MPos).
 1126colourise_goal(Goal, Origin, TB, Pos) :-
 1127    strip_module(Goal, _, PGoal),
 1128    nonvar(PGoal),
 1129    (   goal_classification(TB, Goal, Origin, ClassInferred),
 1130        call_goal_colours(Goal, ClassInferred, ClassSpec-ArgSpecs)
 1131    ->  true
 1132    ;   call_goal_colours(Goal, ClassSpec-ArgSpecs)
 1133    ),
 1134    !,                                          % specified
 1135    functor_position(Pos, FPos, ArgPos),
 1136    (   ClassSpec == classify
 1137    ->  goal_classification(TB, Goal, Origin, Class)
 1138    ;   Class = ClassSpec
 1139    ),
 1140    colour_item(goal_term(Class, Goal), TB, Pos),
 1141    colour_item(goal(Class, Goal), TB, FPos),
 1142    colour_dict_braces(TB, Pos),
 1143    specified_items(ArgSpecs, Goal, TB, ArgPos).
 1144colourise_goal(Module:Goal, _Origin, TB, QGoalPos) :-
 1145    QGoalPos = term_position(_,_,QF,QT,[PM,PG]),
 1146    !,
 1147    colourise_module(Module, TB, PM),
 1148    colour_item(functor, TB, QF-QT),
 1149    (   PG = term_position(_,_,FF,FT,_)
 1150    ->  FP = FF-FT
 1151    ;   FP = PG
 1152    ),
 1153    (   callable(Goal)
 1154    ->  qualified_goal_classification(Module:Goal, TB, Class),
 1155        colour_item(goal_term(Class, Goal), TB, QGoalPos),
 1156        colour_item(goal(Class, Goal), TB, FP),
 1157        colourise_goal_args(Goal, Module, TB, PG)
 1158    ;   var(Goal)
 1159    ->  colourise_term_arg(Goal, TB, PG)
 1160    ;   colour_item(type_error(callable), TB, PG)
 1161    ).
 1162colourise_goal(Op, _Origin, TB, Pos) :-
 1163    nonvar(Op),
 1164    Op = op(_,_,_),
 1165    !,
 1166    colourise_op_declaration(Op, TB, Pos).
 1167colourise_goal(Goal, Origin, TB, Pos) :-
 1168    goal_classification(TB, Goal, Origin, Class),
 1169    (   Pos = term_position(_,_,FF,FT,_ArgPos)
 1170    ->  FPos = FF-FT
 1171    ;   FPos = Pos
 1172    ),
 1173    colour_item(goal_term(Class, Goal), TB, Pos),
 1174    colour_item(goal(Class, Goal), TB, FPos),
 1175    colourise_goal_args(Goal, TB, Pos).
 1176
 1177% make sure to emit a fragment for the braces of tag{k:v, ...} or
 1178% {...} that is mapped to something else.
 1179
 1180colour_dict_braces(TB, dict_position(_F,T,_TF,TT,_KVPos)) :-
 1181    !,
 1182    BStart is TT+1,
 1183    colour_item(dict_content, TB, BStart-T).
 1184colour_dict_braces(_, _).
 1185
 1186%!  colourise_goal_args(+Goal, +TB, +Pos)
 1187%
 1188%   Colourise the arguments to a goal. This predicate deals with
 1189%   meta- and database-access predicates.
 1190
 1191colourise_goal_args(Goal, TB, Pos) :-
 1192    colourization_module(TB, Module),
 1193    colourise_goal_args(Goal, Module, TB, Pos).
 1194
 1195colourization_module(TB, Module) :-
 1196    (   colour_state_source_id(TB, SourceId),
 1197        xref_module(SourceId, Module)
 1198    ->  true
 1199    ;   Module = user
 1200    ).
 1201
 1202colourise_goal_args(Goal, M, TB, term_position(_,_,_,_,ArgPos)) :-
 1203    !,
 1204    (   meta_args(Goal, TB, MetaArgs)
 1205    ->  colourise_meta_args(1, Goal, M, MetaArgs, TB, ArgPos)
 1206    ;   colourise_goal_args(1, Goal, M, TB, ArgPos)
 1207    ).
 1208colourise_goal_args(Goal, M, TB, brace_term_position(_,_,ArgPos)) :-
 1209    !,
 1210    (   meta_args(Goal, TB, MetaArgs)
 1211    ->  colourise_meta_args(1, Goal, M, MetaArgs, TB, [ArgPos])
 1212    ;   colourise_goal_args(1, Goal, M, TB, [ArgPos])
 1213    ).
 1214colourise_goal_args(_, _, _, _).                % no arguments
 1215
 1216colourise_goal_args(_, _, _, _, []) :- !.
 1217colourise_goal_args(N, Goal, Module, TB, [P0|PT]) :-
 1218    colourise_option_arg(Goal, Module, N, TB, P0),
 1219    !,
 1220    NN is N + 1,
 1221    colourise_goal_args(NN, Goal, Module, TB, PT).
 1222colourise_goal_args(N, Goal, Module, TB, [P0|PT]) :-
 1223    arg(N, Goal, Arg),
 1224    colourise_term_arg(Arg, TB, P0),
 1225    NN is N + 1,
 1226    colourise_goal_args(NN, Goal, Module, TB, PT).
 1227
 1228
 1229colourise_meta_args(_, _, _, _, _, []) :- !.
 1230colourise_meta_args(N, Goal, Module, MetaArgs, TB, [P0|PT]) :-
 1231    colourise_option_arg(Goal, Module, N, TB, P0),
 1232    !,
 1233    NN is N + 1,
 1234    colourise_meta_args(NN, Goal, Module, MetaArgs, TB, PT).
 1235colourise_meta_args(N, Goal, Module, MetaArgs, TB, [P0|PT]) :-
 1236    arg(N, Goal, Arg),
 1237    arg(N, MetaArgs, MetaSpec),
 1238    colourise_meta_arg(MetaSpec, Arg, TB, P0),
 1239    NN is N + 1,
 1240    colourise_meta_args(NN, Goal, Module, MetaArgs, TB, PT).
 1241
 1242colourise_meta_arg(MetaSpec, Arg, TB, Pos) :-
 1243    nonvar(Arg),
 1244    expand_meta(MetaSpec, Arg, Expanded),
 1245    !,
 1246    colourise_goal(Expanded, [], TB, Pos). % TBD: recursion
 1247colourise_meta_arg(MetaSpec, Arg, TB, Pos) :-
 1248    nonvar(Arg),
 1249    MetaSpec == //,
 1250    !,
 1251    colourise_dcg_goals(Arg, //, TB, Pos).
 1252colourise_meta_arg(_, Arg, TB, Pos) :-
 1253    colourise_term_arg(Arg, TB, Pos).
 1254
 1255%!  meta_args(+Goal, +TB, -ArgSpec) is semidet.
 1256%
 1257%   Return a copy of Goal, where   each  meta-argument is an integer
 1258%   representing the number of extra arguments   or  the atom // for
 1259%   indicating a DCG  body.  The   non-meta  arguments  are  unbound
 1260%   variables.
 1261%
 1262%   E.g. meta_args(maplist(foo,x,y), X) --> X = maplist(2,_,_)
 1263%
 1264%   NOTE: this could be cached if performance becomes an issue.
 1265
 1266meta_args(Goal, TB, VarGoal) :-
 1267    colour_state_source_id(TB, SourceId),
 1268    xref_meta(SourceId, Goal, _),
 1269    !,
 1270    compound_name_arity(Goal, Name, Arity),
 1271    compound_name_arity(VarGoal, Name, Arity),
 1272    xref_meta(SourceId, VarGoal, MetaArgs),
 1273    instantiate_meta(MetaArgs).
 1274
 1275instantiate_meta([]).
 1276instantiate_meta([H|T]) :-
 1277    (   var(H)
 1278    ->  H = 0
 1279    ;   H = V+N
 1280    ->  V = N
 1281    ;   H = //(V)
 1282    ->  V = (//)
 1283    ),
 1284    instantiate_meta(T).
 1285
 1286%!  expand_meta(+MetaSpec, +Goal, -Expanded) is semidet.
 1287%
 1288%   Add extra arguments to the goal if the meta-specifier is an
 1289%   integer (see above).
 1290
 1291expand_meta(MetaSpec, Goal, Goal) :-
 1292    MetaSpec == 0.
 1293expand_meta(MetaSpec, M:Goal, M:Expanded) :-
 1294    atom(M),
 1295    !,
 1296    expand_meta(MetaSpec, Goal, Expanded).
 1297expand_meta(MetaSpec, Goal, Expanded) :-
 1298    integer(MetaSpec),
 1299    MetaSpec > 0,
 1300    (   atom(Goal)
 1301    ->  functor(Expanded, Goal, MetaSpec)
 1302    ;   compound(Goal)
 1303    ->  compound_name_arguments(Goal, Name, Args0),
 1304        length(Extra, MetaSpec),
 1305        append(Args0, Extra, Args),
 1306        compound_name_arguments(Expanded, Name, Args)
 1307    ).
 1308
 1309%!  colourise_setof(+Term, +TB, +Pos)
 1310%
 1311%   Colourise the 2nd argument of setof/bagof
 1312
 1313colourise_setof(Var^G, TB, term_position(_,_,FF,FT,[VP,GP])) :-
 1314    !,
 1315    colourise_term_arg(Var, TB, VP),
 1316    colour_item(ext_quant, TB, FF-FT),
 1317    colourise_setof(G, TB, GP).
 1318colourise_setof(Term, TB, Pos) :-
 1319    colourise_goal(Term, [], TB, Pos).
 1320
 1321%       colourise_db(+Arg, +TB, +Pos)
 1322%
 1323%       Colourise database modification calls (assert/1, retract/1 and
 1324%       friends.
 1325
 1326colourise_db((Head:-Body), TB, term_position(_,_,_,_,[HP,BP])) :-
 1327    !,
 1328    colourise_db(Head, TB, HP),
 1329    colourise_body(Body, Head, TB, BP).
 1330colourise_db(Module:Head, TB, term_position(_,_,QF,QT,[MP,HP])) :-
 1331    !,
 1332    colourise_module(Module, TB, MP),
 1333    colour_item(functor, TB, QF-QT),
 1334    (   atom(Module),
 1335        colour_state_source_id(TB, SourceId),
 1336        xref_module(SourceId, Module)
 1337    ->  colourise_db(Head, TB, HP)
 1338    ;   colourise_db(Head, TB, HP)
 1339    ).
 1340colourise_db(Head, TB, Pos) :-
 1341    colourise_goal(Head, '<db-change>', TB, Pos).
 1342
 1343
 1344%!  colourise_option_args(+Goal, +Module, +Arg:integer,
 1345%!                        +TB, +ArgPos) is semidet.
 1346%
 1347%   Colourise  predicate  options  for  the    Arg-th   argument  of
 1348%   Module:Goal
 1349
 1350colourise_option_arg(Goal, Module, Arg, TB, ArgPos) :-
 1351    goal_name_arity(Goal, Name, Arity),
 1352    current_option_arg(Module:Name/Arity, Arg),
 1353    current_predicate_options(Module:Name/Arity, Arg, OptionDecl),
 1354    debug(emacs, 'Colouring option-arg ~w of ~p',
 1355          [Arg, Module:Name/Arity]),
 1356    arg(Arg, Goal, Options),
 1357    colourise_option(Options, Module, Goal, Arg, OptionDecl, TB, ArgPos).
 1358
 1359colourise_option(Options0, Module, Goal, Arg, OptionDecl, TB, Pos0) :-
 1360    strip_option_module_qualifier(Goal, Module, Arg, TB,
 1361                                  Options0, Pos0, Options, Pos),
 1362    (   Pos = list_position(F, T, ElmPos, TailPos)
 1363    ->  colour_item(list, TB, F-T),
 1364        colourise_option_list(Options, OptionDecl, TB, ElmPos, TailPos)
 1365    ;   (   var(Options)
 1366        ;   Options == []
 1367        )
 1368    ->  colourise_term_arg(Options, TB, Pos)
 1369    ;   colour_item(type_error(list), TB, Pos)
 1370    ).
 1371
 1372strip_option_module_qualifier(Goal, Module, Arg, TB,
 1373                              M:Options, term_position(_,_,_,_,[MP,Pos]),
 1374                              Options, Pos) :-
 1375    predicate_property(Module:Goal, meta_predicate(Head)),
 1376    arg(Arg, Head, :),
 1377    !,
 1378    colourise_module(M, TB, MP).
 1379strip_option_module_qualifier(_, _, _, _,
 1380                              Options, Pos, Options, Pos).
 1381
 1382
 1383colourise_option_list(_, _, _, [], none) :- !.
 1384colourise_option_list(Tail, _, TB, [], TailPos) :-
 1385    !,
 1386    colourise_term_arg(Tail, TB, TailPos).
 1387colourise_option_list([H|T], OptionDecl, TB, [HPos|TPos], TailPos) :-
 1388    colourise_option(H, OptionDecl, TB, HPos),
 1389    colourise_option_list(T, OptionDecl, TB, TPos, TailPos).
 1390
 1391colourise_option(Opt, _, TB, Pos) :-
 1392    var(Opt),
 1393    !,
 1394    colourise_term_arg(Opt, TB, Pos).
 1395colourise_option(Opt, OptionDecl, TB, term_position(_,_,FF,FT,ValPosList)) :-
 1396    !,
 1397    generalise_term(Opt, GenOpt),
 1398    (   memberchk(GenOpt, OptionDecl)
 1399    ->  colour_item(option_name, TB, FF-FT),
 1400        Opt =.. [Name|Values],
 1401        GenOpt =.. [Name|Types],
 1402        colour_option_values(Values, Types, TB, ValPosList)
 1403    ;   colour_item(no_option_name, TB, FF-FT),
 1404        colourise_term_args(ValPosList, 1, Opt, TB)
 1405    ).
 1406colourise_option(_, _, TB, Pos) :-
 1407    colour_item(type_error(option), TB, Pos).
 1408
 1409colour_option_values([], [], _, _).
 1410colour_option_values([V0|TV], [T0|TT], TB, [P0|TP]) :-
 1411    (   (   var(V0)
 1412        ;   is_of_type(T0, V0)
 1413        ;   T0 = list(_),
 1414            member(E, V0),
 1415            var(E)
 1416        ;   dict_field_extraction(V0)
 1417        )
 1418    ->  colourise_term_arg(V0, TB, P0)
 1419    ;   callable(V0),
 1420        (   T0 = callable
 1421        ->  N = 0
 1422        ;   T0 = (callable+N)
 1423        )
 1424    ->  colourise_meta_arg(N, V0, TB, P0)
 1425    ;   colour_item(type_error(T0), TB, P0)
 1426    ),
 1427    colour_option_values(TV, TT, TB, TP).
 1428
 1429
 1430%!  colourise_files(+Arg, +TB, +Pos, +Why)
 1431%
 1432%   Colourise the argument list of one of the file-loading predicates.
 1433%
 1434%   @param Why is one of =any= or =imported=
 1435
 1436colourise_files(List, TB, list_position(F,T,Elms,TailPos), Why) :-
 1437    !,
 1438    colour_item(list, TB, F-T),
 1439    colourise_file_list(List, TB, Elms, TailPos, Why).
 1440colourise_files(M:Spec, TB, term_position(_,_,_,_,[MP,SP]), Why) :-
 1441    !,
 1442    colourise_module(M, TB, MP),
 1443    colourise_files(Spec, TB, SP, Why).
 1444colourise_files(Var, TB, P, _) :-
 1445    var(Var),
 1446    !,
 1447    colour_item(var, TB, P).
 1448colourise_files(Spec0, TB, Pos, Why) :-
 1449    strip_module(Spec0, _, Spec),
 1450    (   colour_state_source_id(TB, Source),
 1451        prolog_canonical_source(Source, SourceId),
 1452        catch(xref_source_file(Spec, Path, SourceId, [silent(true)]),
 1453              _, fail)
 1454    ->  (   Why = imported,
 1455            \+ resolves_anything(TB, Path),
 1456            exports_something(TB, Path)
 1457        ->  colour_item(file_no_depend(Path), TB, Pos)
 1458        ;   colour_item(file(Path), TB, Pos)
 1459        )
 1460    ;   colour_item(nofile, TB, Pos)
 1461    ).
 1462
 1463%!  colourise_file_list(+Files, +TB, +ElmPos, +TailPos, +Why)
 1464
 1465colourise_file_list([], _, [], none, _).
 1466colourise_file_list(Last, TB, [], TailPos, _Why) :-
 1467    (   var(Last)
 1468    ->  colourise_term(Last, TB, TailPos)
 1469    ;   colour_item(type_error(list), TB, TailPos)
 1470    ).
 1471colourise_file_list([H|T], TB, [PH|PT], TailPos, Why) :-
 1472    colourise_files(H, TB, PH, Why),
 1473    colourise_file_list(T, TB, PT, TailPos, Why).
 1474
 1475resolves_anything(TB, Path) :-
 1476    colour_state_source_id(TB, SourceId),
 1477    xref_defined(SourceId, Head, imported(Path)),
 1478    xref_called(SourceId, Head, _),
 1479    !.
 1480
 1481exports_something(TB, Path) :-
 1482    colour_state_source_id(TB, SourceId),
 1483    xref_defined(SourceId, _, imported(Path)),
 1484    !.
 1485
 1486%!  colourise_directory(+Arg, +TB, +Pos)
 1487%
 1488%   Colourise argument that should be an existing directory.
 1489
 1490colourise_directory(Spec, TB, Pos) :-
 1491    (   colour_state_source_id(TB, SourceId),
 1492        catch(xref_source_file(Spec, Path, SourceId,
 1493                               [ file_type(directory),
 1494                                 silent(true)
 1495                               ]),
 1496              _, fail)
 1497    ->  colour_item(directory(Path), TB, Pos)
 1498    ;   colour_item(nofile, TB, Pos)
 1499    ).
 1500
 1501%!  colourise_langoptions(+Term, +TB, +Pos) is det.
 1502%
 1503%   Colourise the 3th argument of module/3
 1504
 1505colourise_langoptions([], _, _) :- !.
 1506colourise_langoptions([H|T], TB, list_position(PF,PT,[HP|TP],_)) :-
 1507    !,
 1508    colour_item(list, TB, PF-PT),
 1509    colourise_langoptions(H, TB, HP),
 1510    colourise_langoptions(T, TB, TP).
 1511colourise_langoptions(Spec, TB, Pos) :-
 1512    colourise_files(library(dialect/Spec), TB, Pos, imported).
 1513
 1514%!  colourise_class(ClassName, TB, Pos)
 1515%
 1516%   Colourise an XPCE class.
 1517
 1518colourise_class(ClassName, TB, Pos) :-
 1519    colour_state_source_id(TB, SourceId),
 1520    classify_class(SourceId, ClassName, Classification),
 1521    colour_item(class(Classification, ClassName), TB, Pos).
 1522
 1523%!  classify_class(+SourceId, +ClassName, -Classification)
 1524%
 1525%   Classify an XPCE class. As long as   this code is in this module
 1526%   rather than using hooks, we do not   want to load xpce unless it
 1527%   is already loaded.
 1528
 1529classify_class(SourceId, Name, Class) :-
 1530    xref_defined_class(SourceId, Name, Class),
 1531    !.
 1532classify_class(_SourceId, Name, Class) :-
 1533    current_predicate(pce:send_class/3),
 1534    (   current_predicate(classify_class/2)
 1535    ->  true
 1536    ;   use_module(library(pce_meta), [classify_class/2])
 1537    ),
 1538    member(G, [classify_class(Name, Class)]),
 1539    call(G).
 1540
 1541%!  colourise_term_args(+Term, +TB, +Pos)
 1542%
 1543%   colourise head/body principal terms.
 1544
 1545colourise_term_args(Term, TB,
 1546                    term_position(_,_,_,_,ArgPos)) :-
 1547    !,
 1548    colourise_term_args(ArgPos, 1, Term, TB).
 1549colourise_term_args(_, _, _).
 1550
 1551colourise_term_args([], _, _, _).
 1552colourise_term_args([Pos|T], N, Term, TB) :-
 1553    arg(N, Term, Arg),
 1554    colourise_term_arg(Arg, TB, Pos),
 1555    NN is N + 1,
 1556    colourise_term_args(T, NN, Term, TB).
 1557
 1558%!  colourise_term_arg(+Term, +TB, +Pos)
 1559%
 1560%   Colourise an arbitrary Prolog term without context of its semantical
 1561%   role.
 1562
 1563colourise_term_arg(_, _, Pos) :-
 1564    var(Pos),
 1565    !.
 1566colourise_term_arg(Arg, TB, parentheses_term_position(PO,PC,Pos)) :-
 1567    !,
 1568    colour_item(parentheses, TB, PO-PC),
 1569    colourise_term_arg(Arg, TB, Pos).
 1570colourise_term_arg(Var, TB, Pos) :-                     % variable
 1571    var(Var), Pos = _-_,
 1572    !,
 1573    (   singleton(Var, TB)
 1574    ->  colour_item(singleton, TB, Pos)
 1575    ;   current_variable(Var, TB)
 1576    ->  colour_item(current_variable, TB, Pos)
 1577    ;   colour_item(var, TB, Pos)
 1578    ).
 1579colourise_term_arg(List, TB, list_position(F, T, Elms, Tail)) :-
 1580    !,
 1581    colour_item(list, TB, F-T),
 1582    colourise_list_args(Elms, Tail, List, TB, classify).    % list
 1583colourise_term_arg(String, TB, string_position(F, T)) :-    % string
 1584    !,
 1585    (   string(String)
 1586    ->  colour_item(string, TB, F-T)
 1587    ;   String = [H|_]
 1588    ->  (   integer(H)
 1589        ->  colour_item(codes, TB, F-T)
 1590        ;   colour_item(chars, TB, F-T)
 1591        )
 1592    ;   String == []
 1593    ->  colour_item(codes, TB, F-T)
 1594    ).
 1595colourise_term_arg(_, TB,
 1596                   quasi_quotation_position(F,T,QQType,QQTypePos,CPos)) :-
 1597    !,
 1598    colourise_qq_type(QQType, TB, QQTypePos),
 1599    functor_name(QQType, Type),
 1600    colour_item(qq_content(Type), TB, CPos),
 1601    arg(1, CPos, SE),
 1602    SS is SE-2,
 1603    FE is F+2,
 1604    TS is T-2,
 1605    colour_item(qq(open),  TB, F-FE),
 1606    colour_item(qq(sep),   TB, SS-SE),
 1607    colour_item(qq(close), TB, TS-T).
 1608colourise_term_arg({Term}, TB, brace_term_position(F,T,Arg)) :-
 1609    !,
 1610    colour_item(brace_term, TB, F-T),
 1611    colourise_term_arg(Term, TB, Arg).
 1612colourise_term_arg(Map, TB, dict_position(F,T,TF,TT,KVPos)) :-
 1613    !,
 1614    is_dict(Map, Tag),
 1615    colour_item(dict, TB, F-T),
 1616    TagPos = TF-TT,
 1617    (   var(Tag)
 1618    ->  (   singleton(Tag, TB)
 1619        ->  colour_item(singleton, TB, TagPos)
 1620        ;   colour_item(var, TB, TagPos)
 1621        )
 1622    ;   colour_item(dict_tag, TB, TagPos)
 1623    ),
 1624    BStart is TT+1,
 1625    colour_item(dict_content, TB, BStart-T),
 1626    colourise_dict_kv(Map, TB, KVPos).
 1627colourise_term_arg([](List,Term), TB,                   % [] as operator
 1628                   term_position(_,_,0,0,[ListPos,ArgPos])) :-
 1629    !,
 1630    colourise_term_arg(List, TB, ListPos),
 1631    colourise_term_arg(Term, TB, ArgPos).
 1632colourise_term_arg(#(Macro), TB, term_position(_,_,HF,HT,[MPos])) :-
 1633    expand_macro(TB, Macro, Term),
 1634    !,
 1635    macro_term_string(Term, String),
 1636    colour_item(macro(String), TB, HF-HT),
 1637    colourise_term_arg(Macro, TB, MPos).
 1638colourise_term_arg(Compound, TB, Pos) :-                % compound
 1639    compound(Compound),
 1640    !,
 1641    (   Pos = term_position(_F,_T,FF,FT,_ArgPos)
 1642    ->  colour_item(functor, TB, FF-FT)             % TBD: Infix/Postfix?
 1643    ;   true                                        % TBD: When is this
 1644    ),
 1645    colourise_term_args(Compound, TB, Pos).
 1646colourise_term_arg(EmptyList, TB, Pos) :-
 1647    EmptyList == [],
 1648    !,
 1649    colour_item(empty_list, TB, Pos).
 1650colourise_term_arg(Atom, TB, Pos) :-
 1651    atom(Atom),
 1652    !,
 1653    colour_item(atom, TB, Pos).
 1654colourise_term_arg(Integer, TB, Pos) :-
 1655    integer(Integer),
 1656    !,
 1657    colour_item(int, TB, Pos).
 1658colourise_term_arg(Rational, TB, Pos) :-
 1659    rational(Rational),
 1660    !,
 1661    colour_item(rational(Rational), TB, Pos).
 1662colourise_term_arg(Float, TB, Pos) :-
 1663    float(Float),
 1664    !,
 1665    colour_item(float, TB, Pos).
 1666colourise_term_arg(_Arg, _TB, _Pos) :-
 1667    true.
 1668
 1669colourise_list_args([HP|TP], Tail, [H|T], TB, How) :-
 1670    specified_item(How, H, TB, HP),
 1671    colourise_list_args(TP, Tail, T, TB, How).
 1672colourise_list_args([], none, _, _, _) :- !.
 1673colourise_list_args([], TP, T, TB, How) :-
 1674    specified_item(How, T, TB, TP).
 1675
 1676
 1677%!  colourise_expression(+Term, +TB, +Pos)
 1678%
 1679%   colourise arithmetic expressions.
 1680
 1681colourise_expression(_, _, Pos) :-
 1682    var(Pos),
 1683    !.
 1684colourise_expression(Arg, TB, parentheses_term_position(PO,PC,Pos)) :-
 1685    !,
 1686    colour_item(parentheses, TB, PO-PC),
 1687    colourise_expression(Arg, TB, Pos).
 1688colourise_expression(Compound, TB, Pos) :-
 1689    compound(Compound), Pos = term_position(_F,_T,FF,FT,_ArgPos),
 1690    !,
 1691    (   dict_field_extraction(Compound)
 1692    ->  colourise_term_arg(Compound, TB, Pos)
 1693    ;   (   current_arithmetic_function(Compound)
 1694        ->  colour_item(function, TB, FF-FT)
 1695        ;   colour_item(no_function, TB, FF-FT)
 1696        ),
 1697        colourise_expression_args(Compound, TB, Pos)
 1698    ).
 1699colourise_expression(Atom, TB, Pos) :-
 1700    atom(Atom),
 1701    !,
 1702    (   current_arithmetic_function(Atom)
 1703    ->  colour_item(function, TB, Pos)
 1704    ;   colour_item(no_function, TB, Pos)
 1705    ).
 1706colourise_expression(NumOrVar, TB, Pos) :-
 1707    Pos = _-_,
 1708    !,
 1709    colourise_term_arg(NumOrVar, TB, Pos).
 1710colourise_expression(_Arg, TB, Pos) :-
 1711    colour_item(type_error(evaluable), TB, Pos).
 1712
 1713dict_field_extraction(Term) :-
 1714    compound(Term),
 1715    compound_name_arity(Term, '.', 2),
 1716    Term \= [_|_].                        % traditional mode
 1717
 1718
 1719colourise_expression_args(roundtoward(Expr, Mode), TB,
 1720                          term_position(_,_,_,_,[ExprPos, ModePos])) :-
 1721    !,
 1722    colourise_expression(Expr, TB, ExprPos),
 1723    colourise_round_mode(Mode, TB, ModePos).
 1724colourise_expression_args(Term, TB,
 1725                          term_position(_,_,_,_,ArgPos)) :-
 1726    !,
 1727    colourise_expression_args(ArgPos, 1, Term, TB).
 1728colourise_expression_args(_, _, _).
 1729
 1730colourise_expression_args([], _, _, _).
 1731colourise_expression_args([Pos|T], N, Term, TB) :-
 1732    arg(N, Term, Arg),
 1733    colourise_expression(Arg, TB, Pos),
 1734    NN is N + 1,
 1735    colourise_expression_args(T, NN, Term, TB).
 1736
 1737colourise_round_mode(Mode, TB, Pos) :-
 1738    var(Mode),
 1739    !,
 1740    colourise_term_arg(Mode, TB, Pos).
 1741colourise_round_mode(Mode, TB, Pos) :-
 1742    round_mode(Mode),
 1743    !,
 1744    colour_item(identifier, TB, Pos).
 1745colourise_round_mode(_Mode, TB, Pos) :-
 1746    colour_item(domain_error(rounding_mode), TB, Pos).
 1747
 1748round_mode(to_nearest).
 1749round_mode(to_positive).
 1750round_mode(to_negative).
 1751round_mode(to_zero).
 1752
 1753%!  colourise_qq_type(+QQType, +TB, +QQTypePos)
 1754%
 1755%   Colouring the type part of a quasi quoted term
 1756
 1757colourise_qq_type(QQType, TB, QQTypePos) :-
 1758    functor_position(QQTypePos, FPos, _),
 1759    colour_item(qq_type, TB, FPos),
 1760    colourise_term_args(QQType, TB, QQTypePos).
 1761
 1762qq_position(quasi_quotation_position(_,_,_,_,_)).
 1763
 1764%!  colourise_dict_kv(+Dict, +TB, +KVPosList)
 1765%
 1766%   Colourise the name-value pairs in the dict
 1767
 1768colourise_dict_kv(_, _, []) :- !.
 1769colourise_dict_kv(Dict, TB, [key_value_position(_F,_T,SF,ST,K,KP,VP)|KV]) :-
 1770    colour_item(dict_key, TB, KP),
 1771    colour_item(dict_sep, TB, SF-ST),
 1772    get_dict(K, Dict, V),
 1773    colourise_term_arg(V, TB, VP),
 1774    colourise_dict_kv(Dict, TB, KV).
 1775
 1776
 1777%!  colourise_exports(+List, +TB, +Pos)
 1778%
 1779%   Colourise the module export-list (or any other list holding
 1780%   terms of the form Name/Arity referring to predicates).
 1781
 1782colourise_exports([], TB, Pos) :- !,
 1783    colourise_term_arg([], TB, Pos).
 1784colourise_exports(List, TB, list_position(F,T,ElmPos,Tail)) :-
 1785    !,
 1786    colour_item(list, TB, F-T),
 1787    (   Tail == none
 1788    ->  true
 1789    ;   colour_item(type_error(list), TB, Tail)
 1790    ),
 1791    colourise_exports2(List, TB, ElmPos).
 1792colourise_exports(_, TB, Pos) :-
 1793    colour_item(type_error(list), TB, Pos).
 1794
 1795colourise_exports2([G0|GT], TB, [P0|PT]) :-
 1796    !,
 1797    colourise_declaration(G0, export, TB, P0),
 1798    colourise_exports2(GT, TB, PT).
 1799colourise_exports2(_, _, _).
 1800
 1801
 1802%!  colourise_imports(+List, +File, +TB, +Pos)
 1803%
 1804%   Colourise import list from use_module/2, importing from File.
 1805
 1806colourise_imports(List, File, TB, Pos) :-
 1807    (   colour_state_source_id(TB, SourceId),
 1808        ground(File),
 1809        catch(xref_public_list(File, SourceId,
 1810                               [ path(Path),
 1811                                 public(Public),
 1812                                 silent(true)
 1813                               ] ), _, fail)
 1814    ->  true
 1815    ;   Public = [],
 1816        Path = (-)
 1817    ),
 1818    colourise_imports(List, Path, Public, TB, Pos).
 1819
 1820colourise_imports([], _, _, TB, Pos) :-
 1821    !,
 1822    colour_item(empty_list, TB, Pos).
 1823colourise_imports(List, File, Public, TB, list_position(F,T,ElmPos,Tail)) :-
 1824    !,
 1825    colour_item(list, TB, F-T),
 1826    (   Tail == none
 1827    ->  true
 1828    ;   colour_item(type_error(list), TB, Tail)
 1829    ),
 1830    colourise_imports2(List, File, Public, TB, ElmPos).
 1831colourise_imports(except(Except), File, Public, TB,
 1832                  term_position(_,_,FF,FT,[LP])) :-
 1833    !,
 1834    colour_item(keyword(except), TB, FF-FT),
 1835    colourise_imports(Except, File, Public, TB, LP).
 1836colourise_imports(_, _, _, TB, Pos) :-
 1837    colour_item(type_error(list), TB, Pos).
 1838
 1839colourise_imports2([G0|GT], File, Public, TB, [P0|PT]) :-
 1840    !,
 1841    colourise_import(G0, File, TB, P0),
 1842    colourise_imports2(GT, File, Public, TB, PT).
 1843colourise_imports2(_, _, _, _, _).
 1844
 1845
 1846colourise_import(PI as Name, File, TB, term_position(_,_,FF,FT,[PP,NP])) :-
 1847    pi_to_term(PI, Goal),
 1848    !,
 1849    colour_item(goal(imported(File), Goal), TB, PP),
 1850    rename_goal(Goal, Name, NewGoal),
 1851    goal_classification(TB, NewGoal, [], Class),
 1852    colour_item(goal(Class, NewGoal), TB, NP),
 1853    colour_item(keyword(as), TB, FF-FT).
 1854colourise_import(PI, File, TB, Pos) :-
 1855    pi_to_term(PI, Goal),
 1856    colour_state_source_id(TB, SourceID),
 1857    (   \+ xref_defined(SourceID, Goal, imported(File))
 1858    ->  colour_item(undefined_import, TB, Pos)
 1859    ;   \+ xref_called(SourceID, Goal, _)
 1860    ->  colour_item(unused_import, TB, Pos)
 1861    ),
 1862    !.
 1863colourise_import(PI, _, TB, Pos) :-
 1864    colourise_declaration(PI, import, TB, Pos).
 1865
 1866%!  colourise_declaration(+Decl, ?Which, +TB, +Pos) is det.
 1867%
 1868%   Colourise declaration sequences as used  by module/2, dynamic/1,
 1869%   etc.
 1870
 1871colourise_declaration(PI, _, TB, term_position(F,T,FF,FT,[NamePos,ArityPos])) :-
 1872    pi_to_term(PI, Goal),
 1873    !,
 1874    goal_classification(TB, Goal, [], Class),
 1875    colour_item(predicate_indicator(Class, Goal), TB, F-T),
 1876    colour_item(goal(Class, Goal), TB, NamePos),
 1877    colour_item(predicate_indicator, TB, FF-FT),
 1878    colour_item(arity, TB, ArityPos).
 1879colourise_declaration(Module:PI, _, TB,
 1880                      term_position(_,_,QF,QT,[PM,PG])) :-
 1881    atom(Module), pi_to_term(PI, Goal),
 1882    !,
 1883    colourise_module(M, TB, PM),
 1884    colour_item(functor, TB, QF-QT),
 1885    colour_item(predicate_indicator(extern(M), Goal), TB, PG),
 1886    PG = term_position(_,_,FF,FT,[NamePos,ArityPos]),
 1887    colour_item(goal(extern(M), Goal), TB, NamePos),
 1888    colour_item(predicate_indicator, TB, FF-FT),
 1889    colour_item(arity, TB, ArityPos).
 1890colourise_declaration(Module:PI, _, TB,
 1891                      term_position(_,_,QF,QT,[PM,PG])) :-
 1892    atom(Module), nonvar(PI), PI = Name/Arity,
 1893    !,                                  % partial predicate indicators
 1894    colourise_module(Module, TB, PM),
 1895    colour_item(functor, TB, QF-QT),
 1896    (   (var(Name) ; atom(Name)),
 1897        (var(Arity) ; integer(Arity), Arity >= 0)
 1898    ->  colourise_term_arg(PI, TB, PG)
 1899    ;   colour_item(type_error(predicate_indicator), TB, PG)
 1900    ).
 1901colourise_declaration(op(N,T,P), Which, TB, Pos) :-
 1902    (   Which == export
 1903    ;   Which == import
 1904    ),
 1905    !,
 1906    colour_item(exported_operator, TB, Pos),
 1907    colourise_op_declaration(op(N,T,P), TB, Pos).
 1908colourise_declaration(Module:Goal, table, TB,
 1909                      term_position(_,_,QF,QT,
 1910                                    [PM,term_position(_F,_T,FF,FT,ArgPos)])) :-
 1911    atom(Module), callable(Goal),
 1912    !,
 1913    colourise_module(Module, TB, PM),
 1914    colour_item(functor, TB, QF-QT),
 1915    goal_classification(TB, Module:Goal, [], Class),
 1916    compound_name_arguments(Goal, _, Args),
 1917    colour_item(goal(Class, Goal), TB, FF-FT),
 1918    colourise_table_modes(Args, TB, ArgPos).
 1919colourise_declaration(Goal, table, TB, term_position(_F,_T,FF,FT,ArgPos)) :-
 1920    callable(Goal),
 1921    !,
 1922    compound_name_arguments(Goal, _, Args),
 1923    goal_classification(TB, Goal, [], Class),
 1924    colour_item(goal(Class, Goal), TB, FF-FT),
 1925    colourise_table_modes(Args, TB, ArgPos).
 1926colourise_declaration(Goal, table, TB, Pos) :-
 1927    atom(Goal),
 1928    !,
 1929    goal_classification(TB, Goal, [], Class),
 1930    colour_item(goal(Class, Goal), TB, Pos).
 1931colourise_declaration(Partial, _Which, TB, Pos) :-
 1932    compatible_with_pi(Partial),
 1933    !,
 1934    colourise_term_arg(Partial, TB, Pos).
 1935colourise_declaration(_, Which, TB, Pos) :-
 1936    colour_item(type_error(declaration(Which)), TB, Pos).
 1937
 1938compatible_with_pi(Term) :-
 1939    var(Term),
 1940    !.
 1941compatible_with_pi(Name/Arity) :-
 1942    !,
 1943    var_or_atom(Name),
 1944    var_or_nonneg(Arity).
 1945compatible_with_pi(Name//Arity) :-
 1946    !,
 1947    var_or_atom(Name),
 1948    var_or_nonneg(Arity).
 1949compatible_with_pi(M:T) :-
 1950    var_or_atom(M),
 1951    compatible_with_pi(T).
 1952
 1953var_or_atom(X) :- var(X), !.
 1954var_or_atom(X) :- atom(X).
 1955var_or_nonneg(X) :- var(X), !.
 1956var_or_nonneg(X) :- integer(X), X >= 0, !.
 1957
 1958pi_to_term(Name/Arity, Term) :-
 1959    (atom(Name)->true;Name==[]), integer(Arity), Arity >= 0,
 1960    !,
 1961    functor(Term, Name, Arity).
 1962pi_to_term(Name//Arity0, Term) :-
 1963    atom(Name), integer(Arity0), Arity0 >= 0,
 1964    !,
 1965    Arity is Arity0 + 2,
 1966    functor(Term, Name, Arity).
 1967
 1968colourise_meta_declarations((Head,Tail), Extra, TB,
 1969                            term_position(_,_,_,_,[PH,PT])) :-
 1970    !,
 1971    colourise_meta_declaration(Head, Extra, TB, PH),
 1972    colourise_meta_declarations(Tail, Extra, TB, PT).
 1973colourise_meta_declarations(Last, Extra, TB, Pos) :-
 1974    colourise_meta_declaration(Last, Extra, TB, Pos).
 1975
 1976colourise_meta_declaration(M:Head, Extra, TB,
 1977                           term_position(_,_,QF,QT,
 1978                                         [ MP,
 1979                                           term_position(_,_,FF,FT,ArgPos)
 1980                                         ])) :-
 1981    compound(Head),
 1982    !,
 1983    colourise_module(M, TB, MP),
 1984    colour_item(functor, TB, QF-QT),
 1985    colour_item(goal(extern(M),Head), TB, FF-FT),
 1986    compound_name_arguments(Head, _, Args),
 1987    colourise_meta_decls(Args, Extra, TB, ArgPos).
 1988colourise_meta_declaration(Head, Extra, TB, term_position(_,_,FF,FT,ArgPos)) :-
 1989    compound(Head),
 1990    !,
 1991    goal_classification(TB, Head, [], Class),
 1992    colour_item(goal(Class, Head), TB, FF-FT),
 1993    compound_name_arguments(Head, _, Args),
 1994    colourise_meta_decls(Args, Extra, TB, ArgPos).
 1995colourise_meta_declaration([H|T], Extra, TB, list_position(LF,LT,[HP],TP)) :-
 1996    !,
 1997    colour_item(list, TB, LF-LT),
 1998    colourise_meta_decls([H,T], Extra, TB, [HP,TP]).
 1999colourise_meta_declaration(_, _, TB, Pos) :-
 2000    !,
 2001    colour_item(type_error(compound), TB, Pos).
 2002
 2003colourise_meta_decls([], _, _, []).
 2004colourise_meta_decls([Arg|ArgT], Extra, TB, [PosH|PosT]) :-
 2005    colourise_meta_decl(Arg, Extra, TB, PosH),
 2006    colourise_meta_decls(ArgT, Extra, TB, PosT).
 2007
 2008colourise_meta_decl(Arg, Extra, TB, Pos) :-
 2009    nonvar(Arg),
 2010    (   valid_meta_decl(Arg)
 2011    ->  true
 2012    ;   memberchk(Arg, Extra)
 2013    ),
 2014    colour_item(meta(Arg), TB, Pos).
 2015colourise_meta_decl(_, _, TB, Pos) :-
 2016    colour_item(error, TB, Pos).
 2017
 2018valid_meta_decl(:).
 2019valid_meta_decl(*).
 2020valid_meta_decl(//).
 2021valid_meta_decl(^).
 2022valid_meta_decl(?).
 2023valid_meta_decl(+).
 2024valid_meta_decl(-).
 2025valid_meta_decl(I) :- integer(I), between(0,9,I).
 2026
 2027%!  colourise_declarations(+Term, +Which, +TB, +Pos)
 2028%
 2029%   Colourise  specification  for  dynamic/1,   table/1,  etc.  Includes
 2030%   processing options such as ``:- dynamic p/1 as incremental.``.
 2031
 2032colourise_declarations(List, Which, TB, list_position(F,T,Elms,none)) :-
 2033    !,
 2034    colour_item(list, TB, F-T),
 2035    colourise_list_declarations(List, Which, TB, Elms).
 2036colourise_declarations(Term, Which, TB, parentheses_term_position(PO,PC,Pos)) :-
 2037    !,
 2038    colour_item(parentheses, TB, PO-PC),
 2039    colourise_declarations(Term, Which, TB, Pos).
 2040colourise_declarations((Head,Tail), Which, TB,
 2041                             term_position(_,_,_,_,[PH,PT])) :-
 2042    !,
 2043    colourise_declarations(Head, Which, TB, PH),
 2044    colourise_declarations(Tail, Which, TB, PT).
 2045colourise_declarations(as(Spec, Options), Which, TB,
 2046                             term_position(_,_,FF,FT,[PH,PT])) :-
 2047    !,
 2048    colour_item(keyword(as), TB, FF-FT),
 2049    colourise_declarations(Spec, Which, TB, PH),
 2050    colourise_decl_options(Options, Which, TB, PT).
 2051colourise_declarations(PI, Which, TB, Pos) :-
 2052    colourise_declaration(PI, Which, TB, Pos).
 2053
 2054colourise_list_declarations([], _, _, []).
 2055colourise_list_declarations([H|T], Which, TB, [HP|TP]) :-
 2056    colourise_declaration(H, Which, TB, HP),
 2057    colourise_list_declarations(T, Which, TB, TP).
 2058
 2059
 2060colourise_table_modes([], _, _).
 2061colourise_table_modes([H|T], TB, [PH|PT]) :-
 2062    colourise_table_mode(H, TB, PH),
 2063    colourise_table_modes(T, TB, PT).
 2064
 2065colourise_table_mode(H, TB, Pos) :-
 2066    table_mode(H, Mode),
 2067    !,
 2068    colour_item(table_mode(Mode), TB, Pos).
 2069colourise_table_mode(lattice(Spec), TB, term_position(_F,_T,FF,FT,[ArgPos])) :-
 2070    !,
 2071    colour_item(table_mode(lattice), TB, FF-FT),
 2072    table_moded_call(Spec, 3, TB, ArgPos).
 2073colourise_table_mode(po(Spec), TB, term_position(_F,_T,FF,FT,[ArgPos])) :-
 2074    !,
 2075    colour_item(table_mode(po), TB, FF-FT),
 2076    table_moded_call(Spec, 2, TB, ArgPos).
 2077colourise_table_mode(_, TB, Pos) :-
 2078    colour_item(type_error(table_mode), TB, Pos).
 2079
 2080table_mode(Var, index) :-
 2081    var(Var),
 2082    !.
 2083table_mode(+, index).
 2084table_mode(index, index).
 2085table_mode(-, first).
 2086table_mode(first, first).
 2087table_mode(last, last).
 2088table_mode(min, min).
 2089table_mode(max, max).
 2090table_mode(sum, sum).
 2091
 2092table_moded_call(Atom, Arity, TB, Pos) :-
 2093    atom(Atom),
 2094    functor(Head, Atom, Arity),
 2095    goal_classification(TB, Head, [], Class),
 2096    colour_item(goal(Class, Head), TB, Pos).
 2097table_moded_call(Atom/Arity, Arity, TB,
 2098                 term_position(_,_,FF,FT,[NP,AP])) :-
 2099    atom(Atom),
 2100    !,
 2101    functor(Head, Atom, Arity),
 2102    goal_classification(TB, Head, [], Class),
 2103    colour_item(goal(Class, Head), TB, NP),
 2104    colour_item(predicate_indicator, TB, FF-FT),
 2105    colour_item(arity, TB, AP).
 2106table_moded_call(Head, Arity, TB, Pos) :-
 2107    Pos = term_position(_,_,FF,FT,_),
 2108    compound(Head),
 2109    !,
 2110    compound_name_arity(Head, _Name, Arity),
 2111    goal_classification(TB, Head, [], Class),
 2112    colour_item(goal(Class, Head), TB, FF-FT),
 2113    colourise_term_args(Head, TB, Pos).
 2114table_moded_call(_, _, TB, Pos) :-
 2115    colour_item(type_error(predicate_name_or_indicator), TB, Pos).
 2116
 2117colourise_decl_options(Options, Which, TB,
 2118                       parentheses_term_position(_,_,Pos)) :-
 2119    !,
 2120    colourise_decl_options(Options, Which, TB, Pos).
 2121colourise_decl_options((Head,Tail), Which, TB,
 2122                        term_position(_,_,_,_,[PH,PT])) :-
 2123    !,
 2124    colourise_decl_options(Head, Which, TB, PH),
 2125    colourise_decl_options(Tail, Which, TB, PT).
 2126colourise_decl_options(Option, Which, TB, Pos) :-
 2127    ground(Option),
 2128    valid_decl_option(Option, Which),
 2129    !,
 2130    functor(Option, Name, _),
 2131    (   Pos = term_position(_,_,FF,FT,[ArgPos])
 2132    ->  colour_item(decl_option(Name), TB, FF-FT),
 2133        (   arg(1, Option, Value),
 2134            nonneg_or_false(Value)
 2135        ->  colourise_term_arg(Value, TB, ArgPos)
 2136        ;   colour_item(type_error(decl_option_value(Which)), TB, ArgPos)
 2137        )
 2138    ;   colour_item(decl_option(Name), TB, Pos)
 2139    ).
 2140colourise_decl_options(_, Which, TB, Pos) :-
 2141    colour_item(type_error(decl_option(Which)), TB, Pos).
 2142
 2143valid_decl_option(subsumptive,         table).
 2144valid_decl_option(variant,             table).
 2145valid_decl_option(incremental,         table).
 2146valid_decl_option(monotonic,           table).
 2147valid_decl_option(opaque,              table).
 2148valid_decl_option(lazy,                table).
 2149valid_decl_option(monotonic,           dynamic).
 2150valid_decl_option(incremental,         dynamic).
 2151valid_decl_option(abstract(_),         dynamic).
 2152valid_decl_option(opaque,              dynamic).
 2153valid_decl_option(shared,              table).
 2154valid_decl_option(private,             table).
 2155valid_decl_option(subgoal_abstract(_), table).
 2156valid_decl_option(answer_abstract(_),  table).
 2157valid_decl_option(max_answers(_),      table).
 2158valid_decl_option(shared,              dynamic).
 2159valid_decl_option(private,             dynamic).
 2160valid_decl_option(local,               dynamic).
 2161valid_decl_option(multifile,           _).
 2162valid_decl_option(discontiguous,       _).
 2163valid_decl_option(volatile,            _).
 2164
 2165nonneg_or_false(Value) :-
 2166    var(Value),
 2167    !.
 2168nonneg_or_false(Value) :-
 2169    integer(Value), Value >= 0,
 2170    !.
 2171nonneg_or_false(off).
 2172nonneg_or_false(false).
 2173
 2174%!  colourise_op_declaration(Op, TB, Pos) is det.
 2175
 2176colourise_op_declaration(op(P,T,N), TB, term_position(_,_,FF,FT,[PP,TP,NP])) :-
 2177    colour_item(goal(built_in, op(N,T,P)), TB, FF-FT),
 2178    colour_op_priority(P, TB, PP),
 2179    colour_op_type(T, TB, TP),
 2180    colour_op_name(N, TB, NP).
 2181
 2182colour_op_name(_, _, Pos) :-
 2183    var(Pos),
 2184    !.
 2185colour_op_name(Name, TB, parentheses_term_position(PO,PC,Pos)) :-
 2186    !,
 2187    colour_item(parentheses, TB, PO-PC),
 2188    colour_op_name(Name, TB, Pos).
 2189colour_op_name(Name, TB, Pos) :-
 2190    var(Name),
 2191    !,
 2192    colour_item(var, TB, Pos).
 2193colour_op_name(Name, TB, Pos) :-
 2194    (atom(Name) ; Name == []),
 2195    !,
 2196    colour_item(identifier, TB, Pos).
 2197colour_op_name(Module:Name, TB, term_position(_F,_T,QF,QT,[MP,NP])) :-
 2198    !,
 2199    colourise_module(Module, TB, MP),
 2200    colour_item(functor, TB, QF-QT),
 2201    colour_op_name(Name, TB, NP).
 2202colour_op_name(List, TB, list_position(F,T,Elems,none)) :-
 2203    !,
 2204    colour_item(list, TB, F-T),
 2205    colour_op_names(List, TB, Elems).
 2206colour_op_name(_, TB, Pos) :-
 2207    colour_item(error, TB, Pos).
 2208
 2209colour_op_names([], _, []).
 2210colour_op_names([H|T], TB, [HP|TP]) :-
 2211    colour_op_name(H, TB, HP),
 2212    colour_op_names(T, TB, TP).
 2213
 2214colour_op_type(Type, TB, Pos) :-
 2215    var(Type),
 2216    !,
 2217    colour_item(var, TB, Pos).
 2218colour_op_type(Type, TB, Pos) :-
 2219    op_type(Type),
 2220    !,
 2221    colour_item(op_type(Type), TB, Pos).
 2222colour_op_type(_, TB, Pos) :-
 2223    colour_item(error, TB, Pos).
 2224
 2225colour_op_priority(Priority, TB, Pos) :-
 2226    var(Priority), colour_item(var, TB, Pos).
 2227colour_op_priority(Priority, TB, Pos) :-
 2228    integer(Priority),
 2229    between(0, 1200, Priority),
 2230    !,
 2231    colour_item(int, TB, Pos).
 2232colour_op_priority(_, TB, Pos) :-
 2233    colour_item(error, TB, Pos).
 2234
 2235op_type(fx).
 2236op_type(fy).
 2237op_type(xf).
 2238op_type(yf).
 2239op_type(xfy).
 2240op_type(xfx).
 2241op_type(yfx).
 2242
 2243
 2244%!  colourise_prolog_flag_name(+Name, +TB, +Pos)
 2245%
 2246%   Colourise the name of a Prolog flag
 2247
 2248colourise_prolog_flag_name(_, _, Pos) :-
 2249    var(Pos),
 2250    !.
 2251colourise_prolog_flag_name(Name, TB, parentheses_term_position(PO,PC,Pos)) :-
 2252    !,
 2253    colour_item(parentheses, TB, PO-PC),
 2254    colourise_prolog_flag_name(Name, TB, Pos).
 2255colourise_prolog_flag_name(Name, TB, Pos) :-
 2256    atom(Name),
 2257    !,
 2258    (   current_prolog_flag(Name, _)
 2259    ->  colour_item(flag_name(Name), TB, Pos)
 2260    ;   known_flag(Name)
 2261    ->  colour_item(known_flag_name(Name), TB, Pos)
 2262    ;   colour_item(no_flag_name(Name), TB, Pos)
 2263    ).
 2264colourise_prolog_flag_name(Name, TB, Pos) :-
 2265    colourise_term(Name, TB, Pos).
 2266
 2267% Some flags are know, but can be unset.
 2268known_flag(associated_file).
 2269known_flag(android).
 2270known_flag(android_api).
 2271known_flag(apple).
 2272known_flag(asan).
 2273known_flag(break_level).
 2274known_flag(conda).
 2275known_flag(dde).
 2276known_flag(emscripten).
 2277known_flag(engines).
 2278known_flag(executable_format).
 2279known_flag(gc_thread).
 2280known_flag(gmp_version).
 2281known_flag(gui).
 2282known_flag(max_rational_size).
 2283known_flag(mitigate_spectre).
 2284known_flag(msys2).
 2285known_flag(pid).
 2286known_flag(pipe).
 2287known_flag(posix_shell).
 2288known_flag(shared_home).
 2289known_flag(shared_table_space).
 2290known_flag(system_thread_id).
 2291known_flag(threads).
 2292known_flag(unix).
 2293known_flag(windows).
 2294known_flag(wine_version).
 2295known_flag(xpce).
 2296known_flag(bundle).
 2297known_flag(apple_universal_binary).
 2298
 2299		 /*******************************
 2300		 *             MACROS		*
 2301		 *******************************/
 2302
 2303%!  expand_macro(+TB, +Macro, -Expanded) is semidet.
 2304%
 2305%   @tbd This only works if the code is compiled. Ideally we'd also make
 2306%   this work for not compiled code.
 2307
 2308expand_macro(TB, Macro, Expanded) :-
 2309    colour_state_source_id(TB, SourceId),
 2310    (   xref_module(SourceId, M)
 2311    ->  true
 2312    ;   M = user
 2313    ),
 2314    current_predicate(M:'$macro'/2),
 2315    catch(M:'$macro'(Macro, Expanded),
 2316          error(_, _),
 2317          fail),
 2318    !.
 2319
 2320macro_term_string(Term, String) :-
 2321    copy_term_nat(Term, Copy),
 2322    numbervars(Copy, 0, _, [singletons(true)]),
 2323    term_string(Copy, String,
 2324                [ portray(true),
 2325                  max_depth(2),
 2326                  numbervars(true)
 2327                ]).
 2328
 2329
 2330                 /*******************************
 2331                 *        CONFIGURATION         *
 2332                 *******************************/
 2333
 2334%       body_compiled(+Term)
 2335%
 2336%       Succeeds if term is a construct handled by the compiler.
 2337
 2338body_compiled((_,_)).
 2339body_compiled((_->_)).
 2340body_compiled((_*->_)).
 2341body_compiled((_;_)).
 2342body_compiled(\+_).
 2343
 2344%!  goal_classification(+TB, +Goal, +Origin, -Class)
 2345%
 2346%   Classify Goal appearing in TB and called from a clause with head
 2347%   Origin.  For directives, Origin is [].
 2348
 2349goal_classification(_, QGoal, _, Class) :-
 2350    strip_module(QGoal, _, Goal),
 2351    (   var(Goal)
 2352    ->  !, Class = meta
 2353    ;   \+ callable(Goal)
 2354    ->  !, Class = not_callable
 2355    ).
 2356goal_classification(_, Goal, Origin, recursion) :-
 2357    callable(Origin),
 2358    generalise_term(Goal, Origin),
 2359    !.
 2360goal_classification(TB, Goal, _, How) :-
 2361    colour_state_source_id(TB, SourceId),
 2362    xref_defined(SourceId, Goal, How),
 2363    How \= public(_),
 2364    !.
 2365goal_classification(TB, Goal, _, Class) :-
 2366    (   colour_state_source_id(TB, SourceId),
 2367        xref_module(SourceId, Module)
 2368    ->  true
 2369    ;   Module = user
 2370    ),
 2371    call_goal_classification(Goal, Module, Class),
 2372    !.
 2373goal_classification(TB, Goal, _, How) :-
 2374    colour_state_module(TB, Module),
 2375    atom(Module),
 2376    Module \== prolog_colour_ops,
 2377    predicate_property(Module:Goal, imported_from(From)),
 2378    !,
 2379    How = imported(From).
 2380goal_classification(_TB, _Goal, _, undefined).
 2381
 2382%!  goal_classification(+Goal, +Module, -Class)
 2383%
 2384%   Multifile hookable classification for non-local goals.
 2385
 2386call_goal_classification(Goal, Module, Class) :-
 2387    catch(global_goal_classification(Goal, Module, Class), _,
 2388          Class = type_error(callable)).
 2389
 2390global_goal_classification(Goal, _, built_in) :-
 2391    built_in_predicate(Goal),
 2392    !.
 2393global_goal_classification(Goal, _, autoload(From)) :-  % SWI-Prolog
 2394    predicate_property(Goal, autoload(From)).
 2395global_goal_classification(Goal, Module, Class) :-      % SWI-Prolog
 2396    strip_module(Goal, _, PGoal),
 2397    current_predicate(_, user:PGoal),
 2398    !,
 2399    (   Module == user
 2400    ->  Class = global(GClass, Location),
 2401        global_location(user:Goal, Location),
 2402        global_class(user:Goal, GClass)
 2403    ;   Class = global
 2404    ).
 2405global_goal_classification(Goal, _, Class) :-
 2406    compound(Goal),
 2407    compound_name_arity(Goal, Name, Arity),
 2408    vararg_goal_classification(Name, Arity, Class).
 2409
 2410global_location(Goal, File:Line) :-
 2411    predicate_property(Goal, file(File)),
 2412    predicate_property(Goal, line_count(Line)),
 2413    !.
 2414global_location(_, -).
 2415
 2416global_class(Goal, dynamic)   :- predicate_property(Goal, dynamic), !.
 2417global_class(Goal, multifile) :- predicate_property(Goal, multifile), !.
 2418global_class(Goal, tabled)    :- predicate_property(Goal, tabled), !.
 2419global_class(_,    static).
 2420
 2421
 2422%!  vararg_goal_classification(+Name, +Arity, -Class) is semidet.
 2423%
 2424%   Multifile hookable classification for _vararg_ predicates.
 2425
 2426vararg_goal_classification(call, Arity, built_in) :-
 2427    Arity >= 1.
 2428vararg_goal_classification(send_super, Arity, expanded) :- % XPCE (TBD)
 2429    Arity >= 2.
 2430vararg_goal_classification(get_super, Arity, expanded) :-  % XPCE (TBD)
 2431    Arity >= 3.
 2432
 2433%!  qualified_goal_classification(:Goal, +TB, -Class)
 2434%
 2435%   Classify an explicitly qualified goal.
 2436
 2437qualified_goal_classification(Goal, TB, Class) :-
 2438    goal_classification(TB, Goal, [], Class),
 2439    Class \== undefined,
 2440    !.
 2441qualified_goal_classification(Module:Goal, _, extern(Module, How)) :-
 2442    predicate_property(Module:Goal, visible),
 2443    !,
 2444    (   (   predicate_property(Module:Goal, public)
 2445        ;   predicate_property(Module:Goal, exported)
 2446        )
 2447    ->  How = (public)
 2448    ;   How = (private)
 2449    ).
 2450qualified_goal_classification(Module:_, _, extern(Module, unknown)).
 2451
 2452%!  classify_head(+TB, +Head, -Class)
 2453%
 2454%   Classify a clause head
 2455
 2456classify_head(TB, Goal, exported) :-
 2457    colour_state_source_id(TB, SourceId),
 2458    xref_exported(SourceId, Goal),
 2459    !.
 2460classify_head(_TB, Goal, hook) :-
 2461    xref_hook(Goal),
 2462    !.
 2463classify_head(TB, Goal, hook) :-
 2464    colour_state_source_id(TB, SourceId),
 2465    xref_module(SourceId, M),
 2466    xref_hook(M:Goal),
 2467    !.
 2468classify_head(TB, Goal, Class) :-
 2469    built_in_predicate(Goal),
 2470    (   system_module(TB)
 2471    ->  (   predicate_property(system:Goal, iso)
 2472        ->  Class = def_iso
 2473        ;   goal_name(Goal, Name),
 2474            \+ sub_atom(Name, 0, _, _, $)
 2475        ->  Class = def_swi
 2476        )
 2477    ;   (   predicate_property(system:Goal, iso)
 2478        ->  Class = iso
 2479        ;   Class = built_in
 2480        )
 2481    ).
 2482classify_head(TB, Goal, unreferenced) :-
 2483    colour_state_source_id(TB, SourceId),
 2484    \+ (xref_called(SourceId, Goal, By), By \= Goal),
 2485    !.
 2486classify_head(TB, Goal, test) :-
 2487    Goal = test(_),
 2488    colour_state_source_id(TB, SourceId),
 2489    xref_called(SourceId, Goal, '<test_unit>'(_Unit)),
 2490    !.
 2491classify_head(TB, Goal, test) :-
 2492    Goal = test(_, _),
 2493    colour_state_source_id(TB, SourceId),
 2494    xref_called(SourceId, Goal, '<test_unit>'(_Unit)),
 2495    !.
 2496classify_head(TB, Goal, How) :-
 2497    colour_state_source_id(TB, SourceId),
 2498    (   xref_defined(SourceId, Goal, imported(From))
 2499    ->  How = imported(From)
 2500    ;   xref_defined(SourceId, Goal, How)
 2501    ),
 2502    !.
 2503classify_head(_TB, _Goal, undefined).
 2504
 2505built_in_predicate(Goal) :-
 2506    predicate_property(system:Goal, built_in),
 2507    !.
 2508built_in_predicate(module(_, _)).       % reserved expanded constructs
 2509built_in_predicate(module(_, _, _)).
 2510built_in_predicate(if(_)).
 2511built_in_predicate(elif(_)).
 2512built_in_predicate(else).
 2513built_in_predicate(endif).
 2514
 2515goal_name(_:G, Name) :- nonvar(G), !, goal_name(G, Name).
 2516goal_name(G, Name) :- callable(G), functor_name(G, Name).
 2517
 2518system_module(TB) :-
 2519    colour_state_source_id(TB, SourceId),
 2520    xref_module(SourceId, M),
 2521    module_property(M, class(system)).
 2522
 2523generalise_term(Specific, General) :-
 2524    (   compound(Specific)
 2525    ->  compound_name_arity(Specific, Name, Arity),
 2526        compound_name_arity(General0, Name, Arity),
 2527        General = General0
 2528    ;   General = Specific
 2529    ).
 2530
 2531rename_goal(Goal0, Name, Goal) :-
 2532    (   compound(Goal0)
 2533    ->  compound_name_arity(Goal0, _, Arity),
 2534        compound_name_arity(Goal, Name, Arity)
 2535    ;   Goal = Name
 2536    ).
 2537
 2538functor_name(Term, Name) :-
 2539    (   compound(Term)
 2540    ->  compound_name_arity(Term, Name, _)
 2541    ;   atom(Term)
 2542    ->  Name = Term
 2543    ).
 2544
 2545goal_name_arity(Goal, Name, Arity) :-
 2546    (   compound(Goal)
 2547    ->  compound_name_arity(Goal, Name, Arity)
 2548    ;   atom(Goal)
 2549    ->  Name = Goal, Arity = 0
 2550    ).
 2551
 2552
 2553call_goal_colours(Term, Colours) :-
 2554    goal_colours(Term, Colours),
 2555    !.
 2556call_goal_colours(Term, Colours) :-
 2557    def_goal_colours(Term, Colours).
 2558
 2559call_goal_colours(Term, Class, Colours) :-
 2560    goal_colours(Term, Class, Colours),
 2561    !.
 2562%call_goal_colours(Term, Class, Colours) :-
 2563%    def_goal_colours(Term, Class, Colours).
 2564
 2565
 2566%       Specify colours for individual goals.
 2567
 2568def_goal_colours(_ is _,                 built_in-[classify,expression]).
 2569def_goal_colours(_ < _,                  built_in-[expression,expression]).
 2570def_goal_colours(_ > _,                  built_in-[expression,expression]).
 2571def_goal_colours(_ =< _,                 built_in-[expression,expression]).
 2572def_goal_colours(_ >= _,                 built_in-[expression,expression]).
 2573def_goal_colours(_ =\= _,                built_in-[expression,expression]).
 2574def_goal_colours(_ =:= _,                built_in-[expression,expression]).
 2575def_goal_colours(module(_,_),            built_in-[identifier,exports]).
 2576def_goal_colours(module(_,_,_),          built_in-[identifier,exports,langoptions]).
 2577def_goal_colours(use_module(_),          built_in-[imported_file]).
 2578def_goal_colours(use_module(File,_),     built_in-[file,imports(File)]).
 2579def_goal_colours(autoload(_),            built_in-[imported_file]).
 2580def_goal_colours(autoload(File,_),       built_in-[file,imports(File)]).
 2581def_goal_colours(reexport(_),            built_in-[file]).
 2582def_goal_colours(reexport(File,_),       built_in-[file,imports(File)]).
 2583def_goal_colours(dynamic(_),             built_in-[declarations(dynamic)]).
 2584def_goal_colours(thread_local(_),        built_in-[declarations(thread_local)]).
 2585def_goal_colours(module_transparent(_),  built_in-[declarations(module_transparent)]).
 2586def_goal_colours(discontiguous(_),       built_in-[declarations(discontiguous)]).
 2587def_goal_colours(multifile(_),           built_in-[declarations(multifile)]).
 2588def_goal_colours(volatile(_),            built_in-[declarations(volatile)]).
 2589def_goal_colours(public(_),              built_in-[declarations(public)]).
 2590def_goal_colours(det(_),                 built_in-[declarations(det)]).
 2591def_goal_colours(table(_),               built_in-[declarations(table)]).
 2592def_goal_colours(meta_predicate(_),      built_in-[meta_declarations]).
 2593def_goal_colours(mode(_),                built_in-[meta_declarations]).
 2594def_goal_colours(consult(_),             built_in-[file]).
 2595def_goal_colours(include(_),             built_in-[file]).
 2596def_goal_colours(ensure_loaded(_),       built_in-[file]).
 2597def_goal_colours(load_files(_),          built_in-[file]).
 2598def_goal_colours(load_files(_,_),        built_in-[file,options]).
 2599def_goal_colours(setof(_,_,_),           built_in-[classify,setof,classify]).
 2600def_goal_colours(bagof(_,_,_),           built_in-[classify,setof,classify]).
 2601def_goal_colours(predicate_options(_,_,_), built_in-[predicate,classify,classify]).
 2602% Database access
 2603def_goal_colours(assert(_),              built_in-[db]).
 2604def_goal_colours(asserta(_),             built_in-[db]).
 2605def_goal_colours(assertz(_),             built_in-[db]).
 2606def_goal_colours(assert(_,_),            built_in-[db,classify]).
 2607def_goal_colours(asserta(_,_),           built_in-[db,classify]).
 2608def_goal_colours(assertz(_,_),           built_in-[db,classify]).
 2609def_goal_colours(retract(_),             built_in-[db]).
 2610def_goal_colours(retractall(_),          built_in-[db]).
 2611def_goal_colours(clause(_,_),            built_in-[db,classify]).
 2612def_goal_colours(clause(_,_,_),          built_in-[db,classify,classify]).
 2613% misc
 2614def_goal_colours(set_prolog_flag(_,_),   built_in-[prolog_flag_name,classify]).
 2615def_goal_colours(current_prolog_flag(_,_), built_in-[prolog_flag_name,classify]).
 2616% XPCE stuff
 2617def_goal_colours(pce_autoload(_,_),      classify-[classify,file]).
 2618def_goal_colours(pce_image_directory(_), classify-[directory]).
 2619def_goal_colours(new(_, _),              built_in-[classify,pce_new]).
 2620def_goal_colours(send_list(_,_,_),       built_in-pce_arg_list).
 2621def_goal_colours(send(_,_),              built_in-[pce_arg,pce_selector]).
 2622def_goal_colours(get(_,_,_),             built_in-[pce_arg,pce_selector,pce_arg]).
 2623def_goal_colours(send_super(_,_),        built_in-[pce_arg,pce_selector]).
 2624def_goal_colours(get_super(_,_),         built_in-[pce_arg,pce_selector,pce_arg]).
 2625def_goal_colours(get_chain(_,_,_),       built_in-[pce_arg,pce_selector,pce_arg]).
 2626def_goal_colours(Pce,                    built_in-pce_arg) :-
 2627    compound(Pce),
 2628    functor_name(Pce, Functor),
 2629    pce_functor(Functor).
 2630
 2631pce_functor(send).
 2632pce_functor(get).
 2633pce_functor(send_super).
 2634pce_functor(get_super).
 2635
 2636
 2637                 /*******************************
 2638                 *        SPECIFIC HEADS        *
 2639                 *******************************/
 2640
 2641head_colours(file_search_path(_,_), hook-[identifier,classify]).
 2642head_colours(library_directory(_),  hook-[file]).
 2643head_colours(resource(_,_),         hook-[identifier,file]).
 2644head_colours(resource(_,_,_),       hook-[identifier,file,classify]).
 2645
 2646head_colours(Var, _) :-
 2647    var(Var),
 2648    !,
 2649    fail.
 2650head_colours(M:H, Colours) :-
 2651    M == user,
 2652    head_colours(H, HC),
 2653    HC = hook - _,
 2654    !,
 2655    Colours = meta-[module(user), HC ].
 2656head_colours(M:H, Colours) :-
 2657    atom(M), callable(H),
 2658    xref_hook(M:H),
 2659    !,
 2660    Colours = meta-[module(M), hook-classify ].
 2661head_colours(M:_, meta-[module(M),extern(M)]).
 2662
 2663
 2664                 /*******************************
 2665                 *             STYLES           *
 2666                 *******************************/
 2667
 2668%!  def_style(+Pattern, -Style)
 2669%
 2670%   Define the style used for the   given  pattern. Definitions here
 2671%   can     be     overruled     by       defining     rules     for
 2672%   emacs_prolog_colours:style/2
 2673
 2674def_style(goal(built_in,_),        [colour(blue)]).
 2675def_style(goal(imported(_),_),     [colour(blue)]).
 2676def_style(goal(autoload(_),_),     [colour(navy_blue)]).
 2677def_style(goal(global,_),          [colour(navy_blue)]).
 2678def_style(goal(global(dynamic,_),_), [colour(magenta)]).
 2679def_style(goal(global(_,_),_),     [colour(navy_blue)]).
 2680def_style(goal(undefined,_),       [colour(red)]).
 2681def_style(goal(thread_local(_),_), [colour(magenta), underline(true)]).
 2682def_style(goal(dynamic(_),_),      [colour(magenta)]).
 2683def_style(goal(multifile(_),_),    [colour(navy_blue)]).
 2684def_style(goal(expanded,_),        [colour(blue), underline(true)]).
 2685def_style(goal(extern(_),_),       [colour(blue), underline(true)]).
 2686def_style(goal(extern(_,private),_), [colour(red)]).
 2687def_style(goal(extern(_,public),_), [colour(blue)]).
 2688def_style(goal(recursion,_),       [underline(true)]).
 2689def_style(goal(meta,_),            [colour(red4)]).
 2690def_style(goal(foreign(_),_),      [colour(darkturquoise)]).
 2691def_style(goal(local(_),_),        []).
 2692def_style(goal(constraint(_),_),   [colour(darkcyan)]).
 2693def_style(goal(not_callable,_),    [background(orange)]).
 2694
 2695def_style(function,                [colour(blue)]).
 2696def_style(no_function,             [colour(red)]).
 2697
 2698def_style(option_name,             [colour('#3434ba')]).
 2699def_style(no_option_name,          [colour(red)]).
 2700
 2701def_style(neck(_),		   [bold(true)]).
 2702
 2703def_style(head(exported,_),        [colour(blue), bold(true)]).
 2704def_style(head(public(_),_),       [colour('#016300'), bold(true)]).
 2705def_style(head(extern(_),_),       [colour(blue), bold(true)]).
 2706def_style(head(dynamic,_),         [colour(magenta), bold(true)]).
 2707def_style(head(multifile(_),_),    [colour(navy_blue), bold(true)]).
 2708def_style(head(unreferenced,_),    [colour(red), bold(true)]).
 2709def_style(head(hook,_),            [colour(blue), underline(true)]).
 2710def_style(head(meta,_),            []).
 2711def_style(head(constraint(_),_),   [colour(darkcyan), bold(true)]).
 2712def_style(head(imported(_),_),     [colour(darkgoldenrod4), bold(true)]).
 2713def_style(head(built_in,_),        [background(orange), bold(true)]).
 2714def_style(head(iso,_),             [background(orange), bold(true)]).
 2715def_style(head(def_iso,_),         [colour(blue), bold(true)]).
 2716def_style(head(def_swi,_),         [colour(blue), bold(true)]).
 2717def_style(head(test,_),            [colour('#01bdbd'), bold(true)]).
 2718def_style(head(_,_),               [bold(true)]).
 2719def_style(rule_condition,	   [background('#d4ffe3')]).
 2720
 2721def_style(module(_),               [colour(dark_slate_blue)]).
 2722def_style(comment(_),              [colour(dark_green)]).
 2723
 2724def_style(directive,               [background(grey90)]).
 2725def_style(method(_),               [bold(true)]).
 2726
 2727def_style(var,                     [colour(red4)]).
 2728def_style(singleton,               [bold(true), colour(red4)]).
 2729def_style(unbound,                 [colour(red), bold(true)]).
 2730def_style(quoted_atom,             [colour(navy_blue)]).
 2731def_style(string,                  [colour(navy_blue)]).
 2732def_style(rational(_),		   [colour(steel_blue)]).
 2733def_style(codes,                   [colour(navy_blue)]).
 2734def_style(chars,                   [colour(navy_blue)]).
 2735def_style(nofile,                  [colour(red)]).
 2736def_style(file(_),                 [colour(blue), underline(true)]).
 2737def_style(file_no_depend(_),       [colour(blue), underline(true), background(pink)]).
 2738def_style(directory(_),            [colour(blue)]).
 2739def_style(class(built_in,_),       [colour(blue), underline(true)]).
 2740def_style(class(library(_),_),     [colour(navy_blue), underline(true)]).
 2741def_style(class(local(_,_,_),_),   [underline(true)]).
 2742def_style(class(user(_),_),        [underline(true)]).
 2743def_style(class(user,_),           [underline(true)]).
 2744def_style(class(undefined,_),      [colour(red), underline(true)]).
 2745def_style(prolog_data,             [colour(blue), underline(true)]).
 2746def_style(flag_name(_),            [colour(blue)]).
 2747def_style(known_flag_name(_),      [colour(blue), background(pink)]).
 2748def_style(no_flag_name(_),         [colour(red)]).
 2749def_style(unused_import,           [colour(blue), background(pink)]).
 2750def_style(undefined_import,        [colour(red)]).
 2751
 2752def_style(constraint(_),           [colour(darkcyan)]).
 2753
 2754def_style(keyword(_),              [colour(blue)]).
 2755def_style(identifier,              [bold(true)]).
 2756def_style(delimiter,               [bold(true)]).
 2757def_style(expanded,                [colour(blue), underline(true)]).
 2758def_style(hook(_),                 [colour(blue), underline(true)]).
 2759def_style(op_type(_),              [colour(blue)]).
 2760
 2761def_style(qq_type,                 [bold(true)]).
 2762def_style(qq(_),                   [colour(blue), bold(true)]).
 2763def_style(qq_content(_),           [colour(red4)]).
 2764
 2765def_style(dict_tag,                [bold(true)]).
 2766def_style(dict_key,                [bold(true)]).
 2767def_style(dict_function(_),        [colour(navy_blue)]).
 2768def_style(dict_return_op,          [colour(blue)]).
 2769
 2770def_style(hook,                    [colour(blue), underline(true)]).
 2771def_style(dcg_right_hand_ctx,      [background('#d4ffe3')]).
 2772
 2773def_style(error,                   [background(orange)]).
 2774def_style(type_error(_),           [background(orange)]).
 2775def_style(domain_error(_),         [background(orange)]).
 2776def_style(syntax_error(_,_),       [background(orange)]).
 2777def_style(instantiation_error,     [background(orange)]).
 2778
 2779def_style(decl_option(_),	   [bold(true)]).
 2780def_style(table_mode(_),	   [bold(true)]).
 2781
 2782def_style(macro(_),                [colour(blue), underline(true)]).
 2783
 2784%!  syntax_colour(?Class, ?Attributes) is nondet.
 2785%
 2786%   True when a range  classified  Class   must  be  coloured  using
 2787%   Attributes.  Attributes is a list of:
 2788%
 2789%     * colour(ColourName)
 2790%     * background(ColourName)
 2791%     * bold(Boolean)
 2792%     * underline(Boolean)
 2793%
 2794%   Attributes may be the empty list. This   is used for cases where
 2795%   -for example- a  menu  is  associated   with  the  fragment.  If
 2796%   syntax_colour/2 fails, no fragment is created for the region.
 2797
 2798syntax_colour(Class, Attributes) :-
 2799    (   style(Class, Attributes)            % user hook
 2800    ;   def_style(Class, Attributes)        % system default
 2801    ).
 2802
 2803
 2804%!  term_colours(+Term, -FunctorColour, -ArgColours)
 2805%
 2806%   Define colourisation for specific terms.
 2807
 2808term_colours((?- Directive), Colours) :-
 2809    term_colours((:- Directive), Colours).
 2810term_colours((prolog:Head --> _),
 2811             neck(-->) - [ expanded - [ module(prolog),
 2812                                        hook(message) - [ identifier
 2813                                                        ]
 2814                                      ],
 2815                           dcg_body(prolog:Head)
 2816                         ]) :-
 2817    prolog_message_hook(Head).
 2818
 2819prolog_message_hook(message(_)).
 2820prolog_message_hook(deprecated(_)).
 2821prolog_message_hook(error_message(_)).
 2822prolog_message_hook(message_context(_)).
 2823prolog_message_hook(message_location(_)).
 2824
 2825%       XPCE rules
 2826
 2827term_colours(variable(_, _, _, _),
 2828             expanded - [ identifier,
 2829                          classify,
 2830                          classify,
 2831                          comment(string)
 2832                        ]).
 2833term_colours(variable(_, _, _),
 2834             expanded - [ identifier,
 2835                          classify,
 2836                          atom
 2837                        ]).
 2838term_colours(handle(_, _, _),
 2839             expanded - [ classify,
 2840                          classify,
 2841                          classify
 2842                        ]).
 2843term_colours(handle(_, _, _, _),
 2844             expanded - [ classify,
 2845                          classify,
 2846                          classify,
 2847                          classify
 2848                        ]).
 2849term_colours(class_variable(_,_,_,_),
 2850             expanded - [ identifier,
 2851                          pce(type),
 2852                          pce(default),
 2853                          comment(string)
 2854                        ]).
 2855term_colours(class_variable(_,_,_),
 2856             expanded - [ identifier,
 2857                          pce(type),
 2858                          pce(default)
 2859                        ]).
 2860term_colours(delegate_to(_),
 2861             expanded - [ classify
 2862                        ]).
 2863term_colours((:- encoding(_)),
 2864             expanded - [ expanded - [ classify
 2865                                     ]
 2866                        ]).
 2867term_colours((:- pce_begin_class(_, _, _)),
 2868             expanded - [ expanded - [ identifier,
 2869                                       pce_new,
 2870                                       comment(string)
 2871                                     ]
 2872                        ]).
 2873term_colours((:- pce_begin_class(_, _)),
 2874             expanded - [ expanded - [ identifier,
 2875                                       pce_new
 2876                                     ]
 2877                        ]).
 2878term_colours((:- pce_extend_class(_)),
 2879             expanded - [ expanded - [ identifier
 2880                                     ]
 2881                        ]).
 2882term_colours((:- pce_end_class),
 2883             expanded - [ expanded
 2884                        ]).
 2885term_colours((:- pce_end_class(_)),
 2886             expanded - [ expanded - [ identifier
 2887                                     ]
 2888                        ]).
 2889term_colours((:- use_class_template(_)),
 2890             expanded - [ expanded - [ pce_new
 2891                                     ]
 2892                        ]).
 2893term_colours((:- emacs_begin_mode(_,_,_,_,_)),
 2894             expanded - [ expanded - [ identifier,
 2895                                       classify,
 2896                                       classify,
 2897                                       classify,
 2898                                       classify
 2899                                     ]
 2900                        ]).
 2901term_colours((:- emacs_extend_mode(_,_)),
 2902             expanded - [ expanded - [ identifier,
 2903                                       classify
 2904                                     ]
 2905                        ]).
 2906term_colours((:- pce_group(_)),
 2907             expanded - [ expanded - [ identifier
 2908                                     ]
 2909                        ]).
 2910term_colours((:- pce_global(_, new(_))),
 2911             expanded - [ expanded - [ identifier,
 2912                                       pce_arg
 2913                                     ]
 2914                        ]).
 2915term_colours((:- emacs_end_mode),
 2916             expanded - [ expanded
 2917                        ]).
 2918term_colours(pce_ifhostproperty(_,_),
 2919             expanded - [ classify,
 2920                          classify
 2921                        ]).
 2922term_colours((_,_),
 2923             error - [ classify,
 2924                       classify
 2925                     ]).
 2926
 2927%!  specified_item(+Specified, +Term, +TB, +TermPosition) is det.
 2928%
 2929%   Colourise an item that is explicitly   classified  by the user using
 2930%   term_colours/2 or goal_colours/2.
 2931
 2932specified_item(_Class, _Term, _TB, Pos) :-
 2933    var(Pos),
 2934    !.
 2935specified_item(Class, Term, TB, parentheses_term_position(PO,PC,Pos)) :-
 2936    !,
 2937    colour_item(parentheses, TB, PO-PC),
 2938    specified_item(Class, Term, TB, Pos).
 2939specified_item(_, Var, TB, Pos) :-
 2940    (   var(Var)
 2941    ;   qq_position(Pos)
 2942    ),
 2943    !,
 2944    colourise_term_arg(Var, TB, Pos).
 2945                                        % generic classification
 2946specified_item(classify, Term, TB, Pos) :-
 2947    !,
 2948    colourise_term_arg(Term, TB, Pos).
 2949                                        % classify as head
 2950specified_item(head, Term, TB, Pos) :-
 2951    !,
 2952    colourise_clause_head(Term, TB, Pos).
 2953                                        % expanded head (DCG=2, ...)
 2954specified_item(head(+N), Term, TB, Pos) :-
 2955    !,
 2956    colourise_extended_head(Term, N, TB, Pos).
 2957                                        % M:Head
 2958specified_item(extern(M), Term, TB, Pos) :-
 2959    !,
 2960    colourise_extern_head(Term, M, TB, Pos).
 2961                                        % classify as body
 2962specified_item(body, Term, TB, Pos) :-
 2963    !,
 2964    colourise_body(Term, TB, Pos).
 2965specified_item(body(Goal), _Term0, TB, Pos) :-
 2966    !,
 2967    colourise_body(Goal, TB, Pos).
 2968specified_item(dcg_body(Head), Term, TB, Pos) :-
 2969    !,
 2970    colourise_dcg(Term, Head, TB, Pos).
 2971specified_item(setof, Term, TB, Pos) :-
 2972    !,
 2973    colourise_setof(Term, TB, Pos).
 2974specified_item(meta(MetaSpec), Term, TB, Pos) :-
 2975    !,
 2976    colourise_meta_arg(MetaSpec, Term, TB, Pos).
 2977                                        % DCG goal in body
 2978specified_item(dcg, Term, TB, Pos) :-
 2979    !,
 2980    colourise_dcg(Term, [], TB, Pos).
 2981                                        % assert/retract arguments
 2982specified_item(db, Term, TB, Pos) :-
 2983    !,
 2984    colourise_db(Term, TB, Pos).
 2985                                        % error(Error)
 2986specified_item(error(Error), _Term, TB, Pos) :-
 2987    colour_item(Error, TB, Pos).
 2988                                        % files
 2989specified_item(file(Path), _Term, TB, Pos) :-
 2990    !,
 2991    colour_item(file(Path), TB, Pos).
 2992specified_item(file, Term, TB, Pos) :-
 2993    !,
 2994    colourise_files(Term, TB, Pos, any).
 2995specified_item(imported_file, Term, TB, Pos) :-
 2996    !,
 2997    colourise_files(Term, TB, Pos, imported).
 2998specified_item(langoptions, Term, TB, Pos) :-
 2999    !,
 3000    colourise_langoptions(Term, TB, Pos).
 3001specified_item(expression, Term, TB, Pos) :-
 3002    !,
 3003    colourise_expression(Term, TB, Pos).
 3004                                        % directory
 3005specified_item(directory, Term, TB, Pos) :-
 3006    !,
 3007    colourise_directory(Term, TB, Pos).
 3008                                        % [Name/Arity, ...]
 3009specified_item(exports, Term, TB, Pos) :-
 3010    !,
 3011    colourise_exports(Term, TB, Pos).
 3012                                        % [Name/Arity, ...]
 3013specified_item(imports(File), Term, TB, Pos) :-
 3014    !,
 3015    colourise_imports(Term, File, TB, Pos).
 3016                                        % Name/Arity
 3017specified_item(import(File), Term, TB, Pos) :-
 3018    !,
 3019    colourise_import(Term, File, TB, Pos).
 3020                                        % Name/Arity, ...
 3021specified_item(predicates, Term, TB, Pos) :-
 3022    !,
 3023    colourise_declarations(Term, predicate_indicator, TB, Pos).
 3024                                        % Name/Arity
 3025specified_item(predicate, Term, TB, Pos) :-
 3026    !,
 3027    colourise_declaration(Term, predicate_indicator, TB, Pos).
 3028                                        % head(Arg, ...)
 3029specified_item(meta_declarations, Term, TB, Pos) :-
 3030    !,
 3031    colourise_meta_declarations(Term, [], TB, Pos).
 3032specified_item(meta_declarations(Extra), Term, TB, Pos) :-
 3033    !,
 3034    colourise_meta_declarations(Term, Extra, TB, Pos).
 3035specified_item(declarations(Which), Term, TB, Pos) :-
 3036    !,
 3037    colourise_declarations(Term, Which, TB, Pos).
 3038                                        % set_prolog_flag(Name, _)
 3039specified_item(prolog_flag_name, Term, TB, Pos) :-
 3040    !,
 3041    colourise_prolog_flag_name(Term, TB, Pos).
 3042                                        % XPCE new argument
 3043specified_item(pce_new, Term, TB, Pos) :-
 3044    !,
 3045    (   atom(Term)
 3046    ->  colourise_class(Term, TB, Pos)
 3047    ;   compound(Term)
 3048    ->  functor_name(Term, Class),
 3049        Pos = term_position(_,_,FF, FT, ArgPos),
 3050        colourise_class(Class, TB, FF-FT),
 3051        specified_items(pce_arg, Term, TB, ArgPos)
 3052    ;   colourise_term_arg(Term, TB, Pos)
 3053    ).
 3054                                        % Generic XPCE arguments
 3055specified_item(pce_arg, new(X), TB,
 3056               term_position(_,_,_,_,[ArgPos])) :-
 3057    !,
 3058    specified_item(pce_new, X, TB, ArgPos).
 3059specified_item(pce_arg, new(X, T), TB,
 3060               term_position(_,_,_,_,[P1, P2])) :-
 3061    !,
 3062    colourise_term_arg(X, TB, P1),
 3063    specified_item(pce_new, T, TB, P2).
 3064specified_item(pce_arg, @(Ref), TB, Pos) :-
 3065    !,
 3066    colourise_term_arg(@(Ref), TB, Pos).
 3067specified_item(pce_arg, prolog(Term), TB,
 3068               term_position(_,_,FF,FT,[ArgPos])) :-
 3069    !,
 3070    colour_item(prolog_data, TB, FF-FT),
 3071    colourise_term_arg(Term, TB, ArgPos).
 3072specified_item(pce_arg, Term, TB, Pos) :-
 3073    compound(Term),
 3074    Term \= [_|_],
 3075    \+ is_dict(Term),
 3076    !,
 3077    specified_item(pce_new, Term, TB, Pos).
 3078specified_item(pce_arg, Term, TB, Pos) :-
 3079    !,
 3080    colourise_term_arg(Term, TB, Pos).
 3081                                        % List of XPCE arguments
 3082specified_item(pce_arg_list, List, TB, list_position(F,T,Elms,Tail)) :-
 3083    !,
 3084    colour_item(list, TB, F-T),
 3085    colourise_list_args(Elms, Tail, List, TB, pce_arg).
 3086specified_item(pce_arg_list, Term, TB, Pos) :-
 3087    !,
 3088    specified_item(pce_arg, Term, TB, Pos).
 3089                                        % XPCE selector
 3090specified_item(pce_selector, Term, TB,
 3091               term_position(_,_,_,_,ArgPos)) :-
 3092    !,
 3093    specified_items(pce_arg, Term, TB, ArgPos).
 3094specified_item(pce_selector, Term, TB, Pos) :-
 3095    colourise_term_arg(Term, TB, Pos).
 3096                                        % Nested specification
 3097specified_item(FuncSpec-ArgSpecs, Term, TB,
 3098               term_position(_,_,FF,FT,ArgPos)) :-
 3099    !,
 3100    specified_item(FuncSpec, Term, TB, FF-FT),
 3101    specified_items(ArgSpecs, Term, TB, ArgPos).
 3102                                        % Nested for {...}
 3103specified_item(FuncSpec-[ArgSpec], {Term}, TB,
 3104               brace_term_position(F,T,ArgPos)) :-
 3105    !,
 3106    specified_item(FuncSpec, {Term}, TB, F-T),
 3107    specified_item(ArgSpec, Term, TB, ArgPos).
 3108                                        % Specified
 3109specified_item(FuncSpec-ElmSpec, List, TB,
 3110               list_position(F,T,ElmPos,TailPos)) :-
 3111    !,
 3112    colour_item(FuncSpec, TB, F-T),
 3113    specified_list(ElmSpec, List, TB, ElmPos, TailPos).
 3114specified_item(Class, _, TB, Pos) :-
 3115    colour_item(Class, TB, Pos).
 3116
 3117%!  specified_items(+Spec, +Term, +TB, +PosList)
 3118
 3119specified_items(Specs, Term, TB, PosList) :-
 3120    is_dict(Term),
 3121    !,
 3122    specified_dict_kv(PosList, Term, TB, Specs).
 3123specified_items(Specs, Term, TB, PosList) :-
 3124    is_list(Specs),
 3125    !,
 3126    specified_arglist(Specs, 1, Term, TB, PosList).
 3127specified_items(Spec, Term, TB, PosList) :-
 3128    specified_argspec(PosList, Spec, 1, Term, TB).
 3129
 3130
 3131specified_arglist([], _, _, _, _).
 3132specified_arglist(_, _, _, _, []) :- !.         % Excess specification args
 3133specified_arglist([S0|ST], N, T, TB, [P0|PT]) :-
 3134    (   S0 == options,
 3135        colourization_module(TB, Module),
 3136        colourise_option_arg(T, Module, N, TB, P0)
 3137    ->  true
 3138    ;   arg(N, T, Term),
 3139        specified_item(S0, Term, TB, P0)
 3140    ),
 3141    NN is N + 1,
 3142    specified_arglist(ST, NN, T, TB, PT).
 3143
 3144specified_argspec([], _, _, _, _).
 3145specified_argspec([P0|PT], Spec, N, T, TB) :-
 3146    arg(N, T, Term),
 3147    specified_item(Spec, Term, TB, P0),
 3148    NN is N + 1,
 3149    specified_argspec(PT, Spec, NN, T, TB).
 3150
 3151
 3152%       specified_list(+Spec, +List, +TB, +PosList, TailPos)
 3153
 3154specified_list([], [], _, [], _).
 3155specified_list([HS|TS], [H|T], TB, [HP|TP], TailPos) :-
 3156    !,
 3157    specified_item(HS, H, TB, HP),
 3158    specified_list(TS, T, TB, TP, TailPos).
 3159specified_list(Spec, [H|T], TB, [HP|TP], TailPos) :-
 3160    specified_item(Spec, H, TB, HP),
 3161    specified_list(Spec, T, TB, TP, TailPos).
 3162specified_list(_, _, _, [], none) :- !.
 3163specified_list(Spec, Tail, TB, [], TailPos) :-
 3164    specified_item(Spec, Tail, TB, TailPos).
 3165
 3166%!  specified_dict_kv(+PosList, +Term, +TB, +Specs)
 3167%
 3168%   @arg Specs is a list of dict_kv(+Key, +KeySpec, +ArgSpec)
 3169
 3170specified_dict_kv([], _, _, _).
 3171specified_dict_kv([key_value_position(_F,_T,SF,ST,K,KP,VP)|Pos],
 3172                  Dict, TB, Specs) :-
 3173    specified_dict_kv1(K, Specs, KeySpec, ValueSpec),
 3174    colour_item(KeySpec, TB, KP),
 3175    colour_item(dict_sep, TB, SF-ST),
 3176    get_dict(K, Dict, V),
 3177    specified_item(ValueSpec, V, TB, VP),
 3178    specified_dict_kv(Pos, Dict, TB, Specs).
 3179
 3180specified_dict_kv1(Key, Specs, KeySpec, ValueSpec) :-
 3181    Specs = [_|_],
 3182    memberchk(dict_kv(Key, KeySpec, ValueSpec), Specs),
 3183    !.
 3184specified_dict_kv1(Key, dict_kv(Key2, KeySpec, ValueSpec), KeySpec, ValueSpec) :-
 3185    \+ Key \= Key2,
 3186    !.              % do not bind Key2
 3187specified_dict_kv1(_, _, dict_key, classify).
 3188
 3189
 3190                 /*******************************
 3191                 *         DESCRIPTIONS         *
 3192                 *******************************/
 3193
 3194syntax_message(Class) -->
 3195    message(Class),
 3196    !.
 3197syntax_message(qq(_)) -->
 3198    [ 'Quasi quote delimiter' ].
 3199syntax_message(qq_type) -->
 3200    [ 'Quasi quote type term' ].
 3201syntax_message(qq_content(Type)) -->
 3202    [ 'Quasi quote content (~w syntax)'-[Type] ].
 3203syntax_message(goal(Class, Goal)) -->
 3204    !,
 3205    goal_message(Class, Goal).
 3206syntax_message(class(Type, Class)) -->
 3207    !,
 3208    xpce_class_message(Type, Class).
 3209syntax_message(dict_return_op) -->
 3210    !,
 3211    [ ':= separates function from return value' ].
 3212syntax_message(dict_function) -->
 3213    !,
 3214    [ 'Function on a dict' ].
 3215syntax_message(ext_quant) -->
 3216    !,
 3217    [ 'Existential quantification operator' ].
 3218syntax_message(hook(message)) -->
 3219    [ 'Rule for print_message/2' ].
 3220syntax_message(module(Module)) -->
 3221    (   { current_module(Module) }
 3222    ->  (   { module_property(Module, file(File)) }
 3223        ->  [ 'Module ~w defined in ~w'-[Module,File] ]
 3224        ;   [ 'Module ~w'-[Module] ]
 3225        )
 3226    ;   [ 'Module ~w (not loaded)'-[Module] ]
 3227    ).
 3228syntax_message(decl_option(incremental)) -->
 3229    [ 'Keep affected tables consistent' ].
 3230syntax_message(decl_option(abstract)) -->
 3231    [ 'Add abstracted goal to table dependency graph' ].
 3232syntax_message(decl_option(volatile)) -->
 3233    [ 'Do not include predicate in a saved program' ].
 3234syntax_message(decl_option(multifile)) -->
 3235    [ 'Clauses are spread over multiple files' ].
 3236syntax_message(decl_option(discontiguous)) -->
 3237    [ 'Clauses are not contiguous' ].
 3238syntax_message(decl_option(private)) -->
 3239    [ 'Tables or clauses are private to a thread' ].
 3240syntax_message(decl_option(local)) -->
 3241    [ 'Tables or clauses are private to a thread' ].
 3242syntax_message(decl_option(shared)) -->
 3243    [ 'Tables or clauses are shared between threads' ].
 3244syntax_message(decl_option(_Opt)) -->
 3245    [ 'Predicate property' ].
 3246syntax_message(rational(Value)) -->
 3247    [ 'Rational number ~w'-[Value] ].
 3248syntax_message(rule_condition) -->
 3249    [ 'Guard' ].
 3250syntax_message(neck(=>)) -->
 3251    [ 'Rule' ].
 3252syntax_message(neck(-->)) -->
 3253    [ 'Grammar rule' ].
 3254syntax_message(neck(==>)) -->
 3255    [ 'SSU Grammar rule' ].
 3256syntax_message(macro(String)) -->
 3257    [ 'Macro indicator (expands to ~s)'-[String] ].
 3258syntax_message(flag_name(Name)) -->
 3259    [ 'Prolog flag ~w'-[Name] ].
 3260syntax_message(known_flag_name(Name)) -->
 3261    [ 'Prolog flag ~w (not set; known)'-[Name] ].
 3262syntax_message(no_flag_name(Name)) -->
 3263    [ 'Prolog flag ~w (not set)'-[Name] ].
 3264
 3265goal_message(meta, _) -->
 3266    [ 'Meta call' ].
 3267goal_message(not_callable, _) -->
 3268    [ 'Goal is not callable (type error)' ].
 3269goal_message(expanded, _) -->
 3270    [ 'Expanded goal' ].
 3271goal_message(Class, Goal) -->
 3272    { predicate_name(Goal, PI) },
 3273    [ 'Call to ~q'-PI ],
 3274    goal_class(Class).
 3275
 3276goal_class(recursion) -->
 3277    [ ' (recursive call)' ].
 3278goal_class(undefined) -->
 3279    [ ' (undefined)' ].
 3280goal_class(global) -->
 3281    [ ' (Auto-imported from module user)' ].
 3282goal_class(global(Class, File:Line)) -->
 3283    [ ' (~w in user module from '-[Class], url(File:Line), ')' ].
 3284goal_class(global(Class, source_location(File,Line))) -->
 3285    [ ' (~w in user module from '-[Class], url(File:Line), ')' ].
 3286goal_class(global(Class, -)) -->
 3287    [ ' (~w in user module)'-[Class] ].
 3288goal_class(imported(From)) -->
 3289    [ ' (imported from ~q)'-[From] ].
 3290goal_class(extern(_, private)) -->
 3291    [ ' (WARNING: private predicate)' ].
 3292goal_class(extern(_, public)) -->
 3293    [ ' (public predicate)' ].
 3294goal_class(extern(_)) -->
 3295    [ ' (cross-module call)' ].
 3296goal_class(Class) -->
 3297    [ ' (~p)'-[Class] ].
 3298
 3299xpce_class_message(Type, Class) -->
 3300    [ 'XPCE ~w class ~q'-[Type, Class] ]