/**********************************************************************
 
	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	"stream.h"
#include	"long_char.h"
#include	"xlerror.h"
#include	"xl.h"

XL_SEXP * xl_PrintStd();
XL_SEXP * xl_Print();

int
cmp_ps_str(L_CHAR * f,char * str)
{
int s_len;
	s_len = strlen(str);
	if ( memcmp(f,l_string(std_cm,str),s_len*sizeof(L_CHAR)) )
		return -1;
	switch ( f[s_len] ) {
	case ':':
		return s_len+1;
	case 0:
		return s_len;
	}
	return -1;
}

int
get_ps_flags(L_CHAR * f)
{
int len;
int ret;
	ret = 0;
	for ( ; *f ; f += len ) {
		len = cmp_ps_str(f,"indent");
		if ( len > 0 ) {
			ret |= PF_INDENT;
			continue;
		}
		len = cmp_ps_str(f,"lisp");
		if ( len > 0 ) {
			ret |= PF_LISP;
			continue;
		}
		len = cmp_ps_str(f,"xml");
		if ( len > 0 ) {
			ret |= PF_XML;
			continue;
		}
		len = cmp_ps_str(f,"html");
		if ( len > 0 ) {
			ret |= PF_HTML;
			continue;
		}
		len = cmp_ps_str(f,"text");
		if ( len > 0 ) {
			ret |= PF_TEXT;
			continue;
		}
		return -1;
	}
	return ret;
}


void
init_PrintStd(XLISP_ENV * env)
{
	set_env(env,l_string(std_cm,"PrintStd"),
		get_func_prim(xl_PrintStd,FO_APPLICATIVE,0,2,2));
}

XL_SEXP *
xl_PrintStd(XLISP_ENV * env,XL_SEXP * s,XLISP_ENV * a,XL_SYM_FIELD * sf)
{
L_CHAR * opt;
int flags;
L_CHAR * file;
STREAM * st;
	opt = get_sf_attribute(sf,l_string(std_cm,"option"));
	if ( opt ) {
		flags = get_ps_flags(opt);
		if ( flags < 0 ) {
		return get_error(
			s->h.file,
			s->h.line,
			XLE_PROTO_INV_PARAM,
			l_string(std_cm,"Printstd"),
			list(	n_get_string("invalid parameter (option)"),
				0));
		}
	}
	else	flags = 0;
	file = get_sf_attribute(sf,l_string(std_cm,"file"));
	if ( file == 0 )
		st = s_stdout;
	else	st = s_open_file(n_string(std_cm,file),O_CREAT|O_TRUNC|O_RDWR,0644);
	print_sexp(st,get_el(s,1),PF_RAW_DISABLE|flags);
	s_printf(st,"\n");
	return 0;
}


