Remove labltk from the distribution (will be available as a third-party library).

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14077 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 0 insertions, 243 deletions

diff --git a/otherlibs/labltk/support/cltkEval.c b/otherlibs/labltk/support/cltkEval.c
deleted file mode 100644
index c7a43481c..000000000
--- a/otherlibs/labltk/support/cltkEval.c
+++ /dev/null
@@ -1,243 +0,0 @@
-/***********************************************************************/
-/*                                                                     */
-/*                 MLTk, Tcl/Tk interface of OCaml                     */
-/*                                                                     */
-/*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    */
-/*               projet Cristal, INRIA Rocquencourt                    */
-/*            Jacques Garrigue, Kyoto University RIMS                  */
-/*                                                                     */
-/*  Copyright 2002 Institut National de Recherche en Informatique et   */
-/*  en Automatique and Kyoto University.  All rights reserved.         */
-/*  This file is distributed under the terms of the GNU Library        */
-/*  General Public License, with the special exception on linking      */
-/*  described in file LICENSE found in the OCaml source tree.          */
-/*                                                                     */
-/***********************************************************************/
-
-/* $Id$ */
-
-#include <stdlib.h>
-#include <string.h>
-
-#include <tcl.h>
-#include <tk.h>
-#include <mlvalues.h>
-#include <alloc.h>
-#include <memory.h>
-#ifdef HAS_UNISTD
-#include <unistd.h>
-#endif
-#include "camltk.h"
-
-/* The Tcl interpretor */
-Tcl_Interp *cltclinterp = NULL;
-
-/* Copy a list of strings from the C heap to OCaml */
-value copy_string_list(int argc, char **argv)
-{
-  CAMLparam0();
-  CAMLlocal3( res, oldres, str );
-  int i;
-  oldres = Val_unit;
-  str = Val_unit;
-
-  res = Val_int(0); /* [] */
-  for (i = argc-1; i >= 0; i--) {
-    oldres = res;
-    str = tcl_string_to_caml(argv[i]);
-    res = alloc(2, 0);
-    Field(res, 0) = str;
-    Field(res, 1) = oldres;
-  }
-  CAMLreturn(res);
-}
-
-/*
- * Calling Tcl from OCaml
- *   this version works on an arbitrary Tcl command,
- *   and does parsing and substitution
- */
-CAMLprim value camltk_tcl_eval(value str)
-{
-  int code;
-  char *cmd = NULL;
-
-  CheckInit();
-
-  /* Tcl_Eval may write to its argument, so we take a copy
-   * If the evaluation raises an OCaml exception, we have a space
-   * leak
-   */
-  Tcl_ResetResult(cltclinterp);
-  cmd = caml_string_to_tcl(str);
-  code = Tcl_Eval(cltclinterp, cmd);
-  stat_free(cmd);
-
-  switch (code) {
-  case TCL_OK:
-    return tcl_string_to_caml(Tcl_GetStringResult(cltclinterp));
-  case TCL_ERROR:
-    tk_error(Tcl_GetStringResult(cltclinterp));
-  default:  /* TCL_BREAK, TCL_CONTINUE, TCL_RETURN */
-    tk_error("bad tcl result");
-  }
-}
-
-/*
- * Calling Tcl from OCaml
- *   direct call, argument is TkArgs vect
-  type TkArgs =
-      TkToken of string
-    | TkTokenList of TkArgs list                (* to be expanded *)
-    | TkQuote of TkArgs                         (* mapped to Tcl list *)
- * NO PARSING, NO SUBSTITUTION
- */
-
-/*
- * Compute the size of the argument (of type TkArgs).
- * TkTokenList must be expanded,
- * TkQuote count for one.
- */
-int argv_size(value v)
-{
-  switch (Tag_val(v)) {
-  case 0:                       /* TkToken */
-    return 1;
-  case 1:                       /* TkTokenList */
-    { int n = 0;
-      value l;
-      for (l=Field(v,0), n=0; Is_block(l); l=Field(l,1))
-        n+=argv_size(Field(l,0));
-      return n;
-    }
-  case 2:                       /* TkQuote */
-    return 1;
-  default:
-    tk_error("argv_size: illegal tag");
-  }
-}
-
-/* Fill a preallocated vector arguments, doing expansion and all.
- * Assumes Tcl will
- *  not tamper with our strings
- *  make copies if strings are "persistent"
- */
-int fill_args (char **argv, int where, value v)
-{
-  value l;
-
-  switch (Tag_val(v)) {
-  case 0:
-    argv[where] = caml_string_to_tcl(Field(v,0)); /* must free by stat_free */
-    return (where + 1);
-  case 1:
-    for (l=Field(v,0); Is_block(l); l=Field(l,1))
-      where = fill_args(argv,where,Field(l,0));
-    return where;
-  case 2:
-    { char **tmpargv;
-      char *merged;
-      int i;
-      int size = argv_size(Field(v,0));
-      tmpargv = (char **)caml_stat_alloc((size + 1) * sizeof(char *));
-      fill_args(tmpargv,0,Field(v,0));
-      tmpargv[size] = NULL;
-      merged = Tcl_Merge(size,(const char *const*)tmpargv);
-      for(i = 0; i<size; i++){ stat_free(tmpargv[i]); }
-      stat_free((char *)tmpargv);
-      /* must be freed by stat_free */
-      argv[where] = (char*)caml_stat_alloc(strlen(merged)+1);
-      strcpy(argv[where], merged);
-      Tcl_Free(merged);
-      return (where + 1);
-    }
-  default:
-    tk_error("fill_args: illegal tag");
-  }
-}
-
-/* v is an array of TkArg */
-CAMLprim value camltk_tcl_direct_eval(value v)
-{
-  int i;
-  int size;                     /* size of argv */
-  char **argv, **allocated;
-  int result;
-  Tcl_CmdInfo info;
-
-  CheckInit();
-
-  /* walk the array to compute final size for Tcl */
-  for(i=0, size=0; i<Wosize_val(v); i++)
-    size += argv_size(Field(v,i));
-
-  /* +2: one slot for NULL
-         one slot for "unknown" if command not found */
-  argv = (char **)caml_stat_alloc((size + 2) * sizeof(char *));
-  allocated = (char **)caml_stat_alloc(size * sizeof(char *));
-
-  /* Copy -- argv[i] must be freed by stat_free */
-  {
-    int where;
-    for(i=0, where=0; i<Wosize_val(v); i++){
-      where = fill_args(argv,where,Field(v,i));
-    }
-    if( size != where ){ tk_error("fill_args error!!! Call the CamlTk maintainer!"); }
-    for(i=0; i<where; i++){ allocated[i] = argv[i]; }
-    argv[size] = NULL;
-    argv[size + 1] = NULL;
-  }
-
-  /* Eval */
-  Tcl_ResetResult(cltclinterp);
-  if (Tcl_GetCommandInfo(cltclinterp,argv[0],&info)) { /* command found */
-#if (TCL_MAJOR_VERSION >= 8)
-    /* info.proc might be a NULL pointer
-     * We should probably attempt an Obj invocation, but the following quick
-     * hack is easier.
-     */
-    if (info.proc == NULL) {
-      Tcl_DString buf;
-      Tcl_DStringInit(&buf);
-      Tcl_DStringAppend(&buf, argv[0], -1);
-      for (i=1; i<size; i++) {
-        Tcl_DStringAppend(&buf, " ", -1);
-        Tcl_DStringAppend(&buf, argv[i], -1);
-      }
-      result = Tcl_Eval(cltclinterp, Tcl_DStringValue(&buf));
-      Tcl_DStringFree(&buf);
-    } else {
-      result = (*info.proc)(info.clientData,cltclinterp,size,(const char**)argv);
-    }
-#else
-    result = (*info.proc)(info.clientData,cltclinterp,size,(const char**)argv);
-#endif
-  } else { /* implement the autoload stuff */
-    if (Tcl_GetCommandInfo(cltclinterp,"unknown",&info)) { /* unknown found */
-      for (i = size; i >= 0; i--)
-        argv[i+1] = argv[i];
-      argv[0] = "unknown";
-      result = (*info.proc)(info.clientData,cltclinterp,size+1,(const char**)argv);
-    } else { /* ah, it isn't there at all */
-      result = TCL_ERROR;
-      Tcl_AppendResult(cltclinterp, "Unknown command \"",
-                       argv[0], "\"", NULL);
-    }
-  }
-
-  /* Free the various things we allocated */
-  for(i=0; i< size; i ++){
-    stat_free((char *) allocated[i]);
-  }
-  stat_free((char *)argv);
-  stat_free((char *)allocated);
-
-  switch (result) {
-  case TCL_OK:
-    return tcl_string_to_caml (Tcl_GetStringResult(cltclinterp));
-  case TCL_ERROR:
-    tk_error(Tcl_GetStringResult(cltclinterp));
-  default:  /* TCL_BREAK, TCL_CONTINUE, TCL_RETURN */
-    tk_error("bad tcl result");
-  }
-}