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

int lock_pdb_lock_p;
extern int  res_lock_p;

extern RESOURCE ** res_entry_hash_table;

extern SEM res_lock;
XL_SEXP * xl_gv_resource();
XL_SEXP * xl_gv_new_resource();
XL_SEXP * xl_gv_set_status();
XL_SEXP * xl_gv_get_bib();
XL_SEXP * xl_note();
XL_SEXP * xl_gv_get_notes();

extern char status_msg_table[][STS_MSG_TBL_LENGTH];


XLISP_ENV * gv_env[RID_SP_MAX];
XLISP_ENV * gv_resource_env[RT_MAX];
XL_SEXP * xl_gv_resource_status();
XL_SEXP * xl_gv_get_resource();
extern GV_FUNC gv_new_table[RT_MAX];

void
init_gv_resource(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"gv-resource"),
		get_func_prim(xl_gv_resource,FO_NORMAL,0,1,-1));
	set_env(env,l_string(std_cm,"gv-new-resource"),
		get_func_prim(xl_gv_new_resource,FO_APPLICATIVE,0,5,5));
	set_env(env,l_string(std_cm,"gv-status"),
		get_func_prim(xl_gv_resource_status,
			FO_APPLICATIVE,0,1,1));
	set_env(env,l_string(std_cm,"gv-get-resource"),
		get_func_prim(xl_gv_get_resource,
			FO_APPLICATIVE,0,2,2));
	set_env(env,l_string(std_cm,"gv-set-status"),
		get_func_prim(xl_gv_set_status,
			FO_APPLICATIVE,0,1,1));
	set_env(env,l_string(std_cm,"gv-get-bib"),
		get_func_prim(xl_gv_get_bib,
			FO_APPLICATIVE,0,4,4));
	set_env(env,l_string(std_cm,"note"),
		get_func_prim(xl_note,FO_APPLICATIVE,0,1,1));
	set_env(env,l_string(std_cm,"gv-get-notes"),
		get_func_prim(xl_gv_get_notes,FO_APPLICATIVE,0,1,1));
}


void
set_note(
	RESOURCE * r,
	int type,
	L_CHAR * img,
	int fill_color,
	int line_color,
	L_CHAR * data,
	L_CHAR * url)
{
NOTE * n;

	n = d_alloc(sizeof(*n));
	n->type = type;
	if ( img )
		n->img = ll_copy_str(img);
	else	n->img = 0;
	n->fill_color = fill_color;
	n->line_color = line_color;
	n->data = ll_copy_str(data);
	if ( url )
		n->url = ll_copy_str(url);
	else	n->url = 0;

	n->next = r->h.notes;
	r->h.notes = n;
}


void
gc_gv_resource()
{
int i;
RESOURCE * r;

	for ( i = 0; i < RID_SP_MAX ; i ++ )
		gc_gblisp_env(gv_env[i]);
	for ( i = 0 ; i < RT_MAX ; i ++ )
		gc_gblisp_env(gv_resource_env[i]);
	if ( res_entry_hash_table == 0 )
		return;
	for ( i = 0 ; i < RES_HASH_SIZE ; i ++ ) {
		r = res_entry_hash_table[i];
		for ( ; r ; r = r->h.entry_next ) {
			gc_gb_sexp(r->h.meta);
			gc_gb_sexp(r->h.incremental_error);
			gc_gb_sexp(r->h.initial_error);
			gc_gb_sexp(r->h.data);
			switch ( r->h.type ) {
			case RT_DRAW_GB:
				gc_gv_draw(r);
				break;
			case RT_COORDINATE:
				gc_gv_coordinate(r);
				break;
			}
		}
	}
}


void
gc_gv_resource_onlock()
{
int i;
RESOURCE * r;
	if ( res_entry_hash_table == 0 )
		return;
	lock_task(res_lock);
	for ( i = 0 ; i < RES_HASH_SIZE ; i ++ ) {
		r = res_entry_hash_table[i];
		for ( ; r ; r = r->h.entry_next ) {
			if ( r->h.type != RT_DRAW_GB )
				continue;
			if ( r->draw_gb.pdb_lock_gc_flag )
				continue;
			r->draw_gb.pdb_lock_gc_flag = 1;
			unlock_task(res_lock,"gc_gv_resource_onlock");
			lock_pdb_lock(r,0);
			lock_task(res_lock);
		}
	}
	unlock_task(res_lock,"gc_gv_resource_onlock");
}

