Richard Suchenwirth 2007-05-04 - MJ contributed this nice example of how to extend Tcl with a new subcommand to the chan ensemble (new from 8.5). First, write a self-contained function that implements what you want - in this case, return a string indicating whether the given channel is readable (r) and/or writable (w):
/*
*----------------------------------------------------------------------
*
* Tcl_ModeObjCmd --
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
int
Tcl_ModeObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to puts on. */
const char *channelId; /* Name of channel for puts. */
int mode; /* Mode in which channel is opened. */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
channelId = Tcl_GetString(objv[1]);
chan = Tcl_GetChannel(interp, channelId, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) != 0) {
Tcl_AppendElement(interp, "r");
}
if ((mode & TCL_WRITABLE) != 0) {
Tcl_AppendElement(interp, "w");
}
return TCL_OK;
}Then, make it available as a command to Tcl:
Tcl_CreateObjCommand(interp, "::tcl::chan::mode",
Tcl_ModeObjCmd, NULL, NULL);Finally, in init.tcl, register that new command as ensemble member of chan:
# Set up the 'chan' ensemble (TIP #208).
namespace eval chan {
# TIP #219. Added methods: create, postevent.
# TIP 287. Added method: pending.
namespace ensemble create -command ::chan -map {
blocked ::tcl::chan::blocked
close ::tcl::chan::close
configure ::tcl::chan::configure
copy ::tcl::chan::copy
create ::tcl::chan::rCreate
eof ::tcl::chan::eof
event ::tcl::chan::event
flush ::tcl::chan::flush
gets ::tcl::chan::gets
mode {::tcl::chan::mode ;############### here}
names {::file channels}
pending ::tcl::chan::Pending
postevent ::tcl::chan::rPostevent
puts ::tcl::chan::puts
read ::tcl::chan::read
seek ::tcl::chan::seek
tell ::tcl::chan::tell
truncate ::tcl::chan::Truncate
}
}