← Back to branch summary

~ubuntu-branches/debian/stretch/adabrowse/stretch

« back to all changes in this revision

Viewing changes to ad-config.adb

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2004-02-14 13:22:40 UTC
  • Revision ID: james.westby@ubuntu.com-20040214132240-cqumhiq1677pkvzo
Tags: upstream-4.0.2
Import upstream version 4.0.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
ad-config.adb
 
1
-------------------------------------------------------------------------------
 
2
--
 
3
--  This file is part of AdaBrowse.
 
4
--
 
5
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
 
6
-- <BLOCKQUOTE>
 
7
--    AdaBrowse is free software; you can redistribute it and/or modify it
 
8
--    under the terms of the  GNU General Public License as published by the
 
9
--    Free Software  Foundation; either version 2, or (at your option) any
 
10
--    later version. AdaBrowse is distributed in the hope that it will be
 
11
--    useful, but <EM>without any warranty</EM>; without even the implied
 
12
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
 
13
--    See the GNU General Public License for  more details. You should have
 
14
--    received a copy of the GNU General Public License with this distribution,
 
15
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
 
16
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
 
17
--    USA.
 
18
-- </BLOCKQUOTE>
 
19
--
 
20
-- <DL><DT><STRONG>
 
21
-- Author:</STRONG><DD>
 
22
--   Thomas Wolf  (TW)
 
23
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
 
24
--
 
25
-- <DL><DT><STRONG>
 
26
-- Purpose:</STRONG><DD>
 
27
--   Configuration file management.</DL>
 
28
--
 
29
-- <!--
 
30
-- Revision History
 
31
--
 
32
--   05-FEB-2002   TW  Created from stuff that had piled up in AD.HTML.
 
33
--   18-FEB-2002   TW  'Configure' now skips empty lines.
 
34
--   22-FEB-2002   TW  'Configure' now skips any non-empty lines that start
 
35
--                     with '#': this allows comments in configuration files.
 
36
--                     Also improved some error messages.
 
37
--   12-MAR-2002   TW  Uses Util.Files.Text_IO.Next_Line now to read the
 
38
--                     configuration file.
 
39
--   13-MAR-2002   TW  Added key 'Index_XRef'.
 
40
--   14-MAR-2002   TW  Added key 'Index_Title'.
 
41
--   02-MAY-2002   TW  Added key 'Include_File', rewrote 'Configure' to do file
 
42
--                     inclusion and check for recursive inclusions.
 
43
--   24-JUN-2002   TW  Changed to use new package 'Util.Files.Config'.
 
44
--   28-JUN-2002   TW  Unquotes now the compile command and index titles.
 
45
--   03-JUL-2002   TW  Handled the case-sensitivity bug for the "Path." keys
 
46
--                     at the source: I mistakenly used 'Key' instead of 'K'.
 
47
--   04-JUN-2002   TW  Added "include" and "xref" keys.
 
48
--   08-JUN-2003   TW  Added 'Full_Name' to 'Set_File_Name'.
 
49
--   02-JUL-2003   TW  Added support for the "index" and "rule" keys.
 
50
--   18-NOV-2003   TW  Use AD.Environment.Get to make sure to account for -X
 
51
--                     options...
 
52
-- -->
 
53
-------------------------------------------------------------------------------
 
54
 
 
55
pragma License (GPL);
 
56
 
 
57
with Ada.Exceptions;
 
58
with Ada.Strings.Maps;
 
59
with Ada.Strings.Unbounded;
 
60
with Ada.Unchecked_Deallocation;
 
61
 
 
62
with AD.Compiler;
 
63
with AD.Crossrefs;
 
64
with AD.Descriptions;
 
65
with AD.Environment;
 
66
with AD.Exclusions;
 
67
with AD.Expressions;
 
68
with AD.Filters;
 
69
with AD.Format;
 
70
with AD.Indices.Configuration;
 
