home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / src / tclXcmdloop.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-01-11  |  10.6 KB  |  356 lines
  1. /* 
  2.  * tclXcmdloop --
  3.  *
  4.  *   Interactive command loop, C and Tcl callable.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1993 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 3.1 1994/01/11 06:31:35 markd Exp $
  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.     /*
  93.      * If the command was supplied and it was a successful set of a variable,
  94.      * don't output the result.
  95.      */
  96.     if ((checkCmd != NULL) && (intResult == TCL_OK) && IsSetVarCmd (checkCmd))
  97.         return;
  98.  
  99.     if (intResult == TCL_OK) {
  100.         if (interp->result [0] != '\0') {
  101.             fputs (interp->result, stdout);
  102.             fputs ("\n", stdout);
  103.         }
  104.     } else {
  105.         fflush (stdout);
  106.         if (intResult == TCL_ERROR)  
  107.             fputs ("Error: ", stderr);
  108.         else
  109.             fprintf (stderr, "Bad return code (%d): ", intResult);
  110.         fputs (interp->result, stderr);
  111.         fputs ("\n", stderr);
  112.         fflush (stderr);
  113.     }
  114. }
  115.  
  116. /*
  117.  *-----------------------------------------------------------------------------
  118.  *
  119.  * TclX_OutputPrompt --
  120.  *     Outputs a prompt by executing either the command string in
  121.  *     tcl_prompt1 or tcl_prompt2.
  122.  *
  123.  *-----------------------------------------------------------------------------
  124.  */
  125. void
  126. TclX_OutputPrompt (interp, topLevel)
  127.     Tcl_Interp *interp;
  128.     int         topLevel;
  129. {
  130.     char *hookName;
  131.     char *promptHook;
  132.     int   result;
  133.     int   promptDone = FALSE;
  134.  
  135.     /*
  136.      * If a signal came in, process it.  This prevents signals that are queued
  137.      * from generating prompt hook errors.
  138.      */
  139.     if (tcl_AsyncReady) {
  140.         Tcl_AsyncInvoke (interp, TCL_OK); 
  141.     }
  142.  
  143.     hookName = topLevel ? "tcl_prompt1" : "tcl_prompt2";
  144.  
  145.     promptHook = Tcl_GetVar (interp, hookName, 1);
  146.     if (promptHook != NULL) {
  147.         result = Tcl_Eval (interp, promptHook);
  148.         if (result == TCL_ERROR) {
  149.             fputs ("Error in prompt hook: ", stderr);
  150.             fputs (interp->result, stderr);
  151.             fputs ("\n", stderr);
  152.             TclX_PrintResult (interp, result, NULL);
  153.         } else {
  154.             promptDone = TRUE;
  155.         }
  156.     } 
  157.     if (!promptDone) {
  158.         if (topLevel)
  159.             fputs ("%", stdout);
  160.         else
  161.             fputs (">", stdout);
  162.     }
  163.     fflush (stdout);
  164.     Tcl_ResetResult (interp);
  165. }
  166.  
  167. /*
  168.  *-----------------------------------------------------------------------------
  169.  *
  170.  * Tcl_CommandLoop --
  171.  *
  172.  *   Run a Tcl command loop.  The command loop interactively prompts for,
  173.  * reads and executes commands. Two global variables, "tcl_prompt1" and
  174.  * "tcl_prompt2" contain prompt hooks.  A prompt hook is Tcl code that is
  175.  * executed and its result is used as the prompt string. If a error generating
  176.  * signal occurs while in the command loop, it is reset and ignored.  EOF
  177.  * terminates the loop.
  178.  *
  179.  * Parameters:
  180.  *   o interp (I) - A pointer to the interpreter
  181.  *   o interactive (I) - If TRUE print prompts and non-error results.
  182.  * Returns:
  183.  *   TCL_OK or TCL_ERROR;
  184.  *-----------------------------------------------------------------------------
  185.  */
  186. int
  187. Tcl_CommandLoop (interp, interactive)
  188.     Tcl_Interp *interp;
  189.     int         interactive;
  190. {
  191.     Tcl_DString cmdBuf;
  192.     char        inputBuf [128];
  193.     int         topLevel = TRUE;
  194.     int         result;
  195.  
  196.     Tcl_DStringInit (&cmdBuf);
  197.  
  198.     while (TRUE) {
  199.         /*
  200.          * If a signal came in, process it. Drop any pending command
  201.          * if a "error" signal occured since the last time we were
  202.          * through here.
  203.          */
  204.         if (tcl_AsyncReady) {
  205.             Tcl_AsyncInvoke (interp, TCL_OK); 
  206.         }
  207.         if (tclGotErrorSignal) {
  208.             tclGotErrorSignal = FALSE;
  209.             Tcl_DStringFree (&cmdBuf);
  210.             topLevel = TRUE;
  211.         }
  212.  
  213.         /*
  214.          * Output a prompt and input a command.
  215.          */
  216.         clearerr (stdin);
  217.         clearerr (stdout);
  218.         if (interactive)
  219.             TclX_OutputPrompt (interp, topLevel);
  220.         errno = 0;
  221.         if (fgets (inputBuf, sizeof (inputBuf), stdin) == NULL) {
  222.             if (!feof(stdin) && (errno == EINTR)) {
  223.                 putchar('\n');
  224.                 continue;  /* Next command */
  225.             }
  226.             if (ferror (stdin)) {
  227.                 Tcl_AppendResult (interp, "command input error on stdin: ",
  228.                                   Tcl_PosixError (interp), (char *) NULL);
  229.                 return TCL_ERROR;
  230.             }
  231.             goto endOfFile;
  232.         }
  233.         Tcl_DStringAppend (&cmdBuf, inputBuf, -1);
  234.  
  235.         if (!Tcl_CommandComplete (cmdBuf.string)) {
  236.             topLevel = FALSE;
  237.             continue;  /* Next line */
  238.         }
  239.  
  240.         /*
  241.          * Finally have a complete command, go eval it and maybe output the
  242.          * result.
  243.          */
  244.         result = Tcl_RecordAndEval (interp, cmdBuf.string, 0);
  245.  
  246.         if (interactive || result != TCL_OK)
  247.             TclX_PrintResult (interp, result, cmdBuf.string);
  248.  
  249.         topLevel = TRUE;
  250.         Tcl_DStringFree (&cmdBuf);
  251.     }
  252.   endOfFile:
  253.     Tcl_DStringFree (&cmdBuf);
  254.     return TCL_OK;
  255. }
  256.  
  257. /*
  258.  *-----------------------------------------------------------------------------
  259.  *
  260.  * SetPromptVar --
  261.  *     Set one of the prompt hook variables, saving a copy of the old
  262.  *     value, if it exists.
  263.  *
  264.  * Parameters:
  265.  *   o hookVarName (I) - The name of the global variable containing prompt
  266.  *     hook.
  267.  *   o newHookValue (I) - The new value for the prompt hook.
  268.  *   o oldHookValuePtr (O) - If not NULL, then a pointer to a copy of the
  269.  *     old prompt value is returned here.  NULL is returned if there was not
  270.  *     old value.  This is a pointer to a malloc-ed string that must be
  271.  *     freed when no longer needed.
  272.  * Result:
  273.  *   TCL_OK if the hook variable was set ok, TCL_ERROR if an error occured.
  274.  *-----------------------------------------------------------------------------
  275.  */
  276. static int
  277. SetPromptVar (interp, hookVarName, newHookValue, oldHookValuePtr)
  278.     Tcl_Interp *interp;
  279.     char       *hookVarName;
  280.     char       *newHookValue;
  281.     char      **oldHookValuePtr;
  282. {
  283.     char *hookValue;    
  284.     char *oldHookPtr = NULL;
  285.  
  286.     if (oldHookValuePtr != NULL) {
  287.         hookValue = Tcl_GetVar (interp, hookVarName, TCL_GLOBAL_ONLY);
  288.         if (hookValue != NULL)
  289.             oldHookPtr =  ckstrdup (hookValue);
  290.     }
  291.     if (Tcl_SetVar (interp, hookVarName, newHookValue, 
  292.                     TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) {
  293.         if (oldHookPtr != NULL)
  294.             ckfree (oldHookPtr);
  295.         return TCL_ERROR;
  296.     }    
  297.     if (oldHookValuePtr != NULL)
  298.         *oldHookValuePtr = oldHookPtr;
  299.     return TCL_OK;
  300. }
  301.  
  302. /*
  303.  *-----------------------------------------------------------------------------
  304.  *
  305.  * Tcl_CommandloopCmd --
  306.  *     Implements the TCL commandloop command:
  307.  *       commandloop ?prompt1? ?prompt2?
  308.  *
  309.  * Results:
  310.  *     Standard TCL results.
  311.  *
  312.  *-----------------------------------------------------------------------------
  313.  */
  314. int
  315. Tcl_CommandloopCmd(clientData, interp, argc, argv)
  316.     ClientData  clientData;
  317.     Tcl_Interp *interp;
  318.     int         argc;
  319.     char      **argv;
  320. {
  321.     char *oldTopLevelHook  = NULL;
  322.     char *oldDownLevelHook = NULL;
  323.     int   result = TCL_ERROR;
  324.  
  325.     if (argc > 3) {
  326.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0],
  327.                           " ?prompt1? ?prompt2?", (char *) NULL);
  328.         return TCL_ERROR;
  329.     }
  330.     if (argc > 1) {
  331.         if (SetPromptVar (interp, "tcl_prompt1", argv[1],
  332.                           &oldTopLevelHook) != TCL_OK)
  333.             goto exitPoint;
  334.     }
  335.     if (argc > 2) {
  336.         if (SetPromptVar (interp, "tcl_prompt2", argv[2], 
  337.                           &oldDownLevelHook) != TCL_OK)
  338.             goto exitPoint;
  339.     }
  340.  
  341.     Tcl_CommandLoop (interp, TRUE);
  342.  
  343.     if (oldTopLevelHook != NULL)
  344.         SetPromptVar (interp, "topLevelPromptHook", oldTopLevelHook, NULL);
  345.     if (oldDownLevelHook != NULL)
  346.         SetPromptVar (interp, "downLevelPromptHook", oldDownLevelHook, NULL);
  347.         
  348.     result = TCL_OK;
  349.   exitPoint:
  350.     if (oldTopLevelHook != NULL)
  351.         ckfree (oldTopLevelHook);
  352.     if (oldDownLevelHook != NULL)
  353.         ckfree (oldDownLevelHook);
  354.     return result;
  355. }
  356.