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

#include	<stdlib.h>
#include	<errno.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])();

void
_print_sexp(STREAM * fd,XL_SEXP * s,int flags,INDENT ind);

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

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,XL_SEXP * s,int flags)
{
	if ( flags & PF_TEXT )
		return;
	s_printf(fd,"()");
}

pt_t pt_null = {
	_print_null_lxh,
	_print_null_lxh,
};

void
_print_error_lxh(STREAM * fd,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) )
		s_printf(fd,"^");

	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;
	s_printf(fd,"\n %%E\n (\"%ls\" \"%ls\" %i \"%ls\" 0x%x\n ",
		site,
		filename,
		s->err.line,
		func,
		s->err.code);
	_print_sexp(fd,s->err.data,
		(flags&(~(PFM_FORMAT|PF_TEXT)))|PF_LISP|PF_LISP_MODE,ind);
	s_printf(fd,")");
}

pt_t pt_error = {
	_print_error_lxh,
	_print_error_lxh,
};

void
_print_pair_l(STREAM * fd,XL_SEXP * s,int flags,INDENT ind)
{
int t;
int f;
INDENT ind2;
XL_SEXP * r;
	if ( flags&PF_INDENT ) {
		if ( ind.flags & IF_FORCE ) {
			s_printf(fd,"\n");
			print_ind(fd,ind);
		}
	}
	ind2.flags = 0;
	ind2.ind = ind.ind+1;
	if ( !(flags & PF_TEXT) )
		s_printf(fd,"(");
	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 )
			s_printf(fd," ");
		f = 1;
		_print_sexp(fd,car(s),flags|PF_LISP_MODE,ind2);
		ind2.flags |= IF_FORCE;
		s = cdr(s);
	}
	if ( t == 0 ) {
		if ( !(flags & PF_TEXT) )
			s_printf(fd,")");
	}
	else {
		s_printf(fd,".");
		ind2.flags |= IF_FORCE;
		_print_sexp(fd,s,flags|PF_LISP_MODE,ind2);
		s_printf(fd,")");
	}
}

void
_print_field_xh(STREAM * fd,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] == '-' )
					s_printf(fd," %ls=\"#%ls\"",
						sf->name,
						&sf->data[2]);
				else	s_printf(fd," %ls=%ls ",
						sf->name,
						&sf->data[1]);
				break;
			case 0:
				s_printf(fd," %ls",
					sf->name);
				break;
			default:
				s_printf(fd," %ls=\"%ls\"",
					sf->name,
					sf->data);
			}
		}
	}
	else {
		for ( sf = s->symbol.field ; sf ; sf = sf->next )
			s_printf(fd," %ls=\"%ls\"",
				sf->name,
				sf->data);
	}
}

void
__print_field_l(STREAM * fd,L_CHAR * str)
{
L_CHAR * p1;
int len;
L_CHAR * buf;
	p1 = str;
	s_printf(fd,"\"");
	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:
			s_printf(fd,"%ls\"",buf);
			break;
		case '\n':
		case '\r':
			s_printf(fd,"%ls\\n",buf);
			break;
		case '\t':
			s_printf(fd,"%ls\\t",buf);
			break;
		case '\\':
			s_printf(fd,"%ls\\\\",buf);
			break;
		case '"':
			s_printf(fd,"%ls\\\"",buf);
			break;
		case '&':
			s_printf(fd,"%ls&amp;",buf);
			break;
		case '<':
			s_printf(fd,"%ls&lt;",buf);
			break;
		}
		if ( p1[len] == 0 )
			break;
		p1 = &p1[len+1];
	}
	d_f_ree(buf);
}

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

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

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

pt_t pt_pair = {
	_print_pair_l,
	_print_pair_xh,
};

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

pt_t pt_symbol = {
	_print_symbol_lxh,
	_print_symbol_lxh,
};

void
_print_string_l(STREAM * fd,XL_SEXP * s,int flags)
{
L_CHAR * p1;
int len;
L_CHAR * buf;
	if ( flags&PF_TEXT ) {
		s_printf(fd,"%ls",s->string.data);
		return;
	}
	p1 = s->string.data;
	if ( !(flags&PF_LISP_MODE) )
		s_printf(fd,"^\"");
	else	s_printf(fd,"\"");
	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:
			s_printf(fd,"%ls\"",buf);
			break;
		case '\n':
		case '\r':
			s_printf(fd,"%ls\\n",buf);
			break;
		case '\t':
			s_printf(fd,"%ls\\t",buf);
			break;
		case '\\':
			s_printf(fd,"%ls\\\\",buf);
			break;
		case '"':
			s_printf(fd,"%ls\\\"",buf);
			break;
		case '&':
			s_printf(fd,"%ls&amp;",buf);
			break;
		case '<':
			s_printf(fd,"%ls&lt;",buf);
			break;
		}
		if ( p1[len] == 0 )
			break;
		p1 = &p1[len+1];
	}
	d_f_ree(buf);
}

void
_print_string_xh(STREAM * fd,XL_SEXP * s,int flags)
{
L_CHAR * p1;
int len;
L_CHAR * buf;
	if ( flags&PF_TEXT ) {
		s_printf(fd,"%ls",s->string.data);
		return;
	}
	if ( flags&PF_LISP_MODE ) {
		_print_string_l(fd,s,flags);
		return;
	}
	if ( s->string.data[0] == '^' ) {
		_print_string_l(fd,s,flags);
		return;
	}
	if ( s->string.data[0] == 0 ) {
		_print_string_l(fd,s,flags);
		return;
	}
	if ( '0' <= s->string.data[0] &&
			s->string.data[0] <= '9' ) {
		_print_string_l(fd,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,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] <= ' ' ) {
			s_printf(fd,"%ls&#%i;",buf,
				p1[len]);
		}
		else switch ( p1[len] ) {
		case 0:
			s_printf(fd,"%ls",buf);
			break;
		case '&':
			s_printf(fd,"%ls&amp;",buf);
			break;
		case '<':
			s_printf(fd,"%ls&lt;",buf);
			break;
		default:
			s_printf(fd,"%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,XL_SEXP * s,int flags)
{
	s_printf(fd,"%i",s->integer.data);
	if ( s->integer.unit )
		s_printf(fd,"%ls",s->integer.unit);
}

pt_t pt_integer = {
	_print_integer_lxh,
	_print_integer_lxh
};

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

pt_t pt_floating = {
	_print_floating_lxh,
	_print_floating_lxh
};

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

pt_t pt_function = {
	_print_function_lxh,
	_print_function_lxh
};

void
_print_raw_lxh(STREAM * fd,XL_SEXP * s,int flags)
{
int er;
char * pp;
int size,ss;
	if ( !(flags&PF_LISP_MODE) )
		s_printf(fd,"^");
	s_printf(fd,"#%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;
				}
				break;
			}
			size -= er;
			pp += er;
		}
	}
	else	s_printf(fd,"]");
	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
};

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;
	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,XL_SEXP * s,int flags,INDENT ind)
{
pt_t * tbl;
	tbl = _get_print_table(s);
	if ( (flags&PFM_FORMAT) == PF_LISP )
		((*tbl)[0])(fd,s,flags,ind);
	else	((*tbl)[1])(fd,s,flags,ind);
}

void
print_sexp(STREAM * fd,XL_SEXP * s,int flags)
{
pt_t * tbl;
INDENT ind;

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