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