1509 lines
46 KiB
Prolog
1509 lines
46 KiB
Prolog
/* Part of SWI-Prolog
|
|
|
|
Author: Jan Wielemaker
|
|
E-mail: J.Wielemaker@cs.vu.nl
|
|
WWW: http://www.swi-prolog.org/projects/xpce/
|
|
Copyright (C): 1985-2011, University of Amsterdam
|
|
VU University Amsterdam
|
|
|
|
This program is free software; you can redistribute it and/or
|
|
modify it under the terms of the GNU General Public License
|
|
as published by the Free Software Foundation; either version 2
|
|
of the License, or (at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Lesser General Public
|
|
License along with this library; if not, write to the Free Software
|
|
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
|
|
As a special exception, if you link this library with other files,
|
|
compiled with a Free Software compiler, to produce an executable, this
|
|
library does not by itself cause the resulting executable to be covered
|
|
by the GNU General Public License. This exception does not however
|
|
invalidate any other reasons why the executable file might be covered by
|
|
the GNU General Public License.
|
|
*/
|
|
|
|
|
|
:- module(prolog_colour,
|
|
[ prolog_colourise_stream/3, % +Stream, +SourceID, :ColourItem
|
|
prolog_colourise_term/4, % +Stream, +SourceID, :ColourItem, +Options
|
|
syntax_colour/2, % +Class, -Attributes
|
|
syntax_message//1 % +Class
|
|
]).
|
|
:- use_module(library(prolog_xref)).
|
|
:- use_module(library(predicate_options)).
|
|
:- use_module(library(prolog_source)).
|
|
:- use_module(library(lists)).
|
|
:- use_module(library(operators)).
|
|
:- use_module(library(debug)).
|
|
:- use_module(library(edit)).
|
|
:- use_module(library(error)).
|
|
:- use_module(library(option)).
|
|
:- use_module(library(record)).
|
|
:- if(exists_source(library(pce_meta))).
|
|
:- use_module(library(pce_meta)).
|
|
:- endif.
|
|
|
|
:- meta_predicate
|
|
prolog_colourise_stream(+, +, 3),
|
|
prolog_colourise_term(+, +, 3, +).
|
|
|
|
:- predicate_options(prolog_colourise_term/4, 4,
|
|
[ subterm_positions(-any)
|
|
]).
|
|
|
|
/** <module> Prolog syntax colouring support.
|
|
|
|
This module defines reusable code to colourise Prolog source.
|
|
|
|
@tbd: The one-term version
|
|
*/
|
|
|
|
|
|
:- multifile
|
|
style/2, % +ColourClass, -Attributes
|
|
message//1, % +ColourClass
|
|
term_colours/2, % +SourceTerm, -ColourSpec
|
|
goal_colours/2, % +Goal, -ColourSpec
|
|
directive_colours/2, % +Goal, -ColourSpec
|
|
goal_classification/2. % +Goal, -Class
|
|
|
|
|
|
:- record
|
|
colour_state(source_id,
|
|
closure,
|
|
singletons).
|
|
|
|
%% prolog_colourise_stream(+Stream, +SourceID, :ColourItem) is det.
|
|
%
|
|
% Determine colour fragments for the data on Stream. SourceID is
|
|
% the canonical identifier of the input as known to the
|
|
% cross-referencer, i.e., as created using xref_source(SourceID).
|
|
%
|
|
% ColourItem is a closure that is called for each identified
|
|
% fragment with three additional arguments:
|
|
%
|
|
% * The syntactical category
|
|
% * Start position (character offset) of the fragment
|
|
% * Length of the fragment (in characters).
|
|
|
|
prolog_colourise_stream(Fd, SourceId, ColourItem) :-
|
|
make_colour_state([ source_id(SourceId),
|
|
closure(ColourItem)
|
|
],
|
|
TB),
|
|
setup_call_cleanup(
|
|
save_settings(State),
|
|
colourise_stream(Fd, TB),
|
|
restore_settings(State)).
|
|
|
|
colourise_stream(Fd, TB) :-
|
|
( peek_char(Fd, #) % skip #! script line
|
|
-> skip(Fd, 10)
|
|
; true
|
|
),
|
|
repeat,
|
|
'$set_source_module'(SM, SM),
|
|
character_count(Fd, Start),
|
|
catch(read_term(Fd, Term,
|
|
[ subterm_positions(TermPos),
|
|
singletons(Singletons),
|
|
module(SM),
|
|
comments(Comments)
|
|
]),
|
|
E,
|
|
read_error(E, TB, Fd, Start)),
|
|
fix_operators(Term, TB),
|
|
colour_state_singletons(TB, Singletons),
|
|
( colourise_term(Term, TB, TermPos, Comments)
|
|
-> true
|
|
; arg(1, TermPos, From),
|
|
print_message(warning,
|
|
format('Failed to colourise ~p at index ~d~n',
|
|
[Term, From]))
|
|
),
|
|
Term == end_of_file, !.
|
|
|
|
save_settings(state(Style, Esc)) :-
|
|
push_operators([]),
|
|
current_prolog_flag(character_escapes, Esc),
|
|
'$style_check'(Style, Style).
|
|
|
|
restore_settings(state(Style, Esc)) :-
|
|
set_prolog_flag(character_escapes, Esc),
|
|
'$style_check'(_, Style),
|
|
pop_operators.
|
|
|
|
%% read_error(+Error, +TB, +Stream, +Start) is failure.
|
|
%
|
|
% If this is a syntax error, create a syntax-error fragment.
|
|
|
|
read_error(Error, TB, Stream, Start) :-
|
|
( Error = error(syntax_error(Id), stream(_S, _Line, _LinePos, CharNo))
|
|
-> message_to_string(error(syntax_error(Id), _), Msg),
|
|
character_count(Stream, End),
|
|
show_syntax_error(TB, CharNo:Msg, Start-End),
|
|
fail
|
|
; throw(Error)
|
|
).
|
|
|
|
%% colour_item(+Class, +TB, +Pos) is det.
|
|
|
|
colour_item(Class, TB, Pos) :-
|
|
arg(1, Pos, Start),
|
|
arg(2, Pos, End),
|
|
Len is End - Start,
|
|
colour_state_closure(TB, Closure),
|
|
call(Closure, Class, Start, Len).
|
|
|
|
|
|
%% safe_push_op(+Prec, +Type, :Name)
|
|
%
|
|
% Define operators into the default source module and register
|
|
% them to be undone by pop_operators/0.
|
|
|
|
safe_push_op(P, T, N0) :-
|
|
( N0 = _:_
|
|
-> N = N0
|
|
; '$set_source_module'(M, M),
|
|
N = M:N0
|
|
),
|
|
push_op(P, T, N),
|
|
debug(colour, ':- ~w.', [op(P,T,N)]).
|
|
|
|
%% fix_operators(+Term, +Src) is det.
|
|
%
|
|
% Fix flags that affect the syntax, such as operators and some
|
|
% style checking options. Src is the canonical source as required
|
|
% by the cross-referencer.
|
|
|
|
fix_operators((:- Directive), Src) :-
|
|
catch(process_directive(Directive, Src), _, true), !.
|
|
fix_operators(_, _).
|
|
|
|
process_directive(style_check(X), _) :- !,
|
|
style_check(X).
|
|
process_directive(op(P,T,N), _) :- !,
|
|
safe_push_op(P, T, N).
|
|
process_directive(module(_Name, Export), _) :- !,
|
|
forall(member(op(P,A,N), Export),
|
|
safe_push_op(P,A,N)).
|
|
process_directive(use_module(Spec), Src) :- !,
|
|
catch(process_use_module(Spec, Src), _, true).
|
|
process_directive(Directive, Src) :-
|
|
prolog_source:expand((:-Directive), Src, _).
|
|
|
|
%% process_use_module(+Imports, +Src)
|
|
%
|
|
% Get the exported operators from the referenced files.
|
|
|
|
process_use_module([], _) :- !.
|
|
process_use_module([H|T], Src) :- !,
|
|
process_use_module(H, Src),
|
|
process_use_module(T, Src).
|
|
process_use_module(File, Src) :-
|
|
( xref_public_list(File, _Path, Public, Src)
|
|
-> forall(member(op(P,T,N), Public),
|
|
safe_push_op(P,T,N))
|
|
; true
|
|
).
|
|
|
|
%% prolog_colourise_term(+Stream, +SourceID, :ColourItem, +Options)
|
|
%
|
|
% Colourise the next term on Stream. Unlike
|
|
% prolog_colourise_stream/3, this predicate assumes it is reading
|
|
% a single term rather than the entire stream. This implies that
|
|
% it cannot adjust syntax according to directives that preceed it.
|
|
%
|
|
% Options:
|
|
%
|
|
% * subterm_positions(-TermPos)
|
|
% Return complete term-layout. If an error is read, this is a
|
|
% term error_position(StartClause, EndClause, ErrorPos)
|
|
|
|
prolog_colourise_term(Stream, SourceId, ColourItem, Options) :-
|
|
make_colour_state([ source_id(SourceId),
|
|
closure(ColourItem)
|
|
],
|
|
TB),
|
|
option(subterm_positions(TermPos), Options, _),
|
|
findall(Op, xref_op(SourceId, Op), Ops),
|
|
character_count(Stream, Start),
|
|
read_source_term_at_location(
|
|
Stream, Term,
|
|
[ module(prolog_colour),
|
|
operators(Ops),
|
|
error(Error),
|
|
subterm_positions(TermPos),
|
|
singletons(Singletons),
|
|
comments(Comments)
|
|
]),
|
|
( var(Error)
|
|
-> colour_state_singletons(TB, Singletons),
|
|
colour_item(range, TB, TermPos), % Call to allow clearing
|
|
colourise_term(Term, TB, TermPos, Comments)
|
|
; character_count(Stream, End),
|
|
TermPos = error_position(Start, End, Pos),
|
|
colour_item(range, TB, TermPos),
|
|
show_syntax_error(TB, Error, Start-End),
|
|
Error = Pos:_Message
|
|
).
|
|
|
|
show_syntax_error(TB, Pos:Message, Range) :-
|
|
End is Pos + 1,
|
|
colour_item(syntax_error(Message, Range), TB, Pos-End).
|
|
|
|
|
|
singleton(Var, TB) :-
|
|
colour_state_singletons(TB, Singletons),
|
|
member_var(Var, Singletons).
|
|
|
|
member_var(V, [_=V2|_]) :-
|
|
V == V2, !.
|
|
member_var(V, [_|T]) :-
|
|
member_var(V, T).
|
|
|
|
%% colourise_term(+Term, +TB, +Termpos, +Comments)
|
|
|
|
colourise_term(Term, TB, TermPos, Comments) :-
|
|
colourise_comments(Comments, TB),
|
|
colourise_term(Term, TB, TermPos).
|
|
|
|
colourise_comments(-, _).
|
|
colourise_comments([], _).
|
|
colourise_comments([H|T], TB) :-
|
|
colourise_comment(H, TB),
|
|
colourise_comments(T, TB).
|
|
|
|
colourise_comment(Pos-Comment, TB) :-
|
|
stream_position_data(char_count, Pos, Start),
|
|
string_length(Comment, Len),
|
|
End is Start + Len + 1,
|
|
colour_item(comment, TB, Start-End).
|
|
|
|
colourise_term(Term, TB, Pos) :-
|
|
term_colours(Term, FuncSpec-ArgSpecs), !,
|
|
Pos = term_position(_,_,FF,FT,ArgPos),
|
|
specified_item(FuncSpec, Term, TB, FF-FT),
|
|
specified_items(ArgSpecs, Term, TB, ArgPos).
|
|
colourise_term((Head :- Body), TB,
|
|
term_position(F,T,FF,FT,[HP,BP])) :- !,
|
|
colour_item(clause, TB, F-T),
|
|
colour_item(neck(clause), TB, FF-FT),
|
|
colourise_clause_head(Head, TB, HP),
|
|
colourise_body(Body, Head, TB, BP).
|
|
colourise_term((Head --> Body), TB, % TBD: expansion!
|
|
term_position(F,T,FF,FT,[HP,BP])) :- !,
|
|
colour_item(grammar_rule, TB, F-T),
|
|
colour_item(neck(grammar_rule), TB, FF-FT),
|
|
colourise_extended_head(Head, 2, TB, HP),
|
|
colourise_dcg(Body, Head, TB, BP).
|
|
colourise_term(:->(Head, Body), TB,
|
|
term_position(F,T,FF,FT,[HP,BP])) :- !,
|
|
colour_item(method, TB, F-T),
|
|
colour_item(neck(method(send)), TB, FF-FT),
|
|
colour_method_head(send(Head), TB, HP),
|
|
colourise_method_body(Body, TB, BP).
|
|
colourise_term(:<-(Head, Body), TB,
|
|
term_position(F,T,FF,FT,[HP,BP])) :- !,
|
|
colour_item(method, TB, F-T),
|
|
colour_item(neck(method(get)), TB, FF-FT),
|
|
colour_method_head(get(Head), TB, HP),
|
|
colourise_method_body(Body, TB, BP).
|
|
colourise_term((:- Directive), TB, Pos) :- !,
|
|
colour_item(directive, TB, Pos),
|
|
arg(5, Pos, [ArgPos]),
|
|
colourise_directive(Directive, TB, ArgPos).
|
|
colourise_term((?- Directive), TB, Pos) :- !,
|
|
colourise_term((:- Directive), TB, Pos).
|
|
colourise_term(end_of_file, _, _) :- !.
|
|
colourise_term(Fact, TB, Pos) :- !,
|
|
colour_item(clause, TB, Pos),
|
|
colourise_clause_head(Fact, TB, Pos).
|
|
|
|
%% colourise_extended_head(+Head, +ExtraArgs, +TB, +Pos) is det.
|
|
%
|
|
% Colourise a clause-head that is extended by term_expansion,
|
|
% getting ExtraArgs more arguments (e.g., DCGs add two more
|
|
% arguments.
|
|
|
|
colourise_extended_head(Head, N, TB, Pos) :-
|
|
extend(Head, N, TheHead),
|
|
colourise_clause_head(TheHead, TB, Pos).
|
|
|
|
extend(M:Head, N, M:ExtHead) :-
|
|
nonvar(Head), !,
|
|
extend(Head, N, ExtHead).
|
|
extend(Head, N, ExtHead) :-
|
|
callable(Head), !,
|
|
Head =.. List,
|
|
length(Extra, N),
|
|
append(List, Extra, List1),
|
|
ExtHead =.. List1.
|
|
extend(Head, _, Head).
|
|
|
|
|
|
colourise_clause_head(Head, TB, Pos) :-
|
|
head_colours(Head, ClassSpec-ArgSpecs), !,
|
|
functor_position(Pos, FPos, ArgPos),
|
|
( ClassSpec == classify
|
|
-> classify_head(TB, Head, Class)
|
|
; Class = ClassSpec
|
|
),
|
|
colour_item(head(Class), TB, FPos),
|
|
specified_items(ArgSpecs, Head, TB, ArgPos).
|
|
colourise_clause_head(Head, TB, Pos) :-
|
|
functor_position(Pos, FPos, _),
|
|
classify_head(TB, Head, Class),
|
|
colour_item(head(Class), TB, FPos),
|
|
colourise_term_args(Head, TB, Pos).
|
|
|
|
% colourise_extern_head(+Head, +Module, +TB, +Pos)
|
|
%
|
|
% Colourise the head specified as Module:Head. Normally used for
|
|
% adding clauses to multifile predicates in other modules.
|
|
|
|
colourise_extern_head(Head, M, TB, Pos) :-
|
|
functor_position(Pos, FPos, _),
|
|
colour_item(head(extern(M)), TB, FPos),
|
|
colourise_term_args(Head, TB, Pos).
|
|
|
|
colour_method_head(SGHead, TB, Pos) :-
|
|
arg(1, SGHead, Head),
|
|
functor(SGHead, SG, _),
|
|
functor_position(Pos, FPos, _),
|
|
colour_item(method(SG), TB, FPos),
|
|
colourise_term_args(Head, TB, Pos).
|
|
|
|
% functor_position(+Term, -FunctorPos, -ArgPosList)
|
|
%
|
|
% Get the position of a functor and its argument. Unfortunately
|
|
% this goes wrong for lists, who have two `functor-positions'.
|
|
|
|
functor_position(term_position(_,_,FF,FT,ArgPos), FF-FT, ArgPos) :- !.
|
|
functor_position(list_position(F,_T,Elms,none), F-FT, Elms) :- !,
|
|
FT is F + 1.
|
|
functor_position(Pos, Pos, []).
|
|
|
|
|
|
%% colourise_directive(+Body, +TB, +Pos)
|
|
%
|
|
% Colourise the body of a directive.
|
|
|
|
colourise_directive((A,B), TB, term_position(_,_,_,_,[PA,PB])) :- !,
|
|
colourise_directive(A, TB, PA),
|
|
colourise_directive(B, TB, PB).
|
|
colourise_directive(Body, TB, Pos) :-
|
|
nonvar(Body),
|
|
directive_colours(Body, ClassSpec-ArgSpecs), !, % specified
|
|
functor_position(Pos, FPos, ArgPos),
|
|
( ClassSpec == classify
|
|
-> goal_classification(TB, Body, [], Class)
|
|
; Class = ClassSpec
|
|
),
|
|
colour_item(goal(Class, Body), TB, FPos),
|
|
specified_items(ArgSpecs, Body, TB, ArgPos).
|
|
colourise_directive(Body, TB, Pos) :-
|
|
colourise_body(Body, TB, Pos).
|
|
|
|
|
|
% colourise_body(+Body, +TB, +Pos)
|
|
%
|
|
% Breaks down to colourise_goal/3.
|
|
|
|
colourise_body(Body, TB, Pos) :-
|
|
colourise_body(Body, [], TB, Pos).
|
|
|
|
colourise_body(Body, Origin, TB, Pos) :-
|
|
colour_item(body, TB, Pos),
|
|
colourise_goals(Body, Origin, TB, Pos).
|
|
|
|
%% colourise_method_body(+MethodBody, +TB, +Pos)
|
|
%
|
|
% Colourise the optional "comment":: as pce(comment) and proceed
|
|
% with the body.
|
|
%
|
|
% @tbd Get this handled by a hook.
|
|
|
|
colourise_method_body(::(_Comment,Body), TB,
|
|
term_position(_F,_T,_FF,_FT,[CP,BP])) :- !,
|
|
colour_item(comment, TB, CP),
|
|
colourise_body(Body, TB, BP).
|
|
colourise_method_body(Body, TB, Pos) :- % deal with pri(::) < 1000
|
|
Body =.. [F,A,B],
|
|
control_op(F), !,
|
|
Pos = term_position(_F,_T,_FF,_FT,
|
|
[ AP,
|
|
BP
|
|
]),
|
|
colourise_method_body(A, TB, AP),
|
|
colourise_body(B, TB, BP).
|
|
colourise_method_body(Body, TB, Pos) :-
|
|
colourise_body(Body, TB, Pos).
|
|
|
|
control_op(',').
|
|
control_op((;)).
|
|
control_op((->)).
|
|
control_op((*->)).
|
|
|
|
colourise_goals(Body, Origin, TB, term_position(_,_,_,_,ArgPos)) :-
|
|
body_compiled(Body), !,
|
|
colourise_subgoals(ArgPos, 1, Body, Origin, TB).
|
|
colourise_goals(Goal, Origin, TB, Pos) :-
|
|
colourise_goal(Goal, Origin, TB, Pos).
|
|
|
|
colourise_subgoals([], _, _, _, _).
|
|
colourise_subgoals([Pos|T], N, Body, Origin, TB) :-
|
|
arg(N, Body, Arg),
|
|
colourise_goals(Arg, Origin, TB, Pos),
|
|
NN is N + 1,
|
|
colourise_subgoals(T, NN, Body, Origin, TB).
|
|
|
|
% colourise_dcg(+Body, +Head, +TB, +Pos)
|
|
%
|
|
% Breaks down to colourise_dcg_goal/3.
|
|
|
|
colourise_dcg(Body, Head, TB, Pos) :-
|
|
colour_item(dcg, TB, Pos),
|
|
dcg_extend(Head, Origin),
|
|
colourise_dcg_goals(Body, Origin, TB, Pos).
|
|
|
|
colourise_dcg_goals(Var, _, TB, Pos) :-
|
|
var(Var), !,
|
|
colour_item(goal(meta,Var), TB, Pos).
|
|
colourise_dcg_goals({Body}, Origin, TB, brace_term_position(F,T,Arg)) :- !,
|
|
colour_item(dcg(plain), TB, F-T),
|
|
colourise_goals(Body, Origin, TB, Arg).
|
|
colourise_dcg_goals([], _, TB, Pos) :- !,
|
|
colour_item(dcg(list), TB, Pos).
|
|
colourise_dcg_goals(List, _, TB, Pos) :-
|
|
List = [_|_], !,
|
|
colour_item(dcg(list), TB, Pos),
|
|
colourise_term_args(List, TB, Pos).
|
|
colourise_dcg_goals(Body, Origin, TB, term_position(_,_,_,_,ArgPos)) :-
|
|
body_compiled(Body), !,
|
|
colourise_dcg_subgoals(ArgPos, 1, Body, Origin, TB).
|
|
colourise_dcg_goals(Goal, Origin, TB, Pos) :-
|
|
colourise_dcg_goal(Goal, Origin, TB, Pos),
|
|
colourise_term_args(Goal, TB, Pos).
|
|
|
|
colourise_dcg_subgoals([], _, _, _, _).
|
|
colourise_dcg_subgoals([Pos|T], N, Body, Origin, TB) :-
|
|
arg(N, Body, Arg),
|
|
colourise_dcg_goals(Arg, Origin, TB, Pos),
|
|
NN is N + 1,
|
|
colourise_dcg_subgoals(T, NN, Body, Origin, TB).
|
|
|
|
dcg_extend(Term, _) :-
|
|
var(Term), !, fail.
|
|
dcg_extend(M:Term, M:Goal) :-
|
|
dcg_extend(Term, Goal).
|
|
dcg_extend(Term, Goal) :-
|
|
callable(Term),
|
|
Term =.. List,
|
|
append(List, [_,_], List2),
|
|
Goal =.. List2.
|
|
|
|
% colourise_dcg_goal(+Goal, +Origin, +TB, +Pos).
|
|
|
|
colourise_dcg_goal(!, Origin, TB, TermPos) :- !,
|
|
colourise_goal(!, Origin, TB, TermPos).
|
|
colourise_dcg_goal(Goal, Origin, TB, TermPos) :-
|
|
dcg_extend(Goal, TheGoal), !,
|
|
colourise_goal(TheGoal, Origin, TB, TermPos).
|
|
colourise_dcg_goal(Goal, _, TB, Pos) :-
|
|
colourise_term_args(Goal, TB, Pos).
|
|
|
|
|
|
% colourise_goal(+Goal, +Origin, +TB, +Pos)
|
|
%
|
|
% Colourise access to a single goal.
|
|
|
|
% Deal with list as goal (consult)
|
|
colourise_goal(Goal, _, TB, list_position(F,T,Elms,_)) :- !,
|
|
FT is F + 1,
|
|
AT is T - 1,
|
|
colour_item(goal(built_in, Goal), TB, F-FT),
|
|
colour_item(goal(built_in, Goal), TB, AT-T),
|
|
colourise_file_list(Goal, TB, Elms).
|
|
colourise_goal(Goal, Origin, TB, Pos) :-
|
|
nonvar(Goal),
|
|
goal_colours(Goal, ClassSpec-ArgSpecs), !, % specified
|
|
functor_position(Pos, FPos, ArgPos),
|
|
( ClassSpec == classify
|
|
-> goal_classification(TB, Goal, Origin, Class)
|
|
; Class = ClassSpec
|
|
),
|
|
colour_item(goal(Class, Goal), TB, FPos),
|
|
specified_items(ArgSpecs, Goal, TB, ArgPos).
|
|
colourise_goal(Module:Goal, _Origin, TB, term_position(_,_,_,_,[PM,PG])) :- !,
|
|
colour_item(module(Module), TB, PM),
|
|
( PG = term_position(_,_,FF,FT,_)
|
|
-> FP = FF-FT
|
|
; FP = PG
|
|
),
|
|
colour_item(goal(extern(Module), Goal), TB, FP),
|
|
colourise_goal_args(Goal, TB, PG).
|
|
colourise_goal(Goal, Origin, TB, Pos) :-
|
|
goal_classification(TB, Goal, Origin, Class),
|
|
( Pos = term_position(_,_,FF,FT,_ArgPos)
|
|
-> FPos = FF-FT
|
|
; FPos = Pos
|
|
),
|
|
colour_item(goal(Class, Goal), TB, FPos),
|
|
colourise_goal_args(Goal, TB, Pos).
|
|
|
|
%% colourise_goal_args(+Goal, +TB, +Pos)
|
|
%
|
|
% Colourise the arguments to a goal. This predicate deals with
|
|
% meta- and database-access predicates.
|
|
|
|
colourise_goal_args(Goal, TB, term_position(_,_,_,_,ArgPos)) :-
|
|
colourise_options(Goal, TB, ArgPos),
|
|
meta_args(Goal, MetaArgs), !,
|
|
colourise_meta_args(1, Goal, MetaArgs, TB, ArgPos).
|
|
colourise_goal_args(Goal, TB, Pos) :-
|
|
Pos = term_position(_,_,_,_,ArgPos), !,
|
|
colourise_options(Goal, TB, ArgPos),
|
|
colourise_term_args(Goal, TB, Pos).
|
|
colourise_goal_args(_, _, _). % no arguments
|
|
|
|
colourise_meta_args(_, _, _, _, []) :- !.
|
|
colourise_meta_args(N, Goal, MetaArgs, TB, [P0|PT]) :-
|
|
arg(N, Goal, Arg),
|
|
arg(N, MetaArgs, MetaSpec),
|
|
colourise_meta_arg(MetaSpec, Arg, TB, P0),
|
|
NN is N + 1,
|
|
colourise_meta_args(NN, Goal, MetaArgs, TB, PT).
|
|
|
|
colourise_meta_arg(MetaSpec, Arg, TB, Pos) :-
|
|
expand_meta(MetaSpec, Arg, Expanded), !,
|
|
colourise_goal(Expanded, [], TB, Pos). % TBD: recursion
|
|
colourise_meta_arg(_, Arg, TB, Pos) :-
|
|
colourise_term_arg(Arg, TB, Pos).
|
|
|
|
% meta_args(+Goal, -ArgSpec)
|
|
%
|
|
% Return a copy of Goal, where each meta-argument is an integer
|
|
% representing the number of extra arguments. The non-meta
|
|
% arguments are unbound variables.
|
|
%
|
|
% E.g. meta_args(maplist(foo,x,y), X) --> X = maplist(2,_,_)
|
|
%
|
|
% NOTE: this could be cached if performance becomes an issue.
|
|
|
|
meta_args(Goal, VarGoal) :-
|
|
xref_meta(Goal, _),
|
|
functor(Goal, Name, Arity),
|
|
functor(VarGoal, Name, Arity),
|
|
xref_meta(VarGoal, MetaArgs),
|
|
instantiate_meta(MetaArgs).
|
|
|
|
instantiate_meta([]).
|
|
instantiate_meta([H|T]) :-
|
|
( var(H)
|
|
-> H = 0
|
|
; H = V+N
|
|
-> V = N
|
|
),
|
|
instantiate_meta(T).
|
|
|
|
% expand_meta(+MetaSpec, +Goal, -Expanded)
|
|
%
|
|
% Add extra arguments to the goal if the meta-specifier is an
|
|
% integer (see above).
|
|
|
|
expand_meta(MetaSpec, Goal, Goal) :-
|
|
MetaSpec == 0.
|
|
expand_meta(MetaSpec, M:Goal, M:Expanded) :-
|
|
atom(M), !,
|
|
expand_meta(MetaSpec, Goal, Expanded).
|
|
expand_meta(MetaSpec, Goal, Expanded) :-
|
|
integer(MetaSpec),
|
|
callable(Goal), !,
|
|
length(Extra, MetaSpec),
|
|
Goal =.. List0,
|
|
append(List0, Extra, List),
|
|
Expanded =.. List.
|
|
|
|
%% colourise_setof(+Term, +TB, +Pos)
|
|
%
|
|
% Colourise the 2nd argument of setof/bagof
|
|
|
|
colourise_setof(Var^G, TB, term_position(_,_,FF,FT,[VP,GP])) :- !,
|
|
colourise_term_arg(Var, TB, VP),
|
|
colour_item(built_in, TB, FF-FT),
|
|
colourise_setof(G, TB, GP).
|
|
colourise_setof(Term, TB, Pos) :-
|
|
colourise_goal(Term, [], TB, Pos).
|
|
|
|
% colourise_db(+Arg, +TB, +Pos)
|
|
%
|
|
% Colourise database modification calls (assert/1, retract/1 and
|
|
% friends.
|
|
|
|
colourise_db((Head:-_Body), TB, term_position(_,_,_,_,[HP,_])) :- !,
|
|
colourise_db(Head, TB, HP).
|
|
colourise_db(Module:Head, TB, term_position(_,_,_,_,[MP,HP])) :- !,
|
|
colour_item(module(Module), TB, MP),
|
|
( atom(Module),
|
|
colour_state_source_id(TB, SourceId),
|
|
xref_module(SourceId, Module)
|
|
-> colourise_db(Head, TB, HP)
|
|
; true % TBD: Modifying in other module
|
|
).
|
|
colourise_db(Head, TB, Pos) :-
|
|
colourise_goal(Head, '<db-change>', TB, Pos).
|
|
|
|
|
|
%% colourise_options(+Goal, +TB, +ArgPos)
|
|
%
|
|
% Colourise predicate options
|
|
|
|
colourise_options(Goal, TB, ArgPos) :-
|
|
( compound(Goal),
|
|
functor(Goal, Name, Arity),
|
|
( colour_state_source_id(TB, SourceId),
|
|
xref_module(SourceId, Module)
|
|
-> true
|
|
; Module = user
|
|
),
|
|
current_predicate_options(Module:Name/Arity, Arg, OptionDecl),
|
|
debug(emacs, 'Colouring option-arg ~w of ~p',
|
|
[Arg, Module:Name/Arity]),
|
|
arg(Arg, Goal, Options0),
|
|
nth1(Arg, ArgPos, Pos0),
|
|
strip_option_module_qualifier(Goal, Module, Arg, TB,
|
|
Options0, Pos0, Options, Pos),
|
|
( Pos = list_position(_, _, ElmPos, TailPos)
|
|
-> colourise_option_list(Options, OptionDecl, TB, ElmPos, TailPos)
|
|
; ( var(Options)
|
|
; Options == []
|
|
)
|
|
-> colourise_term_arg(Options, TB, Pos)
|
|
; colour_item(type_error(list), TB, Pos)
|
|
),
|
|
fail
|
|
; true
|
|
).
|
|
|
|
strip_option_module_qualifier(Goal, Module, Arg, TB,
|
|
M:Options, term_position(_,_,_,_,[MP,Pos]),
|
|
Options, Pos) :-
|
|
predicate_property(Module:Goal, meta_predicate(Head)),
|
|
arg(Arg, Head, :), !,
|
|
colour_item(module(M), TB, MP).
|
|
strip_option_module_qualifier(_, _, _, _,
|
|
Options, Pos, Options, Pos).
|
|
|
|
|
|
colourise_option_list(_, _, _, [], none).
|
|
colourise_option_list(Tail, _, TB, [], TailPos) :-
|
|
colourise_term_arg(Tail, TB, TailPos).
|
|
colourise_option_list([H|T], OptionDecl, TB, [HPos|TPos], TailPos) :-
|
|
colourise_option(H, OptionDecl, TB, HPos),
|
|
colourise_option_list(T, OptionDecl, TB, TPos, TailPos).
|
|
|
|
colourise_option(Opt, _, TB, Pos) :-
|
|
var(Opt), !,
|
|
colourise_term_arg(Opt, TB, Pos).
|
|
colourise_option(Opt, OptionDecl, TB, term_position(_,_,FF,FT,ValPosList)) :- !,
|
|
functor(Opt, Name, Arity),
|
|
functor(GenOpt, Name, Arity),
|
|
( memberchk(GenOpt, OptionDecl)
|
|
-> colour_item(option_name, TB, FF-FT),
|
|
Opt =.. [Name|Values],
|
|
GenOpt =.. [Name|Types],
|
|
colour_option_values(Values, Types, TB, ValPosList)
|
|
; colour_item(no_option_name, TB, FF-FT)
|
|
).
|
|
colourise_option(_, _, TB, Pos) :-
|
|
colour_item(type_error(option), TB, Pos).
|
|
|
|
colour_option_values([], [], _, _).
|
|
colour_option_values([V0|TV], [T0|TT], TB, [P0|TP]) :-
|
|
( ( var(V0)
|
|
; is_of_type(T0, V0)
|
|
)
|
|
-> colourise_term_arg(V0, TB, P0)
|
|
; callable(V0),
|
|
( T0 = callable
|
|
-> N = 0
|
|
; T0 = (callable+N)
|
|
)
|
|
-> colourise_meta_arg(N, V0, TB, P0)
|
|
; colour_item(type_error(T0), TB, P0)
|
|
),
|
|
colour_option_values(TV, TT, TB, TP).
|
|
|
|
|
|
%% colourise_files(+Arg, +TB, +Pos)
|
|
%
|
|
% Colourise the argument list of one of the file-loading predicates.
|
|
|
|
colourise_files(List, TB, list_position(_,_,Elms,_)) :- !,
|
|
colourise_file_list(List, TB, Elms).
|
|
colourise_files(M:Spec, TB, term_position(_,_,_,_,[MP,SP])) :- !,
|
|
colour_item(module(M), TB, MP),
|
|
colourise_files(Spec, TB, SP).
|
|
colourise_files(Var, TB, P) :-
|
|
var(Var), !,
|
|
colour_item(var, TB, P).
|
|
colourise_files(Spec0, TB, Pos) :-
|
|
strip_module(Spec0, _, Spec),
|
|
( colour_state_source_id(TB, Source),
|
|
prolog_canonical_source(Source, SourceId),
|
|
catch(xref_source_file(Spec, Path, SourceId), _, fail)
|
|
-> colour_item(file(Path), TB, Pos)
|
|
; colour_item(nofile, TB, Pos)
|
|
).
|
|
|
|
colourise_file_list([], _, _).
|
|
colourise_file_list([H|T], TB, [PH|PT]) :-
|
|
colourise_files(H, TB, PH),
|
|
colourise_file_list(T, TB, PT).
|
|
|
|
|
|
%% colourise_directory(+Arg, +TB, +Pos)
|
|
%
|
|
% Colourise argument that should be an existing directory.
|
|
|
|
colourise_directory(Spec, TB, Pos) :-
|
|
( colour_state_source_id(TB, SourceId),
|
|
catch(xref_source_file(Spec, Path, SourceId,
|
|
[file_type(directory)]),
|
|
_, fail)
|
|
-> colour_item(directory(Path), TB, Pos)
|
|
; colour_item(nofile, TB, Pos)
|
|
).
|
|
|
|
|
|
%% colourise_class(ClassName, TB, Pos)
|
|
%
|
|
% Colourise an XPCE class.
|
|
|
|
colourise_class(ClassName, TB, Pos) :-
|
|
colour_state_source_id(TB, SourceId),
|
|
classify_class(SourceId, ClassName, Classification),
|
|
colour_item(class(Classification, ClassName), TB, Pos).
|
|
|
|
%% classify_class(+SourceId, +ClassName, -Classification).
|
|
|
|
classify_class(SourceId, Name, Class) :-
|
|
xref_defined_class(SourceId, Name, Class), !.
|
|
:- if(current_predicate(classify_class/2)).
|
|
classify_class(_, Name, Class) :-
|
|
classify_class(Name, Class).
|
|
:- endif.
|
|
|
|
%% colourise_term_args(+Term, +TB, +Pos)
|
|
%
|
|
% colourise head/body principal terms.
|
|
|
|
colourise_term_args(Term, TB,
|
|
term_position(_,_,_,_,ArgPos)) :- !,
|
|
colourise_term_args(ArgPos, 1, Term, TB).
|
|
colourise_term_args(_, _, _).
|
|
|
|
colourise_term_args([], _, _, _).
|
|
colourise_term_args([Pos|T], N, Term, TB) :-
|
|
arg(N, Term, Arg),
|
|
colourise_term_arg(Arg, TB, Pos),
|
|
NN is N + 1,
|
|
colourise_term_args(T, NN, Term, TB).
|
|
|
|
colourise_term_arg(Var, TB, Pos) :- % variable
|
|
var(Var), !,
|
|
( singleton(Var, TB)
|
|
-> colour_item(singleton, TB, Pos)
|
|
; colour_item(var, TB, Pos)
|
|
).
|
|
colourise_term_arg(List, TB, list_position(_, _, Elms, Tail)) :- !,
|
|
colourise_list_args(Elms, Tail, List, TB, classify). % list
|
|
colourise_term_arg(Compound, TB, Pos) :- % compound
|
|
compound(Compound), !,
|
|
colourise_term_args(Compound, TB, Pos).
|
|
colourise_term_arg(_, TB, string_position(F, T)) :- !, % string
|
|
colour_item(string, TB, F-T).
|
|
colourise_term_arg(Atom, TB, Pos) :- % single quoted atom
|
|
atom(Atom), !,
|
|
colour_item(atom, TB, Pos).
|
|
colourise_term_arg(_Arg, _TB, _Pos) :-
|
|
true.
|
|
|
|
colourise_list_args([HP|TP], Tail, [H|T], TB, How) :-
|
|
specified_item(How, H, TB, HP),
|
|
colourise_list_args(TP, Tail, T, TB, How).
|
|
colourise_list_args([], none, _, _, _) :- !.
|
|
colourise_list_args([], TP, T, TB, How) :-
|
|
specified_item(How, T, TB, TP).
|
|
|
|
|
|
% colourise_exports(+List, +TB, +Pos)
|
|
%
|
|
% Colourise the module export-list (or any other list holding
|
|
% terms of the form Name/Arity referring to predicates).
|
|
|
|
colourise_exports([], _, _) :- !.
|
|
colourise_exports(List, TB, list_position(_,_,ElmPos,Tail)) :- !,
|
|
( Tail == none
|
|
-> true
|
|
; colour_item(type_error(list), TB, Tail)
|
|
),
|
|
colourise_exports2(List, TB, ElmPos).
|
|
colourise_exports(_, TB, Pos) :-
|
|
colour_item(type_error(list), TB, Pos).
|
|
|
|
colourise_exports2([G0|GT], TB, [P0|PT]) :- !,
|
|
colourise_declaration(G0, TB, P0),
|
|
colourise_exports2(GT, TB, PT).
|
|
colourise_exports2(_, _, _).
|
|
|
|
|
|
% colourise_imports(+List, +File, +TB, +Pos)
|
|
%
|
|
% Colourise import list from use_module/2, importing from File.
|
|
|
|
colourise_imports(List, File, TB, Pos) :-
|
|
( colour_state_source_id(TB, SourceId),
|
|
catch(xref_public_list(File, Path, Public, SourceId), _, fail)
|
|
-> true
|
|
; Public = []
|
|
),
|
|
colourise_imports(List, Path, Public, TB, Pos).
|
|
|
|
colourise_imports([], _, _, _, _).
|
|
colourise_imports(List, File, Public, TB, list_position(_,_,ElmPos,Tail)) :- !,
|
|
( Tail == none
|
|
-> true
|
|
; colour_item(type_error(list), TB, Tail)
|
|
),
|
|
colourise_imports2(List, File, Public, TB, ElmPos).
|
|
colourise_imports(except(Except), File, Public, TB,
|
|
term_position(_,_,FF,FT,[LP])) :- !,
|
|
colour_item(keyword(except), TB, FF-FT),
|
|
colourise_imports(Except, File, Public, TB, LP).
|
|
colourise_imports(_, _, _, TB, Pos) :-
|
|
colour_item(type_error(list), TB, Pos).
|
|
|
|
colourise_imports2([G0|GT], File, Public, TB, [P0|PT]) :- !,
|
|
colourise_import(G0, File, TB, P0),
|
|
colourise_imports2(GT, File, Public, TB, PT).
|
|
colourise_imports2(_, _, _, _, _).
|
|
|
|
|
|
colourise_import(PI as Name, File, TB, term_position(_,_,FF,FT,[PP,NP])) :-
|
|
pi_to_term(PI, Goal), !,
|
|
colour_item(goal(imported(File), Goal), TB, PP),
|
|
functor(Goal, _, Arity),
|
|
functor(NewGoal, Name, Arity),
|
|
goal_classification(TB, NewGoal, [], Class),
|
|
colour_item(goal(Class, NewGoal), TB, NP),
|
|
colour_item(keyword(as), TB, FF-FT).
|
|
colourise_import(PI, _, TB, Pos) :-
|
|
colourise_declaration(PI, TB, Pos).
|
|
|
|
|
|
%% colourise_declarations(+Term, +TB, +Pos)
|
|
%
|
|
% Colourise the Predicate indicator lists of dynamic, multifile, etc
|
|
% declarations.
|
|
|
|
colourise_declarations((Head,Tail), TB,
|
|
term_position(_,_,_,_,[PH,PT])) :- !,
|
|
colourise_declaration(Head, TB, PH),
|
|
colourise_declarations(Tail, TB, PT).
|
|
colourise_declarations(Last, TB, Pos) :-
|
|
colourise_declaration(Last, TB, Pos).
|
|
|
|
colourise_declaration(PI, TB, Pos) :-
|
|
pi_to_term(PI, Goal), !,
|
|
goal_classification(TB, Goal, [], Class),
|
|
colour_item(goal(Class, Goal), TB, Pos).
|
|
colourise_declaration(Module:PI, TB,
|
|
term_position(_,_,_,_,[PM,PG])) :-
|
|
atom(Module), pi_to_term(PI, Goal), !,
|
|
colour_item(module(M), TB, PM),
|
|
colour_item(goal(extern(M), Goal), TB, PG).
|
|
colourise_declaration(op(_,_,_), TB, Pos) :-
|
|
colour_item(exported_operator, TB, Pos).
|
|
colourise_declaration(_, TB, Pos) :-
|
|
colour_item(type_error(export_declaration), TB, Pos).
|
|
|
|
pi_to_term(Name/Arity, Term) :-
|
|
atom(Name), integer(Arity), !,
|
|
functor(Term, Name, Arity).
|
|
pi_to_term(Name//Arity0, Term) :-
|
|
atom(Name), integer(Arity0), !,
|
|
Arity is Arity0 + 2,
|
|
functor(Term, Name, Arity).
|
|
|
|
%% colourise_prolog_flag_name(+Name, +TB, +Pos)
|
|
%
|
|
% Colourise the name of a Prolog flag
|
|
|
|
colourise_prolog_flag_name(Name, TB, Pos) :-
|
|
atom(Name), !,
|
|
( current_prolog_flag(Name, _)
|
|
-> colour_item(flag_name(Name), TB, Pos)
|
|
; colour_item(no_flag_name(Name), TB, Pos)
|
|
).
|
|
colourise_prolog_flag_name(Name, TB, Pos) :-
|
|
colourise_term(Name, TB, Pos).
|
|
|
|
|
|
/*******************************
|
|
* CONFIGURATION *
|
|
*******************************/
|
|
|
|
% body_compiled(+Term)
|
|
%
|
|
% Succeeds if term is a construct handled by the compiler.
|
|
|
|
body_compiled((_,_)).
|
|
body_compiled((_->_)).
|
|
body_compiled((_*->_)).
|
|
body_compiled((_;_)).
|
|
body_compiled(\+_).
|
|
|
|
% goal_classification(+TB, +Goal, +Origin, -Class)
|
|
%
|
|
% Classify Goal appearing in TB and called from a clause with head
|
|
% Origin. For directives Origin is [].
|
|
|
|
goal_classification(_, Goal, _, meta) :-
|
|
var(Goal), !.
|
|
goal_classification(_, Goal, Origin, recursion) :-
|
|
callable(Goal),
|
|
functor(Goal, Name, Arity),
|
|
functor(Origin, Name, Arity), !.
|
|
goal_classification(TB, Goal, _, How) :-
|
|
colour_state_source_id(TB, SourceId),
|
|
xref_defined(SourceId, Goal, How),
|
|
How \= public(_), !.
|
|
goal_classification(_TB, Goal, _, Class) :-
|
|
goal_classification(Goal, Class), !.
|
|
goal_classification(_TB, _Goal, _, undefined).
|
|
|
|
% goal_classification(+Goal, -Class)
|
|
%
|
|
% Multifile hookable classification for non-local goals.
|
|
|
|
goal_classification(Goal, built_in) :-
|
|
built_in_predicate(Goal), !.
|
|
goal_classification(Goal, autoload) :- % SWI-Prolog
|
|
functor(Goal, Name, Arity),
|
|
'$in_library'(Name, Arity, _Path), !.
|
|
goal_classification(Goal, global) :- % SWI-Prolog
|
|
current_predicate(_, user:Goal), !.
|
|
goal_classification(SS, expanded) :- % XPCE (TBD)
|
|
functor(SS, send_super, A),
|
|
A >= 2, !.
|
|
goal_classification(SS, expanded) :- % XPCE (TBD)
|
|
functor(SS, get_super, A),
|
|
A >= 3, !.
|
|
|
|
classify_head(TB, Goal, exported) :-
|
|
colour_state_source_id(TB, SourceId),
|
|
xref_exported(SourceId, Goal), !.
|
|
classify_head(_TB, Goal, hook) :-
|
|
xref_hook(Goal), !.
|
|
classify_head(TB, Goal, hook) :-
|
|
colour_state_source_id(TB, SourceId),
|
|
xref_module(SourceId, M),
|
|
xref_hook(M:Goal), !.
|
|
classify_head(TB, Goal, unreferenced) :-
|
|
colour_state_source_id(TB, SourceId),
|
|
\+ (xref_called(SourceId, Goal, By), By \= Goal), !.
|
|
classify_head(TB, Goal, How) :-
|
|
colour_state_source_id(TB, SourceId),
|
|
xref_defined(SourceId, Goal, How), !.
|
|
classify_head(_TB, Goal, built_in) :-
|
|
built_in_predicate(Goal), !.
|
|
classify_head(_TB, _Goal, undefined).
|
|
|
|
built_in_predicate(Goal) :-
|
|
predicate_property(system:Goal, built_in), !.
|
|
built_in_predicate(module(_, _)).
|
|
built_in_predicate(if(_)).
|
|
built_in_predicate(elif(_)).
|
|
built_in_predicate(else).
|
|
built_in_predicate(endif).
|
|
|
|
% Specify colours for individual goals.
|
|
|
|
goal_colours(module(_,_), built_in-[identifier,exports]).
|
|
goal_colours(use_module(_), built_in-[file]).
|
|
goal_colours(use_module(File,_), built_in-[file,imports(File)]).
|
|
goal_colours(reexport(_), built_in-[file]).
|
|
goal_colours(reexport(File,_), built_in-[file,imports(File)]).
|
|
goal_colours(dynamic(_), built_in-[predicates]).
|
|
goal_colours(thread_local(_), built_in-[predicates]).
|
|
goal_colours(module_transparent(_), built_in-[predicates]).
|
|
goal_colours(multifile(_), built_in-[predicates]).
|
|
goal_colours(volatile(_), built_in-[predicates]).
|
|
goal_colours(public(_), built_in-[predicates]).
|
|
goal_colours(consult(_), built_in-[file]).
|
|
goal_colours(include(_), built_in-[file]).
|
|
goal_colours(ensure_loaded(_), built_in-[file]).
|
|
goal_colours(load_files(_,_), built_in-[file,classify]).
|
|
goal_colours(setof(_,_,_), built_in-[classify,setof,classify]).
|
|
goal_colours(bagof(_,_,_), built_in-[classify,setof,classify]).
|
|
goal_colours(predicate_options(_,_,_), built_in-[predicate,classify,classify]).
|
|
% Database access
|
|
goal_colours(assert(_), built_in-[db]).
|
|
goal_colours(asserta(_), built_in-[db]).
|
|
goal_colours(assertz(_), built_in-[db]).
|
|
goal_colours(assert(_,_), built_in-[db,classify]).
|
|
goal_colours(asserta(_,_), built_in-[db,classify]).
|
|
goal_colours(assertz(_,_), built_in-[db,classify]).
|
|
goal_colours(retract(_), built_in-[db]).
|
|
goal_colours(retractall(_), built_in-[db]).
|
|
goal_colours(clause(_,_), built_in-[db,classify]).
|
|
goal_colours(clause(_,_,_), built_in-[db,classify,classify]).
|
|
% misc
|
|
goal_colours(set_prolog_flag(_,_), built_in-[prolog_flag_name,classify]).
|
|
goal_colours(current_prolog_flag(_,_), built_in-[prolog_flag_name,classify]).
|
|
% XPCE stuff
|
|
goal_colours(pce_autoload(_,_), classify-[classify,file]).
|
|
goal_colours(pce_image_directory(_), classify-[directory]).
|
|
goal_colours(new(_, _), built_in-[classify,pce_new]).
|
|
goal_colours(send_list(_,_,_), built_in-pce_arg_list).
|
|
goal_colours(send(_,_), built_in-[pce_arg,pce_selector]).
|
|
goal_colours(get(_,_,_), built_in-[pce_arg,pce_selector,pce_arg]).
|
|
goal_colours(send_super(_,_), built_in-[pce_arg,pce_selector]).
|
|
goal_colours(get_super(_,_), built_in-[pce_arg,pce_selector,pce_arg]).
|
|
goal_colours(get_chain(_,_,_), built_in-[pce_arg,pce_selector,pce_arg]).
|
|
goal_colours(Pce, built_in-pce_arg) :-
|
|
compound(Pce),
|
|
functor(Pce, Functor, _),
|
|
pce_functor(Functor).
|
|
|
|
pce_functor(send).
|
|
pce_functor(get).
|
|
pce_functor(send_super).
|
|
pce_functor(get_super).
|
|
|
|
|
|
/*******************************
|
|
* SPECIFIC HEADS *
|
|
*******************************/
|
|
|
|
head_colours(file_search_path(_,_), hook-[identifier,classify]).
|
|
head_colours(library_directory(_), hook-[file]).
|
|
head_colours(resource(_,_,_), hook-[identifier,classify,file]).
|
|
|
|
head_colours(Var, _) :-
|
|
var(Var), !,
|
|
fail.
|
|
head_colours(M:H, Colours) :-
|
|
atom(M), callable(H),
|
|
xref_hook(M:H), !,
|
|
Colours = hook - [ hook, hook-classify ].
|
|
head_colours(M:H, Colours) :-
|
|
M == user,
|
|
head_colours(H, HC),
|
|
HC = hook - _, !,
|
|
Colours = hook - [ hook, HC ].
|
|
head_colours(M:_, meta-[module(M),extern(M)]).
|
|
|
|
|
|
/*******************************
|
|
* STYLES *
|
|
*******************************/
|
|
|
|
%% def_style(+Pattern, -Style)
|
|
%
|
|
% Define the style used for the given pattern. Definitions here
|
|
% can be overruled by defining rules for
|
|
% emacs_prolog_colours:style/2
|
|
|
|
def_style(goal(built_in,_), [colour(blue)]).
|
|
def_style(goal(imported(_),_), [colour(blue)]).
|
|
def_style(goal(autoload,_), [colour(navy_blue)]).
|
|
def_style(goal(global,_), [colour(navy_blue)]).
|
|
def_style(goal(undefined,_), [colour(red)]).
|
|
def_style(goal(thread_local(_),_), [colour(magenta), underline(true)]).
|
|
def_style(goal(dynamic(_),_), [colour(magenta)]).
|
|
def_style(goal(multifile(_),_), [colour(navy_blue)]).
|
|
def_style(goal(expanded,_), [colour(blue), underline(true)]).
|
|
def_style(goal(extern(_),_), [colour(blue), underline(true)]).
|
|
def_style(goal(recursion,_), [underline(true)]).
|
|
def_style(goal(meta,_), [colour(red4)]).
|
|
def_style(goal(foreign(_),_), [colour(darkturquoise)]).
|
|
def_style(goal(local(_),_), []).
|
|
def_style(goal(constraint(_),_), [colour(darkcyan)]).
|
|
|
|
def_style(option_name, [colour('#3434ba')]).
|
|
def_style(no_option_name, [colour(red)]).
|
|
|
|
def_style(head(exported), [colour(blue), bold(true)]).
|
|
def_style(head(public(_)), [colour('#016300'), bold(true)]).
|
|
def_style(head(extern(_)), [colour(blue), bold(true)]).
|
|
def_style(head(dynamic), [colour(magenta), bold(true)]).
|
|
def_style(head(multifile), [colour(navy_blue), bold(true)]).
|
|
def_style(head(unreferenced), [colour(red), bold(true)]).
|
|
def_style(head(hook), [colour(blue), underline(true)]).
|
|
def_style(head(meta), []).
|
|
def_style(head(constraint(_)), [colour(darkcyan), bold(true)]).
|
|
def_style(head(_), [bold(true)]).
|
|
def_style(module(_), [colour(dark_slate_blue)]).
|
|
def_style(comment, [colour(dark_green)]).
|
|
|
|
def_style(directive, [background(grey90)]).
|
|
def_style(method(_), [bold(true)]).
|
|
|
|
def_style(var, [colour(red4)]).
|
|
def_style(singleton, [bold(true), colour(red4)]).
|
|
def_style(unbound, [colour(red), bold(true)]).
|
|
def_style(quoted_atom, [colour(navy_blue)]).
|
|
def_style(string, [colour(navy_blue)]).
|
|
def_style(nofile, [colour(red)]).
|
|
def_style(file(_), [colour(blue), underline(true)]).
|
|
def_style(directory(_), [colour(blue)]).
|
|
def_style(class(built_in,_), [colour(blue), underline(true)]).
|
|
def_style(class(library(_),_), [colour(navy_blue), underline(true)]).
|
|
def_style(class(local(_,_,_),_), [underline(true)]).
|
|
def_style(class(user(_),_), [underline(true)]).
|
|
def_style(class(user,_), [underline(true)]).
|
|
def_style(class(undefined,_), [colour(red), underline(true)]).
|
|
def_style(prolog_data, [colour(blue), underline(true)]).
|
|
def_style(flag_name(_), [colour(blue)]).
|
|
def_style(no_flag_name(_), [colour(red)]).
|
|
|
|
def_style(keyword(_), [colour(blue)]).
|
|
def_style(identifier, [bold(true)]).
|
|
def_style(delimiter, [bold(true)]).
|
|
def_style(expanded, [colour(blue), underline(true)]).
|
|
|
|
def_style(hook, [colour(blue), underline(true)]).
|
|
|
|
def_style(error, [background(orange)]).
|
|
def_style(type_error(_), [background(orange)]).
|
|
def_style(syntax_error(_,_), [background(orange)]).
|
|
|
|
%% syntax_colour(?Class, ?Attributes) is nondet.
|
|
%
|
|
% True when a range classified Class must be coloured using
|
|
% Attributes. Attributes is a list of:
|
|
%
|
|
% * colour(ColourName)
|
|
% * background(ColourName)
|
|
% * bold(Boolean)
|
|
% * underline(Boolean)
|
|
%
|
|
% Attributes may be the empty list. This is used for cases where
|
|
% -for example- a menu is associated with the fragment. If
|
|
% syntax_colour/2 fails, no fragment is created for the region.
|
|
|
|
syntax_colour(Class, Attributes) :-
|
|
( style(Class, Attributes) % user hook
|
|
; def_style(Class, Attributes) % system default
|
|
).
|
|
|
|
|
|
%% term_colours(+Term, -FunctorColour, -ArgColours)
|
|
%
|
|
% Define colourisation for specific terms.
|
|
|
|
term_colours((?- Directive), Colours) :-
|
|
term_colours((:- Directive), Colours).
|
|
term_colours((prolog:Head --> _),
|
|
expanded - [ expanded - [ expanded,
|
|
expanded - [ identifier
|
|
]
|
|
],
|
|
classify
|
|
]) :-
|
|
prolog_message_hook(Head).
|
|
|
|
prolog_message_hook(message(_)).
|
|
prolog_message_hook(error_message(_)).
|
|
prolog_message_hook(message_context(_)).
|
|
prolog_message_hook(message_location(_)).
|
|
|
|
% XPCE rules
|
|
|
|
term_colours(variable(_, _, _, _),
|
|
expanded - [ identifier,
|
|
classify,
|
|
classify,
|
|
comment
|
|
]).
|
|
term_colours(variable(_, _, _),
|
|
expanded - [ identifier,
|
|
classify,
|
|
atom
|
|
]).
|
|
term_colours(handle(_, _, _),
|
|
expanded - [ classify,
|
|
classify,
|
|
classify
|
|
]).
|
|
term_colours(handle(_, _, _, _),
|
|
expanded - [ classify,
|
|
classify,
|
|
classify,
|
|
classify
|
|
]).
|
|
term_colours(class_variable(_,_,_,_),
|
|
expanded - [ identifier,
|
|
pce(type),
|
|
pce(default),
|
|
comment
|
|
]).
|
|
term_colours(class_variable(_,_,_),
|
|
expanded - [ identifier,
|
|
pce(type),
|
|
pce(default)
|
|
]).
|
|
term_colours(delegate_to(_),
|
|
expanded - [ classify
|
|
]).
|
|
term_colours((:- encoding(_)),
|
|
expanded - [ expanded - [ classify
|
|
]
|
|
]).
|
|
term_colours((:- pce_begin_class(_, _, _)),
|
|
expanded - [ expanded - [ identifier,
|
|
pce_new,
|
|
comment
|
|
]
|
|
]).
|
|
term_colours((:- pce_begin_class(_, _)),
|
|
expanded - [ expanded - [ identifier,
|
|
pce_new
|
|
]
|
|
]).
|
|
term_colours((:- pce_extend_class(_)),
|
|
expanded - [ expanded - [ identifier
|
|
]
|
|
]).
|
|
term_colours((:- pce_end_class),
|
|
expanded - [ expanded
|
|
]).
|
|
term_colours((:- pce_end_class(_)),
|
|
expanded - [ expanded - [ identifier
|
|
]
|
|
]).
|
|
term_colours((:- use_class_template(_)),
|
|
expanded - [ expanded - [ pce_new
|
|
]
|
|
]).
|
|
term_colours((:- emacs_begin_mode(_,_,_,_,_)),
|
|
expanded - [ expanded - [ identifier,
|
|
classify,
|
|
classify,
|
|
classify,
|
|
classify
|
|
]
|
|
]).
|
|
term_colours((:- emacs_extend_mode(_,_)),
|
|
expanded - [ expanded - [ identifier,
|
|
classify
|
|
]
|
|
]).
|
|
term_colours((:- pce_group(_)),
|
|
expanded - [ expanded - [ identifier
|
|
]
|
|
]).
|
|
term_colours((:- pce_global(_, new(_))),
|
|
expanded - [ expanded - [ identifier,
|
|
pce_arg
|
|
]
|
|
]).
|
|
term_colours((:- emacs_end_mode),
|
|
expanded - [ expanded
|
|
]).
|
|
term_colours(pce_ifhostproperty(_,_),
|
|
expanded - [ classify,
|
|
classify
|
|
]).
|
|
term_colours((_,_),
|
|
error - [ classify,
|
|
classify
|
|
]).
|
|
|
|
specified_item(_, Var, TB, Pos) :-
|
|
var(Var), !,
|
|
colourise_term_arg(Var, TB, Pos).
|
|
% generic classification
|
|
specified_item(classify, Term, TB, Pos) :- !,
|
|
colourise_term_arg(Term, TB, Pos).
|
|
% classify as head
|
|
specified_item(head, Term, TB, Pos) :- !,
|
|
colourise_clause_head(Term, TB, Pos).
|
|
% expanded head (DCG=2, ...)
|
|
specified_item(head(+N), Term, TB, Pos) :- !,
|
|
colourise_extended_head(Term, N, TB, Pos).
|
|
% M:Head
|
|
specified_item(extern(M), Term, TB, Pos) :- !,
|
|
colourise_extern_head(Term, M, TB, Pos).
|
|
% classify as body
|
|
specified_item(body, Term, TB, Pos) :- !,
|
|
colourise_body(Term, TB, Pos).
|
|
specified_item(setof, Term, TB, Pos) :- !,
|
|
colourise_setof(Term, TB, Pos).
|
|
specified_item(meta(MetaSpec), Term, TB, Pos) :- !,
|
|
colourise_meta_arg(MetaSpec, Term, TB, Pos).
|
|
% DCG goal in body
|
|
specified_item(dcg, Term, TB, Pos) :- !,
|
|
colourise_dcg(Term, [], TB, Pos).
|
|
% assert/retract arguments
|
|
specified_item(db, Term, TB, Pos) :- !,
|
|
colourise_db(Term, TB, Pos).
|
|
% files
|
|
specified_item(file, Term, TB, Pos) :- !,
|
|
colourise_files(Term, TB, Pos).
|
|
% directory
|
|
specified_item(directory, Term, TB, Pos) :- !,
|
|
colourise_directory(Term, TB, Pos).
|
|
% [Name/Arity, ...]
|
|
specified_item(exports, Term, TB, Pos) :- !,
|
|
colourise_exports(Term, TB, Pos).
|
|
% [Name/Arity, ...]
|
|
specified_item(imports(File), Term, TB, Pos) :- !,
|
|
colourise_imports(Term, File, TB, Pos).
|
|
% Name/Arity, ...
|
|
specified_item(predicates, Term, TB, Pos) :- !,
|
|
colourise_declarations(Term, TB, Pos).
|
|
% Name/Arity
|
|
specified_item(predicate, Term, TB, Pos) :- !,
|
|
colourise_declaration(Term, TB, Pos).
|
|
% set_prolog_flag(Name, _)
|
|
specified_item(prolog_flag_name, Term, TB, Pos) :- !,
|
|
colourise_prolog_flag_name(Term, TB, Pos).
|
|
% XPCE new argument
|
|
specified_item(pce_new, Term, TB, Pos) :- !,
|
|
( atom(Term)
|
|
-> colourise_class(Term, TB, Pos)
|
|
; compound(Term)
|
|
-> functor(Term, Class, _),
|
|
Pos = term_position(_,_,FF, FT, ArgPos),
|
|
colourise_class(Class, TB, FF-FT),
|
|
specified_items(pce_arg, Term, TB, ArgPos)
|
|
; colourise_term_arg(Term, TB, Pos)
|
|
).
|
|
% Generic XPCE arguments
|
|
specified_item(pce_arg, new(X), TB,
|
|
term_position(_,_,_,_,[ArgPos])) :- !,
|
|
specified_item(pce_new, X, TB, ArgPos).
|
|
specified_item(pce_arg, new(X, T), TB,
|
|
term_position(_,_,_,_,[P1, P2])) :- !,
|
|
colourise_term_arg(X, TB, P1),
|
|
specified_item(pce_new, T, TB, P2).
|
|
specified_item(pce_arg, @(Ref), TB, Pos) :- !,
|
|
colourise_term_arg(@(Ref), TB, Pos).
|
|
specified_item(pce_arg, prolog(Term), TB,
|
|
term_position(_,_,FF,FT,[ArgPos])) :- !,
|
|
colour_item(prolog_data, TB, FF-FT),
|
|
colourise_term_arg(Term, TB, ArgPos).
|
|
specified_item(pce_arg, Term, TB, Pos) :-
|
|
compound(Term),
|
|
Term \= [_|_], !,
|
|
specified_item(pce_new, Term, TB, Pos).
|
|
specified_item(pce_arg, Term, TB, Pos) :- !,
|
|
colourise_term_arg(Term, TB, Pos).
|
|
% List of XPCE arguments
|
|
specified_item(pce_arg_list, List, TB, list_position(_,_,Elms,Tail)) :- !,
|
|
colourise_list_args(Elms, Tail, List, TB, pce_arg).
|
|
specified_item(pce_arg_list, Term, TB, Pos) :- !,
|
|
specified_item(pce_arg, Term, TB, Pos).
|
|
% XPCE selector
|
|
specified_item(pce_selector, Term, TB,
|
|
term_position(_,_,_,_,ArgPos)) :- !,
|
|
specified_items(pce_arg, Term, TB, ArgPos).
|
|
specified_item(pce_selector, Term, TB, Pos) :-
|
|
colourise_term_arg(Term, TB, Pos).
|
|
% Nested specification
|
|
specified_item(FuncSpec-ArgSpecs, Term, TB,
|
|
term_position(_,_,FF,FT,ArgPos)) :- !,
|
|
specified_item(FuncSpec, Term, TB, FF-FT),
|
|
specified_items(ArgSpecs, Term, TB, ArgPos).
|
|
% Nested for {...}
|
|
specified_item(FuncSpec-[ArgSpec], {Term}, TB,
|
|
brace_term_position(F,T,ArgPos)) :- !,
|
|
specified_item(FuncSpec, {Term}, TB, F-T),
|
|
specified_item(ArgSpec, Term, TB, ArgPos).
|
|
% Specified
|
|
specified_item(FuncSpec-ElmSpec, List, TB, list_position(F,T,ElmPos,TailPos)) :- !,
|
|
FT is F + 1,
|
|
AT is T - 1,
|
|
colour_item(FuncSpec, TB, F-FT),
|
|
colour_item(FuncSpec, TB, AT-T),
|
|
specified_list(ElmSpec, List, TB, ElmPos, TailPos).
|
|
specified_item(Class, _, TB, Pos) :-
|
|
colour_item(Class, TB, Pos).
|
|
|
|
% specified_items(+Spec, +T, +TB, +PosList)
|
|
|
|
specified_items(Specs, Term, TB, PosList) :-
|
|
is_list(Specs), !,
|
|
specified_arglist(Specs, 1, Term, TB, PosList).
|
|
specified_items(Spec, Term, TB, PosList) :-
|
|
specified_argspec(PosList, Spec, 1, Term, TB).
|
|
|
|
|
|
specified_arglist([], _, _, _, _).
|
|
specified_arglist(_, _, _, _, []) :- !. % Excess specification args
|
|
specified_arglist([S0|ST], N, T, TB, [P0|PT]) :-
|
|
arg(N, T, Term),
|
|
specified_item(S0, Term, TB, P0),
|
|
NN is N + 1,
|
|
specified_arglist(ST, NN, T, TB, PT).
|
|
|
|
specified_argspec([], _, _, _, _).
|
|
specified_argspec([P0|PT], Spec, N, T, TB) :-
|
|
arg(N, T, Term),
|
|
specified_item(Spec, Term, TB, P0),
|
|
NN is N + 1,
|
|
specified_argspec(PT, Spec, NN, T, TB).
|
|
|
|
|
|
% specified_list(+Spec, +List, +TB, +PosList, TailPos)
|
|
|
|
specified_list([], [], _, [], _).
|
|
specified_list([HS|TS], [H|T], TB, [HP|TP], TailPos) :- !,
|
|
specified_item(HS, H, TB, HP),
|
|
specified_list(TS, T, TB, TP, TailPos).
|
|
specified_list(Spec, [H|T], TB, [HP|TP], TailPos) :-
|
|
specified_item(Spec, H, TB, HP),
|
|
specified_list(Spec, T, TB, TP, TailPos).
|
|
specified_list(_, _, _, [], none) :- !.
|
|
specified_list(Spec, Tail, TB, [], TailPos) :-
|
|
specified_item(Spec, Tail, TB, TailPos).
|
|
|
|
|
|
/*******************************
|
|
* DESCRIPTIONS *
|
|
*******************************/
|
|
|
|
syntax_message(Class) -->
|
|
message(Class), !.
|
|
syntax_message(goal(Class, Goal)) --> !,
|
|
goal_message(Class, Goal).
|
|
syntax_message(class(Type, Class)) --> !,
|
|
xpce_class_message(Type, Class).
|
|
|
|
goal_message(meta, _) -->
|
|
[ 'Meta call' ].
|
|
goal_message(recursion, _) -->
|
|
[ 'Recursive call' ].
|
|
goal_message(undefined, _) -->
|
|
[ 'Call to undefined predicate' ].
|
|
goal_message(expanded, _) -->
|
|
[ 'Expanded goal' ].
|
|
goal_message(global, _) -->
|
|
[ 'Auto-imported from module user' ].
|
|
goal_message(Class, Goal) -->
|
|
{ predicate_name(Goal, PI) },
|
|
[ 'Call to ~w predicate ~q'-[Class,PI] ].
|
|
|
|
xpce_class_message(Type, Class) -->
|
|
[ 'XPCE ~w class ~q'-[Type, Class] ].
|