/**********************************************************************
 
	Copyright (C) 2003-2004
	Hirohisa MORI <joshua@nichibun.ac.jp>
	Tomoki SEKIYAMA <sekiyama@yahoo.co.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 <string.h>
#include <stdlib.h>

#include "v/VObject.h"
#include "v/vobj_utils.h"
#include "v/VMarshaler.h"

extern "C" {

#include "xl.h"
#include "xlerror.h"
#include "memory_debug.h"
#include "task.h"
#include "lock_level.h"
#include "gbview.h"

bool vobject_quit();
void vobject_layout();
//void gc_gb_sexp();
void gc_gblisp_env(XLISP_ENV *);
XL_SEXP *v_get_el_by_symbol(XL_SEXP * s,L_CHAR * sym,void * cond);

SEM vobj_utils_lock;
VSysArgTranslator * vsat_list;

void
gc_vobj_utils_lock()
{
	lock_task(vobj_utils_lock);
}

void
gc_vobj_utils_unlock()
{
	unlock_task(vobj_utils_lock,"unlock");
}

void
gc_vobj_utils()
{
VSysArgTranslator * vsat;
	for ( vsat = vsat_list ; vsat ; vsat = vsat->next ) {
		gc_gblisp_env(vsat->env);
	}
}

 

// ========================================================= 
//   Callback function glue
// =========================================================



void
insert_vsat_list(VSysArgTranslator * vsat)
{
	lock_task(vobj_utils_lock);
	vsat->next = vsat_list;
	vsat_list = vsat;
	unlock_task(vobj_utils_lock,"insert_vsat_list");
}

void
delete_vsat_list(VSysArgTranslator * vsat)
{
VSysArgTranslator ** vp;
	lock_task(vobj_utils_lock);
	for ( vp = &vsat_list ; *vp ; vp = &(*vp)->next )
		if ( *vp == vsat ) {
			*vp = vsat->next;
			unlock_task(vobj_utils_lock,"delete_vsat_list");
			return;
		}
	unlock_task(vobj_utils_lock,"delete_vsat_list");
}


void
free_VSysArgTranslator(int type,void * ptr)
{
VSysArgTranslator * vsat;
	vsat = (VSysArgTranslator*)ptr;
	delete_vsat_list(vsat);
	if ( type == VFLT_DELETE ) {
		if ( vsat->func )
			d_f_ree(vsat->func);
		d_f_ree(vsat);
	}
}

VSysArgTranslator *
copy_vsat(VSysArgTranslator * vsat)
{
VSysArgTranslator * ret;
	ret = (VSysArgTranslator*)d_alloc(sizeof(*ret));
	memcpy(ret,vsat,sizeof(*vsat));
	if ( vsat->func )
		ret->func = ll_copy_str(vsat->func);
	return ret;
}

V_CALLBACK_D(vobj_callback_glue)
{
extern PRI_CTL parse_lock_ctl,queue_lock_ctl;
PRI_CTL_THREAD tt1,tt2;

	enter_pri_ctl(&parse_lock_ctl,&tt1);
	enter_pri_ctl(&queue_lock_ctl,&tt2);

	gc_push(0,0,"vobj_callback_glue");

	VObjectStatus sts;
	XL_SEXP *result;
	L_CHAR *func = (L_CHAR*)user_arg;
	if ( object )
		object->get_status(&sts, VSF_ID);
	else
		sts.id = 0;
	if ( user_arg == 0 )
		er_panic("vobj_callback_glue");
	if ( func[0] == 0 ) {
		// user_arg is sys_arg translator structure : 0 is the signature
		VSysArgTranslator *vsat = (VSysArgTranslator*)user_arg;
		if ( vsat->env ) {
			if ( vsat->translator )
				result = eval(vsat->env, List(
					get_symbol(vsat->func),
					get_integer(sts.id, 0),
					(*vsat->translator)(object, sys_arg),
					-1));
			else	result = eval(vsat->env, List(
					get_symbol(vsat->func),
					get_integer(sts.id, 0),
					0,
					-1));
		}
		else {
			if ( vsat->translator )
				result = eval(vobj_env, List(
					get_symbol(vsat->func),
					get_integer(sts.id, 0),
					(*vsat->translator)(object, sys_arg),
					-1));
			else	result = eval(vobj_env, List(
					get_symbol(vsat->func),
					get_integer(sts.id, 0),
					0,
					-1));
		}
	}
	else
		result = eval(vobj_env, List(
				get_symbol((L_CHAR*)user_arg),
				get_integer(sts.id, 0),
				-1));
	if ( get_type(result) == XLT_ERROR ) {
		fflush(stdout);
		ss_printf("vobj_callback_glue ERROR : ");
		print_sexp(s_stdout, result, 0);
		ss_printf("\n");
	}
//*
	else {
		fflush(stdout);
		ss_printf("vobj_callback_glue : ");
		print_sexp(s_stdout, result, 0);
		ss_printf("\n");
	}	
//*/
	gc_pop(0,0);

	exit_pri_ctl(&parse_lock_ctl);
	exit_pri_ctl(&queue_lock_ctl);

}


// ========================================================= 
//   Utility XL Functions
// =========================================================



