openMSX
TclObject.cc
Go to the documentation of this file.
1#include "TclObject.hh"
2#include "Interpreter.hh"
3#include "CommandException.hh"
4
5namespace openmsx {
6
7static void throwException(Tcl_Interp* interp)
8{
9 std::string_view message = interp ? Tcl_GetStringResult(interp)
10 : "TclObject error";
11 throw CommandException(message);
12}
13
14void TclObject::addListElement(Tcl_Obj* element)
15{
16 // Although it's theoretically possible that Tcl_ListObjAppendElement()
17 // returns an error (e.g. adding an element to a string containing
18 // unbalanced quotes), this rarely occurs in our context. So we don't
19 // require passing an Interpreter parameter in all addListElement()
20 // functions. And in the very unlikely case that it does happen the
21 // only problem is that the error message is less descriptive than it
22 // could be.
23 Tcl_Interp* interp = nullptr;
24 if (Tcl_IsShared(obj)) {
25 Tcl_DecrRefCount(obj);
26 obj = Tcl_DuplicateObj(obj);
27 Tcl_IncrRefCount(obj);
28 }
29 if (Tcl_ListObjAppendElement(interp, obj, element) != TCL_OK) {
30 throwException(interp);
31 }
32}
33
34void TclObject::addListElementsImpl(std::initializer_list<Tcl_Obj*> l)
35{
36 Tcl_Obj* const* objv = l.begin();
37 addListElementsImpl(int(l.size()), objv);
38}
39
40void TclObject::addListElementsImpl(int objc, Tcl_Obj* const* objv)
41{
42 Tcl_Interp* interp = nullptr; // see comment in addListElement
43 if (Tcl_IsShared(obj)) {
44 Tcl_DecrRefCount(obj);
45 obj = Tcl_DuplicateObj(obj);
46 Tcl_IncrRefCount(obj);
47 }
48 if (Tcl_ListObjReplace(interp, obj, INT_MAX, 0, objc, objv) != TCL_OK) {
49 throwException(interp);
50 }
51}
52
53void TclObject::addDictKeyValues(std::initializer_list<Tcl_Obj*> keyValuePairs)
54{
55 assert((keyValuePairs.size() % 2) == 0);
56 Tcl_Interp* interp = nullptr; // see comment in addListElement
57 if (Tcl_IsShared(obj)) {
58 Tcl_DecrRefCount(obj);
59 obj = Tcl_DuplicateObj(obj);
60 Tcl_IncrRefCount(obj);
61 }
62 auto it = keyValuePairs.begin(), et = keyValuePairs.end();
63 while (it != et) {
64 Tcl_Obj* key = *it++;
65 Tcl_Obj* value = *it++;
66 if (Tcl_DictObjPut(interp, obj, key, value) != TCL_OK) {
67 throwException(interp);
68 }
69 }
70}
71
72int TclObject::getInt(Interpreter& interp_) const
73{
74 auto* interp = interp_.interp;
75 int result;
76 if (Tcl_GetIntFromObj(interp, obj, &result) != TCL_OK) {
77 throwException(interp);
78 }
79 return result;
80}
81
82std::optional<int> TclObject::getOptionalInt() const
83{
84 int result;
85 if (Tcl_GetIntFromObj(nullptr, obj, &result) != TCL_OK) {
86 return {};
87 }
88 return result;
89}
90
92{
93 auto* interp = interp_.interp;
94 int result;
95 if (Tcl_GetBooleanFromObj(interp, obj, &result) != TCL_OK) {
96 throwException(interp);
97 }
98 return result != 0;
99}
100
101double TclObject::getDouble(Interpreter& interp_) const
102{
103 auto* interp = interp_.interp;
104 double result;
105 if (Tcl_GetDoubleFromObj(interp, obj, &result) != TCL_OK) {
106 throwException(interp);
107 }
108 return result;
109}
110
112{
113 int length;
114 char* buf = Tcl_GetStringFromObj(obj, &length);
115 return {buf, size_t(length)};
116}
117
118std::span<const uint8_t> TclObject::getBinary() const
119{
120 int length;
121 auto* buf = Tcl_GetByteArrayFromObj(obj, &length);
122 return {buf, size_t(length)};
123}
124
125unsigned TclObject::getListLength(Interpreter& interp_) const
126{
127 auto* interp = interp_.interp;
128 int result;
129 if (Tcl_ListObjLength(interp, obj, &result) != TCL_OK) {
130 throwException(interp);
131 }
132 return result;
133}
134unsigned TclObject::getListLengthUnchecked() const
135{
136 int result;
137 if (Tcl_ListObjLength(nullptr, obj, &result) != TCL_OK) {
138 return 0; // error
139 }
140 return result;
141}
142
143TclObject TclObject::getListIndex(Interpreter& interp_, unsigned index) const
144{
145 auto* interp = interp_.interp;
146 Tcl_Obj* element;
147 if (Tcl_ListObjIndex(interp, obj, index, &element) != TCL_OK) {
148 throwException(interp);
149 }
150 return element ? TclObject(element) : TclObject();
151}
152TclObject TclObject::getListIndexUnchecked(unsigned index) const
153{
154 Tcl_Obj* element;
155 if (Tcl_ListObjIndex(nullptr, obj, index, &element) != TCL_OK) {
156 return {};
157 }
158 return element ? TclObject(element) : TclObject();
159}
160
162{
163 auto* interp = interp_.interp;
164 Tcl_Obj* value;
165 if (Tcl_DictObjGet(interp, obj, key.obj, &value) != TCL_OK) {
166 throwException(interp);
167 }
168 return value ? TclObject(value) : TclObject();
169}
170
172{
173 auto* interp = interp_.interp;
174 int result;
175 if (Tcl_ExprBooleanObj(interp, obj, &result) != TCL_OK) {
176 throwException(interp);
177 }
178 return result != 0;
179}
180
182{
183 auto* interp = interp_.interp;
184 int flags = compile ? 0 : TCL_EVAL_DIRECT;
185 int success = Tcl_EvalObjEx(interp, obj, flags);
186 if (success != TCL_OK) {
187 throw CommandException(Tcl_GetStringResult(interp));
188 }
189 return TclObject(Tcl_GetObjResult(interp));
190}
191
192} // namespace openmsx
bool getBoolean(Interpreter &interp) const
Definition: TclObject.cc:91
TclObject executeCommand(Interpreter &interp, bool compile=false)
Interpret this TclObject as a command and execute it.
Definition: TclObject.cc:181
unsigned getListLength(Interpreter &interp) const
Definition: TclObject.cc:125
TclObject getListIndex(Interpreter &interp, unsigned index) const
Definition: TclObject.cc:143
bool evalBool(Interpreter &interp) const
Definition: TclObject.cc:171
double getDouble(Interpreter &interp) const
Definition: TclObject.cc:101
void addListElement(const T &t)
Definition: TclObject.hh:127
std::span< const uint8_t > getBinary() const
Definition: TclObject.cc:118
int getInt(Interpreter &interp) const
Definition: TclObject.cc:72
void addDictKeyValues(Args &&... args)
Definition: TclObject.hh:144
TclObject getDictValue(Interpreter &interp, const TclObject &key) const
Definition: TclObject.cc:161
std::optional< int > getOptionalInt() const
Definition: TclObject.cc:82
zstring_view getString() const
Definition: TclObject.cc:111
Like std::string_view, but with the extra guarantee that it refers to a zero-terminated string.
Definition: zstring_view.hh:22
T length(const vecN< N, T > &x)
Definition: gl_vec.hh:339
This file implemented 3 utility functions:
Definition: Autofire.cc:9