| Line 1... |
Line 1... |
// $Id: RtclClassBase.cpp 488 2013-02-16 18:49:47Z mueller $
|
// $Id: RtclClassBase.cpp 584 2014-08-22 19:38:12Z mueller $
|
//
|
//
|
// Copyright 2011-2013 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
// Copyright 2011-2014 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
//
|
//
|
// This program is free software; you may redistribute and/or modify it under
|
// This program is free software; you may redistribute and/or modify it under
|
// the terms of the GNU General Public License as published by the Free
|
// the terms of the GNU General Public License as published by the Free
|
// Software Foundation, either version 2, or at your option any later version.
|
// Software Foundation, either version 2, or at your option any later version.
|
//
|
//
|
| Line 11... |
Line 11... |
// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
// for complete details.
|
// for complete details.
|
//
|
//
|
// Revision History:
|
// Revision History:
|
// Date Rev Version Comment
|
// Date Rev Version Comment
|
|
// 2014-08-22 584 1.0.4 use nullptr
|
// 2013-02-10 485 1.0.3 add static const defs
|
// 2013-02-10 485 1.0.3 add static const defs
|
// 2013-01-13 474 1.0.2 TclClassCmd(): check for existing Rtclproxy names
|
// 2013-01-13 474 1.0.2 TclClassCmd(): check for existing Rtclproxy names
|
// 2011-03-05 366 1.0.1 use AppendResultNewLines() in exception catcher
|
// 2011-03-05 366 1.0.1 use AppendResultNewLines() in exception catcher
|
// 2011-02-20 363 1.0 Initial version
|
// 2011-02-20 363 1.0 Initial version
|
// 2011-02-11 360 0.1 First draft
|
// 2011-02-11 360 0.1 First draft
|
// ---------------------------------------------------------------------------
|
// ---------------------------------------------------------------------------
|
|
|
/*!
|
/*!
|
\file
|
\file
|
\version $Id: RtclClassBase.cpp 488 2013-02-16 18:49:47Z mueller $
|
\version $Id: RtclClassBase.cpp 584 2014-08-22 19:38:12Z mueller $
|
\brief Implemenation of RtclClassBase.
|
\brief Implemenation of RtclClassBase.
|
*/
|
*/
|
|
|
#include <string.h>
|
#include <string.h>
|
|
|
| Line 101... |
Line 102... |
// check if proxy of given name already existing
|
// check if proxy of given name already existing
|
RtclProxyBase* pprox = RtclContext::Find(interp).FindProxy("",name);
|
RtclProxyBase* pprox = RtclContext::Find(interp).FindProxy("",name);
|
if (pprox) {
|
if (pprox) {
|
Tcl_AppendResult(interp, "-E: command name '", name,
|
Tcl_AppendResult(interp, "-E: command name '", name,
|
"' exists already as RtclProxy of type '",
|
"' exists already as RtclProxy of type '",
|
pprox->Type().c_str(), "'", NULL);
|
pprox->Type().c_str(), "'", nullptr);
|
return kERR;
|
return kERR;
|
|
|
}
|
}
|
|
|
// finally create new proxy
|
// finally create new proxy
|
| Line 117... |
Line 118... |
|
|
int RtclClassBase::ClassCmdList(Tcl_Interp* interp)
|
int RtclClassBase::ClassCmdList(Tcl_Interp* interp)
|
{
|
{
|
std::vector<RtclProxyBase*> list;
|
std::vector<RtclProxyBase*> list;
|
RtclContext::Find(interp).ListProxy(list, Type());
|
RtclContext::Find(interp).ListProxy(list, Type());
|
RtclOPtr rlist(Tcl_NewListObj(0, NULL));
|
RtclOPtr rlist(Tcl_NewListObj(0, nullptr));
|
|
|
for (size_t i=0; i<list.size(); i++) {
|
for (size_t i=0; i<list.size(); i++) {
|
const char* cmdname = Tcl_GetCommandName(interp, list[i]->Token());
|
const char* cmdname = Tcl_GetCommandName(interp, list[i]->Token());
|
RtclOPtr rval(Tcl_NewStringObj(cmdname, -1));
|
RtclOPtr rval(Tcl_NewStringObj(cmdname, -1));
|
if (Tcl_ListObjAppendElement(interp, rlist, rval) != kOK) return kERR;
|
if (Tcl_ListObjAppendElement(interp, rlist, rval) != kOK) return kERR;
|
| Line 137... |
Line 138... |
|
|
int RtclClassBase::ClassCmdDelete(Tcl_Interp* interp, const char* name)
|
int RtclClassBase::ClassCmdDelete(Tcl_Interp* interp, const char* name)
|
{
|
{
|
Tcl_CmdInfo cinfo;
|
Tcl_CmdInfo cinfo;
|
if (Tcl_GetCommandInfo(interp, name, &cinfo) == 0) {
|
if (Tcl_GetCommandInfo(interp, name, &cinfo) == 0) {
|
Tcl_AppendResult(interp, "-E: unknown command name '", name, "'", NULL);
|
Tcl_AppendResult(interp, "-E: unknown command name '", name, "'", nullptr);
|
return kERR;
|
return kERR;
|
}
|
}
|
|
|
RtclContext& cntx = RtclContext::Find(interp);
|
RtclContext& cntx = RtclContext::Find(interp);
|
if (!cntx.CheckProxy((RtclProxyBase*) cinfo.objClientData)) {
|
if (!cntx.CheckProxy((RtclProxyBase*) cinfo.objClientData)) {
|
Tcl_AppendResult(interp, "-E: command '", name, "' is not a RtclProxy",
|
Tcl_AppendResult(interp, "-E: command '", name, "' is not a RtclProxy",
|
NULL);
|
nullptr);
|
return kERR;
|
return kERR;
|
}
|
}
|
if (!cntx.CheckProxy((RtclProxyBase*) cinfo.objClientData, Type())) {
|
if (!cntx.CheckProxy((RtclProxyBase*) cinfo.objClientData, Type())) {
|
Tcl_AppendResult(interp, "-E: command '", name,
|
Tcl_AppendResult(interp, "-E: command '", name,
|
"' is not a RtclProxy of type '",
|
"' is not a RtclProxy of type '",
|
Type().c_str(), "'", NULL);
|
Type().c_str(), "'", nullptr);
|
return kERR;
|
return kERR;
|
}
|
}
|
|
|
int irc = Tcl_DeleteCommand(interp, name);
|
int irc = Tcl_DeleteCommand(interp, name);
|
if (irc != kOK) Tcl_AppendResult(interp, "-E: failed to delete '", name,
|
if (irc != kOK) Tcl_AppendResult(interp, "-E: failed to delete '", name,
|
"'", NULL);
|
"'", nullptr);
|
return irc;
|
return irc;
|
}
|
}
|
|
|
//------------------------------------------+-----------------------------------
|
//------------------------------------------+-----------------------------------
|
//! FIXME_docs
|
//! FIXME_docs
|
| Line 168... |
Line 169... |
int RtclClassBase::ThunkTclClassCmd(ClientData cdata, Tcl_Interp* interp,
|
int RtclClassBase::ThunkTclClassCmd(ClientData cdata, Tcl_Interp* interp,
|
int objc, Tcl_Obj* const objv[])
|
int objc, Tcl_Obj* const objv[])
|
{
|
{
|
if (!cdata) {
|
if (!cdata) {
|
Tcl_AppendResult(interp, "-E: BUG! ThunkTclClassCmd called with cdata == 0",
|
Tcl_AppendResult(interp, "-E: BUG! ThunkTclClassCmd called with cdata == 0",
|
NULL);
|
nullptr);
|
return kERR;
|
return kERR;
|
}
|
}
|
|
|
try {
|
try {
|
return ((RtclClassBase*) cdata)->TclClassCmd(interp, objc, objv);
|
return ((RtclClassBase*) cdata)->TclClassCmd(interp, objc, objv);
|
} catch (exception& e) {
|
} catch (exception& e) {
|
Rtcl::AppendResultNewLines(interp);
|
Rtcl::AppendResultNewLines(interp);
|
Tcl_AppendResult(interp, "-E: exception caught in ThunkTclClassCmd: '",
|
Tcl_AppendResult(interp, "-E: exception caught in ThunkTclClassCmd: '",
|
e.what(), "'", NULL);
|
e.what(), "'", nullptr);
|
}
|
}
|
return kERR;
|
return kERR;
|
}
|
}
|
|
|
//------------------------------------------+-----------------------------------
|
//------------------------------------------+-----------------------------------
|
