ocarina-backends-xml_tree-generator.adb 14.6 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--  O C A R I N A . B A C K E N D S . X M L _ T R E E . G E N E R A T O R   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
yoogx's avatar
yoogx committed
9
--    Copyright (C) 2008-2009 Telecom ParisTech, 2010-2018 ESA & ISAE.      --
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
--                                                                          --
-- Ocarina  is free software; you can redistribute it and/or modify under   --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
jhugues's avatar
jhugues committed
27
28
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
29
30
31
--                                                                          --
------------------------------------------------------------------------------

32
33
with Ocarina.Namet;  use Ocarina.Namet;
with Ocarina.Output; use Ocarina.Output;
yoogx's avatar
yoogx committed
34
with Utils;          use Utils;
35

36
with Ada.Directories;
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
with GNAT.OS_Lib; use GNAT.OS_Lib;

with Ocarina.Backends.Utils;
with Ocarina.Backends.XML_Tree.Nodes;
with Ocarina.Backends.XML_Tree.Nutils;
with Ocarina.Backends.XML_Values;
with Ocarina.Backends.Messages;

package body Ocarina.Backends.XML_Tree.Generator is

   use Ocarina.Backends.Utils;
   use Ocarina.Backends.XML_Tree.Nodes;
   use Ocarina.Backends.XML_Tree.Nutils;
   use Ocarina.Backends.XML_Values;
   use Ocarina.Backends.Messages;

   procedure Generate_XML_Comment (N : Node_Id);
   procedure Generate_HI_Distributed_Application (N : Node_Id);
   procedure Generate_HI_Node (N : Node_Id);
   procedure Generate_Defining_Identifier (N : Node_Id);
   procedure Generate_HI_Unit (N : Node_Id);
   procedure Generate_Assignement (N : Node_Id);
   procedure Generate_Literal (N : Node_Id);
   procedure Generate_XML_Node (N : Node_Id);
   procedure Generate_XML_File (N : Node_Id);

   procedure Write (T : Token_Type);
   procedure Write_Line (T : Token_Type);

   function Get_File_Name (N : Node_Id) return Name_Id;
   --  Generate a file name from the package node given as parameter

   procedure Release_Output (Fd : File_Descriptor);
   --  Releases the output by closing the opened files

   function Set_Output (N : Node_Id) return File_Descriptor;
   --  Adjust the output depending on the command line options and
   --  return a file descriptor in order to be able to close it.

   -------------------
   -- Get_File_Name --
   -------------------

   function Get_File_Name (N : Node_Id) return Name_Id is
81
82
      Suffix_XML  : constant String := ".xml";
      Suffix_HTML : constant String := ".html";
83
84
85
86
   begin
      --  The File name corresponding is the lowerd name of N

      Get_Name_String
87
        (Conventional_Base_Name (Name (Defining_Identifier (N))));
88
89

      --  Adding file suffix
90
91
92
93
94
      if Is_HTML (N) then
         Add_Str_To_Name_Buffer (Suffix_HTML);
      else
         Add_Str_To_Name_Buffer (Suffix_XML);
      end if;
95
96
97
98
99
100
101
102
103
104
105
106

      return Name_Find;
   end Get_File_Name;

   ----------------
   -- Set_Output --
   ----------------

   function Set_Output (N : Node_Id) return File_Descriptor is
   begin
      if not Print_On_Stdout then
         declare
107
108
109
            File_Name        : constant Name_Id := Get_File_Name (N);
            File_Name_String : constant String  := Get_Name_String (File_Name);
            Fd               : File_Descriptor;
110

