plugins

active_plugin(Id) :-
    animation_mode(Id),
    is_registered_plugin(Id).

available_plugins_for_mode(list(Plugins)) :-
    get_preference(user_is_an_expert_with_accessto_source_distribution,Expert),
    animation_mode(Mode),
    findall( list([Pl,Name]),
    ( plugin_for_modes(Pl,Modes),
    ( Expert==true -> true ; plugin_is_stable(Pl) ),
    member(Mode,Modes),
    pname(Pl,Name)),
    Plugins).

check_option(Mandatory,Info,_Id,_Verdict) :-
    member(M,Mandatory),
    memberchk( (M=_), Info),!.

check_option(Mandatory,_Info,Id,false) :-
    ( Mandatory = [M] ->
    Msg = ['Missing plugin info ', M]
    ;
    Msg = ['Missing one plugin info of ', Mandatory]),
    ajoin(['Plugin ',Id,': '|Msg], Msg1),
    print_message(error,Msg1),
    fail.

check_options(Info,Id) :-
    findall(O,mandatory_option(O),Mandatory),
    check_options2(Mandatory,Info,Id,_).

check_options2([],_Info,_Id,true).

check_options2([Mandatory1|Mrest],Info,Id,Verdict) :-
    (is_list(Mandatory1) -> Mandatory = Mandatory1 ; Mandatory = [Mandatory1]),
    check_option(Mandatory,Info,Id,Verdict),
    check_options2(Mrest,Info,Id,Verdict).

check_syntax_colouring(Rules,Id) :-
    ( syntax_colouring_error(Rules,Error) ->
    ajoin(['Error in syntax colouring rules for plugin ',Id,
    ': ', Error],Msg),
    print_message(warning,Msg),
    fail
    ;
    true).

check_syntax_colouring_type(Type,Error) :-
    Keys = [syntax_comment,syntax_keyword,syntax_type,
    syntax_assignment, syntax_operator, syntax_logical,
    syntax_unsupported],
    (memberchk(Type,Keys) -> fail ; ajoin(['unexpected colouring type ',Type],Error)).

compiletime_init_plugins :- load_compiletime_plugins,initialise_plugins.

do_not_load_plugin(plugins('probvm/probvm.pl')).

get_plugin_module_name(plugins(F),ModuleName) :- !, tools:get_modulename_filename(F,ModuleName).

get_plugin_module_name(F,ModuleName) :- tools:get_modulename_filename(F,ModuleName).

initialise_plugin(Id) :-
    plugin(Id,_Module),
    call(Id:plugin_info(Info)),
    %print(init_plugin(Id,Info)),nl,
    initialise_plugin2(Id,Info),
    !.

initialise_plugin2(Id,Info) :-
    %check_options(Info,Id),
    register_infos(Info,Id,_Used).

initialise_plugins :-
    reset_plugin_db,
    fail.

initialise_plugins :-
    plugin(Id,_Module),
    initialise_plugin(Id),
    fail.

initialise_plugins.

is_plugin_file_extension(Ext,Id) :-
    file_extensions(Id,AllExtensions),
    member( (_,Extensions), AllExtensions),
    member(Ext,Extensions), !.

is_registered_plugin(Id) :-
    pname(Id,_Name).

is_registered_plugin(Id,Name) :-
    pname(Id,Name).

load_compiletime_plugins :- print(load_compiletime_plugins),nl,
    findall(Module,
    ( directory_member_of_directory(plugins('.'),Dir,Fullname),
    atom_concat(Dir,'.pl',PrologFilename),
    file_member_of_directory(Fullname,PrologFilename,_),
    ajoin([Dir,'/',PrologFilename], Modulename),
    Module = plugins(Modulename) ),
    Plugins),
    %print(loading_plugins(Plugins)),nl,
    load_plugins2(Plugins).

