1 unit Nesting;
2 {(*}
3 (*------------------------------------------------------------------------------
4 Delphi Code formatter source code
5
6 The Original Code is Nesting, released May 2003.
7 The Initial Developer of the Original Code is Anthony Steele.
8 Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
9 All Rights Reserved.
10 Contributor(s):
11 Anthony Steele.
12 Adem Baba
13
14 The 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.
16 You may obtain a copy of the License at http://www.mozilla.org/NPL/
17
18 Software distributed under the License is distributed on an "AS IS" basis,
19 WITHOUT WARRANTY OF ANY KIND, either express or implied.
20 See the License for the specific language governing rights and limitations
21 under the License.
22
23 Alternatively, the contents of this file may be used under the terms of
24 the GNU General Public License Version 2 or later (the "GPL")
25 See http://www.gnu.org/licenses/gpl.html
26 ------------------------------------------------------------------------------*)
27 {*)}
28
29 {$I JcfGlobal.inc}
30
31 interface
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
47 type
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
GetLevelnull76 function GetLevel(const peItemType: TNestingLevelType): integer;
77
78 { by the end of the unit, everything opened should have been closed }
FinalTestnull79 function FinalTest: string;
Totalnull80 function Total: integer;
81 end;
82
83 implementation
84
85 uses SysUtils;
86
87 procedure TNestingLevelList.DecLevel(const peItemType: TNestingLevelType);
88 begin
89 dec(fiValues[peItemType]);
90 end;
91
92
93 procedure TNestingLevelList.IncLevel(const peItemType: TNestingLevelType);
94 begin
95 inc(fiValues[peItemType]);
96 end;
97
TNestingLevelList.GetLevelnull98 function TNestingLevelList.GetLevel(const peItemType: TNestingLevelType): integer;
99 begin
100 Result := fiValues[peItemType];
101 end;
102
103
104 { at the end of it all, all should be back to zero }
FinalTestnull105 function TNestingLevelList.FinalTest: string;
106 var
107 leLoop: TNestingLevelType;
108 begin
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;
119 end;
120
121 procedure TNestingLevelList.Assign(const pcSource: TNestingLevelList);
122 var
123 leLoop: TNestingLevelType;
124 begin
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
138 end;
139
140 procedure TNestingLevelList.Clear;
141 var
142 leLoop: TNestingLevelType;
143 begin
144 for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
145 fiValues[leLoop] := 0;
146 end;
147
Totalnull148 function TNestingLevelList.Total: integer;
149 var
150 leLoop: TNestingLevelType;
151 begin
152
153 Result := 0;
154 for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
155 begin
156 Result := Result + fiValues[leLoop];
157 end;
158 end;
159
160 end.
161