XL_SEXP *
vobj_get_object_by_name(XL_SEXP *s, L_CHAR *name, XL_SEXP *arg)
{
XL_SEXP * res, * sym;
VObject * obj;

	for ( ; get_type(s) == XLT_PAIR ; s = cdr(s) ) {
		res = car(s);
		if ( get_type(res) != XLT_PAIR )
			continue;
		sym = car(res);
		if ( get_type(sym) == XLT_SYMBOL ) {
			if ( l_strcmp(sym->symbol.data,name) == 0 )
				break;
		}
		sym = get_el(res,2);
		if ( get_type(sym) != XLT_INTEGER )
			continue;
		if ( sym->integer.data & OIF_INTERNAL ) {
			sym = get_el(res,1);
			if ( get_type(sym) != XLT_INTEGER )
				continue;
			obj = VObject::get_object_by_id(sym->integer.data);
			res = obj->get_object_by_name(name);
			if ( res )
				break;
		}
	}
	if ( get_type(s) == XLT_NULL )
		return vobj_get_error(initial_VExError(V_ER_NOT_FOUND,0,0), arg);
	switch ( get_type(res) ) {
	case XLT_PAIR:
		res = car(cdr(res));
		if ( get_type(res) == XLT_INTEGER )
			return res;
		break;
	case XLT_INTEGER:
		return res;
	}
	return vobj_get_error(initial_VExError(V_ER_NOT_FOUND,0,0), arg);
}



VObject *
get_object_from_name(XLISP_ENV * env,L_CHAR * name)
{
XL_SEXP * list;
XL_SEXP * p, * t, * s;
VObject * obj;
	list = eval(env,n_get_symbol("__object_list"));
	if ( get_type(list) == XLT_ERROR )
		return 0;
	for ( p = list ; get_type(p) == XLT_PAIR ; p = cdr(p) ) {
		t = car(p);
		if ( get_type(t) != XLT_PAIR )
			er_panic("get_object_form_name(1)");
		s = car(t);
		if ( get_type(s) != XLT_SYMBOL )
			er_panic("get_object_form_name(2)");
		if ( l_strcmp(s->symbol.data,name) == 0 )
			goto ok;
		s = get_el(t,2);
		if ( get_type(s) != XLT_INTEGER )
			continue;
		if ( s->integer.data & OIF_INTERNAL ) {
			s = get_el(t,1);
			if ( get_type(s) != XLT_INTEGER )
				continue;
			obj = VObject::get_object_by_id(s->integer.data);
			s = obj->get_object_by_name(name);
			if ( s )
				goto ok2;
		}
	}
	return 0;
ok:
	s = get_el(t,1);
ok2:
	if ( get_type(s) != XLT_INTEGER )
		return 0;
	return VObject::get_object_by_id(s->integer.data);
}

XL_SEXP *
vobj_GetObjectID(XLISP_ENV *env, XL_SEXP *arg, XLISP_ENV *a, XL_SYM_FIELD *sf)
{
	XL_SEXP *s = cdr(arg);
	XL_SEXP *t = car(cdr(s));
	s = car(s);
	
	if ( get_type(s) != XLT_PAIR )
		goto type_missmatch;
	if ( get_type(t) != XLT_SYMBOL )
		goto type_missmatch;

	return vobj_get_object_by_name(s,t->symbol.data,arg);

type_missmatch:
	return get_error(
		arg->h.file,
		arg->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm, "GetObjectID"),
		n_get_string("type missmatch"));
}

XL_SEXP *
vobj_Quit()
{
	vobject_quit();
	return 0;
}

XL_SEXP *
vobj_Layout()
{
	vobject_layout();
	return 0;
}

void
init_vobj_utils(XLISP_ENV *env)
{
	vobj_utils_lock = new_lock(LL_VOBJ_UTILS);
	init_marshaler();
	init_VMarshaler(env);
	set_env(env,l_string(std_cm,"GetObjectID"),
		get_func_prim((XL_SEXP*(*)())vobj_GetObjectID,FO_APPLICATIVE,0,3,3));
	set_env(env,l_string(std_cm,"Quit"),
		get_func_prim((XL_SEXP*(*)())vobj_Quit,FO_APPLICATIVE,0,1,1));
	set_env(env,l_string(std_cm,"Layout"),
		get_func_prim((XL_SEXP*(*)())vobj_Layout,FO_APPLICATIVE,0,1,1));
}


// ========================================================= 
//   Convert constants to L_CHAR / XL_SEXP
// =========================================================

// -------- VALIGN_xxx --> L_CHAR --------
unsigned char
vobj_get_align_by_name(L_CHAR *attr)
{
	char *n = n_string(std_cm, attr);

#define RET_ALIGN(align)	if ( strcasecmp(n,#align) == 0 ) return VALIGN_##align

	RET_ALIGN(LEFT);
	RET_ALIGN(TOP);
	RET_ALIGN(RIGHT);
	RET_ALIGN(BOTTOM);
	RET_ALIGN(FILL);
	
	return VALIGN_EXPAND;
}

