|
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 |
#ifdef _WIN32
|
|
Packit |
bd2e5d |
#include <wtypes.h>
|
|
Packit |
bd2e5d |
#include <winbase.h>
|
|
Packit |
bd2e5d |
#include <winsock.h>
|
|
Packit |
bd2e5d |
#endif
|
|
Packit |
bd2e5d |
#include <tcl.h>
|
|
Packit |
bd2e5d |
#include <tk.h>
|
|
Packit |
bd2e5d |
#include <mlvalues.h>
|
|
Packit |
bd2e5d |
#include <callback.h>
|
|
Packit |
bd2e5d |
#include "camltk.h"
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
/*
|
|
Packit |
bd2e5d |
* File descriptor callbacks
|
|
Packit |
bd2e5d |
*/
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
void FileProc(ClientData clientdata, int mask)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
caml_callback2(*handler_code,Val_int(clientdata),Val_int(0));
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
/* Map Unix.file_descr values to Tcl file handles */
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
#ifndef _WIN32
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
/* Under Unix, we use file handlers */
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
/* Map Unix.file_descr values to Tcl file handles (for tcl 7)
|
|
Packit |
bd2e5d |
or Unix file descriptors (for tcl 8). */
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
#if (TCL_MAJOR_VERSION < 8)
|
|
Packit |
bd2e5d |
static Tcl_File tcl_filehandle(value fd)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
return Tcl_GetFile((ClientData)Long_val(fd), TCL_UNIX_FD);
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
#else
|
|
Packit |
bd2e5d |
#define tcl_filehandle(fd) Int_val(fd)
|
|
Packit |
bd2e5d |
#define Tcl_File int
|
|
Packit |
bd2e5d |
#endif
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
CAMLprim value camltk_add_file_input(value fd, value cbid)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
CheckInit();
|
|
Packit |
bd2e5d |
Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_READABLE,
|
|
Packit |
bd2e5d |
FileProc, (ClientData)(Long_val(cbid)));
|
|
Packit |
bd2e5d |
return Val_unit;
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
/* We have to free the Tcl handle when we are finished using it (Tcl
|
|
Packit |
bd2e5d |
* asks us to, and moreover it is probably dangerous to keep the same
|
|
Packit |
bd2e5d |
* handle over two allocations of the same fd by the kernel).
|
|
Packit |
bd2e5d |
* But we don't know when we are finished with the fd, so we free it
|
|
Packit |
bd2e5d |
* in rem_file (it doesn't close the fd anyway). For fds for which we
|
|
Packit |
bd2e5d |
* repeatedly add/rem, this will cause some overhead.
|
|
Packit |
bd2e5d |
*/
|
|
Packit |
bd2e5d |
CAMLprim value camltk_rem_file_input(value fd, value cbid)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
Tcl_File fh = tcl_filehandle(fd);
|
|
Packit |
bd2e5d |
Tcl_DeleteFileHandler(fh);
|
|
Packit |
bd2e5d |
#if (TCL_MAJOR_VERSION < 8)
|
|
Packit |
bd2e5d |
Tcl_FreeFile(fh);
|
|
Packit |
bd2e5d |
#endif
|
|
Packit |
bd2e5d |
return Val_unit;
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
CAMLprim value camltk_add_file_output(value fd, value cbid)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
CheckInit();
|
|
Packit |
bd2e5d |
Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_WRITABLE,
|
|
Packit |
bd2e5d |
FileProc, (ClientData) (Long_val(cbid)));
|
|
Packit |
bd2e5d |
return Val_unit;
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
CAMLprim value camltk_rem_file_output(value fd, value cbid)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
Tcl_File fh = tcl_filehandle(fd);
|
|
Packit |
bd2e5d |
Tcl_DeleteFileHandler(fh);
|
|
Packit |
bd2e5d |
#if (TCL_MAJOR_VERSION < 8)
|
|
Packit |
bd2e5d |
Tcl_FreeFile(fh);
|
|
Packit |
bd2e5d |
#endif
|
|
Packit |
bd2e5d |
return Val_unit;
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
#else
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
/* Under Win32, we go through the generic channel abstraction */
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
#define Handle_val(v) (*((HANDLE *) Data_custom_val(v)))
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
/* Map Unix.file_descr values to Tcl channels */
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
static Tcl_Channel tcl_channel(value fd, int flags)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
HANDLE h = Handle_val(fd);
|
|
Packit |
bd2e5d |
int optval, optsize;
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
optsize = sizeof(optval);
|
|
Packit |
bd2e5d |
if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE,
|
|
Packit |
bd2e5d |
(char *)&optval, &optsize) == 0)
|
|
Packit |
bd2e5d |
return Tcl_MakeTcpClientChannel((ClientData) h);
|
|
Packit |
bd2e5d |
else
|
|
Packit |
bd2e5d |
return Tcl_MakeFileChannel((ClientData) h, flags);
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
CAMLprim value camltk_add_file_input(value fd, value cbid)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
CheckInit();
|
|
Packit |
bd2e5d |
Tcl_CreateChannelHandler(tcl_channel(fd, TCL_READABLE),
|
|
Packit |
bd2e5d |
TCL_READABLE,
|
|
Packit |
bd2e5d |
FileProc, (ClientData) (Int_val(cbid)));
|
|
Packit |
bd2e5d |
return Val_unit;
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
CAMLprim value camltk_rem_file_input(value fd, value cbid)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
Tcl_DeleteChannelHandler(tcl_channel(fd, TCL_READABLE),
|
|
Packit |
bd2e5d |
FileProc, (ClientData) (Int_val(cbid)));
|
|
Packit |
bd2e5d |
return Val_unit;
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
CAMLprim value camltk_add_file_output(value fd, value cbid)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
CheckInit();
|
|
Packit |
bd2e5d |
Tcl_CreateChannelHandler(tcl_channel(fd, TCL_WRITABLE),
|
|
Packit |
bd2e5d |
TCL_WRITABLE,
|
|
Packit |
bd2e5d |
FileProc, (ClientData) (Int_val(cbid)));
|
|
Packit |
bd2e5d |
return Val_unit;
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
CAMLprim value camltk_rem_file_output(value fd, value cbid)
|
|
Packit |
bd2e5d |
{
|
|
Packit |
bd2e5d |
Tcl_DeleteChannelHandler(tcl_channel(fd, TCL_WRITABLE),
|
|
Packit |
bd2e5d |
FileProc, (ClientData) (Int_val(cbid)));
|
|
Packit |
bd2e5d |
return Val_unit;
|
|
Packit |
bd2e5d |
}
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
#endif
|