/* xlstr - xlisp string builtin functions */
/*	Copyright (c) 1985, by David Michael Betz
	All Rights Reserved
	Permission is granted for unrestricted non-commercial use	*/

#include "xlisp.h"

/* xstrcat - concatenate a bunch of strings */
NODE *xstrcat (NODE *args)
{
    NODE ***oldstk,*val,*p;
    char *str;
    size_t len;

    /* create a new stack frame */
    oldstk = xlsave(&val,(NODE **)NULL);

    /* find the length of the new string */
    for (p = args, len = 0; p; )
	len += strlen(getstring(xlmatch(STR,&p)));

    /* create the result string */
    val = newstring(len);
    str = getstring(val);
    *str = 0;

    /* combine the strings */
    while (args)
	strcat(str,getstring(xlmatch(STR,&args)));

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the new string */
    return (val);
}

/* xsubstr - return a substring */
NODE *xsubstr (NODE *args)
{
    NODE ***oldstk,*arg,*src,*val;
    size_t start,forlen,srclen;
    char *srcptr,*dstptr;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&src,&val,(NODE **)NULL);

    /* initialize */
    arg = args;
    
    /* get string and its length */
    src = xlmatch(STR,&arg);
    srcptr = getstring(src);
    srclen = strlen(srcptr);

    /* get starting pos -- must be present */
    start = getsize_t(xlmatch(INT,&arg),0,SIZE_MAX);

    /* get length -- if not present use remainder of string */
    forlen = (arg ? getsize_t(xlmatch(INT,&arg),0,SIZE_MAX) : srclen);

    /* make sure there aren't any more arguments */
    xllastarg(arg);

    /* don't take more than exists */
    if (start + forlen > srclen)
	forlen = srclen - start + 1;

    /* if start beyond string -- return null string */
    if (start > srclen) {
	start = 1;
	forlen = 0; }
	
    /* create return node */
    val = newstring(forlen);
    dstptr = getstring(val);

    /* move string */
    for (srcptr += start-1; forlen--; *dstptr++ = *srcptr++)
	;
    *dstptr = 0;

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the substring */
    return (val);
}

/* xstring - return a string consisting of a single character */
NODE *xstring (NODE *args)
{
    char buf[2];
    /* get the character (integer) */
    ((unsigned char*)buf)[0] = (unsigned char)getint(xlmatch(INT,&args), 0, UCHAR_MAX);
    xllastarg(args);

    /* make a one character string */
    buf[1] = 0;
    return (cvstring(buf));
}

/* xchar - extract a character from a string */
NODE *xchar (NODE *args)
{
    char *str;
    size_t n;

    /* get the string and the index */
    str = getstring(xlmatch(STR,&args));
    n = getsize_t(xlmatch(INT,&args), 0, SIZE_MAX);
    xllastarg(args);

    /* range check the index */
    if (/* n < 0 || */ n >= strlen(str))
	xlerror("index out of range",cvfixnum((FIXNUM)n));

    /* return the character */
    return (cvfixnum((FIXNUM)(unsigned char)str[n]));
}

