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