load_plugin(Module,Id) :-
    catch( ( load_plugin2(Module,Id) ->
    ajoin(['Loaded plugin ', Id], Msg),
    print_message(informational, Msg)
    ;
    ajoin(['Loading of module ', Module, ' failed: '], Msg),
    print_message(error, Msg)),
    E,
    ( ajoin(['Loading of module ', Module, ' raised an exception: ', E], Msg),
    print_message(error, Msg))).

load_plugin2(Module,Id) :-
    use_module(IdVar,Module,[]), % SICStus 4.3.3 now keeps IdVar a variable !
    (var(IdVar) -> get_plugin_module_name(Module,Id)
    ; IdVar = Id),
    %print(used_module(Id,Module)),nl,
    ( plugin(Id,_) ->
    ajoin(['Plugin ID ',Id,' used twice'],Msg),
    print_message(error,Msg),
    fail
    ;
    true).

load_plugin_file(Id,Filename) :-
    user:tcltk_clear_machine,
    (plugin_init_pred(Id,Module:Pred/0) -> call(Module:Pred) ; true),
    file_loader(Id,Module:Pred/1),
    call(Module:Pred,Filename),!,
    set_animation_mode(Id).

load_plugins2([]).

load_plugins2([Module|Prest]) :- do_not_load_plugin(Module),!, load_plugins2(Prest).

load_plugins2([Module|Prest]) :-
    load_plugin(Module,Id),
    (nonvar(Id) -> assertz(plugin(Id,Module)); true),
    load_plugins2(Prest).

mandatory_option(name).

mandatory_option(load_file).

mandatory_option([file_extensions,plugin_for_modes]).

mandatory_option(transition).

mandatory_option(initialisation).

notify_new_transition_to_plugin(FromId,TransId,DstId,Exists) :-
    animation_mode(Mode),
    notify_new_transition_to_plugin(Mode,FromId,TransId,DstId,Exists).

notify_new_transition_to_plugin(ModeId,FromId,TransId,DstId,Exists) :-
    plugin_new_transition_pred(ModeId,Module:Pred/4),
    !,
    ( call(Module:Pred,FromId,TransId,DstId,Exists) ->
    true
    ;
    ajoin(['Notification of new transition failed for plugin ',ModeId,', ',call(Pred,FromId,TransId,DstId,Exists)],Msg),
    add_error(plugins,Msg)).

notify_new_transition_to_plugin(_Id,_FromId,_TransId,_DstId,_Exists).

plugin_check_invariantKO(IdPlugin,IdProB,State) :-
    plugin_check_invariant_pred(IdPlugin,Module:Pred/2),
    call(Module:Pred,IdProB,State).

plugin_compute_expression(Id,Expression,State,Result) :-
    compute_expression_pred(Id,Module:Pred/3),
    call(Module:Pred,Expression,State,Result).

plugin_evaluate_predicate(Id,Predicate,State) :-
    evaluate_predicate_pred(Id,Module:Pred/3),
    call(Module:Pred,Predicate,State).

plugin_evaluate_transition_predicate(Id,Predicate,Transition) :-
    evaluate_transition_pred(Id,Module:Pred/2),
    call(Module:Pred,Predicate,Transition).

plugin_file_extensions(list(Ext)) :-
    get_preference(user_is_an_expert_with_accessto_source_distribution,Expert),
    findall( list([Description, list(Suffixes)]),
    ( file_extensions(Id,Ext),
    ( Expert==true -> true ; plugin_is_stable(Id) ),
    member( (Description,Suffixes), Ext)),
    Ext).

plugin_get_internal(Id,InternalRepresentation) :-
    active_plugin(Id),
    plugin_internal_representation_pred(Id,Module:Pred/1),
    call(Module:Pred,InternalRepresentation).

plugin_get_output(list(Outputs),SortOfOutput) :-
    active_plugin(Id),
    plugin_output_pred(Id,Module:Pred/3),
    findall(list([Name,Output]),
    (call(Module:Pred,Name,Output,Sorts),member(SortOfOutput,Sorts)),
    Outputs).

plugin_get_output(Name,Output) :-
    active_plugin(Id),
    plugin_output_pred(Id,Module:Pred/3),
    call(Module:Pred,Name,Output,_).