// -------- VALIGN_xxx <-- L_CHAR --------
L_CHAR *
vobj_get_align_name(unsigned align, bool vert_flag)
{

#define RET_ALIGN_NAME(a)	if ( align == VALIGN_##a ) return l_string(std_cm,#a)

	if ( vert_flag ) {
		RET_ALIGN_NAME(LEFT);
		RET_ALIGN_NAME(RIGHT);
	}
	else {
		RET_ALIGN_NAME(TOP);
		RET_ALIGN_NAME(BOTTOM);
	}
	RET_ALIGN_NAME(FILL);
	
	return l_string(std_cm,"EXPAND");
}


// -------- VSF_xxx <-- L_CHAR --------
int
vobj_sts_flag_by_name(L_CHAR *flag)
{
#define RET_FLAG(value, ff)  if ( l_strcmp(flag, l_string(std_cm, #value)) == 0 ) return ff

	RET_FLAG(parent, VSF_PARENT);
	RET_FLAG(children, VSF_CHILDREN);
	RET_FLAG(id, VSF_ID);
	RET_FLAG(attr, VSF_ATTR);
	RET_FLAG(value, VSF_VALUE);
	RET_FLAG(ws, VSF_WS);
	RET_FLAG(fsize, VSF_FSIZE);
	RET_FLAG(descriptor, VSF_DESC);
	RET_FLAG(vert_desc, VSF_VERTD);
	RET_FLAG(visible, VSF_VISIBLE);
	RET_FLAG(enabled, VSF_ENABLED);
	RET_FLAG(homogeneous, VSF_HOMOGEN);
	RET_FLAG(spacing, VSF_SPACING);
	RET_FLAG(alignv, VSF_ALIGN);
	RET_FLAG(alignh, VSF_ALIGN);
	RET_FLAG(padding, VSF_PADDING);
	RET_FLAG(cursor, VSF_CURSOR);
	RET_FLAG(value_event_handler, VSF_VALUE_EH);
	RET_FLAG(descriptor_event_handler, VSF_DESC_EH);
	RET_FLAG(destroy_handler, VSF_DESTROY_H);

	RET_FLAG(min_size, VSF_MIN_SIZE);
	RET_FLAG(size, VSF_SIZE);
	RET_FLAG(position, VSF_POSITION);
	return 0;
}

// -------- VSF_xxx <-- SYM_FIELD --------
int
vobj_status_flag_from_fs(XL_SEXP *arg, XL_SYM_FIELD *sf, int *out_flags,
		VStatusFlagsFromFS * vsffs)
{
	int i, mode, ff;
	int j;
	L_CHAR flag[64];
	L_CHAR *flags = get_sf_attribute(sf, l_string(std_cm, "flags"));
	L_CHAR *p = flags;
	if ( flags == 0 )
		return -2;	
	*out_flags = 0;
	i = 0;
	mode = 0;

	if ( vsffs )
		for ( j = 0 ; vsffs[j].get_flag ; j ++ )
			vsffs[j].flags = 0;
	
	for ( p = flags ; mode != 2 ; p++ ) {
		switch ( mode ) {
		  case 0:
		  	if ( *p == 0 ) {
		  		mode = 2;
		  		continue;
		  	}
			if ( *p == ' ' )
				continue;
			mode = 1;
			// continue into case 1

		  case 1:
			if ( *p && *p != ',' ) {
				flag[i++] = *p;
				if ( i >= 32 )
					return -1;
				continue;
			}
			flag[i] = 0;
			mode = 0;
			i = 0;
			
			ff = vobj_sts_flag_by_name(flag);
			if ( ff == 0 ) {
				if ( vsffs == 0 )
					return -1;
				for ( j = 0 ; vsffs[j].get_flag ; j ++ ) {
					ff = (*vsffs[j].get_flag)(flag);
					if ( ff )
						break;
				}
				if ( ff == 0 )
					return -1;
				vsffs[j].flags |= ff;
			}
			else {
				*out_flags |= ff;
			}
			if ( *p == 0 )
				mode = 2;
			break;
		}
	}
	return 0;
}



// -------- V_ER_xxx --> XL_SEXP --------

