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


XL_SEXP * xl_CutString();

void
init_CutString(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"CutString"),
		get_func_prim(xl_CutString,FO_APPLICATIVE,0,4,4));
}

XL_SEXP *
xl_CutString(XLISP_ENV * env,XL_SEXP * s)
{
XL_SEXP * ret;
XL_SEXP * str;
XL_SEXP * sn;
XL_SEXP * sl;
L_CHAR * c;
int	i,j,len,slen;
	str = get_el(s,1);
	sn = get_el(s,2);
	sl = get_el(s,3);
	if ( (get_type(str) != XLT_STRING) || (get_type(sn) != XLT_INTEGER) || (get_type(sl) != XLT_INTEGER) ) {
		return get_error(
			s->h.file,
			s->h.line,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"CutString"),
			List(	n_get_string("invalid argument in CutString"),
				s,
				-1));
	}

	slen = l_strlen(str->string.data);
	if ( slen < 0 ) {
		goto _bail;
	}
	else if ( slen == 0 ) {
		return n_get_string("");
	}

	if ( sn->integer.data < 0 ) {
		goto _bail;
	}

	len = sl->integer.data;
	if ( len < 0 ) {
		goto _bail;
	}

	c = (L_CHAR *)d_alloc((len+1)*sizeof(L_CHAR));
	c[len] = 0;
	for ( i = sn->integer.data, j = 0 ; (i < slen) && (j < len) ; i ++, j ++ ) {
		c[j] = (str->string.data)[i];
	}
	c[j] = 0;
	ret = get_string(c);
	d_f_ree(c);
	return ret;
_bail:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"CutString"),
		List(	n_get_string("invalid argument in CutString"),
			s,-1));
}
