2 * Support for namespaces in jim
4 * (c) 2011 Steve Bennett <steveb@workware.net.au>
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 * 2. Redistributions in binary form must reproduce the above
13 * copyright notice, this list of conditions and the following
14 * disclaimer in the documentation and/or other materials
15 * provided with the distribution.
17 * THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
18 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
19 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
20 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
21 * JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
22 * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
23 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
24 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
25 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
26 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
27 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
28 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 * The views and conclusions contained in the software and documentation
31 * are those of the authors and should not be interpreted as representing
32 * official policies, either expressed or implied, of the Jim Tcl Project.
34 * Based on code originally from Tcl 6.7:
36 * Copyright 1987-1991 Regents of the University of California
37 * Permission to use, copy, modify, and distribute this
38 * software and its documentation for any purpose and without
39 * fee is hereby granted, provided that the above copyright
40 * notice appear in all copies. The University of California
41 * makes no representations about the suitability of this
42 * software for any purpose. It is provided "as is" without
43 * express or implied warranty.
53 #include "jimautoconf.h"
54 #include "jim-subcmd.h"
56 /* -----------------------------------------------------------------------------
58 * ---------------------------------------------------------------------------*/
61 * nsObj is a canonical namespace name (.e.g. "" for root, "abc" for ::abc)
63 * The given name is appended to the namespace name to produce a complete canonical name.
65 * e.g. "" "abc" => abc
67 * "" "abc::def" => abc::def
68 * "abc" "def" => abc::def
69 * "abc" "::def" => def
72 Jim_Obj
*JimCanonicalNamespace(Jim_Interp
*interp
, Jim_Obj
*nsObj
, Jim_Obj
*nameObj
)
75 const char *name
= Jim_String(nameObj
);
76 assert(nameObj
->refCount
!= 0);
77 assert(nsObj
->refCount
!= 0);
78 if (name
[0] == ':' && name
[1] == ':') {
79 /* Absolute namespace */
80 while (*++name
== ':') {
82 return Jim_NewStringObj(interp
, name
, -1);
84 if (Jim_Length(nsObj
) == 0) {
85 /* Relative to the global namespace */
88 /* Relative to non-global namespace */
89 objPtr
= Jim_DuplicateObj(interp
, nsObj
);
90 Jim_AppendString(interp
, objPtr
, "::", 2);
91 Jim_AppendObj(interp
, objPtr
, nameObj
);
95 int Jim_CreateNamespaceVariable(Jim_Interp
*interp
, Jim_Obj
*varNameObj
, Jim_Obj
*targetNameObj
)
98 Jim_IncrRefCount(varNameObj
);
99 Jim_IncrRefCount(targetNameObj
);
101 /* push non-namespace vars if in namespace eval? */
102 rc
= Jim_SetVariableLink(interp
, varNameObj
, targetNameObj
, interp
->topFramePtr
);
104 /* This is the only reason the link can fail */
105 Jim_SetResultFormatted(interp
, "can't define \"%#s\": name refers to an element in an array", varNameObj
);
108 Jim_DecrRefCount(interp
, varNameObj
);
109 Jim_DecrRefCount(interp
, targetNameObj
);
115 * Returns the parent of the given namespace.
117 * ::bob::tom => ::bob
124 Jim_Obj
*Jim_NamespaceQualifiers(Jim_Interp
*interp
, Jim_Obj
*ns
)
126 const char *name
= Jim_String(ns
);
127 const char *pt
= strrchr(name
, ':');
128 if (pt
&& pt
!= name
&& pt
[-1] == ':') {
129 return Jim_NewStringObj(interp
, name
, pt
- name
- 1);
132 return interp
->emptyObj
;
136 Jim_Obj
*Jim_NamespaceTail(Jim_Interp
*interp
, Jim_Obj
*ns
)
138 const char *name
= Jim_String(ns
);
139 const char *pt
= strrchr(name
, ':');
140 if (pt
&& pt
!= name
&& pt
[-1] == ':') {
141 return Jim_NewStringObj(interp
, pt
+ 1, -1);
148 static Jim_Obj
*JimNamespaceCurrent(Jim_Interp
*interp
)
150 Jim_Obj
*objPtr
= Jim_NewStringObj(interp
, "::", 2);
151 Jim_AppendObj(interp
, objPtr
, interp
->framePtr
->nsObj
);
155 static int JimVariableCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
157 int retcode
= JIM_OK
;
160 Jim_WrongNumArgs(interp
, 1, argv
, "name ?value?");
164 Jim_Obj
*targetNameObj
;
165 Jim_Obj
*localNameObj
;
167 targetNameObj
= JimCanonicalNamespace(interp
, interp
->framePtr
->nsObj
, argv
[1]);
169 localNameObj
= Jim_NamespaceTail(interp
, argv
[1]);
170 Jim_IncrRefCount(localNameObj
);
171 if (interp
->framePtr
->level
!= 0 || Jim_Length(interp
->framePtr
->nsObj
) != 0) {
172 retcode
= Jim_CreateNamespaceVariable(interp
, localNameObj
, targetNameObj
);
175 /* Set the variable via the local name */
176 if (retcode
== JIM_OK
&& argc
> 2) {
177 retcode
= Jim_SetVariable(interp
, localNameObj
, argv
[2]);
179 Jim_DecrRefCount(interp
, localNameObj
);
184 /* Used to invoke script-based helpers.
185 * It would be ideal if ensembles were supported in the core
187 static int Jim_EvalEnsemble(Jim_Interp
*interp
, const char *basecmd
, const char *subcmd
, int argc
, Jim_Obj
*const *argv
)
189 Jim_Obj
*prefixObj
= Jim_NewStringObj(interp
, basecmd
, -1);
191 Jim_AppendString(interp
, prefixObj
, " ", 1);
192 Jim_AppendString(interp
, prefixObj
, subcmd
, -1);
194 return Jim_EvalObjPrefix(interp
, prefixObj
, argc
, argv
);
197 static int JimNamespaceCmd(Jim_Interp
*interp
, int argc
, Jim_Obj
*const *argv
)
202 static const char * const options
[] = {
203 "eval", "current", "canonical", "qualifiers", "parent", "tail", "delete",
204 "origin", "code", "inscope", "import", "export",
205 "which", "upvar", NULL
209 OPT_EVAL
, OPT_CURRENT
, OPT_CANONICAL
, OPT_QUALIFIERS
, OPT_PARENT
, OPT_TAIL
, OPT_DELETE
,
210 OPT_ORIGIN
, OPT_CODE
, OPT_INSCOPE
, OPT_IMPORT
, OPT_EXPORT
,
211 OPT_WHICH
, OPT_UPVAR
,
215 Jim_WrongNumArgs(interp
, 1, argv
, "subcommand ?arg ...?");
219 if (Jim_GetEnum(interp
, argv
[1], options
, &option
, "subcommand", JIM_ERRMSG
| JIM_ENUM_ABBREV
) != JIM_OK
) {
226 Jim_WrongNumArgs(interp
, 2, argv
, "name arg ?arg...?");
233 objPtr
= Jim_ConcatObj(interp
, argc
- 3, argv
+ 3);
236 nsObj
= JimCanonicalNamespace(interp
, interp
->framePtr
->nsObj
, argv
[2]);
237 return Jim_EvalNamespace(interp
, objPtr
, nsObj
);
241 Jim_WrongNumArgs(interp
, 2, argv
, "");
244 Jim_SetResult(interp
, JimNamespaceCurrent(interp
));
249 Jim_WrongNumArgs(interp
, 2, argv
, "?current? ?name?");
253 Jim_SetResult(interp
, interp
->framePtr
->nsObj
);
255 else if (argc
== 3) {
256 Jim_SetResult(interp
, JimCanonicalNamespace(interp
, interp
->framePtr
->nsObj
, argv
[2]));
259 Jim_SetResult(interp
, JimCanonicalNamespace(interp
, argv
[2], argv
[3]));
265 Jim_WrongNumArgs(interp
, 2, argv
, "string");
268 Jim_SetResult(interp
, Jim_NamespaceQualifiers(interp
, argv
[2]));
276 Jim_WrongNumArgs(interp
, 2, argv
, "string");
279 Jim_SetResult(interp
, Jim_NamespaceTail(interp
, argv
[2]));
283 if (argc
!= 2 && argc
!= 3) {
284 Jim_WrongNumArgs(interp
, 2, argv
, "?name?");
294 objPtr
= interp
->framePtr
->nsObj
;
296 if (Jim_Length(objPtr
) == 0 || Jim_CompareStringImmediate(interp
, objPtr
, "::")) {
299 objPtr
= Jim_NamespaceQualifiers(interp
, objPtr
);
301 name
= Jim_String(objPtr
);
303 if (name
[0] != ':' || name
[1] != ':') {
304 /* Make it fully scoped */
305 Jim_SetResultString(interp
, "::", 2);
306 Jim_AppendObj(interp
, Jim_GetResult(interp
), objPtr
);
307 Jim_IncrRefCount(objPtr
);
308 Jim_DecrRefCount(interp
, objPtr
);
311 Jim_SetResult(interp
, objPtr
);
317 /* Implemented as a Tcl helper proc.
318 * Note that calling a proc will change the current namespace,
319 * so helper procs must call [uplevel namespace canon] to get the callers
322 return Jim_EvalEnsemble(interp
, "namespace", options
[option
], argc
- 2, argv
+ 2);
325 int Jim_namespaceInit(Jim_Interp
*interp
)
327 if (Jim_PackageProvide(interp
, "namespace", "1.0", JIM_ERRMSG
))
330 Jim_CreateCommand(interp
, "namespace", JimNamespaceCmd
, NULL
, NULL
);
331 Jim_CreateCommand(interp
, "variable", JimVariableCmd
, NULL
, NULL
);