1 unit utility; { DPL 2004-03-22 }
2
3 { Utilities, mainly aids to parsing }
4
5 interface
6
equalsIgnoreCasenull7 function equalsIgnoreCase(s1, s2: string): boolean;
startsWithIgnoreCasenull8 function startsWithIgnoreCase(s1, s2: string): boolean;
endsWithnull9 function endsWith(s1, s2: string): boolean;
startsWithBracedWordnull10 function startsWithBracedWord (P: string): boolean;
GetNextWordnull11 function GetNextWord (var s: string; Delim, Term: char): string;
NextWordnull12 function NextWord (s: string; Delim, Term: char): string;
wordCountnull13 function wordCount (s: string): integer;
pluralnull14 function plural (n: integer): string;
curtailnull15 function curtail (var s: string; c: char): integer;
16 { Remove last character if it equals c and return its position;
17 otherwise return 0 }
toStringnull18 function toString(n: integer): string;
19 procedure trim(var s: string);
digitnull20 function digit(c: char): integer;
matchnull21 function match(source, pattern: string): boolean;
translatenull22 function translate(source, pattern, target: string): string;
23 procedure grep(var source, pattern, target: string);
24 { See Implementation for what this currently does. }
25
26 implementation uses strings;
27
28 const blank = ' '; dummy = #0;
29
wordCountnull30 function wordCount (s: string): integer;
31 var i, n: integer;
32 begin if length(s)=0 then
33 begin wordCount:=0; exit; end;
34 if s[1]=blank then n:=0 else n:=1;
35 for i:=1 to length(s)-1 do
36 if (s[i]=blank) and (s[i+1]<>blank) then inc(n);
37 wordCount:=n;
38 end;
39
GetNextWordnull40 function GetNextWord (var s: string; Delim, Term: char): string;
41 { A delimiter is a character that separates words, but forms no part
42 of them. A terminator is a character that appears at the end of
43 a word. }
44 var n, start, last: integer;
45 begin last:=length(s); n:=1;
46 while (n<=last) and (s[n] = Delim) do inc(n);
47 start:=n;
48 while (n<=last) and not (s[n] in [Delim,Term]) do inc(n);
49 if (n<=last) and (s[n] = Term) then inc(n);
50 GetNextWord:=substr(s,start,n-start);
51 while (n<=last) and (s[n] = Delim) do inc(n);
52 predelete(s,n-1);
53 end;
54
NextWordnull55 function NextWord (s: string; Delim, Term: char): string;
56 begin NextWord:=GetNextWord(s,Delim,Term); end;
57
pluralnull58 function plural (n: integer): string;
59 begin if n=1 then plural:='' else plural:='s'; end;
60
curtailnull61 function curtail (var s: string; c: char): integer;
62 var l: integer;
63 begin l:=length(s); curtail:=0;
64 if s[l]=c then begin shorten(s,l-1); curtail:=l; end;
65 end;
66
toStringnull67 function toString(n: integer): string;
68 var s: string;
69 begin str(n,s); toString:=s; end;
70
digitnull71 function digit(c: char): integer;
72 begin digit:=ord(c)-ord('0'); end;
73
equalsIgnoreCasenull74 function equalsIgnoreCase(s1, s2: string): boolean;
75 begin toUpper(s1); toUpper(s2); equalsIgnoreCase:=s1=s2;
76 end;
77
startsWithIgnoreCasenull78 function startsWithIgnoreCase(s1, s2: string): boolean;
79 begin toUpper(s1); toUpper(s2); startsWithIgnoreCase:=startsWith(s1,s2);
80 end;
81
startsWithBracedWordnull82 function startsWithBracedWord (P: string): boolean;
83 var w: string;
84 begin w := getNextWord(P,blank,dummy);
85 startsWithBracedWord := (w[1]='{') and (w[length(w)]='}');
86 end;
87
88 procedure trim(var s: string);
89 var k: integer;
90 begin k:=posnot(blank,s);
91 if k>1 then predelete(s,k-1) else if k=0 then s:='';
92 end;
93
endsWithnull94 function endsWith(s1, s2: string): boolean;
95 var l1, l2: integer;
96 begin l1:=length(s1); l2:=length(s2);
97 if l1<l2 then begin endsWith:=false; exit end;
98 predelete(s1,l1-l2); endsWith:=s1=s2
99 end;
100
101 {--- Match/Replace package --- }
102
103 { Search and replace. Stops when pattern no longer matches source.
104 Pattern wildcards:
105 ? Any single character
106 * Any string
107 # An unsigned integer
108 ## A signed integer
109 ### A signed number maybe with a decimal part
110 Pattern metacharacters:
111 \x where x is any character, stands for that character
112 Target wildcards
113 \0 to \9 Value of corresponding source wildcard
114 Target metacharacters
115 \ When not followed by 0..9 or \, stands for itself
116 \\ Backslash
117 }
118 procedure grep(var source, pattern, target: string);
119 var p1, p2: array[0..9] of integer;
120 i, j, p, s, t, index, reg: integer;
121 product: string;
122 trigger, matching: boolean;
123 procedure remember(s1, s2: integer);
124 begin if index>9 then halt(9999);
125 p1[index] := s1; p2[index] := s2; s := s2+1; inc(index)
126 end;
127 procedure matchnum;
128 var allowsign, allowpoint, quit: boolean;
129 s0: integer;
130 begin allowsign := false; allowpoint := false; matching := false; s0 := s;
131 if p<length(pattern) then if pattern[p+1]='#' then
132 begin inc(p); allowsign := true;
133 if p<length(pattern) then if pattern[p+1]='#' then
134 begin inc(p); allowpoint := true end
135 end;
136 if allowsign and ((source[s]='-') or (source[s]='+')) then
137 begin inc(s); if s>length(source) then exit end;
138 quit := false;
139 while (not quit) and (s<=length(source)) do
140 begin if source[s]='.' then if not allowpoint then quit := true else
141 begin inc(s); allowpoint := false end;
142 if (source[i]>='0') and (source[i]<='9') then
143 begin inc(s); matching := true end
144 else quit := true
145 end;
146 if matching then remember(s0,s-1)
147 end;
148 procedure matchmeta;
149 begin if p<length(pattern) then inc(p);
150 if source[s]=pattern[p] then begin inc(s); inc(p) end
151 else matching := false
152 end;
153 procedure subgrep;
154 begin matching := true;
155 if pattern[p]='*' then begin remember(s,length(source)); inc(p) end
156 else if pattern[p]='?' then begin remember(s,s); inc(p) end
157 else if pattern[p]='#' then matchnum
158 else if pattern[p]='\' then matchmeta
159 else if source[s]=pattern[p] then begin inc(s); inc(p) end
160 else matching := false
161 end;
162 begin
163 index := 0; s := 1; p := 1;
164 for i:=0 to 9 do begin p1[i]:=1; p2[i]:=0 end;
165 while matching and (p<=length(pattern)) and (s<=length(source)) do subgrep;
166 product := ''; trigger := false;
167 for t:=1 to length(target) do if trigger then
168 begin reg := digit(target[t]); if (reg>=0) and (reg<=9) then
169 for j:=p1[reg] to p2[reg] do product := product + source[j]
170 else if target[t]='\' then product := product + '\'
171 else product := product + '\' + target[t];
172 trigger := false
173 end
174 else if (target[t]='\') and (t<length(target)) then trigger := true
175 else product := product + target[t];
176 source := substr(source,s,length(source));
177 pattern := substr(pattern,p,length(pattern));
178 target := product
179 end;
180
181
182 { "match" tests whether the source matches the pattern exactly }
matchnull183 function match(source, pattern: string): boolean;
184 const target: string = '';
185 begin grep(source, pattern, target);
186 match := (source='') and (pattern='')
187 end;
188
189 { "translate" replaces the pattern by the target in the source. }
translatenull190 function translate(source, pattern, target: string): string;
191 begin grep(source, pattern, target); translate := target;
192 end;
193
194 end.
195