/**********************************************************************
 
	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 "v/VWindow.h"
#include "v/vobj_utils.h"

extern "C" {
#include "xl.h"
#include "xlerror.h"


XL_SEXP *
vobj_VDestroy(XLISP_ENV *env, XL_SEXP *arg, XLISP_ENV *a, XL_SYM_FIELD *sf);	

XL_SEXP *
vobj_VDestroy(XLISP_ENV *env, XL_SEXP *arg, XLISP_ENV *a, XL_SYM_FIELD *sf)
{
XL_SEXP * id;
VObject * _id;
L_CHAR * refer,* refer_id;
XL_SEXP * p;
	if ( list_length(arg) == 1 ) {
		refer = get_sf_attribute(sf,l_string(std_cm,"refer"));
		refer_id = get_sf_attribute(sf,l_string(std_cm,"refer.id"));
		if ( refer == 0 && refer_id == 0 ) {
			return get_error(
				arg->h.file,
				arg->h.line,
				XLE_PROTO_INV_PARAM,
				l_string(std_cm,"VDestroy"),
				n_get_string("attribute refer or refer.id is required"));
		}
		if ( refer ) {
			p = eval(env,n_get_symbol("__object_list"));
			if ( get_type(p) == XLT_ERROR )
				return p;
			p = vobj_get_object_by_name(p,refer,arg);
			switch ( get_type(p) ) {
			case XLT_ERROR:
				return p;
			case XLT_INTEGER:
				break;
			default:
				er_panic("get_refered_object");
			}
			_id = VObject::get_object_by_id(p->integer.data);
		}
		else {
			_id = VObject::get_object_by_id(atoi(
				n_string(std_cm,refer_id)));
		}
	}
	else {
		id = get_el(arg,1);
		if ( get_type(id) != XLT_INTEGER ) {
			return get_error(
				arg->h.file,
				arg->h.line,
				XLE_SEMANTICS_TYPE_MISSMATCH,
				l_string(std_cm,"VDestroy"),
				n_get_string(
				"id type missmatch"));
		}
		_id = VObject::get_object_by_id(id->integer.data);
	}
	if ( _id == 0 ) {
		return get_error(
			arg->h.file,
			arg->h.line,
			XLE_PROTO_INV_OBJECT,
			l_string(std_cm,"VDestroy"),
			n_get_string(
			"id object is not existed"));
	}
	_id->destroy();
	return 0;
}

void
init_VDestroy(XLISP_ENV *env)
{
	set_env(env,l_string(std_cm,"VDestroy"),
		get_func_prim((XL_SEXP*(*)())vobj_VDestroy,FO_APPLICATIVE,0,1,2));
	
}


} // extern "C"