XL_SEXP *
get_ex_flags_pos(int flags,char * msg)
{
XL_SEXP * ret;
	ret = 0;
	if ( flags & VSF_PARENT	) {
		ret = cons(n_get_string("VSF_PARENT"),ret);
		flags &= ~ VSF_PARENT;
	}
	if ( flags &  VSF_CHILDREN ) {
		ret = cons(n_get_string("VSF_CHILDREN"),ret);
		flags &= ~ VSF_CHILDREN;
	}
	if ( flags &  VSF_ID ) {
		ret = cons(n_get_string("VSF_ID"),ret);
		flags &= ~ VSF_ID;
	}
	if ( flags &  VSF_ATTR	) {
		ret = cons(n_get_string("VSF_ATTR"),ret);
		flags &= ~ VSF_ATTR;
	}
	if ( flags &  VSF_VALUE ) {
		ret = cons(n_get_string("VSF_VALUE"),ret);
		flags &= ~ VSF_VALUE;
	}
	if ( flags &  VSF_WS ) {
		ret = cons(n_get_string("VSF_WS"),ret);
		flags &= ~ VSF_WS;
	}
	if ( flags &  VSF_FSIZE	) {
		ret = cons(n_get_string("VSF_FSIZE"),ret);
		flags &= ~ VSF_FSIZE;
	}
	if ( flags &  VSF_DESC ) {
		ret = cons(n_get_string("VSF_DESC"),ret);
		flags &= ~ VSF_DESC;
	}
	if ( flags &  VSF_VERTD ) {
		ret = cons(n_get_string("VSF_VERTD"),ret);
		flags &= ~ VSF_VERTD;
	}
	if ( flags &  VSF_VISIBLE ) {
		ret = cons(n_get_string("VSF_VISIBLE"),ret);
		flags &= ~ VSF_VISIBLE;
	}
	if ( flags &  VSF_ENABLED ) {
		ret = cons(n_get_string("VSF_ENABLED"),ret);
		flags &= ~ VSF_ENABLED;
	}
	if ( flags &  VSF_HOMOGEN ) {
		ret = cons(n_get_string("VSF_HOMOGEN"),ret);
		flags &= ~ VSF_HOMOGEN;
	}
	if ( flags &  VSF_SPACING ) {
		ret = cons(n_get_string("VSF_SPACING"),ret);
		flags &= ~ VSF_SPACING;
	}
	if ( flags &  VSF_ALIGN	) {
		ret = cons(n_get_string("VSF_ALIGN"),ret);
		flags &= ~ VSF_ALIGN;
	}
	if ( flags &  VSF_PADDING ) {
		ret = cons(n_get_string("VSF_PADDING"),ret);
		flags &= ~ VSF_PADDING;
	}
	if ( flags &  VSF_CURSOR ) {	
		ret = cons(n_get_string("VSF_CURSOR"),ret);
		flags &= ~ VSF_CURSOR;
	}
	if ( flags &  VSF_VALUE_EH ) {
		ret = cons(n_get_string("VSF_VALUE_EH"),ret);
		flags &= ~ VSF_VALUE_EH;
	}
	if ( flags &  VSF_DESC_EH ) {
		ret = cons(n_get_string("VSF_DESC_EH"),ret);
		flags &= ~ VSF_DESC_EH;
	}
	if ( flags &  VSF_DESTROY_H ) {
		ret = cons(n_get_string("VSF_DESTROY_H"),ret);
		flags &= ~ VSF_DESTROY_H;
	}

	if ( flags &  VSF_MIN_SIZE ) {
		ret = cons(n_get_string("VSF_DESTROY_H"),ret);
		flags &= ~ VSF_DESTROY_H;
	}
	if ( flags &  VSF_SIZE ) {
		ret = cons(n_get_string("VSF_SIZE"),ret);
		flags &= ~ VSF_SIZE;
	}
	if ( flags &  VSF_POSITION ) {
		ret = cons(n_get_string("VSF_POSITION"),ret);
		flags &= ~ VSF_POSITION;
	}
	if ( flags &  VSF_CALC_MIN ) {
		ret = cons(n_get_string("VSF_CALC_MIN"),ret);
		flags &= ~ VSF_CALC_MIN;
	}
	if ( flags &  VSF_LAYOUT ) {
		ret = cons(n_get_string("VSF_LAYOUT"),ret);
		flags &= ~ VSF_LAYOUT;
	}
	if ( flags ) {
		ret = cons(n_get_string("some-unknown-flags"),ret);
	}
	return cons(n_get_string(msg),ret);
}


XL_SEXP *
vobj_get_error(VExError err, XL_SEXP *arg)
{
L_CHAR * func;
XL_SEXP * sym;
XL_FILE * file;
int line;
	if ( arg ) {
		file = arg->h.file;
		line = arg->h.line;
	}
	else {
		file = 0;
		line = 0;
	}
	if ( get_type(arg) != XLT_PAIR )
		goto unknown_func;
	sym = car(arg);
	if ( get_type(sym) != XLT_SYMBOL )
		goto unknown_func;
	func = sym->symbol.data;
	goto ok;
unknown_func:
	func = l_string(std_cm,"VObject Func");
ok:
	switch (err.code) {
	  case V_ER_PARAM:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj invalid param"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));

	  case V_ER_CANT_SET:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj can't set"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));

	  case V_ER_MAX_CHILDREN:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj max children"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));

	  case V_ER_NOT_FOUND:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj not found"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));

	  case V_ER_ALREADY:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj already"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));

	  case V_ER_DESTROYED:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj destroyed"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));

	  case V_ER_PARENT:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj invalid parent"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));
	
	  case V_ER_NO_DISPLAY:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj no display"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));
			
	  case V_ER_NOT_READY:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj not ready"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));
			
	  case V_ER_NOT_SUPPORT:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj not supported"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));
			
	  case V_ER_INVALID_MODE:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj invalid mode"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));
			
	  case V_ER_FLAGS_CONBINATION:
		return get_error(
			file,
			line,
			XLE_PROTO_INV_PARAM,
			func,
			List(n_get_string("vobj flags combination"),
				get_ex_flags_pos(err.subcode1,"non execute flags"),
				get_ex_flags_pos(err.subcode2,"error flag"),
				-1));
			
	  case V_ER_NO_ERR:
		return 0;
	  default:
	  	er_panic("UNDEF V_ER\n");
	}
	return 0;
}

