version 1.122 | version 1.123 |
---|
| |
} | } |
| |
int ScriptTcl::Tcl_colvars(ClientData clientData, | int ScriptTcl::Tcl_colvars(ClientData clientData, |
Tcl_Interp *interp, int argc, char *argv[]) { | Tcl_Interp *interp, |
| int objc, |
| Tcl_Obj *const objv[]) |
| { |
ScriptTcl *script = (ScriptTcl *)clientData; | ScriptTcl *script = (ScriptTcl *)clientData; |
script->initcheck(); | script->initcheck(); |
colvarmodule *colvars = Node::Object()->colvars; | colvarmodule *colvars = Node::Object()->colvars; |
| |
Tcl_SetResult(interp,"colvars module not active",TCL_VOLATILE); | Tcl_SetResult(interp,"colvars module not active",TCL_VOLATILE); |
return TCL_ERROR; | return TCL_ERROR; |
} | } |
int retval = colvars->proxy->script->run(argc, (char const **) argv); | colvarscript *cvscript = colvars->proxy->script; |
// use Tcl dynamic allocation to prevent having to copy the buffer | int retval = cvscript->run(objc, reinterpret_cast<unsigned char * const *>(objv)); |
// *twice* just because Tcl is missing const qualifiers for strings | |
char *buf = Tcl_Alloc(colvars->proxy->script->result.length() + 1); | bool const no_errors = (retval == COLVARSCRIPT_OK) && |
strncpy(buf, colvars->proxy->script->result.c_str(), colvars->proxy->script->result.length() + 1); | (cvm::get_error() == COLVARS_OK); |
Tcl_SetResult(interp, buf, TCL_DYNAMIC); | |
// Note: sometimes Tcl 8.5 will segfault here | |
// (only on error conditions, apparently) | |
// http://sourceforge.net/p/tcl/bugs/4677/ | |
// Fixed in Tcl 8.6 | |
| |
if (retval == COLVARSCRIPT_OK && !cvm::get_error()) | Tcl_Obj *obj = Tcl_NewStringObj(cvscript->result.c_str(), |
| cvscript->result.length() + 1); |
| Tcl_SetObjResult(interp, obj); |
| |
| if (no_errors) { |
return TCL_OK; | return TCL_OK; |
else | } else { |
return TCL_ERROR; | return TCL_ERROR; |
} | } |
| } |
| |
int ScriptTcl::Tcl_checkpoint(ClientData clientData, | int ScriptTcl::Tcl_checkpoint(ClientData clientData, |
Tcl_Interp *interp, int argc, char *argv[]) { | Tcl_Interp *interp, int argc, char *argv[]) { |
| |
(ClientData) this, (Tcl_CmdDeleteProc *) NULL); | (ClientData) this, (Tcl_CmdDeleteProc *) NULL); |
Tcl_CreateCommand(interp, "colvarvalue", Tcl_colvarvalue, | Tcl_CreateCommand(interp, "colvarvalue", Tcl_colvarvalue, |
(ClientData) this, (Tcl_CmdDeleteProc *) NULL); | (ClientData) this, (Tcl_CmdDeleteProc *) NULL); |
Tcl_CreateCommand(interp, "cv", Tcl_colvars, | Tcl_CreateObjCommand(interp, "cv", Tcl_colvars, |
(ClientData) this, (Tcl_CmdDeleteProc *) NULL); | (ClientData) this, (Tcl_CmdDeleteProc *) NULL); |
Tcl_CreateCommand(interp, "colvarfreq", Tcl_colvarfreq, | Tcl_CreateCommand(interp, "colvarfreq", Tcl_colvarfreq, |
(ClientData) this, (Tcl_CmdDeleteProc *) NULL); | (ClientData) this, (Tcl_CmdDeleteProc *) NULL); |