int
gc_gv_resource_clock()
{
RESOURCE * r;
int i;
	if ( res_entry_hash_table == 0 )
		return 0;
	lock_task(res_lock);
	for ( i = 0 ; i < RES_HASH_SIZE ; i ++ ) {
		r = res_entry_hash_table[i];
		for ( ; r ; r = r->h.entry_next ) {
			if ( r->h.type != RT_DRAW_GB )
				continue;
			if ( r->draw_gb.pdb_lock_gc_flag )
				continue;
			unlock_task(res_lock,"gc_gv_resource_lock");
			return -1;
		}
	}
	return 0;
}

void
gc_gv_resource_unlock()
{
int i;
RESOURCE * r;

	if ( res_entry_hash_table == 0 )
		return;
	for ( i = 0 ; i < RES_HASH_SIZE ; i ++ ) {
		r = res_entry_hash_table[i];
		for ( ; r ; r = r->h.entry_next ) {
			if ( r->h.type != RT_DRAW_GB )
				continue;
			if ( r->draw_gb.pdb_lock_gc_flag == 0 )
				continue;
			r->draw_gb.pdb_lock_gc_flag = 0;
			unlock_task(res_lock,"gc_gv_resource_unlock");

			unlock_pdb_lock(r);

			lock_task(res_lock);
		}
	}
	unlock_task(res_lock,"gc_gv_resource_unlock");
}

void
set_gv_sp_resource(int id,XLISP_ENV * env)
{
	if ( id >= RID_SP_MAX )
		return;
	gv_env[id] = env;
}

void
set_gv_resource(int id,XLISP_ENV * env)
{
	gv_resource_env[id] = env;
}

void
call_gv_event(int rno,L_CHAR * msg)
{
int cat;
XLISP_ENV * env;
XL_SEXP * ret;

	cat = rno>>16;
	if ( cat == RIDC_SPECIAL )
		env = gv_env[rno];
	else 	env = gv_resource_env[cat];
	if ( env == 0 )
		env = gblisp_top_env0;
	gc_push(0,0,"call_gv_event");
	ret = eval(env,List(
		get_symbol(l_string(std_cm,"gv-event")),
		get_integer(rno,0),
		get_string(msg),
		-1));
	gc_pop(0,0);
}

XL_SEXP *
xl_gv_resource(XLISP_ENV * env,XL_SEXP * s,
		XLISP_ENV * a_env,XL_SYM_FIELD * sf)
{
XL_SEXP * ret;
RESOURCE * _res;
XLISP_ENV * _env, * ep, * eval_env;
int rid;
L_CHAR * _rid,* _type;
int type;

	_rid = get_sf_attribute(sf,l_string(std_cm,"rid"));
	_type = get_sf_attribute(sf,l_string(std_cm,"type"));
	if ( _rid )
		sscanf(n_string(std_cm,_rid),"%i",&rid);
	else	rid = 0;
	if ( _type ) {
		if ( l_strcmp(_type,l_string(std_cm,"raw")) == 0 )
			type = 1;
		else	type = 0;
	}
	else	type = 0;
	if ( rid < RID_SPECIAL_S )
		goto undef_resource;
	else if ( rid < RID_SP_MAX ) {
		_res = 0;
		_env = gv_env[rid];
		if ( _env == 0 )
			goto undef_resource;
	}
	else if ( rid < RID_SPECIAL_E )
		goto undef_resource;
	else {
		_res = search_resource_by_no(rid);
		if ( _res == 0 )
			goto undef_resource;
		_env = gv_resource_env[_res->h.type];
	}
	if ( type == 1 ) {
		eval_env = _env;
	}
	else {
		ep = new_env_pair(_env,env);
		eval_env = new_env(ep);
	}
	if ( _res )
		set_env(eval_env,l_string(std_cm,"__resource"),
			get_ptr(_res,0));
	s = cdr(s);
	ret = 0;
	for ( ; get_type(s) ; s = cdr(s) ) {
		if ( get_type(s) == XLT_ERROR )
			return s;
		if ( get_type(car(s)) == XLT_ERROR )
			return car(s);
		ret = eval(eval_env,car(s));
		if ( get_type(ret) == XLT_ERROR )
			return ret;
	}
	return ret;
undef_resource:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_UNDEF_RESOURCE,
		l_string(std_cm,"gv-resource"),
		n_get_string("undefined resource"));
}




