home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / util / edit / jade / src / streams.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-10-04  |  30.5 KB  |  1,345 lines
  1. /* streams.c -- Lisp stream handling
  2.    Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4.    This file is part of Jade.
  5.  
  6.    Jade is free software; you can redistribute it and/or modify it
  7.    under the terms of the GNU General Public License as published by
  8.    the Free Software Foundation; either version 2, or (at your option)
  9.    any later version.
  10.  
  11.    Jade is distributed in the hope that it will be useful, but
  12.    WITHOUT ANY WARRANTY; without even the implied warranty of
  13.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.    GNU General Public License for more details.
  15.  
  16.    You should have received a copy of the GNU General Public License
  17.    along with Jade; see the file COPYING.    If not, write to
  18.    the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* These are the Lisp objects which are classed as streams:
  21.    FILE: [rw]
  22.    MARK: [rw] advance pos attribute of mark afterwards
  23.    BUFFER: [rw] from cursor pos
  24.    (NUMBER . STRING): [r] from the NUMBER'th char of STRING
  25.    (STRING . ACTUAL-LENGTH): [w] to after INDEX
  26.    (BUFFER . POS): [rw] from BUFFER, POS is advanced
  27.    (BUFFER . t): [w] end of BUFFER
  28.    FUNCTION: [rw] call FUNCTION, when reading FUNCTION is expected to
  29.             return the next character, when writing it is called with
  30.             one arg, either character or string.
  31.    PROCESS: [w] write to the stdin of the PROCESS if it's running
  32.    t: [w] display in status line  */
  33.  
  34. #include "jade.h"
  35. #include "jade_protos.h"
  36. #include "regexp/regexp.h"
  37.  
  38. #include <string.h>
  39. #include <fcntl.h>
  40. #include <ctype.h>
  41. #include <stdlib.h>
  42.  
  43. #ifdef NEED_MEMORY_H
  44. # include <memory.h>
  45. #endif
  46.  
  47. _PR int stream_getc(VALUE);
  48. _PR int stream_ungetc(VALUE, int);
  49. _PR int stream_putc(VALUE, int);
  50. _PR int stream_puts(VALUE, u_char *, int, bool);
  51. _PR int stream_read_esc(VALUE, int *);
  52. _PR void stream_put_cntl(VALUE, int);
  53.  
  54. _PR void file_sweep(void);
  55. _PR int file_cmp(VALUE, VALUE);
  56. _PR void file_prin(VALUE, VALUE);
  57.  
  58. _PR void streams_init(void);
  59. _PR void streams_kill(void);
  60.  
  61. static int
  62. pos_getc(TX *tx, POS *pos)
  63. {
  64.     int c = EOF;
  65.     if(pos->pos_Line < tx->tx_NumLines)
  66.     {
  67.     LINE *ln = tx->tx_Lines + pos->pos_Line;
  68.     if(pos->pos_Col >= (ln->ln_Strlen - 1))
  69.     {
  70.         if(++pos->pos_Line == tx->tx_NumLines)
  71.         {
  72.         --pos->pos_Line;
  73.         return(EOF);
  74.         }
  75.         pos->pos_Col = 0;
  76.         return('\n');
  77.     }
  78.     c = ln->ln_Line[pos->pos_Col++];
  79.     }
  80.     return(c);
  81. }
  82.  
  83. static int
  84. pos_putc(TX *tx, POS *pos, int c)
  85. {
  86.     int rc = EOF;
  87.     if(!read_only(tx) && pad_pos(tx, pos))
  88.     {
  89.     u_char tmps[2];
  90.     tmps[0] = (u_char)c;
  91.     tmps[1] = 0;
  92.     if(iscntrl(c))
  93.     {
  94.         if(insert_string(tx, tmps, 1, pos))
  95.         rc = 1;
  96.     }
  97.     else
  98.     {
  99.         POS start = *pos;
  100.         if(insert_str_n(tx, tmps, 1, pos))
  101.         {
  102.         undo_record_insertion(tx, &start, pos);
  103.         flag_insertion(tx, &start, pos);
  104.         rc = 1;
  105.         }
  106.     }
  107.     }
  108.     return(rc);
  109. }
  110.  
  111. static int
  112. pos_puts(TX *tx, POS *pos, u_char *buf, int bufLen)
  113. {
  114.     int rc = EOF;
  115.     if(!read_only(tx) && pad_pos(tx, pos))
  116.     {
  117.     if(insert_string(tx, buf, bufLen, pos))
  118.         rc = bufLen;
  119.     }
  120.     return(rc);
  121. }
  122.  
  123. int
  124. stream_getc(VALUE stream)
  125. {
  126.     int c = EOF;
  127.     if(NILP(stream)
  128.        && !(stream = cmd_symbol_value(sym_standard_input, sym_nil)))
  129.     return(c);
  130.     switch(VTYPE(stream))
  131.     {
  132.     VALUE res;
  133.     int oldgci;
  134.  
  135.     case V_File:
  136.     if(VFILE(stream)->lf_Name)
  137.         c = getc(VFILE(stream)->lf_File);
  138.     break;
  139.  
  140.     case V_Mark:
  141.     if(!VMARK(stream)->mk_Resident)
  142.         cmd_signal(sym_invalid_stream, list_2(stream, MKSTR("Marks used as streams must be resident")));
  143.     else
  144.         c = pos_getc(VMARK(stream)->mk_File.tx,
  145.              &VPOS(VMARK(stream)->mk_Pos));
  146.     break;
  147.  
  148.     case V_TX:
  149.     c = pos_getc(VTX(stream), get_tx_cursor(VTX(stream)));
  150.     break;
  151.  
  152.     case V_Cons:
  153.     res = VCAR(stream);
  154.     if(NUMBERP(res) && STRINGP(VCDR(stream)))
  155.     {
  156.         c = (int)VSTR(VCDR(stream))[VNUM(res)];
  157.         if(c)
  158.         VCAR(stream) = make_number(VNUM(res) + 1);
  159.         else
  160.         c = EOF;
  161.         break;
  162.     }
  163.     else if(BUFFERP(res) && POSP(VCDR(stream)))
  164.     {
  165.         c = pos_getc(VTX(res), &VPOS(VCDR(stream)));
  166.         break;
  167.     }
  168.     else if(res != sym_lambda)
  169.     {
  170.         cmd_signal(sym_invalid_stream, LIST_1(stream));
  171.         break;
  172.     }
  173.     /* FALL THROUGH */
  174.  
  175.     case V_Symbol:
  176.     oldgci = gc_inhibit;
  177.     gc_inhibit = TRUE;
  178.     if((res = call_lisp0(stream)) && NUMBERP(res))
  179.         c = VNUM(res);
  180.     gc_inhibit = oldgci;
  181.     break;
  182.  
  183. #ifdef HAVE_SUBPROCESSES
  184.     case V_Process:
  185.     cmd_signal(sym_invalid_stream, list_2(stream, MKSTR("Processes are not input streams")));
  186.     break;
  187. #endif
  188.  
  189.     default:
  190.     cmd_signal(sym_invalid_stream, LIST_1(stream));
  191.     }
  192.     return(c);
  193. }
  194.  
  195. /* Puts back one character, it will be read next call to streamgetc on
  196.    this stream.
  197.    Note that some types of stream don't actually use c, they just rewind
  198.    pointers.
  199.    Never call this unless you *have* *successfully* read from the stream
  200.    previously. (few checks are performed here, I assume they were made in
  201.    streamgetc()).  */
  202. #define POS_UNGETC(p,tx) \
  203.     if(--((p)->pos_Col) < 0) \
  204.     { \
  205.     (p)->pos_Line--; \
  206.     (p)->pos_Col = (tx)->tx_Lines[(p)->pos_Line].ln_Strlen - 1; \
  207.     }
  208. int
  209. stream_ungetc(VALUE stream, int c)
  210. {
  211.     int rc = FALSE;
  212.     if(NILP(stream)
  213.        && !(stream = cmd_symbol_value(sym_standard_input, sym_nil)))
  214.     return(rc);
  215.     switch(VTYPE(stream))
  216.     {
  217.     POS *pos;
  218.     VALUE tmp;
  219.     int oldgci;
  220.  
  221.     case V_File:
  222.     if(ungetc(c, VFILE(stream)->lf_File) != EOF)
  223.         rc = TRUE;
  224.     break;
  225.  
  226.     case V_Mark:
  227.     pos = &VPOS(VMARK(stream)->mk_Pos);
  228.     POS_UNGETC(pos, VMARK(stream)->mk_File.tx)
  229.     rc = TRUE;
  230.     break;
  231.  
  232.     case V_TX:
  233.     pos = get_tx_cursor(VTX(stream));
  234.     POS_UNGETC(pos, VTX(stream))
  235.     rc = TRUE;
  236.     break;
  237.  
  238.     case V_Cons:
  239.     tmp = VCAR(stream);
  240.     if(NUMBERP(tmp) && STRINGP(VCDR(stream)))
  241.     {
  242.         VCAR(stream) = make_number(VNUM(tmp) - 1);
  243.         rc = TRUE;
  244.         break;
  245.     }
  246.     else if(BUFFERP(tmp) && POSP(VCDR(stream)))
  247.     {
  248.         POS_UNGETC(&VPOS(VCDR(stream)), VTX(tmp));
  249.         rc = TRUE;
  250.         break;
  251.     }
  252.     /* FALL THROUGH */
  253.  
  254.     case V_Symbol:
  255.     tmp = make_number(c);
  256.     oldgci = gc_inhibit;
  257.     gc_inhibit = TRUE;
  258.     if((tmp = call_lisp1(stream, tmp)) && !NILP(tmp))
  259.         rc = TRUE;
  260.     gc_inhibit = oldgci;
  261.     break;
  262.     }
  263.     return(rc);
  264. }
  265.  
  266. int
  267. stream_putc(VALUE stream, int c)
  268. {
  269.     int rc = 0;
  270.     if(NILP(stream)
  271.        && !(stream = cmd_symbol_value(sym_standard_output, sym_nil)))
  272.     return(rc);
  273.     switch(VTYPE(stream))
  274.     {
  275.     VALUE args, res, new;
  276.     int len;
  277.     u_char tmps[2];
  278.     POS pos;
  279.  
  280.     case V_File:
  281.     if(VFILE(stream)->lf_Name)
  282.     {
  283.         if(putc(c, VFILE(stream)->lf_File) != EOF)
  284.         rc = 1;
  285.     }
  286.     break;
  287.  
  288.     case V_Mark:
  289.     if(!VMARK(stream)->mk_Resident)
  290.         cmd_signal(sym_invalid_stream, list_2(stream, MKSTR("Marks used as streams must be resident")));
  291.     else
  292.     {
  293.         pos = VPOS(VMARK(stream)->mk_Pos);
  294.         rc = pos_putc(VMARK(stream)->mk_File.tx, &pos, c);
  295.     }
  296.     break;
  297.  
  298.     case V_TX:
  299.     pos = *(get_tx_cursor(VTX(stream)));
  300.     rc = pos_putc(VTX(stream), &pos, c);
  301.     break;
  302.  
  303.     case V_Cons:
  304.     args = VCAR(stream);
  305.     if(VTYPEP(args, V_DynamicString) && NUMBERP(VCDR(stream)))
  306.     {
  307.         int actuallen = VNUM(VCDR(stream));
  308.         len = STRING_LEN(args);
  309.         if(len + 1 >= actuallen)
  310.         {
  311.         int newlen = actuallen < 16 ? 32 : actuallen * 2;
  312.         new = make_string(newlen + 1);
  313.         if(!new)
  314.             break;
  315.         memcpy(VSTR(new), VSTR(args), len);
  316.         VCAR(stream) = new;
  317.         VCDR(stream) = make_number(newlen);
  318.         args = new;
  319.         }
  320.         VSTR(args)[len] = (u_char)c;
  321.         VSTR(args)[len+1] = 0;
  322.         set_string_len(args, len + 1);
  323.         rc = 1;
  324.         break;
  325.     }
  326.     else if(BUFFERP(args))
  327.     {
  328.         if(POSP(VCDR(stream)))
  329.         rc = pos_putc(VTX(args), &VPOS(VCDR(stream)), c);
  330.         else
  331.         {
  332.         pos.pos_Line = VTX(args)->tx_NumLines - 1;
  333.         pos.pos_Col = VTX(args)->tx_Lines[pos.pos_Line].ln_Strlen - 1;
  334.         rc = pos_putc(VTX(args), &pos, c);
  335.         }
  336.         break;
  337.     }
  338.     else if(args != sym_lambda)
  339.     {
  340.         cmd_signal(sym_invalid_stream, LIST_1(stream));
  341.         break;
  342.     }
  343.     /* FALL THROUGH */
  344.  
  345.     case V_Symbol:
  346.     if(stream == sym_t)
  347.     {
  348.         if(curr_vw->vw_Flags & VWFF_MESSAGE)
  349.         {
  350.         VW *vw = curr_vw;
  351.         u_char *s;
  352.         s = str_dupn(vw->vw_Message, vw->vw_MessageLen + 1);
  353.         if(s)
  354.         {
  355.             s[vw->vw_MessageLen++] = c;
  356.             s[vw->vw_MessageLen] = 0;
  357.             str_free(vw->vw_Message);
  358.             vw->vw_Message = s;
  359.             vw->vw_Flags |= VWFF_MESSAGE | VWFF_REFRESH_STATUS;
  360.         }
  361.         }
  362.         else
  363.         {
  364.         tmps[0] = (u_char)c;
  365.         tmps[1] = 0;
  366.         messagen(tmps, 1);
  367.         }
  368.         rc = 1;
  369.     }
  370.     else
  371.     {
  372.         int oldgci = gc_inhibit;
  373.         gc_inhibit = TRUE;
  374.         if((res = call_lisp1(stream, make_number(c))) && !NILP(res))
  375.         rc = 1;
  376.         gc_inhibit = oldgci;
  377.     }
  378.     break;
  379.  
  380. #ifdef HAVE_SUBPROCESSES
  381.     case V_Process:
  382.     tmps[0] = (u_char)c;
  383.     tmps[1] = 0;
  384.     rc = write_to_process(stream, tmps, 1);
  385.     break;
  386. #endif
  387.  
  388.     default:
  389.     cmd_signal(sym_invalid_stream, LIST_1(stream));
  390.     }
  391.     return(rc);
  392. }
  393.  
  394. int
  395. stream_puts(VALUE stream, u_char *buf, int bufLen, bool isValString)
  396. {
  397.     int rc = 0;
  398.     if(NILP(stream)
  399.        && !(stream = cmd_symbol_value(sym_standard_output, sym_nil)))
  400.     return(rc);
  401.     if(bufLen == -1)
  402.     bufLen = isValString ? STRING_LEN(VAL(STRING_HDR(buf))) : strlen(buf);
  403.     switch(VTYPE(stream))
  404.     {
  405.     VALUE args, res, new;
  406.     int len, newlen;
  407.     POS pos;
  408.  
  409.     case V_File:
  410.     if(VFILE(stream)->lf_Name)
  411.     {
  412.         if((rc = fwrite(buf, 1, bufLen, VFILE(stream)->lf_File)) == bufLen)
  413.         rc = bufLen;
  414.     }
  415.     break;
  416.  
  417.     case V_Mark:
  418.     if(!VMARK(stream)->mk_Resident)
  419.         cmd_signal(sym_invalid_stream, list_2(stream, MKSTR("Marks used as streams must be resident")));
  420.     else
  421.     {
  422.         pos = VPOS(VMARK(stream)->mk_Pos);
  423.         rc = pos_puts(VMARK(stream)->mk_File.tx, &pos, buf, bufLen);
  424.     }
  425.     break;
  426.  
  427.     case V_TX:
  428.     pos = *(get_tx_cursor(VTX(stream)));
  429.     rc = pos_puts(VTX(stream), &pos, buf, bufLen);
  430.     break;
  431.  
  432.     case V_Cons:
  433.     args = VCAR(stream);
  434.     if(VTYPEP(args, V_DynamicString) && NUMBERP(VCDR(stream)))
  435.     {
  436.         int actuallen = VNUM(VCDR(stream));
  437.         len = STRING_LEN(args);
  438.         newlen = len + bufLen + 1;
  439.         if(actuallen <= newlen)
  440.         {
  441.         register int tmp = actuallen < 16 ? 32 : actuallen * 2;
  442.         if(tmp > newlen)
  443.             newlen = tmp;
  444.         new = make_string(newlen + 1);
  445.         if(!new)
  446.             break;
  447.         memcpy(VSTR(new), VSTR(args), len);
  448.         VCAR(stream) = new;
  449.         VCDR(stream) = make_number(newlen);
  450.         args = new;
  451.         }
  452. #if 1
  453.         memcpy(VSTR(args) + len, buf, bufLen);
  454.         VSTR(args)[len + bufLen] = 0;
  455. #else
  456.         strcpy(VSTR(args) + len, buf);
  457. #endif
  458.         set_string_len(args, len + bufLen);
  459.         rc = bufLen;
  460.         break;
  461.     }
  462.     else if(BUFFERP(args))
  463.     {
  464.         if(POSP(VCDR(stream)))
  465.         rc = pos_puts(VTX(args), &VPOS(VCDR(stream)), buf, bufLen);
  466.         else
  467.         {
  468.         pos.pos_Line = VTX(args)->tx_NumLines - 1;
  469.         pos.pos_Col = VTX(args)->tx_Lines[pos.pos_Line].ln_Strlen - 1;
  470.         rc = pos_puts(VTX(args), &pos, buf, bufLen);
  471.         }
  472.         break;
  473.     }
  474.     else if(args != sym_lambda)
  475.     {
  476.         cmd_signal(sym_invalid_stream, LIST_1(stream));
  477.         break;
  478.     }
  479.     /* FALL THROUGH */
  480.  
  481.     case V_Symbol:
  482.     if(stream == sym_t)
  483.     {
  484.         if(curr_vw->vw_Flags & VWFF_MESSAGE)
  485.         {
  486.         VW *vw = curr_vw;
  487.         u_char *s;
  488.         newlen = vw->vw_MessageLen + bufLen;
  489.         s = str_dupn(vw->vw_Message, newlen);
  490.         if(s)
  491.         {
  492.             memcpy(s + vw->vw_MessageLen, buf, bufLen);
  493.             s[newlen] = 0;
  494.             str_free(vw->vw_Message);
  495.             vw->vw_Message = s;
  496.             vw->vw_MessageLen = newlen;
  497.             vw->vw_Flags |= VWFF_MESSAGE | VWFF_REFRESH_STATUS;
  498.         }
  499.         }
  500.         else
  501.         messagen(buf, bufLen);
  502.         rc = bufLen;
  503.     }
  504.     else
  505.     {
  506.         int oldgci = gc_inhibit;
  507.         if(isValString)
  508.         args = VAL(STRING_HDR(buf));
  509.         else
  510.         args = string_dupn(buf, bufLen);
  511.         gc_inhibit = TRUE;
  512.         if((res = call_lisp1(stream, args)) && !NILP(res))
  513.         {
  514.         if(NUMBERP(res))
  515.             rc = VNUM(res);
  516.         else
  517.             rc = bufLen;
  518.         }
  519.         gc_inhibit = oldgci;
  520.     }
  521.     break;
  522.  
  523. #ifdef HAVE_SUBPROCESSES
  524.     case V_Process:
  525.     rc = write_to_process(stream, buf, bufLen);
  526.     break;
  527. #endif
  528.  
  529.     default:
  530.     cmd_signal(sym_invalid_stream, LIST_1(stream));
  531.     }
  532.     return(rc);
  533. }
  534.  
  535. /* Read an escape sequence from STREAM. C_P should contain the first
  536.    character of the escape *not* the escape character. Supported sequences
  537.    are,
  538.      n   newline
  539.      r   carriage return
  540.      f   form feed
  541.      t   horizontal tab
  542.      v   vertical tab
  543.      a   bell
  544.      ^C  control code of C
  545.      012 octal character code
  546.      x12 hex character code
  547.    Otherwise the character is returned as-is.  */
  548. int
  549. stream_read_esc(VALUE stream, int *c_p)
  550. {
  551.     u_char c;
  552.     switch(*c_p)
  553.     {
  554.     case 'n':
  555.     c = '\n';
  556.     break;
  557.     case 'r':
  558.     c = '\r';
  559.     break;
  560.     case 'f':
  561.     c = '\f';
  562.     break;
  563.     case 't':
  564.     c = '\t';
  565.     break;
  566.     case 'v':
  567.     c = '\v';
  568.     break;
  569.     case 'a':
  570.     c = '\a';
  571.     break;
  572.     case '^':
  573.     c = toupper(stream_getc(stream)) ^ 0x40;
  574.     break;
  575.     case '0':
  576.     case '1':
  577.     case '2':
  578.     case '3':
  579.     case '4':
  580.     case '5':
  581.     case '6':
  582.     case '7':
  583.     c = *c_p - '0';
  584.     *c_p = stream_getc(stream);
  585.     if((*c_p >= '0') && (*c_p <= '7'))
  586.     {
  587.         c = (c * 8) + (*c_p - '0');
  588.         *c_p = stream_getc(stream);
  589.         if((*c_p >= '0') && (*c_p <= '7'))
  590.         {
  591.         c = (c * 8) + (*c_p - '0');
  592.         break;
  593.         }
  594.         else
  595.         return(c);
  596.     }
  597.     else
  598.         return(c);
  599.     case 'x':
  600.     c = 0;
  601.     while(1)
  602.     {
  603.         *c_p = stream_getc(stream);
  604.         if(!isxdigit(*c_p))
  605.         return(c);
  606.         if((*c_p >= '0') && (*c_p <= '9'))
  607.         c = (c * 16) + (*c_p - '0');
  608.         else
  609.         c = (c * 16) + (toupper(*c_p) - 'A') + 10;
  610.     }
  611.     default:
  612.     c = *c_p;
  613.     }
  614.     *c_p = stream_getc(stream);
  615.     return(c);
  616. }
  617.  
  618. /* Print an escape sequence for the character C to STREAM. */
  619. void
  620. stream_put_cntl(VALUE stream, int c)
  621. {
  622.     u_char buff[40];
  623.     u_char *buf = buff + 1;
  624.     buff[0] = V_StaticString;
  625.     switch(c)
  626.     {
  627.     case '\n':
  628.     strcpy(buf, "\\n");
  629.     break;
  630.     case '\t':
  631.     strcpy(buf, "\\t");
  632.     break;
  633.     case '\r':
  634.     strcpy(buf, "\\r");
  635.     break;
  636.     case '\f':
  637.     strcpy(buf, "\\f");
  638.     break;
  639.     case '\a':
  640.     strcpy(buf, "\\a");
  641.     break;
  642.     default:
  643.     if(c <= 0x3f)
  644.         sprintf(buf, "\\^%c", c + 0x40);
  645.     else
  646.         sprintf(buf, "\\%o", (int)c);
  647.     break;
  648.     }
  649.     stream_puts(stream, buf, -1, TRUE);
  650. }
  651.  
  652. _PR VALUE cmd_write(VALUE stream, VALUE data, VALUE len);
  653. DEFUN("write", cmd_write, subr_write, (VALUE stream, VALUE data, VALUE len), V_Subr3, DOC_write) /*
  654. ::doc:write::
  655. write STREAM DATA [LENGTH]
  656.  
  657. Writes DATA, which can either be a string or a character, to the stream
  658. STREAM, returning the number of characters actually written. If DATA is
  659. a string LENGTH can define how many characters to write.
  660. ::end:: */
  661. {
  662.     int actual;
  663.     switch(VTYPE(data))
  664.     {
  665.     bool vstring;
  666.     case V_Number:
  667.     actual = stream_putc(stream, VNUM(data));
  668.     break;
  669.     case V_StaticString:
  670.     case V_DynamicString:
  671.     if(NUMBERP(len))
  672.     {
  673.         actual = VNUM(len);
  674.         if(actual > STRING_LEN(data))
  675.         return(signal_arg_error(len, 3));
  676.         if(actual == STRING_LEN(data))
  677.         vstring = TRUE;
  678.         else
  679.         vstring = FALSE;
  680.     }
  681.     else
  682.     {
  683.         actual = STRING_LEN(data);
  684.         vstring = TRUE;
  685.     }
  686.     actual = stream_puts(stream, VSTR(data), actual, vstring);
  687.     break;
  688.     default:
  689.     return(signal_arg_error(data, 2));
  690.     }
  691.     return(make_number(actual));
  692. }
  693.  
  694. _PR VALUE cmd_read_char(VALUE stream);
  695. DEFUN("read-char", cmd_read_char, subr_read_char, (VALUE stream), V_Subr1, DOC_read_char) /*
  696. ::doc:read_char::
  697. read-char STREAM
  698.  
  699. Reads the next character from the input-stream STREAM, if no more characters
  700. are available returns nil.
  701. ::end:: */
  702. {
  703.     int rc;
  704.     if((rc = stream_getc(stream)) != EOF)
  705.     return(make_number(rc));
  706.     return(sym_nil);
  707. }
  708.  
  709. _PR VALUE cmd_read_line(VALUE stream);
  710. DEFUN("read-line", cmd_read_line, subr_read_line, (VALUE stream), V_Subr1, DOC_read_line) /*
  711. ::doc:read_line::
  712. read-line STREAM
  713.  
  714. Read one line of text from STREAM.
  715. ::end:: */
  716. {
  717.     u_char buf[400];
  718.     if(FILEP(stream))
  719.     {
  720.     /* Special case for file streams. We can read a line in one go.     */
  721.     if(VFILE(stream)->lf_Name && fgets(buf, 400, VFILE(stream)->lf_File))
  722.         return(string_dup(buf));
  723.     return(sym_nil);
  724.     }
  725.     else
  726.     {
  727.     u_char *bufp = buf;
  728.     int len = 0, c;
  729.     while((c = stream_getc(stream)) != EOF)
  730.     {
  731.         *bufp++ = (u_char)c;
  732.         if((++len >= 399) || (c == '\n'))
  733.         break;
  734.     }
  735.     if(len == 0)
  736.         return(sym_nil);
  737.     return(string_dupn(buf, len));
  738.     }
  739. }
  740.  
  741. _PR VALUE cmd_copy_stream(VALUE source, VALUE dest);
  742. DEFUN("copy-stream", cmd_copy_stream, subr_copy_stream, (VALUE source, VALUE dest), V_Subr2, DOC_copy_stream) /*
  743. ::doc:copy_stream::
  744. copy-stream SOURCE-STREAM DEST-STREAM
  745.  
  746. Copy all characters from SOURCE-STREAM to DEST-STREAM until an EOF is read.
  747. ::end:: */
  748. {
  749.     int len = 0, i = 0, c;
  750.     u_char buff[402];
  751.     u_char *buf = buff + 1;
  752.     buff[0] = V_StaticString;
  753.     while((c = stream_getc(source)) != EOF)
  754.     {
  755.     if(i == 400)
  756.     {
  757.         buf[i] = 0;
  758.         if(stream_puts(dest, buf, i, TRUE) == EOF)
  759.         break;
  760.         i = 0;
  761.     }
  762.     else
  763.         buf[i++] = c;
  764.     len++;
  765.     TEST_INT;
  766.     if(INT_P)
  767.         return(NULL);
  768.     }
  769.     if(i > 0)
  770.     {
  771.     buff[i] = 0;
  772.     stream_puts(dest, buf, i, TRUE);
  773.     }
  774.     if(len)
  775.     return(make_number(len));
  776.     return(sym_nil);
  777. }
  778.  
  779. _PR VALUE cmd_read(VALUE);
  780. DEFUN("read", cmd_read, subr_read, (VALUE stream), V_Subr1, DOC_read) /*
  781. ::doc:read::
  782. read [STREAM]
  783.  
  784. Reads one lisp-object from the input-stream STREAM (or the value of the
  785. variable `standard-input' if STREAM is unspecified) and return it.
  786. ::end:: */
  787. {
  788.     VALUE res;
  789.     int c;
  790.     if(NILP(stream)
  791.        && !(stream = cmd_symbol_value(sym_standard_input, sym_nil)))
  792.     {
  793.     signal_arg_error(stream, 1);
  794.     return(NULL);
  795.     }
  796.     c = stream_getc(stream);
  797.     if(c == EOF)
  798.     res = cmd_signal(sym_end_of_stream, LIST_1(stream));
  799.     else
  800.     res = readl(stream, &c);
  801.     /* If an error occurred leave stream where it is.  */
  802.     if(res && c != EOF)
  803.     stream_ungetc(stream, c);
  804.     return(res);
  805. }
  806.  
  807. _PR VALUE cmd_print(VALUE, VALUE);
  808. DEFUN("print", cmd_print, subr_print, (VALUE obj, VALUE stream), V_Subr2, DOC_print) /*
  809. ::doc:print::
  810. print OBJECT [STREAM]
  811.  
  812. First outputs a newline, then prints a text representation of OBJECT to
  813. STREAM (or the contents of the variable `standard-output') in a form suitable
  814. for `read'.
  815. ::end:: */
  816. {
  817.     if(NILP(stream)
  818.        && !(stream = cmd_symbol_value(sym_standard_output, sym_nil)))
  819.     {
  820.     signal_arg_error(stream, 1);
  821.     return(NULL);
  822.     }
  823.     stream_putc(stream, '\n');
  824.     print_val(stream, obj);
  825.     return(obj);
  826. }
  827.  
  828. _PR VALUE cmd_prin1(VALUE, VALUE);
  829. DEFUN("prin1", cmd_prin1, subr_prin1, (VALUE obj, VALUE stream), V_Subr2, DOC_prin1) /*
  830. ::doc:prin1::
  831. prin1 OBJECT [STREAM]
  832.  
  833. Prints a text representation of OBJECT to STREAM (or the contents of the
  834. variable `standard-output') in a form suitable for `read'.
  835. ::end:: */
  836. {
  837.     if(NILP(stream)
  838.        && !(stream = cmd_symbol_value(sym_standard_output, sym_nil)))
  839.     {
  840.     signal_arg_error(stream, 1);
  841.     return(NULL);
  842.     }
  843.     print_val(stream, obj);
  844.     return(obj);
  845. }
  846.  
  847. _PR VALUE cmd_princ(VALUE, VALUE);
  848. DEFUN("princ", cmd_princ, subr_princ, (VALUE obj, VALUE stream), V_Subr2, DOC_princ) /*
  849. ::doc:princ::
  850. princ OBJECT [STREAM]
  851.  
  852. Prints a text representation of OBJECT to STREAM (or the contents of the
  853. variable standard-output), no strange characters are quoted and no quotes
  854. are printed around strings.
  855. ::end:: */
  856. {
  857.     if(NILP(stream)
  858.        && !(stream = cmd_symbol_value(sym_standard_output, sym_nil)))
  859.     {
  860.     signal_arg_error(stream, 1);
  861.     return(NULL);
  862.     }
  863.     princ_val(stream, obj);
  864.     return(obj);
  865. }
  866.  
  867. _PR VALUE cmd_format(VALUE);
  868. DEFUN("format", cmd_format, subr_format, (VALUE args), V_SubrN, DOC_format) /*
  869. ::doc:format::
  870. format STREAM FORMAT-STRING ARGS...
  871.  
  872. Writes a string created from the format specification FORMAT-STRING and
  873. the argument-values ARGS to the stream, STREAM. If STREAM is nil a string
  874. is created and returned.
  875.  
  876. FORMAT-STRING is a template for the result, any `%' characters introduce
  877. a substitution, using the next unused ARG. These format specifiers are
  878. implemented:
  879.    d      print next ARG as decimal integer
  880.    x      print next ARG as hexadecimal integer
  881.    o      print next ARG in octal
  882.    c      print next ARG as ASCII character
  883.    s      unquoted representation (as from `princ') of next ARG
  884.    S      normal print'ed representation of next ARG
  885.    %      literal percentage character
  886. ::end:: */
  887. {
  888.     u_char *fmt, *last_fmt;
  889.     bool mk_str;
  890.     VALUE stream = ARG2;
  891.     u_char c;
  892.     DECLARE1(stream, STRINGP);
  893.     fmt = VSTR(stream);
  894.     stream = ARG1;
  895.     if(NILP(stream))
  896.     {
  897.     stream = cmd_cons(string_dupn("", 0), make_number(0));
  898.     mk_str = TRUE;
  899.     }
  900.     else
  901.     mk_str = FALSE;
  902.     args = move_down_list(args, 2);
  903.     last_fmt = fmt;
  904.     while((c = *fmt++))
  905.     {
  906.     if(c == '%')
  907.     {
  908.         u_char tbuf[40], nfmt[4];
  909.         VALUE val = ARG1;
  910.         if(last_fmt != fmt - 1)
  911.         stream_puts(stream, last_fmt, fmt - last_fmt - 1, FALSE);
  912.         switch(c = *fmt++)
  913.         {
  914.         case 'd':
  915.         case 'x':
  916.         case 'o':
  917.         case 'c':
  918.         nfmt[0] = '%';
  919.         nfmt[1] = 'l';
  920.         nfmt[2] = c;
  921.         nfmt[3] = 0;
  922.         sprintf(tbuf, nfmt, NUMBERP(val) ? VNUM(val) : (long)val);
  923.         stream_puts(stream, tbuf, -1, FALSE);
  924.         break;
  925.         case 's':
  926.         princ_val(stream, val);
  927.         break;
  928.         case 'S':
  929.         print_val(stream, val);
  930.         break;
  931.         case '%':
  932.         stream_putc(stream, '%');
  933.         break;
  934.         }
  935.         if(c != '%')
  936.         args = move_down_list(args, 1);
  937.         last_fmt = fmt;
  938.     }
  939.     }
  940.     if(last_fmt != fmt - 1)
  941.     stream_puts(stream, last_fmt, fmt - last_fmt - 1, FALSE);
  942.     if(mk_str)
  943.     {
  944.     if(STRING_LEN(VCAR(stream)) != VNUM(VCDR(stream)))
  945.     {
  946.         /* Truncate the stream to it's actual length. */
  947.         stream = cmd_copy_sequence(VCAR(stream));
  948.     }
  949.     else
  950.         stream = VCAR(stream);
  951.     }
  952.     return(stream);
  953. }
  954.  
  955. _PR VALUE cmd_make_string_input_stream(VALUE string, VALUE start);
  956. DEFUN("make-string-input-stream", cmd_make_string_input_stream, subr_make_string_input_stream, (VALUE string, VALUE start), V_Subr2, DOC_make_string_input_stream) /*
  957. ::doc:make_string_input_stream::
  958. make-string-input-stream STRING [START]
  959.  
  960. Returns a input stream, it will supply, in order, the characters in STRING,
  961. starting from START (or the beginning of the string).
  962. ::end:: */
  963. {
  964.     DECLARE1(string, STRINGP);
  965.     return(cmd_cons(NUMBERP(start) ? start : make_number(0), string));
  966. }
  967.  
  968. _PR VALUE cmd_make_string_output_stream(void);
  969. DEFUN("make-string-output-stream", cmd_make_string_output_stream, subr_make_string_output_stream, (void), V_Subr0, DOC_make_string_output_stream) /*
  970. ::doc:make_string_output_stream::
  971. make-string-output-stream
  972.  
  973. Returns an output stream which will accumulate the characters written to
  974. it for the use of the `get-output-stream-string' function.
  975. ::end:: */
  976. {
  977.     return(cmd_cons(string_dupn("", 0), make_number(0)));
  978. }
  979.  
  980. _PR VALUE cmd_get_output_stream_string(VALUE strm);
  981. DEFUN("get-output-stream-string", cmd_get_output_stream_string, subr_get_output_stream_string, (VALUE strm), V_Subr1, DOC_get_output_stream_string) /*
  982. ::doc:get_output_stream_string::
  983. get-output-stream-string STRING-OUTPUT-STREAM
  984.  
  985. Returns a string containing the characters written to the stream STRING-
  986. OUTPUT-STREAM (created by `make-string-output-stream'). The stream is then
  987. reset so that the next call to this function with this stream will only
  988. return the new characters.
  989. ::end:: */
  990. {
  991.     VALUE string;
  992.     if(!CONSP(strm) || !STRINGP(VCAR(strm)) || !NUMBERP(VCDR(strm)))
  993.     return(signal_arg_error(strm, 1));
  994.     if(STRING_LEN(VCAR(strm)) != VNUM(VCDR(strm)))
  995.     {
  996.     /* Truncate the string to it's actual length. */
  997.     string = cmd_copy_sequence(VCAR(strm));
  998.     }
  999.     else
  1000.     string = VCAR(strm);
  1001.     /* Reset the stream. */
  1002.     VCAR(strm) = string_dupn("", 0);
  1003.     VCDR(strm) = make_number(0);
  1004.     return(string);
  1005. }
  1006.  
  1007. _PR VALUE cmd_streamp(VALUE arg);
  1008. DEFUN("streamp", cmd_streamp, subr_streamp, (VALUE arg), V_Subr1, DOC_streamp) /*
  1009. ::doc:streamp::
  1010. streamp ARG
  1011.  
  1012. Returns t if ARG is a stream.
  1013. ::end:: */
  1014. {
  1015.     VALUE res = sym_nil;
  1016.     switch(VTYPE(arg))
  1017.     {
  1018.     VALUE car, cdr;
  1019.     case V_File:
  1020.     case V_Buffer:
  1021.     case V_Mark:
  1022.     case V_Process:
  1023.     case V_Symbol:
  1024.     res = sym_t;
  1025.     break;
  1026.     case V_Cons:
  1027.     car = VCAR(arg);
  1028.     cdr = VCDR(arg);
  1029.     if((car == sym_lambda)
  1030.        || (BUFFERP(car) && (POSP(cdr) || (cdr == sym_t)))
  1031.        || (NUMBERP(car) && STRINGP(cdr))
  1032.        || (STRINGP(car) && NUMBERP(cdr)))
  1033.         res = sym_t;
  1034.     break;
  1035.     }
  1036.     return(res);
  1037. }
  1038.  
  1039. static LFile *lfile_chain;
  1040.  
  1041. void
  1042. file_sweep(void)
  1043. {
  1044.     LFile *lf = lfile_chain;
  1045.     lfile_chain = NULL;
  1046.     while(lf)
  1047.     {
  1048.     LFile *nxt = lf->lf_Next;
  1049.     if(!GC_MARKEDP(VAL(lf)))
  1050.     {
  1051.         if(lf->lf_Name && !(lf->lf_Flags & LFF_DONT_CLOSE))
  1052.         fclose(lf->lf_File);
  1053.         str_free(lf);
  1054.     }
  1055.     else
  1056.     {
  1057.         GC_CLR(VAL(lf));
  1058.         lf->lf_Next = lfile_chain;
  1059.         lfile_chain = lf;
  1060.     }
  1061.     lf = nxt;
  1062.     }
  1063. }
  1064.  
  1065. int
  1066. file_cmp(VALUE v1, VALUE v2)
  1067. {
  1068.     if(VTYPE(v1) == VTYPE(v2))
  1069.     {
  1070.     if(VFILE(v1)->lf_Name && VFILE(v2)->lf_Name)
  1071.         return(!same_files(VSTR(VFILE(v1)->lf_Name), VSTR(VFILE(v2)->lf_Name)));
  1072.     }
  1073.     return(1);
  1074. }
  1075.  
  1076. void
  1077. file_prin(VALUE strm, VALUE obj)
  1078. {
  1079.     stream_puts(strm, "#<file ", -1, FALSE);
  1080.     if(VFILE(obj)->lf_Name)
  1081.     {
  1082.     stream_puts(strm, VSTR(VFILE(obj)->lf_Name), -1, FALSE);
  1083.     stream_putc(strm, '>');
  1084.     }
  1085.     else
  1086.     stream_puts(strm, "*unbound*>", -1, FALSE);
  1087. }
  1088.  
  1089. _PR VALUE cmd_open(VALUE name, VALUE modes, VALUE file);
  1090. DEFUN("open", cmd_open, subr_open, (VALUE name, VALUE modes, VALUE file), V_Subr3, DOC_open) /*
  1091. ::doc:open::
  1092. open [FILE-NAME MODE-STRING] [FILE]
  1093.  
  1094. Opens a file called FILE-NAME with modes MODE-STRING (standard c-library
  1095. modes, ie `r' == read, `w' == write, etc). If FILE is given it is an
  1096. existing file object which is to be closed before opening the new file on it.
  1097. ::end:: */
  1098. {
  1099.     LFile *lf;
  1100.     if(!FILEP(file))
  1101.     {
  1102.     lf = str_alloc(sizeof(LFile));
  1103.     if(lf)
  1104.     {
  1105.         lf->lf_Next = lfile_chain;
  1106.         lfile_chain = lf;
  1107.         lf->lf_Type = V_File;
  1108.     }
  1109.     }
  1110.     else
  1111.     {
  1112.     lf = VFILE(file);
  1113.     if(lf->lf_Name && !(lf->lf_Flags & LFF_DONT_CLOSE))
  1114.         fclose(lf->lf_File);
  1115.     }
  1116.     if(lf)
  1117.     {
  1118.     lf->lf_File = NULL;
  1119.     lf->lf_Name = NULL;
  1120.     lf->lf_Flags = 0;
  1121.     if(STRINGP(name) && STRINGP(modes))
  1122.     {
  1123.         lf->lf_File = fopen(VSTR(name), VSTR(modes));
  1124.         if(lf->lf_File)
  1125.         {
  1126.         lf->lf_Name = name;
  1127. #ifdef HAVE_UNIX
  1128.         /*
  1129.          * set close-on-exec for easy process fork()ing
  1130.          */
  1131.         fcntl(fileno(lf->lf_File), F_SETFD, 1);
  1132. #endif
  1133.         }
  1134.         else
  1135.         return(cmd_signal(sym_file_error, list_2(lookup_errno(), name)));
  1136.     }
  1137.     return(VAL(lf));
  1138.     }
  1139.     return(NULL);
  1140. }
  1141.  
  1142. _PR VALUE cmd_close(VALUE file);
  1143. DEFUN("close", cmd_close, subr_close, (VALUE file), V_Subr1, DOC_close) /*
  1144. ::doc:close::
  1145. close FILE
  1146.  
  1147. Kills any association between object FILE and the file in the filesystem that
  1148. it has open.
  1149. ::end:: */
  1150. {
  1151.     DECLARE1(file, FILEP);
  1152.     if(VFILE(file)->lf_Name && !(VFILE(file)->lf_Flags & LFF_DONT_CLOSE))
  1153.     fclose(VFILE(file)->lf_File);
  1154.     VFILE(file)->lf_File = NULL;
  1155.     VFILE(file)->lf_Name = NULL;
  1156.     return(file);
  1157. }
  1158.  
  1159. _PR VALUE cmd_flush_file(VALUE file);
  1160. DEFUN("flush-file", cmd_flush_file, subr_flush_file, (VALUE file), V_Subr1, DOC_flush_file) /*
  1161. ::doc:flush_file::
  1162. flush-file FILE
  1163.  
  1164. Flushes any buffered output on FILE.
  1165. ::end:: */
  1166. {
  1167.     DECLARE1(file, FILEP);
  1168.     if(VFILE(file)->lf_Name)
  1169.     fflush(VFILE(file)->lf_File);
  1170.     return(file);
  1171. }
  1172.  
  1173. _PR VALUE cmd_filep(VALUE arg);
  1174. DEFUN("filep", cmd_filep, subr_filep, (VALUE arg), V_Subr1, DOC_filep) /*
  1175. ::doc:filep::
  1176. filep ARG
  1177.  
  1178. Returns t if ARG is a file object.
  1179. ::end:: */
  1180. {
  1181.     if(FILEP(arg))
  1182.     return(sym_t);
  1183.     return(sym_nil);
  1184. }
  1185.  
  1186. _PR VALUE cmd_file_bound_p(VALUE file);
  1187. DEFUN("file-bound-p", cmd_file_bound_p, subr_file_bound_p, (VALUE file), V_Subr1, DOC_file_bound_p) /*
  1188. ::doc:file_bound_p::
  1189. file-bound-p FILE
  1190.  
  1191. Returns t if FILE is currently bound to a physical file.
  1192. ::end:: */
  1193. {
  1194.     DECLARE1(file, FILEP);
  1195.     if(VFILE(file)->lf_Name)
  1196.     return(sym_t);
  1197.     return(sym_nil);
  1198. }
  1199.  
  1200. _PR VALUE cmd_file_binding(VALUE file);
  1201. DEFUN("file-binding", cmd_file_binding, subr_file_binding, (VALUE file), V_Subr1, DOC_file_binding) /*
  1202. ::doc:file_binding::
  1203. file-binding FILE
  1204.  
  1205. Returns the name of the physical file FILE is bound to, or nil.
  1206. ::end:: */
  1207. {
  1208.     DECLARE1(file, FILEP);
  1209.     if(VFILE(file)->lf_Name)
  1210.     return(VFILE(file)->lf_Name);
  1211.     return(sym_nil);
  1212. }
  1213.  
  1214. _PR VALUE cmd_file_eof_p(VALUE file);
  1215. DEFUN("file-eof-p", cmd_file_eof_p, subr_file_eof_p, (VALUE file), V_Subr1, DOC_file_eof_p) /*
  1216. ::doc:file_eof_p::
  1217. file-eof-p FILE
  1218.  
  1219. Returns t when the end of FILE is reached.
  1220. ::end:: */
  1221. {
  1222.     DECLARE1(file, FILEP);
  1223.     if(VFILE(file)->lf_Name && feof(VFILE(file)->lf_File))
  1224.     return(sym_t);
  1225.     return(sym_nil);
  1226. }
  1227.  
  1228. _PR VALUE cmd_read_file_until(VALUE file, VALUE re, VALUE nocase_p);
  1229. DEFUN("read-file-until", cmd_read_file_until, subr_read_file_until, (VALUE file, VALUE re, VALUE nocase_p), V_Subr3, DOC_read_file_until) /*
  1230. ::doc:read_file_until::
  1231. read-file-until FILE REGEXP [IGNORE-CASE-P]
  1232.  
  1233. Read lines from the Lisp file object FILE until one matching the regular
  1234. expression REGEXP is found. The matching line is returned, or nil if no
  1235. lines match.
  1236. If IGNORE-CASE-P is non-nil the regexp matching is not case-sensitive.
  1237. ::end:: */
  1238. {
  1239.     regexp *prog;
  1240.     u_char buf[400];        /* Fix this later. */
  1241.     DECLARE1(file, FILEP);
  1242.     DECLARE2(re, STRINGP);
  1243.     if(!VFILE(file)->lf_Name)
  1244.     return(cmd_signal(sym_bad_arg, list_2(MKSTR("File object is unbound"), file)));
  1245.     prog = regcomp(VSTR(re));
  1246.     if(prog)
  1247.     {
  1248.     int eflags = NILP(nocase_p) ? 0 : REG_NOCASE;
  1249.     FILE *fh = VFILE(file)->lf_File;
  1250.     VALUE res = sym_nil;
  1251.     while(fgets(buf, 400, fh))
  1252.     {
  1253.         if(regexec2(prog, buf, eflags))
  1254.         {
  1255.         res = string_dup(buf);
  1256.         break;
  1257.         }
  1258.     }
  1259.     free(prog);
  1260.     return(res);
  1261.     }
  1262.     return(NULL);
  1263. }
  1264.  
  1265. _PR VALUE cmd_stdin_file(void);
  1266. DEFUN("stdin-file", cmd_stdin_file, subr_stdin_file, (void), V_Subr0, DOC_stdin_file) /*
  1267. ::doc:stdin_file::
  1268. stdin-file
  1269.  
  1270. Returns the file object representing the editor's standard input.
  1271. ::end:: */
  1272. {
  1273.     static VALUE stdin_file;
  1274.     if(stdin_file)
  1275.     return(stdin_file);
  1276.     stdin_file = cmd_open(sym_nil, sym_nil, sym_nil);
  1277.     VFILE(stdin_file)->lf_Name = MKSTR("<stdin>");
  1278.     VFILE(stdin_file)->lf_File = stdin;
  1279.     VFILE(stdin_file)->lf_Flags |= LFF_DONT_CLOSE;
  1280.     mark_static(&stdin_file);
  1281.     return(stdin_file);
  1282. }
  1283.  
  1284. _PR VALUE cmd_stdout_file(void);
  1285. DEFUN("stdout-file", cmd_stdout_file, subr_stdout_file, (void), V_Subr0, DOC_stdout_file) /*
  1286. ::doc:stdout_file::
  1287. stdout-file
  1288.  
  1289. Returns the file object representing the editor's standard output.
  1290. ::end:: */
  1291. {
  1292.     static VALUE stdout_file;
  1293.     if(stdout_file)
  1294.     return(stdout_file);
  1295.     stdout_file = cmd_open(sym_nil, sym_nil, sym_nil);
  1296.     VFILE(stdout_file)->lf_Name = MKSTR("<stdout>");
  1297.     VFILE(stdout_file)->lf_File = stdout;
  1298.     VFILE(stdout_file)->lf_Flags |= LFF_DONT_CLOSE;
  1299.     mark_static(&stdout_file);
  1300.     return(stdout_file);
  1301. }
  1302.  
  1303. void
  1304. streams_init(void)
  1305. {
  1306.     ADD_SUBR(subr_write);
  1307.     ADD_SUBR(subr_read_char);
  1308.     ADD_SUBR(subr_read_line);
  1309.     ADD_SUBR(subr_copy_stream);
  1310.     ADD_SUBR(subr_read);
  1311.     ADD_SUBR(subr_print);
  1312.     ADD_SUBR(subr_prin1);
  1313.     ADD_SUBR(subr_princ);
  1314.     ADD_SUBR(subr_format);
  1315.     ADD_SUBR(subr_make_string_input_stream);
  1316.     ADD_SUBR(subr_make_string_output_stream);
  1317.     ADD_SUBR(subr_get_output_stream_string);
  1318.     ADD_SUBR(subr_streamp);
  1319.     ADD_SUBR(subr_open);
  1320.     ADD_SUBR(subr_close);
  1321.     ADD_SUBR(subr_flush_file);
  1322.     ADD_SUBR(subr_filep);
  1323.     ADD_SUBR(subr_file_bound_p);
  1324.     ADD_SUBR(subr_file_binding);
  1325.     ADD_SUBR(subr_file_eof_p);
  1326.     ADD_SUBR(subr_read_file_until);
  1327.     ADD_SUBR(subr_stdin_file);
  1328.     ADD_SUBR(subr_stdout_file);
  1329. }
  1330.  
  1331. void
  1332. streams_kill(void)
  1333. {
  1334.     LFile *lf = lfile_chain;
  1335.     while(lf)
  1336.     {
  1337.     LFile *nxt = lf->lf_Next;
  1338.     if(lf->lf_Name && !(lf->lf_Flags & LFF_DONT_CLOSE))
  1339.         fclose(lf->lf_File);
  1340.     str_free(lf);
  1341.     lf = nxt;
  1342.     }
  1343.     lfile_chain = NULL;
  1344. }
  1345.