pkgb.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:4k
源码类别:

通讯编程

开发平台:

Visual C++

  1. /* 
  2.  * pkgb.c --
  3.  *
  4.  * This file contains a simple Tcl package "pkgb" 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: pkgb.c,v 1.4 2000/04/04 08:06:07 hobbs Exp $
  14.  */
  15. #include "tcl.h"
  16. /*
  17.  * Prototypes for procedures defined later in this file:
  18.  */
  19. static int    Pkgb_SubObjCmd _ANSI_ARGS_((ClientData clientData,
  20. Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
  21. static int    Pkgb_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData,
  22. Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
  23. /*
  24.  *----------------------------------------------------------------------
  25.  *
  26.  * Pkgb_SubObjCmd --
  27.  *
  28.  * This procedure is invoked to process the "pkgb_sub" Tcl command.
  29.  * It expects two arguments and returns their difference.
  30.  *
  31.  * Results:
  32.  * A standard Tcl result.
  33.  *
  34.  * Side effects:
  35.  * See the user documentation.
  36.  *
  37.  *----------------------------------------------------------------------
  38.  */
  39. static int
  40. Pkgb_SubObjCmd(dummy, interp, objc, objv)
  41.     ClientData dummy; /* Not used. */
  42.     Tcl_Interp *interp; /* Current interpreter. */
  43.     int objc; /* Number of arguments. */
  44.     Tcl_Obj * CONST objv[]; /* Argument objects. */
  45. {
  46.     int first, second;
  47.     if (objc != 3) {
  48. Tcl_WrongNumArgs(interp, 1, objv, "num num");
  49.         return TCL_ERROR;
  50.     }
  51.     if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
  52.     || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
  53.         return TCL_ERROR;
  54.     }
  55.     Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
  56.     return TCL_OK;
  57. }
  58. /*
  59.  *----------------------------------------------------------------------
  60.  *
  61.  * Pkgb_UnsafeObjCmd --
  62.  *
  63.  * This procedure is invoked to process the "pkgb_unsafe" Tcl command.
  64.  * It just returns a constant string.
  65.  *
  66.  * Results:
  67.  * A standard Tcl result.
  68.  *
  69.  * Side effects:
  70.  * See the user documentation.
  71.  *
  72.  *----------------------------------------------------------------------
  73.  */
  74. static int
  75. Pkgb_UnsafeObjCmd(dummy, interp, objc, objv)
  76.     ClientData dummy; /* Not used. */
  77.     Tcl_Interp *interp; /* Current interpreter. */
  78.     int objc; /* Number of arguments. */
  79.     Tcl_Obj * CONST objv[]; /* Argument objects. */
  80. {
  81.     Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
  82.     return TCL_OK;
  83. }
  84. /*
  85.  *----------------------------------------------------------------------
  86.  *
  87.  * Pkgb_Init --
  88.  *
  89.  * This is a package initialization procedure, which is called
  90.  * by Tcl when this package is to be added to an interpreter.
  91.  *
  92.  * Results:
  93.  * None.
  94.  *
  95.  * Side effects:
  96.  * None.
  97.  *
  98.  *----------------------------------------------------------------------
  99.  */
  100. int
  101. Pkgb_Init(interp)
  102.     Tcl_Interp *interp; /* Interpreter in which the package is
  103.  * to be made available. */
  104. {
  105.     int code;
  106.     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
  107. return TCL_ERROR;
  108.     }
  109.     code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
  110.     if (code != TCL_OK) {
  111. return code;
  112.     }
  113.     Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
  114.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  115.     Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd,
  116.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  117.     return TCL_OK;
  118. }
  119. /*
  120.  *----------------------------------------------------------------------
  121.  *
  122.  * Pkgb_SafeInit --
  123.  *
  124.  * This is a package initialization procedure, which is called
  125.  * by Tcl when this package is to be added to an unsafe interpreter.
  126.  *
  127.  * Results:
  128.  * None.
  129.  *
  130.  * Side effects:
  131.  * None.
  132.  *
  133.  *----------------------------------------------------------------------
  134.  */
  135. int
  136. Pkgb_SafeInit(interp)
  137.     Tcl_Interp *interp; /* Interpreter in which the package is
  138.  * to be made available. */
  139. {
  140.     int code;
  141.     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
  142. return TCL_ERROR;
  143.     }
  144.     code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
  145.     if (code != TCL_OK) {
  146.       return code;
  147.     }
  148.     Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
  149.     (Tcl_CmdDeleteProc *) NULL);
  150.     return TCL_OK;
  151. }