/**********************************************************************
 
	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.

**********************************************************************/


#define STREAM_LIB

#ifdef VA2
#include	<varargs.h>
#else
#include	<stdarg.h>
#endif
#include	"xl.h"

#include	<stdlib.h>
#include	<errno.h>
#include	<setjmp.h>
#include	"machine/err.h"
#include	"xl.h"
#include	"memory_debug.h"
#include	"memory_routine.h"


typedef struct indent {
	short		flags;
#define IF_FORCE	0x0001
	short		ind;
} INDENT;
typedef void (*pt_t[2])();

typedef struct err_env {
	jmp_buf		env;
	int		er;
} ERR_ENV;

pt_t * _get_print_table(XL_SEXP * s);
void _print_sexp(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags,INDENT ind);
void _e_printf(STREAM * fd,ERR_ENV * ee,char * fmt,...);
void print_ind(STREAM * fd,ERR_ENV * ee,INDENT ind);
void _print_null_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_error_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_pair_l(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags,INDENT ind);
void _print_field_xh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void __print_field_l(STREAM * fd,ERR_ENV * ee,L_CHAR * str);
void _print_field_l(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_pair_xh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags,INDENT ind);
void _print_symbol_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_string_l(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_string_xh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_integer_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_floating_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_function_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_raw_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);
void _print_ptr_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags);


void
_e_printf(STREAM * fd,ERR_ENV * ee,char * fmt,...)
{
va_list p;
int ret;

#ifdef VA2
	va_start(p);
#else
	va_start(p,fmt);
#endif
	ret = _s_printf(fd,&ee->er,fmt,p);

	va_end(p);

	if ( ret < 0 )
		longjmp(ee->env,-1);
}

void
print_ind(STREAM * fd,ERR_ENV * ee,INDENT ind)
{
int i;
	for ( i = 0 ; i < ind.ind ; i ++ )
		_e_printf(fd,ee," ");
}

int
check_valid_tag_char(L_CHAR ch)
{
	if ( ((int)ch) <= ' ' && 0 <= ((int)ch) )
		return -1;
	switch ( ch ) {
	case '^':
	case '<':
	case '&':
	case '\'':
	case '"':
	case '>':
	case '(':
	case ')':
	case '%':
	case '/':
	case '\\':
	case '=':
	case '+':
		return -1;
	}
	return 0;
}

int
check_valid_tag(L_CHAR * str)
{
	for ( ; *str && check_valid_tag_char(*str) == 0 ; str ++);
	if ( *str == 0 )
		return 0;
	return -1;
}

int
check_valid_string_char(L_CHAR ch)
{
	if ( ((int)ch) <= ' ' && 0 <= ((int)ch) )
		return -1;
	switch ( ch ) {
	case '^':
	case '\'':
	case '(':
	case ')':
	case '%':
		return -1;
	}
	return 0;
}

int
check_valid_string(L_CHAR * str)
{
	for ( ; *str && check_valid_string_char(*str) == 0 ; str ++);
	if ( *str == 0 )
		return 0;
	return -1;
}

void
_print_null_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
	if ( flags & PF_TEXT )
		return;
	_e_printf(fd,ee,"()");
}

pt_t pt_null = {
	_print_null_lxh,
	_print_null_lxh,
};

void
_print_error_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
INDENT ind;
L_CHAR nl[1];
L_CHAR * site, * filename,* func;

	nl[0] = 0;

	ind.flags = 0;
	ind.ind = 0;
	if ( !(flags&PF_LISP_MODE) )
		_e_printf(fd,ee,"^");

	if ( s->err.site == 0 )
		site = nl;
	else	site = s->err.site;
	if ( s->err.filename == 0 )
		filename = nl;
	else	filename = s->err.filename;
	if ( s->err.func == 0 )
		func = nl;
	else	func = s->err.func;
	_e_printf(fd,ee,"\n %%E\n (\"%ls\" \"%ls\" %i \"%ls\" 0x%x\n ",
		site,
		filename,
		s->err.line,
		func,
		s->err.code);
	_print_sexp(fd,ee,s->err.data,
		(flags&(~(PFM_FORMAT|PF_TEXT)))|PF_LISP|PF_LISP_MODE,ind);
	_e_printf(fd,ee,")");
}

