Posted to tcl by sebres at Mon Jan 21 15:18:14 GMT 2019view raw
- /*
- * 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;
- }