XL_SEXP * get_resource_element(RESOURCE * r)
{
XL_SEXP * ret, * rec;
	ret = 0;
	rec = List(
		get_symbol(l_string(std_cm,"target-URI")),
		get_string(get_url_str2(&r->h.target)),
		-1);
	ret = cons(rec,ret);
	rec = List(
		get_symbol(l_string(std_cm,"entry-URI")),
		get_string(get_url_str2(&r->h.entry)),
		-1);
	ret = cons(rec,ret);
	rec = List(
		get_symbol(l_string(std_cm,"rid")),
		get_integer(r->h.no,0),
		-1);
	ret = cons(rec,ret);
	return ret;
}

BIB_LIST *
insert_bib_list(BIB_LIST * root,BIB_LIST * bl)
{
BIB_LIST ** blp;
	for ( blp = &root ; *blp ; blp = &(*blp)->next ){
		if ( (*blp)->inherit < bl->inherit )
			continue;
		if ( (*blp)->inherit > bl->inherit )
			goto next;
		switch ( l_strcmp((*blp)->namespace,
				bl->namespace) ) {
		case -1:
			continue;
		case 0:
			break;
		case 1:
			goto next;
		}
		switch ( l_strcmp((*blp)->qualifier,
				bl->qualifier) ) {
		case -1:
			continue;
		case 0:
			break;
		case 1:
			goto next;
		}
		switch ( l_strcmp((*blp)->type,
				bl->type) ) {
		case -1:
			continue;
		case 0:
			break;
		case 1:
			goto next;
		}
		switch ( l_strcmp((*blp)->data,
				bl->data) ) {
		case -1:
			continue;
		case 0:
			goto next;
		case 1:
			goto next;
		}
	}
next:
	bl->next = *blp;
	*blp = bl;
	return root;
}

void
set_bib_qualifier();

void
new_qualifier(
	RESOURCE * r,
	int inh,
	L_CHAR * q,
	L_CHAR * ns,
	XL_SYM_FIELD * sf)
{
BIB_LIST * bl;
L_CHAR * qq;
L_CHAR * dt;
BIB_LIST ** blp;

	bl = d_alloc(sizeof(*bl));
	bl->inherit = inh;
	bl->namespace = ll_copy_str(ns);
	for ( qq = q ; ; qq ++ ) {
		switch ( *qq ) {
		case 0:
			qq = q;
			break;
		case ':':
			qq ++;
			break;
		default:
			continue;
		}
		break;
	}
	bl->qualifier = ll_copy_str(qq);
	dt = get_sf_attribute(sf,l_string(std_cm,"type"));
	if ( dt == 0 )
		bl->type = nl_copy_str(std_cm,"text");
	else	bl->type = ll_copy_str(dt);
	dt = get_sf_attribute(sf,l_string(std_cm,"data"));
	if ( dt == 0 )
		bl->data = nl_copy_str(std_cm,"");
	else	bl->data = ll_copy_str(dt);
	r->h.bib = insert_bib_list(r->h.bib,bl);
}

void
bib_inheritance(RESOURCE * r,XL_SEXP * b,XL_SEXP * sym,
	XL_SYM_FIELD * ns_sf)
{
L_CHAR * n;
int no;
	n = get_sf_attribute(sym->symbol.field,l_string(std_cm,"no"));
	if ( n == 0 )
		return;
	sscanf(n_string(std_cm,n),"%i",&no);
	set_bib_qualifier(r,no,b,ns_sf);
}

void
free_bib_list(BIB_LIST * bl)
{
BIB_LIST * bl2;
	for ( ; bl ; ) {
		bl2 = bl->next;
		d_f_ree(bl->namespace);
		d_f_ree(bl->qualifier);
		d_f_ree(bl->type);
		d_f_ree(bl->data);
		d_f_ree(bl);
		bl = bl2;
	}
}

BIB_LIST *
copy_bib_list(BIB_LIST * bl)
{
BIB_LIST * ret, ** blp;
BIB_LIST * bl2;
	ret = 0;
	blp = &ret;
	for ( ; bl ; ) {
		bl2 = d_alloc(sizeof(*bl));
		bl2->namespace = ll_copy_str(bl->namespace);
		bl2->inherit = bl->inherit;
		bl2->qualifier = ll_copy_str(bl->qualifier);
		bl2->type = ll_copy_str(bl->type);
		bl2->data = ll_copy_str(bl->data);
		bl2->next = 0;
		*blp = bl2;
		blp = &(*blp)->next;
		bl = bl->next;
	}
	return ret;
}

BIB_LIST *
search_bib_list(BIB_LIST * bl,
	L_CHAR * namespace,int inherit,L_CHAR * qualifier)
{
	for ( ; bl ; bl = bl->next ) {
		if ( namespace && l_strcmp(bl->namespace,namespace) )
			continue;
		if ( inherit >= 0 && bl->inherit != inherit )
			continue;
		if ( qualifier && l_strcmp(bl->qualifier,qualifier) )
			continue;
		return bl;
	}
	return 0;
}