pt_t pt_error = {
	_print_error_lxh,
	_print_error_lxh,
};

void
_print_pair_l(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags,INDENT ind)
{
int t;
int f;
INDENT ind2;
	if ( flags&PF_INDENT ) {
		if ( ind.flags & IF_FORCE ) {
			_e_printf(fd,ee,"\n");
			print_ind(fd,ee,ind);
		}
	}
	ind2.flags = 0;
	ind2.ind = ind.ind+1;
	if ( !(flags & PF_TEXT) )
		_e_printf(fd,ee,"(");
	f = 0;
	for ( ; (t=get_type(s)) == XLT_PAIR ; ) {
/*
		if ( break_check ) {
			r = (*break_check)(s);
			if ( get_type(r) == XLT_ERROR )
				return;
		} 
*/
		if ( f )
			_e_printf(fd,ee," ");
		f = 1;
		_print_sexp(fd,ee,car(s),flags|PF_LISP_MODE,ind2);
		ind2.flags |= IF_FORCE;
		s = cdr(s);
	}
	if ( t == 0 ) {
		if ( !(flags & PF_TEXT) )
			_e_printf(fd,ee,")");
	}
	else {
		_e_printf(fd,ee,".");
		ind2.flags |= IF_FORCE;
		_print_sexp(fd,ee,s,flags|PF_LISP_MODE,ind2);
		_e_printf(fd,ee,")");
	}
}

void
_print_field_xh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
XL_SYM_FIELD * sf;
	if ( (flags & PFM_FORMAT) == PF_HTML &&
			!(flags&PF_LISP_MODE) ) {
		for ( sf = s->symbol.field ; sf ; sf = sf->next ) {
			switch ( sf->data[0] ) {
			case '#':
				if ( sf->data[1] == '-' )
					_e_printf(fd,ee," %ls=\"#%ls\"",
						sf->name,
						&sf->data[2]);
				else	_e_printf(fd,ee," %ls=%ls ",
						sf->name,
						&sf->data[1]);
				break;
			case 0:
				_e_printf(fd,ee," %ls",
					sf->name);
				break;
			default:
				_e_printf(fd,ee," %ls=\"%ls\"",
					sf->name,
					sf->data);
			}
		}
	}
	else {
		for ( sf = s->symbol.field ; sf ; sf = sf->next ) {
			_e_printf(fd,ee," %ls=",
				  sf->name);
			__print_field_l(fd,ee,sf->data);
		}
	}
}

void
__print_field_l(STREAM * fd,ERR_ENV * ee,L_CHAR * str)
{
L_CHAR * p1;
int len;
L_CHAR * buf;
	p1 = str;
	_e_printf(fd,ee,"\"");
	buf = d_alloc(10);
	for ( ; ; ) {
		for ( len = 0 ; p1[len] != '\n' &&
			p1[len] != '\r' &&
			p1[len] != '"' &&
			p1[len] != '\\' &&
			p1[len] != '\t' &&
			p1[len] != '&' &&
			p1[len] != '<' &&
			p1[len] != 0;
			len ++ );
		buf = d_re_alloc(buf,(len+1)*sizeof(L_CHAR));
		memcpy(buf,p1,len*sizeof(L_CHAR));
		buf[len] = 0;
		switch ( p1[len] ) {
		case 0:
			_e_printf(fd,ee,"%ls\"",buf);
			break;
		case '\n':
		case '\r':
			_e_printf(fd,ee,"%ls\\n",buf);
			break;
		case '\t':
			_e_printf(fd,ee,"%ls\\t",buf);
			break;
		case '\\':
			_e_printf(fd,ee,"%ls\\\\",buf);
			break;
		case '"':
			_e_printf(fd,ee,"%ls\\\"",buf);
			break;
		case '&':
			_e_printf(fd,ee,"%ls&amp;",buf);
			break;
		case '<':
			_e_printf(fd,ee,"%ls&lt;",buf);
			break;
		}
		if ( p1[len] == 0 )
			break;
		p1 = &p1[len+1];
	}
	d_f_ree(buf);
}

