1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14
   15:- use_module(library(lists)).   16:- use_module(library(statistics)).   17
   18/*
   19 * walking_file_list(+FileList,+Functor,+Arity)
   20 *
   21 *	Arg2 is the functor and Arg3 the Arity of a predicate
   22 *	that succeeds with a prolog file as the first argument,
   23 *	Arg1 is a list of files (or directories).
   24 *
   25 * 	walking_file_list/3 tries to call the predicate of Arg2 
   26 * 	and Arg3 on each file in Arg1 recursively.
   27 */    
   28walking_file_list([],_,_).
   29walking_file_list([File|Files],Functor,Arity):-
   30    check_file_or_dir(File,Functor,Arity),
   31    walking_file_list(Files,Functor,Arity),!.
   32  
   33/*
   34 *	check_file_or_dir(+File,+Functor,+Arity)
   35 *	Arg2 is the functor and Arg3 the Arity of a predicate
   36 *	that succeeds with a prolog file as the first argument.
   37 * 	
   38 *	If Arg1 is a prolog file the predicate is called on Arg1.
   39 *	If Arg1 is a directory the predicate is called on each prolog
   40 * 	file in Arg1 or its subdirectories.
   41 *	Else it simply succeeds.
   42 */    
   43check_file_or_dir(File,Functor,Arity):-    
   44    file_name_extension(_,Ext,File),
   45    prolog_file_type(Ext,prolog),
   46    !,
   47    functor(Term,Functor,Arity),
   48    arg(1,Term,File),
   49    (	catch(call(Term),_,true/*(write('.'),writeln(Term),true)*/)
   50    ;	true
   51    ).
   52check_file_or_dir(Dir,Functor,Arity):-
   53	walking_prolog_directory(Dir,Functor,Arity),!.
   54check_file_or_dir(_,_,_).
   55    
   56/*
   57 * walking_prolog_directory(+Dir,+Functor,+Arity)
   58 *	if Arg2 is the functor and Arg3 the Arity of a predicate
   59 *	that succeeds with a prolog file as the first argument,
   60 * 	walking_prolog_directory/3 calls this predicate on each
   61 *	prolog file in the directory Arg1 or its subdirectories.
   62 */
   63walking_prolog_directory(Dir,Functor,Arity):-
   64    exists_directory(Dir),
   65    string_concat(Dir,'/*',FileString), /**/
   66    expand_file_name(FileString,Files),
   67    forall(member(File, Files), 
   68 		   check_file_or_dir(File,Functor,Arity)).   
   69
   70/*
   71 * do_nothing_on_file(+File)
   72 * does nothing to a file - just for runtime testing.
   73 */
   74do_nothing_on_file(_).
   75
   76
   77prolog_file(Dir,PLFile):- 
   78    exists_directory(Dir),
   79    string_concat(Dir,'/*',FileString), 
   80    expand_file_name(FileString,LocalFiles),
   81    member(File, LocalFiles), 
   82 	prolog_file_or_dir(File,PLFile). 
   83
   84prolog_file_or_dir(File,File) :-   
   85    file_name_extension(_,Pl,File),
   86    prolog_file_type(Pl,prolog),
   87    !.
   88prolog_file_or_dir(Dir,File) :-
   89    prolog_file(Dir,File).
   90
   91prolog_files(Dir, PrologFiles) :-
   92    findall( File, prolog_file(Dir,File), PrologFiles).
   93 
   94gogo :- time(consult_prolog_files('Z:/WorkspacePDT')).
   95
   96consult_prolog_files(Dir) :-
   97    prolog_file(Dir, File), 
   98      consult(File),
   99    fail.
  100consult_prolog_files(_)