int
cmp_bib_list(BIB_LIST * b1,BIB_LIST * b2)
{
int ret;
	for ( ; b1 && b2 ; b1 = b1->next , b2 = b2->next ) {
		ret = l_strcmp(b1->namespace,b2->namespace);
		if ( ret )
			return ret;
		if ( b1->inherit < b2->inherit )
			return -1;
		if ( b1->inherit > b2->inherit )
			return 1;
		ret = l_strcmp(b1->qualifier,b2->qualifier);
		if ( ret )
			return ret;
		ret = l_strcmp(b1->type,b2->type);
		if ( ret )
			return ret;
		ret = l_strcmp(b1->data,b2->data);
		if ( ret )
			return ret;
	}
	if ( b1 == 0 && b2 == 0 )
		return 0;
	if ( b1 == 0 )
		return -1;
	return 1;
}

L_CHAR *
get_ns(XL_SYM_FIELD * ns_sf,L_CHAR * sym)
{
L_CHAR * dt;
L_CHAR * qq;

	dt = ll_copy_str(sym);
	for ( qq = dt ; ; qq ++ ) {
		switch ( *qq ) {
		case 0:
			return l_string(std_cm,"");
		case ':':
			*qq = 0;
			break;
		default:
			continue;
		}
		break;
	}
	for ( ; ns_sf ; ns_sf = ns_sf->next ) {
		if ( memcmp(ns_sf->name,l_string(std_cm,"xmlns:"),
				6*sizeof(L_CHAR)) )
			continue;
		if ( l_strcmp(&ns_sf->name[6],dt) )
			continue;
		return ns_sf->data;
	}
	return l_string(std_cm,"err");
}

void
set_bib_qualifier(RESOURCE * r,int inh,XL_SEXP * b,XL_SYM_FIELD * ns_sf)
{
XL_SEXP * value, * sym;
L_CHAR * ns;

	b = cdr(b);
	for ( ; get_type(b) ; b = cdr(b) ) {
		value = car(b);
		if ( get_type(value) != XLT_PAIR )
			continue;
		sym = car(value);
		if ( get_type(sym) != XLT_SYMBOL )
			continue;
		if ( l_strcmp(sym->symbol.data,
			l_string(std_cm,"inheritance")) == 0 ) {

//			bib_inheritance(r,b,sym,ns_sf);

			bib_inheritance(r,value,sym,ns_sf);
		}
		ns = get_ns(ns_sf,sym->symbol.data);
		if ( ns == 0 )
			continue;
		new_qualifier(r,inh,sym->symbol.data,
				ns,sym->symbol.field);
	}
}

void
set_bib(RESOURCE * r,XL_SEXP * meta)
{
XL_SYM_FIELD * sf;
XL_SEXP * bib,* b, * sym;
	for ( bib = meta ; get_type(bib) ; bib = cdr(bib) ) {
		b = car(bib);
		if ( get_type(b) != XLT_PAIR )
			continue;
		sym = car(b);
		if ( get_type(sym) != XLT_SYMBOL )
			continue;
		if ( l_strcmp(sym->symbol.data,l_string(std_cm,"bib"))
				== 0 )
			goto ok;
	}
	return;
ok:
	sf = sym->symbol.field;
	set_bib_qualifier(r,0,b,sf);
}

XL_SEXP *
get_bib_data(RESOURCE * r,L_CHAR * ns,int inh,L_CHAR * q)
{
BIB_LIST * bl;
XL_SEXP * ret;
	ret = 0;
	for ( bl = r->h.bib ; bl ; bl = bl->next ) {
		if ( l_strcmp(bl->namespace,ns) )
			continue;
		if ( inh >= 0 && bl->inherit != inh )
			continue;
		if ( l_strcmp(bl->qualifier,q) )
			continue;
		ret = cons(
			List(
				get_string(bl->namespace),
				get_integer(bl->inherit,0),
				get_string(bl->qualifier),
				get_string(bl->type),
				get_string(bl->data),
				-1),
			ret);
	}
	return ret;
}


