2 * The Regina Rexx Interpreter
3 * Copyright (C) 1992-1994 Anders Christensen <anders@pvv.unit.no>
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.
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.
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.
21 * Bug in LCC complier wchar.h that incorrectly says it defines stat struct
25 # include <sys/stat.h>
36 # include <sys/stat.h>
48 #if defined(__WATCOMC__) && !defined(__QNX__)
55 /* Stupid MSC can't compile own headers without warning at least in VC 5.0 */
56 # pragma warning(disable: 4115 4201 4214 4514)
62 # pragma warning(default: 4115 4201 4214)
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 ...
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
) ;
77 streng
*cms_sleep( tsd_t
*TSD
, cparamboxptr parms
)
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) ) ;
83 #if defined(HAVE_USLEEP)
84 usleep( (int)((myatof(TSD
,parms
->value
))*1000*1000) ) ;
86 sleep( atozpos( TSD
, parms
->value
, "SLEEP", 1 ) ) ;
89 return nullstringptr() ;
93 streng
*cms_makebuf( tsd_t
*TSD
, cparamboxptr parms
)
95 checkparam( parms
, 0, 0 , "MAKEBUF" ) ;
96 return int_to_streng( TSD
,make_buffer( TSD
)) ;
101 streng
*cms_justify( tsd_t
*TSD
, cparamboxptr parms
)
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
;
107 streng
*result
=NULL
;
109 checkparam( parms
, 2, 3 , "JUSTIFY" ) ;
111 cptr
= parms
->value
->value
;
112 cend
= cptr
+ parms
->value
->len
;
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 ) ;
123 for (cp
=cptr
; cp
<cend
; cp
++)
127 if (!rx_isspace(*cp
))
135 if (!rx_isspace(*cp
))
145 if (inspace
&& spaces
)
148 result
= Str_makeTSD( length
) ;
149 if (chars
+spaces
>length
|| spaces
==0)
157 extra
= (length
- chars
) % spaces
;
158 between
= (length
- chars
) / spaces
;
159 initial
= (spaces
- extra
) / 2 ;
163 out
= result
->value
;
164 oend
= out
+ length
;
166 for (; cp
<cend
&& rx_isspace(*cp
); cp
++) ;
167 for (; cp
<cend
&& out
<oend
; cp
++)
171 for (;cp
<cend
&& rx_isspace(*cp
); cp
++) ;
172 for (i
=0; i
<between
&& out
<oend
; i
++)
176 else if (extra
&& out
<oend
)
188 for (; out
<oend
; out
++)
191 assert( out
- result
->value
== length
) ;
192 result
->len
= length
;
199 streng
*cms_find( tsd_t
*TSD
, cparamboxptr parms
)
201 parambox newparms
[3];
203 checkparam( parms
, 2, 3 , "FIND" ) ;
205 /* Rebuild parms but switch the first two parameters */
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
)
213 newparms
[1].next
= newparms
+ 2;
214 newparms
[2].value
= parms
->next
->next
->value
;
217 return std_wordpos( TSD
, newparms
) ;
221 streng
*cms_index( tsd_t
*TSD
, cparamboxptr parms
)
223 parambox newparms
[3];
225 checkparam( parms
, 2, 3 , "INDEX" ) ;
227 /* Rebuild parms but switch the first two parameters */
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
)
235 newparms
[1].next
= newparms
+ 2;
236 newparms
[2].value
= parms
->next
->next
->value
;
239 return std_pos( TSD
, newparms
) ;
242 streng
*cms_desbuf( tsd_t
*TSD
, cparamboxptr parms
)
244 checkparam( parms
, 0, 0 , "DESBUF" ) ;
245 return( int_to_streng( TSD
,drop_buffer( TSD
, 0))) ;
249 streng
*cms_buftype( tsd_t
*TSD
, cparamboxptr parms
)
251 checkparam( parms
, 0, 0 , "BUFTYPE" ) ;
253 return (nullstringptr()) ;
257 streng
*cms_dropbuf( tsd_t
*TSD
, cparamboxptr parms
)
261 checkparam( parms
, 0, 1 , "DROPBUF" ) ;
263 buffer
= myatol(TSD
, parms
->value
) ;
265 return( int_to_streng( TSD
,drop_buffer(TSD
, buffer
))) ;
270 /* this part of the code is not used */
272 static int select_file( const struct direct
*entry
)
274 return !(strcmp(entry
->d_name
,filename
)) ;
278 streng
*cms_state( tsd_t
*TSD
, cparamboxptr parms
)
280 struct direct
*names
=NULL
;
281 int last
=0, result
=0 ;
282 char *dir
=NULL
, *string
=NULL
, *retval
=NULL
;
284 checkparam( parms
, 1, 1 , "STATE" ) ;
285 last
= strlen(string
=parms
->value
) ;
286 for (;(string
[last
]!=FILE_SEPARATOR
)&&(last
>0);last
--) ;
289 string
[last
] = '\000' ;
295 result
= scandir(dir
,&names
,&select_file
,NULL
) ;
297 string
[last
] = FILE_SEPARATOR
;
299 /* Ought to open or stat the file to check if it is readable */
301 return int_to_streng( TSD
,result
==1) ;
306 streng
*cms_state( tsd_t
*TSD
, cparamboxptr parms
)
308 /* this is a bit too easy ... but STREAM() function should handle it */
313 checkparam( parms
, 1, 1 , "STATE" ) ;
315 /* will generate warning under Ultrix, don't care */
316 fn
= str_of(TSD
,parms
->value
);
317 rcode
= stat( fn
, &buffer
) ;
319 return int_to_streng( TSD
,rcode
!=0) ;