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