1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
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.
|