// -------- V_MODKEY_XXX <-- L_CHAR --------

char
v_modkey_by_name(L_CHAR *lname)
{
#define MODKEY_CVT(n) if ( strstr(name, #n) ) ret |= V_MODKEY_##n

	char *name = n_string(std_cm, lname);
	char ret = 0;
	
	MODKEY_CVT(SHIFT);
	MODKEY_CVT(CAPS);
	MODKEY_CVT(ALT);
	MODKEY_CVT(CTRL);
	MODKEY_CVT(META);
	
	return ret;
}

// ========================================================= 
//   Convert status <==> XL_SEXP
// =========================================================


// -------- VObjectList --> XL_SEXP --------
XL_SEXP *
vobj_get_children_list(VObjectList *list)
{
	VObjectStatus sts;
	XL_SEXP *children = 0;
	gc_push(0,0,"vobj_get_children_list");
	for (  ; list ; list = list->next ) {
		list->object->get_status(&sts, VSF_ID);
		children = cons(get_integer(sts.id ,0), children);
	}
	XL_SEXP *ret = 0;
	for ( ; get_type(children) ; children = cdr(children) ) // inverse
		ret = cons(car(children), ret);
	gc_pop(ret, (void(*)())gc_gb_sexp);
	return ret;
}


// -------- VObjectStatus --> XL_SEXP --------
XL_SEXP *
vobj_get_status_list(VObjectStatus *s, int flags)
{
	XL_SEXP *ret = 0;
	char buffer[32];

#define ITOA(a) (sprintf(buffer,"%d",a),buffer)
#define SIZETOA(a) (sprintf(buffer,"%d,%d",a.w,a.h),buffer)
#define POINTTOA(a) (sprintf(buffer,"%d,%d",a.x,a.y),buffer)

#define INSERT_STS(attr,flag,sexp) \
	if ( flags & flag )	\
		ret = cons(List(n_get_symbol(#attr),sexp,-1),ret)

#define INSERT_STS_I(attr,flag) INSERT_STS(attr,flag,get_integer(s->attr,0))
#define INSERT_STS_LC(attr,flag) INSERT_STS(attr,flag,get_string((L_CHAR*)s->attr))
#define INSERT_STS_ALIGN(attr,flag,v) INSERT_STS(attr,flag,get_string(vobj_get_align_name(s->attr,v)))
#define INSERT_STS_FUNC(attr,a,flag) INSERT_STS(attr,flag,s->attr==vobj_callback_glue?get_string((L_CHAR*)(s->a)):n_get_string(""))
#define INSERT_STS_SIZE(attr,flag) {	\
	INSERT_STS(attr,flag,n_get_string(SIZETOA(s->attr)));	\
	INSERT_STS(attr.w,flag,get_integer(s->attr.w,0));	\
	INSERT_STS(attr.h,flag,get_integer(s->attr.h,0));	}
#define INSERT_STS_POINT(attr,flag) {	\
	INSERT_STS(attr,flag,n_get_string(POINTTOA(s->attr)));	\
	INSERT_STS(attr.x,flag,get_integer(s->attr.x,0));	\
	INSERT_STS(attr.y,flag,get_integer(s->attr.y,0));	}


	INSERT_STS(parent, VSF_PARENT, get_integer(s->id, 0));
	INSERT_STS(children, VSF_CHILDREN, vobj_get_children_list(s->children));

	INSERT_STS_I(id, VSF_ID);
	INSERT_STS_I(attr, VSF_ATTR);
	INSERT_STS_I(value, VSF_VALUE);
	L_CHAR a = 0;
	INSERT_STS(ws, VSF_WS, s->ws?get_string(s->ws->stylename):get_string(&a));
	INSERT_STS_I(fsize, VSF_FSIZE);
	INSERT_STS_LC(descriptor, VSF_DESC);
	INSERT_STS_I(vert_desc, VSF_VERTD);
	INSERT_STS_I(visible, VSF_VISIBLE);
	INSERT_STS_I(enabled, VSF_ENABLED);
	INSERT_STS_I(homogeneous, VSF_HOMOGEN);
	INSERT_STS_SIZE(spacing, VSF_SPACING);
	INSERT_STS_ALIGN(alignh, VSF_ALIGN, false);
	INSERT_STS_ALIGN(alignv, VSF_ALIGN, true);
	INSERT_STS_SIZE(padding, VSF_PADDING);
	//INSERT_STS(cursor, VSF_CURSOR);
	INSERT_STS_FUNC(value_event_handler, value_eh_arg, VSF_VALUE_EH);
	INSERT_STS_FUNC(descriptor_event_handler, desc_eh_arg, VSF_DESC_EH);
	INSERT_STS_FUNC(destroy_handler, destroy_h_arg, VSF_DESTROY_H);

	INSERT_STS_SIZE(min_size, VSF_MIN_SIZE);
	INSERT_STS_SIZE(size, VSF_SIZE);
	INSERT_STS_POINT(position, VSF_POSITION);
	
	if ( ret != 0 )
		ret = cons(n_get_symbol("status"), ret);
	return ret;
}


// -------- VObjectStatus <-- SYM_FIELD --------


void
get_sf_v(L_CHAR** env,L_CHAR** func,L_CHAR * v)
{
L_CHAR * p,* q;
	if ( v[0] == 'e' ) {
		*env = q = ll_copy_str(&v[2]);
		for ( p = q ; *p && *p != '/' ; p ++ );
		if ( *p ) {
			*p = 0;
			p ++;
			*func = q = ll_copy_str(p);
		}
		else {
			*func = 0;
		}
	}
	else {
		*env = 0;
	}
}

VSysArgTranslator *
get_vsat(XLISP_ENV * arg_env,L_CHAR * v)
{
	if ( v[0] == 0 )	return 0;
	else if ( (v[0] == 'e' || v[0] == 'c') && v[1] == '/' ) {
	VSysArgTranslator * vsat;
	XL_SEXP * _e;
	XLISP_ENV * _ee;
	L_CHAR * sf_env,* sf_func;
		get_sf_v(&sf_env,&sf_func,v);
		if ( sf_env ) {
			_e = eval(arg_env,get_symbol(sf_env));
			if ( get_type(_e) != XLT_ENV )	
				_ee = arg_env;
			else	_ee = _e->env.data;
			d_f_ree(sf_env);
		}
		else	_ee = arg_env;
		if ( sf_func == 0 )
			sf_func = nl_copy_str(std_cm,"get_vsat");
		vsat = (VSysArgTranslator*)d_alloc(sizeof(*vsat));
		memset(vsat,0,sizeof(*vsat));
		vsat->env = _ee;
		vsat->func = sf_func;
		return vsat;
	}
	else	return 0;
}

int
get_sts_from_sf(XLISP_ENV * arg_env,VObjectStatus *s,int flags, XL_SYM_FIELD *sf, VObject::FreeList **free_list)
{
	L_CHAR *v;
	int ah,av;
	
	int f = 0;
	
#define GET_ATTR(value)	get_sf_attribute(sf, l_string(std_cm, #value))
#define GET_I(c)	atoi(n_string(std_cm, c))

#define GET_ATTR_AND_SET(value,flag)	\
	if ( ( v = GET_ATTR(value) ) ) s->value = v, f |= flag
#define GET_ATTR_AND_SET_I(value,flag)	\
	if ( ( v = GET_ATTR(value) ) ) s->value = GET_I(v), f |= flag
#define GET_ATTR_AND_SET_SIZE(value,flag) {	\
	s->value.w = s->value.h = V_DEFAULT_SIZE;	\
	GET_ATTR_AND_SET_I(value.w, flag);	\
	GET_ATTR_AND_SET_I(value.h, flag);	\
	if ( ( v = GET_ATTR(value) ) )	\
		(sscanf(n_string(std_cm,v),"%hd,%hd", &s->value.w, &s->value.h) == 1 ?	\
			s->value.h = s->value.w : 0) , f |= flag;	}
#define GET_ATTR_AND_SET_POINT(value,flag)	{\
	s->value.x = s->value.y = V_DEFAULT_POS;	\
	GET_ATTR_AND_SET_I(value.x, flag);	\
	GET_ATTR_AND_SET_I(value.y, flag);	\
	if ( ( v = GET_ATTR(value) ) )	\
		(sscanf(n_string(std_cm,v),"%hd,%hd", &s->value.x, &s->value.y) == 1 ?	\
			s->value.x = s->value.y : 0), f |= flag;	}

