home *** CD-ROM | disk | FTP | other *** search
/ PC Online 1997 August / PCO0897.ISO / filesbbs / os2 / plnk065.arj / PLNK065.ZIP / pilot-link.0.6.5 / pd-tty.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-05-23  |  12.4 KB  |  522 lines
  1. /* pd-tty.c: Text asynchronous input/output support for pilot-debug. 
  2.  *           Currently includes interfaces to STDIO (using plus-patch style
  3.  *           handlers), readline 2.0 (using internal hack to simulate
  4.  *           co-routine), and Tk (using a standard text widget.)
  5.  *
  6.  * This is free software, licensed under the GNU Public License V2.
  7.  * See the file COPYING for details.
  8.  * 
  9.  */
  10.  
  11. void display(char * text, char * tag, int type);
  12. void do_readline(void);
  13.  
  14. #include <stdio.h>
  15. #include <stdlib.h>
  16. #include <unistd.h>
  17. #include <signal.h>
  18. #include <sys/time.h>
  19. #include <sys/types.h>
  20. #include "pi-source.h"
  21. #include "pi-socket.h"
  22. #include "pi-dlp.h"
  23. #include "pi-syspkt.h"
  24.  
  25. #ifdef TK
  26. extern int usetk;
  27. # include "tk.h"
  28. #else
  29. # include "tcl.h"
  30. #endif
  31.  
  32. #ifndef TCL_ACTIVE
  33. # define TCL_ACTIVE TCL_READABLE
  34. #endif
  35.  
  36. extern int Interactive;
  37.  
  38. extern Tcl_Interp * interp;        
  39.  
  40. extern int tty;            /* Non-zero means standard input is a
  41.                  * terminal-like device.  Zero means it's*/
  42.  
  43. #ifdef READLINE_2_0
  44.  
  45. #include <readline/readline.h>
  46. #include <readline/history.h>
  47.  
  48. /* Undocumented readline-2.0 internals */
  49. extern void rl_deprep_terminal(void);
  50. extern int rl_getc(FILE * stream);
  51. extern void rl_gather_tyi(void);
  52.  
  53. static volatile int readable = 0;
  54.  
  55. static Tcl_DString command;
  56.  
  57. void Readable(ClientData d, int mask) { readable = 1; }
  58.  
  59. void Exit(ClientData d) { rl_deprep_terminal(); }
  60.  
  61. static int mode = 0;
  62.  
  63. void do_readline(void)
  64. {
  65.    char buf[20];
  66.    int gotPartial = 0;
  67.    int exitCode = 0;
  68.    Tcl_Channel in = Tcl_GetStdChannel(TCL_STDIN);
  69.    
  70.    Tcl_SetChannelOption(interp, in, "-blocking", "off");
  71.    
  72.    Tcl_CreateChannelHandler(in, TCL_READABLE, Readable, 0);
  73.    
  74.    for(;;) {
  75.       char * line = readline(gotPartial ? "> " : "pilot-debug> ");
  76.       char * cmd;
  77.       int code;
  78.       if (!line)
  79.          break;
  80.       (void) Tcl_DStringAppend(&command, line, -1);
  81.       cmd = Tcl_DStringAppend(&command, "\n", -1);
  82.       
  83.       add_history(line);
  84.       free(line);
  85.       
  86.       if (!Tcl_CommandComplete(cmd)) {
  87.          gotPartial = 1;
  88.       } else {
  89.          gotPartial = 0;
  90.          code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
  91.          
  92.          
  93.          Tcl_DStringFree(&command);
  94.          if (*interp->result != 0) {
  95.             Tcl_Channel chan;
  96.             if (code != TCL_OK) {
  97.                chan = Tcl_GetChannel(interp, "stderr", NULL);
  98.             } else {
  99.                chan = Tcl_GetChannel(interp, "stdout", NULL);
  100.             }
  101.             if (chan) {
  102.                Tcl_Write(chan, interp->result, -1);
  103.                Tcl_Write(chan, "\n", 1);
  104.             }
  105.          }
  106.       }
  107.       Tcl_ResetResult(interp);
  108.    }
  109.    sprintf(buf, "exit %d", exitCode);
  110.    Tcl_Eval(interp, buf);
  111. }
  112.  
  113.  
  114. /* Replace internal readline routine that retrieves a character */
  115. int rl_getc(FILE * stream)
  116. {
  117.    unsigned char c;
  118.    int d;
  119.    
  120.    for(;;) {
  121.       if (!readable)
  122.           Tcl_DoOneEvent(0);
  123.       d = Tcl_Read(Tcl_GetStdChannel(TCL_STDIN), &c, 1);
  124.       readable = 0;
  125.       if (d == 1) {
  126.          if (mode) {
  127.             printf("\n");
  128.             mode = 0;
  129.             rl_forced_update_display();
  130.          }
  131.          return (unsigned int)c;
  132.       }
  133.    }
  134. }
  135.  
  136. /* Replace internal readline routine that gets a character without blocking */
  137. void rl_gather_tyi(void)
  138. {
  139.    unsigned char c;
  140.    int d;
  141.    
  142.    Tcl_DoOneEvent(TCL_DONT_WAIT);
  143.    d = Tcl_Read(Tcl_GetStdChannel(TCL_STDIN), &c, 1);
  144.    if (d == 1) {
  145.       if (mode) {
  146.          printf("\n");
  147.          mode = 0;
  148.          rl_forced_update_display();
  149.       }
  150.       rl_stuff_char(c);
  151.    }
  152.    return;
  153. }
  154. #else
  155.  
  156. static void
  157. StdinProc(ClientData clientData, int mask);
  158.  
  159. static void
  160. Prompt(Tcl_Interp * interp, int partial);
  161.  
  162.  
  163. static Tcl_DString command;    /* Used to buffer incomplete commands being
  164.                  * read from stdin. */
  165. static Tcl_DString line;    /* Used to read the next line from the
  166.                                  * terminal input. */
  167.  
  168. static int gotPartial = 0;
  169.  
  170. static int mode = 0;
  171.  
  172.  
  173. void do_readline(void)
  174. {
  175.     char buf[20];
  176.     int exitCode = 0;
  177.     Tcl_Channel inChannel, outChannel;
  178.  
  179.     /*
  180.      * Process commands from stdin until there's an end-of-file.  Note
  181.      * that we need to fetch the standard channels again after every
  182.      * eval, since they may have been changed.
  183.      */
  184.  
  185.     inChannel = Tcl_GetChannel(interp, "stdin", NULL);
  186.     if (inChannel) {
  187.     Tcl_CreateChannelHandler(inChannel, TCL_READABLE|TCL_ACTIVE,
  188.         StdinProc, (ClientData) inChannel);
  189.     }
  190.     if (tty) {
  191.     Prompt(interp, 0);
  192.     }
  193.     outChannel = Tcl_GetChannel(interp, "stdout", NULL);
  194.     if (outChannel) {
  195.     Tcl_Flush(outChannel);
  196.     }
  197.     Tcl_DStringInit(&command);
  198.     Tcl_CreateExitHandler((Tcl_ExitProc *) Tcl_DStringFree, (ClientData) &command);
  199.     Tcl_DStringInit(&line);
  200.     Tcl_ResetResult(interp);
  201.  
  202.     /*
  203.      * Loop infinitely until all event handlers are passive. Then exit.
  204.      * Rather than calling exit, invoke the "exit" command so that
  205.      * users can replace "exit" with some other command to do additional
  206.      * cleanup on exit.  The Tcl_Eval call should never return.
  207.      */
  208.      
  209.     while (Tcl_DoOneEvent(0)) {
  210.     }
  211.     sprintf(buf, "exit %d", exitCode);
  212.     Tcl_Eval(interp, buf);
  213.     return;
  214. }
  215.  
  216. /*
  217.  *----------------------------------------------------------------------
  218.  *
  219.  * StdinProc --
  220.  *
  221.  *    This procedure is invoked by the event dispatcher whenever
  222.  *    standard input becomes readable.  It grabs the next line of
  223.  *    input characters, adds them to a command being assembled, and
  224.  *    executes the command if it's complete.
  225.  *
  226.  * Results:
  227.  *    None.
  228.  *
  229.  * Side effects:
  230.  *    Could be almost arbitrary, depending on the command that's
  231.  *    typed.
  232.  *
  233.  *----------------------------------------------------------------------
  234.  */
  235.  
  236.  
  237.     /* ARGSUSED */
  238. static void
  239. StdinProc(clientData, mask)
  240.     ClientData clientData;        /* Not used. */
  241.     int mask;                /* Not used. */
  242. {
  243.     char *cmd;
  244.     int code, count;
  245.     Tcl_Channel newchan, chan = (Tcl_Channel) clientData;
  246.  
  247.     count = Tcl_Gets(chan, &line);
  248.  
  249.     if (count < 0) {
  250.     if (!gotPartial) {
  251.         if (tty) {
  252.         Tcl_Exit(0);
  253.         } else {
  254.         Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
  255.         }
  256.         return;
  257.     } else {
  258.         count = 0;
  259.     }
  260.     }
  261.  
  262.     (void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1);
  263.     cmd = Tcl_DStringAppend(&command, "\n", -1);
  264.     Tcl_DStringFree(&line);
  265.     
  266.     if (!Tcl_CommandComplete(cmd)) {
  267.         gotPartial = 1;
  268.         goto prompt;
  269.     }
  270.     gotPartial = 0;
  271.  
  272.     /*
  273.      * Disable the stdin channel handler while evaluating the command;
  274.      * otherwise if the command re-enters the event loop we might
  275.      * process commands from stdin before the current command is
  276.      * finished.  Among other things, this will trash the text of the
  277.      * command being evaluated.
  278.      */
  279.  
  280.     Tcl_CreateChannelHandler(chan, TCL_ACTIVE, StdinProc, (ClientData) chan);
  281.     code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
  282.     newchan = Tcl_GetChannel(interp, "stdin", NULL);
  283.     if (chan != newchan) {
  284.     Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
  285.     }
  286.     if (newchan) {
  287.     Tcl_CreateChannelHandler(newchan, TCL_READABLE | TCL_ACTIVE,
  288.         StdinProc, (ClientData) newchan);
  289.     }
  290.     Tcl_DStringFree(&command);
  291.     if (*interp->result != 0) {
  292.     if (code != TCL_OK) {
  293.         chan = Tcl_GetChannel(interp, "stderr", NULL);
  294.     } else if (tty) {
  295.         chan = Tcl_GetChannel(interp, "stdout", NULL);
  296.     } else {
  297.         chan = NULL;
  298.     }
  299.     if (chan) {
  300.         Tcl_Write(chan, interp->result, -1);
  301.         Tcl_Write(chan, "\n", 1);
  302.     }
  303.     }
  304.  
  305.     /*
  306.      * Output a prompt.
  307.      */
  308.  
  309.     prompt:
  310.     if (tty) {
  311.     Prompt(interp, gotPartial);
  312.     }
  313.     Tcl_ResetResult(interp);
  314. }
  315.  
  316. /*
  317.  *----------------------------------------------------------------------
  318.  *
  319.  * Prompt --
  320.  *
  321.  *    Issue a prompt on standard output, or invoke a script
  322.  *    to issue the prompt.
  323.  *
  324.  * Results:
  325.  *    None.
  326.  *
  327.  * Side effects:
  328.  *    A prompt gets output, and a Tcl script may be evaluated
  329.  *    in interp.
  330.  *
  331.  *----------------------------------------------------------------------
  332.  */
  333.  
  334. static void
  335. Prompt(interp, partial)
  336.     Tcl_Interp *interp;            /* Interpreter to use for prompting. */
  337.     int partial;            /* Non-zero means there already
  338.                      * exists a partial command, so use
  339.                      * the secondary prompt. */
  340. {
  341.     char *promptCmd;
  342.     int code;
  343.     Tcl_Channel outChannel, errChannel;
  344.  
  345.     errChannel = Tcl_GetChannel(interp, "stderr", NULL);
  346.  
  347.     promptCmd = Tcl_GetVar(interp,
  348.     partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
  349.     if (promptCmd == NULL) {
  350.     outChannel = Tcl_GetChannel(interp, "stdout", NULL);
  351. defaultPrompt:
  352.     if (!partial && outChannel) {
  353.             Tcl_Write(outChannel, "% ", 2);
  354.     }
  355.     } else {
  356.     code = Tcl_Eval(interp, promptCmd);
  357.     outChannel = Tcl_GetChannel(interp, "stdout", NULL);
  358.     if (code != TCL_OK) {
  359.         Tcl_AddErrorInfo(interp,
  360.             "\n    (script that generates prompt)");
  361.             /*
  362.              * We must check that errChannel is a real channel - it
  363.              * is possible that someone has transferred stderr out of
  364.              * this interpreter with "interp transfer".
  365.              */
  366.  
  367.         errChannel = Tcl_GetChannel(interp, "stdout", NULL);
  368.             if (errChannel != (Tcl_Channel) NULL) {
  369.                 Tcl_Write(errChannel, interp->result, -1);
  370.                 Tcl_Write(errChannel, "\n", 1);
  371.             }
  372.         goto defaultPrompt;
  373.     } else if (*interp->result && outChannel) {
  374.         Tcl_Write(outChannel, interp->result, strlen(interp->result));
  375.     }
  376.     }
  377.     if (outChannel) {
  378.         Tcl_Flush(outChannel);
  379.     }
  380. }
  381.  
  382.  
  383.  
  384. #endif /*!USE_READLINE_2_0*/
  385.  
  386. void display(char * text, char * tag, int type)
  387. {
  388.    int i;
  389.  
  390. #ifdef TK
  391.    if (usetk) {
  392.       Tcl_DString disp;
  393.       Tcl_DStringInit(&disp);
  394.       if (mode == 0) {          
  395.          Tcl_DStringAppend(&disp,".f.t mark set display {insert linestart};", -1);
  396.          mode = 1;
  397.       }
  398.       Tcl_DStringAppend(&disp, ".f.t insert display",-1);
  399.       Tcl_DStringAppendElement(&disp, text);
  400.       if (tag)
  401.          Tcl_DStringAppendElement(&disp, tag);
  402.       if (strlen(text) && (text[strlen(text)-1] == '\n')) {
  403.          mode = 0;
  404.       }
  405.       if (mode == 0)
  406.          Tcl_DStringAppend(&disp,";.f.t mark unset display", -1);
  407.       /*printf("Exec |%s|\n", Tcl_DStringValue(&disp));*/
  408.       Tcl_Eval(interp,Tcl_DStringValue(&disp));
  409.       /*puts(interp->result);*/
  410.       Tcl_DStringFree(&disp);
  411.       return;
  412.    }
  413. #endif   
  414.    type++;
  415.    
  416.    for (i=0;i<strlen(text);i++) {
  417.       if (mode == 0) {
  418.          /* At prompt */
  419.          /* Dumb hack to erase prompt */
  420.          printf("\r                                               \r");
  421.          mode = -1; /* Beginning of line */
  422.       }
  423.       if (mode != type) {
  424.          if (mode != -1)
  425.             printf("\n"); /* end current line */
  426.          printf("%s", tag);
  427.          mode = type;
  428.       }
  429.       printf("%c", text[i]);
  430.       if (text[i] == '\n') {
  431.         mode = 0; 
  432. #ifdef READLINE_2_0
  433.         rl_forced_update_display(); /* Bring the prompt back */
  434. #else
  435.     Prompt(interp, gotPartial);
  436. #endif        
  437.       }
  438.    }
  439. }
  440.  
  441.  
  442. #if 0
  443. int SayInteractive(char * text)
  444. {
  445.     Tcl_DString d;
  446.     
  447.     if (!Interactive)
  448.       return 0;
  449.     
  450.     Tcl_DStringInit(&d);
  451.  
  452. #ifdef TK
  453.     if (usetk) {
  454.         Tcl_DStringAppendElement(&d, ".f.t");
  455.         Tcl_DStringAppendElement(&d, "insert");
  456.         Tcl_DStringAppendElement(&d, "insert");
  457.         Tcl_DStringAppendElement(&d, text);
  458.         Tcl_Eval(interp, Tcl_DStringValue(&d));
  459.         Tcl_DStringFree(&d);
  460.         Tcl_DStringAppendElement(&d, ".f.t");    
  461.         Tcl_DStringAppendElement(&d, "see");
  462.         Tcl_DStringAppendElement(&d, "insert");
  463.         Tcl_Eval(interp, Tcl_DStringValue(&d));
  464.         Tcl_DStringFree(&d);
  465.     } else {
  466. #endif
  467.         Tcl_DStringAppendElement(&d, "puts");
  468.         Tcl_DStringAppendElement(&d, text);
  469.         Tcl_Eval(interp, Tcl_DStringValue(&d));
  470.         Tcl_DStringFree(&d);
  471.  
  472. #ifdef TK
  473.     }
  474. #endif
  475.     Tcl_Eval(interp, Tcl_DStringValue(&d));
  476.     Tcl_DStringFree(&d);
  477.     
  478.     return 0;
  479. }
  480.  
  481. int Say(char * text)
  482. {
  483.     Tcl_DString d;
  484.     
  485.     if (Interactive) {
  486.         Tcl_DStringInit(&d);
  487. #ifdef TK
  488.         if (usetk) {
  489.             Tcl_DStringAppendElement(&d, ".f.t");
  490.             Tcl_DStringAppendElement(&d, "insert");
  491.             Tcl_DStringAppendElement(&d, "insert");
  492.             Tcl_DStringAppendElement(&d, text);
  493.             Tcl_Eval(interp, Tcl_DStringValue(&d));
  494.             Tcl_DStringFree(&d);
  495.             Tcl_DStringAppendElement(&d, ".f.t");    
  496.             Tcl_DStringAppendElement(&d, "see");
  497.             Tcl_DStringAppendElement(&d, "insert");
  498.             Tcl_Eval(interp, Tcl_DStringValue(&d));
  499.             Tcl_DStringFree(&d);
  500.         } else {
  501. #endif
  502.             Tcl_DStringAppendElement(&d, "puts");
  503.             Tcl_DStringAppendElement(&d, text);
  504.             Tcl_Eval(interp, Tcl_DStringValue(&d));
  505.             Tcl_DStringFree(&d);
  506.  
  507. #ifdef TK
  508.         }
  509. #endif
  510.     } else 
  511.             Tcl_AppendResult(interp, text, NULL);
  512.     
  513.     return 0;
  514. }
  515.  
  516. int Error(char * text)
  517. {
  518.     Tcl_SetResult(interp, text, TCL_STATIC);
  519.     return TCL_ERROR;
  520. }
  521. #endif
  522.