lazarus/components/jcf2/Process/Nesting.pas

unit Nesting;
{(*}
(*------------------------------------------------------------------------------
 Delphi Code formatter source code

The Original Code is Nesting, released May 2003.
The Initial Developer of the Original Code is Anthony Steele.
Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
All Rights Reserved.
Contributor(s):
Anthony Steele.
Adem Baba

The contents of this file are subject to the Mozilla Public License Version 1.1
(the "License"). you may not use this file except in compliance with the License.
You may obtain a copy of the License at http://www.mozilla.org/NPL/

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied.
See the License for the specific language governing rights and limitations 
under the License.

Alternatively, the contents of this file may be used under the terms of
the GNU General Public License Version 2 or later (the "GPL") 
See http://www.gnu.org/licenses/gpl.html
------------------------------------------------------------------------------*)
{*)}

{$I JcfGlobal.inc}

interface

{ AFS 10 Jan 2002
  This is fairly generic code so it has it's own class
  to store on each token nesting level info for a variety of indicators
  such as
  - begin end block nesting level
  - record case nesting level
  - case statement, try statment etc.
  - procedure nesting level

  Easier and faster to set this up once
  with a visitor and store it on a leaf node
  than the generate it on the fly
}

type

  TNestingLevelType = (
    nlBlock, // generic code indent
    nlCaseSelector,
    nlRecordType,
    nlRecordVariantSection,
    nlProcedure,
    nlRoundBracket, nlSquareBracket,
    nlStatementLabel);

  TNestingLevelList = class(TObject)
  private
    { store a nesting level for one of the above enums
      Adem Baba suggested that an array indexed by enum
      would be simpler and faster than a TObjectList }
    fiValues: array[TNestingLevelType] of integer;

  public
    procedure Clear;

    procedure Assign(const pcSource: TNestingLevelList);

    { clients do not have unrestricted write access to these values
      should only increment and dec them,
      e.g. nlRoundBracket is incremented on each '(' and decemented on ')' }
    procedure IncLevel(const peItemType: TNestingLevelType);
    procedure DecLevel(const peItemType: TNestingLevelType);

    function GetLevel(const peItemType: TNestingLevelType): integer;

    { by the end of the unit, everything opened should have been closed }
    function FinalTest: string;
    function Total: integer;
  end;

implementation

uses SysUtils;

procedure TNestingLevelList.DecLevel(const peItemType: TNestingLevelType);
begin
  dec(fiValues[peItemType]);
end;


procedure TNestingLevelList.IncLevel(const peItemType: TNestingLevelType);
begin
  inc(fiValues[peItemType]);
end;

function TNestingLevelList.GetLevel(const peItemType: TNestingLevelType): integer;
begin
  Result := fiValues[peItemType];
end;


{ at the end of it all, all should be back to zero }
function TNestingLevelList.FinalTest: string;
var
  leLoop: TNestingLevelType;
begin
  Result := '';

  for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
  begin
    if fiValues[leLoop] > 0 then
    begin
      Result := 'Final nesting level = ' + IntToStr(fiValues[leLoop]);
      break;
    end;
  end;
end;

procedure TNestingLevelList.Assign(const pcSource: TNestingLevelList);
var
  leLoop: TNestingLevelType;
begin

  if pcSource = nil then
  begin
    Clear;
  end
  else
  begin
    for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
    begin
      fiValues[leLoop] := pcSource.GetLevel(leLoop);
    end;
  end;

end;

procedure TNestingLevelList.Clear;
var
  leLoop: TNestingLevelType;
begin
  for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
    fiValues[leLoop] := 0;
end;

function TNestingLevelList.Total: integer;
var
  leLoop: TNestingLevelType;
begin

  Result := 0;
  for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
  begin
    Result := Result + fiValues[leLoop];
  end;
end;

end.