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--   Handling of the -f parameter value.</DL>
28--
29-- <!--
30-- Revision History
31--
32--   02-FEB-2002   TW  First release.
33--   13-MAR-2002   TW  Changed to support -f @filename.
34--   18-MAR-2002   TW  Allows '#'-line comments in input file for -f @filename.
35--   10-JUN-2003   TW  Support for "-- " lines in input files. What follows the
36--                     Ada comment delimiter must be the unit name. Next line
37--                     must be the file name.
38--   09-JUL-2003   TW  Use AD.Known_Units, and special handling for "*.adt".
39-- -->
40-------------------------------------------------------------------------------
41
42pragma License (GPL);
43
44with Ada.Exceptions;
45with Ada.Strings.Fixed;
46with Ada.Strings.Maps;
47with Ada.Strings.Unbounded;
48with Ada.Text_IO;
49
50with AD.Known_Units;
51with AD.Text_Utilities;
52
53with Util.Files.Text_IO;
54with Util.Pathes;
55with Util.Strings;
56
57pragma Elaborate_All (Util.Files.Text_IO);
58
59package body AD.Parameters is
60
61   package ASF renames Ada.Strings.Fixed;
62   package ASM renames Ada.Strings.Maps;
63   package ASU renames Ada.Strings.Unbounded;
64
65   use AD.Text_Utilities;
66
67   To_Unit   : constant ASM.Character_Mapping := ASM.To_Mapping ("-", ".");
68
69   Name      : ASU.Unbounded_String;
70   Unit_Id   : ASU.Unbounded_String;
71   Path_Part : ASU.Unbounded_String;
72   Is_StdIn  : Boolean := False;
73   Is_Temp   : Boolean := False;
74   F         : Ada.Text_IO.File_Access := null;
75   File      : aliased Ada.Text_IO.File_Type;
76
77   procedure Save_Input
78   is
79      use type Ada.Text_IO.File_Access;
80   begin
81      if not Is_StdIn or else F = null then
82         return;
83      end if;
84      --  It's a hack, but so is "popen", which is the basis for my Util.Pipes
85      --  package. The problem is that a command executed through "popen"
86      --  inherits the calling program's standard I/O files: stdin, stdout, and
87      --  stderr, where either stdin or stdout are replaced by a pipe, which
88      --  can be accessed by the stream opened by Util.Pipes.Open. In other
89      --  words, a called program shares stdin with AdaBrowse!
90      --
91      --  Therefore, we need to squirrel away the contents of our stdin before
92      --  making the first call to an external program, lest some nasty called
93      --  program snatches it away by reading from its stdin, which is also
94      --  *our* stdin.
95      --
96      --  We use an unnamed temporary file to store the contents of stdin to.
97      --  That's just plain simpler than some in-memory structure, and also
98      --  avoids memory problems for large inputs.
99      begin
100         Ada.Text_IO.Create (File, Ada.Text_IO.Out_File);
101      exception
102         when others =>
103            return;
104      end;
105      --  Read all from stdin and save in temporary file.
106      Is_Temp := True;
107      declare
108         Buffer : String (1 .. 500);
109         Last   : Natural;
110      begin
111         while not Ada.Text_IO.End_Of_File (F.all) loop
112            Ada.Text_IO.Get_Line (F.all, Buffer, Last);
113            if Last < Buffer'Last then
114               Ada.Text_IO.Put_Line (File, Buffer (1 .. Last));
115            else
116               Ada.Text_IO.Put (File, Buffer);
117            end if;
118         end loop;
119      end;
120      Ada.Text_IO.New_Line (File);
121      Ada.Text_IO.Reset (File, Ada.Text_IO.In_File);
122      Is_StdIn := False;
123      F := File'Access;
124   end Save_Input;
125
126   procedure Set_Source_Name
127     (File_Name : in String;
128      Try_Known : in Boolean := False)
129   is
130   begin
131      if Try_Known then
132         AD.Known_Units.Find (File_Name, Name, Path_Part, Unit_Id);
133         if ASU.Length (Name) > 0 then
134            --  We've found it!
135            return;
136         end if;
137      end if;
138      Path_Part := ASU.To_Unbounded_String (Util.Pathes.Path (File_Name));
139      --  Not found.
140      declare
141         Ext : constant String := Util.Pathes.Extension (File_Name);
142      begin
143         if Ext'Length = 0 or else Util.Strings.Equal (Ext, "adt") then
144            Name :=
145              ASU.To_Unbounded_String
146                (Util.Pathes.Replace_Extension (File_Name, "ads"));
147         else
148            Name := ASU.To_Unbounded_String (Util.Pathes.Name (File_Name));
149         end if;
150      end;
151      Unit_Id   := ASU.Null_Unbounded_String;
152   end Set_Source_Name;
153
154   function Get_Line is
155     new Util.Files.Text_IO.Next_Line
156           (Line_Continuation => "",
157            Comment_Start     => "#",
158            Delimiters        => Util.Strings.Null_Set);
159   --  Raw line reading, but with comment handling.
160
161   procedure Set_Input
162     (File_Name : in String)
163   is
164   begin
165      if File_Name (File_Name'First) = '@' or else
166         File_Name = "-"
167      then
168         --  It's a list!
169         if File_Name = "@-" or else File_Name = "-" then
170            Is_StdIn := True;
171            F := Ada.Text_IO.Current_Input;
172            if not Advance_Input then
173               Ada.Exceptions.Raise_Exception
174                 (Input_Error'Identity,
175                  "No units to process.");
176            end if;
177         else
178            declare
179               Name : constant String :=
180                 File_Name (File_Name'First + 1 .. File_Name'Last);
181            begin
182               begin
183                  Ada.Text_IO.Open (File, Ada.Text_IO.In_File, Name);
184               exception
185                  when others =>
186                     Ada.Exceptions.Raise_Exception
187                       (Input_Error'Identity,
188                        "Cannot open file """ & Name & """.");
189               end;
190               F := Ada.Text_IO.File_Access'(File'Access);
191               if not Advance_Input then
192                  Ada.Exceptions.Raise_Exception
193                    (Input_Error'Identity,
194                     "File """ & Name & """ is empty.");
195               end if;
196            end;
197         end if;
198      else
199         F := null;
200         Set_Source_Name (File_Name, True);
201      end if;
202   end Set_Input;
203
204   procedure Set_Input
205     (File : in Ada.Text_IO.File_Access)
206   is
207   begin
208      F        := File;
209      Is_StdIn := False;
210      if not Advance_Input then
211         Ada.Exceptions.Raise_Exception
212           (Input_Error'Identity, "No sources of unit specs found. Stopping");
213      end if;
214   end Set_Input;
215
216   function Advance_Input
217     return Boolean
218   is
219      use type Ada.Text_IO.File_Access;
220   begin
221      if F = null or else not Ada.Text_IO.Is_Open (F.all) then
222         return False;
223      elsif Ada.Text_IO.End_Of_File (F.all) then
224         Close;
225         return False;
226      end if;
227      declare
228         Line : constant String := Util.Strings.Trim (Get_Line (F.all));
229      begin
230         if Line'Last < Line'First then
231            Close;
232            return False;
233         end if;
234         if Util.Strings.Is_Prefix (Line, "--") then
235            --  Assume what follows is the unit name. The project manager
236            --  uses this method to tell us the unit name up-front!
237            if Ada.Text_IO.End_Of_File (F.all) then
238               Close;
239               return False;
240            end if;
241            declare
242               Next_Line : constant String :=
243                 Util.Strings.Trim (Get_Line (F.all));
244            begin
245               if Next_Line'Last < Next_Line'First then
246                  Close;
247                  return False;
248               end if;
249               Set_Source_Name (Canonical (Next_Line));
250               Set_Unit_Name
251                 (Util.Strings.Trim (Line (Line'First + 2 .. Line'Last)));
252            end;
253         else
254            Set_Source_Name (Canonical (Line), True);
255         end if;
256         return True;
257      end;
258   end Advance_Input;
259
260   function Is_File
261     return Boolean
262   is
263      use type Ada.Text_IO.File_Access;
264   begin
265      return F /= null;
266   end Is_File;
267
268   procedure Close
269   is
270   begin
271      if Ada.Text_IO.Is_Open (File) then
272         if Is_Temp then
273            begin
274               Ada.Text_IO.Delete (File);
275            exception
276               when others =>
277                  Ada.Text_IO.Close (File);
278            end;
279         else
280            Ada.Text_IO.Close (File);
281         end if;
282      end if;
283      F := null;
284   end Close;
285
286   function Source_Name
287     return String
288   is
289   begin
290      return ASU.To_String (Name);
291   end Source_Name;
292
293   function Unit_Name
294     return String
295   is
296   begin
297      if ASU.Length (Unit_Id) > 0 then
298         return ASU.To_String (Unit_Id);
299      end if;
300      --  Either we have no project file, or somehow the project manager
301      --  was not able to produce a sensible name: revert to the default
302      --  behavior.
303      declare
304         Unit_Name : constant String :=
305           Util.Strings.To_Mixed
306             (ASF.Translate (Util.Pathes.Base_Name (Source_Name), To_Unit));
307      begin
308         Set_Unit_Name (Unit_Name);
309         return Unit_Name;
310      end;
311   end Unit_Name;
312
313   procedure Set_Unit_Name
314     (Name : in String)
315   is
316   begin
317      Unit_Id := ASU.To_Unbounded_String (Name);
318   end Set_Unit_Name;
319
320   function Path
321     return String
322   is
323   begin
324      return ASU.To_String (Path_Part);
325   end Path;
326
327end AD.Parameters;
328