111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
         begin
            if Present (XML_DTD (N)) then
               --  If a DTD has been specified, copy it as target
               --  file, then move at the end of the file to add
               --  output.

               Ada.Directories.Copy_File
                 (Source_Name => Get_Name_String (Name (XML_DTD (N))),
                  Target_Name => File_Name_String);
               Fd := Open_Read_Write (File_Name_String, Text);
               Lseek (Fd, 0, Seek_End);
            else
               --  Else, create a new file, overwrite existing file

               Fd := Create_File (File_Name_String, Text);
            end if;
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249

            if Fd = Invalid_FD then
               raise Program_Error;
            end if;

            --  Setting the output

            Set_Output (Fd);
            return Fd;
         end;
      end if;

      return Invalid_FD;
   end Set_Output;

   --------------------
   -- Release_Output --
   --------------------

   procedure Release_Output (Fd : File_Descriptor) is
   begin
      if not Print_On_Stdout and then Fd /= Invalid_FD then
         Set_Standard_Output;
         Close (Fd);
      end if;
   end Release_Output;

   --------------
   -- Generate --
   --------------

   procedure Generate (N : Node_Id) is
   begin
      case Kind (N) is
         when K_XML_Comment =>
            Generate_XML_Comment (N);

         when K_HI_Distributed_Application =>
            Generate_HI_Distributed_Application (N);

         when K_HI_Unit =>
            Generate_HI_Unit (N);

         when K_XML_File =>
            Generate_XML_File (N);

         when K_HI_Node =>
            Generate_HI_Node (N);

         when K_Defining_Identifier =>
            Generate_Defining_Identifier (N);

         when K_XML_Node =>
            Generate_XML_Node (N);

         when K_Literal =>
            Generate_Literal (N);

         when K_Assignement =>
            Generate_Assignement (N);

         when others =>
            Display_Error ("other element in generator", Fatal => False);
            null;
      end case;
   end Generate;

   --------------------------
   -- Generate_XML_Comment --
   --------------------------

   procedure Generate_XML_Comment (N : Node_Id) is
      --  This procedure does the following :

      --  * It generates an XML comment basing on the name of node N

      --  * If the name it too long, and depending on the location of
      --    the comment in the source code, the procedure splits the
      --    comment into more than a line.

      --  The comment is assumed to be a sequence of caracters,
      --  beginning and ending with a NON-SPACE caracter.

      --  A word is :

      --  a space character, or else a sequence of non space
      --  characters located between two spaces.

      --  The maximum length of a line, in colums
      Max_Line_Length : constant Natural := 78;

      function Are_There_More_Words return Boolean;
      --  This function returns True if there are words in the buffer

      function Next_Word_Length return Natural;
      --  This function returns the size of the next word to be
      --  got. It returns zero when the buffer is empty.

      function Get_Next_Word return String;
      --  This function extracts the next word from the buffer

      --------------------------
      -- Are_There_More_Words --
      --------------------------

      function Are_There_More_Words return Boolean is
      begin
         return (Name_Len /= 0);
      end Are_There_More_Words;

      ----------------------
      -- Next_Word_Length --
      ----------------------

      function Next_Word_Length return Natural is
         L : Natural;
      begin
         if not Are_There_More_Words then
            L := 0;
         elsif Name_Buffer (1) = ' ' then
            L := 1;
         else
            L := 0;
250
            while L + 1 <= Name_Len and then Name_Buffer (L + 1) /= ' ' loop
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
               L := L + 1;
            end loop;
         end if;
         return L;
      end Next_Word_Length;

      -------------------
      -- Get_Next_Word --
      -------------------

      function Get_Next_Word return String is
         L : constant Natural := Next_Word_Length;
      begin
         if L = 0 then
            return "";
         else
            declare
               Next_Word : constant String := Name_Buffer (1 .. L);
            begin
               if Name_Len = L then
                  Name_Len := 0;
               else
                  Set_Str_To_Name_Buffer (Name_Buffer (L + 1 .. Name_Len));
               end if;
               return Next_Word;
            end;
         end if;
      end Get_Next_Word;

280
      First_Line   : Boolean := True;
281
282
283
284
285
286
287
288
289
290
291
292
293
294
      Used_Columns : Natural;
   begin
      Get_Name_String (Name (Defining_Identifier (N)));

      while Are_There_More_Words loop
         Used_Columns := N_Space;
         if First_Line then
            First_Line := False;
         else
            Write_Indentation;
         end if;

         --  We consume 4 colums

yoogx's avatar
yoogx committed
295
         Write_Eol;
296
         Used_Columns := Used_Columns + 2;
yoogx's avatar
yoogx committed
297
         Write_Str ("<!-- ");
298
299
300
301
302
303
304
305
306
307

         Used_Columns := Used_Columns + Next_Word_Length;
         Write_Str (Get_Next_Word);

         while Are_There_More_Words
           and then (Used_Columns + Next_Word_Length < Max_Line_Length)
         loop
            Used_Columns := Used_Columns + Next_Word_Length;
            Write_Str (Get_Next_Word);
         end loop;