#define GET_ATTR_AND_SET_HANDLER(value,arg,flag)	\
	if ( (v = GET_ATTR(value)) ) {	\
		if ( v[0] == 0 )	s->value = 0;	\
		else if ( (v[0] == 'e' || v[0] == 'c') && v[1] == '/' ) {	\
		VSysArgTranslator * vsat;					\
		XL_SEXP * _e;							\
		XLISP_ENV * _ee;						\
		L_CHAR * sf_env,* sf_func;					\
			get_sf_v(&sf_env,&sf_func,v);				\
			if ( sf_env ) {						\
				_e = eval(arg_env,get_symbol(sf_env));		\
				if ( get_type(_e) != XLT_ENV )			\
					_ee = arg_env;				\
				else	_ee = _e->env.data;			\
				d_f_ree(sf_env);				\
			}							\
			else	_ee = arg_env;					\
			if ( sf_func == 0 )					\
				sf_func = nl_copy_str(std_cm,#value);		\
			vsat = (VSysArgTranslator*)d_alloc(sizeof(*vsat));	\
			memset(vsat,0,sizeof(*vsat));				\
			vsat->env = _ee;					\
			vsat->func = sf_func;					\
			s->value = vobj_callback_glue;				\
			s->arg = vsat;						\
			VObject::FreeList * list = new VObject::FreeList;	\
			list->target = s->arg;					\
			list->next = *free_list;				\
			list->free_func = free_VSysArgTranslator;		\
			insert_vsat_list(vsat);					\
			*free_list = list;					\
		}								\
		else {	s->value = vobj_callback_glue;	\
				s->arg = ll_copy_str(v);	\
				VObject::FreeList *list = new VObject::FreeList;	\
				list->free_func = 0;			\
				list->target = s->arg, list->next = *free_list;	\
				*free_list = list; }	\
		f |= flag;							\
	}

	*free_list = 0;

	GET_ATTR_AND_SET_I(value, VSF_VALUE);

	if ( (v = GET_ATTR(ws)) )
		s->ws = get_ws(v), f |= VSF_WS;
	GET_ATTR_AND_SET_I(fsize, VSF_FSIZE);
	GET_ATTR_AND_SET(descriptor, VSF_DESC);
	GET_ATTR_AND_SET_I(vert_desc, VSF_VERTD);

	GET_ATTR_AND_SET_I(visible, VSF_VISIBLE);
	GET_ATTR_AND_SET_I(enabled, VSF_ENABLED);
		
	GET_ATTR_AND_SET_I(homogeneous, VSF_HOMOGEN);
	GET_ATTR_AND_SET_SIZE(spacing, VSF_SPACING);

	if ( (flags & VSF_ALIGN) == 0 )
		s->alignv = s->alignh = VALIGN_EXPAND;
	if ( (v = GET_ATTR(alignv)) ) {
		av = 1;
		s->alignv = vobj_get_align_by_name(v), f |= VSF_ALIGN;
	}
	else	av = 0;
	if ( (v = GET_ATTR(alignh)) ) {
		ah = 1;
		s->alignh = vobj_get_align_by_name(v), f |= VSF_ALIGN;
	}
	else	ah = 0;
	if ( (flags & VSF_ALIGN) == 0 ) {
		if ( av == 0 )
			s->alignv = VALIGN_EXPAND;
		if ( ah == 0 )
			s->alignh = VALIGN_EXPAND;
	}
		
	GET_ATTR_AND_SET_SIZE(padding, VSF_PADDING);
	// cursor ?
	
	GET_ATTR_AND_SET_HANDLER(value_event_handler, value_eh_arg, VSF_VALUE_EH);
	GET_ATTR_AND_SET_HANDLER(descriptor_event_handler, desc_eh_arg, VSF_DESC_EH);
	GET_ATTR_AND_SET_HANDLER(destroy_handler, destroy_h_arg, VSF_DESTROY_H);

	GET_ATTR_AND_SET_SIZE(min_size, VSF_MIN_SIZE);
	GET_ATTR_AND_SET_SIZE(size, VSF_SIZE);
	GET_ATTR_AND_SET_POINT(position, VSF_POSITION);

	return f|flags;
}