71
with AD.HTML.Pathes;
 
72
with AD.Messages;
 
73
with AD.Printers.HTML;
 
74
with AD.User_Tags;
 
75
 
 
76
with Util.Environment.Bash;
 
77
with Util.Files.Config;
 
78
with Util.Pathes;
 
79
with Util.Strings;
 
80
 
 
81
package body AD.Config is
 
82
 
 
83
   package ASU renames Ada.Strings.Unbounded;
 
84
 
 
85
   use AD.HTML;
 
86
 
 
87
   use Util.Strings;
 
88
 
 
89
   procedure Deallocate is
 
90
      new Ada.Unchecked_Deallocation (String, ASU.String_Access);
 
91
 
 
92
   Reorder          : constant Boolean := True;
 
93
 
 
94
   Config_Files     : ASU.Unbounded_String;
 
95
   Nof_Config_Files : Natural := 0;
 
96
 
 
97
   function Get_Nof_Config_Files
 
98
     return Natural
 
99
   is
 
100
   begin
 
101
      return Nof_Config_Files;
 
102
   end Get_Nof_Config_Files;
 
103
 
 
104
   function Get_Config_Files
 
105
     return String
 
106
   is
 
107
   begin
 
108
      return ASU.To_String (Config_Files);
 
109
   end Get_Config_Files;
 
110
 
 
111
   function Get_Reorder
 
112
     return Boolean
 
113
   is
 
114
   begin
 
115
      return Reorder;
 
116
   end Get_Reorder;
 
117
 
 
118
   ----------------------------------------------------------------------------
 
119
 
 
120
   type Add_Procedure is access procedure (Key : in String);
 
121
 
 
122
   ----------------------------------------------------------------------------
 
123
 
 
124
   type Environment_Expander is
 
125
     new Util.Environment.Bash.Bash_Expander with
 
126
      record
 
127
         File_Name : ASU.String_Access;
 
128
      end record;
 
129
 
 
130
   function Legal_Name
 
131
     (Self   : access Environment_Expander;
 
132
      Source : in     String)
 
133
     return Natural;
 
134
 
 
135
   function Get
 
136
     (Self : access Environment_Expander;
 
137
      Name : in     String)
 
138
     return String;
 
139
 
 
140
   function Legal_Name
 
141
     (Self   : access Environment_Expander;
 
142
      Source : in     String)
 
143
     return Natural
 
144
   is
 
145
   begin
 
146
      if Source'Last >= Source'First and then
 
147
         (Source (Source'First) = '@' or else Source (Source'First) = '$')
 
148
      then
 
149
         return Source'First;
 
150
      end if;
 
151
      --  Super call:
 
152
      return Util.Environment.Bash.Legal_Name
 
153
               (Util.Environment.Bash.Bash_Expander (Self.all)'Access,
 
154
                Source);
 
155
   end Legal_Name;
 
156
 
 
157
   function Get
 
158
     (Self : access Environment_Expander;
 
159
      Name : in     String)
 
160
     return String
 
161
   is
 
162
   begin
 
163
      if Name = "$" then
 
164
         return Util.Pathes.Name (Self.File_Name.all);
 
165
      elsif Name = "@" then
 
166
         return Util.Pathes.Normalize (Util.Pathes.Path (Self.File_Name.all));
 
167
      end if;
 
168
      return AD.Environment.Get (Name);
 
169
      --  Super call:
 
170
      --  return Util.Environment.Bash.Get
 
171
      --           (Util.Environment.Bash.Bash_Expander (Self.all)'Access,
 
172
      --            Name);
 
173
   end Get;
 
174
 
 
175
   ----------------------------------------------------------------------------
 
176
 
 
177
   type Reader (Expander : access Environment_Expander) is
 
178
     new Util.Files.Config.Reader with null record;
 
179
 
 
180
   procedure Set_File_Name
 
