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