1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                             G N A T F I N D                              --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1998-2011, Free Software Foundation, Inc.         --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17-- for  more details.  You should have  received  a copy of the GNU General --
18-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19-- http://www.gnu.org/licenses for a complete copy of the license.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26with Opt;
27with Osint;    use Osint;
28with Switch;   use Switch;
29with Types;    use Types;
30with Xr_Tabls; use Xr_Tabls;
31with Xref_Lib; use Xref_Lib;
32
33with Ada.Strings.Fixed; use Ada.Strings.Fixed;
34with Ada.Text_IO;       use Ada.Text_IO;
35
36with GNAT.Command_Line; use GNAT.Command_Line;
37
38with System.Strings;    use System.Strings;
39
40--------------
41-- Gnatfind --
42--------------
43
44procedure Gnatfind is
45   Output_Ref      : Boolean := False;
46   Pattern         : Xref_Lib.Search_Pattern;
47   Local_Symbols   : Boolean := True;
48   Prj_File        : File_Name_String;
49   Prj_File_Length : Natural := 0;
50   Nb_File         : Natural := 0;
51   Usage_Error     : exception;
52   Full_Path_Name  : Boolean := False;
53   Have_Entity     : Boolean := False;
54   Wide_Search     : Boolean := True;
55   Glob_Mode       : Boolean := True;
56   Der_Info        : Boolean := False;
57   Type_Tree       : Boolean := False;
58   Read_Only       : Boolean := False;
59   Source_Lines    : Boolean := False;
60
61   Has_File_In_Entity : Boolean := False;
62   --  Will be true if a file name was specified in the entity
63
64   RTS_Specified : String_Access := null;
65   --  Used to detect multiple use of --RTS= switch
66
67   EXT_Specified : String_Access := null;
68   --  Used to detect multiple use of --ext= switch
69
70   procedure Parse_Cmd_Line;
71   --  Parse every switch on the command line
72
73   procedure Usage;
74   --  Display the usage
75
76   procedure Write_Usage;
77   --  Print a small help page for program usage and exit program
78
79   --------------------
80   -- Parse_Cmd_Line --
81   --------------------
82
83   procedure Parse_Cmd_Line is
84
85      procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
86
87      --  Start of processing for Parse_Cmd_Line
88
89   begin
90      --  First check for --version or --help
91
92      Check_Version_And_Help ("GNATFIND", "1998");
93
94      --  Now scan the other switches
95
96      GNAT.Command_Line.Initialize_Option_Scan;
97
98      loop
99         case
100           GNAT.Command_Line.Getopt
101             ("a aI: aO: d e f g h I: nostdinc nostdlib p: r s t -RTS= -ext=")
102         is
103            when ASCII.NUL =>
104               exit;
105
106            when 'a'    =>
107               if GNAT.Command_Line.Full_Switch = "a" then
108                  Read_Only := True;
109               elsif GNAT.Command_Line.Full_Switch = "aI" then
110                  Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter);
111               else
112                  Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter);
113               end if;
114
115            when 'd'    =>
116               Der_Info := True;
117
118            when 'e'    =>
119               Glob_Mode := False;
120
121            when 'f'    =>
122               Full_Path_Name := True;
123
124            when 'g'    =>
125               Local_Symbols := False;
126
127            when 'h'    =>
128               Write_Usage;
129
130            when 'I'    =>
131               Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter);
132               Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter);
133
134            when 'n'    =>
135               if GNAT.Command_Line.Full_Switch = "nostdinc" then
136                  Opt.No_Stdinc := True;
137               elsif GNAT.Command_Line.Full_Switch = "nostdlib" then
138                  Opt.No_Stdlib := True;
139               end if;
140
141            when 'p'    =>
142               declare
143                  S : constant String := GNAT.Command_Line.Parameter;
144               begin
145                  Prj_File_Length := S'Length;
146                  Prj_File (1 .. Prj_File_Length) := S;
147               end;
148
149            when 'r'    =>
150               Output_Ref := True;
151
152            when 's' =>
153               Source_Lines := True;
154
155            when 't' =>
156               Type_Tree := True;
157
158            --  Only switch starting with -- recognized is --RTS
159
160            when '-' =>
161               if GNAT.Command_Line.Full_Switch = "-RTS" then
162
163                  --  Check that it is the first time we see this switch
164
165                  if RTS_Specified = null then
166                     RTS_Specified := new String'(GNAT.Command_Line.Parameter);
167                  elsif RTS_Specified.all /= GNAT.Command_Line.Parameter then
168                     Osint.Fail ("--RTS cannot be specified multiple times");
169                  end if;
170
171                  Opt.No_Stdinc := True;
172                  Opt.RTS_Switch := True;
173
174                  declare
175                     Src_Path_Name : constant String_Ptr :=
176                                       Get_RTS_Search_Dir
177                                         (GNAT.Command_Line.Parameter,
178                                          Include);
179                     Lib_Path_Name : constant String_Ptr :=
180                                       Get_RTS_Search_Dir
181                                         (GNAT.Command_Line.Parameter,
182                                          Objects);
183
184                  begin
185                     if Src_Path_Name /= null
186                       and then Lib_Path_Name /= null
187                     then
188                        Add_Search_Dirs (Src_Path_Name, Include);
189                        Add_Search_Dirs (Lib_Path_Name, Objects);
190
191                     elsif Src_Path_Name = null
192                       and then Lib_Path_Name = null
193                     then
194                        Osint.Fail ("RTS path not valid: missing " &
195                                      "adainclude and adalib directories");
196
197                     elsif Src_Path_Name = null then
198                        Osint.Fail ("RTS path not valid: missing " &
199                                      "adainclude directory");
200
201                     elsif Lib_Path_Name = null then
202                        Osint.Fail ("RTS path not valid: missing " &
203                                      "adalib directory");
204                     end if;
205                  end;
206
207               --  Process -ext switch
208
209               elsif GNAT.Command_Line.Full_Switch = "-ext" then
210
211                  --  Check that it is the first time we see this switch
212
213                  if EXT_Specified = null then
214                     EXT_Specified := new String'(GNAT.Command_Line.Parameter);
215                  elsif EXT_Specified.all /= GNAT.Command_Line.Parameter then
216                     Osint.Fail ("--ext cannot be specified multiple times");
217                  end if;
218
219                  if
220                    EXT_Specified'Length = Osint.ALI_Default_Suffix'Length
221                  then
222                     Osint.ALI_Suffix := EXT_Specified.all'Access;
223                  else
224                     Osint.Fail ("--ext argument must have 3 characters");
225                  end if;
226
227               end if;
228
229            when others =>
230               Write_Usage;
231         end case;
232      end loop;
233
234      --  Get the other arguments
235
236      loop
237         declare
238            S : constant String := GNAT.Command_Line.Get_Argument;
239
240         begin
241            exit when S'Length = 0;
242
243            --  First argument is the pattern
244
245            if not Have_Entity then
246               Add_Entity (Pattern, S, Glob_Mode);
247               Have_Entity := True;
248
249               if not Has_File_In_Entity
250                 and then Index (S, ":") /= 0
251               then
252                  Has_File_In_Entity := True;
253               end if;
254
255            --  Next arguments are the files to search
256
257            else
258               Add_Xref_File (S);
259               Wide_Search := False;
260               Nb_File := Nb_File + 1;
261            end if;
262         end;
263      end loop;
264
265   exception
266      when GNAT.Command_Line.Invalid_Switch =>
267         Ada.Text_IO.Put_Line ("Invalid switch : "
268                               & GNAT.Command_Line.Full_Switch);
269         Write_Usage;
270
271      when GNAT.Command_Line.Invalid_Parameter =>
272         Ada.Text_IO.Put_Line ("Parameter missing for : "
273                               & GNAT.Command_Line.Full_Switch);
274         Write_Usage;
275
276      when Xref_Lib.Invalid_Argument =>
277         Ada.Text_IO.Put_Line ("Invalid line or column in the pattern");
278         Write_Usage;
279   end Parse_Cmd_Line;
280
281   -----------
282   -- Usage --
283   -----------
284
285   procedure Usage is
286   begin
287      Put_Line ("Usage: gnatfind pattern[:sourcefile[:line[:column]]] "
288                & "[file1 file2 ...]");
289      New_Line;
290      Put_Line ("  pattern     Name of the entity to look for (can have "
291                & "wildcards)");
292      Put_Line ("  sourcefile  Only find entities referenced from this "
293                & "file");
294      Put_Line ("  line        Only find entities referenced from this line "
295                & "of file");
296      Put_Line ("  column      Only find entities referenced from this columns"
297                & " of file");
298      Put_Line ("  file ...    Set of Ada source files to search for "
299                & "references. This parameters are optional");
300      New_Line;
301      Put_Line ("gnatfind switches:");
302      Display_Usage_Version_And_Help;
303      Put_Line ("   -a        Consider all files, even when the ali file is "
304                & "readonly");
305      Put_Line ("   -aIdir    Specify source files search path");
306      Put_Line ("   -aOdir    Specify library/object files search path");
307      Put_Line ("   -d        Output derived type information");
308      Put_Line ("   -e        Use the full regular expression set for "
309                & "pattern");
310      Put_Line ("   -f        Output full path name");
311      Put_Line ("   -g        Output information only for global symbols");
312      Put_Line ("   -Idir     Like -aIdir -aOdir");
313      Put_Line ("   -nostdinc Don't look for sources in the system default"
314                & " directory");
315      Put_Line ("   -nostdlib Don't look for library files in the system"
316                & " default directory");
317      Put_Line ("   --ext=xxx Specify alternate ali file extension");
318      Put_Line ("   --RTS=dir specify the default source and object search"
319                & " path");
320      Put_Line ("   -p file   Use file as the default project file");
321      Put_Line ("   -r        Find all references (default to find declaration"
322                & " only)");
323      Put_Line ("   -s        Print source line");
324      Put_Line ("   -t        Print type hierarchy");
325   end Usage;
326
327   -----------------
328   -- Write_Usage --
329   -----------------
330
331   procedure Write_Usage is
332   begin
333      Display_Version ("GNATFIND", "1998");
334      New_Line;
335
336      Usage;
337
338      raise Usage_Error;
339   end Write_Usage;
340
341--  Start of processing for Gnatfind
342
343begin
344   Parse_Cmd_Line;
345
346   if not Have_Entity then
347      Write_Usage;
348   end if;
349
350   --  Special case to speed things up: if the user has a command line of the
351   --  form 'gnatfind entity:file', i.e. has specified a file and only wants
352   --  the bodies and specs, then we can restrict the search to the .ali file
353   --  associated with 'file'.
354
355   if Has_File_In_Entity
356     and then not Output_Ref
357   then
358      Wide_Search := False;
359   end if;
360
361   --  Find the project file
362
363   if Prj_File_Length = 0 then
364      Xr_Tabls.Create_Project_File (Default_Project_File ("."));
365   else
366      Xr_Tabls.Create_Project_File (Prj_File (1 .. Prj_File_Length));
367   end if;
368
369   --  Fill up the table
370
371   if Type_Tree and then Nb_File > 1 then
372      Ada.Text_IO.Put_Line ("Error: for type hierarchy output you must "
373                            & "specify only one file.");
374      Ada.Text_IO.New_Line;
375      Write_Usage;
376   end if;
377
378   Search (Pattern, Local_Symbols, Wide_Search, Read_Only,
379           Der_Info, Type_Tree);
380
381   if Source_Lines then
382      Xr_Tabls.Grep_Source_Files;
383   end if;
384
385   Print_Gnatfind (Output_Ref, Full_Path_Name);
386
387exception
388   when Usage_Error =>
389      null;
390end Gnatfind;
391