#ifndef lint
static char *RCSid = "$Id: cmsfuncs.c,v 1.14 1993/05/10 06:07:22 anders Exp anders $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
    This code modified for Win32 port by Ataman Software, Inc. June 29, 1995.
*/

#include "rexx.h"
#ifdef VMS
# include <stat.h>
#elif defined(WIN32)
# include <sys/stat.h>
#else
# include <sys/stat.h>
# include <unistd.h>
#endif
#include <stdio.h>
#include <ctype.h>
#include <assert.h>
/*
 * Since development of Ultrix has ceased, and they never managed to 
 * fix a few things, we want to define a few things, just in order 
 * to kill a few warnings ...
 */
#if defined(FIX_PROTOS) && defined(FIX_ALL_PROTOS) && defined(ultrix)
   int fstat( int fd, struct stat *buf ) ;
   int stat( char *path, struct stat *buf ) ;
#endif




streng *cms_sleep( paramboxptr parms )
{
   checkparam( parms, 1, 1) ;
#ifdef HAS_USLEEP
   usleep( (int)((myatof(parms->value))*1000*1000) ) ;
#else
   sleep( atozpos( parms->value ) ) ;
#endif
   return nullstringptr() ;
}   


streng *cms_makebuf( paramboxptr parms )
{
   checkparam( parms, 0, 0 ) ;
   return int_to_streng(make_buffer()) ;
}



streng *cms_justify( paramboxptr parms ) 
{
   int inspace, i, count, between, extra, initial, spaces, chars, length ;
   char *cend, *cp, *cptr, *out, *oend ;
   char pad ;
   streng *result ;

   checkparam( parms, 2, 3 ) ;

   cptr = parms->value->value ;
   cend = cptr + parms->value->len ;

   length = atozpos( parms->next->value ) ;
   if (parms->next->next && parms->next->next->value)
      pad = getonechar( parms->next->next->value ) ;
   else
      pad = ' ' ;

   inspace = 1 ;
   spaces = 0 ;
   chars = 0 ;
   for (cp=cptr; cp<cend; cp++)
   {
      if (inspace)
      {
         if (!isspace(*cp))
         {
            chars++ ;
            inspace = 0 ;
         }
      }
      else
      {
         if (!isspace(*cp))
            chars++ ;
         else
         {
            spaces++ ;
            inspace = 1 ;
         }
      }
   }

   if (inspace && spaces)
      spaces-- ;

   result = Str_make( length ) ;
   if (chars+spaces>length || spaces==0)
   {
      between = 1 ;
      extra = 0 ;
      initial = 0 ;
   }
   else
   {
      extra = (length - chars) % spaces ;
      between = (length - chars) / spaces ;
      initial = (spaces - extra) / 2 ;
   }   

   count = 0 ;
   out = result->value ;
   oend = out + length ;
   cp = cptr ;
   for (; cp<cend && isspace(*cp); cp++) ;
   for (; cp<cend && out<oend; cp++)
   {
      if (isspace(*cp))
      {
         for (;cp<cend && isspace(*cp); cp++) ;
         for (i=0; i<between && out<oend; i++)
            *(out++) = pad ;
         if (count<initial)
            count++ ;
         else if (extra && out<oend)
         {
            extra-- ;
            *(out++) = pad ;
         }  
         if (out<oend)
            *(out++) = *cp ;
      }
      else
         *(out++) = *cp ;
   }
      
   for (; out<oend; out++)
      *out = pad ;

   assert( out - result->value == length ) ;
   result->len = length ;

   return result ;
}
            


streng *cms_find( paramboxptr parms )
{
   paramboxptr ptmp ;
   extern streng *std_wordpos( paramboxptr ) ;
  
   checkparam( parms, 2, 3 ) ;
   ptmp = parms->next ;
   parms->next = ptmp->next ;
   ptmp->next = parms ;

   return std_wordpos( ptmp ) ;
}

   
streng *cms_index( paramboxptr parms )
{
   paramboxptr ptmp ;
   extern streng *std_pos( paramboxptr ) ;

   checkparam( parms, 2, 3 ) ;
   ptmp = parms->next ;
   parms->next = ptmp->next ;
   ptmp->next = parms ;

   return std_pos( ptmp ) ;
}

streng *cms_desbuf( paramboxptr parms )
{
   checkparam( parms, 0, 0 ) ;
   return( int_to_streng(drop_buffer(0))) ;
}


streng *cms_buftype( paramboxptr parms )
{
   checkparam( parms, 0, 0 ) ;
   type_buffer() ;
   return (nullstringptr()) ;
}


streng *cms_dropbuf( paramboxptr parms )
{
   int buffer=(-1) ;

   checkparam( parms, 0, 1 ) ;
   if (parms->value)
      buffer = myatol(parms->value) ;

   return( int_to_streng(drop_buffer(buffer))) ;      
}
 

#ifdef HAS_SCANDIR
/* this part of the code is not used */
char *filename ;

int select_file( struct direct *entry )
{
   extern char *filename ;
   return !(strcmp(entry->d_name,filename)) ;
}


char *cms_state( paramboxptr parms ) 
{
   extern char *filename ;
   struct direct *names ;
   int last, result ;
   char *dir, *string, *retval ;

   checkparam( parms, 1, 1 ) ;
   last = strlen(string=parms->value) ;
   for (;(string[last]!=FILE_SEPARATOR)&&(last>0);last--) ;
   if (last) {
      string[last] = '\000' ;
      filename = &string[last+1] ;
      dir = string ; }
   else {
      dir = "." ;
      filename = &string[last] ; }

   result = scandir(dir,&names,&select_file,NULL) ;
   if (last)
      string[last] = FILE_SEPARATOR ;
   retval = Malloc(BOOL_STR_LENGTH) ;
   sprintf(retval,"%d",(result==1)) ;

   /* Ought to open or stat the file to check if it is readable */

   return retval ;
}
#else


streng *cms_state( paramboxptr parms )
{
   /* this is a bit too easy ... but STREAM() function should handle it */
   streng *retval ;
   int rcode ;
   struct stat buffer ;
   
   checkparam( parms, 1, 1 ) ;
   retval = Str_make( BOOL_STR_LENGTH ) ;

   /* will generate warning under Ultrix, don't care */   
   rcode = stat( Str_ify(parms->value)->value, &buffer ) ;
   return int_to_streng(rcode!=0) ;
   
}
#endif

