-------------------------------------------------------------------------------
--
-- This file is part of AdaBrowse.
--
-- Copyright (c) 2002 by Thomas Wolf.
--
-- AdaBrowse is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by the
-- Free Software Foundation; either version 2, or (at your option) any
-- later version. AdaBrowse 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.
-- See the GNU General Public License for more details. You should have
-- received a copy of the GNU General Public License with this distribution,
-- see file "GPL.txt". If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-- USA.
--
--
-- -
-- Author:
-
-- Thomas Wolf (TW)
-- twolf@acm.org
--
-- -
-- Purpose:
-
-- Handling of the -f parameter value.
--
--
-------------------------------------------------------------------------------
pragma License (GPL);
with Ada.Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with AD.Known_Units;
with AD.Text_Utilities;
with Util.Files.Text_IO;
with Util.Pathes;
with Util.Strings;
pragma Elaborate_All (Util.Files.Text_IO);
package body AD.Parameters is
package ASF renames Ada.Strings.Fixed;
package ASM renames Ada.Strings.Maps;
package ASU renames Ada.Strings.Unbounded;
use AD.Text_Utilities;
To_Unit : constant ASM.Character_Mapping := ASM.To_Mapping ("-", ".");
Name : ASU.Unbounded_String;
Unit_Id : ASU.Unbounded_String;
Path_Part : ASU.Unbounded_String;
Is_StdIn : Boolean := False;
Is_Temp : Boolean := False;
F : Ada.Text_IO.File_Access := null;
File : aliased Ada.Text_IO.File_Type;
procedure Save_Input
is
use type Ada.Text_IO.File_Access;
begin
if not Is_StdIn or else F = null then
return;
end if;
-- It's a hack, but so is "popen", which is the basis for my Util.Pipes
-- package. The problem is that a command executed through "popen"
-- inherits the calling program's standard I/O files: stdin, stdout, and
-- stderr, where either stdin or stdout are replaced by a pipe, which
-- can be accessed by the stream opened by Util.Pipes.Open. In other
-- words, a called program shares stdin with AdaBrowse!
--
-- Therefore, we need to squirrel away the contents of our stdin before
-- making the first call to an external program, lest some nasty called
-- program snatches it away by reading from its stdin, which is also
-- *our* stdin.
--
-- We use an unnamed temporary file to store the contents of stdin to.
-- That's just plain simpler than some in-memory structure, and also
-- avoids memory problems for large inputs.
begin
Ada.Text_IO.Create (File, Ada.Text_IO.Out_File);
exception
when others =>
return;
end;
-- Read all from stdin and save in temporary file.
Is_Temp := True;
declare
Buffer : String (1 .. 500);
Last : Natural;
begin
while not Ada.Text_IO.End_Of_File (F.all) loop
Ada.Text_IO.Get_Line (F.all, Buffer, Last);
if Last < Buffer'Last then
Ada.Text_IO.Put_Line (File, Buffer (1 .. Last));
else
Ada.Text_IO.Put (File, Buffer);
end if;
end loop;
end;
Ada.Text_IO.New_Line (File);
Ada.Text_IO.Reset (File, Ada.Text_IO.In_File);
Is_StdIn := False;
F := File'Access;
end Save_Input;
procedure Set_Source_Name
(File_Name : in String;
Try_Known : in Boolean := False)
is
begin
if Try_Known then
AD.Known_Units.Find (File_Name, Name, Path_Part, Unit_Id);
if ASU.Length (Name) > 0 then
-- We've found it!
return;
end if;
end if;
Path_Part := ASU.To_Unbounded_String (Util.Pathes.Path (File_Name));
-- Not found.
declare
Ext : constant String := Util.Pathes.Extension (File_Name);
begin
if Ext'Length = 0 or else Util.Strings.Equal (Ext, "adt") then
Name :=
ASU.To_Unbounded_String
(Util.Pathes.Replace_Extension (File_Name, "ads"));
else
Name := ASU.To_Unbounded_String (Util.Pathes.Name (File_Name));
end if;
end;
Unit_Id := ASU.Null_Unbounded_String;
end Set_Source_Name;
function Get_Line is
new Util.Files.Text_IO.Next_Line
(Line_Continuation => "",
Comment_Start => "#",
Delimiters => Util.Strings.Null_Set);
-- Raw line reading, but with comment handling.
procedure Set_Input
(File_Name : in String)
is
begin
if File_Name (File_Name'First) = '@' or else
File_Name = "-"
then
-- It's a list!
if File_Name = "@-" or else File_Name = "-" then
Is_StdIn := True;
F := Ada.Text_IO.Current_Input;
if not Advance_Input then
Ada.Exceptions.Raise_Exception
(Input_Error'Identity,
"No units to process.");
end if;
else
declare
Name : constant String :=
File_Name (File_Name'First + 1 .. File_Name'Last);
begin
begin
Ada.Text_IO.Open (File, Ada.Text_IO.In_File, Name);
exception
when others =>
Ada.Exceptions.Raise_Exception
(Input_Error'Identity,
"Cannot open file """ & Name & """.");
end;
F := Ada.Text_IO.File_Access'(File'Access);
if not Advance_Input then
Ada.Exceptions.Raise_Exception
(Input_Error'Identity,
"File """ & Name & """ is empty.");
end if;
end;
end if;
else
F := null;
Set_Source_Name (File_Name, True);
end if;
end Set_Input;
procedure Set_Input
(File : in Ada.Text_IO.File_Access)
is
begin
F := File;
Is_StdIn := False;
if not Advance_Input then
Ada.Exceptions.Raise_Exception
(Input_Error'Identity, "No sources of unit specs found. Stopping");
end if;
end Set_Input;
function Advance_Input
return Boolean
is
use type Ada.Text_IO.File_Access;
begin
if F = null or else not Ada.Text_IO.Is_Open (F.all) then
return False;
elsif Ada.Text_IO.End_Of_File (F.all) then
Close;
return False;
end if;
declare
Line : constant String := Util.Strings.Trim (Get_Line (F.all));
begin
if Line'Last < Line'First then
Close;
return False;
end if;
if Util.Strings.Is_Prefix (Line, "--") then
-- Assume what follows is the unit name. The project manager
-- uses this method to tell us the unit name up-front!
if Ada.Text_IO.End_Of_File (F.all) then
Close;
return False;
end if;
declare
Next_Line : constant String :=
Util.Strings.Trim (Get_Line (F.all));
begin
if Next_Line'Last < Next_Line'First then
Close;
return False;
end if;
Set_Source_Name (Canonical (Next_Line));
Set_Unit_Name
(Util.Strings.Trim (Line (Line'First + 2 .. Line'Last)));
end;
else
Set_Source_Name (Canonical (Line), True);
end if;
return True;
end;
end Advance_Input;
function Is_File
return Boolean
is
use type Ada.Text_IO.File_Access;
begin
return F /= null;
end Is_File;
procedure Close
is
begin
if Ada.Text_IO.Is_Open (File) then
if Is_Temp then
begin
Ada.Text_IO.Delete (File);
exception
when others =>
Ada.Text_IO.Close (File);
end;
else
Ada.Text_IO.Close (File);
end if;
end if;
F := null;
end Close;
function Source_Name
return String
is
begin
return ASU.To_String (Name);
end Source_Name;
function Unit_Name
return String
is
begin
if ASU.Length (Unit_Id) > 0 then
return ASU.To_String (Unit_Id);
end if;
-- Either we have no project file, or somehow the project manager
-- was not able to produce a sensible name: revert to the default
-- behavior.
declare
Unit_Name : constant String :=
Util.Strings.To_Mixed
(ASF.Translate (Util.Pathes.Base_Name (Source_Name), To_Unit));
begin
Set_Unit_Name (Unit_Name);
return Unit_Name;
end;
end Unit_Name;
procedure Set_Unit_Name
(Name : in String)
is
begin
Unit_Id := ASU.To_Unbounded_String (Name);
end Set_Unit_Name;
function Path
return String
is
begin
return ASU.To_String (Path_Part);
end Path;
end AD.Parameters;