synchronize with bazar-ocaml/camltk41

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2761 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
author: Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> 2000-01-20 03:01:18 +0000
committer: Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> 2000-01-20 03:01:18 +0000
commit: 7ad04d651d11c14ea85310d4980651d61add2da8 (patch)
tree: 58084c94199318afea2ada35b0fac17c2de27342 /otherlibs/labltk/support
parent: a928f5cd699efe6c46d15958572848ce90d44478 (diff)
5 files changed, 98 insertions, 51 deletions
diff --git a/otherlibs/labltk/support/cltkDMain.c b/otherlibs/labltk/support/cltkDMain.c
index 2b5b819e9..bda74a756 100644
--- a/otherlibs/labltk/support/cltkDMain.c
+++ b/otherlibs/labltk/support/cltkDMain.c
@@ -190,7 +190,7 @@ int CamlInvokeCmd(dummy
 
 
 /* Now the real Tk stuff */
-static Tk_Window mainWindow;
+Tk_Window cltk_mainWindow;
 
 #define RCNAME ".camltkrc"
 #define CAMLCB "camlcb"
diff --git a/otherlibs/labltk/support/cltkEval.c b/otherlibs/labltk/support/cltkEval.c
index ff9eb5702..5d1efa9df 100644
--- a/otherlibs/labltk/support/cltkEval.c
+++ b/otherlibs/labltk/support/cltkEval.c
@@ -54,7 +54,8 @@ value copy_string_list(argc, argv)
 
 /*
  * Calling Tcl from Caml
- *   this version works on an arbitrary Tcl command
+ *   this version works on an arbitrary Tcl command,
+ *   and does parsing and substitution
  */
 value camltk_tcl_eval(str) /* ML */
 value str; 
@@ -206,7 +207,29 @@ value v;
     /* 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;
+        char *string;
+        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);
+        }
+        // fprintf(stderr,"80 compat: %s\n", argv[0]);
+        result = Tcl_Eval(cltclinterp, Tcl_DStringValue(&buf));
+        Tcl_DStringFree(&buf);
+      }
+      else
+        result = (*info.proc)(info.clientData,cltclinterp,size,argv);
+#else
       result = (*info.proc)(info.clientData,cltclinterp,size,argv);
+#endif
     } else {/* implement the autoload stuff */
       if (Tcl_GetCommandInfo(cltclinterp,"unknown",&info)) { /* unknown found */
         for (i = size; i >= 0; i--)
diff --git a/otherlibs/labltk/support/cltkFile.c b/otherlibs/labltk/support/cltkFile.c
index ec456ffba..93f459076 100644
--- a/otherlibs/labltk/support/cltkFile.c
+++ b/otherlibs/labltk/support/cltkFile.c
@@ -38,52 +38,22 @@ void FileProc(ClientData clientdata, int mask)
 
 #ifndef _WIN32
 
-/* Unix system */
+/* Under Unix, we use file handlers */
 
-#if TCL_MAJOR_VERSION >= 8
-#define tcl_filehandle(fd) Int_val(fd)
-#define Tcl_File int
-#define Tcl_FreeFile(fd)
-#else
+/* Map Unix.file_descr values to Tcl file handles (for tcl 7)
+   or Unix file descriptors (for tcl 8). */
+
+#if (TCL_MAJOR_VERSION < 8)
 static Tcl_File tcl_filehandle(value fd)
 {
   return Tcl_GetFile((ClientData)Long_val(fd), TCL_UNIX_FD);
 }
-#endif
-
 #else
-
-/* Windows */
-
-#define Handle_val(v) (*((HANDLE *)(v)))
-
-static Tcl_File tcl_filehandle(value fd)
-{
-  HANDLE h = Handle_val(fd);
-  int type;
-  int optval, optsize;
-
-  optsize = sizeof(optval);
-  if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE, &optval, &optsize) == 0)
-    type = TCL_WIN_SOCKET;
-  else
-    switch (GetFileType(h)) {
-    case FILE_TYPE_CHAR:
-      type = TCL_WIN_CONSOLE;
-    case FILE_TYPE_PIPE:
-      type = TCL_WIN_PIPE;
-    case FILE_TYPE_DISK:
-    default:                    /* use WIN_FILE for unknown handles */
-      type = TCL_WIN_FILE;
-    }
-  return Tcl_GetFile(h, type);
-}
-
+#define tcl_filehandle(fd) Int_val(fd)
+#define Tcl_File int
 #endif
 