plugin_has_output(SortOfOutput) :-
    plugin_get_output(list([_|_]),SortOfOutput).

plugin_has_preferences :-
    plugins_with_preferences(list([_|_])),!.

plugin_is_available_for_mode :-
    available_plugins_for_mode(list([_|_])),!.

plugin_is_initialised_state(Id,State) :-
    (is_initialised_state_pred(Id,Module:Pred/1) -> call(Module:Pred,State) ; true).

plugin_is_stable(Id) :-
    (status(Id,Status) -> Status==stable ; true).

plugin_parse(Id,ExprStrings,PredStrings,TransPredStrings,Exprs,Preds,Trans) :-
    parser_pred(Id,Module:Pred/6),
    call(Module:Pred,ExprStrings,PredStrings,TransPredStrings,Exprs,Preds,Trans).

plugin_preference_category(plugin(Id,Key), plugin(Id)) :-
    is_registered_plugin(Id),
    plugin_preferences_pred(Id,Module:Pred/4),
    call(Module:Pred,Key,_,_,_).

plugin_preference_default_value(plugin(Id,Key),Value) :-
    is_registered_plugin(Id),
    plugin_preferences_pred(Id,Module:Pred/4),
    call(Module:Pred,Key,Value,_,_).

plugin_preference_description(plugin(Id,Key),Description) :-
    is_registered_plugin(Id),
    plugin_preferences_pred(Id,Module:Pred/4),
    call(Module:Pred,Key,_,Description,_).

plugin_preference_val_type(plugin(Id,Key),Type) :-
    is_registered_plugin(Id),
    plugin_preferences_pred(Id,Module:Pred/4),
    call(Module:Pred,Key,_,_,Type).

plugin_prettyprint_property(Id,Property,Atom) :-
    ( prettyprint_property_pred(Id,Module:Pred/2) ->
    call(Module:Pred,Property,Codes)
    ;
    write_to_codes(Property,Codes)),
    (atomic(Codes) -> Atom=Codes ; atom_codes(Atom,Codes)).

plugin_prettyprint_transition(Id,Transition,Atom) :-
    ( prettyprint_transition_pred(Id,Module:Pred/2) ->
    call(Module:Pred,Transition,Codes)
    ;
    write_to_codes(Transition,Codes)),
    (atomic(Codes) -> Atom=Codes ; atom_codes(Atom,Codes)).

plugin_prettyprint_value(Id,Property,Codes) :-
    ( prettyprint_value_pred(Id,Module:Pred/2) ->
    call(Module:Pred,Property,Codes)
    ;
    write_to_codes(Property,Codes)).

plugin_state_property(Id,State,Property) :-
    State \== root,
    ( state_property_pred(Id,Module:Pred/2) ->
    call(Module:Pred,State,Property)
    ;
    Property = State).

plugin_transition(Id,Org,Trans,Dst,Infos) :-
    ( Org==root ->
    initialisation_pred(Id,Module:Pred/3),
    call(Module:Pred,Trans,Dst,Infos)
    ;
    transition_pred(Id,Module:Pred/4),
    call(Module:Pred,Org,Trans,Dst,Infos)).

plugins_with_preferences(list(Plugins)) :-
    get_preference(user_is_an_expert_with_accessto_source_distribution,Expert),
    findall( list([Pl,Name]),
    ( is_registered_plugin(Pl),
    ( Expert==true -> true ; plugin_is_stable(Pl) ),
    plugin_preferences_pred(Pl,_),
    pname(Pl,Name)),
    Plugins).

reg_proc_assert(Id,Name,Fact,Proc,Arity) :-
    ( Proc = M:P/Arity -> true
    ; Proc = P/Arity -> M:P/Arity = Id:Proc
    ;
    ajoin(['Predicate in info ',Name,' of plugin ',
    Id,' is not valid: ',Proc],Msg),
    print_message(error, Msg),fail),
    Fact =.. [F|Args], append(Args,[M:P/Arity],AllArgs),
    NFact =.. [F|AllArgs],
    regassert(Id,Name,NFact).

