home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / Programming / Source / winterp-1.13 / src-server / xlisp / xlio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  5.9 KB  |  250 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         xlio.c
  5. * RCS:          $Header: xlio.c,v 1.4 91/03/24 22:25:01 mayer Exp $
  6. * Description:  xlisp i/o routines
  7. * Author:       David Michael Betz
  8. * Created:      
  9. * Modified:     Fri Oct  4 04:01:32 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: xlio.c,v 1.4 91/03/24 22:25:01 mayer Exp $";
  43.  
  44. #include "xlisp.h"
  45.  
  46. /* external variables */
  47. extern LVAL s_stdin,s_stdout,s_stderr,s_debugio,s_traceout,s_unbound;
  48. extern int xlfsize;
  49.  
  50. /* xlgetc - get a character from a file or stream */
  51. int xlgetc(fptr)
  52.   LVAL fptr;
  53. {
  54.     LVAL lptr,cptr;
  55.     FILE *fp;
  56.     int ch;
  57.  
  58.     /* check for input from nil */
  59.     if (fptr == NIL)
  60.     ch = EOF;
  61.  
  62.     /* otherwise, check for input from a stream */
  63.     else if (ustreamp(fptr)) {
  64.     if ((lptr = gethead(fptr)) == NIL)
  65.         ch = EOF;
  66.     else {
  67.         if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
  68.         xlfail("bad stream");
  69.         sethead(fptr,lptr = cdr(lptr));
  70.         if (lptr == NIL)
  71.         settail(fptr,NIL);
  72.         ch = getchcode(cptr);
  73.     }
  74.     }
  75.  
  76.     /* otherwise, check for a buffered character */
  77.     else if (ch = getsavech(fptr))
  78.     setsavech(fptr,'\0');
  79.  
  80.     /* otherwise, check for terminal input or file input */
  81.     else {
  82.     fp = getfile(fptr);
  83.     if (fp == stdin || fp == stderr)
  84.         ch = ostgetc();
  85.     else
  86.         ch = osagetc(fp);
  87.     }
  88.  
  89.     /* return the character */
  90.     return (ch);
  91. }
  92.  
  93. /* xlungetc - unget a character */
  94. xlungetc(fptr,ch)
  95.   LVAL fptr; int ch;
  96. {
  97.     LVAL lptr;
  98.     
  99.     /* check for ungetc from nil */
  100.     if (fptr == NIL)
  101.     ;
  102.     
  103.     /* otherwise, check for ungetc to a stream */
  104.     if (ustreamp(fptr)) {
  105.     if (ch != EOF) {
  106.         lptr = cons(cvchar(ch),gethead(fptr));
  107.         if (gethead(fptr) == NIL)
  108.         settail(fptr,lptr);
  109.         sethead(fptr,lptr);
  110.     }
  111.     }
  112.     
  113.     /* otherwise, it must be a file */
  114.     else
  115.     setsavech(fptr,ch);
  116. }
  117.  
  118. /* xlpeek - peek at a character from a file or stream */
  119. int xlpeek(fptr)
  120.   LVAL fptr;
  121. {
  122.     LVAL lptr,cptr;
  123.     int ch;
  124.  
  125.     /* check for input from nil */
  126.     if (fptr == NIL)
  127.     ch = EOF;
  128.  
  129.     /* otherwise, check for input from a stream */
  130.     else if (ustreamp(fptr)) {
  131.     if ((lptr = gethead(fptr)) == NIL)
  132.         ch = EOF;
  133.     else {
  134.         if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
  135.         xlfail("bad stream");
  136.         ch = getchcode(cptr);
  137.     }
  138.     }
  139.  
  140.     /* otherwise, get the next file character and save it */
  141.     else {
  142.     ch = xlgetc(fptr);
  143.     setsavech(fptr,ch);
  144.     }
  145.  
  146.     /* return the character */
  147.     return (ch);
  148. }
  149.  
  150. /* xlputc - put a character to a file or stream */
  151. xlputc(fptr,ch)
  152.   LVAL fptr; int ch;
  153. {
  154.     LVAL lptr;
  155.     FILE *fp;
  156.  
  157.     /* count the character */
  158.     ++xlfsize;
  159.  
  160.     /* check for output to nil */
  161.     if (fptr == NIL)
  162.     ;
  163.  
  164.     /* otherwise, check for output to an unnamed stream */
  165.     else if (ustreamp(fptr)) {
  166.     lptr = consa(cvchar(ch));
  167.     if (gettail(fptr))
  168.         rplacd(gettail(fptr),lptr);
  169.     else
  170.         sethead(fptr,lptr);
  171.     settail(fptr,lptr);
  172.     }
  173.  
  174.     /* otherwise, check for terminal output or file output */
  175.     else {
  176.     fp = getfile(fptr);
  177.     if (fp == stdout || fp == stderr)
  178.         ostputc(ch);
  179.     else
  180.         osaputc(ch,fp);
  181.     }
  182. }
  183.  
  184. /* xlflush - flush the input buffer */
  185. int xlflush()
  186. {
  187.     osflush();
  188. }
  189.  
  190. /* stdprint - print to *standard-output* */
  191. stdprint(expr)
  192.   LVAL expr;
  193. {
  194.     xlprint(getvalue(s_stdout),expr,TRUE);
  195.     xlterpri(getvalue(s_stdout));
  196. }
  197.  
  198. /* stdputstr - print a string to *standard-output* */
  199. stdputstr(str)
  200.   char *str;
  201. {
  202.     xlputstr(getvalue(s_stdout),str);
  203. }
  204.  
  205. /* errprint - print to *error-output* */
  206. errprint(expr)
  207.   LVAL expr;
  208. {
  209.     xlprint(getvalue(s_stderr),expr,TRUE);
  210.     xlterpri(getvalue(s_stderr));
  211. }
  212.  
  213. /* errputstr - print a string to *error-output* */
  214. errputstr(str)
  215.   char *str;
  216. {
  217.     xlputstr(getvalue(s_stderr),str);
  218. }
  219.  
  220. /* dbgprint - print to *debug-io* */
  221. dbgprint(expr)
  222.   LVAL expr;
  223. {
  224.     xlprint(getvalue(s_debugio),expr,TRUE);
  225.     xlterpri(getvalue(s_debugio));
  226. }
  227.  
  228. /* dbgputstr - print a string to *debug-io* */
  229. dbgputstr(str)
  230.   char *str;
  231. {
  232.     xlputstr(getvalue(s_debugio),str);
  233. }
  234.  
  235. /* trcprin1 - print to *trace-output* */
  236. trcprin1(expr)
  237.   LVAL expr;
  238. {
  239.     xlprint(getvalue(s_traceout),expr,TRUE);
  240. }
  241.  
  242. /* trcputstr - print a string to *trace-output* */
  243. trcputstr(str)
  244.   char *str;
  245. {
  246.     xlputstr(getvalue(s_traceout),str);
  247. }
  248.  
  249.  
  250.