31static std::vector<Trace> traces;
32static uintptr_t traceCount = 0;
35static int dummyClose(ClientData , Tcl_Interp* )
39static int dummyInput(ClientData ,
char* ,
44static void dummyWatch(ClientData ,
int )
47static int dummyGetHandle(ClientData ,
int ,
52Tcl_ChannelType Interpreter::channelType = {
53 const_cast<char*
>(
"openMSX console"),
57 Interpreter::outputProc,
74 Tcl_FindExecutable(programName);
78 : interp(Tcl_CreateInterp())
95 Tcl_Channel channel = Tcl_CreateChannel(&channelType,
96 "openMSX console",
this, TCL_WRITABLE);
98 Tcl_SetChannelOption(interp, channel,
"-translation",
"binary");
99 Tcl_SetChannelOption(interp, channel,
"-buffering",
"line");
100 Tcl_SetChannelOption(interp, channel,
"-encoding",
"utf-8");
102 Tcl_SetStdChannel(channel, TCL_STDOUT);
115 if (!Tcl_InterpDeleted(interp)) {
116 Tcl_DeleteInterp(interp);
127 static bool scheduled =
false;
130 atexit(Tcl_Finalize);
134int Interpreter::outputProc(ClientData clientData,
const char* buf,
138 auto* output =
static_cast<Interpreter*
>(clientData)->output;
139 std::string_view text(buf, toWrite);
140 if (!text.empty() && output) {
153 return Tcl_FindCommand(interp, name.
c_str(),
nullptr, 0);
158 auto token = Tcl_CreateObjCommand(
159 interp, name.
c_str(), commandProc,
160 static_cast<ClientData
>(&command),
nullptr);
166 Tcl_DeleteCommandFromToken(interp,
static_cast<Tcl_Command
>(command.
getToken()));
169int Interpreter::commandProc(ClientData clientData, Tcl_Interp* interp,
170 int objc, Tcl_Obj*
const* objv)
173 auto& command = *
static_cast<Command*
>(clientData);
174 std::span<const TclObject> tokens(
175 reinterpret_cast<TclObject*
>(
const_cast<Tcl_Obj**
>(objv)),
180 if (!command.isAllowedInEmptyMachine()) {
181 if (
auto* controller =
183 &command.getCommandController())) {
184 if (!controller->getMSXMotherBoard().getMachineConfig()) {
186 "Can't execute command in empty machine");
190 command.execute(tokens, result);
191 }
catch (MSXException&
e) {
192 result =
e.getMessage();
209 return execute(
"openmsx::all_command_names");
214 return Tcl_CommandComplete(command.
c_str()) != 0;
219 int success = Tcl_Eval(interp, command.
c_str());
220 if (success != TCL_OK) {
223 return TclObject(Tcl_GetObjResult(interp));
228 int success = Tcl_EvalFile(interp, filename.
c_str());
229 if (success != TCL_OK) {
232 return TclObject(Tcl_GetObjResult(interp));
239 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)) {
241 std::cerr << Tcl_GetStringResult(interp) <<
'\n';
244static Tcl_Obj* getVar(Tcl_Interp* interp,
const TclObject& name)
246 return Tcl_ObjGetVar2(interp, name.getTclObjectNonConst(),
nullptr,
254 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)) {
263 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)) {
270 Tcl_UnsetVar(interp, name, TCL_GLOBAL_ONLY);
283 if (Tcl_Obj* tclVarValue = getVar(interp, name)) {
325 uintptr_t traceID = traceCount++;
326 traces.emplace_back(Trace{traceID, &variable});
328 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
329 traceProc,
reinterpret_cast<ClientData
>(traceID));
335 uintptr_t traceID = it->id;
339 Tcl_UntraceVar(interp, name,
340 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
341 traceProc,
reinterpret_cast<ClientData
>(traceID));
345static BaseSetting* getTraceSetting(uintptr_t traceID)
348 return t ?
t->setting :
nullptr;
352static std::string_view removeColonColon(std::string_view s)
354 if (s.starts_with(
"::")) s.remove_prefix(2);
359char* Interpreter::traceProc(ClientData clientData, Tcl_Interp* interp,
360 const char* part1,
const char* ,
int flags)
393 auto traceID =
reinterpret_cast<uintptr_t
>(clientData);
394 auto* variable = getTraceSetting(traceID);
395 if (!variable)
return nullptr;
397 const TclObject& part1Obj = variable->getFullNameObj();
398 assert(removeColonColon(part1) == removeColonColon(part1Obj.getString()));
400 static std::string static_string;
401 if (flags & TCL_TRACE_READS) {
403 setVar(interp, part1Obj, variable->getValue());
404 }
catch (MSXException&
e) {
405 static_string = std::move(
e).getMessage();
406 return const_cast<char*
>(static_string.c_str());
409 if (flags & TCL_TRACE_WRITES) {
411 Tcl_Obj* v = getVar(interp, part1Obj);
412 TclObject newValue(v ? v : Tcl_NewObj());
413 variable->setValueDirect(newValue);
414 const TclObject& newValue2 = variable->getValue();
415 if (newValue != newValue2) {
416 setVar(interp, part1Obj, newValue2);
418 }
catch (MSXException&
e) {
419 setVar(interp, part1Obj, getSafeValue(*variable));
420 static_string = std::move(
e).getMessage();
421 return const_cast<char*
>(static_string.c_str());
424 if (flags & TCL_TRACE_UNSETS) {
430 variable->getDefaultValue()));
431 }
catch (MSXException&) {
437 setVar(interp, part1Obj, getSafeValue(*variable));
438 Tcl_TraceVar(interp, part1, TCL_TRACE_READS |
439 TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
441 reinterpret_cast<ClientData
>(traceID));
462 Tcl_DoOneEvent(TCL_DONT_WAIT);
467 return {interp, command};
473 int result = Tcl_ParseCommand(interp, command.data(), narrow<int>(command.size()), 0, &parseInfo);
474 Tcl_FreeParse(&parseInfo);
475 return result == TCL_OK;
481 int result = Tcl_ParseExpr(interp, expression.data(), narrow<int>(expression.size()), &parseInfo);
482 Tcl_FreeParse(&parseInfo);
483 return result == TCL_OK;
488 assert(argc <= tokens.size());
489 Tcl_WrongNumArgs(interp, narrow<int>(argc),
reinterpret_cast<Tcl_Obj* const*
>(tokens.data()), message);
virtual std::optional< TclObject > getOptionalValue() const =0
Like getValue(), but in case of error returns an empty optional instead of throwing an exception.
virtual void setValueDirect(const TclObject &value)=0
Similar to setValue(), but doesn't trigger Tcl traces.
const TclObject & getFullNameObj() const
Get the name of this setting.
std::string_view getFullName() const
void setToken(void *token_)
virtual void output(std::string_view text)=0
void unsetVariable(const char *name)
TclObject execute(zstring_view command)
TclObject getCommandNames()
void init(const char *programName)
void wrongNumArgs(unsigned argc, std::span< const TclObject > tokens, const char *message)
void deleteNamespace(const std::string &name)
Delete the global namespace with given name.
bool validCommand(std::string_view command)
bool validExpression(std::string_view expression)
void registerSetting(BaseSetting &variable)
void createNamespace(const std::string &name)
Create the global namespace with given name.
void unregisterCommand(Command &command)
void setVariable(const TclObject &name, const TclObject &value)
TclParser parse(std::string_view command)
TclObject executeFile(zstring_view filename)
bool isComplete(zstring_view command) const
void unregisterSetting(BaseSetting &variable)
bool hasCommand(zstring_view name) const
void registerCommand(zstring_view name, Command &command)
Tcl_Obj * getTclObjectNonConst() const
zstring_view getString() const
Like std::string_view, but with the extra guarantee that it refers to a zero-terminated string.
constexpr const char * data() const
constexpr const char * c_str() const
const string & getSystemDataDir()
Get system directory.
const string & getUserDataDir()
Get the openMSX data dir in the user's home directory.
This file implemented 3 utility functions:
auto * binary_find(ForwardRange &&range, const T &value, Compare comp={}, Proj proj={})
auto rfind_unguarded(RANGE &range, const VAL &val, Proj proj={})
Similar to the find(_if)_unguarded functions above, but searches from the back to front.
TemporaryString tmpStrCat(Ts &&... ts)