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