1 unit SingleSpaceAfter;
2
3 {(*}
4 (*------------------------------------------------------------------------------
5 Delphi Code formatter source code
6
7 The Original Code is SingleSpaceAfter, released May 2003.
8 The Initial Developer of the Original Code is Anthony Steele.
9 Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
10 All Rights Reserved.
11 Contributor(s): Anthony Steele.
12
13 The contents of this file are subject to the Mozilla Public License Version 1.1
14 (the "License"). you may not use this file except in compliance with the License.
15 You may obtain a copy of the License at http://www.mozilla.org/NPL/
16
17 Software distributed under the License is distributed on an "AS IS" basis,
18 WITHOUT WARRANTY OF ANY KIND, either express or implied.
19 See the License for the specific language governing rights and limitations
20 under the License.
21
22 Alternatively, the contents of this file may be used under the terms of
23 the GNU General Public License Version 2 or later (the "GPL")
24 See http://www.gnu.org/licenses/gpl.html
25 ------------------------------------------------------------------------------*)
26 {*)}
27
28 {$I JcfGlobal.inc}
29
30 interface
31
32 { AFS 9 Dec 1999
33 Single space after }
34
35 uses SwitchableVisitor;
36
37 type
38 TSingleSpaceAfter = class(TSwitchableVisitor)
39 private
40 protected
EnabledVisitSourceTokennull41 function EnabledVisitSourceToken(const pcNode: TObject): boolean; override;
42 public
43 constructor Create; override;
44
IsIncludedInSettingsnull45 function IsIncludedInSettings: boolean; override;
46 end;
47
48
49 implementation
50
51 uses
52 { local }
53 JcfStringUtils,
54 SourceToken, Tokens, ParseTreeNodeType, JcfSettings,
55 FormatFlags, TokenUtils, SettingsTypes;
56
57 const
58 SingleSpaceAfterTokens: TTokenTypeSet = [ttColon, ttAssign, ttComma,
59 ttPlusAssign, ttMinusAssign, ttTimesAssign, ttFloatDivAssign];
60
61 SingleSpaceAfterWords: TTokenTypeSet = [
62 ttProcedure, ttFunction,
63 ttConstructor, ttDestructor, ttProperty,
64 ttOf, ttDo, ttWhile, ttUntil, ttCase, ttIf, ttTo, ttDownTo, ttGeneric];
65
66 PossiblyUnaryOperators: TTokenTypeSet = [ttPlus, ttMinus];
67
NeedsSingleSpacenull68 function NeedsSingleSpace(const pt, ptNext: TSourceToken): boolean;
69 var
70 lcSameLineToken,lcPrev: TSourceToken;
71 begin
72 Assert(pt <> nil);
73 Assert(ptNext <> nil);
74
75 Result := False;
76
77 if pt.HasParentNode(nLiteralString) then
78 exit;
79
80 if pt.HasParentNode(nAsm) then
81 exit;
82
83 if pt.HasParentNode(nGeneric, 2) then
84 begin
85 if pt.TokenType in [ttComma, ttColon, ttSemiColon] then
86 Result := true;
87 exit;
88 end;
89
90 // if the next token is a comment, leave it where it is, do not adjust spacing
91 if ptNext.TokenType = ttComment then
92 exit;
93
94 // semicolons
95 if (pt.TokenType = ttSemiColon) then
96 begin
97
98 { semciolon as a record field seperator in a const record declaration
99 has no newline (See ReturnAfter.pas), just a single space }
100 if (pt.HasParentNode(nRecordConstant)) then
101 exit(True);
102
103 { semicolon in param declaration list }
104 if (pt.HasParentNode(nFormalParams)) then
105 exit(True);
106
107 { semicolon in param lists in proc type def. as above }
108 if (pt.HasParentNode(nProcedureType)) then
109 exit(True);
110
111 { semicolon in procedure directives }
112 if (pt.HasParentNode(nProcedureDirectives)) then
113 exit(True);
114
115 end;// semicolon
116
117 { function foo: integer; has single space after the colon
118 single space after colon - anywhere? }
119 if pt.TokenType = ttColon then
120 Result := True;
121
122 if (pt.TokenType in SingleSpaceAfterTokens) then
123 begin
124 lcPrev := pt.PriorSolidToken;
125 if (lcPrev <> nil) and (lcPrev.TokenType = ttDot) then // operaror typename.:=( ) .+= .*=
126 exit(false);
127 exit(True);
128 end;
129
130 if pt.TokenType = ttOpenBracket then
131 if FormattingSettings.Spaces.SpaceAfterOpenBrackets then
132 exit(true);
133
134 { 'absolute' as a var directive }
135 if (pt.TokenType = ttAbsolute) and pt.HasParentNode(nVarAbsolute) then
136 exit(True);
137
138 if (pt.TokenType in SingleSpaceAfterWords) then
139 begin
140 { 'procedure' and 'function' in proc type def don't have space after, e.g.
141 type
142 TFredProc = procedure(var psFred: integer); }
143
144 if (pt.HasParentNode(nProcedureType, 2)) and (ptNext.TokenType in
145 [ttOpenBracket, ttSemiColon]) then
146 Result := False
147 else
148 Result := True;
149
150 exit;
151 end;
152
153 if FormattingSettings.Spaces.SpaceForOperator = eAlways then
154 begin
155 if (pt.TokenType in SingleSpaceOperators) then
156 exit(True);
157
158 { + or - but only if it is a binary operator, ie a term to the left of it }
159 if (pt.TokenType in PossiblyUnaryOperators) and (pt.HasParentNode(nExpression)) and
160 ( not IsUnaryOperator(pt)) then
161 exit(True);
162 end;
163
164 { only if it actually is a directive, see TestCases/TestBogusDirectives for details }
165 if (pt.TokenType in AllDirectives) and (pt.HasParentNode(DirectiveNodes)) and
166 (ptNext.TokenType <> ttSemiColon)
167 then
168 exit(True);
169
170 if pt.TokenType = ttEquals then
171 exit(True);
172
173 { 'in' in the uses clause }
174 if (pt.TokenType = ttIn) and (pt.HasParentNode(nUses)) then
175 exit(True);
176
177 { const or var as parameter var types }
178 if (pt.TokenType in ParamTypes) and (pt.HasParentNode(nFormalParams)) then
179 // beware of 'procedure foo (bar: array of const);' and the like
180 if not ((pt.TokenType = ttConst) and pt.HasParentNode(nType, 1)) then
181 exit(True);
182
183 if (pt.TokenType in ParamTypes) and pt.HasParentNode(nPropertyParameterList) and
184 pt.IsOnRightOf(nPropertyParameterList, ttOpenSquareBracket)
185 then
186 exit(True);
187
188 { signle space after read, write etc in property }
189 if pt.HasParentNode(nProperty) then
190 if (pt.TokenType in [ttProperty, ttRead, ttWrite, ttDefault, ttStored, ttImplements])
191 and (ptNext.TokenType <> ttSemiColon)
192 then
193 exit(True);
194
195 { single space before class heritage ?
196 see NoSpaceAfter }
197 if (pt.HasParentNode(nRestrictedType)) and (pt.TokenType in ObjectTypeWords) and
198 (FormattingSettings.Spaces.SpaceBeforeClassHeritage) then
199 begin
200 if (ptNext.TokenType in [ttOpenBracket, ttSemiColon]) then
201 exit(True);
202 end;
203
204 if InStatements(pt) then
205 begin
206 // else if
207 if (pt.TokenType = ttElse) and (ptNext.TokenType = ttIf) then
208 exit(True);
209
210 // end else
211 if (pt.TokenType = ttEnd) and (ptNext.TokenType = ttElse) then
212 exit(True);
213
214 { else followed by something else on the same line,
215 e.g if block style brings up the following "begin" }
216 if (pt.TokenType = ttElse) then
217 begin
218 lcSameLineToken := pt.NexttokenWithExclusions([ttWhiteSpace]);
219 if (lcSameLineToken <> nil) and (not (lcSameLineToken.TokenType in [ttReturn, ttSemiColon])) then
220 exit(True);
221 end;
222 end;
223
224 end;
225
226
227 constructor TSingleSpaceAfter.Create;
228 begin
229 inherited;
230 FormatFlags := FormatFlags + [eAddSpace, eRemoveSpace, eRemoveReturn];
231 end;
232
EnabledVisitSourceTokennull233 function TSingleSpaceAfter.EnabledVisitSourceToken(const pcNode: TObject): boolean;
234 var
235 lcSourceToken: TSourceToken;
236 lcNext, lcNew: TSourceToken;
237 begin
238 Result := False;
239 lcSourceToken := TSourceToken(pcNode);
240
241 { exclude if a comment is next }
242 lcNext := lcSourceToken.NextTokenWithExclusions([ttWhiteSpace, ttReturn]);
243 if lcNext = nil then
244 exit;
245
246 if lcNext.TokenType = ttComment then
247 exit;
248
249 if NeedsSingleSpace(lcSourceToken, lcNext) then
250 begin
251 { inspect the next token }
252 lcNext := lcSourceToken.NextToken;
253 if lcNext.TokenType = ttWhiteSpace then
254 begin
255 lcNext.SourceCode := NativeSpace;
256
257 { empty any preceeding whitespace }
258 repeat
259 lcNext := lcNext.NextToken;
260 if lcNext.TokenType = ttWhiteSpace then
261 lcNext.SourceCode := '';
262 until lcNext.TokenType <> ttWhiteSpace;
263
264 end
265 else if (lcNext.TokenType <> ttReturn) then
266 begin
267 // insert a space
268 lcNew := TSourceToken.Create;
269 lcNew.TokenType := ttWhiteSpace;
270 lcNew.SourceCode := NativeSpace;
271
272 InsertTokenAfter(lcSourceToken, lcNew);
273 end;
274
275 end;
276 end;
277
IsIncludedInSettingsnull278 function TSingleSpaceAfter.IsIncludedInSettings: boolean;
279 begin
280 Result := FormattingSettings.Spaces.FixSpacing;
281 end;
282
283 end.
284