]>
Commit | Line | Data |
---|---|---|
996ae0b0 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- S T Y L E S W -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
debe0ab6 | 9 | -- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- |
996ae0b0 RK |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
13 | -- ware Foundation; either version 2, or (at your option) any later ver- -- | |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
996ae0b0 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
fbf5a39b | 27 | with Opt; use Opt; |
996ae0b0 RK |
28 | |
29 | package body Stylesw is | |
30 | ||
31 | ------------------------------- | |
32 | -- Reset_Style_Check_Options -- | |
33 | ------------------------------- | |
34 | ||
35 | procedure Reset_Style_Check_Options is | |
36 | begin | |
debe0ab6 RD |
37 | Style_Check_Indentation := 0; |
38 | Style_Check_Attribute_Casing := False; | |
39 | Style_Check_Blanks_At_End := False; | |
40 | Style_Check_Comments := False; | |
41 | Style_Check_DOS_Line_Terminator := False; | |
42 | Style_Check_End_Labels := False; | |
43 | Style_Check_Form_Feeds := False; | |
44 | Style_Check_Horizontal_Tabs := False; | |
45 | Style_Check_If_Then_Layout := False; | |
46 | Style_Check_Keyword_Casing := False; | |
47 | Style_Check_Layout := False; | |
48 | Style_Check_Max_Line_Length := False; | |
49 | Style_Check_Max_Nesting_Level := False; | |
50 | Style_Check_Order_Subprograms := False; | |
51 | Style_Check_Pragma_Casing := False; | |
52 | Style_Check_References := False; | |
53 | Style_Check_Specs := False; | |
54 | Style_Check_Standard := False; | |
55 | Style_Check_Tokens := False; | |
56 | Style_Check_Xtra_Parens := False; | |
996ae0b0 RK |
57 | end Reset_Style_Check_Options; |
58 | ||
59 | ------------------------------ | |
60 | -- Save_Style_Check_Options -- | |
61 | ------------------------------ | |
62 | ||
63 | procedure Save_Style_Check_Options (Options : out Style_Check_Options) is | |
64 | P : Natural := 0; | |
996ae0b0 RK |
65 | |
66 | procedure Add (C : Character; S : Boolean); | |
67 | -- Add given character C to string if switch S is true | |
68 | ||
0da2c8ac AC |
69 | procedure Add_Nat (N : Nat); |
70 | -- Add given natural number to string | |
71 | ||
72 | --------- | |
73 | -- Add -- | |
74 | --------- | |
75 | ||
996ae0b0 RK |
76 | procedure Add (C : Character; S : Boolean) is |
77 | begin | |
78 | if S then | |
79 | P := P + 1; | |
80 | Options (P) := C; | |
81 | end if; | |
82 | end Add; | |
83 | ||
0da2c8ac AC |
84 | ------------- |
85 | -- Add_Nat -- | |
86 | ------------- | |
87 | ||
88 | procedure Add_Nat (N : Nat) is | |
89 | begin | |
90 | if N > 9 then | |
91 | Add_Nat (N / 10); | |
92 | end if; | |
93 | ||
94 | P := P + 1; | |
95 | Options (P) := Character'Val (Character'Pos ('0') + N mod 10); | |
96 | end Add_Nat; | |
97 | ||
996ae0b0 RK |
98 | -- Start of processing for Save_Style_Check_Options |
99 | ||
100 | begin | |
101 | for K in Options'Range loop | |
102 | Options (K) := ' '; | |
103 | end loop; | |
104 | ||
105 | Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')), | |
106 | Style_Check_Indentation /= 0); | |
107 | ||
108 | Add ('a', Style_Check_Attribute_Casing); | |
109 | Add ('b', Style_Check_Blanks_At_End); | |
110 | Add ('c', Style_Check_Comments); | |
debe0ab6 | 111 | Add ('d', Style_Check_DOS_Line_Terminator); |
996ae0b0 RK |
112 | Add ('e', Style_Check_End_Labels); |
113 | Add ('f', Style_Check_Form_Feeds); | |
114 | Add ('h', Style_Check_Horizontal_Tabs); | |
115 | Add ('i', Style_Check_If_Then_Layout); | |
116 | Add ('k', Style_Check_Keyword_Casing); | |
117 | Add ('l', Style_Check_Layout); | |
996ae0b0 | 118 | Add ('n', Style_Check_Standard); |
7fe16580 | 119 | Add ('o', Style_Check_Order_Subprograms); |
996ae0b0 RK |
120 | Add ('p', Style_Check_Pragma_Casing); |
121 | Add ('r', Style_Check_References); | |
122 | Add ('s', Style_Check_Specs); | |
123 | Add ('t', Style_Check_Tokens); | |
62b63164 | 124 | Add ('x', Style_Check_Xtra_Parens); |
996ae0b0 RK |
125 | |
126 | if Style_Check_Max_Line_Length then | |
0da2c8ac | 127 | P := P + 1; |
996ae0b0 | 128 | Options (P) := 'M'; |
0da2c8ac AC |
129 | Add_Nat (Style_Max_Line_Length); |
130 | end if; | |
131 | ||
132 | if Style_Check_Max_Nesting_Level then | |
133 | P := P + 1; | |
134 | Options (P) := 'L'; | |
135 | Add_Nat (Style_Max_Nesting_Level); | |
996ae0b0 RK |
136 | end if; |
137 | ||
0da2c8ac AC |
138 | pragma Assert (P <= Options'Last); |
139 | ||
140 | while P < Options'Last loop | |
141 | P := P + 1; | |
142 | Options (P) := ' '; | |
143 | end loop; | |
996ae0b0 RK |
144 | end Save_Style_Check_Options; |
145 | ||
146 | ------------------------------------- | |
147 | -- Set_Default_Style_Check_Options -- | |
148 | ------------------------------------- | |
149 | ||
150 | procedure Set_Default_Style_Check_Options is | |
151 | begin | |
152 | Reset_Style_Check_Options; | |
153 | Set_Style_Check_Options ("3abcefhiklmnprst"); | |
154 | end Set_Default_Style_Check_Options; | |
155 | ||
156 | ----------------------------- | |
157 | -- Set_Style_Check_Options -- | |
158 | ----------------------------- | |
159 | ||
160 | -- Version used when no error checking is required | |
161 | ||
162 | procedure Set_Style_Check_Options (Options : String) is | |
163 | OK : Boolean; | |
164 | EC : Natural; | |
996ae0b0 RK |
165 | begin |
166 | Set_Style_Check_Options (Options, OK, EC); | |
167 | end Set_Style_Check_Options; | |
168 | ||
169 | -- Normal version with error checking | |
170 | ||
171 | procedure Set_Style_Check_Options | |
172 | (Options : String; | |
173 | OK : out Boolean; | |
174 | Err_Col : out Natural) | |
175 | is | |
176 | J : Natural; | |
177 | C : Character; | |
178 | ||
179 | begin | |
180 | J := Options'First; | |
181 | while J <= Options'Last loop | |
182 | C := Options (J); | |
183 | J := J + 1; | |
184 | ||
185 | case C is | |
186 | when '1' .. '9' => | |
187 | Style_Check_Indentation | |
188 | := Character'Pos (C) - Character'Pos ('0'); | |
189 | ||
190 | when 'a' => | |
debe0ab6 | 191 | Style_Check_Attribute_Casing := True; |
996ae0b0 RK |
192 | |
193 | when 'b' => | |
debe0ab6 | 194 | Style_Check_Blanks_At_End := True; |
996ae0b0 RK |
195 | |
196 | when 'c' => | |
debe0ab6 RD |
197 | Style_Check_Comments := True; |
198 | ||
199 | when 'd' => | |
200 | Style_Check_DOS_Line_Terminator := True; | |
996ae0b0 RK |
201 | |
202 | when 'e' => | |
debe0ab6 | 203 | Style_Check_End_Labels := True; |
996ae0b0 RK |
204 | |
205 | when 'f' => | |
debe0ab6 | 206 | Style_Check_Form_Feeds := True; |
996ae0b0 RK |
207 | |
208 | when 'h' => | |
debe0ab6 | 209 | Style_Check_Horizontal_Tabs := True; |
996ae0b0 RK |
210 | |
211 | when 'i' => | |
debe0ab6 | 212 | Style_Check_If_Then_Layout := True; |
996ae0b0 RK |
213 | |
214 | when 'k' => | |
debe0ab6 | 215 | Style_Check_Keyword_Casing := True; |
996ae0b0 RK |
216 | |
217 | when 'l' => | |
debe0ab6 | 218 | Style_Check_Layout := True; |
996ae0b0 | 219 | |
0da2c8ac AC |
220 | when 'L' => |
221 | Style_Max_Nesting_Level := 0; | |
222 | ||
223 | if J > Options'Last | |
224 | or else Options (J) not in '0' .. '9' | |
225 | then | |
226 | OK := False; | |
227 | Err_Col := J; | |
228 | return; | |
229 | end if; | |
230 | ||
231 | loop | |
232 | Style_Max_Nesting_Level := | |
233 | Style_Max_Nesting_Level * 10 + | |
234 | Character'Pos (Options (J)) - Character'Pos ('0'); | |
235 | ||
236 | if Style_Max_Nesting_Level > 999 then | |
237 | OK := False; | |
238 | Err_Col := J; | |
239 | return; | |
240 | end if; | |
241 | ||
242 | J := J + 1; | |
243 | exit when J > Options'Last | |
244 | or else Options (J) not in '0' .. '9'; | |
245 | end loop; | |
246 | ||
247 | Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0; | |
248 | ||
996ae0b0 | 249 | when 'm' => |
debe0ab6 RD |
250 | Style_Check_Max_Line_Length := True; |
251 | Style_Max_Line_Length := 79; | |
996ae0b0 RK |
252 | |
253 | when 'n' => | |
debe0ab6 | 254 | Style_Check_Standard := True; |
996ae0b0 | 255 | |
2e071734 AC |
256 | when 'N' => |
257 | Reset_Style_Check_Options; | |
258 | ||
996ae0b0 RK |
259 | when 'M' => |
260 | Style_Max_Line_Length := 0; | |
261 | ||
262 | if J > Options'Last | |
263 | or else Options (J) not in '0' .. '9' | |
264 | then | |
265 | OK := False; | |
266 | Err_Col := J; | |
267 | return; | |
268 | end if; | |
269 | ||
270 | loop | |
271 | Style_Max_Line_Length := | |
272 | Style_Max_Line_Length * 10 + | |
273 | Character'Pos (Options (J)) - Character'Pos ('0'); | |
fbf5a39b AC |
274 | |
275 | if Style_Max_Line_Length > Int (Column_Number'Last) then | |
276 | OK := False; | |
277 | Err_Col := J; | |
278 | return; | |
279 | end if; | |
280 | ||
996ae0b0 RK |
281 | J := J + 1; |
282 | exit when J > Options'Last | |
283 | or else Options (J) not in '0' .. '9'; | |
284 | end loop; | |
285 | ||
62b63164 | 286 | Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0; |
996ae0b0 RK |
287 | |
288 | when 'o' => | |
debe0ab6 | 289 | Style_Check_Order_Subprograms := True; |
996ae0b0 RK |
290 | |
291 | when 'p' => | |
debe0ab6 | 292 | Style_Check_Pragma_Casing := True; |
996ae0b0 RK |
293 | |
294 | when 'r' => | |
debe0ab6 | 295 | Style_Check_References := True; |
996ae0b0 RK |
296 | |
297 | when 's' => | |
debe0ab6 | 298 | Style_Check_Specs := True; |
996ae0b0 RK |
299 | |
300 | when 't' => | |
debe0ab6 | 301 | Style_Check_Tokens := True; |
996ae0b0 | 302 | |
62b63164 | 303 | when 'x' => |
debe0ab6 | 304 | Style_Check_Xtra_Parens := True; |
62b63164 | 305 | |
996ae0b0 RK |
306 | when ' ' => |
307 | null; | |
308 | ||
309 | when others => | |
310 | OK := False; | |
311 | Err_Col := J - 1; | |
312 | return; | |
313 | end case; | |
314 | end loop; | |
315 | ||
316 | Style_Check := True; | |
317 | OK := True; | |
318 | Err_Col := Options'Last + 1; | |
319 | end Set_Style_Check_Options; | |
320 | ||
321 | end Stylesw; |