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