libs/cpascal/StringLib.cp

   1 (* ============================================================= *)
   2 (* Preliminary library module for Gardens Point Component Pascal *)
   3 (* ============================================================= *)
   4
   5 MODULE StringLib; (* from GPM module StdStrings.mod kjg june 1989 *)
   6   IMPORT RTS;
   7
   8   CONST  nul = 0X;
   9
  10 (* ============================================================ *)
  11
  12   PROCEDURE CanAssignAll*(sLen : INTEGER;
  13                        IN dest : ARRAY OF CHAR) : BOOLEAN;
  14  (**  Check if an assignment is possible without truncation.
  15   *)
  16   BEGIN
  17     RETURN LEN(dest) > sLen; (* must leave room for nul *)
  18   END CanAssignAll;
  19
  20   PROCEDURE Assign*   (IN  src : ARRAY OF CHAR;
  21                        OUT dst : ARRAY OF CHAR);
  22  (**  Assign as much as possible of src to dst,
  23   *   leaving room for a terminating ASCII nul.
  24   *)
  25     VAR ix, hi : INTEGER;
  26         ch     : CHAR;
  27   BEGIN
  28     hi := MIN(LEN(src), LEN(dst)) - 1;
  29     FOR ix := 0 TO hi DO
  30       ch := src[ix];
  31       dst[ix] := ch;
  32       IF ch = nul THEN RETURN END;
  33     END;
  34    (*
  35     *  We have copied up to index "hi"
  36     *  without finding a nul in "src"
  37     *)
  38     dst[hi] := nul;
  39   END Assign;
  40
  41 (* ============================================================ *)
  42
  43   PROCEDURE CanExtractAll*(len : INTEGER;
  44                            sIx : INTEGER;
  45                            num : INTEGER;
  46                        OUT dst : ARRAY OF CHAR) : BOOLEAN;
  47  (**  Check if an extraction of "num" charcters,
  48   *   starting at source index "sIx" is possible.
  49   *)
  50   BEGIN
  51     RETURN  (sIx + num <= len) &
  52             (LEN(dst) > num);     (* leave room for nul *)
  53   END CanExtractAll;
  54
  55   PROCEDURE Extract*  (IN  src : ARRAY OF CHAR;
  56                            sIx : INTEGER;
  57                            num : INTEGER;
  58                        OUT dst : ARRAY OF CHAR);
  59  (**  Extract "num" characters starting at index "sIx".
  60   *   Result is truncated if either there are fewer characters
  61   *   left in the source, or the destination is too short.
  62   *)
  63     VAR ch  : CHAR;
  64         sLm : INTEGER;
  65         dLm : INTEGER;
  66         dIx : INTEGER;
  67   BEGIN
  68
  69     sLm := LEN(src$) - 1;  (* max index of source *)
  70     dLm := LEN(dst) - 1;   (* max index of dest.  *)
  71     IF sIx < 0 THEN RTS.Throw("StdStrings.Extract: Bad start index") END;
  72     IF num < 0 THEN RTS.Throw("StdStrings.Extract: Bad char. count") END;
  73
  74     IF sIx > sLm THEN dst[0] := nul; RETURN END;
  75     IF (sIx + num - 1) < sLm THEN sLm := sIx + num - 1 END;
  76
  77     dIx := 0;
  78     FOR sIx := sIx TO sLm DO
  79       IF dIx = dLm THEN dst[dIx] := nul; RETURN END;
  80       ch := src[sIx];
  81       dst[dIx] := ch;
  82       INC(dIx);
  83     END;
  84     dst[dIx] := nul;
  85   END Extract;
  86
  87 (* ============================================================ *)
  88
  89   PROCEDURE CanDeleteAll*( len : INTEGER;
  90                            sIx : INTEGER;
  91                            num : INTEGER) : BOOLEAN;
  92  (**  Check if "num" characters may be deleted starting
  93   *   from index "sIx", when len is the source length.
  94   *)
  95   BEGIN
  96     RETURN (sIx < len) & (sIx + num <= len);
  97   END CanDeleteAll;
  98
  99   PROCEDURE Delete*(VAR str : ARRAY OF CHAR;
 100                         sIx : INTEGER;
 101                         num : INTEGER);
 102     VAR sLm, mIx : INTEGER;
 103  (**  Delete "num" characters starting from index "sIx".
 104   *   Less characters are deleted if there are less
 105   *   than "num" characters after "sIx".
 106   *)
 107   BEGIN
 108     sLm := LEN(str$) - 1;
 109     IF sIx < 0 THEN RTS.Throw("StdStrings.Delete: Bad start index") END;
 110     IF num < 0 THEN RTS.Throw("StdStrings.Delete: Bad char. count") END;
 111
 112     (* post : lim is length of str *)
 113     IF sIx < sLm THEN (* else do nothing *)
 114       IF sIx + num <= sLm THEN (* else sIx is unchanged *)
 115         mIx := sIx + num;
 116         WHILE mIx <= sLm DO
 117           str[sIx] := str[mIx]; INC(sIx); INC(mIx);
 118         END;
 119       END;
 120       str[sIx] := nul;
 121     END;
 122   END Delete;
 123
 124
 125 (* ============================================================ *)
 126
 127   PROCEDURE CanInsertAll*(sLen : INTEGER;
 128                           sIdx : INTEGER;
 129                       VAR dest : ARRAY OF CHAR) : BOOLEAN;
 130  (**  Check if "sLen" characters may be inserted into "dest"
 131   *   starting from index "sIdx".
 132   *)
 133     VAR dLen : INTEGER;
 134         dCap : INTEGER;
 135   BEGIN
 136     dCap := LEN(dest)-1; (* max chars in destination string  *)
 137     dLen := LEN(dest$);  (* current chars in destination str *)
 138     RETURN (sIdx < dLen) &
 139            (dLen + sLen < dCap);
 140   END CanInsertAll;
 141
 142   PROCEDURE Insert*   (IN  src : ARRAY OF CHAR;
 143                            sIx : INTEGER;
 144                        VAR dst : ARRAY OF CHAR);
 145  (**  Insert "src" string into "dst" starting from index
 146   *   "sIx".  Less characters are inserted if there is not
 147   *   sufficient space in the destination.  The destination is
 148   *   unchanged if "sIx" is beyond the end of the initial string.
 149   *)
 150     VAR dLen, sLen, dCap, iEnd, cEnd : INTEGER;
 151         idx : INTEGER;
 152   BEGIN
 153     dCap := LEN(dst)-1;
 154     sLen := LEN(src$);
 155     dLen := LEN(dst$);  (* dst[dLen] is index of the nul *)
 156     IF sIx < 0 THEN RTS.Throw("StdStrings.Insert: Bad start index") END;
 157
 158     (* skip trivial case *)
 159     IF (sIx > dLen) OR (sLen = 0) THEN RETURN END;
 160
 161     iEnd := MIN(sIx + sLen,  dCap); (* next index after last insert position *)
 162     cEnd := MIN(dLen + sLen, dCap); (* next index after last string position *)
 163
 164     FOR idx := cEnd-1 TO iEnd BY -1 DO
 165        dst[idx]  := dst[idx-sLen];
 166     END;
 167
 168     FOR idx := 0 TO sLen - 1 DO
 169       dst[idx+sIx] := src[idx];
 170     END;
 171     dst[cEnd] := nul;
 172   END Insert;
 173
 174 (* ============================================================ *)
 175
 176   PROCEDURE CanReplaceAll*(len : INTEGER;
 177                            sIx : INTEGER;
 178                        VAR dst : ARRAY OF CHAR) : BOOLEAN;
 179  (**  Check if "len" characters may be replaced in "dst"
 180   *   starting from index "sIx".
 181   *)
 182   BEGIN
 183     RETURN len + sIx <= LEN(dst$);
 184   END CanReplaceAll;
 185
 186   PROCEDURE Replace*  (IN  src : ARRAY OF CHAR;
 187                            sIx : INTEGER;
 188                        VAR dst : ARRAY OF CHAR);
 189  (**  Insert the characters of "src" string into "dst" starting
 190   *   from index "sIx".  Less characters are replaced if the
 191   *   initial length of the destination string is insufficient.
 192   *   The string length of "dst" is unchanged.
 193   *)
 194     VAR dLen, sLen, ix : INTEGER;
 195   BEGIN
 196     dLen := LEN(dst$);
 197     sLen := LEN(src$);
 198     IF sIx >= dLen THEN RETURN END;
 199     IF sIx < 0 THEN RTS.Throw("StdStrings.Replace: Bad start index") END;
 200
 201     FOR ix := sIx TO MIN(sIx+sLen-1, dLen-1) DO
 202       dst[ix] := src[ix-sIx];
 203     END;
 204   END Replace;
 205
 206 (* ============================================================ *)
 207
 208   PROCEDURE CanAppendAll*(len : INTEGER;
 209                       VAR dst : ARRAY OF CHAR) : BOOLEAN;
 210  (**  Check if "len" characters may be appended to "dst"
 211   *)
 212     VAR dLen : INTEGER;
 213         dCap : INTEGER;
 214   BEGIN
 215     dCap := LEN(dst)-1; (* max chars in destination string  *)
 216     dLen := LEN(dst$);  (* current chars in destination str *)
 217     RETURN dLen + len <= dCap;
 218   END CanAppendAll;
 219
 220   PROCEDURE Append*(src : ARRAY OF CHAR;
 221                 VAR dst : ARRAY OF CHAR);
 222  (**  Append the characters of "src" string onto "dst".
 223   *   Less characters are appended if the length of the
 224   *   destination string is insufficient.
 225   *)
 226     VAR dLen, dCap, sLen : INTEGER;
 227         idx : INTEGER;
 228   BEGIN
 229     dCap := LEN(dst)-1; (* max chars in destination string  *)
 230     dLen := LEN(dst$);  (* current chars in destination str *)
 231     sLen := LEN(src$);
 232     FOR idx := 0 TO sLen-1 DO
 233       IF dLen = dCap THEN dst[dCap] := nul; RETURN END;
 234       dst[dLen] := src[idx]; INC(dLen);
 235     END;
 236     dst[dLen] := nul;
 237   END Append;
 238
 239 (* ============================================================ *)
 240
 241   PROCEDURE Capitalize*(VAR str : ARRAY OF CHAR);
 242     VAR ix : INTEGER;
 243   BEGIN
 244     FOR ix := 0 TO LEN(str$)-1 DO str[ix] := CAP(str[ix]) END;
 245   END Capitalize;
 246
 247 (* ============================================================ *)
 248
 249   PROCEDURE FindNext*    (IN  pat : ARRAY OF CHAR;
 250                           IN  str : ARRAY OF CHAR;
 251                               bIx : INTEGER;  (* Begin index *)
 252                           OUT fnd : BOOLEAN;
 253                           OUT pos : INTEGER);
 254  (**  Find the first occurrence of the pattern string "pat"
 255   *   in "str" starting the search from index "bIx".
 256   *   If no match is found "fnd" is set FALSE and "pos"
 257   *   is set to "bIx".  Empty patterns match everywhere.
 258   *)
 259     VAR pIx, sIx : INTEGER;
 260         pLn, sLn : INTEGER;
 261         sCh      : CHAR;
 262   BEGIN
 263     pos := bIx;
 264     pLn := LEN(pat$);
 265     sLn := LEN(str$);
 266
 267     (* first check that string extends to bIx *)
 268     IF bIx >= sLn - pLn THEN fnd := FALSE; RETURN END;
 269     IF pLn = 0 THEN fnd := TRUE; RETURN END;
 270     IF bIx < 0 THEN RTS.Throw("StdStrings.FindNext: Bad start index") END;
 271
 272     sCh := pat[0];
 273     FOR sIx := bIx TO sLn - pLn - 1 DO
 274       IF str[sIx] = sCh THEN (* possible starting point! *)
 275         pIx := 0;
 276         REPEAT
 277           INC(pIx);
 278           IF pIx = pLn THEN fnd := TRUE; pos := sIx; RETURN END;
 279         UNTIL str[sIx + pIx] # pat[pIx];
 280       END;
 281     END;
 282     fnd := FALSE;
 283   END FindNext;
 284
 285 (* ============================================================ *)
 286
 287   PROCEDURE FindPrev*(IN  pat : ARRAY OF CHAR;
 288                       IN  str : ARRAY OF CHAR;
 289                           bIx : INTEGER;  (* begin index *)
 290                       OUT fnd : BOOLEAN;
 291                       OUT pos : INTEGER);
 292
 293  (**  Find the previous occurrence of the pattern string "pat"
 294   *   in "str" starting the search from index "bIx".
 295   *   If no match is found "fnd" is set FALSE and "pos"
 296   *   is set to "bIx".  A pattern starting from "bIx" is found.
 297   *   Empty patterns match everywhere.
 298   *)
 299     VAR pIx, sIx : INTEGER;
 300         pLn, sLn : INTEGER;
 301         sCh      : CHAR;
 302   BEGIN
 303     pos := bIx;
 304     pLn := LEN(pat$);
 305     sLn := LEN(str$);
 306
 307     IF pLn = 0 THEN fnd := TRUE; RETURN END;
 308     IF pLn > sLn THEN fnd := FALSE; RETURN END;
 309     IF bIx < 0 THEN RTS.Throw("StdStrings.FindPrev: Bad start index") END;
 310
 311     (* start searching from bIx OR sLn - pLn *)
 312     sCh := pat[0];
 313     FOR sIx := MIN(bIx, sLn - pLn - 1) TO 0 BY - 1 DO
 314       IF str[sIx] = sCh THEN (* possible starting point! *)
 315         pIx := 0;
 316         REPEAT
 317           INC(pIx);
 318           IF pIx = pLn THEN fnd := TRUE; pos := sIx; RETURN END;
 319         UNTIL str[sIx + pIx] # pat[pIx];
 320       END;
 321     END;
 322     fnd := FALSE;
 323   END FindPrev;
 324
 325 (* ============================================================ *)
 326
 327   PROCEDURE FindDiff*   (IN  str1 : ARRAY OF CHAR;
 328                          IN  str2 : ARRAY OF CHAR;
 329                          OUT diff : BOOLEAN;
 330                          OUT dPos : INTEGER);
 331  (**  Find the index of the first charater of difference
 332   *   between the two input strings.  If the strings are
 333   *   identical "diff" is set FALSE, and "dPos" is zero.
 334   *)
 335     VAR ln1, ln2, idx : INTEGER;
 336   BEGIN
 337     ln1 := LEN(str1$);
 338     ln2 := LEN(str2$);
 339
 340     FOR idx := 0 TO MIN(ln1, ln2) DO
 341       IF str1[idx] # str2[idx] THEN
 342         diff := TRUE; dPos := idx; RETURN;   (* PRE-EMPTIVE RETURN *)
 343       END;
 344     END;
 345     dPos := 0;
 346     diff := (ln1 # ln2);  (* default result *)
 347   END FindDiff;
 348
 349 (* ============================================================ *)
 350 END StringLib.