| 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); |