PageRenderTime 19ms CodeModel.GetById 13ms app.highlight 2ms RepoModel.GetById 1ms app.codeStats 1ms

/components/jcf2/Process/Nesting.pas

http://github.com/graemeg/lazarus
Pascal | 160 lines | 85 code | 27 blank | 48 comment | 6 complexity | c214d4b2cc677a2175086f471fef1091 MD5 | raw file
  1unit Nesting;
  2{(*}
  3(*------------------------------------------------------------------------------
  4 Delphi Code formatter source code
  5
  6The Original Code is Nesting, released May 2003.
  7The Initial Developer of the Original Code is Anthony Steele.
  8Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
  9All Rights Reserved.
 10Contributor(s):
 11Anthony Steele.
 12Adem Baba
 13
 14The contents of this file are subject to the Mozilla Public License Version 1.1
 15(the "License"). you may not use this file except in compliance with the License.
 16You may obtain a copy of the License at http://www.mozilla.org/NPL/
 17
 18Software distributed under the License is distributed on an "AS IS" basis,
 19WITHOUT WARRANTY OF ANY KIND, either express or implied.
 20See the License for the specific language governing rights and limitations 
 21under the License.
 22
 23Alternatively, the contents of this file may be used under the terms of
 24the GNU General Public License Version 2 or later (the "GPL") 
 25See http://www.gnu.org/licenses/gpl.html
 26------------------------------------------------------------------------------*)
 27{*)}
 28
 29{$I JcfGlobal.inc}
 30
 31interface
 32
 33{ AFS 10 Jan 2002
 34  This is fairly generic code so it has it's own class
 35  to store on each token nesting level info for a variety of indicators
 36  such as
 37  - begin end block nesting level
 38  - record case nesting level
 39  - case statement, try statment etc.
 40  - procedure nesting level
 41
 42  Easier and faster to set this up once
 43  with a visitor and store it on a leaf node
 44  than the generate it on the fly
 45}
 46
 47type
 48
 49  TNestingLevelType = (
 50    nlBlock, // generic code indent
 51    nlCaseSelector,
 52    nlRecordType,
 53    nlRecordVariantSection,
 54    nlProcedure,
 55    nlRoundBracket, nlSquareBracket,
 56    nlStatementLabel);
 57
 58  TNestingLevelList = class(TObject)
 59  private
 60    { store a nesting level for one of the above enums
 61      Adem Baba suggested that an array indexed by enum
 62      would be simpler and faster than a TObjectList }
 63    fiValues: array[TNestingLevelType] of integer;
 64
 65  public
 66    procedure Clear;
 67
 68    procedure Assign(const pcSource: TNestingLevelList);
 69
 70    { clients do not have unrestricted write access to these values
 71      should only increment and dec them,
 72      e.g. nlRoundBracket is incremented on each '(' and decemented on ')' }
 73    procedure IncLevel(const peItemType: TNestingLevelType);
 74    procedure DecLevel(const peItemType: TNestingLevelType);
 75
 76    function GetLevel(const peItemType: TNestingLevelType): integer;
 77
 78    { by the end of the unit, everything opened should have been closed }
 79    function FinalTest: string;
 80    function Total: integer;
 81  end;
 82
 83implementation
 84
 85uses SysUtils;
 86
 87procedure TNestingLevelList.DecLevel(const peItemType: TNestingLevelType);
 88begin
 89  dec(fiValues[peItemType]);
 90end;
 91
 92
 93procedure TNestingLevelList.IncLevel(const peItemType: TNestingLevelType);
 94begin
 95  inc(fiValues[peItemType]);
 96end;
 97
 98function TNestingLevelList.GetLevel(const peItemType: TNestingLevelType): integer;
 99begin
100  Result := fiValues[peItemType];
101end;
102
103
104{ at the end of it all, all should be back to zero }
105function TNestingLevelList.FinalTest: string;
106var
107  leLoop: TNestingLevelType;
108begin
109  Result := '';
110
111  for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
112  begin
113    if fiValues[leLoop] > 0 then
114    begin
115      Result := 'Final nesting level = ' + IntToStr(fiValues[leLoop]);
116      break;
117    end;
118  end;
119end;
120
121procedure TNestingLevelList.Assign(const pcSource: TNestingLevelList);
122var
123  leLoop: TNestingLevelType;
124begin
125
126  if pcSource = nil then
127  begin
128    Clear;
129  end
130  else
131  begin
132    for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
133    begin
134      fiValues[leLoop] := pcSource.GetLevel(leLoop);
135    end;
136  end;
137
138end;
139
140procedure TNestingLevelList.Clear;
141var
142  leLoop: TNestingLevelType;
143begin
144  for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
145    fiValues[leLoop] := 0;
146end;
147
148function TNestingLevelList.Total: integer;
149var
150  leLoop: TNestingLevelType;
151begin
152
153  Result := 0;
154  for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
155  begin
156    Result := Result + fiValues[leLoop];
157  end;
158end;
159
160end.