void
_print_field_l(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
XL_SYM_FIELD * sf;
	for ( sf = s->symbol.field ; sf ; sf = sf->next ) {
		_e_printf(fd,ee," %ls=", sf->name);
		__print_field_l(fd,ee,sf->data);
	}
}

void
_print_pair_xh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags,INDENT ind)
{
XL_SEXP * s1;
XL_SEXP * sym;

	if ( get_type(sym=car(s)) != XLT_SYMBOL ) {
		_print_pair_l(fd,ee,s,flags,ind);
		return;
	}
	if ( check_valid_tag(sym->symbol.data) ) {
		_print_pair_l(fd,ee,s,flags,ind);
		return;
	}
	if ( get_type(s1=cdr(s)) != XLT_NULL ) {
/*
		if ( break_check ) {
			r = (*break_check)(s);
			if ( get_type(r) == XLT_ERROR )
				return;
		} 
*/
		ind.flags = 0;
		ind.ind ++;
		_e_printf(fd,ee,"<%ls",sym->symbol.data);
		_print_field_xh(fd,ee,sym,flags&(~PF_LISP_MODE));
		if ( flags&PF_INDENT )
			_e_printf(fd,ee,">\n");
		else	_e_printf(fd,ee,">");
		s1 = cdr(s);
		for ( ; get_type(s1) == XLT_PAIR ; s1 = cdr(s1) ) {
			if ( flags&PF_INDENT )
				print_ind(fd,ee,ind);
			_print_sexp(fd,ee,car(s1),flags&(~PF_LISP_MODE),ind);
			if ( flags&PF_INDENT )
				_e_printf(fd,ee,"\n");
			else	_e_printf(fd,ee," ");
		}
		ind.ind --;
		if ( flags&PF_INDENT )
			print_ind(fd,ee,ind);
		_e_printf(fd,ee,"</%ls>",sym->symbol.data);
	}
	else {
		_e_printf(fd,ee,"<%ls",sym->symbol.data);
		_print_field_xh(fd,ee,sym,flags&(~PF_LISP_MODE));
		if ( (flags&PFM_FORMAT) == PF_XML ) {
			if ( sym->symbol.data[0] == '?' )
				_e_printf(fd,ee,"?>");
			else	_e_printf(fd,ee,"/>");
		}
		else	_e_printf(fd,ee,">");
	}
}

pt_t pt_pair = {
	_print_pair_l,
	_print_pair_xh,
};

void
_print_symbol_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
	if ( !(flags&PF_LISP_MODE) )
		_e_printf(fd,ee,"^");
	if ( s->symbol.field ) {
		_e_printf(fd,ee,"[%ls",s->symbol.data);
		_print_field_l(fd,ee,s,flags);
		_e_printf(fd,ee,"]");
	}
	else {
		_e_printf(fd,ee,"%ls",s->symbol.data);
	}
}

pt_t pt_symbol = {
	_print_symbol_lxh,
	_print_symbol_lxh,
};

