/*
 * Copyright (C)1997-2000 Jacques H. de Villiers <Jacques@deVilliers.com>
 * Copyright (C)1997-2000 Center for Spoken Language Understanding,
 *                        Oregon Graduate Institute of Science & Technology
 *
 * The authors hereby grant permission to use, copy, modify, distribute,
 * and license this software and its documentation for any purpose, provided
 * that existing copyright notices are retained in all copies and that this
 * notice is included verbatim in any distributions. No written agreement,
 * license, or royalty fee is required for any of the authorized uses.
 * Modifications to this software may be copyrighted by their authors
 * and need not follow the licensing terms described here, provided that
 * the new terms are clearly indicated on the first page of each file where
 * they apply.
 * 
 * IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
 * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
 * ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
 * DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 * 
 * THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
 * IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
 * NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
 * MODIFICATIONS.
 * 
 * GOVERNMENT USE: If you are acquiring this software on behalf of the
 * U.S. government, the Government shall have only "Restricted Rights"
 * in the software and related documentation as defined in the Federal 
 * Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
 * are acquiring the software on behalf of the Department of Defense, the
 * software shall be classified as "Commercial Computer Software" and the
 * Government shall have only "Restricted Rights" as defined in Clause
 * 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
 * authors grant the U.S. Government and others acting in its behalf
 * permission to use and distribute the software in accordance with the
 * terms specified in this license. 
 
 * * Tue May 29 12:30:00 PDT 1999 *
 *   getFestivalInterp() added
 *                                 -- Jacques@deVilliers.com
 *
 * * Tue Nov  3 09:23:13 PST 1998 *
 *   modifications for Tcl 8.0.2
 *   export festivalCmd() and setFestivalInterp() as C functions - used
 *   in runtime loadable Speech Toolkit Festival module.
 *                                 -- Jacques@deVilliers.com
 * 
 * * Thu Nov 27 19:27:38 PST 1997 *
 *   updated interface for Tcl 8.0 -- Jacques@deVilliers.com
 *
 * * Sat May 17 13:43:47 BST 1997 *
 *   minor modifications to make it work in 1.1.4  -- awb@cstr.ed.ac.uk
 *
 *---------------------------------------------------------------------------
 * This module adds:
 *   1) Tcl interpreter to Scheme
 *   2) a scheme command to invoke Tcl and a
 *   3) Tcl command to invoke Scheme
 *---------------------------------------------------------------------------
 */
#include <stdio.h>
#include <string.h>
#include "festival.h"
#include "festivalP.h"

#if SUPPORT_TCL
#include <tcl.h>

extern "C" {
  int festivalCmd(ClientData d, Tcl_Interp *interp, int argc, char *argv []);
  void setFestivalInterp(Tcl_Interp *interp);
  Tcl_Interp *getFestivalInterp(void);
	   }

static Tcl_Interp *Interp=NULL;
/* Used when loaded into an external interpreter
 */
void setFestivalInterp(Tcl_Interp *interp)
{
  Interp=interp;
}

Tcl_Interp *getFestivalInterp(void)
{
  if (!Interp) {
    Interp=Tcl_CreateInterp();
    Tcl_Init(Interp);
    Tcl_CreateCommand(Interp,"festival",festivalCmd,NULL,NULL);
  }
  return Interp;
}

/* Scheme: (tcl_eval TCL_COMMAND_STRING)
 *
 * Invoke Tcl interpreter from within Festival's scheme runtime.
 * Returns a LISP string, throws an error if the Tcl command fails.
 * For the time being a single, global Tcl interp will suffice.
 */
static LISP tcl_eval(LISP tcl_command)
{
  char *cmd=(char *)get_c_string(tcl_command);
  
  getFestivalInterp();
  if (Tcl_Eval(Interp,cmd)!=TCL_OK) {
    cerr << Tcl_GetStringResult(Interp) << endl;
    festival_error();
  }
  return strintern(Tcl_GetStringResult(Interp));
}


/* get_c_string replacement - does not raise a global error if the LISP object
 * cannot be converted to a string, returns error instead
 */
static int getStringFromLISP(Tcl_Interp *interp, LISP x)
{
  char *t, fb[TCL_DOUBLE_SPACE];
  char r=TCL_OK;
  
  if(NULLP(x)) t="nil";
  else if TYPEP(x,tc_symbol) t=(char*)PNAME(x);
  else if TYPEP(x,tc_flonum) {Tcl_PrintDouble(interp,FLONM(x),fb); t=fb;}
  else if TYPEP(x,tc_string) t=x->storage_as.string.data;
  else {t="LISP object does not have a string representation"; r=TCL_ERROR;}
  Tcl_SetResult(interp,t,TCL_VOLATILE);
  return r;
}


/* TCL: festival scheme_command
 *
 * Invoke the scheme interpreter that wraps our Tcl interp.
 * Result is a Tcl string
 */
int festivalCmd(ClientData d, Tcl_Interp *interp, int argc, char *argv [])
{
  jmp_buf *old_errjmp=est_errjmp;
  int old_errjmp_ok=errjmp_ok;
  int r=TCL_OK;
  LISP l;

  if(argc!=2) {
    Tcl_AppendResult(interp,"wrong # args: should be \"",argv[0],
		     " scheme_command\"",NULL);
    return TCL_ERROR;
  }
  
  gc_protect(&l);
  errjmp_ok=1;
  est_errjmp=walloc(jmp_buf,1);
  if(setjmp(*est_errjmp)) {
    Tcl_SetResult(interp,"SIOD error",TCL_STATIC);
    r=TCL_ERROR;
  } else {
    EST_String ll=argv[1];
    l=read_from_string((char *)ll);
    l=leval(l,NIL);
    r=getStringFromLISP(interp,l);
  }

  gc_unprotect(&l);
  wfree(est_errjmp);
  est_errjmp=old_errjmp;
  errjmp_ok=old_errjmp_ok;
  return r;
}

/* register our new Scheme functions with Festival
 */
void festival_tcl_init(void)
{
  init_subr_1("tcl_eval",tcl_eval,
	      "(tcl_eval STRING)\n\
  Evaluates STRING as a Tcl command, returns the result as a LISP string");

  proclaim_module("tcl");
}
#else  /* no TCL */
void festival_tcl_init(void)
{
  /* nothing to do */
}
#endif
