chanhandle.c -- small C-module to get native handle of tcl-channel

/*
 * chanhandle.c --
 * 
 * Test module to get native handle of channel.
 *
 * Compile:
 *   mingw: gcc -O2 -DUSE_TCL_STUBS=1 -I$tcl/win  -I$tcl/generic chanhandle.c -shared -o chanhandle.dll libtclstub87.a
 *   *nix:  gcc -O2 -DUSE_TCL_STUBS=1 -I$tcl/unix -I$tcl/generic chanhandle.c -shared -o chanhandle.so  libtclstub87.a
 * 
 * Usage:
 *   $ tclsh87
 *   % load chanhandle
 *   % chan-handle r stdin
 *   % chan-handle w stdout
 *   % chan-handle r [set s [socket 127.0.0.1 80]]
 *   % chan-handle w $s
 */

#include "tcl.h"

int GetChanHandleObjCmd(
  ClientData dummy,
  Tcl_Interp* interp,
  int objc,
  Tcl_Obj * const objv[]
) {
  Tcl_Channel chan;
  ClientData handle;

  if (objc != 3) {
    Tcl_WrongNumArgs(interp, 1, objv, "r|w channel");
    return TCL_ERROR;
  }
  
  chan = Tcl_GetChannel(interp, Tcl_GetString(objv[2]), NULL);
  if (!chan) {
    return TCL_ERROR;
  }
  
  handle = 0;
  if (Tcl_GetChannelHandle(chan, 
    (*Tcl_GetString(objv[1]) == 'r' ? TCL_READABLE : TCL_WRITABLE),
    &handle) != TCL_OK) {
    // Tcl_ResetResult(interp);
    return TCL_OK;
  };

  Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((intptr_t)handle)));
  return TCL_OK;
}

int Chanhandle_Init(Tcl_Interp *interp) {
  if (!Tcl_InitStubs(interp, "8.5", 0)) {
    return TCL_ERROR;
  }
  Tcl_CreateObjCommand(interp, "chan-handle", GetChanHandleObjCmd, NULL, NULL);
  return TCL_OK;
}