home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tclx7.3bl / tclx7 / tclX7.3b / src / tclXcmdloop.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-07-16  |  11.2 KB  |  383 lines
  1. /* 
  2.  * tclXcmdloop --
  3.  *
  4.  *   Interactive command loop, C and Tcl callable.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1994 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 4.0 1994/07/16 05:26:34 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Prototypes of internal functions.
  23.  */
  24. static int
  25. IsSetVarCmd _ANSI_ARGS_((char  *command));
  26.  
  27. static int
  28. SetPromptVar _ANSI_ARGS_((Tcl_Interp  *interp,
  29.                           char        *hookVarName,
  30.                           char        *newHookValue,
  31.                           char       **oldHookValuePtr));
  32.  
  33.  
  34. /*
  35.  *-----------------------------------------------------------------------------
  36.  * IsSetVarCmd --
  37.  *
  38.  *    Determine if a command is a `set' command that sets a variable
  39.  * (i.e. two arguments).  This routine should only be called if the command
  40.  * returned TCL_OK.  Returns TRUE if it sets a variable, FALSE if its some
  41.  * other command.
  42.  *-----------------------------------------------------------------------------
  43.  */
  44. static int
  45. IsSetVarCmd (command)
  46.     char  *command;
  47. {
  48.     char  *nextPtr;
  49.     int    wordCnt;
  50.  
  51.     if ((!STRNEQU (command, "set", 3)) || (!ISSPACE (command [3])))
  52.         return FALSE;  /* Quick check */
  53.  
  54.     /*
  55.      * Loop to count the words in the command.
  56.      */
  57.     wordCnt = 0;
  58.     nextPtr = command;
  59.     while (*nextPtr != '\0') {
  60.         nextPtr = TclWordEnd (nextPtr, FALSE, NULL);
  61.         nextPtr++;  /* Character after the word */
  62.         while ((*nextPtr != '\0') && (ISSPACE (*nextPtr)))
  63.             nextPtr++;
  64.         wordCnt++;
  65.     }
  66.     return wordCnt > 2 ? TRUE : FALSE;
  67. }
  68.  
  69. /*
  70.  *-----------------------------------------------------------------------------
  71.  *
  72.  * TclX_PrintResult --
  73.  *
  74.  *   Print the result of a Tcl.  It can optionally not echo "set" commands
  75.  * that successfully set a variable.
  76.  *
  77.  * Parameters:
  78.  *   o interp (I) - A pointer to the interpreter.  Result of command should be
  79.  *     in interp->result.
  80.  *   o intResult (I) - The integer result returned by Tcl_Eval.
  81.  *   o checkCmd (I) - If not NULL and the command was sucessful, check to
  82.  *     set if this is a "set" command setting a variable.  If so, don't echo
  83.  *     the result. 
  84.  *-----------------------------------------------------------------------------
  85.  */
  86. void
  87. TclX_PrintResult (interp, intResult, checkCmd)
  88.     Tcl_Interp *interp;
  89.     int         intResult;
  90.     char       *checkCmd;
  91. {
  92.     FILE *stdoutPtr;
  93.  
  94.     /*
  95.      * If the command was supplied and it was a successful set of a variable,
  96.      * don't output the result.
  97.      */
  98.     if ((checkCmd != NULL) && (intResult == TCL_OK) && IsSetVarCmd (checkCmd))
  99.         return;
  100.  
  101.     stdoutPtr = TCL_STDOUT;
  102.  
  103.     if (intResult == TCL_OK) {
  104.         if (interp->result [0] != '\0') {
  105.             fputs (interp->result, stdoutPtr);
  106.             fputs ("\n", stdoutPtr);
  107.         }
  108.     } else {
  109.         FILE *stderrPtr;
  110.         
  111.         stderrPtr = TCL_STDERR;
  112.  
  113.         fflush (stdoutPtr);
  114.         if (intResult == TCL_ERROR)  
  115.             fputs ("Error: ", stderrPtr);
  116.         else
  117.             fprintf (stderr, "Bad return code (%d): ", intResult);
  118.         fputs (interp->result, stderrPtr);
  119.         fputs ("\n", stderrPtr);
  120.         fflush (stderrPtr);
  121.     }
  122. }
  123.  
  124. /*
  125.  *-----------------------------------------------------------------------------
  126.  *
  127.  * TclX_OutputPrompt --
  128.  *     Outputs a prompt by executing either the command string in
  129.  *     tcl_prompt1 or tcl_prompt2.
  130.  *
  131.  *-----------------------------------------------------------------------------
  132.  */
  133. void
  134. TclX_OutputPrompt (interp, topLevel)
  135.     Tcl_Interp *interp;
  136.     int         topLevel;
  137. {
  138.     char *hookName;
  139.     char *promptHook;
  140.     int   result;
  141.     int   promptDone = FALSE;
  142.     FILE *stdoutPtr;
  143.  
  144.     /*
  145.      * If a signal came in, process it.  This prevents signals that are queued
  146.      * from generating prompt hook errors.
  147.      */
  148.     if (tcl_AsyncReady) {
  149.         Tcl_AsyncInvoke (interp, TCL_OK); 
  150.     }
  151.  
  152.     hookName = topLevel ? "tcl_prompt1" : "tcl_prompt2";
  153.  
  154.     promptHook = Tcl_GetVar (interp, hookName, 1);
  155.     if (promptHook != NULL) {
  156.         result = Tcl_Eval (interp, promptHook);
  157.         if (result == TCL_ERROR) {
  158.             FILE *stderrPtr;
  159.  
  160.             stderrPtr = TCL_STDERR;
  161.  
  162.             fputs ("Error in prompt hook: ", stderrPtr);
  163.             fputs (interp->result, stderrPtr);
  164.             fputs ("\n", stderrPtr);
  165.             TclX_PrintResult (interp, result, NULL);
  166.         } else {
  167.             promptDone = TRUE;
  168.         }
  169.     } 
  170.  
  171.     stdoutPtr = TCL_STDOUT;
  172.  
  173.     if (!promptDone) {
  174.         if (topLevel)
  175.             fputs ("%", stdoutPtr);
  176.         else
  177.             fputs (">", stdoutPtr);
  178.     }
  179.     fflush (stdoutPtr);
  180.     Tcl_ResetResult (interp);
  181. }
  182.  
  183. /*
  184.  *-----------------------------------------------------------------------------
  185.  *
  186.  * Tcl_CommandLoop --
  187.  *
  188.  *   Run a Tcl command loop.  The command loop interactively prompts for,
  189.  * reads and executes commands. Two global variables, "tcl_prompt1" and
  190.  * "tcl_prompt2" contain prompt hooks.  A prompt hook is Tcl code that is
  191.  * executed and its result is used as the prompt string. If a error generating
  192.  * signal occurs while in the command loop, it is reset and ignored.  EOF
  193.  * terminates the loop.
  194.  *
  195.  * Parameters:
  196.  *   o interp (I) - A pointer to the interpreter
  197.  *   o interactive (I) - If TRUE print prompts and non-error results.
  198.  * Returns:
  199.  *   TCL_OK or TCL_ERROR;
  200.  *-----------------------------------------------------------------------------
  201.  */
  202. int
  203. Tcl_CommandLoop (interp, interactive)
  204.     Tcl_Interp *interp;
  205.     int         interactive;
  206. {
  207.     Tcl_DString cmdBuf;
  208.     int         topLevel = TRUE;
  209.     int         result;
  210.     FILE       *stdinPtr, *stdoutPtr;
  211.  
  212.     Tcl_DStringInit (&cmdBuf);
  213.  
  214.     while (TRUE) {
  215.         /*
  216.          * If a signal came in, process it. Drop any pending command
  217.          * if a "error" signal occured since the last time we were
  218.          * through here.
  219.          */
  220.         if (tcl_AsyncReady) {
  221.             Tcl_AsyncInvoke (interp, TCL_OK); 
  222.         }
  223.         if (tclGotErrorSignal) {
  224.             tclGotErrorSignal = FALSE;
  225.             Tcl_DStringFree (&cmdBuf);
  226.             topLevel = TRUE;
  227.         }
  228.  
  229.         /*
  230.          * Output a prompt and input a command.
  231.          */
  232.         stdinPtr = TCL_STDIN;
  233.         stdoutPtr = TCL_STDOUT;
  234.  
  235.         clearerr (stdinPtr);
  236.         clearerr (stdoutPtr);
  237.         if (interactive)
  238.             TclX_OutputPrompt (interp, topLevel);
  239.         errno = 0;
  240.         result = Tcl_DStringGets (stdinPtr, &cmdBuf);
  241.  
  242.         if (result == TCL_BREAK)
  243.             goto endOfFile;
  244.  
  245.         if (result == TCL_ERROR) {
  246.             if (errno == EINTR) {
  247.                 putchar('\n');
  248.                 continue;  /* Next command */
  249.             }
  250.             Tcl_AppendResult (interp, "command input error on stdin: ",
  251.                               Tcl_PosixError (interp), (char *) NULL);
  252.             return TCL_ERROR;
  253.         }
  254.  
  255.         /*
  256.          * Newline was stripped by Tcl_DStringGets, but is needed for
  257.          * command-complete checking, add it back in.  If the command is
  258.          * not complete, get the next line.
  259.          */
  260.         Tcl_DStringAppend (&cmdBuf, "\n", 1);
  261.  
  262.         if (!Tcl_CommandComplete (cmdBuf.string)) {
  263.             topLevel = FALSE;
  264.             continue;  /* Next line */
  265.         }
  266.  
  267.         /*
  268.          * Finally have a complete command, go eval it and maybe output the
  269.          * result.
  270.          */
  271.         result = Tcl_RecordAndEval (interp, cmdBuf.string, 0);
  272.  
  273.         if (interactive || result != TCL_OK)
  274.             TclX_PrintResult (interp, result, cmdBuf.string);
  275.  
  276.         topLevel = TRUE;
  277.         Tcl_DStringFree (&cmdBuf);
  278.     }
  279.   endOfFile:
  280.     Tcl_DStringFree (&cmdBuf);
  281.     return TCL_OK;
  282. }
  283.  
  284. /*
  285.  *-----------------------------------------------------------------------------
  286.  *
  287.  * SetPromptVar --
  288.  *     Set one of the prompt hook variables, saving a copy of the old
  289.  *     value, if it exists.
  290.  *
  291.  * Parameters:
  292.  *   o hookVarName (I) - The name of the global variable containing prompt
  293.  *     hook.
  294.  *   o newHookValue (I) - The new value for the prompt hook.
  295.  *   o oldHookValuePtr (O) - If not NULL, then a pointer to a copy of the
  296.  *     old prompt value is returned here.  NULL is returned if there was not
  297.  *     old value.  This is a pointer to a malloc-ed string that must be
  298.  *     freed when no longer needed.
  299.  * Result:
  300.  *   TCL_OK if the hook variable was set ok, TCL_ERROR if an error occured.
  301.  *-----------------------------------------------------------------------------
  302.  */
  303. static int
  304. SetPromptVar (interp, hookVarName, newHookValue, oldHookValuePtr)
  305.     Tcl_Interp *interp;
  306.     char       *hookVarName;
  307.     char       *newHookValue;
  308.     char      **oldHookValuePtr;
  309. {
  310.     char *hookValue;    
  311.     char *oldHookPtr = NULL;
  312.  
  313.     if (oldHookValuePtr != NULL) {
  314.         hookValue = Tcl_GetVar (interp, hookVarName, TCL_GLOBAL_ONLY);
  315.         if (hookValue != NULL)
  316.             oldHookPtr =  ckstrdup (hookValue);
  317.     }
  318.     if (Tcl_SetVar (interp, hookVarName, newHookValue, 
  319.                     TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) {
  320.         if (oldHookPtr != NULL)
  321.             ckfree (oldHookPtr);
  322.         return TCL_ERROR;
  323.     }    
  324.     if (oldHookValuePtr != NULL)
  325.         *oldHookValuePtr = oldHookPtr;
  326.     return TCL_OK;
  327. }
  328.  
  329. /*
  330.  *-----------------------------------------------------------------------------
  331.  *
  332.  * Tcl_CommandloopCmd --
  333.  *     Implements the TCL commandloop command:
  334.  *       commandloop ?prompt1? ?prompt2?
  335.  *
  336.  * Results:
  337.  *     Standard TCL results.
  338.  *
  339.  *-----------------------------------------------------------------------------
  340.  */
  341. int
  342. Tcl_CommandloopCmd(clientData, interp, argc, argv)
  343.     ClientData  clientData;
  344.     Tcl_Interp *interp;
  345.     int         argc;
  346.     char      **argv;
  347. {
  348.     char *oldTopLevelHook  = NULL;
  349.     char *oldDownLevelHook = NULL;
  350.     int   result = TCL_ERROR;
  351.  
  352.     if (argc > 3) {
  353.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0],
  354.                           " ?prompt1? ?prompt2?", (char *) NULL);
  355.         return TCL_ERROR;
  356.     }
  357.     if (argc > 1) {
  358.         if (SetPromptVar (interp, "tcl_prompt1", argv[1],
  359.                           &oldTopLevelHook) != TCL_OK)
  360.             goto exitPoint;
  361.     }
  362.     if (argc > 2) {
  363.         if (SetPromptVar (interp, "tcl_prompt2", argv[2], 
  364.                           &oldDownLevelHook) != TCL_OK)
  365.             goto exitPoint;
  366.     }
  367.  
  368.     Tcl_CommandLoop (interp, TRUE);
  369.  
  370.     if (oldTopLevelHook != NULL)
  371.         SetPromptVar (interp, "topLevelPromptHook", oldTopLevelHook, NULL);
  372.     if (oldDownLevelHook != NULL)
  373.         SetPromptVar (interp, "downLevelPromptHook", oldDownLevelHook, NULL);
  374.         
  375.     result = TCL_OK;
  376.   exitPoint:
  377.     if (oldTopLevelHook != NULL)
  378.         ckfree (oldTopLevelHook);
  379.     if (oldDownLevelHook != NULL)
  380.         ckfree (oldDownLevelHook);
  381.     return result;
  382. }
  383.