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