XL_SEXP *
xl_gv_get_bib(XLISP_ENV * e,XL_SEXP * s)
{
RESOURCE * r;
XL_SEXP * ret;
XL_SEXP * ns;
XL_SEXP * inh;
XL_SEXP * q;
L_CHAR * _ns;
int _inh;
L_CHAR * _q;
	r = get_resource_ptr(&ret,e,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	ns = get_el(s,1);
	if ( get_type(ns) != XLT_STRING )
		goto type_missmatch;
	_ns = ns->string.data;
	inh = get_el(s,2);
	if ( get_type(inh) != XLT_INTEGER )
		goto type_missmatch;
	_inh = inh->integer.data;
	q = get_el(s,3);
	if ( get_type(q) != XLT_STRING )
		goto type_missmatch;
	_q = q->string.data;
	return get_bib_data(r,_ns,_inh,_q);
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"gv-get-bib"),
		List(n_get_string("type missmatch"),
			-1));
}

XL_SEXP *
set_resource_header(RESOURCE * r,XL_SEXP * meta)
{
XL_SEXP * s, * rec, * tag;
int minrect_flag;
UNIT_ENV * uenv;
L_CHAR * f;
XL_SEXP * _mod;
XL_SEXP * ret;

	setup_c_unit(
		&r->h.cu,-1,f=ll_copy_str(get_url_str2(&r->h.entry)),
		meta,0);
	d_f_ree(f);

	minrect_flag = 0;
	for ( s = meta ; get_type(s) == XLT_PAIR ; s = cdr(s) ) {
		if ( get_type(s) != XLT_PAIR )
			break;
		rec = car(s);
		if ( get_type(rec) != XLT_PAIR )
			continue;
		tag = car(rec);
		if ( get_type(tag) != XLT_SYMBOL )
			continue;
		if ( l_strcmp(tag->symbol.data,l_string(std_cm,
				"mr")) == 0 ) {
			if ( list_length(rec) != 2 )
				return get_error(
					meta->h.file,
					meta->h.line,
					XLE_PROTO_INV_PARAM,
					l_string(std_cm,"gv-new-resource"),
				List(n_get_string("invalid mr element data"),
				     rec,
						-1));
			minrect_flag = 1;
			get_minrect(&r->h.cu,&r->h.minrect,get_el(rec,1));
		}
		if ( l_strcmp(tag->symbol.data,l_string(std_cm,
				"modify")) == 0 ) {
			_mod = get_el(rec,1);
			if ( get_type(_mod) == XLT_INTEGER )
				r->h.modify = _mod->integer.data;
		}
	}
	if ( minrect_flag == 0 ) {
		if ( meta )
			return get_error(
				meta->h.file,
				meta->h.line,
				XLE_SEMANTICS_REQ_SYMBOL,
				l_string(std_cm,"gv-new-resource"),
				List(n_get_string("mr tag element is required"),
					-1));
		else
			return get_error(
				0,
				0,
				XLE_SEMANTICS_REQ_SYMBOL,
				l_string(std_cm,"gv-new-resource"),
				List(n_get_string("mr tag element is required"),
					-1));
	}
	r->h.meta = meta;
	r->h.bib = 0;
	set_bib(r,meta);
	set_inc_status(r,RS_IDLE);
	set_init_status(r,RS_IDLE);
	return 0;
}


XL_SEXP *
xl_gv_new_resource(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
XL_SEXP * r_type;
XL_SEXP * entry;
XL_SEXP * target;
XL_SEXP * meta;
XL_SEXP * ret;
RESOURCE * r;
char * e_param;
URL u_entry,u;
int data_state;
	data_state = NR_NEW;
	for ( ; sf ; sf = sf->next ) {
		if ( l_strcmp(sf->name,l_string(std_cm,"state")) == 0 ) {
			if ( l_strcmp(sf->data,
				l_string(std_cm,"clear")) == 0 )
				data_state = NR_CLEAR;
			else if ( l_strcmp(sf->data,
				l_string(std_cm,"keep")) == 0 )
				data_state = NR_KEEP;
			else {
				e_param = "attribute state";
				goto param_error;
			}
		}
	}
	r_type = get_el(s,1);
	if ( get_type(r_type) != XLT_INTEGER ) {
		e_param = "1st";
		goto type_missmatch;
	}
	entry = get_el(s,2);
	if ( get_type(entry) != XLT_STRING ) {
		e_param = "2nd";
		goto type_missmatch;
	}
	target = get_el(s,3);
	if ( get_type(target) != XLT_STRING ) {
		e_param = "3nd";
		goto type_missmatch;
	}
	meta = get_el(s,4);
	if ( get_type(meta) != XLT_PAIR ) {
		e_param = "4th";
		goto type_missmatch;
	}
	get_url2(&u_entry,entry->string.data);
	if ( get_url_str2(&u_entry) == 0 ) {
		e_param = "entry URL(2nd)";
		goto param_error;
	}
	r = search_resource_by_entry(&u_entry);
	if ( r == 0 ) {
		r = new_resource_entry(r_type->integer.data,&u_entry);
		free_url(&u_entry);
		data_state = NR_NEW;
	}
	else {
		if ( data_state == NR_NEW )
			data_state = NR_KEEP;
		free_url(&u_entry);
	}
	get_url2(&u,target->string.data);
	if ( get_url_str2(&u) == 0 ) {
		e_param = "target URL (3rd)";
		goto param_error;
	}
	set_resource_target(r,&u);
	free_url(&u);
	ret = set_resource_header(r,meta);
	if ( get_type(ret) == XLT_ERROR ) {
		set_init_status_error(r,ret);
		return ret;
	}
	ret = (*gv_new_table[r_type->integer.data])(r,meta,data_state);
	if ( get_type(ret) == XLT_ERROR ) {
		set_init_status_error(r,ret);
		return ret;
	}

	new_resource_option();

	if ( r_type->integer.data == RT_COORDINATE )
		call_gv_event(RID_HIDE_COORD,l_string(std_cm,"insert-coord"));

	return get_integer(r->h.no,0);
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"gv-new-resource"),
		List(n_get_string("type missmatch of the"),
			get_string(l_string(std_cm,e_param)),
			n_get_string("argument"),
			-1));
