开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
pkgc.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：4k
源码类别：

通讯编程

开发平台：

Visual C++

pkgc.c：源码内容
  1. /* 
  2.  * pkgc.c --
  3.  *
  4.  * This file contains a simple Tcl package "pkgc" that is intended
  5.  * for testing the Tcl dynamic loading facilities.  It can be used
  6.  * in both safe and unsafe interpreters.
  7.  *
  8.  * Copyright (c) 1995 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * RCS: @(#) $Id: pkgc.c,v 1.4 2000/04/04 08:06:07 hobbs Exp $
  14.  */
  15. #include "tcl.h"
  17. /*
  18.  * Prototypes for procedures defined later in this file:
  19.  */
  21. static int    Pkgc_SubObjCmd _ANSI_ARGS_((ClientData clientData,
  22. Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
  23. static int    Pkgc_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData,
  24. Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
  26. /*
  27.  *----------------------------------------------------------------------
  28.  *
  29.  * Pkgc_SubObjCmd --
  30.  *
  31.  * This procedure is invoked to process the "pkgc_sub" Tcl command.
  32.  * It expects two arguments and returns their difference.
  33.  *
  34.  * Results:
  35.  * A standard Tcl result.
  36.  *
  37.  * Side effects:
  38.  * See the user documentation.
  39.  *
  40.  *----------------------------------------------------------------------
  41.  */
  43. static int
  44. Pkgc_SubObjCmd(dummy, interp, objc, objv)
  45.     ClientData dummy; /* Not used. */
  46.     Tcl_Interp *interp; /* Current interpreter. */
  47.     int objc; /* Number of arguments. */
  48.     Tcl_Obj * CONST objv[]; /* Argument objects. */
  49. {
  50.     int first, second;
  52.     if (objc != 3) {
  53. Tcl_WrongNumArgs(interp, 1, objv, "num num");
  54. return TCL_ERROR;
  55.     }
  56.     if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
  57.     || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
  58. return TCL_ERROR;
  59.     }
  60.     Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
  61.     return TCL_OK;
  62. }
  64. /*
  65.  *----------------------------------------------------------------------
  66.  *
  67.  * Pkgc_UnsafeCmd --
  68.  *
  69.  * This procedure is invoked to process the "pkgc_unsafe" Tcl command.
  70.  * It just returns a constant string.
  71.  *
  72.  * Results:
  73.  * A standard Tcl result.
  74.  *
  75.  * Side effects:
  76.  * See the user documentation.
  77.  *
  78.  *----------------------------------------------------------------------
  79.  */
  81. static int
  82. Pkgc_UnsafeObjCmd(dummy, interp, objc, objv)
  83.     ClientData dummy; /* Not used. */
  84.     Tcl_Interp *interp; /* Current interpreter. */
  85.     int objc; /* Number of arguments. */
  86.     Tcl_Obj * CONST objv[]; /* Argument objects. */
  87. {
  88.     Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
  89.     return TCL_OK;
  90. }
  92. /*
  93.  *----------------------------------------------------------------------
  94.  *
  95.  * Pkgc_Init --
  96.  *
  97.  * This is a package initialization procedure, which is called
  98.  * by Tcl when this package is to be added to an interpreter.
  99.  *
  100.  * Results:
  101.  * None.
  102.  *
  103.  * Side effects:
  104.  * None.
  105.  *
  106.  *----------------------------------------------------------------------
  107.  */
  109. int
  110. Pkgc_Init(interp)
  111.     Tcl_Interp *interp; /* Interpreter in which the package is
  112.  * to be made available. */
  113. {
  114.     int code;
  116.     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
  117. return TCL_ERROR;
  118.     }
  119.     code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
  120.     if (code != TCL_OK) {
  121. return code;
  122.     }
  123.     Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd,
  124.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  125.     Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd,
  126.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  127.     return TCL_OK;
  128. }
  130. /*
  131.  *----------------------------------------------------------------------
  132.  *
  133.  * Pkgc_SafeInit --
  134.  *
  135.  * This is a package initialization procedure, which is called
  136.  * by Tcl when this package is to be added to an unsafe interpreter.
  137.  *
  138.  * Results:
  139.  * None.
  140.  *
  141.  * Side effects:
  142.  * None.
  143.  *
  144.  *----------------------------------------------------------------------
  145.  */
  147. int
  148. Pkgc_SafeInit(interp)
  149.     Tcl_Interp *interp; /* Interpreter in which the package is
  150.  * to be made available. */
  151. {
  152.     int code;
  154.     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
  155. return TCL_ERROR;
  156.     }
  157.     code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
  158.     if (code != TCL_OK) {
  159.       return code;
  160.     }
  161.     Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, (ClientData) 0,
  162.     (Tcl_CmdDeleteProc *) NULL);
  163.     return TCL_OK;
  164. }