Blame support/cltkUtf.c

Packit bd2e5d
/***********************************************************************/
Packit bd2e5d
/*                                                                     */
Packit bd2e5d
/*                 MLTk, Tcl/Tk interface of OCaml                     */
Packit bd2e5d
/*                                                                     */
Packit bd2e5d
/*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
Packit bd2e5d
/*               projet Cristal, INRIA Rocquencourt                    */
Packit bd2e5d
/*            Jacques Garrigue, Kyoto University RIMS                  */
Packit bd2e5d
/*                                                                     */
Packit bd2e5d
/*  Copyright 2002 Institut National de Recherche en Informatique et   */
Packit bd2e5d
/*  en Automatique and Kyoto University.  All rights reserved.         */
Packit bd2e5d
/*  This file is distributed under the terms of the GNU Library        */
Packit bd2e5d
/*  General Public License, with the special exception on linking      */
Packit bd2e5d
/*  described in file LICENSE found in the OCaml source tree.          */
Packit bd2e5d
/*                                                                     */
Packit bd2e5d
/***********************************************************************/
Packit bd2e5d
Packit bd2e5d
/* $Id$ */
Packit bd2e5d
Packit bd2e5d
#include <stdlib.h>
Packit bd2e5d
#include <string.h>
Packit bd2e5d
Packit bd2e5d
#include <tcl.h>
Packit bd2e5d
#include <tk.h>
Packit bd2e5d
#include <mlvalues.h>
Packit bd2e5d
#include <alloc.h>
Packit bd2e5d
#include <memory.h>
Packit bd2e5d
#ifdef HAS_UNISTD
Packit bd2e5d
#include <unistd.h>
Packit bd2e5d
#endif
Packit bd2e5d
#include "camltk.h"
Packit bd2e5d
Packit bd2e5d
#if (TCL_MAJOR_VERSION > 8 || \
Packit bd2e5d
    (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1)) /* 8.1 */
Packit bd2e5d
# define UTFCONVERSION
Packit bd2e5d
#endif
Packit bd2e5d
Packit bd2e5d
#ifdef UTFCONVERSION
Packit bd2e5d
Packit bd2e5d
char *external_to_utf( const char *str ){
Packit bd2e5d
  char *res;
Packit bd2e5d
  Tcl_DString dstr;
Packit bd2e5d
  int length;
Packit bd2e5d
Packit bd2e5d
  Tcl_ExternalToUtfDString(NULL, str, strlen(str), &dstr);
Packit bd2e5d
  length = Tcl_DStringLength(&dstr);
Packit bd2e5d
  res = caml_stat_alloc(length + 1);
Packit bd2e5d
  memmove( res, Tcl_DStringValue(&dstr), length+1);
Packit bd2e5d
  Tcl_DStringFree(&dstr);
Packit bd2e5d
Packit bd2e5d
  return res;
Packit bd2e5d
}
Packit bd2e5d
Packit bd2e5d
char *utf_to_external( const char *str ){
Packit bd2e5d
  char *res;
Packit bd2e5d
  Tcl_DString dstr;
Packit bd2e5d
  int length;
Packit bd2e5d
Packit bd2e5d
  Tcl_UtfToExternalDString(NULL, str, strlen(str), &dstr);
Packit bd2e5d
  length = Tcl_DStringLength(&dstr);
Packit bd2e5d
  res = caml_stat_alloc(length + 1);
Packit bd2e5d
  memmove( res, Tcl_DStringValue(&dstr), length+1);
Packit bd2e5d
  Tcl_DStringFree(&dstr);
Packit bd2e5d
Packit bd2e5d
  return res;
Packit bd2e5d
}
Packit bd2e5d
Packit bd2e5d
char *caml_string_to_tcl( value s )
Packit bd2e5d
{
Packit bd2e5d
  return external_to_utf( String_val(s) );
Packit bd2e5d
}
Packit bd2e5d
Packit bd2e5d
value tcl_string_to_caml( const char *s )
Packit bd2e5d
{
Packit bd2e5d
  CAMLparam0();
Packit bd2e5d
  CAMLlocal1(res);
Packit bd2e5d
  char *str;
Packit bd2e5d
Packit bd2e5d
  str = utf_to_external( s );
Packit bd2e5d
  res = caml_copy_string(str);
Packit bd2e5d
  caml_stat_free(str);
Packit bd2e5d
  CAMLreturn(res);
Packit bd2e5d
}
Packit bd2e5d
Packit bd2e5d
#else
Packit bd2e5d
Packit bd2e5d
char *caml_string_to_tcl(value s){ return string_to_c(s); }
Packit bd2e5d
value tcl_string_to_caml(char *s){ return caml_copy_string(s); }
Packit bd2e5d
Packit bd2e5d
#endif