/**********************************************************************
 
	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	<stdio.h>
#include	<fcntl.h>
#include	"utils.h"
#include	"memory_routine.h"
#include	"xl.h"
#include	"xlerror.h"

void gc_gb_sexp();

/*
(save "filename" <int:open_mode> <int:access_mode> "raw/gblisp" <list:datalist>)
<Save option="raw/xl" oflag="creat/trunc" mode="permission flags">
filename exp</Save>
*/

void
init_Save(XLISP_ENV * env)
{
extern XL_SEXP * xl_Save();
	set_env(env,l_string(std_cm,"Save"),
		get_func_prim(xl_Save,FO_APPLICATIVE,0,3,3));
}

int
xl_save_write(STREAM * st,XL_SEXP * s)
{
int size,er;
char * ptr;
	ptr = s->raw.data;
	size = s->raw.size;
	for ( ; size ; ) {
		er = s_write(st,ptr,size);
		if ( er < 0 )
			return -1;
		size -= er;
		ptr += er;
	}
	return 0;
}

XL_SEXP *
xl_Save(XLISP_ENV * env,XL_SEXP * s,
	XLISP_ENV * arg_env,XL_SYM_FIELD * sf)
{
XL_SEXP * ss, * ss1;
int mode,p;
int type;
STREAM * st;
L_CHAR * filename;
int inv_arg;
char * tmp,* ptr1, * ptr2;
int end_flag;
int ps_flags;
L_CHAR * encode;

	mode = 0;
	p = 0600;
	ps_flags = PF_MULTI_ROOT;
	encode = 0;
	for ( ; sf ; sf = sf->next ) {
		if ( l_strcmp(sf->name,l_string(std_cm,"option"))
				== 0 ) {
			if ( l_strcmp(sf->data,
					l_string(std_cm,"raw")) == 0 )
				type = 0;
			else if ( l_strcmp(sf->data,
					l_string(std_cm,"xl")) == 0 )
				type = 1;
			else	goto inv_param;
		}
		else if ( l_strcmp(sf->name,l_string(std_cm,"oflag"))
				== 0 ) {
			tmp = n_string(std_cm,sf->data);
			end_flag = 0;
			for ( ptr1 = tmp ; ptr1 ; ) {
				for ( ptr2 = ptr1 ;
						*ptr2 &&
						*ptr2 != ':';
						ptr2 ++ );
				if ( *ptr2 == 0 )
					end_flag = 1;
				*ptr2 = 0;
				if ( strcmp(ptr1,"creat") == 0 )
					mode |= O_CREAT;
				else if ( strcmp(ptr1,"trunc") == 0 )
					mode |= O_TRUNC;
				else if ( strcmp(ptr1,"append") == 0 )
					mode |= O_APPEND;
				else {
					goto inv_param;
				}
				if ( end_flag )
					break;
				ptr1 = ptr2+1;
			}
		}
		else if ( l_strcmp(sf->name,l_string(std_cm,"mode"))
				== 0 ) {
			sscanf(n_string(std_cm,sf->data),"%i",&p);
		}
		else if ( l_strcmp(sf->name,
				l_string(std_cm,"format.mode")) == 0 ) {
			if ( l_strcmp(sf->data,
					l_string(std_cm,"lisp")) == 0 ) {
				ps_flags &= ~PFM_FORMAT;
				ps_flags |= PF_LISP;
			}
			else if ( l_strcmp(sf->data,
					l_string(std_cm,"xml")) == 0 ) {
				ps_flags &= ~PFM_FORMAT;
				ps_flags |= PF_XML;
			}
			else if ( l_strcmp(sf->data,
					l_string(std_cm,"html")) == 0 ) {
				ps_flags &= ~PFM_FORMAT;
				ps_flags |= PF_HTML;
			}
		}
		else if ( l_strcmp(sf->name,
				l_string(std_cm,"format.indent")) == 0 ) {
			if ( l_strcmp(sf->data,
					l_string(std_cm,"on")) == 0 ) {
				ps_flags |= PF_INDENT;
			}
			else if ( l_strcmp(sf->data,
					l_string(std_cm,"off")) == 0 ) {
				ps_flags &= ~PF_INDENT;
			}
		}
		else if ( l_strcmp(sf->name,
				l_string(std_cm,"format.multiroot")) == 0 ) {
			if ( l_strcmp(sf->data,
					l_string(std_cm,"on")) == 0 ) {
				ps_flags |= PF_MULTI_ROOT;
			}
			else if ( l_strcmp(sf->data,
					l_string(std_cm,"off")) == 0 ) {
				ps_flags &= ~PF_MULTI_ROOT;
			}
		}
		else if ( l_strcmp(sf->name,
				l_string(std_cm,"format.text")) == 0 ) {
			if ( l_strcmp(sf->data,
					l_string(std_cm,"on")) == 0 ) {
				ps_flags |= PF_TEXT;
			}
			else if ( l_strcmp(sf->data,
					l_string(std_cm,"off")) == 0 ) {
				ps_flags &= ~PF_TEXT;
			}
		}
		else if ( l_strcmp(sf->name,
				l_string(std_cm,"encoding")) == 0 ) {
			encode = sf->data;
		}
	}

	ss = get_el(s,1);
	switch ( get_type(ss) ) {
	case XLT_ERROR:
		return ss;
	case XLT_STRING:
		filename = ss->string.data;
		break;
	default:
		inv_arg = 1;
		goto typemissmatch;
	}
	st = s_open_file(n_string(std_cm,filename),mode|O_RDWR,p);
	if ( st == 0 )
		goto access_error;
	if ( encode )
		set_encoding_st(st,encode);
	switch ( type ) {
	case 0:
		ss = get_el(s,2);
		switch ( get_type(ss) ) {
		case XLT_ERROR:
			s_close(st);
			return ss;
		case XLT_PAIR:
			break;
		default:
			s_close(st);
			inv_arg = 5;
			goto typemissmatch;
		}
		for ( ; get_type(ss) ;
				gc_push(ss,gc_gb_sexp,"Save"),
				ss = cdr(ss),
				gc_pop(ss,gc_gb_sexp)
				 ) {
			ss1 = car(ss);
			switch ( get_type(ss1) ) {
			case XLT_ERROR:
				s_close(st);
				return ss1;
			case XLT_RAW:
				if ( xl_save_write(st,ss1) < 0 ) {
					s_close(st);
					goto access_error;
				}
				break;
			default:
				inv_arg = 6;
				goto typemissmatch;
			}
		}
		s_close(st);
		return 0;
	case 1:
		ss = get_el(s,2);
		if ( get_type(ss) == XLT_ERROR ) {
			s_close(st);
			return ss;
		}
		print_sexp(st,ss,ps_flags);
		s_close(st);
		return 0;
	default:
		er_panic("gb_save(1)");
	}
access_error:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_OPEN_FILE,
		l_string(std_cm,"Save"),
		list(	n_get_string("cannot access the file"),
			get_string(filename),
			0));
inv_param:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_PROTO_INV_PARAM,
		l_string(std_cm,"Save"),
		list(	n_get_string("invalid parameter"),
			0));
typemissmatch:
	return get_error(
		s->h.file,
		s->h.line,
		XLE_SEMANTICS_TYPE_MISSMATCH,
		l_string(std_cm,"Save"),
		list(	n_get_string("save:type missmatch"),
			get_integer(inv_arg,0),
			0));
}

