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