home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcltk805.zip / tcl805s.zip / tcl8.0.5 / os2 / dltest / pkgd.c < prev    next >
C/C++ Source or Header  |  1999-04-23  |  4KB  |  155 lines
  1. /* 
  2.  * pkgd.c --
  3.  *
  4.  *    This file contains a simple Tcl package "pkgd" 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.  * SCCS: @(#) pkgd.c 1.4 96/02/15 12:30:32
  14.  */
  15.  
  16. #include "tcl.h"
  17.  
  18. /*
  19.  * Prototypes for procedures defined later in this file:
  20.  */
  21.  
  22. static int    Pkgd_SubCmd _ANSI_ARGS_((ClientData clientData,
  23.             Tcl_Interp *interp, int argc, char **argv));
  24. static int    Pkgd_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
  25.             Tcl_Interp *interp, int argc, char **argv));
  26.  
  27. /*
  28.  *----------------------------------------------------------------------
  29.  *
  30.  * Pkgd_SubCmd --
  31.  *
  32.  *    This procedure is invoked to process the "pkgd_sub" Tcl command.
  33.  *    It expects two arguments and returns their difference.
  34.  *
  35.  * Results:
  36.  *    A standard Tcl result.
  37.  *
  38.  * Side effects:
  39.  *    See the user documentation.
  40.  *
  41.  *----------------------------------------------------------------------
  42.  */
  43.  
  44. static int
  45. Pkgd_SubCmd(dummy, interp, argc, argv)
  46.     ClientData dummy;            /* Not used. */
  47.     Tcl_Interp *interp;            /* Current interpreter. */
  48.     int argc;                /* Number of arguments. */
  49.     char **argv;            /* Argument strings. */
  50. {
  51.     int first, second;
  52.  
  53.     if (argc != 3) {
  54.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  55.         " num num\"", (char *) NULL);
  56.     return TCL_ERROR;
  57.     }
  58.     if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
  59.         || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
  60.     return TCL_ERROR;
  61.     }
  62.     sprintf(interp->result, "%d", first - second);
  63.     return TCL_OK;
  64. }
  65.  
  66. /*
  67.  *----------------------------------------------------------------------
  68.  *
  69.  * Pkgd_UnsafeCmd --
  70.  *
  71.  *    This procedure is invoked to process the "pkgd_unsafe" Tcl command.
  72.  *    It just returns a constant string.
  73.  *
  74.  * Results:
  75.  *    A standard Tcl result.
  76.  *
  77.  * Side effects:
  78.  *    See the user documentation.
  79.  *
  80.  *----------------------------------------------------------------------
  81.  */
  82.  
  83. static int
  84. Pkgd_UnsafeCmd(dummy, interp, argc, argv)
  85.     ClientData dummy;            /* Not used. */
  86.     Tcl_Interp *interp;            /* Current interpreter. */
  87.     int argc;                /* Number of arguments. */
  88.     char **argv;            /* Argument strings. */
  89. {
  90.     interp->result = "unsafe command invoked";
  91.     return TCL_OK;
  92. }
  93.  
  94. /*
  95.  *----------------------------------------------------------------------
  96.  *
  97.  * Pkgd_Init --
  98.  *
  99.  *    This is a package initialization procedure, which is called
  100.  *    by Tcl when this package is to be added to an interpreter.
  101.  *
  102.  * Results:
  103.  *    None.
  104.  *
  105.  * Side effects:
  106.  *    None.
  107.  *
  108.  *----------------------------------------------------------------------
  109.  */
  110.  
  111. int
  112. Pkgd_Init(interp)
  113.     Tcl_Interp *interp;        /* Interpreter in which the package is
  114.                  * to be made available. */
  115. {
  116.     int code;
  117.  
  118.     code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
  119.     if (code != TCL_OK) {
  120.     return code;
  121.     }
  122.     Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
  123.         (Tcl_CmdDeleteProc *) NULL);
  124.     Tcl_CreateCommand(interp, "pkgd_unsafe", Pkgd_UnsafeCmd, (ClientData) 0,
  125.         (Tcl_CmdDeleteProc *) NULL);
  126.     return TCL_OK;
  127. }
  128.  
  129. /*
  130.  *----------------------------------------------------------------------
  131.  *
  132.  * Pkgd_SafeInit --
  133.  *
  134.  *    This is a package initialization procedure, which is called
  135.  *    by Tcl when this package is to be added to an unsafe interpreter.
  136.  *
  137.  * Results:
  138.  *    None.
  139.  *
  140.  * Side effects:
  141.  *    None.
  142.  *
  143.  *----------------------------------------------------------------------
  144.  */
  145.  
  146. int
  147. Pkgd_SafeInit(interp)
  148.     Tcl_Interp *interp;        /* Interpreter in which the package is
  149.                  * to be made available. */
  150. {
  151.     Tcl_CreateCommand(interp, "pkgd_sub", Pkgd_SubCmd, (ClientData) 0,
  152.         (Tcl_CmdDeleteProc *) NULL);
  153.     return TCL_OK;
  154. }
  155.