181
     (Self      : in out Reader;
 
182
      Name      : in     String;
 
183
      Full_Name : in     String);
 
184
 
 
185
   function Delimiters
 
186
     (Self : in Reader)
 
187
     return Ada.Strings.Maps.Character_Set;
 
188
 
 
189
   function Skip_String
 
190
     (Self  : in Reader;
 
191
      Line  : in String;
 
192
      Delim : in Character)
 
193
     return Natural;
 
194
 
 
195
   function Parse_Key
 
196
     (Self : in Reader;
 
197
      Line : in String)
 
198
     return Natural;
 
199
 
 
200
   procedure New_Key
 
201
     (Self     : in out Reader;
 
202
      Key      : in     String;
 
203
      Operator : in     String;
 
204
      Value    : in     String);
 
205
 
 
206
   procedure Set_File_Name
 
207
     (Self      : in out Reader;
 
208
      Name      : in     String;
 
209
      Full_Name : in     String)
 
210
   is
 
211
      pragma Warnings (Off, Self); --  silence -gnatwa
 
212
   begin
 
213
      if Nof_Config_Files = 0 then
 
214
         Config_Files := ASU.To_Unbounded_String (Name);
 
215
      else
 
216
         ASU.Append (Config_Files, ", " & Name);
 
217
      end if;
 
218
      Nof_Config_Files := Nof_Config_Files + 1;
 
219
      Self.Expander.File_Name := new String'(Full_Name);
 
220
   end Set_File_Name;
 
221
 
 
222
   function Delimiters
 
223
     (Self : in Reader)
 
224
     return Ada.Strings.Maps.Character_Set
 
225
   is
 
226
      pragma Warnings (Off, Self); --  silence -gnatwa
 
227
   begin
 
228
      return Util.Strings.Shell_Quotes;
 
229
   end Delimiters;
 
230
 
 
231
   function Skip_String
 
232
     (Self  : in Reader;
 
233
      Line  : in String;
 
234
      Delim : in Character)
 
235
     return Natural
 
236
   is
 
237
      pragma Warnings (Off, Self); --  silence -gnatwa
 
238
   begin
 
239
      --  Ada format: enclosed delimiters must be doubled.
 
240
      return Util.Strings.Skip_String (Line, Delim, Delim);
 
241
   end Skip_String;
 
242
 
 
243
   function Parse_Key
 
244
     (Self : in Reader;
 
245
      Line : in String)
 
246
     return Natural
 
247
   is
 
248
      I : Natural;
 
249
   begin
 
250
      I := Util.Files.Config.Parse_Key (Util.Files.Config.Reader (Self), Line);
 
251
      --  "Format." key may be followed by a string!
 
252
      if I > 0 and then I + 1 < Line'Last then
 
253
         if Line (I + 1) = '.' and then
 
254
            Is_In (String_Quotes, Line (I + 2)) and then
 