// =================================================
//   create window structure
// =================================================


void
vobj_delete_children(XLISP_ENV * env,VObject * obj)
{
VObjectStatus _sts,_sts2;
VObject * o;
int len,i;
int * id_list;
VObjectList * ol;
XL_SEXP * obj_list,* ret_o_list, * t,* _id;
	obj->get_status(&_sts,VSF_CHILDREN);
	len = 0;
	for ( ol = _sts.children ; ol ; ol = ol->next , len ++ );
	id_list = (int*)d_alloc(sizeof(int)*len);
	i = 0;
	for ( ; _sts.children ; ) {
		o = _sts.children->object;
		vobject_list_remove(_sts.children,0,
				&_sts.children);
		o->get_status(&_sts2,VSF_ID);
		id_list[i++] = _sts2.id;
		o->destroy();
	}
	if ( env == 0 )
		goto end;
	obj_list = eval(env,n_get_symbol("__object_list"));
	if ( get_type(obj_list) == XLT_ERROR )
		goto end;
	ret_o_list = 0;
	for ( ; get_type(obj_list) == XLT_PAIR ; obj_list = cdr(obj_list) ) {
		t = car(obj_list);
		_id = get_el(t,1);
		if ( get_type(_id) != XLT_INTEGER )
			continue;
		for ( i = 0 ; i < len ; i ++ ) {
			if ( _id->integer.data == id_list[i] )
				goto ok;
		}
		ret_o_list = cons(t,ret_o_list);
		continue;
	ok:
		continue;
	}
	set_op(env,n_get_symbol("__object_list"),ret_o_list);
end:
	d_f_ree(id_list);
	return;
}

XL_SEXP *
vobj_eval_child(int parent, XLISP_ENV *env, XL_SEXP *arg)
{
	XL_SEXP *child, *ret;
	XL_SEXP * list, * wlist;
	L_CHAR *func = 0;
	
	gc_push(0,0,"vobj_eval_child");

	list = 0;
	if ( get_type(car(arg)) == XLT_SYMBOL )
		func = car(arg)->symbol.data;

	XLISP_ENV *nenv = new_env(env);
	if ( parent )
		set_env(nenv,l_string(std_cm,"__parent"), get_integer(parent, 0));

	wlist = eval(env,n_get_symbol("__object_list"));
	if ( get_type(wlist) == XLT_ERROR )
		wlist = 0;
	for ( arg = cdr(arg) ; get_type(arg) == XLT_PAIR ; arg = cdr(arg) ) {
		set_env(nenv,l_string(std_cm,"__object_list"), wlist);
		child = car(arg);
		if ( get_type(child) != XLT_PAIR )
			goto type_missmatch;
		ret = eval(nenv,child);
		switch ( get_type(ret) ) {
		case XLT_ERROR:
			gc_pop(ret,(void(*)())gc_gb_sexp);
			return ret;
		case XLT_PAIR:
			list = append(list,ret);
			wlist = append(wlist,ret);
			break;
		default:
			break;
		}
	}
	gc_pop(list,(void(*)())gc_gb_sexp);
	return list;
	
type_missmatch:
	gc_pop(0,0);
	return get_error(
		arg->h.file,
		arg->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		func,
		List(n_get_string("type missmatch"),
			child,
			-1));
}