void
_print_string_l(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
L_CHAR * p1;
int len;
L_CHAR * buf;
	if ( flags&PF_TEXT ) {
		_e_printf(fd,ee,"%ls",s->string.data);
		return;
	}
	p1 = s->string.data;
	if ( !(flags&PF_LISP_MODE) )
		_e_printf(fd,ee,"^\"");
	else	_e_printf(fd,ee,"\"");
	buf = d_alloc(10);
	for ( ; ; ) {
		for ( len = 0 ; p1[len] != '\n' &&
			p1[len] != '\r' &&
			p1[len] != '"' &&
			p1[len] != '\\' &&
			p1[len] != '\t' &&
			p1[len] != '&' &&
			p1[len] != '<' &&
			p1[len] != 0;
			len ++ );
		buf = d_re_alloc(buf,(len+1)*sizeof(L_CHAR));
		memcpy(buf,p1,len*sizeof(L_CHAR));
		buf[len] = 0;
		switch ( p1[len] ) {
		case 0:
			_e_printf(fd,ee,"%ls\"",buf);
			break;
		case '\n':
		case '\r':
			_e_printf(fd,ee,"%ls\\n",buf);
			break;
		case '\t':
			_e_printf(fd,ee,"%ls\\t",buf);
			break;
		case '\\':
			_e_printf(fd,ee,"%ls\\\\",buf);
			break;
		case '"':
			_e_printf(fd,ee,"%ls\\\"",buf);
			break;
		case '&':
			_e_printf(fd,ee,"%ls&amp;",buf);
			break;
		case '<':
			_e_printf(fd,ee,"%ls&lt;",buf);
			break;
		}
		if ( p1[len] == 0 )
			break;
		p1 = &p1[len+1];
	}
	d_f_ree(buf);
}

void
_print_string_xh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
L_CHAR * p1;
int len;
L_CHAR * buf;
	if ( flags&PF_TEXT ) {
		_e_printf(fd,ee,"%ls",s->string.data);
		return;
	}
	if ( flags&PF_LISP_MODE ) {
		_print_string_l(fd,ee,s,flags);
		return;
	}
	if ( s->string.data[0] == '^' ) {
		_print_string_l(fd,ee,s,flags);
		return;
	}
	if ( s->string.data[0] == 0 ) {
		_print_string_l(fd,ee,s,flags);
		return;
	}
	if ( '0' <= s->string.data[0] &&
			s->string.data[0] <= '9' ) {
		_print_string_l(fd,ee,s,flags);
		return;
	}
	if ( s->string.data[0] == '-' ||
			s->string.data[0] == '+' ) {
		if ( '0' <= s->string.data[1] &&
				s->string.data[1] <= '9' ) {
			_print_string_l(fd,ee,s,flags);
			return;
		}
	}
	p1 = s->string.data;
	buf = d_alloc(10);
	for ( ; ; ) {
		for ( len = 0 ; 
			p1[len] != '&' &&
			p1[len] != '<' &&
			p1[len] != '(' &&
			p1[len] != ')' &&
			(p1[len] > ' ' || p1[len] < 0 )
			;
			len ++ );
		buf = d_re_alloc(buf,(len+1)*sizeof(L_CHAR));
		memcpy(buf,p1,len*sizeof(L_CHAR));
		buf[len] = 0;
		if ( 0 < p1[len] && p1[len] <= ' ' ) {
			_e_printf(fd,ee,"%ls&#%i;",buf,
				p1[len]);
		}
		else switch ( p1[len] ) {
		case 0:
			_e_printf(fd,ee,"%ls",buf);
			break;
		case '&':
			_e_printf(fd,ee,"%ls&amp;",buf);
			break;
		case '<':
			_e_printf(fd,ee,"%ls&lt;",buf);
			break;
		default:
			_e_printf(fd,ee,"%ls&cx%x;",buf,p1[len]);
		}
		if ( p1[len] == 0 )
			break;
		p1 = &p1[len+1];
	}
	d_f_ree(buf);
}

pt_t pt_string = {
	_print_string_l,
	_print_string_xh
};

void
_print_integer_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
	_e_printf(fd, ee, I64_FORMAT, s->integer.data);
	if ( s->integer.unit )
		_e_printf(fd,ee,"%ls",s->integer.unit);
}

pt_t pt_integer = {
	_print_integer_lxh,
	_print_integer_lxh
};

void
_print_floating_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
	_e_printf(fd,ee,"%lf",s->floating.data);
	if ( s->floating.unit )
		_e_printf(fd,ee,"%ls ",s->floating.unit);
	else  	_e_printf(fd,ee," ");
}

pt_t pt_floating = {
	_print_floating_lxh,
	_print_floating_lxh
};

