diff options
author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 1999-11-16 10:29:03 +0000 |
---|---|---|
committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 1999-11-16 10:29:03 +0000 |
commit | 27c082c04663ff18459777e111aca4cde20df265 (patch) | |
tree | d74a2991f4712aa20929a763bb65997c16da94ff /otherlibs/labltk/support/cltkFile.c | |
parent | 8f492b2886fb03a3c23f0d2581222445285d6d28 (diff) |
leave labltk only in olabl branch
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2536 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk/support/cltkFile.c')
-rw-r--r-- | otherlibs/labltk/support/cltkFile.c | 111 |
1 files changed, 0 insertions, 111 deletions
diff --git a/otherlibs/labltk/support/cltkFile.c b/otherlibs/labltk/support/cltkFile.c deleted file mode 100644 index a890aba11..000000000 --- a/otherlibs/labltk/support/cltkFile.c +++ /dev/null @@ -1,111 +0,0 @@ -#ifdef _WIN32 -#include <wtypes.h> -#include <winbase.h> -#include <winsock.h> -#endif -#include <tcl.h> -#include <tk.h> -#include <caml/mlvalues.h> -#include "camltk.h" - -/* - * File descriptor callbacks - */ - -void FileProc(ClientData clientdata, int mask) -{ - callback2(*handler_code,Val_int(clientdata),Val_int(0)); -} - -/* Map Unix.file_descr values to Tcl file handles */ - -#ifndef _WIN32 - -/* Unix system */ - -#if TCL_MAJOR_VERSION >= 8 -#define tcl_filehandle(fd) Int_val(fd) -#define Tcl_File int -#define Tcl_FreeFile(fd) -#else -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); -} - -#endif - -value camltk_add_file_input(fd, cbid) /* ML */ - value fd; - value cbid; -{ - CheckInit(); - Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_READABLE, - FileProc, (ClientData)(Long_val(cbid))); - return Val_unit; -} - -/* We have to free the Tcl handle when we are finished using it (Tcl - * asks us to, and moreover it is probably dangerous to keep the same - * handle over two allocations of the same fd by the kernel). - * But we don't know when we are finished with the fd, so we free it - * 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; -{ - Tcl_File fh = tcl_filehandle(fd); - Tcl_DeleteFileHandler(fh); - Tcl_FreeFile(fh); - return Val_unit; -} - -value camltk_add_file_output(fd, cbid) /* ML */ - value fd; - value cbid; -{ - CheckInit(); - Tcl_CreateFileHandler(tcl_filehandle(fd), TCL_WRITABLE, - FileProc, (ClientData) (Long_val(cbid))); - return Val_unit; -} - -value camltk_rem_file_output(fd) /* ML */ - value fd; -{ - Tcl_File fh = tcl_filehandle(fd); - Tcl_DeleteFileHandler(fh); - Tcl_FreeFile(fh); - return Val_unit; -} - |