regassert(Id,Name,Fact) :-
    functor(Fact,F,Arity),
    NArity is Arity+1,
    functor(Check,F,NArity), arg(1,Check,Id),
    ( call(Check) ->
    ajoin(['Plugin ', Id, ': multiple occurence of info ',
    Name, ', ignoring'],Msg),
    print_message(warning,Msg)
    ;
    Fact=..[F|Args],
    NFact=..[F,Id|Args],
    assertz(NFact)).

register_info(Info,Id,Used) :-
    ( Info = (Name=Value) ->
    ( register_info2(Name,Value,Id) ->
    Used = [Name]
    ;
    ajoin(['Failed analysing plugin info for plugin ', Id,
    ': ', Name, ' = ', Value], Msg),
    print_message(error, Msg),
    Used = [])
    ;
    ajoin(['Invalid plugin info for plugin ', Id,
    ': ', Info], Msg),
    print_message(error, Msg),
    Used = []).

register_info2(name,Name,Id) :-
    regassert(Id,name,pname(Name)).

register_info2(status,Status,Id) :-
    ( memberchk(Status,[stable,unstable]) ->
    regassert(Id,name,status(Status))
    ;
    ajoin(['Plugin ',Id,': Invalid status, ignoring'],Msg),
    print_message(warning,Msg)).

register_info2(load_file,Proc,Id) :-
    reg_proc_assert(Id,load_file,file_loader,Proc,1).

register_info2(author,Author,Id) :-
    regassert(Id,author,author(Author)).

register_info2(file_extensions,Ext,Id) :-
    regassert(Id,file_extensions,file_extensions(Ext)).

register_info2(transition_skeleton,Proc,Id) :-
    reg_proc_assert(Id,transition_skeleton,transition_skeleton,Proc,1).

register_info2(transition,Proc,Id) :-
    reg_proc_assert(Id,transition,transition_pred,Proc,4).

register_info2(initialisation,Proc,Id) :-
    reg_proc_assert(Id,initialisation,initialisation_pred,Proc,3).

register_info2(state_property,Proc,Id) :-
    reg_proc_assert(Id,state_property,state_property_pred,Proc,2).

register_info2(parser,Proc,Id) :-
    reg_proc_assert(Id,parser,parser_pred,Proc,6).

register_info2(compute_expression,Proc,Id) :-
    reg_proc_assert(Id,compute_expression,compute_expression_pred,Proc,3).

register_info2(evaluate_predicate,Proc,Id) :-
    reg_proc_assert(Id,evaluate_predicate,evaluate_predicate_pred,Proc,2).

register_info2(evaluate_transition,Proc,Id) :-
    reg_proc_assert(Id,evaluate_transition,evaluate_transition_pred,Proc,2).

register_info2(is_initialised_state,Proc,Id) :-
    reg_proc_assert(Id,is_initialised_state,is_initialised_state_pred,Proc,1).

register_info2(prettyprint_transition,Proc,Id) :-
    reg_proc_assert(Id,prettyprint_transition,prettyprint_transition_pred,Proc,2).

register_info2(prettyprint_property,Proc,Id) :-
    reg_proc_assert(Id,prettyprint_property,prettyprint_property_pred,Proc,2).

register_info2(prettyprint_value,Proc,Id) :-
    reg_proc_assert(Id,prettyprint_value,prettyprint_value_pred,Proc,2).

register_info2(syntax_colouring,Rules,Id) :-
    check_syntax_colouring(Rules,Id),
    regassert(Id,syntax_colouring,syntax_colouring(Rules)).

register_info2(plugin_for_modes,Modes,Id) :-
    regassert(Id,syntax_colouring,plugin_for_modes(Modes)).

register_info2(plugin_init,Proc,Id) :-
    reg_proc_assert(Id,plugin_init,plugin_init_pred,Proc,0).