255
            To_Lower (Line (Line'First .. I + 1)) = "format."
 
256
         then
 
257
            --  Last component may be a string!
 
258
            I := Skip_String (Self, Line (I + 2 .. Line'Last), Line (I + 2));
 
259
            if I = 0 then
 
260
               Ada.Exceptions.Raise_Exception
 
261
                 (Invalid_Config'Identity,
 
262
                  "unterminated string found");
 
263
            end if;
 
264
         end if;
 
265
      end if;
 
266
      return I;
 
267
   end Parse_Key;
 
268
 
 
269
   procedure New_Key
 
270
     (Self     : in out Reader;
 
271
      Key      : in     String;
 
272
      Operator : in     String;
 
273
      Value    : in     String)
 
274
   is
 
275
 
 
276
      pragma Warnings (Off, Operator); --  silence -gnatwa
 
277
 
 
278
      procedure Parse_List
 
279
        (Add   : in Add_Procedure;
 
280
         Value : in String)
 
281
      is
 
282
         I, J : Natural;
 
283
      begin
 
284
         I := Value'First;
 
285
         while I <= Value'Last loop
 
286
            J := Index (Value (I .. Value'Last), ',');
 
287
            if J = 0 then J := Value'Last + 1; end if;
 
288
            declare
 
289
               Prefix : constant String := Trim (Value (I .. J - 1));
 
290
            begin
 
291
               if Prefix'Last >= Prefix'First then
 
292
                  Add (To_Lower (Prefix));
 
293
               end if;
 
294
            end;
 
295
            I := J + 1;
 
296
         end loop;
 
297
      end Parse_List;
 
298
 
 
299
      function Read_Bool
 
300
        (Str : in String)
 
301
        return Boolean
 
302
      is
 
303
      begin
 
304
         return Boolean'Value (To_Upper (Str));
 
305
      exception
 
306
         when others =>
 
307
            Ada.Exceptions.Raise_Exception
 
308
              (Invalid_Config'Identity,
 
309
               "value must be either 'True' or 'False'");
 
310
            return False;
 
311
      end Read_Bool;
 
312
 
 
313
      K   : constant String := To_Lower (Key);
 
314
 
 
315
   begin --  New_Key
 
316
      if K = "include_file" then
 
317
         --  Recursive include of a configuration file.
 
318
         declare
 
319
            use type ASU.String_Access;
 
320
            Old_File : constant ASU.String_Access := Self.Expander.File_Name;
 
321
            Name     : constant String :=
 
322
              Expand (Self.Expander, Value);
 
323
         begin
 
324
            --  Note: expansion still uses the old file name!
 
325
            if Name'Last >= Name'First then
 
326
               Util.Files.Config.Read (Name, Self);
 
327
               if Self.Expander.File_Name /= Old_File then
 
328
                  Deallocate (Self.Expander.File_Name);
 
329
                  Self.Expander.File_Name := Old_File;
 
330
               end if;
 
331
            end if;
 
332
         exception
 
333
            when others =>
 
334
               if Self.Expander.File_Name /= Old_File then
 
335
                  Deallocate (Self.Expander.File_Name);
 
336
                  Self.Expander.File_Name := Old_File;
 
337
               end if;
 
338
               raise;
 
339
         end;
 
340
      elsif K = "refs_to_standard" then
 
341
         AD.Crossrefs.Set_Standard_Units (Read_Bool (Value));
 
342
      elsif K = "compile" then
 
343
         AD.Compiler.Set_Compile_Command
 
344
             (Expand (Self.Expander, Unquote_All (Value, Shell_Quotes)));
 
345
      elsif K = "index_title" then
 
346
         AD.Indices.Configuration.Set_Title
 
347
           (AD.Indices.Configuration.Unit_Index, Value);
 
348
      elsif K = "index_xref" then
 
349
         AD.Printers.HTML.Set_Index_XRef (Value);
 
350
      elsif K = "char_set" then
 
351
         Set_Char_Set (Value);
 
352
      elsif K = "style_sheet" then
 
353
         Set_Style_Sheet (Expand (Self.Expander, Value));
 
354
      elsif K = "body" then
 
355
         Set_Body (Value);
 
356
      elsif K = "title.before" then
 
357
         Set_Title (Before, Value);
 
358
      elsif K = "title.after" then
 
359
         Set_Title (After, Value);
 
360
      elsif K = "sub_title.before" then
 
361
         Set_Subtitle (Before, Value);
 
362
      elsif K = "sub_title.after" then
 
363
         Set_Subtitle (After, Value);
 
364
      elsif K = "keyword.before" then
 
365
         Set_Keyword (Before, Value);
 
366
      elsif K = "keyword.after" then
 
367
         Set_Keyword (After, Value);
 
368
      elsif K = "attribute.before" then
 
369
         Set_Attribute (Before, Value);
 
370
      elsif K = "attribute.after" then
 
371
         Set_Attribute (After, Value);
 
372
      elsif K = "definition.before" then
 
373
         Set_Definition (Before, Value);
 
374
      elsif K = "definition.after" then
 
375
         Set_Definition (After, Value);
 
376
      elsif K = "comment.before" then
 
377
         Set_Comment (Before, Value);
 
378
      elsif K = "comment.after" then
 
379
         Set_Comment (After, Value);
 
380
      elsif K = "literal.before" then
 
381
         Set_Literal (Before, Value);
 
382
      elsif K = "literal.after" then
 
383
         Set_Literal (After, Value);
 
384
      elsif K = "no_xref" then
 
385
         Parse_List (AD.Exclusions.Add_No_XRef'Access, Value);
 
386
      elsif K = "xref" then
 
387
         Parse_List (AD.Exclusions.Add_No_XRef_Exception'Access, Value);
 
388
      elsif K = "exclude" then
 
389
         if Value'Last < Value'First then
 
390
            AD.Exclusions.Clear_Exclusions;
 
391
         else
 
392
            Parse_List (AD.Exclusions.Add_Exclusion'Access, Value);
 
393
         end if;
 
394
      elsif K = "include" then
 
395
         if Value'Last < Value'First then
 
396
            AD.Exclusions.Clear_Exclusion_Exceptions;
 
397
         else
 
398
            Parse_List (AD.Exclusions.Add_Exclusion_Exception'Access, Value);
 
399
         end if;
 
400
      elsif Is_Prefix (K, "path.") then
 
401
         if K'Length > 5 then
 
402
            AD.HTML.Pathes.Add_Path
 
403
              (K (K'First + 5 .. K'Last), Expand (Self.Expander, Value));
 
404
         else
 
405
            Ada.Exceptions.Raise_Exception
 
406
              (Invalid_Config'Identity, ''' & Key & "' is an invalid key.");
 
407
         end if;
 
408
      elsif Is_Prefix (K, "description.") then
 
409
         AD.Descriptions.Parse (K (K'First + 12 .. K'Last), Value);
 
410
      elsif Is_Prefix (K, "index_title.") then
 
411
         declare
 
412
            use AD.Indices.Configuration;
 
413
            Idx : Index_Type;
 
414
         begin
 
415
            begin
 
416
               Idx := Index_Type'Value (To_Upper (K (K'First + 12 .. K'Last)));
 
417
            exception
 
418
               when others =>
 
419
                  Ada.Exceptions.Raise_Exception
 
420
                    (Invalid_Config'Identity,
 
421
                     ''' & Key & "' is an invalid key.");
 
422
            end;
 
423
            AD.Indices.Configuration.Set_Title
 
424
              (Idx, Unquote_All (Value, Shell_Quotes));
 
425
         end;
 
426
      elsif Is_Prefix (K, "user_tag.") then
 
427
         begin
 
428
            AD.User_Tags.Parse_Tag
 
429
              (K (K'First + 9 .. K'Last), Value, Self.Expander);
 
430
         exception
 
431
            when E : AD.User_Tags.Invalid_Tag =>
 
432
               Ada.Exceptions.Raise_Exception
 
433
                 (Invalid_Config'Identity,
 
434
                  Ada.Exceptions.Exception_Message (E));
 
435
         end;
 
436
      elsif Is_Prefix (K, "format.") then
 
437
         declare
 
438
            A, B : Natural := 0;
 
439
         begin
 
440
            --  Use 'Key' here, for the string must be case sensitive!!
 
441
            if Key'Length > 8 then
 
442
               if Is_In (String_Quotes, Key (Key'First + 7)) then
 
443
                  A := Key'First + 7;
 
444
                  B := Skip_String
 
445
                         (Self, Key (Key'First + 7 .. Key'Last),
 
446
                          Key (Key'First + 7));
 
447
               end if;
 
448
            end if;
 
449
            if A = 0 then
 
450
               Ada.Exceptions.Raise_Exception
 
451
                 (Invalid_Config'Identity,
 
452
                  "'Format.' must be followed by a string");
 
453
            elsif B = 0 then
 
454
               Ada.Exceptions.Raise_Exception
 
455
                 (Invalid_Config'Identity,
 
456
                  "Unterminated string after 'Format.'");
 
457
            end if;
 
458
            if not Is_Prefix (Key (A + 1 .. B - 1), "--") then
 
459
               Ada.Exceptions.Raise_Exception
 
460
                 (Invalid_Config'Identity,
 
461
                  "Format comment prefix must start with ""--""");
 
462
            end if;
 
463
            begin
 
464
               AD.Format.Enter
 
465
                 (Unquote (Key (A + 1 .. B - 1), Key (A), Key (A)),
 
466
                  AD.Filters.Parse (Expand (Self.Expander, Value)));
 
467
            exception
 
468
               when E : AD.Filters.Parse_Error =>
 
469
                  Ada.Exceptions.Raise_Exception
 
470
                    (Invalid_Config'Identity,
 
471
                     Ada.Exceptions.Exception_Message (E));
 
472
            end;
 
473
         end;
 
474
      elsif Is_Prefix (K, "rule.") then
 
475
         --  Must be followed by an identifier.
 
476
         declare
 
477
            I : constant Natural := Identifier (K (K'First + 5 .. K'Last));
 
478
         begin
 
479
            if I = 0 then
 
480
               Ada.Exceptions.Raise_Exception
 
481
                 (Invalid_Config'Identity,
 
482
                  "'Rule.' must be followed by an identifier");
 
483
            elsif I /= K'Last then
 
484
               Ada.Exceptions.Raise_Exception
 
485
                 (Invalid_Config'Identity,
 
486
                  "Key must have the form 'Rule.<Identifier>'");
 
487
            end if;
 
488
         end;
 
489
         declare
 
490
            Expr      : AD.Expressions.Expression;
 
491
            Redefined : Boolean;
 
492
         begin
 
493
            Expr := AD.Expressions.Parse (Value);
 
494
            AD.Expressions.Define_Macro
 
495
              (Key (Key'First + 5 .. Key'Last), Expr, Redefined);
 
496
            if Redefined then
 
497
               AD.Messages.Info
 
498
                 (Key & " redefined in " & Self.Expander.File_Name.all);
 
499
            end if;
 
500
         exception
 
501
            when E : AD.Expressions.Parse_Error =>
 
502
               Ada.Exceptions.Raise_Exception
 
503
                 (Invalid_Config'Identity,
 
504
                  Ada.Exceptions.Exception_Message (E));
 
505
         end;
 
506
      elsif Is_Prefix (K, "index.") then
 
507
         AD.Indices.Configuration.Parse
 
508
           (Key (Key'First + 6 .. Key'Last), Expand (Self.Expander, Value));
 
509
      else
 
510
         Ada.Exceptions.Raise_Exception
 
511
           (Invalid_Config'Identity, "unknown key '" & Key & ''');
 
512
      end if;
 
513
   end New_Key;
 
514
 
 
515
   ----------------------------------------------------------------------------
 
516
 
 
517
   procedure Configure
 
518
     (File_Name : in String)
 
519
   is
 
520
 
 
521
      Expander : aliased Environment_Expander;
 
522
      Parser   : Reader (Expander'Access);
 
523
 
 
524
   begin
 
525
      Util.Files.Config.Read (File_Name, Parser);
 
526
      Deallocate (Expander.File_Name);
 
527
   exception
 
528
      when E : others =>
 
529
         Deallocate (Expander.File_Name);
 
530
         Ada.Exceptions.Raise_Exception
 
531
           (Invalid_Config'Identity,
 
532
            Ada.Exceptions.Exception_Message (E));
 
533
   end Configure;
 
534
 
 
535
end AD.Config;