param_error:
	ret = get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv-new-resource"),
		List(n_get_string("invalid parameter of the"),
			get_string(l_string(std_cm,e_param)),
			n_get_string("argument"),
			-1));
	if ( r )
		set_init_status_error(r,ret);
	return ret;
}


RESOURCE *
get_resource_ptr(XL_SEXP ** retp,XLISP_ENV * e,XL_FILE * f,int ln)
{
RESOURCE * r;
XL_SEXP * ret;
	ret = eval(e,get_symbol(l_string(std_cm,"__resource")));
	switch ( get_type(ret) ) {
	case XLT_ERROR:
		*retp = ret;
		return 0;
	case XLT_PTR:
		*retp = 0;
		return ret->ptr.ptr;
	default:
		*retp = get_error(
			f,
			ln,
			XLE_SEMANTICS_TYPE_MISSMATCH,
			l_string(std_cm,"__resource"),
			List(n_get_string("type missmatch"),
				-1));
		return 0;
	}
}




XL_SEXP *
xl_gv_set_status(XLISP_ENV * e,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
RESOURCE * r;
XL_SEXP * ret;
char * e_param;
L_CHAR * indicate, * target;
int flags,mask;
	r = get_resource_ptr(&ret,e,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	flags = 0;
	mask = 0;
	indicate = get_sf_attribute(sf,l_string(std_cm,"indicate"));
	if ( indicate == 0 )
		goto end2;
	if ( l_strcmp(indicate,l_string(std_cm,"on")) == 0 ) {
		flags |= RF_I_ON;
		mask |= RF_INDICATE;
	}
	else if ( l_strcmp(indicate,l_string(std_cm,"off")) == 0 ) {
		flags |= RF_I_OFF;
		mask |= RF_INDICATE;
	}
	else if ( l_strcmp(indicate,l_string(std_cm,"auto")) == 0 ) {
		flags |= RF_I_AUTO;
		mask |= RF_INDICATE;
	}
	else {
		e_param = "indicate";
		goto invalid_param;
	}
	target = get_sf_attribute(sf,l_string(std_cm,"target"));
	if ( target == 0 ) {
		if ( list_length(s) == 1 ) {
			r->h.flags &= ~mask;
			r->h.flags |= flags;
			goto end;
		}
		goto end;
	}
	if ( l_strcmp(target,l_string(std_cm,"listed")) == 0 ) {
		;
	}
	else if ( l_strcmp(target,l_string(std_cm,"all")) == 0 ) {
		;
	}
	else if ( l_strcmp(target,l_string(std_cm,"self")) == 0 ) {
		r->h.flags &= ~mask;
		r->h.flags |= flags;
		return 0;
	}
	else {
		e_param = "target";
		goto invalid_param;
	}
end:	
	gv_set_status_option(r);
end2:
	return 0;
invalid_param:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv-set-status"),
		List(n_get_string("invalid parameter"),
			n_get_string(e_param),
			-1));
}


