/* xlpeek - peek at a character from a file or stream */
int xlpeek(LVAL fptr)
{
LVAL lptr, cptr=NULL;
int ch;
/* check for input from nil */
if (fptr == NIL)
ch = EOF;
/* otherwise, check for input from a stream */
else if (ustreamp(fptr)) {
if ((lptr = gethead(fptr)) == NIL)
ch = EOF;
else {
if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
xlfail("bad stream");
ch = getchcode(cptr);
}
}
/* otherwise, get the next file character and save it */
else {
ch = xlgetc(fptr);
setsavech(fptr,ch);
}
/* return the character */
return (ch);
}
/* xlputc - put a character to a file or stream */
void xlputc(LVAL fptr, int ch)
{
LVAL lptr;
FILE *fp;
/* count the character */
++xlfsize;
/* check for output to nil */
if (fptr == NIL)
;
/* otherwise, check for output to an unnamed stream */
else if (ustreamp(fptr)) {
lptr = consa(cvchar(ch));
if (gettail(fptr))
rplacd(gettail(fptr),lptr);
else
sethead(fptr,lptr);
settail(fptr,lptr);
}
/* otherwise, check for terminal output or file output */
else {
fp = getfile(fptr);
if (!fp)
xlfail("file not open");
else if (fp == stdout || fp == STDERR)
ostputc(ch);
else
osaputc(ch,fp);
}
}
LVAL xssystem()
{
char *cmd;
int status;
LVAL stream = NIL;
FILE *p;
int ch;
cmd = (char *) getstring(xlgastring());
if (moreargs()) {
stream = xlgetarg();
if (stream == s_true)
stream = getvalue(s_stdout);
else if (!streamp(stream) && !ustreamp(stream))
xlbadtype(stream);
}
if (stream == NIL) {
status = system(cmd);
if (status == 127) xlfail("shell could not execute command");
}
else {
if ((p = popen(cmd, "r")) == NULL)
xlfail("could not execute command");
while ((ch = getc(p)) != EOF) xlputc(stream, ch);
status = pclose(p);
}
return(cvfixnum((FIXTYPE) status));
}
/* xstreamp - is this a stream? */
LVAL xstreamp(void)
{
LVAL arg;
arg = xlgetarg();
xllastarg();
return (streamp(arg) || ustreamp(arg) ? s_true : NIL);
}
/* xformat - formatted output function */
LVAL xformat(void)
{
unsigned char *fmt;
LVAL stream,val;
int ch;
/* protect stream in case it is a new ustream */
xlsave1(stream);
/* get the stream and format string */
stream = xlgetarg();
if (stream == NIL)
val = stream = newustream();
else {
if (stream == s_true)
stream = getvalue(s_stdout);
else if (!streamp(stream) && !ustreamp(stream))
xlbadtype(stream);
val = NIL;
}
fmt = getstring(xlgastring());
/* process the format string */
while ((ch = *fmt++))
if (ch == '~') {
switch (*fmt++) {
case '\0':
xlerror("expecting a format directive",cvstring((char *) (fmt-1)));
case 'a': case 'A':
xlprint(stream,xlgetarg(),FALSE);
break;
case 's': case 'S':
xlprint(stream,xlgetarg(),TRUE);
break;
case '%':
xlterpri(stream);
break;
case '~':
xlputc(stream,'~');
break;
case '\n':
case '\r':
/* mac may read \r -- this should be ignored */
if (*fmt == '\r') fmt++;
while (*fmt && *fmt != '\n' && isspace(*fmt))
++fmt;
break;
default:
xlerror("unknown format directive",cvstring((char *) (fmt-1)));
}
}
else
xlputc(stream,ch);
/* return the value */
if (val) val = getstroutput(val);
xlpop();
return val;
}
/* xlgetc - get a character from a file or stream */
int xlgetc P1C(LVAL, fptr)
{
LVAL lptr,cptr=NULL;
FILEP fp;
int ch;
/* check for input from nil */
if (fptr == NIL)
ch = EOF;
/* otherwise, check for input from a stream */
else if (ustreamp(fptr)) {
if ((lptr = gethead(fptr)) == NIL)
ch = EOF;
else {
if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
xlfail("bad stream");
sethead(fptr,lptr = cdr(lptr));
if (lptr == NIL)
settail(fptr,NIL);
ch = getchcode(cptr);
}
}
/* otherwise, check for a buffered character */
else if ((ch = getsavech(fptr)) != 0)
setsavech(fptr,'\0');
/* otherwise, check for terminal input or file input */
else {
fp = getfile(fptr);
if (fp == CLOSED) /* TAA MOD -- give error */
xlfail("can't read closed stream");
else if (fp == CONSOLE)
/* TAA MOD -- revamped for redirecting */
ch = ostgetc();
else {
if ((fptr->n_sflags & S_FORREADING) == 0)
xlerror("can't read write-only file stream", fptr);
if ((fptr->n_sflags & S_READING) == 0) {
/* possible direction change*/
if (fptr->n_sflags & S_WRITING) {
OSSEEKCUR(fp,0L);
}
fptr->n_sflags |= S_READING;
fptr->n_sflags &= ~S_WRITING;
}
#ifdef OSAGETC
ch = (fptr->n_sflags & S_BINARY) ? OSGETC(fp) : OSAGETC(fp);
#else
ch = OSGETC(fp);
#endif
}
}
/* return the character */
return (ch);
}
LOCAL LVAL get_plot_stream()
{
LVAL stream;
stream = getvalue(s_plot_output);
if (! streamp(stream) && ! ustreamp(stream)) xlerror("not a stream", stream);
return(stream);
}
/* xlgetc - get a character from a file or stream */
int xlgetc(LVAL fptr)
{
LVAL lptr, cptr=NULL;
FILE *fp;
int ch;
/* check for input from nil */
if (fptr == NIL)
ch = EOF;
/* otherwise, check for input from a stream */
else if (ustreamp(fptr)) {
if ((lptr = gethead(fptr)) == NIL)
ch = EOF;
else {
if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
xlfail("bad stream");
sethead(fptr,lptr = cdr(lptr));
if (lptr == NIL)
settail(fptr,NIL);
ch = getchcode(cptr);
}
}
/* otherwise, check for a buffered character */
else if ((ch = getsavech(fptr)))
setsavech(fptr,'\0');
/* otherwise, check for terminal input or file input */
else {
fp = getfile(fptr);
if (fp == stdin || fp == STDERR)
ch = ostgetc();
else
ch = osagetc(fp);
#ifdef DEBUG_INPUT
if (read_by_xlisp && ch != -1) {
putc(ch, read_by_xlisp);
}
#endif
}
/* return the character */
return (ch);
}
/* xloutflush -- flush output buffer */
void xloutflush(LVAL fptr)
{
FILE *fp;
/* check for output to nil or unnamed stream */
if (fptr == NIL || ustreamp(fptr))
;
/* otherwise, check for terminal output or file output */
else {
fp = getfile(fptr);
if (!fp)
xlfail("file not open");
else if (fp == stdout || fp == STDERR)
ostoutflush();
else
osoutflush(fp);
}
}
/* xlungetc - unget a character */
VOID xlungetc P2C(LVAL, fptr, int, ch)
{
LVAL lptr;
/* check for ungetc from nil, or ungetc of EOF */
if (fptr == NIL || ch == EOF)
;
/* otherwise, check for ungetc to a stream */
else if (ustreamp(fptr)) {
lptr = cons(cvchar(ch),gethead(fptr));
if (gethead(fptr) == NIL)
settail(fptr,lptr);
sethead(fptr,lptr);
}
/* otherwise, it must be a file */
else
setsavech(fptr,ch);
}
/* xlgetfile - get a file or stream */
LVAL xlgetfile P1C(int, outflag)
{
LVAL arg;
/* get a file or stream (cons) or nil */
if (null(arg = xlgetarg()))
return outflag ? NIL : getvalue(s_stdin);
else if (streamp(arg)) {
if (getfile(arg) == CLOSED)
xlfail("file not open");
#ifdef BIGNUMS
if (arg->n_sflags & S_BINARY)
xlfail("binary file");
#endif
}
else if (arg == s_true)
return getvalue(s_termio);
else if (!ustreamp(arg))
xlbadtype(arg);
return arg;
}
/* xlungetc - unget a character */
void xlungetc(LVAL fptr, int ch)
{
LVAL lptr;
/* check for ungetc from nil */
if (fptr == NIL || ch == EOF)
;
/* otherwise, check for ungetc to a stream */
else if (ustreamp(fptr)) {
if (ch != EOF) {
lptr = cons(cvchar(ch),gethead(fptr));
if (gethead(fptr) == NIL)
settail(fptr,lptr);
sethead(fptr,lptr);
}
}
/* otherwise, it must be a file */
else
setsavech(fptr,ch);
}
