/**********************************************************************
 
	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	"xl.h"
#include	"xlerror.h"
#include	"utils.h"
#include	"memory_debug.h"

XL_SEXP * xl_SetDatabasePath();
extern L_CHAR * docs_path, * sys_path;

void
init_SetDatabasePath(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"SetDatabasePath"),
		get_func_prim(xl_SetDatabasePath,FO_APPLICATIVE,0,2,3));
}

XL_SEXP *
xl_SetDatabasePath(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * docs,* sys;
	docs = get_el(s,1);
	if ( get_type(docs) != XLT_STRING )
		goto type_missmatch;
	if ( docs_path )
		d_f_ree(docs_path);
	docs_path = ll_copy_str(docs->string.data,1472);
	if ( list_length(s) == 2 )
		return List(docs,-1);
	sys = get_el(s,2);
	if ( get_type(sys) != XLT_STRING )
		goto type_missmatch;
	if ( sys_path )
		d_f_ree(sys_path);
	sys_path = ll_copy_str(sys->string.data,1471);
	return List(docs,sys,-1);
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"SetDatabasePath"),
		n_get_string("type missmatch"));
}
