delfor.pas

delphi代码格式化,最新汉化版

  function GetNext: PPascalWord;
  begin
    with fileText do
      if I < Count - 1 then
        GetNext := PPascalWord(at(I + 1))
      else
        GetNext := nil;
  end;

  procedure SetPrevIndent;
  begin
    if PrevLineFeed <> nil then
      PrevLineFeed^.SetIndent(nIndent);
  end;
  procedure DecPrevIndent;
  begin
    if PrevLineFeed <> nil then
      PrevLineFeed^.IncIndent(-1);
  end;
  procedure CheckIndent(var PascalWord: PPascalWord);
  var
    next: PPascalWord;
    rtype2, lastPop: TReservedType;
    J, k: Integer;
  begin
    rtype := PascalWord^.ReservedType;
    if rtype <> rtNothing then
    begin
      case rtype of
        rtIf:
          if GetStackTop <> rtElse then
            Push(rtype, nIndent + 1, 0)
          else
          begin
            Pop;
            Push(rtElse, nIndent, 0);
          end;
        rtThen:
          if GetStackTop in [rtIf, rtElse] then
          begin
            WrapIndent := False;
            Pop;
            Push(rtype, nIndent, 0);
          end;
        rtColon:
          if GetStackTop = rtOf then
          begin
            WrapIndent := False;
            Push(rtype, nIndent, 0);
            DecPrevIndent;
          end;
        rtElse:
          if GetStackTop in [rtThen, rtColon, rtOf] then
          begin
            WrapIndent := False;
            Pop;
            Push(rtype, nIndent, 0);
            DecPrevIndent;
          end;
        rtWhile:
          Push(rtype, nIndent, 0);
        rtRepeat, rtTry:
          Push(rtype, nIndent, 1);
        rtClass, rtRecord:
          begin
            WrapIndent := False;
            next := GetNext;
            rtype2 := next^.ReservedType;
            if (next <> nil) and ((StrComp(next^.Expression, '(') = 0) or
              (next^.ReservedType in [rtLineFeed, rtPrivate])) then
              Push(rtype, nIndent, 1);
          end;
        rtUntil:
          begin
            Pop;
            SetPrevIndent;
          end;
        rtExcept, rtPrivate: DecPrevIndent;
        rtDo, rtOf:
          begin
            if GetStackTop in [rtWhile, rtCase] then
            begin
              Pop;
              Push(rtype, nIndent, 1);
              WrapIndent := False;
            end;
          end;
        rtLineFeed:
          begin
            if WrapIndent and not wrapped then
            begin
              inc(nIndent);
              wrapped := True;
            end;
            next := GetNext;
            WrapIndent := not ((next <> nil) and (next^.ReservedType in
              [rtLineFeed, rtRepeat, rtVar, rtElse, rtBegin, rtProgram]));
            PrevLineFeed := PLineFeed(PascalWord);
            SetPrevIndent;
          end;
        rtAsm:
          begin
            with fileText do
              while (I < fileText.Count - 1) and
                (PPascalWord(at(I))^.ReservedType <> rtEnd) do
              begin
                if PPascalWord(at(I))^.ReservedType = rtLineFeed then
                  with PLineFeed(at(I))^ do nSpaces := oldnSpaces;
                inc(I);
              end;
          end;
        rtProgram:
          begin
            stackptr := -1;
            nIndent := 0;
            SetPrevIndent;
          end;
        rtProcedure:
          begin
            while GetStackTop = rtVar do
            begin
              Pop;
              SetPrevIndent;
            end;
            if (GetStackTop <> rtClass) and not interfacePart then
            begin
              nIndent := procIndent;
              inc(procIndent);
            end;
          end;
        rtInterface: interfacePart := True;
        rtImplementation: interfacePart := False;
        rtBegin:
          begin
            if not indentBegin and (GetStackTop in [rtDo, rtThen, rtElse]) then
              Push(rtIfBegin, nIndent, 0)
            else if GetStackTop = rtVar then
            begin
              Pop;
              Push(rtype, nIndent, 1);
            end
            else
              Push(rtype, nIndent, 1);
            SetPrevIndent;
            DecPrevIndent;
          end;
        rtVar:
          begin
            if GetStackTop <> rtVar then
              Push(rtype, nIndent, 1)
            else
              DecPrevIndent;
          end;
        rtCase:
          if GetStackTop <> rtRecord then
            Push(rtype, nIndent, 1)
          else inc(nIndent);
        rtEnd:
          begin
            WrapIndent := False;
            if procIndent > 0 then dec(procIndent);
            lastPop := Pop;
            while (stackptr >= 0) and not
              (lastPop in [rtClass, rtRecord, rtTry, rtCase, rtColon,
              rtIfBegin, rtBegin]) do
              lastPop := Pop;
            SetPrevIndent;
            if (not indentBegin) and (lastPop = rtIfBegin) then
              DecPrevIndent;
          end;
        rtSemiColon:
          begin
            if wrapped then dec(nIndent);
            wrapped := False;
            while GetStackTop in [rtDo, rtWhile, rtThen, rtElse, rtColon] do
              lastPop := Pop;
            WrapIndent := False;
            if lastPop in [rtThen, rtElse] then
            begin
              dec(nIndent);
              lastPop := rtNothing;
            end;
          end;
      end;
    end;
  end;