XL_SEXP *
get_init_status_info(RESOURCE * r)
{
	if ( r->h.initial_status == RS_ERROR ) {
		return List(
			get_symbol(l_string(std_cm,"initial-status")),
			get_string(l_string(std_cm,
				status_msg_table[r->h.initial_status])),
			err_handler(r->h.initial_error,0,0),
			-1);
	}
	else {
		return List(
			get_symbol(l_string(std_cm,"initial-status")),
			get_string(l_string(std_cm,
				status_msg_table[r->h.initial_status])),
			-1);
	}
}

XL_SEXP *
get_inc_status_info(RESOURCE * r)
{
	if ( r->h.incremental_status == RS_ERROR ) {
		return List(
			get_symbol(l_string(std_cm,"incremental-status")),
			get_string(l_string(std_cm,
				status_msg_table[r->h.incremental_status])),
			err_handler(r->h.incremental_error,0,0),
			-1);
	}
	else {
		return List(
			get_symbol(l_string(std_cm,"incremental-status")),
			get_string(l_string(std_cm,
				status_msg_table[r->h.incremental_status])),
			-1);
	}
}

XL_SEXP *
get_indicate_status(RESOURCE * r)
{
char * ind;
	switch ( r->h.flags&RF_INDICATE ) {
	case RF_I_AUTO:
		ind = "auto";
		break;
	case RF_I_ON:
		ind = "on";
		break;
	case RF_I_OFF:
		ind = "off";
		break;
	default:
		er_panic("get_indicate_status");
	}
	return List(get_symbol(l_string(std_cm,"indicate")),
			n_get_string(ind),
			-1);
}


XL_SEXP *
get_resource_status_header(RESOURCE ** rp,XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a_env,XL_SYM_FIELD * sf)
{
RESOURCE * r;
int rid;
char * e_param;
XL_SEXP * ret;


	rid = 0;
	for ( ; sf ; sf = sf->next ) {
		if ( l_strcmp(sf->name,l_string(std_cm,"rid")) == 0 ) {
			sscanf(n_string(std_cm,sf->data),"%i",&rid);
			if ( rid == 0 ) {
				e_param = "attribute\"rid\"";
				goto invalid_param;
			}
		}
	}
	if ( rid ) {
		r = search_resource_by_no(rid);
		if ( r == 0 )
			goto invalid_resource_id;
	}
	else {
		r = get_resource_ptr(&ret,env,s->h.file,s->h.line);
		if ( r == 0 )
			return ret;
	}
	*rp = r;
	return List(
		List(	get_symbol(l_string(std_cm,"rid")),
			get_integer(r->h.no,0),
			-1),
		List(	get_symbol(l_string(std_cm,"entry-URI")),
			get_string(get_url_str2(&r->h.entry)),
			-1),
		List(	get_symbol(l_string(std_cm,"target-URI")),
			get_string(get_url_str2(&r->h.target)),
			-1),
		get_init_status_info(r),
		get_inc_status_info(r),
		get_indicate_status(r),
		r->h.meta,
		-1);
invalid_resource_id:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv-status"),
		List(n_get_string("invalid resource id"),
			-1));
invalid_param:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv-status"),
		List(n_get_string("invalid parameter"),
			n_get_string(e_param),
			-1));
}


XL_SEXP *
xl_gv_resource_status(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
RESOURCE * r;
	return cons(
		get_symbol(l_string(std_cm,"status")),
		get_resource_status_header(&r,env,s,a,sf));
}


XL_SEXP *
xl_gv_get_resource(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
int type;
char * e_param;
RESOURCE *r;
XL_SEXP * uu;
URL u;
	for ( ; sf ; sf = sf->next ) {
		if ( l_strcmp(sf->name,l_string(std_cm,"by")) == 0 ) {
			if ( l_strcmp(sf->data,
				l_string(std_cm,"entry")) == 0 ) {
				type = 0;
			}
			else if ( l_strcmp(sf->data,
				l_string(std_cm,"target")) == 0 ) {
				type = 1;
			}
			else {
				e_param = "attribute by";
				goto invalid_param;
			}
		}
	}
	uu = get_el(s,1);
	if ( get_type(uu) != XLT_STRING ) {
		e_param = "1st";
		goto type_missmatch;
	}
	get_url2(&u,uu->string.data);
	switch ( type ) {
	case 0:
		r = search_resource_by_entry(&u);
		break;
	case 1:
		r = search_resource_by_target(&u);
		break;
	}
	free_url(&u);
	if ( r == 0 ) {
		e_param = n_string(std_cm,uu->string.data);
		goto nothing;
	}
	return get_integer(r->h.no,0);
nothing:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_UNDEF_RESOURCE,
		l_string(std_cm,"gv-get-resource"),
		List(n_get_string("undefined the resource"),
			get_string(l_string(std_cm,e_param)),
			n_get_string("argument"),
			-1));
