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