Context Navigation

source: tags/1.5.0/Forms/UFormCheck.pas

Last change on this file was 186, checked in by chronos, 6 years ago
Modified: Faster substring searching with PosFromIndex function without unnecessary string copying.
File size: 13.4 KB

Line
1	unit UFormCheck;
2
3	{$mode delphi}
4
5	interface
6
7	uses
8	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9	ExtCtrls, ComCtrls, UAcronym, URegistry, Registry, UCommon;
10
11	type
12
13	{ TFormCheck }
14
15	TFormCheck = class(TForm)
16	ButtonLoadFromFile: TButton;
17	ButtonAcronymsContent: TButton;
18	ButtonAcronymsSummary: TButton;
19	ButtonCheck: TButton;
20	EditSummaryStart: TEdit;
21	EditSummaryEnd: TEdit;
22	GroupBox1: TGroupBox;
23	GroupBox2: TGroupBox;
24	Label1: TLabel;
25	Label2: TLabel;
26	LabelAcronymCountContent: TLabel;
27	LabelAcronymCountSummary: TLabel;
28	MemoDocument: TMemo;
29	MemoReport: TMemo;
30	OpenDialog1: TOpenDialog;
31	PageControl1: TPageControl;
32	Panel1: TPanel;
33	Panel2: TPanel;
34	Splitter1: TSplitter;
35	TabSheetSource: TTabSheet;
36	TabSheetReport: TTabSheet;
37	procedure ButtonAcronymsSummaryClick(Sender: TObject);
38	procedure ButtonAcronymsContentClick(Sender: TObject);
39	procedure ButtonCheckClick(Sender: TObject);
40	procedure ButtonLoadFromFileClick(Sender: TObject);
41	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
42	procedure FormCreate(Sender: TObject);
43	procedure FormDestroy(Sender: TObject);
44	procedure FormShow(Sender: TObject);
45	private
46	AcronymDbSummary: TAcronymDb;
47	AcronymDbContent: TAcronymDb;
48	LastDocumentFileName: string;
49	function SearchLine(Lines: TStrings; Text: string; Start: Integer = 0): Integer;
50	function SearchLineReverse(Lines: TStrings; Text: string; Start: Integer = -1): Integer;
51	procedure FindInSummary;
52	procedure FindInContent;
53	function ParseMeaning(Acronym, Text: string; StartIndex: Integer;
54	out Meaning: string; DashSeparator: Boolean = False): Boolean;
55	function IsUppercaseAlpha(Text: string): Boolean;
56	function IsAlpha(Text: string): Boolean;
57	procedure ReportDifferencies;
58	function WordContainsLetters(Text, Letters: string): Boolean;
59	public
60	procedure UpdateInterface;
61	procedure LoadConfig;
62	procedure SaveConfig;
63	end;
64
65	var
66	FormCheck: TFormCheck;
67
68
69	implementation
70
71	{$R *.lfm}
72
73	uses
74	UFormAcronyms, UCore;
75
76	resourcestring
77	SAcronymCountContent = 'Content acronym count:';
78	SAcronymCountSummary = 'Summary acronym count:';
79	SDuplicateAcronymContent = 'Duplicate acronym %s with "%s" in document content.';
80	SDuplicateAcronymSummary = 'Duplicate acronym %s with "%s" in acronym summary.';
81	SMissingAcronymContent = 'Content acronym %s with meaning "%s" missing from summary acronyms.';
82	SMissingAcronymSummary = 'Summary acronym %s with meaning "%s" missing from content acronyms.';
83
84
85	{ TFormCheck }
86
87	procedure TFormCheck.ButtonCheckClick(Sender: TObject);
88	begin
89	MemoReport.Lines.Clear;
90	FindInSummary;
91	FindInContent;
92	ReportDifferencies;
93	UpdateInterface;
94	TabSheetReport.Show;
95	end;
96
97	procedure TFormCheck.ButtonLoadFromFileClick(Sender: TObject);
98	begin
99	OpenDialog1.InitialDir := ExtractFileDir(LastDocumentFileName);
100	OpenDialog1.FileName := ExtractFileName(LastDocumentFileName);
101	if OpenDialog1.Execute then begin
102	LastDocumentFileName := OpenDialog1.FileName;
103	MemoDocument.Lines.LoadFromFile(OpenDialog1.FileName);
104	TabSheetSource.Show;
105	end;
106	end;
107
108	procedure TFormCheck.FormClose(Sender: TObject; var CloseAction: TCloseAction);
109	begin
110	Core.PersistentForm1.Save(Self);
111	end;
112
113	procedure TFormCheck.FormCreate(Sender: TObject);
114	begin
115	AcronymDbSummary := TAcronymDb.Create;
116	AcronymDbContent := TAcronymDb.Create;
117	Core.CoolTranslator1.TranslateComponentRecursive(Self);
118	Core.ThemeManager.UseTheme(Self);
119	end;
120
121	procedure TFormCheck.FormDestroy(Sender: TObject);
122	begin
123	AcronymDbSummary.Free;
124	AcronymDbContent.Free;
125	end;
126
127	procedure TFormCheck.FormShow(Sender: TObject);
128	begin
129	Core.PersistentForm1.Load(Self);
130	if FileExists(LastDocumentFileName) then MemoDocument.Lines.LoadFromFile(LastDocumentFileName);
131	UpdateInterface;
132	end;
133
134	procedure TFormCheck.ButtonAcronymsContentClick(Sender: TObject);
135	var
136	FormAcronyms: TFormAcronyms;
137	begin
138	FormAcronyms := TFormAcronyms.Create(Self);
139	try
140	FormAcronyms.Acronyms := AcronymDbContent.Acronyms;
141	FormAcronyms.ShowModal;
142	finally
143	FreeAndNil(FormAcronyms);
144	end;
145	end;
146
147	procedure TFormCheck.ButtonAcronymsSummaryClick(Sender: TObject);
148	var
149	FormAcronyms: TFormAcronyms;
150	begin
151	FormAcronyms := TFormAcronyms.Create(Self);
152	try
153	FormAcronyms.Acronyms := AcronymDbSummary.Acronyms;
154	FormAcronyms.ShowModal;
155	finally
156	FreeAndNil(FormAcronyms);
157	end;
158	end;
159
160	function TFormCheck.SearchLine(Lines: TStrings; Text: string; Start: Integer = 0): Integer;
161	begin
162	Result := Start;
163	while (Result < Lines.Count) and (Pos(Text, Lines[Result]) = 0) do Inc(Result);
164	if Result >= Lines.Count then Result := -1;
165	end;
166
167	function TFormCheck.SearchLineReverse(Lines: TStrings; Text: string;
168	Start: Integer = -1): Integer;
169	begin
170	if Start = -1 then Result := Lines.Count - 1
171	else Result := Start;
172	while (Result >= 0) and (Pos(Text, Lines[Result]) = 0) do Dec(Result);
173	end;
174
175	procedure TFormCheck.FindInSummary;
176	var
177	AcronymSectionStart: Integer;
178	AcronymSectionEnd: Integer;
179	I: Integer;
180	Line: string;
181	Acronym: string;
182	Meaning: string;
183	begin
184	AcronymDbSummary.Acronyms.Clear;
185
186	AcronymSectionStart := SearchLineReverse(MemoDocument.Lines, EditSummaryStart.Text);
187	if AcronymSectionStart <> -1 then begin
188	AcronymSectionEnd := SearchLine(MemoDocument.Lines, EditSummaryEnd.Text, AcronymSectionStart + 1);
189	if AcronymSectionEnd <> -1 then begin
190	for I := AcronymSectionStart + 1 to AcronymSectionEnd - 1 do begin
191	Line := Trim(MemoDocument.Lines[I]);
192	Line := StringReplace(Line, #9, ' ', [rfReplaceAll]);
193	if Line <> '' then begin
194	if Pos(' ', Line) > 0 then begin
195	Acronym := Copy(Line, 1, Pos(' ', Line) - 1);
196	if IsUppercaseAlpha(Acronym) then begin
197	Meaning := Trim(Copy(Line, Pos(' ', Line) + 1, Length(Line)));
198	if Assigned(AcronymDbSummary.SearchAcronym(Acronym, Meaning)) then
199	MemoReport.Lines.Add(Format(SDuplicateAcronymSummary, [Acronym, Meaning]))
200	else AcronymDbSummary.AddAcronym(Acronym, Meaning);
201	end;
202	end;
203	end;
204	end;
205	end;
206	end;
207	end;
208
209	procedure TFormCheck.FindInContent;
210	var
211	Text: string;
212	StartIndex: Integer;
213	EndIndex: Integer;
214	Acronym: string;
215	Meaning: string;
216	Meaning1: string;
217	Meaning2: string;
218	HasMeaning1: Boolean;
219	HasMeaning2: Boolean;
220	begin
221	AcronymDbContent.Acronyms.Clear;
222
223	// Find acronyms usage in text
224	Text := MemoDocument.Lines.Text;
225	Text := StringReplace(Text, #9, ' ', [rfReplaceAll]);
226	Text := StringReplace(Text, LineEnding, ' ', [rfReplaceAll]);
227	StartIndex := 1;
228	repeat
229	StartIndex := PosFromIndex('(', Text, StartIndex);
230	if StartIndex <> 0 then begin
231	EndIndex := PosFromIndex(')', Text, StartIndex);
232	if EndIndex <> 0 then begin
233	Acronym := Trim(Copy(Text, StartIndex + 1, EndIndex - StartIndex - 1));
234	if (Length(Acronym) > 1) and IsUppercaseAlpha(Acronym) then begin
235	HasMeaning1 := ParseMeaning(Acronym, Text, StartIndex - 1, Meaning1);
236	if HasMeaning1 then Meaning := Meaning1;
237	HasMeaning2 := ParseMeaning(Acronym, Text, StartIndex - 1, Meaning2, True);
238	if HasMeaning2 then Meaning := Meaning2;
239	if HasMeaning1 and HasMeaning2 then begin
240	if Length(Meaning1) > Length(Meaning2) then Meaning := Meaning1
241	else Meaning := Meaning2;
242	end;
243	if HasMeaning1 or HasMeaning2 then begin
244	if Assigned(AcronymDbContent.SearchAcronym(Acronym, Meaning)) then
245	MemoReport.Lines.Add(Format(SDuplicateAcronymContent, [Acronym, Meaning]))
246	else AcronymDbContent.AddAcronym(Acronym, Meaning);
247	end;
248	end;
249	end;
250	Inc(StartIndex);
251	end;
252	until StartIndex = 0;
253	end;
254
255	function TFormCheck.ParseMeaning(Acronym, Text: string; StartIndex: Integer;
256	out Meaning: string; DashSeparator: Boolean): Boolean;
257	var
258	StartIndex2: Integer;
259	StartIndex3: Integer;
260	StartIndex4: Integer;
261	LetterIndex: Integer;
262	OneWord: string;
263	WordLetterIndex: Integer;
264	WordCount: Integer;
265	WordCountWrong: Integer;
266	begin
267	Result := True;
268	Meaning := '';
269	StartIndex2 := StartIndex;
270	LetterIndex := Length(Acronym);
271	WordCount := 0;
272	WordCountWrong := 0;
273	while Length(Acronym) > 0 do begin
274	StartIndex3 := PosFromIndexReverse(' ', Text, StartIndex2);
275	if DashSeparator then begin
276	StartIndex4 := PosFromIndexReverse('-', Text, StartIndex2);
277	if StartIndex4 > StartIndex3 then StartIndex3 := StartIndex4;
278	end;
279
280	if StartIndex3 = 0 then Break;
281	OneWord := Copy(Text, StartIndex3 + 1, StartIndex2 - StartIndex3);
282	if OneWord = '$' then begin
283	// Avoid parsing Bash variables
284	Result := False;
285	Exit;
286	end;
287	if Trim(OneWord) = '' then begin
288	StartIndex2 := StartIndex3 - 1;
289	Continue;
290	end;
291	// Is first letter capital?
292	if (Length(OneWord) > 0) and IsAlpha(OneWord[1]) then begin
293	WordLetterIndex := PosFromIndexReverse(LowerCase(OneWord[1]), LowerCase(Copy(Acronym, 1, LetterIndex)), LetterIndex);
294	if WordLetterIndex > 0 then begin
295	// First letter was found in acronym
296	if WordLetterIndex <= LetterIndex then begin
297	if not WordContainsLetters(LowerCase(OneWord), LowerCase(Copy(Acronym, WordLetterIndex, LetterIndex - WordLetterIndex + 1))) then begin
298	Result := False;
299	Exit;
300	end;
301	LetterIndex := WordLetterIndex - 1;
302	end else begin
303	Dec(LetterIndex);
304	end;
305	WordCountWrong := 0;
306	end else begin
307	Inc(WordCountWrong);
308	if WordCountWrong > 1 then begin
309	Result := False;
310	Exit;
311	end;
312	end;
313	end else begin
314	Inc(WordCountWrong);
315	if WordCountWrong > 1 then begin
316	Result := False;
317	Exit;
318	end;
319	end;
320	StartIndex2 := StartIndex3 - 1;
321	if LetterIndex < 1 then Break;
322	Inc(WordCount);
323	if WordCount > 2 * Length(Acronym) then begin
324	// False acronym in braces with too much words
325	Result := False;
326	Exit;
327	end;
328	end;
329	Meaning := Trim(Copy(Text, StartIndex2 + 1, StartIndex - StartIndex2 - 1));
330	end;
331
332	function TFormCheck.IsUppercaseAlpha(Text: string): Boolean;
333	var
334	I: Integer;
335	begin
336	I := 1;
337	Result := True;
338	while (I <= Length(Text)) do begin
339	if not (Text[I] in ['A'..'Z']) then begin
340	Result := False;
341	Break;
342	end;
343	Inc(I);
344	end;
345	end;
346
347	function TFormCheck.IsAlpha(Text: string): Boolean;
348	var
349	I: Integer;
350	begin
351	I := 1;
352	Result := True;
353	while (I <= Length(Text)) do begin
354	if not (Text[I] in ['A'..'Z']) and not (Text[I] in ['a'..'z']) then begin
355	Result := False;
356	Break;
357	end;
358	Inc(I);
359	end;
360	end;
361
362	procedure TFormCheck.ReportDifferencies;
363	var
364	I: Integer;
365	J: Integer;
366	Acronym: TAcronym;
367	Meaning: TAcronymMeaning;
368	begin
369	for I := 0 to AcronymDbContent.Acronyms.Count - 1 do begin
370	Acronym := TAcronym(AcronymDbContent.Acronyms[I]);
371	for J := 0 to Acronym.Meanings.Count - 1 do begin
372	Meaning := TAcronymMeaning(Acronym.Meanings[J]);
373	if not Assigned(AcronymDbSummary.SearchAcronym(Acronym.Name, Meaning.Name, [sfCaseInsensitive])) then
374	MemoReport.Lines.Add(Format(SMissingAcronymContent, [Acronym.Name, Meaning.Name]));
375	end;
376	end;
377
378	for I := 0 to AcronymDbSummary.Acronyms.Count - 1 do begin
379	Acronym := TAcronym(AcronymDbSummary.Acronyms[I]);
380	for J := 0 to Acronym.Meanings.Count - 1 do begin
381	Meaning := TAcronymMeaning(Acronym.Meanings[J]);
382	if not Assigned(AcronymDbContent.SearchAcronym(Acronym.Name, Meaning.Name, [sfCaseInsensitive])) then
383	MemoReport.Lines.Add(Format(SMissingAcronymSummary, [Acronym.Name, Meaning.Name]));
384	end;
385	end;
386	end;
387
388	function TFormCheck.WordContainsLetters(Text, Letters: string): Boolean;
389	var
390	I: Integer;
391	LetterIndex: Integer;
392	begin
393	Result := True;
394	for I := 1 to Length(Letters) do begin
395	LetterIndex := Pos(Letters[I], Text);
396	if LetterIndex > 0 then begin
397	Text := Copy(Text, LetterIndex + 1, Length(Text));
398	end else begin
399	Result := False;
400	Break;
401	end;
402	end;
403	end;
404
405	procedure TFormCheck.UpdateInterface;
406	begin
407	LabelAcronymCountContent.Caption := SAcronymCountContent + ' ' + IntToStr(AcronymDbContent.GetMeaningsCount);
408	LabelAcronymCountSummary.Caption := SAcronymCountSummary + ' ' + IntToStr(AcronymDbSummary.GetMeaningsCount);
409	end;
410
411	procedure TFormCheck.LoadConfig;
412	begin
413	with TRegistryEx.Create do
414	try
415	RootKey := HKEY_CURRENT_USER;
416	OpenKey(DefaultRegKey, True);
417	EditSummaryStart.Text := ReadStringWithDefault('SummaryStart', 'ACRONYMS AND ABBREVIATIONS');
418	EditSummaryEnd.Text := ReadStringWithDefault('SummaryEnd', 'Appendix');
419	LastDocumentFileName := ReadStringWithDefault('LastDocumentFileName', '')
420	finally
421	Free;
422	end;
423	end;
424
425	procedure TFormCheck.SaveConfig;
426	begin
427	with TRegistryEx.Create do
428	try
429	RootKey := HKEY_CURRENT_USER;
430	OpenKey(DefaultRegKey, True);
431	WriteString('SummaryStart', EditSummaryStart.Text);
432	WriteString('SummaryEnd', EditSummaryEnd.Text);
433	WriteString('LastDocumentFileName', LastDocumentFileName);
434	finally
435	Free;
436	end;
437	end;
438
439	end.
440

Note: See TracBrowser for help on using the repository browser.

Download in other formats: