------------------------------------------------------------------------------
--                              Ada Web Server                              --
--                                                                          --
--                     Copyright (C) 2007-2014, AdaCore                     --
--                                                                          --
--  This is free software;  you can redistribute it  and/or modify it       --
--  under terms of the  GNU General Public License as published  by the     --
--  Free Software  Foundation;  either version 3,  or (at your option) any  --
--  later version.  This software 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   --
--  distributed  with  this  software;   see  file COPYING3.  If not, go    --
--  to http://www.gnu.org/licenses for a complete copy of the license.      --
------------------------------------------------------------------------------

--  This tools is to help tracking down unused or undefined entities in Ajax
--  Web development as it is very difficult to ensure that a referenced Id does
--  actually exist in Web pages for example.

with Ada.Characters.Handling;
with Ada.Command_Line;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Containers.Indefinite_Vectors;
with Ada.Directories;
with Ada.Strings.Fixed;
with Ada.Strings.Hash;
with Ada.Strings.Maps.Constants;
with Ada.Strings.Unbounded;
with Ada.Text_IO;

with GNAT.Command_Line;

with AWS.Utils;

procedure Webxref is

   use Ada;
   use Ada.Strings;
   use Ada.Strings.Unbounded;
   use AWS;

   Syntax_Error : exception;

   Version         : constant String := "1.0";

   Max_Line_Length : constant := 1_024;

   --  Reader record is the file iterator context

   type Reader is record
      File    : Text_IO.File_Type;
      Line    : Natural;
      Content : String (1 .. Max_Line_Length);
      Last    : Natural;
      Buffer  : String (1 .. Max_Line_Length * 5);
      Blast   : Natural;
   end record;

   procedure Open (Filename : String; Iterator : in out Reader);
   --  Open filename and initialize the file iterator

   procedure Close (Iterator : in out Reader);
   --  Close file iterator

   procedure Next (Iterator : in out Reader);
   --  Read next line

   procedure Clear_Content (Iterator : in out Reader);
   --  Clear content from the iterator context

   function Index
     (Iterator : Reader;
      Pattern  : String;
      From     : Positive := 1) return Natural;
   --  Returns the position of Pattern starting at From in iterator content

   function Eof (Iterator : Reader) return Boolean;
   --  Returns True if end of file reached

   function Is_Id_Ignored (Name : String) return Boolean;
   --  Returns True if this name is to be ignored

   type Name_Kind is
     (Def_CSS,  -- a definition in a CSS
      Ref_CSS,  -- a reference to a CSS definition (in HTML, XML... documents)
      Def_ML,   -- a definition in an HTML, XML... document
      Ref_ML);  -- a reference to an HTML definition (Found in Ajax response)

   type Kind_Set is array (Name_Kind) of Boolean;

   Null_Kind_Set       : constant Kind_Set := (others => False);

   CSS_Kind            : constant Kind_Set :=
                           (Def_CSS => True, others => False);

   Web_Kind            : constant Kind_Set :=
                           (Ref_CSS | Def_ML => True, others => False);

   Ajax_Response_Kind  : constant Kind_Set :=
                           (Ref_ML => True, others => False);

   Def_Kind            : constant Kind_Set :=
                           (Def_CSS | Def_ML => True, others => False);

   Ref_Kind            : constant Kind_Set :=
                           (Ref_CSS | Ref_ML => True, others => False);

   No_Kind             : constant Kind_Set := (others => False);

   procedure Process_CSS (Filename : String);
   --  Process a CSS file

   procedure Process_ML (Filename : String; Kinds : Kind_Set);
   --  Process a Meta Language file HTML, XML

   procedure Process (Filename : String);
   --  Process any file, dispatch to Process_ML or Process_CSS depending on the
   --  file extension.

   type Occurence is record
      Filename     : Unbounded_String;
      Line, Column : Natural;
      Kind         : Kind_Set;
   end record;

   package Occurences is
     new Containers.Indefinite_Vectors (Natural, Occurence);

   package Id_Maps is new Containers.Indefinite_Hashed_Maps
     (String, Boolean, Strings.Hash, "=");

   procedure Parse_Command_Line;

   procedure Record_Id (Name : String; Location : Occurence);
   --  Record Id name into Id_Dict

   procedure Record_Class (Name : String; Location : Occurence);
   --  Record Class name into Class_Dict

   procedure Log_Error (Location : Occurence; Message : String);
   --  Log error message

   procedure Check_Prefix
     (Name, Prefix : String;
      Location     : Occurence);
   --  Check if Name has the right prefix

   Global_Prefix  : constant String := "global_";
   --  Prefix used for global Ids. Such Ids are not checked for prefix
   --  convention.

   --  Options

   type Mode is (Xref, Unused, Undefined);

   function Is_Mode (Kind : Kind_Set; Check_Mode : Mode) return Boolean;
   --  Returns True if Kind conform to Check_Mode

   Check        : Mode := Xref;
   Dump_Classes : Boolean := True;
   Dump_Ids     : Boolean := True;
   Verbose      : Boolean := False;
   Id_Prefix    : Unbounded_String;
   Class_Prefix : Unbounded_String;
   Id_File      : Boolean := False;
   Has_Error    : Boolean := False;
   Killed_Id    : Id_Maps.Map;

   generic
   package Dict is

      type Id is new Positive;

      function Get (Name : String) return Id;
      --  Returns a uniq Id for Name

      procedure Add (Id  : Dict.Id; Occ : Occurence);
      --  Adds given occurence for Id

      function Get (Id : Dict.Id) return String;
      --  Returns Id's name

      type Node is record
         Name  : Unbounded_String;
         Kinds : Kind_Set;
         Occ   : Occurences.Vector;
      end record;

      function Get (Id : Dict.Id) return Node;
      --  Returns node for the given Id

      procedure Dump (Filter : Mode);
      --  Dump dictionary content on the console

   end Dict;

   ------------------
   -- Check_Prefix --
   ------------------

   procedure Check_Prefix
     (Name, Prefix : String;
      Location     : Occurence) is
   begin
      if Fixed.Index (Name, Global_Prefix) /= Name'First then
         if Prefix'Length >= Name'Length
           or else
             Name (Name'First .. Name'First + Prefix'Length - 1) /= Prefix
         then
            Log_Error
              (Location, Name & " has wrong prefix, expecting "
                 & Prefix & '_' & Name);
         end if;
      end if;
   end Check_Prefix;

   -------------------
   -- Clear_Content --
   -------------------

   procedure Clear_Content (Iterator : in out Reader) is
   begin
      Iterator.Last := 0;
      Iterator.Blast := 0;
   end Clear_Content;

   -----------
   -- Close --
   -----------

   procedure Close (Iterator : in out Reader) is
   begin
      Text_IO.Close (Iterator.File);
      Clear_Content (Iterator);
   end Close;

   ----------
   -- Dict --
   ----------

   package body Dict is

      package Name_Id is
        new Containers.Indefinite_Hashed_Maps (String, Id, Strings.Hash, "=");

      package Id_Name is
        new Containers.Indefinite_Vectors (Id, Node);

      NId : Name_Id.Map;
      IdN : Id_Name.Vector;

      Current : Id := 1;

      ---------
      -- Add --
      ---------

      procedure Add
        (Id  : Dict.Id;
         Occ : Occurence)
      is
         procedure Process (Element : in out Node);

         -------------
         -- Process --
         -------------

         procedure Process (Element : in out Node) is
         begin
            Element.Occ.Append (Occ);
            Element.Kinds := Element.Kinds or Occ.Kind;
         end Process;

      begin
         IdN.Update_Element (Id, Process'Access);
      end Add;

      ----------
      -- Dump --
      ----------

      procedure Dump (Filter : Mode) is

         procedure Dump (Position : Id_Name.Cursor);
         --  Dump name and iterates through all occurences

         ----------
         -- Dump --
         ----------

         procedure Dump (Position : Id_Name.Cursor) is

            procedure Dump (Position : Occurences.Cursor);
            --  Dump the pointed occurence

            Element : constant Node := Id_Name.Element (Position);

            ----------
            -- Dump --
            ----------

            procedure Dump (Position : Occurences.Cursor) is
               Def_Ref : Unbounded_String;
            begin
               declare
                  O : constant Occurence := Occurences.Element (Position);
               begin
                  Text_IO.Put
                    (To_String (O.Filename) & ":"
                       & Utils.Image (O.Line) & ":"
                       & Utils.Image (O.Column) & ": ");

                  if (O.Kind and Def_Kind) /= No_Kind then
                     Append (Def_Ref, "definition");
                  end if;

                  if (O.Kind and Ref_Kind) /= No_Kind then
                     if Def_Ref /= Null_Unbounded_String then
                        Append (Def_Ref, " and ");
                     end if;
                     Append (Def_Ref, "reference");
                  end if;

                  Text_IO.Put (To_String (Def_Ref) & " of ");
                  Text_IO.Put_Line (To_String (Element.Name));
               end;
            end Dump;

         begin
            if Is_Mode (Element.Kinds, Filter) then
               if Verbose then
                  Text_IO.Put (To_String (Element.Name));
                  for K in Name_Kind loop
                     if Element.Kinds (K) then
                        Text_IO.Put (" " & Name_Kind'Image (K));
                     end if;
                  end loop;
                  Text_IO.New_Line;
               end if;

               Element.Occ.Iterate (Dump'Access);
            end if;
         end Dump;

      begin
         IdN.Iterate (Dump'Access);
      end Dump;

      ---------
      -- Get --
      ---------

      function Get (Name : String) return Id is
      begin
         if NId.Contains (Name) then
            return NId.Element (Name);

         else
            NId.Insert (Name, Current);
            IdN.Append
              (Node'(To_Unbounded_String (Name), Null_Kind_Set, Occ => <>));
            Current := Current + 1;
            return Current - 1;
         end if;
      end Get;

      function Get (Id : Dict.Id) return String is
      begin
         if Natural (IdN.Length) >= Natural (Id) then
            return To_String (IdN.Element (Id).Name);
         else
            raise Constraint_Error with "Id not found.";
         end if;
      end Get;

      function Get (Id : Dict.Id) return Node is
      begin
         if Natural (IdN.Length) >= Natural (Id) then
            return IdN.Element (Id);
         else
            raise Constraint_Error with "Id not found.";
         end if;
      end Get;

   end Dict;

   package Class_Dict is new Dict;

   package Id_Dict is new Dict;

   ---------
   -- Eof --
   ---------

   function Eof (Iterator : Reader) return Boolean is
   begin
      return Text_IO.End_Of_File (Iterator.File);
   end Eof;

   -----------
   -- Index --
   -----------

   function Index
     (Iterator : Reader;
      Pattern  : String;
      From     : Positive := 1) return Natural is
   begin
      return Fixed.Index
        (Iterator.Content (From .. Iterator.Last), Pattern);
   end Index;

   -------------------
   -- Is_Id_Ignored --
   -------------------

   function Is_Id_Ignored (Name : String) return Boolean is
      use type Strings.Maps.Character_Set;
   begin
      --  Ignore if it is a number
      return Strings.Fixed.Index
        (Name, not Strings.Maps.Constants.Decimal_Digit_Set) = 0
        or else Killed_Id.Contains (Name);
   end Is_Id_Ignored;

   -------------
   -- Is_Mode --
   -------------

   function Is_Mode
     (Kind : Kind_Set; Check_Mode : Mode) return Boolean is
   begin
      case Check_Mode is
         when Xref =>
            return True;

         when Unused =>
            return Kind = Kind_Set'(Def_ML => True, others => False)
              or else Kind = Kind_Set'(Def_CSS => True, others => False)
              or else Kind =
                Kind_Set'(Def_ML | Def_CSS => True, others => False)
              or else Kind =
                Kind_Set'(Def_ML | Ref_CSS => True, others => False);

         when Undefined =>
            return Kind = Kind_Set'(Ref_ML => True, others => False)
              or else Kind = Kind_Set'(Ref_CSS => True, others => False)
              or else Kind =
                Kind_Set'(Ref_ML | Ref_CSS => True, others => False);
      end case;
   end Is_Mode;

   ---------------
   -- Log_Error --
   ---------------

   procedure Log_Error (Location : Occurence; Message : String) is
   begin
      Has_Error := True;
      Text_IO.Put_Line
        (To_String (Location.Filename) & ":" & Utils.Image (Location.Line)
           & ":" & Utils.Image (Location.Column) & ": " & Message);
   end Log_Error;

   ----------
   -- Next --
   ----------

   procedure Next (Iterator : in out Reader) is
   begin
      Text_IO.Get_Line (Iterator.File, Iterator.Content, Iterator.Last);
      Iterator.Buffer
        (Iterator.Blast + 1 .. Iterator.Blast + Iterator.Last) :=
        Iterator.Content (1 .. Iterator.Last);
      Iterator.Blast := Iterator.Blast + Iterator.Last;
      Iterator.Line := Iterator.Line + 1;
   end Next;

   ----------
   -- Open --
   ----------

   procedure Open (Filename : String; Iterator : in out Reader) is
   begin
      Text_IO.Open (Iterator.File, Text_IO.In_File, Filename);
      Clear_Content (Iterator);
      Iterator.Line := 0;
   end Open;

   ------------------------
   -- Parse_Command_Line --
   ------------------------

   procedure Parse_Command_Line is
   begin
      GNAT.Command_Line.Initialize_Option_Scan
        (Stop_At_First_Non_Switch => True);

      loop
         case GNAT.Command_Line.Getopt ("x u d c C i I v h pi: pc: ki:") is
            when ASCII.NUL =>
               exit;

            when 'u' =>
               Check := Unused;

            when 'x' =>
               Check := Xref;

            when 'd' =>
               Check := Undefined;

            when 'c' =>
               Dump_Classes := True;

            when 'C' =>
               Dump_Classes := False;

            when 'i' =>
               Dump_Ids := True;

            when 'I' =>
               Dump_Ids := False;

            when 'v' =>
               Verbose := True;

            when 'k' =>
               if GNAT.Command_Line.Full_Switch = "ki" then
                  Killed_Id.Include (GNAT.Command_Line.Parameter, True);
               else
                  raise Syntax_Error;
               end if;

            when 'p' =>
               if GNAT.Command_Line.Full_Switch = "pi" then
                  if GNAT.Command_Line.Parameter = "file_based" then
                     Id_File := True;
                  else
                     Id_Prefix := To_Unbounded_String
                       (GNAT.Command_Line.Parameter);
                  end if;

               elsif GNAT.Command_Line.Full_Switch = "pc" then
                  Class_Prefix :=
                    To_Unbounded_String (GNAT.Command_Line.Parameter);

               else
                  raise Syntax_Error;
               end if;

            when 'h' =>
               raise Syntax_Error;

            when others =>
               raise Syntax_Error;
         end case;
      end loop;
   end Parse_Command_Line;

   -------------
   -- Process --
   -------------

   procedure Process (Filename : String) is
      Ext : constant String :=
              Characters.Handling.To_Lower (Directories.Extension (Filename));
   begin
      if Verbose then
         Text_IO.Put_Line ("Process file : " & Filename & " as " & Ext);
      end if;

      if Ext = "css" or else Ext = "tcss" then
         Process_CSS (Filename);

      elsif Ext = "xml" or else Ext = "html" or else Ext = "thtml" then
         Process_ML (Filename, Web_Kind);

      elsif Ext = "txml" then
         Process_ML (Filename, Ajax_Response_Kind);
      end if;
   end Process;

   -----------------
   -- Process_CSS --
   -----------------

   procedure Process_CSS (Filename : String) is

      Seps : constant Maps.Character_Set := Maps.To_Set (" ,{");

      procedure Register_CSS_Path (Iterator : Reader; Pos : Natural);
      --  Parse and register a CSS path, we just want to extract the classes
      --  and ids.

      -----------------------
      -- Register_CSS_Path --
      -----------------------

      procedure Register_CSS_Path (Iterator : Reader; Pos : Natural) is
         Path : constant String :=
                  Iterator.Buffer (1 .. Iterator.Blast - Iterator.Last + Pos);
         S, E : Natural := 1;
      begin
         --  First look for classes
         loop
            S := Fixed.Index (Path, ".", S);
            exit when S = 0;

            E := Fixed.Index (Path, Seps, S);

            if E = 0 then
               E := Path'Last + 1;
            end if;

            declare
               Name : constant String := Path (S + 1 .. E - 1);
               Id   : constant Class_Dict.Id := Class_Dict.Get (Name);
            begin
               Class_Dict.Add
                 (Id, Occurence'(To_Unbounded_String (Filename),
                  Iterator.Line, S + 1, CSS_Kind));
            end;

            S := E + 1;
         end loop;

         --  First look for ids

         S := 1;
         E := 1;

         loop
            S := Fixed.Index (Path, "#", S);
            exit when S = 0;

            E := Fixed.Index (Path, Seps, S);

            if E = 0 then
               E := Path'Last + 1;
            end if;

            declare
               Name : constant String := Path (S + 1 .. E - 1);
               Id   : constant Id_Dict.Id := Id_Dict.Get (Name);
            begin
               Id_Dict.Add
                 (Id, Occurence'(To_Unbounded_String (Filename),
                  Iterator.Line, S + 1, CSS_Kind));
            end;

            S := E + 1;
         end loop;
      end Register_CSS_Path;

      Iterator : Reader;
      Pos      : Natural;
   begin
      Open (Filename, Iterator);

      loop
         Next (Iterator);

         if Iterator.Last = 0 then
            Clear_Content (Iterator);

         else
            Pos := Index (Iterator, "{");

            if Pos /= 0 then
               Register_CSS_Path (Iterator, Pos);
            end if;

            if Index (Iterator, "}") /= 0 then
               Clear_Content (Iterator);
            end if;
         end if;

         exit when Eof (Iterator);
      end loop;

      Close (Iterator);
   end Process_CSS;

   ----------------
   -- Process_ML --
   ----------------

   procedure Process_ML (Filename : String; Kinds : Kind_Set) is

      procedure Find
        (Iterator  : Reader;
         Attribute : String;
         Process   : not null access procedure
                       (Iterator : Reader;
                        Name     : String;
                        Column   : Positive));
      --  Call process for value of the given attribute name

      procedure Process_Id
        (Iterator : Reader; Name : String; Column : Positive);

      procedure Process_Class
        (Iterator : Reader; Name : String; Column : Positive);

      procedure Check_Include (Iterator : Reader);
      --  Check template include. We want here to include as id reference all
      --  parameters to the aws_*.tjs includes.

      -------------------
      -- Check_Include --
      -------------------

      procedure Check_Include (Iterator : Reader) is
         use type Strings.Maps.Character_Set;
         Blank       : constant Strings.Maps.Character_Set :=
                         Strings.Maps.To_Set (" " & ASCII.HT);
         Identifier  : constant Strings.Maps.Character_Set :=
                         Strings.Maps.Constants.Alphanumeric_Set
                             or Strings.Maps.To_Set ("_");
         First, Last : Natural := 1;
      begin
         First := Index (Iterator, "@@INCLUDE@@");

         if First /= 0 then
            First := Strings.Fixed.Index
              (Iterator.Content (First .. Iterator.Last), Blank);

            First := Strings.Fixed.Index
              (Iterator.Content (First .. Iterator.Last), not Blank);

            Last := Strings.Fixed.Index
              (Iterator.Content (First .. Iterator.Last), Blank);

            if Last = 0 then
               --  Last is end-of-line
               Last := Iterator.Last;
            else
               Last := Last - 1;
            end if;

            --  First .. Last is filename

            declare
               I_Filename : constant String :=
                              Iterator.Content (First .. Last);
               Is_First   : Boolean := True;
            begin
               --  Check only aws_*.tjs
               if Strings.Fixed.Index (I_Filename, "aws_") /= 0
                 and then Directories.Extension (I_Filename) = "tjs"
               then
                  loop
                     First := Last + 1;

                     Strings.Fixed.Find_Token
                       (Iterator.Content (First .. Iterator.Last),
                        Identifier,
                        Test  => Strings.Inside,
                        First => First,
                        Last  => Last);
                     exit when Last = 0;

                     if Is_First then
                        Is_First := False;

                     elsif not Is_Id_Ignored
                       (Iterator.Content (First .. Last))
                     then
                        declare
                           Id : constant Id_Dict.Id := Id_Dict.Get
                             (Iterator.Content (First .. Last));
                        begin
                           Id_Dict.Add
                             (Id,
                              (To_Unbounded_String (Filename),
                               Iterator.Line,
                               First,
                               Ajax_Response_Kind));
                        end;
                     end if;
                  end loop;
               end if;
            end;
         end if;
      end Check_Include;

      ----------
      -- Find --
      ----------

      procedure Find
        (Iterator  : Reader;
         Attribute : String;
         Process   : not null access procedure
                       (Iterator : Reader;
                        Name     : String;
                        Column   : Positive))
      is
         procedure Check (C : Character);

         -----------
         -- Check --
         -----------

         procedure Check (C : Character) is
            First, Last : Natural := 1;
         begin
            loop
               First := Index (Iterator, Attribute & '=' & C, First);
               exit when First = 0;

               Last := Index
                 (Iterator, String'(1 => C), First + Attribute'Length + 2);

               if Last = 0 then
                  First := Iterator.Last;

               else
                  Process
                    (Iterator,
                     Iterator.Content
                       (First + Attribute'Length + 2 .. Last - 1),
                     First + Attribute'Length + 2);
                  First := Last + 1;
               end if;
            end loop;
         end Check;

      begin
         Check (''');
         Check ('"');
      end Find;

      -------------------
      -- Process_Class --
      -------------------

      procedure Process_Class
        (Iterator : Reader; Name : String; Column : Positive) is
      begin
         Record_Class
           (Name,
            (To_Unbounded_String (Filename), Iterator.Line, Column, Kinds));
      end Process_Class;

      ----------------
      -- Process_Id --
      ----------------

      procedure Process_Id
        (Iterator : Reader; Name : String; Column : Positive) is
      begin
         if not Is_Id_Ignored (Name) then
            Record_Id
              (Name,
               (To_Unbounded_String (Filename), Iterator.Line, Column, Kinds));
         end if;
      end Process_Id;

      Iterator : Reader;

   begin
      Open (Filename, Iterator);

      loop
         Next (Iterator);

         Find (Iterator, "id", Process_Id'Access);
         Find (Iterator, "class", Process_Class'Access);

         Check_Include (Iterator);

         Clear_Content (Iterator);
         exit when Eof (Iterator);
      end loop;

      Close (Iterator);
   end Process_ML;

   ------------------
   -- Record_Class --
   ------------------

   procedure Record_Class (Name : String; Location : Occurence) is
      Id : constant Class_Dict.Id := Class_Dict.Get (Name);
   begin
      if Class_Prefix /= Null_Unbounded_String then
         Check_Prefix (Name, To_String (Class_Prefix), Location);
      end if;

      Class_Dict.Add (Id, Location);
   end Record_Class;

   ---------------
   -- Record_Id --
   ---------------

   procedure Record_Id (Name : String; Location : Occurence) is

      function Prefix_From_File (Filename : String) return String;
      --  Returns the expected prefix for Ids declared in Filename

      ----------------------
      -- Prefix_From_File --
      ----------------------

      function Prefix_From_File (Filename : String) return String is
         Prefix   : Unbounded_String;
         Get_Next : Boolean := True;
      begin
         for K in Filename'Range loop
            if Get_Next then
               Append (Prefix, Filename (K));
               Get_Next := False;

            elsif Filename (K) = '_' then
               Get_Next := True;
            end if;
         end loop;

         return To_String (Prefix);
      end Prefix_From_File;

      Id : constant Id_Dict.Id := Id_Dict.Get (Name);

   begin
      --  Only check the naming convention for a definition
      if (Location.Kind and Def_Kind) /= No_Kind then
         if Id_Prefix /= Null_Unbounded_String then
            Check_Prefix (Name, To_String (Id_Prefix), Location);

         elsif Id_File then
            Check_Prefix
              (Name,
               Prefix_From_File
                 (Directories.Base_Name (To_String (Location.Filename))),
               Location);
         end if;
      end if;

      Id_Dict.Add (Id, Location);
   end Record_Id;

begin
   Parse_Command_Line;

   --  Parse all files

   loop
      declare
         S : constant String :=
               GNAT.Command_Line.Get_Argument (Do_Expansion => True);
      begin
         exit when S'Length = 0;

         Process (S);
      end;
   end loop;

   if Dump_Classes then
      Text_IO.New_Line;
      Text_IO.Put_Line ("*** Class dictionary");

      Class_Dict.Dump (Check);
   end if;

   if Dump_Ids then
      Text_IO.New_Line;
      Text_IO.Put_Line ("*** Id dictionary");

      Id_Dict.Dump (Check);
   end if;

   if Has_Error then
      Command_Line.Set_Exit_Status (Command_Line.Failure);
   else
      Command_Line.Set_Exit_Status (Command_Line.Success);
   end if;

exception
   when Syntax_Error | GNAT.Command_Line.Invalid_Switch =>
      Text_IO.Put_Line ("webxref - Web Cross-References v" & Version);
      Text_IO.New_Line;
      Text_IO.Put_Line ("Usage : webxref [-huxcCiIv] file1 file2...");
      Text_IO.New_Line;
      Text_IO.Put_Line
        ("        -h         : display help");
      Text_IO.Put_Line
        ("        -x         : output all cross-references (default)");
      Text_IO.Put_Line
        ("        -u         : output unused entities only");
      Text_IO.Put_Line
        ("        -d         : output referenced but undefined entities only");
      Text_IO.Put_Line
        ("        -i         : handle id elements");
      Text_IO.Put_Line
        ("        -I         : do not handle id elements");
      Text_IO.Put_Line
        ("        -c         : handle class elements");
      Text_IO.Put_Line
        ("        -C         : do not handle class elements");
      Text_IO.Put_Line
        ("        -pi prefix : id must have the given prefix");
      Text_IO.Put_Line
        ("                     'file_based' to use filename based prefix");
      Text_IO.Put_Line
        ("        -pc prefix : class must have the given prefix");
      Text_IO.Put_Line
        ("        -ki name   : kill id, do not handle this specific id");
      Command_Line.Set_Exit_Status (Command_Line.Failure);
end Webxref;