Skip to content

Commit 14e7eeb

Browse files
PascalCorpsmanPascalCorpsman
committed
ADD: uncommenter.pas
1 parent 36e754a commit 14e7eeb

File tree

1 file changed

+341
-0
lines changed

1 file changed

+341
-0
lines changed

‎data_control/uncommenter.pas

+341
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,341 @@
1+
(******************************************************************************)
2+
(* uncommenter.pas ??.??.???? *)
3+
(* *)
4+
(* Version : 0.03 *)
5+
(* *)
6+
(* Author : Uwe Schächterle (Corpsman) *)
7+
(* *)
8+
(* Support : www.Corpsman.de *)
9+
(* *)
10+
(* Description : Removes "comments" from a string, using configurable rules. *)
11+
(* *)
12+
(* License : See the file license.md, located under: *)
13+
(* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *)
14+
(* for details about the license. *)
15+
(* *)
16+
(* It is not allowed to change or remove this text from any *)
17+
(* source file of the project. *)
18+
(* *)
19+
(* Warranty : There is no warranty, neither in correctness of the *)
20+
(* implementation, nor anything other that could happen *)
21+
(* or go wrong, use at your own risk. *)
22+
(* *)
23+
(* Known Issues: none *)
24+
(* *)
25+
(* History : 0.01 - Initial version *)
26+
(* 0.02 - Conversion to Unicode, Linux, Removed "UseUnderLinux" *)
27+
(* inserted Compilerswitches, to do that. *)
28+
(* 0.03 - Erste Version für StringLiterale (default, *)
29+
(* deaktiviert) *)
30+
(* *)
31+
(******************************************************************************)
32+
33+
Unit uncommenter;
34+
35+
{$MODE ObjFPC}{$H+}
36+
37+
Interface
38+
39+
Uses sysutils; // für inttostr
40+
41+
Type
42+
43+
// Unser Typ zum Speichern einer Regel
44+
TRule = Record
45+
BeginChar: String; // Die zeichenkette die einen Kommentar Token einleitet
46+
EndChar: String; // Die ZeichenKette die einen Kommentar beendet
47+
Linewise: Boolean; // Wenn True dann geht der Kommentar nur 1 Zeile Lang
48+
End;
49+
50+
TUnCommenter = Class // Die Eigentliche Klasse
51+
private
52+
Frules: Array Of Trule; // Die Kommentar Regeln
53+
FNumberLines: Boolean; // Wenn True dann werden hinter alle Zeilen mit Sonderzeichen Codiert die Echten Zeilennummern eingetragen.
54+
Fscanlength: Integer; // Legt fest wie viele Zeichen der Parser im Vorraus Einliest.
55+
FSonderCharLine: Char; // Das Zeichen das benutzt wird um Code von Steuerzeichen = Zeilennummer zu unterscheiden.
56+
FCaseSensitive: Boolean; // Case sensitiv ?
57+
FDellEmptyLines: Boolean; // Löschen von Komplett Leeren Zeilen ?
58+
FStringLiteral: Char; // Wenn <> #0, dann ignoriert der Uncommenter alles innerhalb von 2 FStringLiteral's
59+
public
60+
Property StringLiteral: Char read FStringLiteral write FStringLiteral;
61+
Property DellEmptyLines: boolean read FDellEmptyLines write FDellEmptyLines;
62+
Property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;
63+
Property NumberLines: boolean read FNumberLines write FNumberLines;
64+
Property ExtraCharLine: Char read FSonderCharLine write FSonderCharLine;
65+
Constructor Create;
66+
Destructor Destroy; override;
67+
Procedure AddRule(BeginChar, EndChar: String; Linewise: Boolean);
68+
Procedure ClearRules;
69+
Function Uncomment(Value: String): String;
70+
End;
71+
72+
Implementation
73+
74+
Uses Math;
75+
76+
Constructor TUnCommenter.Create;
77+
Begin
78+
Inherited create;
79+
//UseUnderLinux := false;
80+
setlength(frules, 0);
81+
FNumberLines := false;
82+
FDellEmptyLines := true;
83+
Fscanlength := 0;
84+
FSonderCharLine := '~';
85+
FCaseSensitive := false;
86+
FStringLiteral := #0;
87+
End;
88+
89+
90+
Destructor TUnCommenter.Destroy;
91+
Begin
92+
setlength(frules, 0);
93+
End;
94+
95+
Procedure TUnCommenter.AddRule(BeginChar, EndChar: String; Linewise: Boolean);
96+
Begin
97+
// Wenn Zeilenweise Kommentare sind brauchen wir mindestens 2 Zeichen um #13 #10 erkennen zu können.
98+
If linewise Then Begin
99+
{$IFDEF Windows}
100+
Fscanlength := max(Fscanlength, 2); // Zum Erkennen von #13#10
101+
{$ENDIF}
102+
EndChar := ''; // Gibt es in dem Fall nicht.
103+
End;
104+
Fscanlength := max(Fscanlength, length(BeginChar)); // Merken des Längsten Einführungszeichens unserer Tocken
105+
Fscanlength := max(Fscanlength, length(EndChar)); // Merken des Längsten Beendenzeichens unserer Tocken
106+
setlength(Frules, high(frules) + 2); // Übernehmen in die Rules Liste
107+
Frules[high(frules)].BeginChar := BeginChar;
108+
Frules[high(frules)].EndChar := EndChar;
109+
Frules[high(frules)].Linewise := Linewise;
110+
End;
111+
112+
Procedure TUnCommenter.ClearRules;
113+
Begin
114+
setlength(Frules, 0); // Wieder Löschen der Regeln
115+
End;
116+
117+
// Die Eigentliche Arbeit wird hier verrichtet
118+
119+
Function TUnCommenter.Uncomment(Value: String): String;
120+
Var
121+
ochars: String; // Merken der zueltzt gelesenen Zeichen
122+
akt: String; // merken der Aktuell gelesenen Zeichen ( Formatiert )
123+
akttmp: String; // merken der Aktuell gelesenen Zeichen ( unFormatiert )
124+
erg: String; // Das Ergebniss.
125+
aLineNumber: integer; // Speichern der Aktuellen Zeilen Nummer des Quell Textes
126+
i: integer; // Schleifen Zählvariable
127+
i2: integer; // Schleifen Zählvariable
128+
inCase: integer; // Merken in welchem Token wir uns gerade befinden -1 = Kein Token
129+
ueber: Integer; // Anzahl der Zeichen die "Überlesen" werden können
130+
fall: Boolean; // = True wenn gerade ein Token geschlossen wurde.
131+
lnm: boolean; // In Ganz Perversen Einstellungen wird die Letzte Zeile nicht beschriftet, dieser Bool behebt das
132+
b: Boolean; // Schmiermerker
133+
InString: Boolean; // Wenn True, dann sind wir in einem String -> Alle Regeln sind Deaktiviert
134+
Begin
135+
If FStringLiteral <> #0 Then Begin
136+
For i := 0 To high(Frules) Do Begin
137+
If (pos(FStringLiteral, Frules[i].BeginChar) <> 0) Or
138+
(pos(FStringLiteral, Frules[i].EndChar) <> 0) Then Begin
139+
result := '';
140+
Raise exception.create('Error, StringLiteral is part of a rule.');
141+
exit;
142+
End;
143+
End;
144+
End;
145+
// Abfangen des einzigen Sonderfalles, der nicht berechnet werden mus.
146+
If (High(Frules) = -1) And (Not FNumberLines) And Not (FDellEmptyLines) Then Begin
147+
result := value;
148+
End
149+
Else Begin
150+
InString := false;
151+
// Der Text mus auf alle Fälle mit einem CR+ RT aufhören sonst ist die Zeilennumerierung nicht immer Richtig, eines zu viel schadet dabei zum Glück nicht ;)
152+
Value := Value + LineEnding;
153+
// Fals noch keine Regeln erzeugt wurden mus hier Fscanlength initialisiert werden.
154+
If FNumberLines Or FDellEmptyLines Then Fscanlength := max(Fscanlength, 2); // Nachträglich einschalten des scannens nach CR RT
155+
erg := ''; // Initialisieren
156+
ochars := ''; // Initialisieren
157+
inCase := -1; // Initialisieren
158+
aLineNumber := -1; // Initialisieren
159+
lnm := False;
160+
ueber := 0;
161+
// Die ersten Paar Zeichen können auf einen Schlag eingelesen werden.
162+
If (Length(Value) > Fscanlength) Then Begin
163+
akt := copy(value, 1, Fscanlength - 1);
164+
delete(value, 1, Fscanlength - 1);
165+
End
166+
Else Begin
167+
akt := value;
168+
End;
169+
// Stringregel im bereits geparsten berücksichtigen
170+
If FStringLiteral <> #0 Then Begin
171+
For i := 1 To length(akt) Do Begin
172+
If akt[i] = FStringLiteral Then InString := Not InString;
173+
End;
174+
End;
175+
// Zwischenspeichern des eingelesenen Textes Unformatiert
176+
akttmp := akt;
177+
If Not FCaseSensitive Then akt := lowercase(akt); // Formatierung für nicht Case Sensitiv
178+
(*
179+
180+
Der Teil :
181+
182+
Or (Length(Akt) <> 0)
183+
184+
wurde Eingefügt, da der parser das AllerLetze Zeichen Verschluckt hatte.
185+
186+
*)
187+
While (Length(Value) <> 0) Or (Length(Akt) <> 0) Do Begin // Solange es noch was zu betrachten gibt
188+
fall := false; // Eine alte Fallende Flanke Löschen.
189+
While (Length(Value) <> 0) And (Length(akt) < Fscanlength) Do Begin
190+
// Weiterlesen im Text.
191+
If Length(Value) <> 0 Then Begin
192+
If FCaseSensitive Then // Wenn Casesensitive
193+
akt := akt + Value[1] // Dann wird Akttmp eigentlich sinnlos.
194+
Else
195+
akt := akt + lowercase(Value[1]);
196+
akttmp := akttmp + Value[1]; // Mitziehen von Akttmp
197+
If (FStringLiteral <> #0) And (Incase = -1) Then Begin // Strings in Kommentaren werden Ignoriert
198+
If value[1] = FStringLiteral Then Begin
199+
InString := Not InString;
200+
End;
201+
End;
202+
delete(Value, 1, 1); // Löschen des bereits eingelesenen Textes
203+
End;
204+
End;
205+
// Scannen nach den BeginnTockens
206+
If Not InString Then Begin // Wenn wir in einem String Sind, wird die Regelerkennung "Deaktiviert"
207+
If Incase = -1 Then Begin
208+
For i := 0 To High(Frules) Do
209+
// schaun ob der Beginn unseres Tokens überhaupt geht.
210+
If length(akt) >= Length(Frules[i].BeginChar) Then Begin
211+
b := true; // Initialisieren
212+
i2 := 1; // Initialisieren
213+
While b And (i2 <= length(Frules[i].BeginChar)) Do Begin // Solange der gelesene Text mit dem Tocken übereinstimmt, lesen
214+
If FCaseSensitive Then Begin // wieder die Case Sensitiv sache
215+
If akt[i2] <> Frules[i].BeginChar[i2] Then b := false; // Wenn die Zeicehn nicht Gleich sind
216+
End
217+
Else Begin
218+
If akt[i2] <> lowercase(Frules[i].BeginChar[i2]) Then b := false; // Wenn die Zeichen nicht Gleich sind
219+
End;
220+
inc(i2); // Weiterzählen auf den nächsten Char
221+
End;
222+
If b Then Begin // Wenn wir tatsächlich einen Token erkannt haben
223+
incase := i; // Merken welcher Token es war
224+
ueber := Length(Frules[i].BeginChar) - 1;
225+
break; // Raus.
226+
End;
227+
End;
228+
End
229+
Else Begin // Scannen nach Ende Tokens
230+
i := incase;
231+
// schaun ob der Beginn unseres Tokens überhaupt geht.
232+
If (length(akt) >= Length(Frules[i].EndChar)) And (Not Frules[i].Linewise) Then Begin
233+
b := true; // Initialisieren
234+
i2 := 1; // Initialisieren
235+
While b And (i2 <= length(Frules[i].EndChar)) Do Begin // Solange der gelesene Text mit dem Tocken übereinstimmt, lesen
236+
If FCaseSensitive Then Begin // wieder die Case Sensitiv sache
237+
If akt[i2] <> Frules[i].EndChar[i2] Then b := false; // Wenn die Zeicehn nicht Gleich sind
238+
End
239+
Else Begin
240+
If akt[i2] <> lowercase(Frules[i].EndChar[i2]) Then b := false; // Wenn die Zeicehn nicht Gleich sind
241+
End;
242+
inc(i2); // Weiterzählen auf den nächsten Char
243+
End;
244+
If b Then Begin // Wenn wir tatsächlich einen Token erkannt haben
245+
incase := -1; // zurücksetzen des Tokenmerkers
246+
fall := true; // Merken der Fallenden Flanke.
247+
ueber := length(Frules[i].EndChar) - 1; // Berechnen der zu überspringenden Zeichen
248+
End;
249+
End;
250+
{$IFDEF Windows}
251+
If (Length(Akt) > 1) And Frules[i].Linewise Then // Sonderfall bei nur einzeilenweisem
252+
If (Akt[1] = #13) And (Akt[2] = #10) Then Begin // Wenn die CRT erkannt wird
253+
{$ELSE}
254+
If (Length(Akt) > 0) And Frules[i].Linewise Then // Sonderfall bei nur einzeilenweisem
255+
If (Akt[1] = #10) Then Begin // Wenn die CRT erkannt wird
256+
{$ENDIF}
257+
incase := -1; // zurücksetzen des Tokenmerkers
258+
Fall := False; // Da wir hier einen Zeilenweisen Kommentar haben darf es keine Fallende Flanke geben, da sonst das folgende CRT verschluckt werden kann.
259+
ueber := 0; // Berechnen der zu überspringenden Zeichen
260+
End;
261+
End;
262+
End;
263+
// SonderFall wenn wir die Zeilen mit ihren Nummern Markieren müssen
264+
{$IFDEF Windows}
265+
If (Length(Akt) > 1) And FNumberLines Then
266+
If (Akt[1] = #13) And (Akt[2] = #10) Then Begin // Bei crt
267+
{$ELSE}
268+
If (Length(Akt) > 0) And FNumberLines Then
269+
If (Akt[1] = #10) Then Begin // Bei crt
270+
{$ENDIF}
271+
inc(aLineNumber); // Hochzählen der Aktuellen Zeilennummer
272+
{$IFDEF Windows}
273+
If (length(ochars) >= 2) And FDellEmptyLines Then Begin // Schaun ob wir ne Leerzeile hatten
274+
If Not ((ochars[length(Ochars) - 1] = #13) And (ochars[length(Ochars)] = #10)) Then Begin // Wenn nicht crt gelesen wurde
275+
{$ELSE}
276+
If (length(ochars) >= 1) And FDellEmptyLines Then Begin // Schaun ob wir ne Leerzeile hatten
277+
If Not ((ochars[length(Ochars)] = #10)) Then Begin // Wenn nicht crt gelesen wurde
278+
{$ENDIF}
279+
erg := erg + FSonderCharLine + inttostr(aLineNumber); // Einfügen der Zeilennummern
280+
lnm := true;
281+
End
282+
End
283+
Else If Length(Ochars) <> 0 Then Begin
284+
erg := erg + FSonderCharLine + inttostr(aLineNumber); // Einfügen der Zeilennummern
285+
lnm := True;
286+
End;
287+
End;
288+
// Wenn wir keinen Kommentar haben dann Kräftig übernehmen :=)
289+
If (Incase = -1) And Not fall Then Begin
290+
If FDellEmptyLines Then Begin // Wenn Leerzeilen Gelöscht werden müssen dann ist hier noch ein wenig Magic Notwendig.
291+
{$IFDEF Windows}
292+
If (akt[1] = #13) Or (akt[1] = #10) Then Begin // Wenn gerade CRT Gelesen wird
293+
If (length(ochars) >= 2) Then Begin // schaun ob bereits crt gelesen wurde
294+
If Not ((ochars[length(Ochars) - 1] = #13) And (ochars[length(Ochars)] = #10)) Then Begin // Wenn nicht crt gelesen wurde
295+
{$ELSE}
296+
If (akt[1] = #10) Then Begin // Wenn gerade CRT Gelesen wird
297+
If (length(ochars) >= 1) Then Begin // schaun ob bereits crt gelesen wurde
298+
If Not ((ochars[length(Ochars)] = #10)) Then Begin // Wenn nicht crt gelesen wurde
299+
{$ENDIF}
300+
erg := erg + akttmp[1]; // übernehmen des gelesenen Codes in das Ergebniss
301+
ochars := ochars + akt[1]; // Merken der Zuletzt gelesenen zeichen
302+
// lnm := False; // Beim Einfügen eines CRT brauchen wir nicht noch Extra eine Zeilenbeschriftung
303+
End;
304+
End;
305+
End
306+
Else Begin
307+
erg := erg + akttmp[1]; // übernehmen des gelesenen Codes in das Ergebniss
308+
ochars := ochars + akt[1]; // Merken der Zuletzt gelesenen zeichen
309+
lnm := False; // Merken das nach diesem Zeichen auf alle Fälle nochmal Beschriftet werden mus.
310+
End;
311+
End
312+
Else Begin
313+
erg := erg + akttmp[1]; // übernehmen des gelesenen Codes in das Ergebniss
314+
ochars := ochars + akt[1]; // Merken der Zuletzt gelesenen zeichen
315+
lnm := False; // Merken das nach diesem Zeichen auf alle Fälle nochmal Beschriftet werden mus.
316+
End;
317+
End;
318+
// wenn es zeichen zu überspringen gibt dann geschieht das hier
319+
If Ueber <> 0 Then Begin
320+
Delete(akt, 1, ueber); // Der Witz ist das Akt immer Länger oder gleich lang wie Ueber + 1 ist !!
321+
Delete(akttmp, 1, ueber); // Der Witz ist das Akt immer Länger oder gleich lang wie Ueber + 1 ist !!
322+
Ueber := 0; // Zurücksetzen
323+
End;
324+
// Wir müssen nicht alle Zeichen als gelesen speichern
325+
// Eigentlich könnte auch > 2 stehen.
326+
If Length(Ochars) > Fscanlength Then
327+
delete(Ochars, 1, 1);
328+
// Am Schlus wird immer das 1. Element von Akt gelöscht
329+
delete(akt, 1, 1);
330+
delete(akttmp, 1, 1);
331+
End;
332+
// Beschriften der Allerletzten Zeile, falls die Beschriftungsoption an ist.
333+
If Not lnm And FNumberLines Then Begin
334+
erg := erg + FSonderCharLine + inttostr(aLineNumber); // Einfügen der Zeilennummern
335+
End;
336+
result := erg; // Rückgabe unseres Geparsten Textes
337+
End;
338+
End;
339+
340+
End.
341+

0 commit comments

Comments
 (0)