rexx/src/rxstr.c

   1 /*
   2  * $Header$
   3  * $Log$
   4  * Revision 1.1  2001/04/04 05:43:39  wang
   5  * First commit: compiles on Linux, Amiga, Windows, Windows CE, generic gcc
   6  *
   7  * Revision 1.3  1999/11/26 13:13:47  bnv
   8  * Added: Windows CE support.
   9  * Changed: To use the new macros.
  10  *
  11  * Revision 1.2  1998/11/26 09:47:11  bnv
  12  * Changed: var 'match' in verify must be boolean
  13  *
  14  * Revision 1.1  1998/07/02 17:34:50  bnv
  15  * Initial revision
  16  *
  17  */
  18
  19 #ifdef __BORLANDC__
  20 #       include <dos.h>
  21 #endif
  22 #include <stdlib.h>
  23 #include <string.h>
  24
  25 #include <lerror.h>
  26 #include <lstring.h>
  27
  28 #include <rexx.h>
  29 #include <rxdefs.h>
  30 #include <interpre.h>
  31
  32 /* --------------------------------------------------------------- */
  33 /*  ABBREV(information,info[,length])                              */
  34 /* --------------------------------------------------------------- */
  35 /*  INDEX(haystack,needle[,start])                                 */
  36 /* --------------------------------------------------------------- */
  37 /*  FIND(string,phrase[,start])                                    */
  38 /* --------------------------------------------------------------- */
  39 /*  LASTPOS(needle,haystack[,start])                               */
  40 /* --------------------------------------------------------------- */
  41 /*  POS(needle,haystack[,start])                                   */
  42 /* --------------------------------------------------------------- */
  43 /*  WORDPOS(phrase,string[,start])                                 */
  44 /* --------------------------------------------------------------- */
  45 void
  46 R_SSoI( const int func )
  47 {
  48         long    l;
  49
  50         if (!IN_RANGE(2,ARGN,3))
  51                 Lerror(ERR_INCORRECT_CALL,0);
  52         must_exist(1);
  53         must_exist(2);
  54         get_oi0(3,l);
  55
  56         switch (func) {
  57                 case f_abbrev:
  58                         Licpy(ARGR,Labbrev(ARG1,ARG2,l));
  59                         break;
  60
  61                 case f_index:
  62                         Licpy(ARGR,Lindex(ARG1,ARG2,l));
  63                         break;
  64
  65                 case f_find:
  66                         Licpy(ARGR,Lfind(ARG1,ARG2,l));
  67                         break;
  68
  69                 case f_lastpos:
  70                         Licpy(ARGR,Llastpos(ARG1,ARG2,l));
  71                         break;
  72
  73                 case f_pos:
  74                         Licpy(ARGR,Lpos(ARG1,ARG2,l));
  75                         break;
  76
  77                 case f_wordpos:
  78                         Licpy(ARGR,Lwordpos(ARG1,ARG2,l));
  79                         break;
  80
  81                 default:
  82                         Lerror(ERR_INTERPRETER_FAILURE,0);
  83         } /* switch */
  84 } /* R_SSoI */
  85
  86 /* --------------------------------------------------------------- */
  87 /*  CENTRE(string,length[,pad])                                    */
  88 /*  CENTER(string,length[,pad])                                    */
  89 /* --------------------------------------------------------------- */
  90 /*  JUSTIFY(string,length[,pad])                                   */
  91 /* --------------------------------------------------------------- */
  92 /*  LEFT(string,length[,pad])                                      */
  93 /* --------------------------------------------------------------- */
  94 /*  RIGHT(string,length[,pad])                                     */
  95 /* --------------------------------------------------------------- */
  96 void
  97 R_SIoC( const int func )
  98 {
  99         long    l;
 100         char    pad;
 101
 102         if (!IN_RANGE(2,ARGN,3))
 103                 Lerror(ERR_INCORRECT_CALL,0);
 104
 105         must_exist(1);
 106         get_i0(2,l);
 107         get_pad(3,pad);
 108
 109         switch (func) {
 110                 case f_center:
 111                         Lcenter(ARGR,ARG1,l,pad);
 112                         break;
 113
 114                 case f_justify:
 115                         Ljustify(ARGR,ARG1,l,pad);
 116                         break;
 117
 118                 case f_left:
 119                         Lleft(ARGR,ARG1,l,pad);
 120                         break;
 121
 122                 case f_right:
 123                         Lright(ARGR,ARG1,l,pad);
 124                         break;
 125
 126                 default:
 127                         Lerror(ERR_INTERPRETER_FAILURE,0);
 128         } /* of switch */
 129 } /* R_SIoC */
 130
 131 /* --------------------------------------------------------------- */
 132 /*  B2X(string)                                                    */
 133 /* --------------------------------------------------------------- */
 134 /*  C2X(string)                                                    */
 135 /* --------------------------------------------------------------- */
 136 /*  GETENV(string)                                                 */
 137 /* --------------------------------------------------------------- */
 138 /*  LENGTH(string)                                                 */
 139 /* --------------------------------------------------------------- */
 140 /*  WORDS(string)                                                  */
 141 /* --------------------------------------------------------------- */
 142 /*  REVERSE(string)                                                */
 143 /* --------------------------------------------------------------- */
 144 /*  SYMBOL(name)                                                   */
 145 /* --------------------------------------------------------------- */
 146 /*  X2B(string)                                                    */
 147 /* --------------------------------------------------------------- */
 148 /*  X2C(string)                                                    */
 149 /* --------------------------------------------------------------- */
 150 /* -- WIN32_WCE -------------------------------------------------- */
 151 /*  A2U(string)                                                    */
 152 /* --------------------------------------------------------------- */
 153 /*  U2A(string)                                                    */
 154 /* --------------------------------------------------------------- */
 155 void
 156 R_S( const int func )
 157 {
 158         Lstr    str;
 159         int     found;
 160
 161         if (ARGN!=1) Lerror(ERR_INCORRECT_CALL,0);
 162         L2STR(ARG1);
 163
 164         switch (func) {
 165                 case f_b2x:
 166                         Lb2x(ARGR,ARG1);
 167                         break;
 168
 169                 case f_c2x:
 170                         Lc2x(ARGR,ARG1);
 171                         break;
 172
 173 #ifndef WCE
 174                 case f_getenv:
 175                         {
 176                                 char    *env;
 177                                 LASCIIZ(*ARG1);
 178                                 env = getenv(LSTR(*ARG1));
 179                                 if (env)
 180                                         Lscpy( ARGR, env);
 181                                 else
 182                                         LZEROSTR(*ARGR);
 183                         }
 184                         break;
 185 #endif
 186
 187                 case f_length:
 188                         Licpy(ARGR, LLEN(*ARG1));
 189                         break;
 190
 191                 case f_words:
 192                         Licpy(ARGR, Lwords(ARG1));
 193                         break;
 194
 195                 case f_reverse:
 196                         Lstrcpy(ARGR,ARG1);
 197                         Lreverse(ARGR);
 198                         break;
 199
 200                 case f_soundex:
 201                         Lsoundex(ARGR,ARG1);
 202                         break;
 203
 204                 case f_symbol:
 205                         if (Ldatatype(ARG1,'S')==0) {
 206                                 Lscpy(ARGR,"BAD");
 207                                 return;
 208                         }
 209                         LINITSTR(str); Lfx(&str,LLEN(*ARG1));
 210                         Lstrcpy(&str,ARG1);
 211                         Lupper(&str); LASCIIZ(str);
 212                         RxVarFindOld(_Proc[_rx_proc].scope,&str,&found);
 213                         LFREESTR(str);
 214                         if (found)
 215                                 Lscpy(ARGR,"VAR");
 216                         else
 217                                 Lscpy(ARGR,"LIT");
 218                         break;
 219
 220                 case f_x2b:
 221                         Lx2b(ARGR,ARG1);
 222                         break;
 223
 224                 case f_x2c:
 225                         Lx2c(ARGR,ARG1);
 226                         break;
 227
 228 #ifdef WCE
 229                 case f_a2u:
 230                         {
 231                                 size_t  len = LLEN(*ARG1);
 232                                 Lfx(ARGR,2*len+2);
 233                                 LASCIIZ(*ARG1);
 234                                 mbstowcs((TCHAR*)(LSTR(*ARGR)), LSTR(*ARG1), len+1);
 235                                 LLEN(*ARGR) = 2*len;
 236                                 LTYPE(*ARGR) = LSTRING_TY;
 237                         }
 238                         break;
 239
 240                 case f_u2a:
 241                         {
 242                                 size_t  len = LLEN(*ARG1)/2;
 243                                 Lfx(ARGR,len);
 244                                 wcstombs(LSTR(*ARGR), (TCHAR*)(LSTR(*ARG1)), len);
 245                                 LLEN(*ARGR) = len;
 246                                 LTYPE(*ARGR) = LSTRING_TY;
 247                         }
 248                         break;
 249 #endif
 250
 251                 default:
 252                         Lerror(ERR_INTERPRETER_FAILURE,0);
 253         } /* switch */
 254 } /* R_S */
 255 /* --------------------------------------------------------------- */
 256 /*  DELSTR(string,n[,length])                                      */
 257 /* --------------------------------------------------------------- */
 258 /*  DELWORD(string,n[,length])                                     */
 259 /* --------------------------------------------------------------- */
 260 /*  SUBWORD(string,n[,length])                                     */
 261 /* --------------------------------------------------------------- */
 262 void
 263 R_SIoI( const int func )
 264 {
 265         long    n,l;
 266
 267         if (!IN_RANGE(2,ARGN,3))
 268                 Lerror(ERR_INCORRECT_CALL,0);
 269         must_exist(1);
 270         get_i(2,n);
 271         get_oiv(3,l,-1);
 272
 273         switch (func) {
 274                 case f_delstr:
 275                         Ldelstr(ARGR,ARG1,n,l);
 276                         break;
 277
 278                 case f_delword:
 279                         Ldelword(ARGR,ARG1,n,l);
 280                         break;
 281
 282                 case f_subword:
 283                         Lsubword(ARGR,ARG1,n,l);
 284                         break;
 285
 286                 default:
 287                         Lerror(ERR_INTERPRETER_FAILURE,0);
 288         } /* switch */
 289 } /* R_SIoI */
 290
 291 /* --------------------------------------------------------------- */
 292 /*  INSERT(new,target[,[n][,[length][,pad]]])                      */
 293 /* --------------------------------------------------------------- */
 294 /*  OVERLAY(new,target[,[n][,[length][,pad]]])                     */
 295 /* --------------------------------------------------------------- */
 296 void
 297 R_SSoIoIoC( const int func )
 298 {
 299         long    n,l;
 300         char    pad;
 301
 302         if (!IN_RANGE(2,ARGN,5))
 303                 Lerror(ERR_INCORRECT_CALL,0);
 304         must_exist(1);
 305         must_exist(2);
 306         get_oi0(3,n);
 307         get_oiv(4,l,-1);
 308         get_pad(5,pad);
 309
 310         switch (func) {
 311                 case f_insert:
 312                         Linsert(ARGR,ARG1,ARG2,n,l,pad);
 313                         break;
 314
 315                 case f_overlay:
 316                         Loverlay(ARGR,ARG1,ARG2,n,l,pad);
 317                         break;
 318
 319                 default:
 320                         Lerror(ERR_INTERPRETER_FAILURE,0);
 321         } /* switch */
 322 } /* R_SSoIoIoC */
 323
 324 /* --------------------------------------------------------------- */
 325 /*  CHANGESTR(searchstr,string,replacestr)                         */
 326 /* --------------------------------------------------------------- */
 327 void
 328 R_changestr( )
 329 {
 330         if (ARGN != 3)
 331                 Lerror(ERR_INCORRECT_CALL,0);
 332         must_exist(1);
 333         must_exist(2);
 334         must_exist(3);
 335         Lchangestr(ARGR,ARG1,ARG2,ARG3);
 336 } /* R_changestr */
 337
 338 /* --------------------------------------------------------------- */
 339 /*  COMPARE(string1,string2[,pad])                                 */
 340 /* --------------------------------------------------------------- */
 341 void
 342 R_compare( )
 343 {
 344         char    pad;
 345
 346         if (!IN_RANGE(2,ARGN,3))
 347                 Lerror(ERR_INCORRECT_CALL,0);
 348         must_exist(1);
 349         must_exist(2);
 350         get_pad(3,pad);
 351
 352         Licpy(ARGR, Lcompare(ARG1,ARG2,pad));
 353 } /* R_compare */
 354
 355 /* --------------------------------------------------------------- */
 356 /*  COPIES(string,n)                                               */
 357 /* --------------------------------------------------------------- */
 358 void
 359 R_copies( )
 360 {
 361         long    n;
 362
 363         if (ARGN != 2)
 364                 Lerror(ERR_INCORRECT_CALL,0);
 365         must_exist(1);
 366         must_exist(2); n = Lrdint(ARG2);
 367         if (n<0) Lerror(ERR_INCORRECT_CALL,0);
 368
 369         Lcopies(ARGR,ARG1,n);
 370 } /* R_copies */
 371
 372 /* --------------------------------------------------------------- */
 373 /*  SUBSTR(string,n[,[length][,pad]])                              */
 374 /* --------------------------------------------------------------- */
 375 void
 376 R_substr( )
 377 {
 378         long    n,l;
 379         char    pad;
 380
 381         if (!IN_RANGE(2,ARGN,4))
 382                 Lerror(ERR_INCORRECT_CALL,0);
 383         must_exist(1);
 384         get_i(2,n);
 385         get_oiv(3,l,-1);
 386         get_pad(4,pad);
 387
 388         Lsubstr(ARGR,ARG1,n,l,pad);
 389 } /* R_substr */
 390
 391 /* --------------------------------------------------------------- */
 392 /*  STRIP(string[,[<"L"|"T"|"B">][,char]])                         */
 393 /* --------------------------------------------------------------- */
 394 void
 395 R_strip( )
 396 {
 397         char    action='B';
 398         char    pad;
 399
 400         if (!IN_RANGE(1,ARGN,3))
 401                 Lerror(ERR_INCORRECT_CALL,0);
 402
 403         must_exist(1);
 404         if (exist(2)) { L2STR(ARG2); action = l2u[(byte)LSTR(*ARG2)[0]]; }
 405         get_pad(3,pad);
 406         Lstrip(ARGR,ARG1,action,pad);
 407 } /* R_strip */
 408
 409 /* --------------------------------------------------------------- */
 410 /*  TRANSLATE(string(,(tableo)(,(tablei)(,pad))))                  */
 411 /* --------------------------------------------------------------- */
 412 void
 413 R_translate( )
 414 {
 415         char    pad;
 416         PLstr   tableo,tablei;
 417
 418         if (!IN_RANGE(1,ARGN,4))
 419                 Lerror(ERR_INCORRECT_CALL,0);
 420
 421         must_exist(1);
 422
 423         if (ARGN==1) {
 424                 Lstrcpy(ARGR,ARG1);
 425                 Lupper(ARGR);
 426                 return;
 427         }
 428
 429         if (exist(2))
 430                 tableo = ARG2;
 431         else
 432                 tableo = NULL;
 433
 434         if (exist(3))
 435                 tablei = ARG3;
 436         else
 437                 tablei = NULL;
 438
 439         get_pad(4,pad);
 440
 441         Ltranslate(ARGR,ARG1,tableo,tablei,pad);
 442 } /* R_translate */
 443
 444 /* --------------------------------------------------------------- */
 445 /*  VERIFY(string,reference[,[option][,start]])                    */
 446 /* --------------------------------------------------------------- */
 447 void
 448 R_verify( )
 449 {
 450         bool    match=FALSE;
 451         long    start;
 452
 453         if (!IN_RANGE(2,ARGN,4))
 454                 Lerror(ERR_INCORRECT_CALL,0);
 455
 456         must_exist(1);
 457         must_exist(2);
 458         if (exist(3)) {
 459                 L2STR(ARG3);
 460                 match = (l2u[(byte)LSTR(*ARG3)[0]] == 'M');
 461         }
 462         get_oi(4,start);
 463         Licpy(ARGR,Lverify(ARG1,ARG2,match,start));
 464 } /* R_verify */
 465
 466 /* --------------------------------------------------------------- */
 467 /*  COUNTSTR(target,string)                                        */
 468 /* --------------------------------------------------------------- */
 469 /*  PUTENV(var,value)                                              */
 470 /* --------------------------------------------------------------- */
 471 void
 472 R_SS( int type )
 473 {
 474         if (ARGN!=2)
 475                 Lerror(ERR_INCORRECT_CALL,0);
 476
 477         must_exist(1);
 478         must_exist(2);
 479 #ifndef WCE
 480         if (type==f_countstr)
 481 #endif
 482                 Licpy(ARGR,Lcountstr(ARG1,ARG2));
 483 #ifndef WCE
 484         else {
 485                 LASCIIZ(*ARG1);
 486                 LASCIIZ(*ARG2);
 487 #       ifdef HAS_SETENV
 488                 Licpy(ARGR,setenv(LSTR(*ARG1),LSTR(*ARG2),TRUE));
 489 #       else
 490                 {
 491                 Lstr    str;
 492                 LINITSTR(str);
 493                 Lstrcpy(&str,ARG1);
 494                 Lcat(&str,"=");
 495                 Lstrcpy(&str,ARG2);
 496                 LASCIIZ(str);
 497                 Licpy(ARGR,putenv(LSTR(str)));
 498                 LFREESTR(str);
 499                 }
 500 #       endif
 501         }
 502 #endif
 503 } /* R_SS */