1/*
2 * cmpRPkg.c --
3 *
4 *  This file contains the C interfaces to the Tcl load command for the
5 *  Reader package: the Reader_Init function.
6 *
7 * Copyright (c) 1998-2000 Ajuba Solutions
8 *
9 * See the file "license.terms" for information on usage and redistribution
10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 *
12 * RCS: @(#) $Id: cmpRPkg.c,v 1.2 2000/05/30 22:19:06 wart Exp $
13 */
14
15#include "cmpInt.h"
16#include "proTbcLoad.h"
17
18/*
19 * name and version of this package
20 */
21
22static char packageName[]    = PACKAGE_NAME;
23static char packageVersion[] = PACKAGE_VERSION;
24
25/*
26 * Name of the commands exported by this package
27 */
28
29static char evalCommand[] = CMP_EVAL_COMMAND;
30static char procCommand[] = CMP_PROC_COMMAND;
31
32/*
33 * this struct describes an entry in the table of command names and command
34 * procs
35 */
36
37typedef struct CmdTable
38{
39    char *cmdName;		/* command name */
40    Tcl_ObjCmdProc *proc;	/* command proc */
41    int exportIt;		/* if 1, export the command */
42} CmdTable;
43
44/*
45 * Declarations for functions defined in this file.
46 */
47
48static int	TbcloadInitInternal _ANSI_ARGS_((Tcl_Interp *interp,
49			int isSafe));
50static int	RegisterCommand _ANSI_ARGS_((Tcl_Interp* interp,
51			char *namespace, CONST CmdTable *cmdTablePtr));
52
53/*
54 * List of commands to create when the package is loaded; must go after the
55 * declarations of the enable command procedure.
56 */
57
58static CONST CmdTable commands[] =
59{
60    { evalCommand,	Tbcload_EvalObjCmd,	1 },
61    { procCommand,	Tbcload_ProcObjCmd,	1 },
62
63    { 0, 0, 0 }
64};
65
66static CONST CmdTable safeCommands[] =
67{
68    { evalCommand,	Tbcload_EvalObjCmd,	1 },
69    { procCommand,	Tbcload_ProcObjCmd,	1 },
70
71    { 0, 0, 0 }
72};
73
74/*
75 *----------------------------------------------------------------------
76 *
77 * Tbcload_Init --
78 *
79 *  This procedure initializes the Loader package.
80 *  The initialization consists of add ing the compiled script loader to the
81 *  set of registered script loaders.
82 *
83 * Results:
84 *  A standard Tcl result.
85 *
86 * Side effects:
87 *  None.
88 *
89 *----------------------------------------------------------------------
90 */
91
92int
93Tbcload_Init(interp)
94    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
95                                 * is initialized */
96{
97    return TbcloadInitInternal(interp, 0);
98}
99
100/*
101 *----------------------------------------------------------------------
102 *
103 * Tbcload_SafeInit --
104 *
105 *  This procedure initializes the Loader package.
106 *  The initialization consists of add ing the compiled script loader to the
107 *  set of registered script loaders.
108 *
109 * Results:
110 *  A standard Tcl result.
111 *
112 * Side effects:
113 *  None.
114 *
115 *----------------------------------------------------------------------
116 */
117
118int
119Tbcload_SafeInit(interp)
120    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
121                                 * is initialized */
122{
123    return TbcloadInitInternal(interp, 1);
124}
125
126/*
127 *----------------------------------------------------------------------
128 *
129 * RegisterCommand --
130 *
131 *  This procedure registers a command in the context of the given namespace.
132 *
133 * Results:
134 *  A standard Tcl result.
135 *
136 * Side effects:
137 *  None.
138 *
139 *----------------------------------------------------------------------
140 */
141
142static int RegisterCommand(interp, namespace, cmdTablePtr)
143    Tcl_Interp* interp;			/* the Tcl interpreter for which the
144                                         * operation is performed */
145    char *namespace;			/* the namespace in which the command
146                                         * is registered */
147    CONST CmdTable *cmdTablePtr;	/* the command to register */
148{
149    char buf[128];
150
151    if (cmdTablePtr->exportIt) {
152        sprintf(buf, "namespace eval %s { namespace export %s }",
153                namespace, cmdTablePtr->cmdName);
154        if (Tcl_Eval(interp, buf) != TCL_OK)
155            return TCL_ERROR;
156    }
157
158    sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName);
159    Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);
160
161    return TCL_OK;
162}
163
164/*
165 *----------------------------------------------------------------------
166 *
167 * TbcloadInitInternal --
168 *
169 *  This procedure initializes the Loader package.
170 *  The isSafe flag is 1 if the interpreter is safe, 0 otherwise.
171 *
172 * Results:
173 *  A standard Tcl result.
174 *
175 * Side effects:
176 *  None.
177 *
178 *----------------------------------------------------------------------
179 */
180
181static int
182TbcloadInitInternal(interp, isSafe)
183    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
184                                 * is initialized */
185    int isSafe;			/* 1 if this is a safe interpreter */
186{
187    CONST CmdTable *cmdTablePtr;
188
189    if (TbcloadInit(interp) != TCL_OK) {
190        return TCL_ERROR;
191    }
192
193    cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
194    for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
195        if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
196            return TCL_ERROR;
197        }
198    }
199
200    return Tcl_PkgProvide(interp, packageName, packageVersion);
201}
202
203/*
204 *----------------------------------------------------------------------
205 *
206 * TbcloadGetPackageName --
207 *
208 *  Returns the package name for the loader package.
209 *
210 * Results:
211 *  See above.
212 *
213 * Side effects:
214 *  None.
215 *
216 *----------------------------------------------------------------------
217 */
218
219CONST char *
220TbcloadGetPackageName()
221{
222    return packageName;
223}
224