1/* * module * 
    2% Very simple... but kept separate to maintain modularity
    3%
    4% Logicmoo Project PrologMUD: A MUD server written in Prolog
    5% Maintainer: Douglas Miles
    6% Dec 13, 2035
    7%
    8*/
    9%
   10% :- module(modScansrc, []).
   11
   12:- include(prologmud(mud_header)).   13
   14% :- register_module_type (mtCommand).
   15
   16%:- export(found_undef/3).
   17%found_undef(_,_,_).
   18%:- dynamic undef/2.
   19
   20/*
   21% when we import new and awefull code base (the previous )this can be helpfull
   22% we redfine list_undefined/1 .. this is the old version
   23:- export(scansrc_list_undefined/1).
   24scansrc_list_undefined(_):-!.
   25scansrc_list_undefined(A):- real_list_undefined(A).
   26
   27list_undefined:-real_list_undefined([]).
   28
   29:- export(real_list_undefined/1).
   30real_list_undefined(A):-
   31 merge_options(A, [module_class([user])], B),
   32        prolog_walk_code([undefined(trace), on_trace(found_undef)|B]),
   33        findall(C-D, retract(undef(C, D)), E),
   34        (   E==[]
   35        ->  true
   36        ;   print_message(warning, check(undefined_predicates)),
   37            keysort(E, F),
   38            group_pairs_by_key(F, G),
   39            maplist(check:report_undefined, G)
   40        ).
   41
   42
   43:- export(remove_undef_search/0).
   44remove_undef_search:- ((
   45 '@'(use_module(library(check)),'user'),
   46 redefine_system_predicate(check:list_undefined(_)),
   47 abolish(check:list_undefined/1),
   48 assert((check:list_undefined(A):- not(thread_self_main),!, ignore(A=[]))),
   49 assert((check:list_undefined(A):- reload_library_index,  update_changed_files,call(thread_self_main),!, ignore(A=[]))),
   50 assert((check:list_undefined(A):- ignore(A=[]),scansrc_list_undefined(A))))).
   51*/
   52
   53baseKB:action_info(actScansrc,"Scan for sourcecode modifed on filesystem and logicmoo. NOTE: only new files with this mask (src_incoming/*/?*.pl) are picked up on").
   54baseKB:agent_call_command(Agent,actScansrc):-  once('@'(agent_call_safely(Agent,actScansrc),'user')).
   55
   56:-export(actScansrc/0).   57actScansrc :- 
   58 ensure_loaded(library(make)),
   59 on_x_debug((
   60  reload_library_index,
   61  %remove_undef_search,
   62  update_changed_files,
   63  include_moo_files_not_included('../src_mud/*/?*.pl'),
   64  include_moo_files_not_included('../src_game/*/?*.pl'),   
   65   % autoload,
   66   % include_moo_files_not_included('../src_incoming/*/*/?*.pl'),
   67   % make,
   68   % include_moo_files_not_included('../src_incoming/*/?*.pfc.pl'),
   69   rescandb,
   70   !)). 
   71
   72include_moo_files_not_included(Mask):- 
   73   expand_file_name(Mask,X),
   74     forall(member(E,X),include_moo_file_ni(E)).
   75
   76include_moo_file_ni(M):-absolute_file_name(M,EX,[expand(true),access(read),file_type(prolog)]),include_moo_file_ni_1(EX).
   77
   78
   79/*
   80
   81:-export(mmake/0).
   82mmake:- update_changed_files.
   83:-export(update_changed_files/0).
   84
   85update_changed_files:-thread_signal(main,update_changed_files0).
   86update_changed_files0 :-
   87  locally(set_prolog_flag(dialect_pfc,default),
   88       (( set_prolog_flag(verbose_load,true),
   89        ensure_loaded(library(make)),
   90	findall(File, make:modified_file(File), Reload0),
   91	list_to_set(Reload0, Reload),
   92	(   prolog:make_hook(before, Reload)
   93	->  true
   94	;   true
   95	),
   96	print_message(silent, make(reload(Reload))),
   97	maplist(make:reload_file, Reload),
   98	print_message(silent, make(done_mud(Reload))),
   99	(   prolog:make_hook(after, Reload)
  100	->  true
  101	;   
  102           true %list_undefined,list_void_declarations
  103	)))).
  104*/
  105
  106include_moo_file_ni_1(M):- atomic_list_concat([_,_|_],'_i_',M),!.
  107include_moo_file_ni_1(M):- atomic_list_concat([_,_|_],'_c_',M),!.
  108include_moo_file_ni_1(M):- source_file_property(M,_),!.
  109include_moo_file_ni_1(M):- source_file_property(_,includes(M)),!.
  110
  111include_moo_file_ni_1(M):- baseKB:ensure_loaded(M).
  112
  113
  114:- include(prologmud(mud_footer)).