register_info2(new_transition_notification,Proc,Id) :-
    reg_proc_assert(Id,new_transition_notification,plugin_new_transition_pred,Proc,4).

register_info2(preferences,Proc,Id) :-
    reg_proc_assert(Id,preferences,plugin_preferences_pred,Proc,4).

register_info2(check_invariant,Proc,Id) :-
    reg_proc_assert(Id,check_invariant,plugin_check_invariant_pred,Proc,2).

register_info2(output,Proc,Id) :-
    reg_proc_assert(Id,output,plugin_output_pred,Proc,3).

register_info2(internal_representation,Proc,Id) :-
    reg_proc_assert(Id,internal_representation,plugin_internal_representation_pred,Proc,1).

register_infos([],_Id,[]).

register_infos([Info|IRest],Id,Used) :-
    register_info(Info,Id,U),
    append(U,RUsed,Used),
    register_infos(IRest,Id,RUsed).

reset_plugin_db :-
    retractpred(pname/2),
    retractpred(status/2),
    retractpred(author/2),
    retractpred(file_extensions/2),
    retractpred(file_loader/2),
    retractpred(transition_skeleton/2),
    retractpred(transition_pred/2),
    retractpred(initialisation_pred/2),
    retractpred(state_property_pred/2),
    retractpred(parser_pred/2),
    retractpred(compute_expression_pred/2),
    retractpred(evaluate_predicate_pred/2),
    retractpred(evaluate_transition_pred/2),
    retractpred(is_initialised_state_pred/2),
    retractpred(prettyprint_transition_pred/2),
    retractpred(prettyprint_property_pred/2),
    retractpred(prettyprint_value_pred/2),
    retractpred(syntax_colouring/2),
    retractpred(plugin_for_modes/2),
    retractpred(plugin_init_pred/2),
    retractpred(plugin_new_transition_pred/2),
    retractpred(plugin_preferences_pred/2),
    retractpred(plugin_check_invariant_pred/2),
    retractpred(plugin_output_pred/2),
    retractpred(plugin_internal_representation_pred/2).

retractpred(F/A) :-
    functor(Fact,F,A), retractall(Fact).

setup_transition_skeleton(Id,Skeleton) :-
    transition_skeleton(Id,Module:Pred/1),!,
    call(Module:Pred,Skeleton).

setup_transition_skeleton(_Id,_Skeleton).

start_plugin_for_current_mode(Id) :-
    animation_mode(Mode),
    is_registered_plugin(Id),
    set_animation_mode(Id),
    set_animation_minor_mode(Mode),
    (plugin_init_pred(Id,Module:Pred/0) -> call(Module:Pred) ; true).

stop_plugin :-
    animation_minor_mode(Mode),
    set_animation_mode(Mode).

stop_plugin :-
    set_animation_mode(b).

syntax_colouring_error([],_) :- !,fail.

syntax_colouring_error([Rule|_],Error) :-
    syntax_colouring_error2(Rule,Error),!.

syntax_colouring_error([_|Rest],Error) :- !,
    syntax_colouring_error(Rest,Error).

syntax_colouring_error(_,'list expected').

syntax_colouring_error2(expression(_Regex,Type),Error) :- !,
    check_syntax_colouring_type(Type,Error).

syntax_colouring_error2(pair(_RegexA,_RegexB,Type),Error) :- !,
    check_syntax_colouring_type(Type,Error).

syntax_colouring_error2(_,'expected expression(Regex,Type) or pair(Begin,End,Type)').

tcl_plugin_syntax_colouring(Id,list(Rules)) :-
    findall(L, tcl_syntax_colouring2(Id,L), Rules).

tcl_syntax_colouring2(Id,TclRule) :-
    syntax_colouring(Id,Rules),
    member(PRule,Rules),
    tcl_syntax_colouring3(PRule,TclRule).

tcl_syntax_colouring3(expression(Pattern,Type), list([expression,Pattern,Type])).

tcl_syntax_colouring3(pair(Begin,End,Type), list([pair,Begin,End,Type])).