regina/cmsfuncs.c

   1 /*
   2  *  The Regina Rexx Interpreter
   3  *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
   4  *
   5  *  This library is free software; you can redistribute it and/or
   6  *  modify it under the terms of the GNU Library General Public
   7  *  License as published by the Free Software Foundation; either
   8  *  version 2 of the License, or (at your option) any later version.
   9  *
  10  *  This library is distributed in the hope that it will be useful,
  11  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  *  Library General Public License for more details.
  14  *
  15  *  You should have received a copy of the GNU Library General Public
  16  *  License along with this library; if not, write to the Free
  17  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18  */
  19
  20 /*
  21  * Bug in LCC complier wchar.h that incorrectly says it defines stat struct
  22  * but doesn't
  23  */
  24 #if defined(__LCC__)
  25 # include <sys/stat.h>
  26 #endif
  27
  28 #include "rexx.h"
  29
  30 #if defined(MAC)
  31 # include "mac.h"
  32 #else
  33 # if defined(VMS)
  34 #  include <stat.h>
  35 # else
  36 #  include <sys/stat.h>
  37 #  ifdef HAVE_UNISTD_H
  38 #   include <unistd.h>
  39 #  endif
  40 # endif
  41 #endif
  42
  43 #include <stdio.h>
  44 #ifdef HAVE_ASSERT_H
  45 # include <assert.h>
  46 #endif
  47
  48 #if defined(__WATCOMC__) && !defined(__QNX__)
  49 # include <dos.h>
  50 #endif
  51
  52 #if defined(WIN32)
  53 # ifdef _MSC_VER
  54 #  if _MSC_VER >= 1100
  55 /* Stupid MSC can't compile own headers without warning at least in VC 5.0 */
  56 #   pragma warning(disable: 4115 4201 4214 4514)
  57 #  endif
  58 # endif
  59 # include <windows.h>
  60 # ifdef _MSC_VER
  61 #  if _MSC_VER >= 1100
  62 #   pragma warning(default: 4115 4201 4214)
  63 #  endif
  64 # endif
  65 #endif
  66
  67 /*
  68  * Since development of Ultrix has ceased, and they never managed to
  69  * fix a few things, we want to define a few things, just in order
  70  * to kill a few warnings ...
  71  */
  72 #if defined(FIX_PROTOS) && defined(FIX_ALL_PROTOS) && defined(ultrix)
  73    int fstat( int fd, struct stat *buf ) ;
  74    int stat( char *path, struct stat *buf ) ;
  75 #endif
  76
  77 streng *cms_sleep( tsd_t *TSD, cparamboxptr parms )
  78 {
  79    checkparam(  parms,  1,  1, "SLEEP" ) ;
  80 #if defined(WIN32) && (defined(_MSC_VER) || defined(__IBMC__) || defined(__BORLANDC__) || defined(__MINGW32__))
  81    Sleep( (int)((myatof(TSD,parms->value))*1000) ) ;
  82 #else
  83 #if defined(HAVE_USLEEP)
  84    usleep( (int)((myatof(TSD,parms->value))*1000*1000) ) ;
  85 #else
  86    sleep( atozpos( TSD, parms->value, "SLEEP", 1 ) ) ;
  87 #endif
  88 #endif
  89    return nullstringptr() ;
  90 }
  91
  92
  93 streng *cms_makebuf( tsd_t *TSD, cparamboxptr parms )
  94 {
  95    checkparam(  parms,  0,  0 , "MAKEBUF" ) ;
  96    return int_to_streng( TSD,make_buffer( TSD )) ;
  97 }
  98
  99
 100
 101 streng *cms_justify( tsd_t *TSD, cparamboxptr parms )
 102 {
 103    int inspace=0, i=0, count=0, between=0, extra=0, initial=0;
 104    int spaces=0, chars=0, length=0 ;
 105    char *cend=NULL, *cp=NULL, *cptr=NULL, *out=NULL, *oend=NULL ;
 106    char pad=' ' ;
 107    streng *result=NULL ;
 108
 109    checkparam(  parms,  2,  3 , "JUSTIFY" ) ;
 110
 111    cptr = parms->value->value ;
 112    cend = cptr + parms->value->len ;
 113
 114    length = atozpos( TSD, parms->next->value, "JUSTIFY", 2 ) ;
 115    if (parms->next->next && parms->next->next->value)
 116       pad = getonechar( TSD, parms->next->next->value, "JUSTIFY", 3 ) ;
 117    else
 118       pad = ' ' ;
 119
 120    inspace = 1 ;
 121    spaces = 0 ;
 122    chars = 0 ;
 123    for (cp=cptr; cp<cend; cp++)
 124    {
 125       if (inspace)
 126       {
 127          if (!rx_isspace(*cp))
 128          {
 129             chars++ ;
 130             inspace = 0 ;
 131          }
 132       }
 133       else
 134       {
 135          if (!rx_isspace(*cp))
 136             chars++ ;
 137          else
 138          {
 139             spaces++ ;
 140             inspace = 1 ;
 141          }
 142       }
 143    }
 144
 145    if (inspace && spaces)
 146       spaces-- ;
 147
 148    result = Str_makeTSD( length ) ;
 149    if (chars+spaces>length || spaces==0)
 150    {
 151       between = 1 ;
 152       extra = 0 ;
 153       initial = 0 ;
 154    }
 155    else
 156    {
 157       extra = (length - chars) % spaces ;
 158       between = (length - chars) / spaces ;
 159       initial = (spaces - extra) / 2 ;
 160    }
 161
 162    count = 0 ;
 163    out = result->value ;
 164    oend = out + length ;
 165    cp = cptr ;
 166    for (; cp<cend && rx_isspace(*cp); cp++) ;
 167    for (; cp<cend && out<oend; cp++)
 168    {
 169       if (rx_isspace(*cp))
 170       {
 171          for (;cp<cend && rx_isspace(*cp); cp++) ;
 172          for (i=0; i<between && out<oend; i++)
 173             *(out++) = pad ;
 174          if (count<initial)
 175             count++ ;
 176          else if (extra && out<oend)
 177          {
 178             extra-- ;
 179             *(out++) = pad ;
 180          }
 181          if (out<oend)
 182             *(out++) = *cp ;
 183       }
 184       else
 185          *(out++) = *cp ;
 186    }
 187
 188    for (; out<oend; out++)
 189       *out = pad ;
 190
 191    assert( out - result->value == length ) ;
 192    result->len = length ;
 193
 194    return result ;
 195 }
 196
 197
 198
 199 streng *cms_find( tsd_t *TSD, cparamboxptr parms )
 200 {
 201    parambox newparms[3];
 202
 203    checkparam(  parms,  2,  3 , "FIND" ) ;
 204
 205    /* Rebuild parms but switch the first two parameters */
 206
 207    memset(newparms, 0, sizeof(newparms) ) ; /* sets dealloc to 0, too */
 208    newparms[0].value = parms->next->value;
 209    newparms[0].next  = newparms + 1;
 210    newparms[1].value = parms->value;
 211    if (parms->next->next)
 212       {
 213          newparms[1].next  = newparms + 2;
 214          newparms[2].value  = parms->next->next->value;
 215       }
 216
 217    return std_wordpos( TSD, newparms ) ;
 218 }
 219
 220
 221 streng *cms_index( tsd_t *TSD, cparamboxptr parms )
 222 {
 223    parambox newparms[3];
 224
 225    checkparam(  parms,  2,  3 , "INDEX" ) ;
 226
 227    /* Rebuild parms but switch the first two parameters */
 228
 229    memset(newparms, 0, sizeof(newparms) ) ; /* sets dealloc to 0, too */
 230    newparms[0].value = parms->next->value;
 231    newparms[0].next  = newparms + 1;
 232    newparms[1].value = parms->value;
 233    if (parms->next->next)
 234       {
 235          newparms[1].next  = newparms + 2;
 236          newparms[2].value  = parms->next->next->value;
 237       }
 238
 239    return std_pos( TSD, newparms ) ;
 240 }
 241
 242 streng *cms_desbuf( tsd_t *TSD, cparamboxptr parms )
 243 {
 244    checkparam(  parms,  0,  0 , "DESBUF" ) ;
 245    return( int_to_streng( TSD,drop_buffer( TSD, 0))) ;
 246 }
 247
 248
 249 streng *cms_buftype( tsd_t *TSD, cparamboxptr parms )
 250 {
 251    checkparam(  parms,  0,  0 , "BUFTYPE" ) ;
 252    type_buffer( TSD ) ;
 253    return (nullstringptr()) ;
 254 }
 255
 256
 257 streng *cms_dropbuf( tsd_t *TSD, cparamboxptr parms )
 258 {
 259    int buffer=(-1) ;
 260
 261    checkparam(  parms,  0,  1 , "DROPBUF" ) ;
 262    if (parms->value)
 263       buffer = myatol(TSD, parms->value) ;
 264
 265    return( int_to_streng( TSD,drop_buffer(TSD, buffer))) ;
 266 }
 267
 268
 269 #ifdef HAS_SCANDIR
 270 /* this part of the code is not used */
 271
 272 static int select_file( const struct direct *entry )
 273 {
 274    return !(strcmp(entry->d_name,filename)) ;
 275 }
 276
 277
 278 streng *cms_state( tsd_t *TSD, cparamboxptr parms )
 279 {
 280    struct direct *names=NULL ;
 281    int last=0, result=0 ;
 282    char *dir=NULL, *string=NULL, *retval=NULL ;
 283
 284    checkparam(  parms,  1,  1 , "STATE" ) ;
 285    last = strlen(string=parms->value) ;
 286    for (;(string[last]!=FILE_SEPARATOR)&&(last>0);last--) ;
 287    if (last)
 288    {
 289       string[last] = '\000' ;
 290       dir = string ;
 291    }
 292    else
 293       dir = "." ;
 294
 295    result = scandir(dir,&names,&select_file,NULL) ;
 296    if (last)
 297       string[last] = FILE_SEPARATOR ;
 298
 299    /* Ought to open or stat the file to check if it is readable */
 300
 301    return int_to_streng( TSD,result==1) ;
 302 }
 303 #else
 304
 305
 306 streng *cms_state( tsd_t *TSD, cparamboxptr parms )
 307 {
 308    /* this is a bit too easy ... but STREAM() function should handle it */
 309    int rcode=0 ;
 310    struct stat buffer ;
 311    char *fn;
 312
 313    checkparam(  parms,  1,  1 , "STATE" ) ;
 314
 315    /* will generate warning under Ultrix, don't care */
 316    fn = str_of(TSD,parms->value);
 317    rcode = stat( fn, &buffer ) ;
 318    FreeTSD(fn);
 319    return int_to_streng( TSD,rcode!=0) ;
 320
 321 }
 322 #endif
 323