XL_SEXP *
vobj_get_id_list(int id, XL_SEXP *children, XL_SYM_FIELD *sf,int flags)
{
	L_CHAR *vname = get_sf_attribute(sf, l_string(std_cm, "name"));
	XL_SEXP *ret;
	if ( vname )
		ret = cons(
			List(get_symbol(vname), get_integer(id, 0), 
				get_integer(flags,0), -1),
			children);
	else
		ret = cons(
			List(n_get_symbol("id"), get_integer(id, 0),
				get_integer(flags,0), -1),
			children);
	return ret;
}


int
get_default_sts_from_symbol(XLISP_ENV * env,VObjectStatus * sts,
	VObject::FreeList ** fl)
{
XL_SEXP * _sts;
	_sts = eval(env,n_get_symbol("VObjectStatus"));
	if ( get_type(_sts) != XLT_SYMBOL )
		return 0;
	return get_sts_from_sf(env,sts,0,_sts->symbol.field,fl);
}

char * get_num(int * d,char * ptr)
{
	*d = 0;
	for ( ; ; ptr ++) {
		if ( '0' <= *ptr && *ptr <= '9' )
			*d = (*d)*10 + (*ptr) - '0';
		else break;
	}
	return ptr;
}

VRect
get_elr_1(char * data)
{
char * buf;
char * p1,* p2;
int d[4];
int dp;
char ret;
VRect r;
	dp = 0;
	buf = copy_str(data);
	for ( p1 = buf ; dp < 4 ; ) {
		p2 = p1;
		for ( ; *p2 && *p2 != ',' ; p2 ++ );
		ret = *p2;
		*p2 = 0;
		d[dp++] = atoi(p1);
		if ( ret == 0 )
			break;
		p1 = p2 + 1;
	}
	r.l = d[0];
	r.t = d[1];
	r.r = d[2];
	r.b = d[3];
	return r;
}


char *
_get_elr_2(int * vp,int * hp,char * data)
{
int * pp;
int d;
	switch ( *data ) {
	case 'v':
		pp = vp;
		break;
	case 'h':
		pp = hp;
		break;
	default:
		*vp = *hp = 1;
		return 0;
	}
	d = 0;
	data ++;
	for ( ; ; data ++ ) {
		if ( '0' <= *data &&
				*data <= '9' )
			d = 10*d + (*data) - '0';
		else 	break;
	}
	*pp = d;
	return data;
}

VRect
get_elr_2(char * data,VImage * img)
{
int v,h,ptr_v,ptr_h;
VRect ret;
int wp,hp;
	ptr_v = ptr_h = 0;
	v = h = 1;
	for ( ; data && *data && *data != '.' ; ) {
		data = _get_elr_2(&v,&h,data);
	}
	if ( *data != '.' )
		goto end;
	for ( ; data && *data ; ) {
		data = _get_elr_2(&ptr_v,&ptr_h,data);
	}
end:
	if ( ptr_v >= v )
		ptr_v = v-1;
	if ( ptr_h >= h )
		ptr_h = h-1;
	wp = img->size.w / h;
	hp = img->size.h / v;
	ret.l = wp * ptr_h;
	ret.r = wp * (ptr_h+1);
	ret.t = hp * ptr_v;
	ret.b = hp * (ptr_v+1);
	return ret;
}

VRect
get_elr(char * data,VImage * img)
{
	if ( data[0] == 'v' || data[0] == 'h' )
		return get_elr_2(data,img);
	else	return get_elr_1(data);
}

VRect
get_elr_spot(VSize size,int v,int h,int ptr_v,int ptr_h)
{
VRect ret;
int wp,hp;
	if ( ptr_v >= v )
		ptr_v = v-1;
	if ( ptr_h >= h )
		ptr_h = h-1;
	wp = size.w / h;
	hp = size.h / v;
	ret.l = wp * ptr_h;
	ret.r = wp * (ptr_h+1);
	ret.t = hp * ptr_v;
	ret.b = hp * (ptr_v+1);
	return ret;
}

void
get_elr_ary(VRect * elr,char * data,VImage * img)
{
int v,h;
char first;
int _v,_h;
	first = *data;
	v = h = 1;
	for ( ; data && *data ; ) {
		data = _get_elr_2(&v,&h,data);
	}
	if ( first == 'v' ) {
		for ( _h = 0 ; _h < h ; _h ++ )
			for ( _v = 0 ; _v < v ; _v ++ )
				*elr++ = get_elr_spot(img->size,v,h,_v,_h);
	}
	else {
		for ( _v = 0 ; _v < v ; _v ++ )
			for ( _h = 0 ; _h < h ; _h ++ )
				*elr++ = get_elr_spot(img->size,v,h,_v,_h);
	}
}

} // extern "C"
