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 * just for testing something with directives
   16 **/
   17
   18:- consult(walking_prolog_files).   19
   20collect_directives(Dir):-
   21    prolog_files(Dir, Files),
   22    collect_for_files(Files,_,Directives),
   23    print_directives(Directives).
   24    
   25collect_for_files([File|Files],FormerDirectives,AllDirectives):-
   26    collect_for_files(Files,FormerDirectives,SomeDirectives),
   27    collect_for_a_file(File,SomeDirectives,AllDirectives).
   28collect_for_files([],_,[]).
   29    
   30collect_for_a_file(File,Former,All):-
   31    open(File,read,InStream),
   32    collect_from_term(InStream,[],Found),
   33    append(Found,Former,AllFound),
   34    list_to_set(AllFound,All),		
   35    close(InStream).
   36   
   37/*collect_from_term(Stream,Former,All):-
   38    read_term(Stream,Clause,[syntax_errors(dec10)]),
   39    (	Clause == end_of_file
   40    ->	All=Former
   41    ;	(	(	Clause =.. [(:-),Directive|_Rest],
   42    			Directive =.. [Functor|_]
   43   			;	Functor=''
   44   			),
   45   			collect_from_term(Stream,Former,Found),
   46   			All = [Functor|Found]
   47   		)
   48   	).*/
   49collect_from_term(Stream,Former,All):-
   50    read_term(Stream,Clause,[syntax_errors(dec10)]),
   51    (	Clause == end_of_file
   52    ->	All=Former
   53    ;	(	(	Clause =.. [(:-),Directive|_Rest],
   54    			Directive =.. [reexport|Args]
   55   			;	Args=''
   56   			),
   57   			collect_from_term(Stream,Former,Found),
   58   			All = [Args|Found]
   59   		)
   60   	).
   61
   62    
   63print_directives([Directive|Directies]):-
   64    writeln(Directive),
   65    print_directives(Directies)