1 unit FormatFlags;
2 
3 { AFS 20 July 2001
4 
5   Code formatter exclusions flags
6   These flags are used to switch off formatting based on special comments }
7 
8 {(*}
9 (*------------------------------------------------------------------------------
10  Delphi Code formatter source code
11 
12 The Original Code is FormatFlags, released May 2003.
13 The Initial Developer of the Original Code is Anthony Steele.
14 Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
15 All Rights Reserved.
16 Contributor(s): Anthony Steele.
17 
18 The contents of this file are subject to the Mozilla Public License Version 1.1
19 (the "License"). you may not use this file except in compliance with the License.
20 You may obtain a copy of the License at http://www.mozilla.org/NPL/
21 
22 Software distributed under the License is distributed on an "AS IS" basis,
23 WITHOUT WARRANTY OF ANY KIND, either express or implied.
24 See the License for the specific language governing rights and limitations
25 under the License.
26 
27 Alternatively, the contents of this file may be used under the terms of
28 the GNU General Public License Version 2 or later (the "GPL")
29 See http://www.gnu.org/licenses/gpl.html
30 ------------------------------------------------------------------------------*)
31 {*)}
32 
33 {$I JcfGlobal.inc}
34 
35 interface
36 
37 type
38 
39   TFormatFlag = (eAllFormat,
40     eObfuscate,
41     eAddSpace, eRemoveSpace,
42     eAddReturn, eRemoveReturn,
43     eAlignVars, eAlignConst, eAlignTypeDef, eAlignAssign, eAlignComment, eAlignField,
44     eCapsReservedWord, eCapsSpecificWord,
45     eIndent, eLineBreaking, eBlockStyle,
46     eWarning,
47     eFindReplace, eFindReplaceUses, eRemoveComments);
48 
49 
50   { these flags control:
51 
52     AllFormat: all clarify processes - turn the formatter as a whole on or off
53     space: all processes that insert or remove spaces
54     indent: inenting of code blocks etc
55     return: all processes that insert or remove returns - note tat there is some overlap with
56     eAlign: alignment of vars, assigns etc
57     eLineBreaking: spliting long lines into 2 or more
58     eBlockStyle - where to put begins & ends, else, etc
59     eWarning: supress warnings
60   }
61 
62   TFormatFlags = set of TFormatFlag;
63 
64 { read a comment for comment enabled flag data }
ReadCommentJcfFlagsnull65 function ReadCommentJcfFlags(psComment: string; out psError: string;
66   out peFlags: TFormatFlags; out pbOn: boolean): boolean;
67 
68 const
69   FORMAT_COMMENT_PREFIX     = '//jcf:';
70   FORMAT_COMMENT_PREFIX_LEN = 6;
71 
72   ALL_FLAGS: TFormatFlags = [Low(TFormatFlag)..High(TFormatFlag)];
73 
74 implementation
75 
76 uses
77   { delphi }
78   {$ifndef fpc}Windows,{$endif} SysUtils,
79   { local }
80   JcfStringUtils;
81 
82 type
83   TRFlagNameData = record
84     sName: string;
85     eFlags: TFormatFlags;
86   end;
87 
88 const
89   FORMAT_FLAG_NAMES: array[1..29] of TRFlagNameData =
90     (
91     (sName: 'format'; eFlags: [eAllFormat]),
92     (sName: 'obfuscate'; eFlags: [eObfuscate]),
93 
94 
95     (sName: 'space'; eFlags: [eAddSpace, eRemoveSpace]),
96     (sName: 'addspace'; eFlags: [eAddSpace]),
97     (sName: 'removespace'; eFlags: [eRemoveSpace]),
98 
99 
100     (sName: 'return'; eFlags: [eAddReturn, eRemoveReturn]),
101     (sName: 'addreturn'; eFlags: [eAddReturn]),
102     (sName: 'removereturn'; eFlags: [eRemoveReturn]),
103 
104     (sName: 'add'; eFlags: [eAddReturn, eAddSpace]),
105     (sName: 'remove'; eFlags: [eRemoveReturn, eRemoveSpace]),
106 
107 
108     (sName: 'align'; eFlags: [eAlignVars, eAlignConst, eAlignTypeDef,
109     eAlignAssign, eAlignComment]),
110     (sName: 'aligndef'; eFlags: [eAlignVars, eAlignConst, eAlignTypeDef]),
111     (sName: 'alignfn'; eFlags: [eAlignVars, eAlignAssign]),
112 
113     (sName: 'alignvars'; eFlags: [eAlignVars]),
114     (sName: 'alignconst'; eFlags: [eAlignConst]),
115     (sName: 'aligntypedef'; eFlags: [eAlignTypeDef]),
116     (sName: 'alignassign'; eFlags: [eAlignAssign]),
117     (sName: 'aligncomment'; eFlags: [eAlignComment]),
118     (sName: 'alignfield'; eFlags: [eAlignField]),
119 
120 
121     (sName: 'indent'; eFlags: [eIndent]),
122 
123     (sName: 'caps'; eFlags: [eCapsReservedWord, eCapsSpecificWord]),
124     (sName: 'capsreservedwords'; eFlags: [eCapsReservedWord]),
125     (sName: 'capsspecificword'; eFlags: [eCapsSpecificWord]),
126 
127 
128     (sName: 'linebreaking'; eFlags: [eLineBreaking]),
129     (sName: 'blockstyle'; eFlags: [eBlockStyle]),
130 
131     (sName: 'warnings'; eFlags: [eWarning]),
132     (sName: 'findreplace'; eFlags: [eFindReplace]),
133     (sName: 'findreplaceuses'; eFlags: [eFindReplaceUses]),
134 
135     (sName: 'reovecomments'; eFlags: [eRemoveComments])
136     );
137 
138 
139 { can stop and restart formating using these comments
140  from DelForExp - Egbbert Van Nes's program }
141 const
142   OLD_NOFORMAT_ON  = '{(*}';
143   OLD_NOFORMAT_OFF = '{*)}';
144 
145   NOFORMAT_ON  = FORMAT_COMMENT_PREFIX + 'format=off';
146   NOFORMAT_OFF = FORMAT_COMMENT_PREFIX + 'format=on';
147 
148 { like StrToBoolean, but recognises 'on' and 'off' too }
LStrToBooleannull149 function LStrToBoolean(const ps: string): boolean;
150 begin
151   if AnsiSameText(ps, 'on') then
152     Result := True
153   else if AnsiSameText(ps, 'off') then
154     Result := False
155   else
156     Result := StrToBoolean(ps);
157 end;
158 
159 { this function works as follows
160   Give it a comment text (psComment)
161   and it returns
162   - True if the comment is a special JCF flags comment
163   psError is empty if the flags could be parsed, else contains an error message
164   psFlags returns the set of flags referenced
165   pbOn tells if they were turned on or off
166 }
ReadCommentJcfFlagsnull167 function ReadCommentJcfFlags(psComment: string; out psError: string;
168   out peFlags: TFormatFlags; out pbOn: boolean): boolean;
169 var
170   lsPrefix, lsRest: string;
171   lsSetting, lsState: string;
172   lbFlagFound: boolean;
173   liLoop:      integer;
174 begin
175   Result  := False;
176   psError := '';
177 
178   // translate {(*} comments to jcf:format=on comments
179   if psComment = OLD_NOFORMAT_ON then
180     psComment := NOFORMAT_ON
181   else if psComment = OLD_NOFORMAT_OFF then
182     psComment := NOFORMAT_OFF;
183 
184   { all comments without the required prefix are of no import to this code
185     if it's not one, then exit without error }
186   lsPrefix := StrLeft(psComment, 6);
187   if not (AnsiSameText(lsPrefix, FORMAT_COMMENT_PREFIX)) then
188     exit;
189 
190   // should be a valid jcf flag directive after here
191   Result := True;
192   lsRest := Trim(StrRestOf(psComment, 7));
193 
194   { rest should read <setting>=<state>
195     where the setting is one of the format flags, and the state is 'on' or 'off'
196   }
197   lsSetting := Trim(StrBefore('=', lsRest));
198   lsState   := Trim(StrAfter('=', lsRest));
199 
200   { is the comment well formed? }
201   if (lsSetting = '') or (lsState = '') then
202   begin
203     psError := 'Comment ' + StrDoubleQuote(psComment) +
204       ' has prefix but cannot be parsed';
205     exit;
206   end;
207 
208   { try and get a state flag from the string, abort if it fails }
209   try
210     pbOn := LStrToBoolean(lsState);
211   except
212     On EJcfConversionError do
213     begin
214       psError := 'In comment ' + StrDoubleQuote(psComment) + ' , ' +
215         ' state ' + StrDoubleQuote(lsState) + ' cannot be parsed to either on or off';
216       exit;
217     end
218     else
219       raise;
220   end;
221 
222   lbFlagFound := False;
223 
224   // accept jcf:all=on to reset state to normal by removing all flags
225   if AnsiSameText(lsSetting, 'all') then
226   begin
227     peFlags     := ALL_FLAGS;
228     lbFlagFound := True;
229   end
230   else
231   begin
232     { match the setting from the table }
233     for liLoop := low(FORMAT_FLAG_NAMES) to high(FORMAT_FLAG_NAMES) do
234     begin
235       if AnsiSameText(lsSetting, FORMAT_FLAG_NAMES[liLoop].sName) then
236       begin
237         peFlags     := FORMAT_FLAG_NAMES[liLoop].eFlags;
238         lbFlagFound := True;
239         break;
240       end;
241     end;
242   end;
243 
244   if not lbFlagFound then
245   begin
246     // unknown setting - nothing to do except log a message
247     psError := 'In comment ' + StrDoubleQuote(psComment) + ' , ' +
248       ' setting ' + StrDoubleQuote(lsSetting) + ' is not known';
249     exit;
250   end;
251 end;
252 
253 end.
254