type_missmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"gv-get-resource"),
		List(n_get_string("type missmatch of the"),
			get_string(l_string(std_cm,e_param)),
			n_get_string("argument"),
			-1));
invalid_param:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"gv-get-resource"),
		List(n_get_string("invalid parameter"),
			n_get_string(e_param),
			-1));
}


XL_SEXP *
xl_note(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
L_CHAR * data;
L_CHAR * img;
L_CHAR * fill_color,* line_color;
L_CHAR * url;
int type;
int _fill,_line;
RESOURCE * r;
XL_SEXP * ret;


	r = get_resource_ptr(&ret,env,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;

	data = get_sf_attribute(sf,l_string(std_cm,"data"));
	img = get_sf_attribute(sf,l_string(std_cm,"img"));
	fill_color = get_sf_attribute(sf,l_string(std_cm,"fill"));
	line_color = get_sf_attribute(sf,l_string(std_cm,"line"));
	url = get_sf_attribute(sf,l_string(std_cm,"url"));
	if ( data == 0 )
		return 0;
	_line = _fill = 0;
	if ( img ) {
		type = NT_IMAGE;
	}
	else if ( fill_color || line_color ) {
		type = NT_COLOR;
		if ( fill_color == 0 )
			_fill = C_TRANSPARENT;
		else {
			sscanf(n_string(std_cm,fill_color),"%x",&_fill);
		}
		if ( fill_color == 0 )
			_line = C_TRANSPARENT;
		else {
			sscanf(n_string(std_cm,fill_color),"%x",&_line);
		}
	}
	else {
		return 0;
	}
	set_note(r,type,img,_fill,_line,data,url);
	return 0;
}

XL_SEXP *
get_image_notes(RESOURCE * r,XL_SEXP * ret)
{
NOTE * n;
XL_SEXP * _d,* _u;
	for ( n = r->h.notes ; n ; n = n->next ) {
		if ( n->type != NT_IMAGE )
			continue;
		if ( n->data )
			_d = get_string(n->data);
		else	_d = 0;
		if ( n->url )
			_u = get_string(n->url);
		else	_u = 0;
		ret = cons(
			List(n_get_symbol("image"),
				_d,_u,
				get_string(n->img),
				-1),
			ret);
	}
	return ret;
}

XL_SEXP *
get_color_notes(RESOURCE * r,XL_SEXP * ret)
{
NOTE * n;
char b1[10],b2[10];
XL_SEXP * _d,* _u;
	for ( n = r->h.notes ; n ; n = n->next ) {
		if ( n->type != NT_COLOR )
			continue;
		sprintf(b1,"#%x",n->fill_color);
		sprintf(b2,"#%x",n->line_color);
		if ( n->data )
			_d = get_string(n->data);
		else	_d = 0;
		if ( n->url )
			_u = get_string(n->url);
		else	_u = 0;
		ret = cons(
			List(n_get_symbol("color"),
				_d,_u,
				n_get_string(b1),
				n_get_string(b2),
				-1),
			ret);
	}
	return ret;
}

XL_SEXP *
xl_gv_get_notes(
	XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * a,XL_SYM_FIELD * sf)
{
RESOURCE * r;
XL_SEXP * ret;
L_CHAR * obj;
MAP * m;
	r = get_resource_ptr(&ret,env,s->h.file,s->h.line);
	if ( r == 0 )
		return ret;
	obj = get_sf_attribute(sf,l_string(std_cm,"obj"));
	ret = 0;
	if ( obj == 0 ) {
	normal:
		ret = get_color_notes(r,ret);
		ret = get_image_notes(r,ret);
	}
	else {
		if ( r->h.type != RT_COORDINATE )
			goto normal;

		ret = get_color_notes(r,ret);
		for ( m = R_NEXT(MAP*,&r->c.map_children) ;
				m != (MAP*)&r->c.map_children;
				m = R_NEXT(MAP*,&m->h) ) {
			if ( m->src == 0 )
				continue;
			ret = get_color_notes(m->src,ret);
		}
		ret = get_image_notes(r,ret);
		for ( m = R_NEXT(MAP*,&r->c.map_children) ;
				m != (MAP*)&r->c.map_children;
				m = R_NEXT(MAP*,&m->h) ) {
			if ( m->src == 0 )
				continue;
			ret = get_image_notes(m->src,ret);
		}
	}
	if ( ret == 0 )
		return 0;
	return cons(n_get_symbol("notes"),ret);
}


