home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tclX6.5c / src / tclXcmdloop.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-19  |  11.7 KB  |  389 lines
  1. /* 
  2.  * tclXcmdloop --
  3.  *
  4.  *   Interactive command loop, C and Tcl callable.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXcmdloop.c,v 2.0 1992/10/16 04:50:29 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21.  
  22. /*
  23.  * Pointer to eval procedure to use.  This way bring in the history module
  24.  * from a library can be made optional.  This only works because the calling
  25.  * sequence of Tcl_Eval is a superset of Tcl_RecordAndEval.  This defaults
  26.  * to no history, set this variable to Tcl_RecordAndEval to use history.
  27.  */
  28.  
  29. int (*tclShellCmdEvalProc) () = Tcl_Eval;
  30.  
  31. /*
  32.  * Prototypes of internal functions.
  33.  */
  34. int
  35. IsSetVarCmd _ANSI_ARGS_((Tcl_Interp *interp,
  36.                          char       *command));
  37.  
  38. void
  39. OutFlush _ANSI_ARGS_((FILE *filePtr));
  40.  
  41. void
  42. Tcl_PrintResult _ANSI_ARGS_((FILE   *fp,
  43.                              int     returnval,
  44.                              char   *resultText));
  45.  
  46. void
  47. OutputPrompt _ANSI_ARGS_((Tcl_Interp *interp,
  48.                           FILE       *outFP,
  49.                           int         topLevel));
  50.  
  51. int
  52. SetPromptVar _ANSI_ARGS_((Tcl_Interp  *interp,
  53.                           char        *hookVarName,
  54.                           char        *newHookValue,
  55.                           char       **oldHookValuePtr));
  56.  
  57.  
  58. /*
  59.  *-----------------------------------------------------------------------------
  60.  *
  61.  * IsSetVarCmd --
  62.  *
  63.  *      Determine if the current command is a `set' command that set
  64.  *      a variable (i.e. two arguments).  This routine should only be
  65.  *      called if the command returned TCL_OK.
  66.  *
  67.  *-----------------------------------------------------------------------------
  68.  */
  69. static int
  70. IsSetVarCmd (interp, command)
  71.     Tcl_Interp *interp;
  72.     char       *command;
  73. {
  74.     char  *nextPtr;
  75.  
  76.     if ((!STRNEQU (command, "set", 3)) || (!isspace (command [3])))
  77.         return FALSE;  /* Quick check */
  78.  
  79.     nextPtr = TclWordEnd (command, FALSE);
  80.     if (*nextPtr == '\0')
  81.         return FALSE;
  82.     nextPtr = TclWordEnd (nextPtr, FALSE);
  83.     if (*nextPtr == '\0')
  84.         return FALSE;
  85.  
  86.     while (*nextPtr != '\0') {
  87.         if (!isspace (*nextPtr))
  88.             return TRUE;
  89.         nextPtr++;
  90.     }
  91.     return FALSE;
  92. }
  93.  
  94. /*
  95.  *-----------------------------------------------------------------------------
  96.  *
  97.  * OutFlush --
  98.  *
  99.  *   Flush a stdio file and check for errors.
  100.  *
  101.  *-----------------------------------------------------------------------------
  102.  */
  103. static void
  104. OutFlush (filePtr)
  105.     FILE *filePtr;
  106. {
  107.     int stat;
  108.  
  109.     stat = fflush (filePtr);
  110.     if (ferror (filePtr)) {
  111.         if (errno != EINTR)
  112.             panic ("command loop: error writing to output file: %s\n",
  113.                    strerror (errno));
  114.         clearerr (filePtr);
  115.     }
  116. }
  117.  
  118. /*
  119.  *-----------------------------------------------------------------------------
  120.  *
  121.  * Tcl_PrintResult --
  122.  *
  123.  *      Print a Tcl result
  124.  *
  125.  * Results:
  126.  *
  127.  *      Takes an open file pointer, a return value and some result
  128.  *      text.  Prints the result text if the return value is TCL_OK,
  129.  *      prints "Error:" and the result text if it's TCL_ERROR,
  130.  *      else prints "Bad return code:" and the result text.
  131.  *
  132.  *-----------------------------------------------------------------------------
  133.  */
  134. static void
  135. Tcl_PrintResult (fp, returnval, resultText)
  136.     FILE   *fp;
  137.     int     returnval;
  138.     char   *resultText;
  139. {
  140.  
  141.     if (returnval == TCL_OK) {
  142.         if (resultText [0] != '\0') {
  143.             fputs (resultText, fp);
  144.             fputs ("\n", fp);
  145.         }
  146.     } else {
  147.         OutFlush (fp);
  148.         fputs ((returnval == TCL_ERROR) ? "Error" : "Bad return code", stderr);
  149.         fputs (": ", stderr);
  150.         fputs (resultText, stderr);
  151.         fputs ("\n", stderr);
  152.         OutFlush (stderr);
  153.     }
  154. }
  155.  
  156. /*
  157.  *-----------------------------------------------------------------------------
  158.  *
  159.  * OutputPromp --
  160.  *     Outputs a prompt by executing either the command string in
  161.  *     TCLENV(topLevelPromptHook) or TCLENV(downLevelPromptHook).
  162.  *
  163.  *-----------------------------------------------------------------------------
  164.  */
  165. static void
  166. OutputPrompt (interp, outFP, topLevel)
  167.     Tcl_Interp *interp;
  168.     FILE       *outFP;
  169.     int         topLevel;
  170. {
  171.     char *hookName;
  172.     char *promptHook;
  173.     int   result;
  174.     int   promptDone = FALSE;
  175.  
  176.     hookName = topLevel ? "topLevelPromptHook"
  177.                         : "downLevelPromptHook";
  178.  
  179.     promptHook = Tcl_GetVar2 (interp, "TCLENV", hookName, 1);
  180.     if ((promptHook != NULL) && (promptHook [0] != '\0')) {
  181.         result = Tcl_Eval (interp, promptHook, 0, (char **)NULL);
  182.         if (!((result == TCL_OK) || (result == TCL_RETURN))) {
  183.             fputs ("Error in prompt hook: ", stderr);
  184.             fputs (interp->result, stderr);
  185.             fputs ("\n", stderr);
  186.             Tcl_PrintResult (outFP, result, interp->result);
  187.         } else {
  188.             fputs (interp->result, outFP);
  189.             promptDone = TRUE;
  190.         }
  191.     } 
  192.     if (!promptDone) {
  193.         if (topLevel)
  194.             fputs ("%", outFP);
  195.         else
  196.             fputs (">", outFP);
  197.     }
  198.     OutFlush (outFP);
  199.  
  200. }
  201.  
  202. /*
  203.  *-----------------------------------------------------------------------------
  204.  *
  205.  * Tcl_CommandLoop --
  206.  *
  207.  *   Run a Tcl command loop.  The command loop interactively prompts for,
  208.  * reads and executes commands. Two entries in the global array TCLENV
  209.  * contain prompt hooks.  A prompt hook is Tcl code that is executed and
  210.  * its result is used as the prompt string.  The element `topLevelPromptHook'
  211.  * is the hook that generates the main prompt.  The element
  212.  * `downLevelPromptHook' is the hook to generate the prompt for reading
  213.  * continuation lines for incomplete commands.  If a signal occurs while
  214.  * in the command loop, it is reset and ignored.  EOF terminates the loop.
  215.  *
  216.  * Parameters:
  217.  *   o interp (I) - A pointer to the interpreter
  218.  *   o inFile (I) - The file to read commands from.
  219.  *   o outFile (I) - The file to write the prompts to. 
  220.  *   o evalProc (I) - The function to call to evaluate a command.
  221.  *     Should be either Tcl_Eval or Tcl_RecordAndEval if history is desired.
  222.  *   o options (I) - Currently unused.
  223.  *-----------------------------------------------------------------------------
  224.  */
  225. void
  226. Tcl_CommandLoop (interp, inFile, outFile, evalProc, options)
  227.     Tcl_Interp *interp;
  228.     FILE       *inFile;
  229.     FILE       *outFile;
  230.     int         (*evalProc) ();
  231.     unsigned    options;
  232. {
  233.     Tcl_CmdBuf cmdBuf;
  234.     char       inputBuf[256];
  235.     int        topLevel = TRUE;
  236.     int        result;
  237.     char      *cmd;
  238.  
  239.     cmdBuf = Tcl_CreateCmdBuf();
  240.  
  241.     while (TRUE) {
  242.         /*
  243.          * If a signal came in, process it and drop any pending command.
  244.          */
  245.         if (tclReceivedSignal) {
  246.             Tcl_CheckForSignal (interp, TCL_OK);
  247.             Tcl_DeleteCmdBuf(cmdBuf);
  248.             cmdBuf = Tcl_CreateCmdBuf();
  249.             topLevel = TRUE;
  250.         }
  251.         /*
  252.          * Output a prompt and input a command.
  253.          */
  254.         clearerr (inFile);
  255.         clearerr (outFile);
  256.         OutputPrompt (interp, outFile, topLevel);
  257.         errno = 0;
  258.         if (fgets (inputBuf, sizeof (inputBuf), inFile) == NULL) {
  259.             if (!feof(inFile) && (errno == EINTR)) {
  260.                 putchar('\n');
  261.                 continue;  /* Next command */
  262.             }
  263.             if (ferror (inFile))
  264.                 panic ("command loop: error on input file: %s\n",
  265.                        strerror (errno));
  266.             goto endOfFile;
  267.         }
  268.         cmd = Tcl_AssembleCmd(cmdBuf, inputBuf);
  269.  
  270.         if (cmd == NULL) {
  271.             topLevel = FALSE;
  272.             continue;  /* Next line */
  273.         }
  274.         /*
  275.          * Finally have a complete command, go eval it and maybe output the
  276.          * result.
  277.          */
  278.         result = (*evalProc) (interp, cmd, 0, (char **)NULL);
  279.         if (result != TCL_OK || !IsSetVarCmd (interp, cmd))
  280.             Tcl_PrintResult (outFile, result, interp->result);
  281.         topLevel = TRUE;
  282.     }
  283. endOfFile:
  284.     Tcl_DeleteCmdBuf(cmdBuf);
  285. }
  286.  
  287. /*
  288.  *-----------------------------------------------------------------------------
  289.  *
  290.  * SetPromptVar --
  291.  *     Set one of the prompt hook variables, saving a copy of the old
  292.  *     value, if it exists.
  293.  *
  294.  * Parameters:
  295.  *   o hookVarName (I) - The name of the prompt hook, which is an element
  296.  *     of the TCLENV array.  One of topLevelPromptHook or downLevelPromptHook.
  297.  *   o newHookValue (I) - The new value for the prompt hook.
  298.  *   o oldHookValuePtr (O) - If not NULL, then a pointer to a copy of the
  299.  *     old prompt value is returned here.  NULL is returned if there was not
  300.  *     old value.  This is a pointer to a malloc-ed string that must be
  301.  *     freed when no longer needed.
  302.  * Result:
  303.  *   TCL_OK if the hook variable was set ok, TCL_ERROR if an error occured.
  304.  *-----------------------------------------------------------------------------
  305.  */
  306. static int
  307. SetPromptVar (interp, hookVarName, newHookValue, oldHookValuePtr)
  308.     Tcl_Interp *interp;
  309.     char       *hookVarName;
  310.     char       *newHookValue;
  311.     char      **oldHookValuePtr;
  312. {
  313.     char *hookValue;    
  314.     char *oldHookPtr = NULL;
  315.  
  316.     if (oldHookValuePtr != NULL) {
  317.         hookValue = Tcl_GetVar2 (interp, "TCLENV", hookVarName, 
  318.                                  TCL_GLOBAL_ONLY);
  319.         if (hookValue != NULL) {
  320.             oldHookPtr = ckalloc (strlen (hookValue) + 1);
  321.             strcpy (oldHookPtr, hookValue);
  322.         }
  323.     }
  324.     if (Tcl_SetVar2 (interp, "TCLENV", hookVarName, newHookValue, 
  325.                      TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) {
  326.         if (oldHookPtr != NULL)
  327.             ckfree (oldHookPtr);
  328.         return TCL_ERROR;
  329.     }    
  330.     if (oldHookValuePtr != NULL)
  331.         *oldHookValuePtr = oldHookPtr;
  332.     return TCL_OK;
  333. }
  334.  
  335. /*
  336.  *-----------------------------------------------------------------------------
  337.  *
  338.  * Tcl_CommandloopCmd --
  339.  *     Implements the TCL commandloop command:
  340.  *       commandloop prompt prompt2
  341.  *
  342.  * Results:
  343.  *     Standard TCL results.
  344.  *
  345.  *-----------------------------------------------------------------------------
  346.  */
  347. int
  348. Tcl_CommandloopCmd(clientData, interp, argc, argv)
  349.     ClientData  clientData;
  350.     Tcl_Interp *interp;
  351.     int         argc;
  352.     char      **argv;
  353. {
  354.     char *oldTopLevelHook  = NULL;
  355.     char *oldDownLevelHook = NULL;
  356.     int   result = TCL_ERROR;
  357.  
  358.     if (argc > 3) {
  359.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0],
  360.                           " [prompt] [prompt2]", (char *) NULL);
  361.         return TCL_ERROR;
  362.     }
  363.     if (argc > 1) {
  364.         if (SetPromptVar (interp, "topLevelPromptHook", argv[1],
  365.                           &oldTopLevelHook) != TCL_OK)
  366.             goto exitPoint;
  367.     }
  368.     if (argc > 2) {
  369.         if (SetPromptVar (interp, "downLevelPromptHook", argv[2], 
  370.                           &oldDownLevelHook) != TCL_OK)
  371.             goto exitPoint;
  372.     }
  373.  
  374.     Tcl_CommandLoop (interp, stdin, stdout, tclShellCmdEvalProc, 0);
  375.  
  376.     if (oldTopLevelHook != NULL)
  377.         SetPromptVar (interp, "topLevelPromptHook", oldTopLevelHook, NULL);
  378.     if (oldDownLevelHook != NULL)
  379.         SetPromptVar (interp, "downLevelPromptHook", oldDownLevelHook, NULL);
  380.         
  381.     result = TCL_OK;
  382. exitPoint:
  383.     if (oldTopLevelHook != NULL)
  384.         ckfree (oldTopLevelHook);
  385.     if (oldDownLevelHook != NULL)
  386.         ckfree (oldDownLevelHook);
  387.     return result;
  388. }
  389.