1// mk4tcl.h -- 2// $Id: mk4tcl.h 4435 2008-08-01 19:58:42Z patthoyts $ 3// This is part of Metakit, the homepage is http://www.equi4.com/metakit.html 4 5#include "config.h" 6#include "mk4.h" 7#include "mk4str.h" 8#include "../src/univ.h" 9 10#include <tcl.h> 11 12#ifdef BUILD_Mk4tcl 13#undef TCL_STORAGE_CLASS 14#define TCL_STORAGE_CLASS DLLEXPORT 15#endif 16 17#ifndef d4_assert 18#if q4_INLINE && !q4_CHECK 19// if inlining is on, assume it's release code and disable assertions 20#define d4_assert(x) 21#elif defined (ASSERT) 22#define d4_assert(x) ASSERT(x) 23#else 24#include <assert.h> 25#define d4_assert(x) assert(x) 26#endif 27#endif 28 29#ifndef CONST84 30#define CONST84 31#endif 32 33#ifndef CONST86 34#define CONST86 35#endif 36 37#ifndef TCL_DECLARE_MUTEX 38#define TCL_DECLARE_MUTEX(v) 39#define Tcl_MutexLock(v) 40#define Tcl_MutexUnlock(v) 41#endif 42 43/////////////////////////////////////////////////////////////////////////////// 44// Defined in this file: 45 46class MkPath; 47class MkWorkspace; 48class Tcl; 49class MkTcl; 50 51/////////////////////////////////////////////////////////////////////////////// 52// Utility code: return next token up to char < '0', and 53// advance the string pointer past following character. 54 55c4_String f4_GetToken(const char * &str_); 56 57/////////////////////////////////////////////////////////////////////////////// 58// Utility code: true if value contains a word starting with the given prefix 59 60bool MatchOneKeyword(const char *value_, const c4_String &crit_); 61 62/////////////////////////////////////////////////////////////////////////////// 63// Utility class: increments and decrements reference count for auto cleanup 64 65class KeepRef { 66 Tcl_Obj *_obj; 67 public: 68 KeepRef(Tcl_Obj *obj_): _obj(obj_) { 69 Tcl_IncrRefCount(_obj); 70 } 71 ~KeepRef() { 72 Tcl_DecrRefCount(_obj); 73 } 74 75 operator Tcl_Obj *()const { 76 return _obj; 77 } 78}; 79 80/////////////////////////////////////////////////////////////////////////////// 81// Utility code: get a Metakit item and convert it to a Tcl object 82 83Tcl_Obj *GetAsObj(const c4_RowRef &row_, const c4_Property &prop_, Tcl_Obj 84 *obj_ = 0); 85 86/////////////////////////////////////////////////////////////////////////////// 87// Utility code: set a Metakit item and convert it from a Tcl object 88 89int SetAsObj(Tcl_Interp *interp, const c4_RowRef &row_, const c4_Property 90 &prop_, Tcl_Obj *obj_); 91 92/////////////////////////////////////////////////////////////////////////////// 93// A path is a view which knows its place, and what workspace it belongs to. 94// Since it contains a string version, its tag can be used to find the item. 95 96class MkPath { 97 int _refs; // reference count 98 99 public: 100 MkPath(MkWorkspace &ws_, const char * &path_, Tcl_Interp *interp); 101 ~MkPath(); // don't use explicit destruction, use Refs(-1) 102 103 int AttachView(Tcl_Interp *interp); 104 int Refs(int diff_); 105 106 MkWorkspace *_ws; // avoid globals, but there is usually just one 107 c4_View _view; // the view corresponding to this path 108 c4_String _path; // describes view, starting with storage tag 109 int _currGen; // tracks the generation to force reloads 110}; 111 112/////////////////////////////////////////////////////////////////////////////// 113// A workspace manages a number of storage objects and their associated paths. 114 115class MkWorkspace { 116 c4_PtrArray _items; // items, or null if released 117 c4_Bytes _usedBuffer; // buffer, using 1 byte per entry 118 t4_byte *_usedRows; // 1 if that row in item 0 is currently in use 119 c4_PtrArray _commands; 120 121 public: 122 Tcl_Interp *_interp; 123 124 struct Item { 125 const c4_String _name; // the alias for this storage 126 const c4_String _fileName; 127 c4_Storage _storage; // the storage object 128 c4_PtrArray _paths; // the paths associated with this entry 129 c4_PtrArray &_items; // array from which this item is referenced 130 int _index; // position in the _items array 131 132 //Item (); // special first entry initializer 133 Item(const char *name_, const char *fileName_, int mode_, c4_PtrArray 134 &items_, int index_, bool share_ = false); 135 ~Item(); 136 137 void ForceRefresh(); // bump the generation to recreate views 138 139 static c4_PtrArray *_shared; // shared items are also listed here 140 }; 141 142 MkWorkspace(Tcl_Interp *ip_); 143 ~MkWorkspace(); 144 145 void DefCmd(MkTcl *cmd_); // 1.2: for cleanup 146 void CleanupCommands(); 147 148 Item *Define(const char *name_, const char *fileName_, int mode_, bool 149 share_); 150 151 Item *Find(const char *name_)const; 152 int NumItems()const; 153 Item *Nth(int index_)const; 154 155 // create a new path if it doesn't exist, else bump the reference count 156 MkPath *AddPath(const char * &name_, Tcl_Interp *interp); 157 // decrease the reference count, delete path if it is no longer used 158 void ForgetPath(const MkPath *path_); 159 // create a path to a temporary row 160 void AllocTempRow(c4_String &); 161 162 // adjust paths of all subviews if the parent position has changed 163 void Invalidate(const MkPath &path_); 164}; 165 166/////////////////////////////////////////////////////////////////////////////// 167// 168// Interface to Tcl 8.0 type mechanism, defines a new "mkProperty" datatype 169// 170// Since properties are immutable, we don't need most of the calls. 171/////////////////////////////////////////////////////////////////////////////// 172 173const c4_Property &AsProperty(Tcl_Obj *objPtr, const c4_View &view_); 174 175/////////////////////////////////////////////////////////////////////////////// 176// 177// Interface to Tcl 8.0 type mechanism, defines a new "mkCursor" datatype 178// 179/////////////////////////////////////////////////////////////////////////////// 180// 181// Cursors in Tcl are implemented as a pointer to an MkPath plus an index. 182 183MkPath &AsPath(Tcl_Obj *obj_); 184int &AsIndex(Tcl_Obj *obj_); 185int SetCursorFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); 186 187// 24nov02: added to support releasing mutex lock during loop eval's 188int Mk_EvalObj(Tcl_Interp *ip_, Tcl_Obj *cmd_); 189 190/////////////////////////////////////////////////////////////////////////////// 191// Helper class for the mk::select command, stores params and performs select 192 193class TclSelector { 194 c4_PtrArray _conditions; 195 Tcl_Interp *_interp; 196 c4_View _view; 197 Tcl_Obj *_temp; 198 199 public: 200 class Condition { 201 public: 202 int _id; 203 c4_View _view; 204 Tcl_Obj *_crit; // no need to incref, original lifetime is guaranteed 205 206 Condition(int id_, const c4_View &view_, Tcl_Obj *crit_): _id(id_), 207 _view(view_), _crit(crit_){} 208 }; 209 210 c4_View _sortProps; 211 c4_View _sortRevProps; 212 int _first; 213 int _count; 214 215 TclSelector(Tcl_Interp *interp_, const c4_View &view_); 216 ~TclSelector(); 217 218 c4_View GetAsProps(Tcl_Obj *obj_); 219 int AddCondition(int id_, Tcl_Obj *props_, Tcl_Obj *value_); 220 bool MatchOneString(int id_, const char *value_, const char *crit_); 221 bool Match(const c4_RowRef &row_); 222 void ExactKeyProps(const c4_RowRef &row_); 223 int DoSelect(Tcl_Obj *list_, c4_View *result_ = 0); 224}; 225 226/////////////////////////////////////////////////////////////////////////////// 227// The Tcl class is a generic interface to Tcl, providing some C++ wrapping 228 229class Tcl { 230 protected: 231 Tcl_Interp *interp; 232 int _error; 233 234 public: 235 Tcl(Tcl_Interp *ip_); 236 237 int Fail(const char *msg_ = 0, int err_ = TCL_ERROR); 238 Tcl_Obj *tcl_GetObjResult(); 239 int tcl_SetObjResult(Tcl_Obj *obj_); 240 int tcl_ListObjLength(Tcl_Obj *obj_); 241 void tcl_ListObjAppendElement(Tcl_Obj *obj_, Tcl_Obj *value_); 242 bool tcl_GetBooleanFromObj(Tcl_Obj *obj_); 243 int tcl_GetIntFromObj(Tcl_Obj *obj_); 244 long tcl_GetLongFromObj(Tcl_Obj *obj_); 245 double tcl_GetDoubleFromObj(Tcl_Obj *obj_); 246 int tcl_GetIndexFromObj(Tcl_Obj *obj_, const char **table_, const char 247 *msg_ = "option"); 248 long tcl_ExprLongObj(Tcl_Obj *obj_); 249 250 Tcl_Obj *GetValue(const c4_RowRef &row_, const c4_Property &prop_, Tcl_Obj 251 *obj_ = 0); 252 Tcl_Obj *tcl_NewStringObj(const char *str_, int len_ = - 1); 253 void list2desc(Tcl_Obj *in, Tcl_Obj *out); 254}; 255 256// The MkTcl class adds Metakit-specific utilities and all the command procs. 257 258class MkTcl: public Tcl { 259 int id; 260 int objc; 261 Tcl_Obj *const * objv; 262 c4_String msg; 263 MkWorkspace &work; 264 265 static int Dispatcher(ClientData cd, Tcl_Interp *ip, int oc, Tcl_Obj *const 266 * ov); 267 268 public: 269 enum { 270 kAnyRow, kExistingRow, kLimitRow, kExtendRow 271 }; 272 273 MkTcl(MkWorkspace *ws_, Tcl_Interp *ip_, int id_, const char *cmd_); 274 ~MkTcl(); 275 276 c4_View asView(Tcl_Obj *obj_); 277 int &changeIndex(Tcl_Obj *obj_); 278 c4_RowRef asRowRef(Tcl_Obj *obj_, int type_ = kExistingRow); 279 int GetCmd(); 280 int SetValues(const c4_RowRef &row_, int objc, Tcl_Obj *const * objv); 281 int SetCmd(); 282 int RowCmd(); 283 int FileCmd(); 284 int ViewCmd(); 285 int LoopCmd(); 286 int CursorCmd(); 287 int SelectCmd(); 288 int ChannelCmd(); 289 int NewCmd(); 290 int Try1Cmd(); 291 int Try2Cmd(); 292 int Try3Cmd(); 293#if MKSQL 294 int SqlAuxCmd(); 295#endif 296 int Execute(int oc, Tcl_Obj *const * ov); 297}; 298 299/////////////////////////////////////////////////////////////////////////////// 300 301class MkView: public Tcl { 302 int objc; 303 Tcl_Obj *const * objv; 304 Tcl_Command cmdToken; 305 c4_String msg; 306 MkWorkspace &work; 307 c4_View view; 308 c4_String cmd; 309 310 static int Dispatcher(ClientData cd, Tcl_Interp *ip, int oc, Tcl_Obj *const 311 * ov); 312 static void DeleteProc(ClientData cd); 313 314 public: 315 316 MkView(Tcl_Interp *ip_, c4_View view_, const char *name = 0); 317 MkView(Tcl_Interp *ip_, const char *name = 0); 318 ~MkView(); 319 320 void Register(const char *name); 321 322 static c4_View View(Tcl_Interp *interp, Tcl_Obj *obj); 323 324 c4_String CmdName() { 325 return cmd; 326 } 327 328 int asIndex(c4_View &view, Tcl_Obj *obj_, bool mayExceed_); 329 int SetValues(const c4_RowRef &row_, int objc, Tcl_Obj *const * objv, 330 c4_View &); 331 332 c4_View &View() { 333 return view; 334 } 335 336 int CloseCmd(); // $obj close 337 int DeleteCmd(); // $obj delete cursor ?count? 338 int FindCmd(); // $obj find ?prop value ...? 339 int GetCmd(); // $obj get cursor ?prop prop ...? 340 int ExistsCmd(); // $obj exists cursor 341 int InfoCmd(); // $obj info 342 int InsertCmd(); // $obj insert cursor ?prop prop ...? 343 int OpenCmd(); // $obj open cursor prop 344 int SearchCmd(); // $obj search prop value 345 int SelectCmd(); // $obj select .... 346 int SetCmd(); // $obj set cursor ?prop value ...? 347 int SizeCmd(); // $obj size ?newsize? 348 int LoopCmd(); // $obj loop cursor ?first? ?limit? ?step? {cmds} 349 int ViewCmd(); // $obj view option ?args? 350 351 int CloneCmd(); // $obj view clone 352 int ConcatCmd(); // $obj view concat view 353 int CopyCmd(); // $obj view copy 354 int DifferentCmd(); // $obj view different view 355 int DupCmd(); // $obj view dup 356 int BlockedCmd(); // $obj view blocked 357 int FlattenCmd(); // $obj view flatten prop 358 int GroupByCmd(); // $obj view groupby subview prop ?prop ...? 359 int HashCmd(); // $obj view hash view ?numkeys? 360 int IndexedCmd(); // $obj view indexed map unique prop ?prop ...? 361 int IntersectCmd(); // $obj view intersect view 362 int JoinCmd(); // $obj view join view prop ?prop ...? 363 int MapCmd(); // $obj view map view 364 int MinusCmd(); // $obj view minus view 365 int OrderedCmd(); // $obj view ordered ?numKeys? 366 int PairCmd(); // $obj view pair view 367 int ProductCmd(); // $obj view product view 368 int ProjectCmd(); // $obj view project prop ?prop ...? 369 int RangeCmd(); // $obj view range start ?limit? ?step? 370 int ReadOnlyCmd(); // $obj view readonly 371 int RenameCmd(); // $obj view rename oprop nprop 372 int RestrictCmd(); // $obj view restrict cursor pos count 373 int UnionCmd(); // $obj view union view 374 int UniqueCmd(); // $obj view unique 375 376 int Execute(int oc, Tcl_Obj *const * ov); 377}; 378 379/////////////////////////////////////////////////////////////////////////////// 380