openMSX
TclObject.cc
Go to the documentation of this file.
1 #include "TclObject.hh"
2 #include "Interpreter.hh"
3 #include "CommandException.hh"
4 
5 namespace openmsx {
6 
7 static void throwException(Tcl_Interp* interp)
8 {
9  std::string_view message = interp ? Tcl_GetStringResult(interp)
10  : "TclObject error";
11  throw CommandException(message);
12 }
13 
14 void 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 
34 void TclObject::addListElementsImpl(std::initializer_list<Tcl_Obj*> l)
35 {
36  Tcl_Obj* const* objv = l.begin();
37  addListElementsImpl(int(l.size()), objv);
38 }
39 
40 void 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 
53 void 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 
72 int 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 
82 std::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 
91 bool TclObject::getBoolean(Interpreter& interp_) const
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 
101 double 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 zstring_view(buf, length);
116 }
117 
119 {
120  int length;
121  auto* buf = Tcl_GetByteArrayFromObj(obj, &length);
122  return {buf, size_t(length)};
123 }
124 
125 unsigned 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 }
134 unsigned 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 
143 TclObject 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 }
152 TclObject TclObject::getListIndexUnchecked(unsigned index) const
153 {
154  Tcl_Obj* element;
155  if (Tcl_ListObjIndex(nullptr, obj, index, &element) != TCL_OK) {
156  return TclObject();
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 
171 bool TclObject::evalBool(Interpreter& interp_) const
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:129
int getInt(Interpreter &interp) const
Definition: TclObject.cc:72
void addDictKeyValues(Args &&... args)
Definition: TclObject.hh:146
span< const uint8_t > getBinary() const
Definition: TclObject.cc:118
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:343
This file implemented 3 utility functions:
Definition: Autofire.cc:9