-- --
-- B o d y --
-- --
--- $Revision: 1.33 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc.
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with GNAT.Spitbol; use GNAT.Spitbol;
with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
Err : exception;
-- Raised on fatal error
- A : VString := Nul;
- Ffield : VString := Nul;
- Field : VString := Nul;
- Fieldno : VString := Nul;
- Flagno : VString := Nul;
- Line : VString := Nul;
- Name : VString := Nul;
- Node : VString := Nul;
- Outstring : VString := Nul;
- Prefix : VString := Nul;
- S : VString := Nul;
- S1 : VString := Nul;
- Sinforev : VString := Nul;
- Syn : VString := Nul;
- Synonym : VString := Nul;
- Temprev : VString := Nul;
- Term : VString := Nul;
- Treeprsrev : VString := Nul;
-
- OutS : File_Type;
+ A : VString := Nul;
+ Ffield : VString := Nul;
+ Field : VString := Nul;
+ Fieldno : VString := Nul;
+ Flagno : VString := Nul;
+ Line : VString := Nul;
+ Name : VString := Nul;
+ Node : VString := Nul;
+ Outstring : VString := Nul;
+ Prefix : VString := Nul;
+ S : VString := Nul;
+ S1 : VString := Nul;
+ Syn : VString := Nul;
+ Synonym : VString := Nul;
+ Term : VString := Nul;
+
+ subtype Sfile is Ada.Streams.Stream_IO.File_Type;
+
+ OutS : Sfile;
-- Output file
- InS : File_Type;
+ InS : Ada.Text_IO.File_Type;
-- Read sinfo.ads
- InT : File_Type;
+ InT : Ada.Text_IO.File_Type;
-- Read treeprs.adt
Special : TB.Table (20);
Sp : aliased Natural;
-- Space left on line for Pchars output
- wsp : Pattern := Span (' ' & ASCII.HT);
-
- Get_SRev : Pattern := BreakX ('$') & "$Rev" & "ision: "
- & Break (' ') * Sinforev;
- Get_TRev : Pattern := BreakX ('$') & "$Rev" & "ision: "
- & Break (' ') * Temprev;
- Is_Temp : Pattern := BreakX ('T') * A & "T e m p l a t e";
- Get_Node : Pattern := wsp & "-- N_" & Rest * Node;
- Tst_Punc : Pattern := Break (" ,.");
- Get_Syn : Pattern := Span (' ') & "-- " & Break (' ') * Synonym
- & " (" & Break (')') * Field;
- Brk_Min : Pattern := Break ('-') * Ffield;
- Is_Flag : Pattern := "Flag" & Rest * Flagno;
- Is_Field : Pattern := Rtab (1) & Len (1) * Fieldno;
- Is_Syn : Pattern := wsp & "N_" & Break (",)") * Syn & Len (1) * Term;
- Brk_Node : Pattern := Break (' ') * Node & ' ';
- Chop_SP : Pattern := Len (Sp'Unrestricted_Access) * S1;
+ wsp : constant Pattern := Span (' ' & ASCII.HT);
+ Is_Temp : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
+ Get_Node : constant Pattern := wsp & "-- N_" & Rest * Node;
+ Tst_Punc : constant Pattern := Break (" ,.");
+ Get_Syn : constant Pattern := Span (' ') & "-- " & Break (' ') * Synonym
+ & " (" & Break (')') * Field;
+ Brk_Min : constant Pattern := Break ('-') * Ffield;
+ Is_Flag : constant Pattern := "Flag" & Rest * Flagno;
+ Is_Field : constant Pattern := Rtab (1) & Len (1) * Fieldno;
+ Is_Syn : constant Pattern := wsp & "N_" & Break (",)") * Syn
+ & Len (1) * Term;
+ Brk_Node : constant Pattern := Break (' ') * Node & ' ';
+ Chop_SP : constant Pattern := Len (Sp'Unrestricted_Access) * S1;
M : Match_Result;
+ procedure Put_Line (F : Sfile; S : String);
+ procedure Put_Line (F : Sfile; S : VString);
+ -- Local version of Put_Line ensures Unix style line endings
+
+ procedure Put_Line (F : Sfile; S : String) is
+ begin
+ String'Write (Stream (F), S);
+ Character'Write (Stream (F), ASCII.LF);
+ end Put_Line;
+
+ procedure Put_Line (F : Sfile; S : VString) is
+ begin
+ Put_Line (F, To_String (S));
+ end Put_Line;
+
+-- Start of processing for XTreeprs
+
begin
Anchored_Mode := True;
- Match ("$Revision: 1.33 $", "$Rev" & "ision: " & Break (' ') * Treeprsrev);
-
if Argument_Count > 0 then
Create (OutS, Out_File, Argument (1));
else
Set (Special, "Raises_Constraint_Error", True);
Set (Special, "Right_Opnd", True);
- -- Get sinfo revs and write header to output file
-
- loop
- Line := Get_Line (InS);
- Lineno := Lineno + 1;
-
- if Line = "" then
- raise Err;
- end if;
-
- exit when Match (Line, Get_SRev);
- end loop;
-
-- Read template header and generate new header
loop
Line := Get_Line (InT);
- if Match (Line, Get_TRev) then
- Put_Line
- (OutS,
- "-- Generated by xtreeprs revision " &
- Treeprsrev & " using --");
-
- Put_Line
- (OutS,
- "-- sinfo.ads revision " &
- Sinforev & " --");
-
- Put_Line
- (OutS,
- "-- treeprs.adt revision "
- & Temprev & " --");
-
- else
- -- Skip lines describing the template
-
- if Match (Line, "-- This file is a template") then
- loop
- Line := Get_Line (InT);
- exit when Line = "";
- end loop;
- end if;
+ -- Skip lines describing the template
- exit when Match (Line, "package");
+ if Match (Line, "-- This file is a template") then
+ loop
+ Line := Get_Line (InT);
+ exit when Line = "";
+ end loop;
+ end if;
- if Match (Line, Is_Temp, M) then
- Replace (M, A & " S p e c ");
- end if;
+ exit when Match (Line, "package");
- Put_Line (OutS, Line);
+ if Match (Line, Is_Temp, M) then
+ Replace (M, A & " S p e c ");
end if;
+
+ Put_Line (OutS, Line);
end loop;
Put_Line (OutS, Line);
loop
Sp := 79 - 4 - Length (Prefix);
- exit when (Size (S) <= Sp);
+ exit when Size (S) <= Sp;
Match (S, Chop_SP, "");
Put_Line (OutS, Prefix & '"' & S1 & """ &");
Prefix := V (" ");
OSDN Git Service