yoogx's avatar
yoogx committed
308
         Write_Str (" -->");
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335

         if Are_There_More_Words then
            Write_Eol;
         end if;
      end loop;
      Write_Eol;
   end Generate_XML_Comment;

   ----------------------------------
   -- Generate_Defining_Identifier --
   ----------------------------------

   procedure Generate_Defining_Identifier (N : Node_Id) is
   begin
      Write_Name (Name (N));
   end Generate_Defining_Identifier;

   -----------------------------------------
   -- Generate_HI_Distributed_Application --
   -----------------------------------------

   procedure Generate_HI_Distributed_Application (N : Node_Id) is
      P                     : Node_Id := First_Node (HI_Nodes (N));
      Application_Directory : Name_Id;
   begin
      --  Create the application directory (a lower case string)

336
337
338
      if Name (N) /= No_Name then
         Get_Name_String (Name (N));
         Application_Directory := To_Lower (Name_Find);
339

340
         Create_Directory (Application_Directory);
341

342
343
344
345
         --  Process the application nodes

         Enter_Directory (Application_Directory);
      end if;
346
347
348
349
350
351

      while Present (P) loop
         Generate (P);
         P := Next_Node (P);
      end loop;

352
353
354
      if Name (N) /= No_Name then
         Leave_Directory;
      end if;
355
356
357
358
359
360
361
   end Generate_HI_Distributed_Application;

   ----------------------
   -- Generate_HI_Node --
   ----------------------

   procedure Generate_HI_Node (N : Node_Id) is
362
      U : Node_Id := First_Node (Units (N));
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
   begin
      while Present (U) loop
         Generate (U);
         U := Next_Node (U);
      end loop;
   end Generate_HI_Node;

   -----------
   -- Write --
   -----------

   procedure Write (T : Token_Type) is
   begin
      Write_Name (Token_Image (T));
   end Write;

   ----------------
   -- Write_Line --
   ----------------

   procedure Write_Line (T : Token_Type) is
   begin
      Write (T);
      Write_Eol;
   end Write_Line;

   ----------------------
   -- Generate_HI_Unit --
   ----------------------

   procedure Generate_HI_Unit (N : Node_Id) is
   begin
      Generate (XML_File (N));
   end Generate_HI_Unit;

   ----------------------
   -- Generate_Literal --
   ----------------------

   procedure Generate_Literal (N : Node_Id) is
   begin
      Write_Str (Image (Value (N)));
   end Generate_Literal;

   --------------------------
   -- Generate_Assignement --
   --------------------------

   procedure Generate_Assignement (N : Node_Id) is
   begin
      Generate (Left_Expression (N));
      Write (Tok_Equal);
      Write_Char ('"');
      Generate (Right_Expression (N));
      Write_Char ('"');
   end Generate_Assignement;

   -----------------------
   -- Generate_XML_Node --
   -----------------------

   procedure Generate_XML_Node (N : Node_Id) is
      P : Node_Id;
   begin
      if Name (Defining_Identifier (N)) = No_Name then
         P := First_Node (Subitems (N));
         while Present (P) loop
            Write_Indentation (-1);
            Generate (P);
            P := Next_Node (P);
         end loop;
         return;
      end if;

      Write (Tok_Less);
      Generate (Defining_Identifier (N));

      if Items (N) /= No_List then
         P := First_Node (Items (N));
         while Present (P) loop
            Write_Space;
            Generate (P);
            P := Next_Node (P);
         end loop;
      end if;

      if Is_Empty (Subitems (N)) and then not Present (Node_Value (N)) then
         Write (Tok_Slash);
         Write (Tok_Greater);
         Write_Eol;
      else
         if Present (Node_Value (N)) then
            Write (Tok_Greater);
            Generate (Node_Value (N));
         else
            Write (Tok_Greater);
            Write_Eol;
            Increment_Indentation;
            P := First_Node (Subitems (N));
            while Present (P) loop
               Write_Indentation (-1);
               Generate (P);
               P := Next_Node (P);
            end loop;
            Decrement_Indentation;
            Write_Indentation (-1);
         end if;
         Write (Tok_Less);
         Write (Tok_Slash);
         Generate (Defining_Identifier (N));
         Write_Line (Tok_Greater);
      end if;
   end Generate_XML_Node;

   -----------------------
   -- Generate_XML_File --
   -----------------------

   procedure Generate_XML_File (N : Node_Id) is
482
      pragma Assert (Present (N));
483
484
485
486
487
488
489
490
491
492
      Fd : File_Descriptor;
   begin
      Fd := Set_Output (N);

      Generate (Root_Node (N));

      Release_Output (Fd);
   end Generate_XML_File;

end Ocarina.Backends.XML_Tree.Generator;