/* libsizzle/scmport.c - Scheme port handling
 
  Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
 
  This is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2, or (at your option)
  any later version.
  
  This software 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.  See the
  GNU General Public License for more details.
  
  You should have received a copy of the GNU General Public License
  along with this package; see the file COPYING.  If not, write to
  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  Boston, MA 02111-1307, USA.  */

#if HAVE_CONFIG_H
# include <config.h>
#endif 

#include <string.h>
#include <stdio.h>

#if ENABLE_NLS
# include <libintl.h>
# define _(String) gettext(String)
#else
# define _(String) (String)
#endif

#include "alloc.h"
#include "node.h"
#include "capi.h"
#include "validate.h"
#include "vector.h"
#include "port.h"
#include "scmport.h"

/* The string port type identifier.  */
zzz_object_t zzz_scmport_port_type;

zzz_scm_t
zzz_make_scmport (zzz_scm_t proc_vec)
{
  zzz_scm_t port;

  port = zzz_make_port (zzz_scmport_port_type, proc_vec);
  port_read_p (port) = 1;
  port_write_p (port) = 1;
  return port;
}



static void
scmport_putc (int ch, zzz_scm_t port)
{
  zzz_scm_t vec = (zzz_scm_t) port_info (port);
  zzz_scm_t proc = zzz_vector_get (vec, 0);
  zzz_scm_t result;

  if (procedure_p (proc))
    zzz_apply (zzz_current_environment, proc,
	       zzz_make_n_list (1, zzz_make_char (ch)), &result);
}

static void
scmport_puts (zzz_scm_t port, char * buf, unsigned len)
{
  zzz_scm_t vec = (zzz_scm_t) port_info (port);
  zzz_scm_t proc = zzz_vector_get (vec, 1);
  zzz_scm_t result;

  if (procedure_p (proc))
    zzz_apply (zzz_current_environment, proc,
	       zzz_make_n_list (1, zzz_make_string (buf, len)), &result);
}

static int
scmport_getc (zzz_scm_t port)
{
  zzz_scm_t vec = (zzz_scm_t) port_info (port);
  zzz_scm_t proc = zzz_vector_get (vec, 3);
  zzz_scm_t result;

  if (procedure_p (proc))
    {
      zzz_apply (zzz_current_environment, proc, NULL, &result);
      if (!char_p (result))
	return EOF;
      else
	return char_val (result);
    }
  else
    return EOF;
}

static void
scmport_close (zzz_scm_t port)
{
  zzz_scm_t vec = (zzz_scm_t) port_info (port);
  zzz_scm_t proc;
  zzz_scm_t result;

  /* Here we have to be careful: if this close function is called
     during garbage collection, we may not call the ports' close
     closure, because all associated data may be freed already. */
  if (zzz_terminating)
     return;

  proc = zzz_vector_get (vec, 4);
  if (procedure_p (proc))
    zzz_apply (zzz_current_environment, proc, NULL, &result);
}

static void
scmport_flush (zzz_scm_t port)
{
  zzz_scm_t vec = (zzz_scm_t) port_info (port);
  zzz_scm_t proc = zzz_vector_get (vec, 2);
  zzz_scm_t result;

  if (procedure_p (proc))
    zzz_apply (zzz_current_environment, proc, NULL, &result);
}

static int
scmport_mark (zzz_scm_t port)
{
  zzz_mark_cell ((zzz_scm_t ) port_info (port));
  return 0;
}

/*:doc
  make-soft-port
  (make-soft-port vec modes) => port
  Creates a port which uses the input/output procedures in the vector
  @var{vec}.
  The vector must constist of the following elements.  Each element must
  be either a procedure or @code{#f}:
  0. A procedure accepting one character for writing.
  1. A procedure accepting a string for writing (currently ignored).
  2. A procedure for flushing the output.
  3. A procedure delivering a character, @code{#f} or @code{eof-object}.
     @code{#f} and the end-of-file object signal an end of file.
  4. A close procedure.  This procedure is only called if a port is
     closed with close-{in,out}put-port, not when closed duriong garbage
     collection.
  The @var{mode} argument is currently ignored.
  doc:*/
#define FUNC_NAME "make-soft-port"
static result_t
make_soft_port (zzz_scm_t env, zzz_scm_t vec, zzz_scm_t modes,
		zzz_scm_t * result)
{
  static char * s_func_name = FUNC_NAME;
  zzz_scm_t port;
  int x;

  CHECK_TYPE (1, vector_p (vec), zzz_vector_type_name);
  CHECK_TYPE (1, vector_len (vec) == 5, _("vector with five elements"));
  for (x = 0; x < 5; x++)
    {
      CHECK_TYPE (1, procedure_p (zzz_vector_get (vec, x)) ||
		  zzz_eq (zzz_vector_get (vec, x), zzz_false_value),
		  _("vector with five procedures or #f"));
    }
  port = zzz_make_scmport (vec);
  *result = port;
  return RESULT_SUCCESS;
}
#undef FUNC_NAME

result_t
zzz_init_scmport (void)
{
  zzz_scmport_port_type = zzz_define_port_type (scmport_getc, NULL,
						scmport_putc, 
						scmport_puts,
						scmport_flush, 
						scmport_close,
						NULL, NULL, NULL, NULL,
						scmport_mark);
  zzz_define_function ("make-soft-port", (zzz_prim_t) make_soft_port,
		       argv_2_0_0);
  return RESULT_SUCCESS;
}