begin
  if changeIndent then
  begin
    wrapped := False;
    WrapIndent := True;
    interfacePart := False;
    nIndent := 0;
    procIndent := 0;
    stackptr := -1;
    I := 0;
    with fileText do
      while I < Count do
      begin
        PasWord := PPascalWord(at(I));
        rtype := PasWord^.ReservedType;
        P := PasWord^.Expression;
        CheckIndent(PasWord);
        inc(I);
      end;
  end;
end;

function TPascalParser.GetString(Dest: PChar; var I: Integer): PChar;
var
  PasWord: PPascalWord;
  P: PChar;
begin
  GetString := Dest;
  Dest^ := #0;
  P := Dest;
  with fileText do
    if (I < Count) then
    begin
      PasWord := PPascalWord(at(I));
      repeat
        P := PasWord^.GetEString(P);
        inc(I);
        if I < Count then PasWord := PPascalWord(at(I));
      until (I >= Count) or (PasWord^.ReservedType = rtLineFeed);
    end;
end;

procedure TPascalParser.WriteToFile(AFileName: PChar);
var
  outFile: Text;
  I: Integer;
  A: array[0..800] of Char;
begin
  assign(outFile, AFileName);
  Rewrite(outFile);
  I := 0;
  with fileText do
    while I < Count do
      writeln(outFile, GetString(A, I));
  Close(outFile);
end;

destructor TPascalParser.Destroy;
begin
  inherited done;
  fileText.done;
end;

constructor TPascalWord.Create;
begin
  inherited init;
end;

function TPascalWord.Expression: PChar;
begin
  Expression := nil;
end;

function TPascalWord.WordType: TWordType;
begin
  WordType := wtLineFeed;
end;

function TPascalWord.space(Before: Boolean): Boolean;
begin
  space := False;
end;

procedure TPascalWord.SetSpace(Before, State: Boolean);
begin
end;

function TPascalWord.ReservedType: TReservedType;
begin
  ReservedType := rtNothing;
end;

procedure TPascalWord.SetReservedType(aReservedType: TReservedType);
begin
end;

function TPascalWord.GetEString(Dest: PChar): PChar;
begin
  Abstract;
end;

constructor TExpression.Create(aType: TWordType; aExpression: PChar);
begin
  FWordType := aType;
  FFormatType := ftNothing;
  FReservedType := rtNothing;
  FExpression := nil;
  SetExpression(aExpression);
end;

procedure TExpression.SetExpression(aExpression: PChar);
begin
  StrDispose(FExpression);
  FExpression := StrNew(aExpression);
end;

function TExpression.Expression: PChar;
begin
  Expression := FExpression;
end;

function TExpression.WordType: TWordType;
begin
  WordType := FWordType;
end;

function TExpression.space(Before: Boolean): Boolean;
begin
  if Before then
    space := FFormatType and ftSpaceBefore > 0
  else
    space := FFormatType and ftSpaceAfter > 0;
end;

function TExpression.ReservedType: TReservedType;
begin
  ReservedType := FReservedType;
end;

destructor TExpression.done;
begin
  SetExpression(nil);
  inherited done;
end;

procedure TExpression.SetSpace(Before, State: Boolean);
var
  b: byte;
begin
  if Before then
    b := ftSpaceBefore
  else
    b := ftSpaceAfter;
  if State then
    FFormatType := FFormatType or b
  else
    FFormatType := FFormatType and not b;
end;

procedure TExpression.SetReservedType(aReservedType: TReservedType);
begin
  FReservedType := aReservedType;
end;

function TExpression.GetEString(Dest: PChar): PChar;
begin
  if space(True) then Dest := strECopy(Dest, ' ');
  Dest := strECopy(Dest, Expression);
  if space(False) then Dest := strECopy(Dest, ' ');
  GetEString := Dest;
end;

function strSpace(Dest: PChar; n: Integer): PChar;
var
  I: Integer;
begin
  strSpace := Dest;
  for I := 0 to n - 1 do
  begin
    Dest^ := ' ';
    inc(Dest);
  end;
  Dest^ := #0;
end;

function TLineFeed.ReservedType: TReservedType;
begin
  ReservedType := rtLineFeed;
end;

constructor TLineFeed.Create(aOldnSpaces: Integer);
begin
  inherited Create;
  oldnSpaces := aOldnSpaces;
  nSpaces := aOldnSpaces; {default not changed indent}
end;

procedure TLineFeed.IncIndent(n: Integer);
begin
  with Formatter do
    inc(nSpaces, n * SpacePerIndent);
end;

procedure TLineFeed.SetIndent(n: Integer);
begin
  with Formatter do
    nSpaces := n * SpacePerIndent;
end;

function TLineFeed.GetEString(Dest: PChar): PChar;
begin
  if nSpaces > 0 then GetEString := StrEnd(strSpace(Dest, nSpaces))
  else GetEString := Dest;
end;

begin
  if paramCount = 0 then
  begin
    InFile := 'TEST.PAS';
    outFile := 'TEST.OUT';
  end
  else if paramCount = 1 then
  begin
    InFile := ParamStr(1);
    outFile := InFile;
  end
  else
  begin
    InFile := ParamStr(1);
    outFile := ParamStr(2);
  end;
  Formatter.Create;
  Formatter.LoadFile(strPCopy(Dest, InFile));
  Formatter.Parse;
  Formatter.WriteToFile(strPCopy(Dest, outFile));
  Formatter.Destroy;
end.