------------------------------------------------------------------------------- -- -- 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;