Delphi-PRAXiS - Source Code Formater

Hallo,

ist schon eine Weile her. Aber mein Wunsch einen eigenen Source Code Formatter (Pascal) zu schreiben steht noch immer im Raum :-D

Deshalb habe ich noch ein bisschen gegrübelt und mich mal wieder daran versucht.

Einer meiner ersten Versuche möchte ich hier vorstellen. Es ist eine reine Spiel-und-Test Version. Es funktioniert noch nicht perfekt. Aber mir gefällt die Tendenz im Augenblick schon ganz gut. Später wenn ausgereifter will ich alles auch benutzerfreundlicher machen. Aktuell muss ich den Zustand reifen lassen :)

Wer Lust und Spaß daran hat, kann gerne mit dem Code auch etwas herumknobbeln, weiterverarbeiten, usw.
Anregungen zum Code und Ideen sind Willkommen.

Der Code ist einfach gehalten. Einfach ein neues Projekt erstellen, ein großes Memo (nur für die Anzeige), ein Button und ein Label (eigentlich auch nicht notwendig, wieder nur um schnell mal etwas zu prüfen...) darauf ziehen. (Ich komme von Lazarus, daher sind evtl. geringfügig änderungen nötig).

"input.txt" => Quellcode der formatiert werden soll
"output.pas" => der Formatierter Code

Viel Spaß und viel Glück :-)

Delphi-Quellcode:

			unit Unit1;

{$mode objfpc}{$H+}

interface

uses

  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,RegExpr, strutils;

type

  { TForm1 }

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    Label1: TLabel;

    Memo2: TMemo;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

  private

  public

  end;

var

  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

function string_zaehlen(substr: string; str: string): integer;

var

  a: integer;

  z,posi: integer;

