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


XL_SEXP * xl_GetProperCode();

void
init_GetProperCode(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"GetProperCode"),
		get_func_prim(xl_GetProperCode,FO_APPLICATIVE,0,2,2));
}

XL_SEXP *
xl_GetProperCode(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
L_CHAR * str_max;
int _str_max;
XL_SEXP * d;
L_CHAR lccode;
CODE_METHOD * cm;
	d = get_el(s,1);
	str_max = get_sf_attribute(sf,l_string(std_cm,"trace"));
	if ( str_max == 0 )
		_str_max = -1;
	else if ( l_strcmp(str_max,l_string(std_cm,"full")) == 0 ) {
		_str_max = -2;
	}
	else {
	 	sscanf(n_string(std_cm,str_max),"%i",&_str_max);
		if ( _str_max == 0 )
			_str_max = -1;
	}
	lccode = get_proper_code(d,_str_max);
	cm = search_cm_by_lccode(lccode);
	if ( cm == 0 )
		er_panic("GetProperCode(1)");
	return n_get_string(cm->name);
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"GetProperCode"),
		0);
}


