Blame support/cltkFile.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
#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