home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src / tclXgeneral.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-05  |  5.9 KB  |  207 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCLExtend
  3. #endif
  4. /* 
  5.  * tclXgeneral.c --
  6.  *
  7.  *      Contains general extensions to the basic TCL command set.
  8.  *-----------------------------------------------------------------------------
  9.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  10.  *
  11.  * Permission to use, copy, modify, and distribute this software and its
  12.  * documentation for any purpose and without fee is hereby granted, provided
  13.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14.  * Mark Diekhans make no representations about the suitability of this
  15.  * software for any purpose.  It is provided "as is" without express or
  16.  * implied warranty.
  17.  *-----------------------------------------------------------------------------
  18.  * $Id: tclXgeneral.c,v 2.6 1993/08/04 15:20:50 markd Exp $
  19.  *-----------------------------------------------------------------------------
  20.  */
  21.  
  22. #include "tclExtdInt.h"
  23.  
  24. /*
  25.  * These globals must be set by main for the information to be defined.
  26.  */
  27.  
  28. char *tclxVersion       = "7.0";    /* Extended Tcl version number.            */
  29. int   tclxPatchlevel    = 0;        /* Extended Tcl patch level.               */
  30.  
  31. char *tclAppName        = "tcl";            /* Application name                        */
  32. char *tclAppLongname    = "tcl X Shell";    /* Long, natural language application name */
  33. char *tclAppVersion     = "7.0";            /* Version number of the application       */
  34.  
  35.  
  36. /*
  37.  *-----------------------------------------------------------------------------
  38.  *
  39.  * Tcl_EchoCmd --
  40.  *    Implements the TCL echo command:
  41.  *        echo ?str ...?
  42.  *
  43.  * Results:
  44.  *      Always returns TCL_OK.
  45.  *
  46.  *-----------------------------------------------------------------------------
  47.  */
  48. int
  49. Tcl_EchoCmd(clientData, interp, argc, argv)
  50.     ClientData  clientData;
  51.     Tcl_Interp *interp;
  52.     int         argc;
  53.     char      **argv;
  54. {
  55.     int idx;
  56.  
  57.     for (idx = 1; idx < argc; idx++) {
  58.         fputs (argv [idx], stdout);
  59.         if (idx < (argc - 1))
  60.             printf(" ");
  61.     }
  62.     printf("\n");
  63.     return TCL_OK;
  64. }
  65.  
  66. /*
  67.  *-----------------------------------------------------------------------------
  68.  *
  69.  * Tcl_InfoxCmd --
  70.  *    Implements the TCL infox command:
  71.  *        infox option
  72.  *
  73.  *-----------------------------------------------------------------------------
  74.  */
  75. int
  76. Tcl_InfoxCmd (clientData, interp, argc, argv)
  77.     ClientData  clientData;
  78.     Tcl_Interp *interp;
  79.     int         argc;
  80.     char      **argv;
  81. {
  82.     if (argc != 2) {
  83.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  84.                           " option", (char *) NULL);
  85.         return TCL_ERROR;
  86.     }
  87.  
  88.     if (STREQU ("version", argv [1])) {
  89.         Tcl_SetResult (interp, tclxVersion, TCL_STATIC);
  90.         return TCL_OK;
  91.     }
  92.     if (STREQU ("patchlevel", argv [1])) {
  93.         char numBuf [32];
  94.         sprintf (numBuf, "%d", tclxPatchlevel);
  95.         Tcl_SetResult (interp, numBuf, TCL_VOLATILE);
  96.         return TCL_OK;
  97.     }
  98.     if (STREQU ("posix_signals", argv [1])) {
  99. #       ifdef HAVE_SIGACTION
  100.         interp->result = "1";
  101. #       else
  102.         interp->result = "0";
  103. #       endif        
  104.         return TCL_OK;
  105.     }
  106.     if (STREQU ("appname", argv [1])) {
  107.         if (tclAppName != NULL)
  108.             Tcl_SetResult (interp, tclAppName, TCL_STATIC);
  109.         return TCL_OK;
  110.     }
  111.     if (STREQU ("applongname", argv [1])) {
  112.         if (tclAppLongname != NULL)
  113.             Tcl_SetResult (interp, tclAppLongname, TCL_STATIC);
  114.         return TCL_OK;
  115.     }
  116.     if (STREQU ("appversion", argv [1])) {
  117.         if (tclAppVersion != NULL)
  118.             Tcl_SetResult (interp, tclAppVersion, TCL_STATIC);
  119.         return TCL_OK;
  120.     }
  121.  
  122.     Tcl_AppendResult (interp, "illegal option \"", argv [1], 
  123.                       "\" expect one of: version, patchlevel, posix_signals, ",
  124.                       "appname, applongname, or appversion",
  125.                       (char *) NULL);
  126.     return TCL_ERROR;
  127. }
  128.  
  129. /*
  130.  *-----------------------------------------------------------------------------
  131.  *
  132.  * Tcl_LoopCmd --
  133.  *     Implements the TCL loop command:
  134.  *         loop var start end ?increment? command
  135.  *
  136.  * Results:
  137.  *      Standard TCL results.
  138.  *
  139.  *-----------------------------------------------------------------------------
  140.  */
  141. int
  142. Tcl_LoopCmd (dummy, interp, argc, argv)
  143.     ClientData  dummy;
  144.     Tcl_Interp *interp;
  145.     int         argc;
  146.     char      **argv;
  147. {
  148.     int   result = TCL_OK;
  149.     long  i, first, limit, incr = 1;
  150.     char *command;
  151.     char  itxt [12];
  152.  
  153.     if ((argc < 5) || (argc > 6)) {
  154.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  155.                           " var first limit ?incr? command", (char *) NULL);
  156.         return TCL_ERROR;
  157.     }
  158.  
  159.     if (Tcl_ExprLong (interp, argv[2], &first) != TCL_OK)
  160.         return TCL_ERROR;
  161.     if (Tcl_ExprLong (interp, argv[3], &limit) != TCL_OK)
  162.         return TCL_ERROR;
  163.     if (argc == 5) {
  164.         command = argv[4];
  165.     } else {
  166.         if (Tcl_ExprLong (interp, argv[4], &incr) != TCL_OK)
  167.             return TCL_ERROR;
  168.         command = argv[5];
  169.     }
  170.  
  171.     for (i = first;
  172.              (((i < limit) && (incr > 0)) || ((i > limit) && (incr < 0)));
  173.              i += incr) {
  174.  
  175.         sprintf (itxt,"%ld",i);
  176.         if (Tcl_SetVar (interp, argv [1], itxt, TCL_LEAVE_ERR_MSG) == NULL)
  177.             return TCL_ERROR;
  178.  
  179.         result = Tcl_Eval (interp, command);
  180.         if (result != TCL_OK) {
  181.             if (result == TCL_CONTINUE) {
  182.                 result = TCL_OK;
  183.             } else if (result == TCL_BREAK) {
  184.                 result = TCL_OK;
  185.                 break;
  186.             } else if (result == TCL_ERROR) {
  187.                 char buf [64];
  188.  
  189.                 sprintf (buf, "\n    (\"loop\" body line %d)", 
  190.                          interp->errorLine);
  191.                 Tcl_AddErrorInfo (interp, buf);
  192.                 break;
  193.             } else {
  194.                 break;
  195.             }
  196.         }
  197.     }
  198.     /*
  199.      * Set variable to its final value.
  200.      */
  201.     sprintf (itxt,"%ld",i);
  202.     if (Tcl_SetVar (interp, argv [1], itxt, TCL_LEAVE_ERR_MSG) == NULL)
  203.         return TCL_ERROR;
  204.  
  205.     return result;
  206. }
  207.