void
_print_function_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
	switch ( s->func.type ) {
	case FT_PRIM:
		_e_printf(fd,ee,"[prim:0x%x]",s->func.prim);
		break;
	case FT_LAMBDA:
		_e_printf(fd,ee,"[lambda:0x%x]",s->func.l_body);
		break;
	default:
		_e_printf(fd,ee,"[%i:]",s->func.type);
		break;
	}
}

pt_t pt_function = {
	_print_function_lxh,
	_print_function_lxh
};

void
_print_raw_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
int er;
char * pp;
int size,ss;
	if ( !(flags&PF_LISP_MODE) )
		_e_printf(fd,ee,"^");
	_e_printf(fd,ee,"#%x#",s->raw.size);
	if ( !(flags&PF_RAW_DISABLE) ) {
		pp = s->raw.data;
		size = s->raw.size;
		for ( ; size ; ) {
			ss = size;
		retry:
			er = s_write(fd,pp,ss);
			if ( er < 0 ) {
				if ( errno == ESYS_AGAIN ) {
					ss = ss/2;
					if ( ss <= 0 )
						ss = 1;
					goto retry;
				}
				ee->er = errno;
				longjmp(ee->env,-1);
				break;
			}
			size -= er;
			pp += er;
		}
	}
	else	_e_printf(fd,ee,"]");
	if ( flags&PF_RAW_CLEAR ) {
		if ( s->raw.data )
			mfree(s->raw.data);
		s->raw.data = 0;
	}
}

pt_t pt_raw = {
	_print_raw_lxh,
	_print_raw_lxh
};


void
_print_ptr_lxh(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags)
{
	_e_printf(fd,ee,"+PTR:%x+",s->ptr.ptr);
}

pt_t pt_ptr = {
	_print_ptr_lxh,
	_print_ptr_lxh
};

pt_t *
_get_print_table(XL_SEXP * s)
{
pt_t * tbl;

	switch ( get_type(s) ) {
	case 0:
		tbl = &pt_null;
		break;
	case XLT_ERROR:
		tbl = &pt_error;
		break;
	case XLT_PAIR:
		tbl = &pt_pair;
		break;
	case XLT_SYMBOL:
		tbl = &pt_symbol;
		break;
	case XLT_STRING:
		tbl = &pt_string;
		break;
	case XLT_INTEGER:
		tbl = &pt_integer;
		break;
	case XLT_FLOAT:
		tbl = &pt_floating;
		break;
	case XLT_FUNC:
		tbl = &pt_function;
		break;
	case XLT_RAW:
		tbl = &pt_raw;
		break;
	case XLT_PTR:
		tbl = &pt_ptr;
		break;
	default:
		s_printf(s_stdout,"--- %i %x\n",get_type(s),s);
		er_panic("_get_print_table(1)");
	}
	return tbl;
}

void
_print_sexp(STREAM * fd,ERR_ENV * ee,XL_SEXP * s,int flags,INDENT ind)
{
pt_t * tbl;
	tbl = _get_print_table(s);
	if ( (flags&PFM_FORMAT) == PF_LISP )
		((*tbl)[0])(fd,ee,s,flags,ind);
	else	((*tbl)[1])(fd,ee,s,flags,ind);
}

int
e_print_sexp(STREAM * fd,int * erp,XL_SEXP * s,int flags)
{
INDENT ind;
ERR_ENV ee;

	ee.er = 0;
	if ( setjmp(ee.env) ) {
		*erp = ee.er;
		return -1;
	}

	ind.flags = 0;
	ind.ind = 0;
	if ( flags&PF_MULTI_ROOT ) {
		for ( ; get_type(s) != XLT_NULL ; s = cdr(s) ) {
			_print_sexp(fd,&ee,car(s),flags,ind);
			_e_printf(fd,&ee,"\n");
		}
	}
	else {
		_print_sexp(fd,&ee,s,flags,ind);
	}
	return 0;
}

void
print_sexp(STREAM * fd,XL_SEXP * s,int flags)
{
	e_print_sexp(fd,0,s,flags);
}