-value camltk_add_file_input(fd, cbid)    /* ML */
-     value fd;
-     value cbid;
+value camltk_add_file_input(value fd, value cbid)    /* ML */
 {
   CheckInit();
   Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_READABLE, 
@@ -98,18 +68,17 @@ value camltk_add_file_input(fd, cbid)    /* ML */
  * in rem_file (it doesn't close the fd anyway). For fds for which we
  * repeatedly add/rem, this will cause some overhead.
  */
-value camltk_rem_file_input(fd) /* ML */
-     value fd;
+value camltk_rem_file_input(value fd, value cbid) /* ML */
 {
   Tcl_File fh = tcl_filehandle(fd);
   Tcl_DeleteFileHandler(fh);
+#if (TCL_MAJOR_VERSION < 8)
   Tcl_FreeFile(fh);
+#endif
   return Val_unit;
 }
 
-value camltk_add_file_output(fd, cbid)    /* ML */
-     value fd;
-     value cbid;
+value camltk_add_file_output(value fd, value cbid)    /* ML */
 {
   CheckInit();
   Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_WRITABLE, 
@@ -117,12 +86,67 @@ value camltk_add_file_output(fd, cbid)    /* ML */
   return Val_unit;
 }
 
-value camltk_rem_file_output(fd) /* ML */
-     value fd;
+value camltk_rem_file_output(value fd, value cbid) /* ML */
 {
   Tcl_File fh = tcl_filehandle(fd);
   Tcl_DeleteFileHandler(fh);
+#if (TCL_MAJOR_VERSION < 8)
   Tcl_FreeFile(fh);
+#endif
+  return Val_unit;
+}
+
+#else
+
+/* Under Win32, we go through the generic channel abstraction */
+
+/* Map Unix.file_descr values to Tcl channels */
+
+#define Handle_val(v) (*((HANDLE *)(v)))
+
+static Tcl_Channel tcl_channel(value fd, int flags)
+{
+  HANDLE h = Handle_val(fd);
+  int optval, optsize;
+
+  optsize = sizeof(optval);
+  if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE,
+                 (char *)&optval, &optsize) == 0)
+    return Tcl_MakeTcpClientChannel((ClientData) h);
+  else
+    return Tcl_MakeFileChannel((ClientData) h, flags);
+}
+
+value camltk_add_file_input(value fd, value cbid)    /* ML */
+{
+  CheckInit();
+  Tcl_CreateChannelHandler(tcl_channel(fd, TCL_READABLE),
+                           TCL_READABLE,
+                           FileProc, (ClientData) (Int_val(cbid)));
   return Val_unit;
 }
 
+value camltk_rem_file_input(value fd, value cbid) /* ML */
+{
+  Tcl_DeleteChannelHandler(tcl_channel(fd, TCL_READABLE),
+                           FileProc, (ClientData) (Int_val(cbid)));
+  return Val_unit;
+}
+
+value camltk_add_file_output(value fd, value cbid)    /* ML */
+{
+  CheckInit();
+  Tcl_CreateChannelHandler(tcl_channel(fd, TCL_WRITABLE),
+                           TCL_WRITABLE,
+                           FileProc, (ClientData) (Int_val(cbid)));
+  return Val_unit;
+}
+
+value camltk_rem_file_output(value fd, value cbid) /* ML */
+{
+  Tcl_DeleteChannelHandler(tcl_channel(fd, TCL_WRITABLE),
+                           FileProc, (ClientData) (Int_val(cbid)));
+  return Val_unit;
+}
+
+#endif
diff --git a/otherlibs/labltk/support/cltkMain.c b/otherlibs/labltk/support/cltkMain.c
index 64fd972b6..bd9ebe439 100644
--- a/otherlibs/labltk/support/cltkMain.c
+++ b/otherlibs/labltk/support/cltkMain.c
@@ -69,7 +69,7 @@ value camltk_opentk(display, name) /* ML */
 {
   if (!cltk_slave_mode) {
     /* Create an interpreter, dies if error */
-#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 1
     Tcl_FindExecutable(String_val(name));
 #endif
     cltclinterp = Tcl_CreateInterp();
diff --git a/otherlibs/labltk/support/cltkTimer.c b/otherlibs/labltk/support/cltkTimer.c
index c7c454251..8de594314 100644
--- a/otherlibs/labltk/support/cltkTimer.c
+++ b/otherlibs/labltk/support/cltkTimer.c
@@ -34,14 +34,14 @@ value camltk_add_timer(milli, cbid) /* ML */
 {
   CheckInit();
   /* look at tkEvent.c , Tk_Token is an int */ 
-  return (value)Tcl_CreateTimerHandler(Int_val(milli), TimerProc, 
-                                       (ClientData) (Long_val(cbid)));
+  return (Val_int(Tcl_CreateTimerHandler(Int_val(milli), TimerProc, 
+                                       (ClientData) (Int_val(cbid)))));
 }
 
 value camltk_rem_timer(token) /* ML */
      value token;
 {
-  Tcl_DeleteTimerHandler((Tcl_TimerToken) token);
+  Tcl_DeleteTimerHandler((Tcl_TimerToken) Int_val(token));
   return Val_unit;
 }
author	Jacques Garrigue <garrigue at math.nagoya-u.ac.jp>	2000-01-20 03:01:18 +0000
committer	Jacques Garrigue <garrigue at math.nagoya-u.ac.jp>	2000-01-20 03:01:18 +0000
commit	7ad04d651d11c14ea85310d4980651d61add2da8 (patch)
tree	58084c94199318afea2ada35b0fac17c2de27342 /otherlibs/labltk/support
parent	a928f5cd699efe6c46d15958572848ce90d44478 (diff)