home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lisp / interpre / xlispdos / source / xlstr.c < prev    next >
Text File  |  1986-04-13  |  3KB  |  116 lines
  1. /* xlstr - xlisp string builtin functions */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern char buf[];
  10.  
  11. /* external procedures */
  12. extern char *strcat();
  13.  
  14. /* xstrcat - concatenate a bunch of strings */
  15. NODE *xstrcat(args)
  16.   NODE *args;
  17. {
  18.     NODE *val,*p;
  19.     char *str;
  20.     int len;
  21.  
  22.     /* find the length of the new string */
  23.     for (p = args, len = 0; p; )
  24.     len += strlen(getstring(xlmatch(STR,&p)));
  25.  
  26.     /* create the result string */
  27.     val = newstring(len);
  28.     str = getstring(val);
  29.     *str = 0;
  30.  
  31.     /* combine the strings */
  32.     while (args)
  33.     strcat(str,getstring(xlmatch(STR,&args)));
  34.  
  35.     /* return the new string */
  36.     return (val);
  37. }
  38.  
  39. /* xsubstr - return a substring */
  40. NODE *xsubstr(args)
  41.   NODE *args;
  42. {
  43.     int start,forlen,srclen;
  44.     char *srcptr,*dstptr;
  45.     NODE *src,*val;
  46.  
  47.     /* get string and its length */
  48.     src = xlmatch(STR,&args);
  49.     srcptr = getstring(src);
  50.     srclen = strlen(srcptr);
  51.  
  52.     /* get starting pos -- must be present */
  53.     start = getfixnum(xlmatch(INT,&args));
  54.  
  55.     /* get length -- if not present use remainder of string */
  56.     forlen = (args ? getfixnum(xlmatch(INT,&args)) : srclen);
  57.  
  58.     /* make sure there aren't any more arguments */
  59.     xllastarg(args);
  60.  
  61.     /* don't take more than exists */
  62.     if (start + forlen > srclen)
  63.     forlen = srclen - start + 1;
  64.  
  65.     /* if start beyond string -- return null string */
  66.     if (start > srclen) {
  67.     start = 1;
  68.     forlen = 0;
  69.     }
  70.     
  71.     /* create return node */
  72.     val = newstring(forlen);
  73.     dstptr = getstring(val);
  74.  
  75.     /* move string */
  76.     for (srcptr += start-1; forlen--; *dstptr++ = *srcptr++)
  77.     ;
  78.     *dstptr = 0;
  79.  
  80.     /* return the substring */
  81.     return (val);
  82. }
  83.  
  84. /* xstring - return a string consisting of a single character */
  85. NODE *xstring(args)
  86.   NODE *args;
  87. {
  88.     /* get the character (integer) */
  89.     buf[0] = getfixnum(xlmatch(INT,&args));
  90.     xllastarg(args);
  91.  
  92.     /* make a one character string */
  93.     buf[1] = 0;
  94.     return (cvstring(buf));
  95. }
  96.  
  97. /* xchar - extract a character from a string */
  98. NODE *xchar(args)
  99.   NODE *args;
  100. {
  101.     char *str;
  102.     int n;
  103.  
  104.     /* get the string and the index */
  105.     str = getstring(xlmatch(STR,&args));
  106.     n = getfixnum(xlmatch(INT,&args));
  107.     xllastarg(args);
  108.  
  109.     /* range check the index */
  110.     if (n < 0 || n >= strlen(str))
  111.     xlerror("index out of range",cvfixnum((FIXNUM)n));
  112.  
  113.     /* return the character */
  114.     return (cvfixnum((FIXNUM)str[n]));
  115. }
  116.