regina/cmsfuncs.c

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