/***************************************************************************
* toplevel.c
*
* The klone pool_toplevel, extracted from the original main.c.
* Added the customizable prompt:
* If the symbol 'klone:prompt is a list, it is decoded as:
* . (get 'klone:prompt 0)
* If a string, is the first prompt (PS1)
* . (get 'klone:prompt 1)
* If s a string, is the second prompt (PS2)
* . (get 'klone:prompt 2)
* If a string, and ParenthesesLevel is not 0, will be printed this
* many times, *after* PS2. PS1 not used in this case
* . (get 'klone:prompt 3)
* If a string, will be printed before the result of eval.
* . (get 'klone:prompt 4)
* If a string, will be printed between prompts and the get
*
* So, to get the old look:
* (setq *:prompt '("?" "?" " " " = " " "))
* NOTE: () means the default value, to get no strings, do:
* (setq *:prompt '("" "" "" "" ""))
*
***************************************************************************/
#include <signal.h>
#ifdef SYSV
#include <sys/types.h>
#endif /* SYSV */
#include <sys/file.h>
#ifdef c_plus_plus
extern "C" {
#endif
#include "EXTERN.h"
#include "klone.h"
#include "kl_atom.h"
#include "kl_coll.h"
#include "kl_func.h"
#include "kl_list.h"
#include "kl_number.h"
#include "kl_string.h"
#include "kl_stream.h"
#ifdef c_plus_plus
}
#endif
#include <sys/time.h>
#ifdef NEED_SELECT_H
#include <sys/select.h>
#endif
#ifdef DEBUG2
#ifdef STATS
#define WATCH_MEM
int KlTotalMem = 0;
int KlLastTotalMem = 0;
#endif /* STATS */
#endif /* DEBUG2 */
static char buffer[8192]; /* input buffer */
#undef KlToplevelPrint
/*****************************************************************************\
* pool *
\*****************************************************************************/
/*********************************************************\
* *
* The definition of C KLONE routines *
* These constitue the KLONE interface to the C programmer *
* *
\*********************************************************/
/* KlPool:
* this routine MUST be used when you want to make successive calls to
* KlRead to parse an expression. It stores the string passed as argument
* and returns the parenthese level. Thus a normal use would be to call
* KlPool with successive lines, while it returns a non-zero value,
* and then call KlRead on the pooled buffer maintained by KlPool,
* whose address is stored in the global Stream KlStdpool.
* (the parenthese level returned)
* The buffer is reset by calling KlPool with a NULL argument.
*/
int
KlPool(s)
char *s; /* the string to be put in the pool */
{
if (!s) {
KlStdpool->klstring->string[0] = '\0';
KlModStringSetLength(KlStdpool->klstring, 0);
KlStdpool->cursor = 0;
return 0;
} else {
KlStringStrcat(((KlStreamString) KlStdpool)->klstring, s);
KlStringStrcat(((KlStreamString) KlStdpool)->klstring, "\n");
return KlCountParentheses(((KlStreamString) KlStdpool)
->klstring->string);
}
}
/*****************************************************************************\
* InputFds *
\*****************************************************************************/
static int KlInputsSize;
static int KlInputsLimit;
typedef struct _KlInput {
char *name; /* name of input, can be 0 */
int fd; /* file descriptor to monitor */
KlVoidFunc handler; /* void handler(name, fd, closure) */
void *closure; /* closure (void *) */
} *KlInput;
static KlInput KlInputs;
void
KlAddInput(name, fd, handler, closure)
char *name;
int fd;
KlVoidFunc handler; /* void handler(name, fd, closure) */
void *closure;
{
int i = KlInputsSize;
KlInputsSize++;
if (KlInputsSize > KlInputsLimit) {
if (KlInputsLimit) {
KlInputs = (KlInput)
Realloc(KlInputs, sizeof(struct _KlInput) * KlInputsSize);
} else {
KlInputs = (KlInput)
Malloc(sizeof(struct _KlInput) * KlInputsSize);
}
KlInputsLimit = KlInputsSize;
}
if (name)
KlInputs[i].name = (char *) KlStrdup(name);
else
KlInputs[i].name = 0;
KlInputs[i].fd = fd;
KlInputs[i].handler = handler;
KlInputs[i].closure = closure;
}
void
KlRemoveInput(fd)
int fd;
{
int i, j, j1;
for (i = 0; i < KlInputsSize; i++) {
if (fd == KlInputs[i].fd) {
if (KlInputs[i].name) Free(KlInputs[i].name);
for (j = i, j1 = j+1; j1 < KlInputsSize; j++, j1++) {
KlInputs[j].name = KlInputs[j1].name;
KlInputs[j].fd = KlInputs[j1].fd;
KlInputs[j].handler = KlInputs[j1].handler;
KlInputs[j].closure = KlInputs[j1].closure;
}
KlInputsSize--;
return;
}
}
}
int /* return 1 if triggered, else 0 */
KlTriggerInput(fdsp)
fd_set *fdsp;
{
int i;
for (i = 0; i < KlInputsSize; i++) {
if (FD_ISSET(KlInputs[i].fd, fdsp)) {
(*(KlInputs[i].handler)) (
KlInputs[i].name, KlInputs[i].fd, KlInputs[i].closure);
return 1;
}
}
return 0;
}
/*****************************************************************************\
* prompt *
\*****************************************************************************/
/* This is BAD */
#define PROMPT_PROMPT1 0
#define PROMPT_PROMPT2 1
#define PROMPT_INDENT 2
#define PROMPT_RESULT 3
#define PROMPT_PAD 4
char * KlPoolToplevelDefaultPrompts[] = {
"?", "?", " ", " = ", " "
};
static char *
KlPoolToplevelGetPrompt(n)
int n;
{
static KlAtom KlPromptDescription = (KlAtom) 0;
if (!KlPromptDescription)
KlPromptDescription = KlIntern("*:prompt");
if ((KlO) KlBoundp(KlPromptDescription) != NIL) {
KlList kl_prompt_list = (KlList) KlAtomEval(KlPromptDescription);
if (KlIsAList(kl_prompt_list)
&& (kl_prompt_list->size > n)) {
KlString kl_prompt = (KlString) (kl_prompt_list->list[n]);
return (KlIsAString(kl_prompt)
? kl_prompt->string
: KlPoolToplevelDefaultPrompts[n]);
}
}
return KlPoolToplevelDefaultPrompts[n];
}
KlDrawPrompt(KlPoolParenthesesLevel)
int KlPoolParenthesesLevel;
{
int i;
/*
* Draw the current prompt: . If not inside an expr use PROMPT_PROMPT1 .
* else puts PROMPT_INDENT, than PROMPT_PROMPT2
*/
if (!KlPoolParenthesesLevel) {
KlSPuts(KlPoolToplevelGetPrompt(PROMPT_PROMPT1), KlStdout);
} else {
KlSPuts(KlPoolToplevelGetPrompt(PROMPT_PROMPT2), KlStdout);
for (i = 0; i < KlPoolParenthesesLevel; i++)
KlSPuts(KlPoolToplevelGetPrompt(PROMPT_INDENT), KlStdout);
}
KlSPuts(KlPoolToplevelGetPrompt(PROMPT_PAD), KlStdout);
KlFlush(KlStdout);
}
/* standard printing: we protect against long lists / strings
*/
void
KlToplevelPrint(obj)
KlO obj;
{
if (KlPrintReadably) {
KlPrintNary(1, &(obj));
} else if (KlIsAString(obj)) {
KlString s = (KlString) obj;
int cutto = -1;
char *p, *end;
if (KlStringLength(s) > 2000)
cutto = 2000;
for (p = s->string, end = p + Min(2000, KlStringLength(s));
end < p; p++) {
if ((*p & 0x7f) < 32 && *p != '\n' && *p != '\t')
{cutto = p - s->string; break;}
}
if (cutto == -1)
KlPrintNary(1, &(obj));
else {
s = (KlString) KlStringPtrMake(cutto, s->string);
KlPrintNary(1, &(s));
s = KlStringMake("...");
KlPrintNary(1, &(s));
}
} else {
KlPrintNary(1, &(obj));
}
}
int
KlPoolToplevel()
{
static int first_time = 1;
static int is_in_string;
static int KlPoolParenthesesLevel;
char *buffer;
int input_len;
int i;
if (KlInputsSize) {
int i = 0, fdmax = 0;
fd_set fds;
FD_ZERO(&fds);
for (i = 0; i < KlInputsSize; i++) {
FD_SET(KlInputs[i].fd, &fds);
if (KlInputs[i].fd > fdmax) fdmax = KlInputs[i].fd;
}
FD_SET(KlFp2Fd(KlStdin->fd), &fds);
if (KlFp2Fd(KlStdin->fd) > fdmax) fdmax = KlFp2Fd(KlStdin->fd);
if (KlMainPreSelect) (*KlMainPreSelect)();
select(fdmax + 1, &fds, NULL, NULL, NULL);
if (KlTriggerInput(&fds))
return KlPoolParenthesesLevel;
}
if (first_time) {
KlPoolParenthesesLevel = KlPool(NULL);
KlDrawPrompt(KlPoolParenthesesLevel); /* draw prompt the first time */
} else {
/* ensures that if we jump out of here in the middle we redo inits */
first_time = 1;
}
/* Wait to get a line */
if (!(buffer = KlGets(KlStdin, &input_len))) {
KlExit(0); /* EOF, quit gracefully */
}
/* Make KlPool gobble all this */
if (!(KlPoolParenthesesLevel = KlPool(buffer))) {
/* we read all the expressions of this line, the NULL returned by
* KlRead meaning the end of the input (here the pool)
*/
KlGCMark2();
KlStdpool->cursor = 0;
KlStdyyRedirect(KlStdpool);
KlStdyyReset(KlStdyy);
{
KlGCMark();
KlO PreviousExpr;
if (!KlRead()) goto end_empty;
PreviousExpr = KlReadExpr;
while (KlRead()) {
if (KlReadExpr == (KlO) KlA_equal && KlInfixAssigns) {
/* x = y, create assign */
if (!(KlRead())) /* x = EOF */
goto end;
PreviousExpr = (KlO)KlAssignMake(PreviousExpr, KlReadExpr);
} else { /* normal */
KlToplevelEval(PreviousExpr);
PreviousExpr = KlReadExpr;
}
}
end:
KlToplevelEval(PreviousExpr);
end_empty:
KlGC();
}
KlGC2();
KlPool(NULL);
}
/* Draw next prompt */
KlDrawPrompt(KlPoolParenthesesLevel);
first_time = 0;
return KlPoolParenthesesLevel;
}
/* evaluates an expression to print at toplevel */
KlToplevelEval(expr)
{
KlO result;
/* Protect evaluation against errors */
if (KlSafeEval(expr, &result)) {
KlSPuts(KlPoolToplevelGetPrompt(PROMPT_RESULT), KlStdout);
KlToplevelPrint(result);
KlPutchar('\n');
} else if (KlLastCaughtTag != (KlO) KlA_ERROR) {
KlSPuts("ERROR: Throwing to uncaught tag: ", KlStdout);
KlSend_print(KlLastCaughtTag, KlStdout);
KlSPuts(", value: ", KlStdout);
KlSend_print(result, KlStdout);
KlPutchar('\n');
} /* errors are silent */
#ifdef WATCH_MEM
if ((KlTotalMem = KlMemSize()) != KlLastTotalMem) {
KlSPrintf(KlStdout, "[", 0);
if (KlLastTotalMem)
KlSPrintf(KlStdout, "MEM: %+d",KlTotalMem-KlLastTotalMem);
KlSPrintf(KlStdout, " =%d]", KlTotalMem);
KlLastTotalMem = KlTotalMem;
}
#endif /* WATCH_MEM */
}
/* Klone version
* gobbles sexprs upto at least a complete one, but multiline with prompts
* and returns the string of its input (which may have syntaxic errors)
* throws to EOF on end, or returns the evaluation of EOF? if given
* (read-lines-pooled [ stream [ EOF? ]] )
*/
KlO
KlPoolKl(argc, argv)
int argc;
KlO *argv;
{
int input_len;
char *buffer;
KlO result;
KlStream stream;
int KlPoolParenthesesLevel = KlPool(NULL); /* reset pool */
switch (argc) {
case 0:
stream = KlStdin;
break;
case 1: case 2:
stream = (KlStream) argv[0];
KlMustBeStream(stream, 0);
KlStreamCanREAD(stream);
break;
default:
return KlBadNumberOfArguments(argc);
}
KlDrawPrompt(KlPoolParenthesesLevel); /* draw prompt the first time */
for (;;) {
if ((!(buffer = KlGets(stream, &input_len)))
|| (!(KlPoolParenthesesLevel = KlPool(buffer)))) {
if (KlStdpool->klstring->size) {
result = (KlO) KlStringCopy(KlStdpool->klstring);
KlPool(NULL); /* clean up pool behind us */
return result;
} else { /* EOF */
if (argc == 2)
return KlSend_eval(argv[1]);
else
KlThrow(KlA_EOF, NIL);
/* NOTREACHED */
}
}
KlDrawPrompt(KlPoolParenthesesLevel); /* draw next prompt */
}
}
#ifdef WATCH_MEM
#include "kl_list.h"
#include "kl_number.h"
int
KlMemSize()
{
extern KlO KlMallocStats();
KlList l;
int used;
KlGCMark();
l = (KlList) KlMallocStats();
used = ((KlNumber) (l->list[0]))->number;
KlGC();
return used;
}
#endif /* WATCH_MEM */
syntax highlighted by Code2HTML, v. 0.9.1