begin

  // ===== Ein paar sachen nicht zählen:

  // === einzeiliges...

  // kommentare ignorieren

  Delete(str,pos('//',str),length(str));

  // texte innerhalb von '  ignorieren

  Delete(str,posEx('''',str,1),

    (posEx('''',str,  posEx('''',str,1)+1   )  -  posEx('''',str,1)+1    )        );

  // ab hier zählen

  z := 0; posi := 0;

  For a := 0 to  str.Length-1 do begin

    posi := posEx(substr, str, posi+1);

    if posi > 0 then begin

      z := z+1;

    end;

    if posi = 0 then begin break; end;

  end;

  Result := z;

end;

//https://www.delphi-treff.de/tipps-tricks/object-pascal/strings/zeichen-wiederholen/

function Replicate(ch: char; anzahl: integer): string;

begin

  SetLength(Result,Anzahl);

  if Length(Result)>0 then

    FillChar(Result[1],Length(Result),ch);

end;

procedure Split(Delimiter: Char; Str: string; ListOfStrings: TStrings) ;

begin

   ListOfStrings.Clear;

   ListOfStrings.Delimiter       := Delimiter;

   ListOfStrings.StrictDelimiter := True; // Requires D2006 or newer.

   ListOfStrings.DelimitedText   := Str;

end;

function Implode(const Strings: TStrings; const separator: string): String;

var

  i: Integer;

begin

  Result := Strings[0];

  for i := 1 to Strings.Count - 1 do

    Result := Result + separator + Strings[i];

end;

procedure TForm1.Button1Click(Sender: TObject);

var

  input: TSTringList;   // Datei einlesen

  output: TStringList;  // verarbeitete daeti ausgeben

  trenner: TSTringList;

  a: integer;

  temp,txt,txt2: string;

  leerzeichen: integer;

  d: textfile;

begin

  // ===== Datei einlesen - begin

  input := TStringList.Create;

  input.LoadFromFile('input.txt');

  // ===== Datei einlesen - end

  // ===== Datei verarbeiten - begin

  trenner := TStringList.Create;

  trenner.Add(' ');

  trenner.Add('//');

  trenner.Add(';');

  trenner.Add('var');

  trenner.Add(#13#10);

  trenner.Add('begin');

  trenner.Add('end');

  trenner.Add('{');

  trenner.Add('}');

  trenner.Add('[');

  trenner.Add(']');

  trenner.Add('(');

  trenner.Add(')');

  trenner.Add('"');

  trenner.Add('''');

  txt := input.Text;

     For a := 0 to trenner.Count-1 do begin

  txt := StringReplace(txt,trenner[a],#13#10+trenner[a]+#13#10,[rfReplaceAll, rfIgnoreCase]);

  end;

     input.text := txt;

     input.Text.Split(#13#10);

  // === Elemente prüfen und bearbeiten

  For a := 0 to input.Count-1 do begin

     // allgemeines

    if pos('interface',input.Strings[a]) >0 then begin  input.Strings[a] :=  #13#10#13#10+'interface'+#13#10; end;

    if pos('uses',input.Strings[a]) >0 then begin  input.Strings[a] :=  #13#10+'uses'+#13#10; end;

    if pos('type',input.Strings[a]) >0 then begin  input.Strings[a] :=  #13#10+'type'+#13#10; end;

    if pos('private',input.Strings[a]) >0 then begin  input.Strings[a] :=  #13#10+'private'+#13#10; end;

    if pos('public',input.Strings[a]) >0 then begin  input.Strings[a] :=  #13#10+'public'+#13#10; end;

    if pos('implementation',input.Strings[a]) >0 then begin  input.Strings[a] :=  #13#10+'implementation'+#13#10; end;

    //if pos('type',input.Strings[a]) >0 then begin  input.Strings[a] :=  #13#10+'type'+#13#10; end;

    // ===== Zeilenumbrüche

    // Zeilenumbruch aber nicht weniger Text als X zeichen ist.

    if posEx('var',input.Strings[a],1) >0 then begin  input.Strings[a] :=  StringReplace(input.Strings[a],'var',#13#10+'var'+#13#10,[rfReplaceAll, rfIgnoreCase]);  end;

    //if posEx('begin',input.Strings[a],1) >0 then begin  input.Strings[a] :=  StringReplace(input.Strings[a],'begin','begin '+#13#10,[rfReplaceAll, rfIgnoreCase]);  end;

    if posEx('begin',input.Strings[a],1) >0 then begin  input.Strings[a] :=  StringReplace(input.Strings[a],'begin','begin'+#13#10,[rfReplaceAll, rfIgnoreCase]); end;

    if posEx('end;',input.Strings[a],90) >0 then begin  input.Strings[a] :=  StringReplace(input.Strings[a],'end;',' end;'+#13#10#13#10,[rfReplaceAll, rfIgnoreCase]); end;

    if (posEx('procedure',input.Strings[a],1) >0) then begin    input.Strings[a] :=  StringReplace(input.Strings[a],'procedure',#13#10#13#10#13#10+'procedure',[rfReplaceAll, rfIgnoreCase]);    end;

  if posEx('function',input.Strings[a],1) >0 then begin  input.Strings[a] :=  StringReplace(input.Strings[a],'function',#13#10#13#10#13#10+'function',[rfReplaceAll, rfIgnoreCase]);  end;

  if posEx('if',input.Strings[a],1) >0 then begin  input.Strings[a] :=  StringReplace(input.Strings[a],'if',#13#10+'if',[rfReplaceAll, rfIgnoreCase]);  end;

  if posEx('while',input.Strings[a],1) >0 then begin  input.Strings[a] :=  StringReplace(input.Strings[a],'while',#13#10+'while',[rfReplaceAll, rfIgnoreCase]);  end;

  if posEx('for',input.Strings[a],1) >0 then begin  input.Strings[a] :=  StringReplace(input.Strings[a],'for',#13#10+'for',[rfReplaceAll, rfIgnoreCase]);  end;

  temp := input.Strings[a];

  //Delete(temp,pos('//',temp),length(temp)); // kein zeilenumbruch im kommentar

  if (posEx(';',temp,1) >0)  then begin   input.Strings[a] :=  StringReplace(input.Strings[a],';',';'+#13#10,[rfReplaceAll, rfIgnoreCase]);  end;

  end;

  // ===== Datei verarbeiten - end

  // ===== leerzeichen - begin

  // leerzeichen muss am schluss gemacht werden

  // === Vorformatieren - begin

   output := TStringList.Create;

   txt2 := '';

    For a := 0 to input.Count-1 do begin

      txt2 := (txt2+input.Strings[a]);

    end;

    output.text := txt2;

    output.text.Split(#13#10); //jetzt zeilenweiße bearbeitne

  // === Vorformatieren - end

  leerzeichen := 1;  // linker rand

  For a := 0 to output.Count-1 do begin

    output.strings[a] := trimleft(output.strings[a]);

    temp := StringReplace(output.strings[a],'end;','endXXX',[rfReplaceAll, rfIgnoreCase]);

    temp := StringReplace(temp,'end ','endXXX',[rfReplaceAll, rfIgnoreCase]);

    leerzeichen := leerzeichen - string_zaehlen('endXXX',temp);

    //leerzeichen := leerzeichen - string_zaehlen('end;',temp);

    //output.strings[a] := IntTostr(leerzeichen)+Replicate(' ',leerzeichen) + output.strings[a];  //zum testen

    output.strings[a] := Replicate(' ',leerzeichen) + output.strings[a];

    leerzeichen := leerzeichen + string_zaehlen('begin',output.strings[a]);

    leerzeichen := leerzeichen + string_zaehlen('class(',output.strings[a]);

    leerzeichen := leerzeichen + string_zaehlen('finally',output.strings[a]);

    label1.caption := IntToStr(leerzeichen);    //zum testen ob leerzeichen noch stimmen...

    output.strings[a] := output.strings[a]+#13#10;

  end;

  // ===== Schönheitskorrekturen

  // leerzeilen korrigieren

  For a := output.Count-1 downto 0 do begin

     // procedure zusätzliche leerzeilen wieder entfernen /  korrigieren

    if (pos('procedure',output.strings[a]) > 0) and ((trim(output.strings[a-1]) = '')) and  (pos('procedure',output.strings[a-4]) > 0)  then begin

      output.Delete(a-1);

      output.Delete(a-2);

      output.Delete(a-3);

    end;

    // var zusätzliche leerzeilen wieder entfernen /  korrigieren

   if (pos('var',output.strings[a]) > 0) and (trim(output.strings[a-1]) = '') then begin

     output.Delete(a-1);

   end;

  end;

input := output;

  // ===== leerzeichen - end

  // ===== Temporär anzeigen - begin

  Memo2.text := ''; txt2 := '';

  For a := 0 to input.Count-1 do begin

    //txt2 := (txt2+input.Strings[a])+#13#10;  // anzeige um die einzelnen objekte zu erkennen.

    txt2 := (txt2+input.Strings[a]);

  end;

  Memo2.text := txt2;

  // ===== Temporär anzeigen - end

  // ===== Datei schreiben - begin

  assignfile(d, 'output.pas');

  rewrite(d);

  writeln(d, txt2);

  closefile(d);

  // ===== Datei schreiben - bend

end;