/**********************************************************************
 
	Copyright (C) 2003 Hirohisa MORI <joshua@nichibun.ac.jp>
 
	This program is free software; you can redistribute it 
	and/or modify it under the terms of the GLOBALBASE 
	Library General Public License (G-LGPL) as published by 

	http://www.globalbase.org/
 
	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.

**********************************************************************/


#include 	"memory_debug.h"
#include 	"xl.h"
#include	"acrp.h"

XL_SEXP * get_op();

XL_SEXP *
get_crd_par(L_CHAR * filename)
{
L_CHAR * _filename;
int len;
XL_SEXP * ret;
XL_SEXP * g;
URL u;
	get_url2(&u,filename);
	_filename = get_url_filepath(&u);
	len = l_strlen(_filename);
	_filename = d_re_alloc(_filename,(len+20)*sizeof(L_CHAR));
	l_strcpy(&_filename[len],l_string(std_cm,".par"));
	g = n_get_symbol("Get");
	ret = get_op(gblisp_top_env0,g,_filename);
	d_f_ree(_filename);
	free_url(&u);
	return ret;
}

XL_SEXP *
get_crd_chi(L_CHAR * filename)
{
L_CHAR * _filename;
int len;
XL_SEXP * ret;
XL_SEXP * g;
URL u;
	get_url2(&u,filename);
	_filename = get_url_filepath(&u);
	len = l_strlen(_filename);
	_filename = d_re_alloc(_filename,(len+20)*sizeof(L_CHAR));
	l_strcpy(&_filename[len],l_string(std_cm,".chi"));
	g = n_get_symbol("Get");
	ret = get_op(gblisp_top_env0,g,_filename);
	d_f_ree(_filename);
	free_url(&u);
	return ret;
}


void
get_sd_url(L_CHAR ** src,L_CHAR ** dest,L_CHAR ** map,XL_SEXP * s)
{
XL_SEXP * tt, * t;
XL_SEXP * sym;
XL_SEXP * d;
int f;

	f = 0;
	*src = *dest = *map = 0;
	for ( tt = s ; get_type(tt) == XLT_PAIR ; tt = cdr(tt) ) {
		t = car(tt);
		if ( get_type(t) != XLT_PAIR )
			continue;
		sym = car(t);
		if ( get_type(sym) != XLT_SYMBOL )
			continue;
		if ( l_strcmp(sym->symbol.data,
				l_string(std_cm,"src")) == 0 ) {
			d = get_el(t,1);
			if ( get_type(d) != XLT_STRING )
				continue;
			*src = d->string.data;
			f |= 1;
		}
		else if ( l_strcmp(sym->symbol.data,
				l_string(std_cm,"dest")) == 0 ) {
			d = get_el(t,1);
			if ( get_type(d) != XLT_STRING )
				continue;
			*dest = d->string.data;
			f |= 2;
		}
		else if ( l_strcmp(sym->symbol.data,
				l_string(std_cm,"map")) == 0 ) {
			d = get_el(t,1);
			if ( get_type(d) != XLT_STRING )
				continue;
			*map = d->string.data;
			f |= 4;
		}
		if ( f == 7 )
			return;
	}
}


XL_SEXP *
filtering_crd(XL_SEXP * s)
{
XL_SEXP * ret;
XL_SEXP * t;
L_CHAR * src, * dest, * map;
int f;

	if ( get_type(s) != XLT_PAIR )
		return 0;
	ret = 0;
	for ( ; get_type(s) ; s = cdr(s) ) {
		t = car(s);
		get_sd_url(&src,&dest,&map,t);
		if ( src == 0 || dest == 0 )
			continue;
		src = &src[l_strlen(src)-4];
		dest = &dest[l_strlen(dest)-4];
		if ( l_strcmp(src,l_string(std_cm,".crd")) )
			continue;
		if ( l_strcmp(dest,l_string(std_cm,".crd")) )
			continue;
		ret = cons(t,ret);
	}
	return ret;
}
