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