-----------------------------------------------------------------------
--  util-http-headers -- HTTP Headers
--  Copyright (C) 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Dates.RFC7231;

package Util.Http.Headers is

   --  Some header names.
   Content_Type    : constant String := "Content-Type";
   Content_Length  : constant String := "Content-Length";
   Accept_Header   : constant String := "Accept";
   Accept_Language : constant String := "Accept-Language";
   Location        : constant String := "Location";
   Cookie          : constant String := "Cookie";
   Cache_Control   : constant String := "Cache-Control";

   function To_Header (Date : in Ada.Calendar.Time) return String
     renames Util.Dates.RFC7231.Image;

   type Quality_Type is digits 4 range 0.0 .. 1.0;

   --  Split an accept like header into multiple tokens and a quality value.
   --  Invoke the `Process` procedure for each token.  Example:
   --
   --     Accept-Language: de, en;q=0.7, jp, fr;q=0.8, ru
   --
   --  The `Process` will be called for "de", "en" with quality 0.7,
   --  and "jp", "fr" with quality 0.8 and then "ru" with quality 1.0.
   procedure Split_Header (Header  : in String;
                           Process : access procedure (Item    : in String;
                                                       Quality : in Quality_Type));

end Util.Http.Headers;

-----------------------------------------------------------------------
--  util-http-headers -- HTTP Headers
--  Copyright (C) 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Dates.RFC7231;

with Util.Http.Mimes;
package Util.Http.Headers is

   --  Some header names.
   Content_Type    : constant String := "Content-Type";
   Content_Length  : constant String := "Content-Length";
   Accept_Header   : constant String := "Accept";
   Accept_Language : constant String := "Accept-Language";
   Location        : constant String := "Location";
   Cookie          : constant String := "Cookie";
   Cache_Control   : constant String := "Cache-Control";

   function To_Header (Date : in Ada.Calendar.Time) return String
     renames Util.Dates.RFC7231.Image;

   type Quality_Type is digits 4 range 0.0 .. 1.0;

   --  Split an accept like header into multiple tokens and a quality value.
   --  Invoke the `Process` procedure for each token.  Example:
   --
   --     Accept-Language: de, en;q=0.7, jp, fr;q=0.8, ru
   --
   --  The `Process` will be called for "de", "en" with quality 0.7,
   --  and "jp", "fr" with quality 0.8 and then "ru" with quality 1.0.
   procedure Split_Header (Header  : in String;
                           Process : access procedure (Item    : in String;
                                                       Quality : in Quality_Type));

   --  Get the accepted media according to the `Accept` header value and a list
   --  of media/mime types.  The quality matching and wildcard are handled
   --  so that we return the best match.  With the following HTTP header:
   --
   --     Accept: image/*; q=0.2, image/jpeg
   --
   --  and if the mimes list contains `image/png` but not `image/jpeg`, the
   --  first one is returned.  If the list contains both, then `image/jpeg` is
   --  returned.
   function Get_Accepted (Header : in String;
                          Mimes  : in Util.Http.Mimes.Mime_List)
                         return Util.Http.Mimes.Mime_Access;

end Util.Http.Headers;

Declare the Get_Accepted function to find the accepted mime/media type according to a list of media types and the Accept header value


-----------------------------------------------------------------------
--  Util.Beans.Objects.Vectors -- Object vectors
--  Copyright (C) 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Containers.Vectors;
package Util.Beans.Objects.Vectors is new
Ada.Containers.Vectors (Index_Type       => Natural,
                            Element_Type => Object);

-----------------------------------------------------------------------
--  util-beans-vectors -- Object vectors
--  Copyright (C) 2011, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Containers.Vectors;
with Util.Beans.Basic;
package Util.Beans.Objects.Vectors is

   package Vectors is
     new Ada.Containers.Vectors (Index_Type       => Natural,
                                 Element_Type => Object);

   subtype Cursor is Vectors.Cursor;
   subtype Vector is Vectors.Vector;

   --  Make all the Vectors operations available (a kind of 'use Vectors' for anybody).
   function Length (Container : in Vector) return Ada.Containers.Count_Type renames Vectors.Length;
   function Is_Empty (Container : in Vector) return Boolean renames Vectors.Is_Empty;
   procedure Clear (Container : in out Vector) renames Vectors.Clear;
   function First (Container : in Vector) return Cursor renames Vectors.First;
   function Last (Container : in Vector) return Cursor renames Vectors.Last;
   function Element (Container : in Vector;
                     Position  : in Natural) return Object renames Vectors.Element;

   procedure Append (Container : in out Vector;
                     New_Item  : in Object;
                     Count     : in Ada.Containers.Count_Type := 1) renames Vectors.Append;
   procedure Query_Element (Position : in Cursor;
                            Process  : not null access procedure (Element : Object))
                            renames Vectors.Query_Element;
   procedure Update_Element (Container : in out Vector;
                             Position  : in Cursor;
                             Process   : not null access procedure (Element : in out Object))
                             renames Vectors.Update_Element;

   function Has_Element (Position : Cursor) return Boolean renames Vectors.Has_Element;
   function Element (Position : Cursor) return Object renames Vectors.Element;
   procedure Next (Position : in out Cursor) renames Vectors.Next;
   function Next (Position : Cursor) return Cursor renames Vectors.Next;
   function Previous (Position : Cursor) return Cursor renames Vectors.Previous;
   procedure Previous (Position : in out Cursor) renames Vectors.Previous;

   --  ------------------------------
   --  Map Bean
   --  ------------------------------
   --  The Map_Bean is a map of objects that also exposes the Bean interface.
   --  This allows the map to be available and accessed from an Object instance.
   type Vector_Bean is new Vectors.Vector and Util.Beans.Basic.Bean with private;
   type Vector_Bean_Access is access all Vector_Bean'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   function Get_Value (From : in Vector_Bean;
                       Name : in String) return Object;

   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   procedure Set_Value (From  : in out Vector_Bean;
                        Name  : in String;
                        Value : in Object);

   --  Create an object that contains a <tt>Vector_Bean</tt> instance.
   function Create return Object;

private

   type Vector_Bean is new Vectors.Vector and Util.Beans.Basic.Bean with null record;

end Util.Beans.Objects.Vectors;

Refactor the Vectors package so that it provides a Vector_Bean type that can be use to make an Object


------------------------------------------------------------------------------
--                                                                          --
--                   ASIS-for-GNAT INTERFACE COMPONENTS                     --
--                                                                          --
--                            A S I S . T E X T                             --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (C) 1995-2012, Free Software Foundation, Inc.       --
--                                                                          --
-- This   specification  is  derived   from  the  Ada   Semantic  Interface --
-- Specification Standard (ISO/IEC 15291) for use with GNAT.  The copyright --
-- notice above, and the license provisions that follow apply solely to the --
--  contents of the part following the private keyword.                     --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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  ASIS-for-GNAT; see file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by AdaCore                     --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
--  20 package Asis.Text
------------------------------------------------------------------------------
------------------------------------------------------------------------------
package Asis.Text is
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--  Asis.Text
--
--  This package encapsulates a set of operations to access the text of ASIS
--  Elements.  It assumes no knowledge of the existence, location, or form of
--  the program text.
--
--  The text of a program consists of the texts of one or more compilations.
--  The text of each compilation is a sequence of separate lexical elements.
--  Each lexical element is either a delimiter, an identifier (which can be a
--  reserved word), a numeric literal, a character literal, a string literal,
--  blank space, or a comment.
--
--  Each ASIS Element has a text image whose value is the series of characters
--  contained by the text span of the Element.  The text span covers all the
--  characters from the first character of the Element through the last
--  character of the Element over some range of lines.
--
--  General Usage Rules:
--
--  Line lists can be indexed to obtain individual lines.  The bounds of each
--  list correspond to the lines with those same numbers from the compilation
--  text.
--
--  Any Asis.Text query may raise ASIS_Failed with a Status of Text_Error if
--  the program text cannot be located or retrieved for any reason such as
--  renaming, deletion, corruption, or moving of the text.
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--  20.1  type Line
------------------------------------------------------------------------------
--  An Ada text line abstraction (a private type).
--
--  Used to represent text fragments from a compilation.
--  ASIS Lines are representations of the compilation text.
--  This shall be supported by all ASIS implementations.
------------------------------------------------------------------------------

   type Line is private;
   Nil_Line  : constant Line;

   function "=" (Left  : Line; Right : Line) return Boolean is abstract;

--  Nil_Line is the value of an uninitialized Line object.
--
------------------------------------------------------------------------------
--  20.2  type Line_Number
------------------------------------------------------------------------------
--  Line_Number
--
--  A numeric subtype that allows each ASIS implementation to place constraints
--  on the upper bound for Line_List elements and compilation unit size.
--
--  The upper bound of Line_Number (Maximum_Line_Number) is the only
--  allowed variation for these declarations.
--
--  Line_Number = 0 is reserved to act as an "invalid" Line_Number value.  No
--  unit text line will ever have a Line_Number of zero.
------------------------------------------------------------------------------
--  Line shall be an undiscriminated private type, or, shall be derived from an
--  undiscriminated private type.  It can be declared as a new type or as a
--  subtype of an existing type.
------------------------------------------------------------------------------

   Maximum_Line_Number : constant ASIS_Natural :=
      Implementation_Defined_Integer_Constant;

   subtype Line_Number is ASIS_Natural range 0 .. Maximum_Line_Number;

------------------------------------------------------------------------------
--  20.3  type Line_Number_Positive
------------------------------------------------------------------------------

   subtype Line_Number_Positive is Line_Number range 1 .. Maximum_Line_Number;

------------------------------------------------------------------------------
--  20.4  type Line_List
------------------------------------------------------------------------------

   type Line_List is array (Line_Number_Positive range <>) of Line;
   Nil_Line_List : constant Line_List;

------------------------------------------------------------------------------
--  20.5  type Character_Position
------------------------------------------------------------------------------
--  Character_Position
--
--  A numeric subtype that allows each ASIS implementation to place constraints
--  on the upper bound for Character_Position and for compilation unit line
--  lengths.
--
--  The upper bound of Character_Position (Maximum_Line_Length) is the
--  only allowed variation for these declarations.
--
--  Character_Position = 0 is reserved to act as an "invalid"
--  Character_Position value.  No unit text line will ever have a character in
--  position zero.
------------------------------------------------------------------------------

   Maximum_Line_Length : constant ASIS_Natural :=
      Implementation_Defined_Integer_Constant;

   subtype Character_Position is ASIS_Natural range 0 .. Maximum_Line_Length;

------------------------------------------------------------------------------
--  20.6  type Character_Position_Positive
------------------------------------------------------------------------------

   subtype Character_Position_Positive is
      Character_Position range 1 .. Maximum_Line_Length;

------------------------------------------------------------------------------
--  20.7  type Span
------------------------------------------------------------------------------
--  Span
--
--  A single text position is identified by a line number and a column number,
--  that represent the text's position within the compilation unit.
--
--  The text of an element can span one or more lines.  The textual Span of an
--  element identifies the lower and upper bound of a span of text positions.
--
--  Spans and positions give client tools the option of accessing compilation
--  unit text through the queries provided by this package, or, to access
--  the text directly through the original compilation unit text file. Type
--  span
--  facilitates the capture of comments before or after an element.
--
--  Note: The original compilation unit text may or may not have existed in a
--  "file", and any such file may or may not still exist. Reference Manual 10.1
--  specifies that the text of a compilation unit is submitted to a compiler.
--  It does not specify that the text is stored in a "file", nor does it
--  specify that the text of a compilation unit has any particular lifetime.
------------------------------------------------------------------------------

   type Span is                                       -- Default is Nil_Span
      record
         First_Line   : Line_Number_Positive        := 1; -- 1..0 - empty
         First_Column : Character_Position_Positive := 1; -- 1..0 - empty
         Last_Line    : Line_Number                 := 0;
         Last_Column  : Character_Position          := 0;
      end record;

   Nil_Span : constant Span := (First_Line   => 1,
                                First_Column => 1,
                                Last_Line    => 0,
                                Last_Column  => 0);

------------------------------------------------------------------------------
--  20.8  function First_Line_Number
------------------------------------------------------------------------------

   function First_Line_Number (Element : Asis.Element) return Line_Number;

------------------------------------------------------------------------------
--  Element - Specifies the element to query
--
--  Returns the first line number on which the text of the element resides.
--
--  Returns 0 if not Is_Text_Available(Element).
--
--  --|AN Application Note:
--  --|AN
--  --|AN The line number recorded for a particular element may or may not
--  --|AN match the "true" line number of the program text for that element if
--  --|AN the Ada environment and the local text editors do not agree on the
--  --|AN definition of "line". For example, the Reference Manual states that
--  --|AN any occurrence of an ASCII.Cr character is to be treated as one or
--  --|AN more end-of-line occurrences.  On most Unix systems, the editors do
--  --|AN not treat a carriage return as being an end-of-line character.
--  --|AN
--  --|AN Ada treats all of the following as end-of-line characters: ASCII.Cr,
--  --|AN ASCII.Lf, ASCII.Ff, ASCII.Vt.  It is up to the compilation system to
--  --|AN determine whether sequences of these characters causes one, or more,
--  --|AN end-of-line occurrences.  Be warned, if the Ada environment and the
--  --|AN system editor (or any other line-counting program) do not use the
--  --|AN same end-of-line conventions, then the line numbers reported by ASIS
--  --|AN may not match those reported by those other programs.
--
------------------------------------------------------------------------------
--  20.9  function Last_Line_Number
------------------------------------------------------------------------------

   function Last_Line_Number (Element : Asis.Element) return Line_Number;

------------------------------------------------------------------------------
--  Element - Specifies the element to query
--
--  Returns the last line number on which the text of the element resides.
--
--  Returns 0 if not Is_Text_Available(Element).
--
------------------------------------------------------------------------------
--  20.10 function Element_Span
------------------------------------------------------------------------------

   function Element_Span (Element : Asis.Element) return Span;

------------------------------------------------------------------------------
--  Element - Specifies the element to query
--
--  Returns the span of the given element.
--
--  Returns a Nil_Span if the text of a Compilation_Unit (Compilation) cannot
--  be located for any reason.
--  --|AN
--  --|AN For this query, Element is only a means to access the
--  --|AN Compilation_Unit (Compilation), the availability of the text of this
--  --|AN Element itself is irrelevant to the result of the query.
--
------------------------------------------------------------------------------
--  20.11 function Compilation_Unit_Span
------------------------------------------------------------------------------

   function Compilation_Unit_Span (Element : Asis.Element) return Span;

------------------------------------------------------------------------------
--  Element - Specifies the element to query
--
--  Returns the span of the text comprising the enclosing compilation unit of
--  the given element.
--
--  Returns a Nil_Span if the text of a Compilation_Unit (Compilation) cannot
--  be located for any reason.
--  --|AN
--  --|AN For this query, Element is only a means to access the
--  --|AN Compilation_Unit (Compilation), the availability of the text of this
--  --|AN Element itself is irrelevant to the result of the query.
--
------------------------------------------------------------------------------
--  20.12 function Compilation_Span
------------------------------------------------------------------------------

   function Compilation_Span (Element : Asis.Element) return Span;

------------------------------------------------------------------------------
--  Element - Specifies the element to query
--
--  Returns the span of the text comprising the compilation to which the
--  element belongs.  The text span may include one or more compilation units.
--
--  Returns a Nil_Span if not Is_Text_Available(Element).
--
------------------------------------------------------------------------------
--  20.13 function Is_Nil
------------------------------------------------------------------------------

   function Is_Nil (Right : Line) return Boolean;

------------------------------------------------------------------------------
--  Right   - Specifies the line to check
--
--  Returns True if the argument is the Nil_Line.
--
--  A Line from a Line_List obtained from any of the Lines functions
--  will not be Is_Nil even if it has a length of zero.
--
------------------------------------------------------------------------------
--  20.14 function Is_Nil
------------------------------------------------------------------------------

   function Is_Nil (Right : Line_List) return Boolean;

------------------------------------------------------------------------------
--  Right   - Specifies the line list to check
--
--  Returns True if the argument has a 'Length of zero.
--

------------------------------------------------------------------------------
--  20.15 function Is_Nil
------------------------------------------------------------------------------

   function Is_Nil (Right : Span) return Boolean;

------------------------------------------------------------------------------
--  Right   - Specifies the Span to check
--
--  Returns True if the argument has a Nil_Span.
--
------------------------------------------------------------------------------
--  20.16 function Is_Equal
------------------------------------------------------------------------------

   function Is_Equal (Left  : Line; Right : Line) return Boolean;

------------------------------------------------------------------------------
--  Left    - Specifies the first of the two lines
--  Right   - Specifies the second of the two lines
--
--  Returns True if the two lines encompass the same text (have the same Span
--  and are from the same compilation).
--
------------------------------------------------------------------------------
--  20.17 function Is_Identical
------------------------------------------------------------------------------

   function Is_Identical (Left  : Line; Right : Line) return Boolean;

------------------------------------------------------------------------------
--  Left    - Specifies the first of the two lines
--  Right   - Specifies the second of the two lines
--
--  Returns True if the two lines encompass the same text (have the same Span
--  and are from the same compilation) and are from the same Context.
--
------------------------------------------------------------------------------
--  20.18 function Length
------------------------------------------------------------------------------

   function Length (The_Line : Line) return Character_Position;

------------------------------------------------------------------------------
--  The_Line    - Specifies the line to query
--
--  Returns the length of the line.
--
--  Raises ASIS_Inappropriate_Line if Is_Nil (The_Line).
--
------------------------------------------------------------------------------
--  20.19 function Lines
------------------------------------------------------------------------------

   function Lines (Element : Asis.Element) return Line_List;

------------------------------------------------------------------------------
--  Element - Specifies the element to query
--
--  Returns a list of lines covering the span of the given program element.
--
--  Returns a Nil_Span if the text of a Compilation containing a given
--  Element cannot be located for any reason.
--
--  Line lists can be indexed to obtain individual lines.  The bounds of each
--  list correspond to the lines with those same numbers in the compilation
--  text.
--
--  The first Line of the result contains text from the compilation starting at
--  the First_Line/First_Column of Element's Span.  The last Line of the result
--  contains text from the compilation ending at the Last_Line/Last_Column of
--  the Element's Span.  Text before or after those limits is not reflected
--  in the returned list.
--  --|AN
--  --|AN For this query, Element is only a means to access the
--  --|AN Compilation_Unit (Compilation), the availability of the text of this
--  --|AN Element itself is irrelevant to the result of the query.
--
------------------------------------------------------------------------------
--  20.20 function Lines
------------------------------------------------------------------------------

   function Lines
     (Element  : Asis.Element;
      The_Span : Span)
      return     Line_List;

------------------------------------------------------------------------------
--  Element  - Specifies the element to query
--  The_Span - Specifies the textual span to return
--
--  Returns a list of lines covering the given span from the compilation
--  containing the given program element.
--
--  Returns a Nil_Span if the text of a Compilation containing a given
--  Element cannot be located for any reason.
--
--  This operation can be used to access lines from text outside the span of an
--  element, but still within the compilation.  For example, lines containing
--  preceding comments or lines between two elements.
--
--  Line lists can be indexed to obtain individual lines.  The bounds of each
--  list correspond to the lines with those same numbers in the compilation
--  text.
--
--  The first Line of the result contains text from the compilation starting at
--  line Span.First_Line and column Span.First_Column.  The last Line of the
--  result contains text from the compilation ending at line Span.Last_Line and
--  column Span.Last_Column.  Text before or after those limits is not
--  reflected in the returned list.
--
--  Raises ASIS_Inappropriate_Line_Number if Is_Nil (The_Span). If
--  The_Span defines a line whose number is outside the range of text lines
--  that can be accessed through the Element, the implementation is encouraged,
--  but not required to raise ASIS_Inappropriate_Line_Number.
--  --|AN
--  --|AN For this query, Element is only a means to access the
--  --|AN Compilation_Unit (Compilation), the availability of the text of this
--  --|AN Element itself is irrelevant to the result of the query.
--
------------------------------------------------------------------------------
--  20.21 function Lines
------------------------------------------------------------------------------

   function Lines
     (Element    : Asis.Element;
      First_Line : Line_Number_Positive;
      Last_Line  : Line_Number)
      return       Line_List;

------------------------------------------------------------------------------
--  Element     - Specifies the element to query
--  First_Line  - Specifies the first line to return
--  Last_Line   - Specifies the last line to return
--
--  Returns a list of Lines covering the full text for each of the indicated
--  lines from the compilation containing the given element.  This operation
--  can be used to access lines from text outside the span of an element, but
--  still within the compilation.
--
--  Returns a Nil_Span if the text of a Compilation containing a given
--  Element cannot be located for any reason.
--
--  Line lists can be indexed to obtain individual lines.  The bounds of each
--  list correspond to the lines with those same numbers in the compilation
--  text.
--
--  Raises ASIS_Inappropriate_Line_Number if the span is nil. If the span
--  defines a line whose number is outside the range of text lines that can be
--  accessed through the Element, the implementation is encouraged, but not
--  required to raise ASIS_Inappropriate_Line_Number.
--  --|AN
--  --|AN For this query, Element is only a means to access the
--  --|AN Compilation_Unit (Compilation), the availability of the text of this
--  --|AN Element itself is irrelevant to the result of the query.
--
------------------------------------------------------------------------------
--  20.22 function Delimiter_Image
------------------------------------------------------------------------------

   function Delimiter_Image return Wide_String;

------------------------------------------------------------------------------
--  Returns the string used as the delimiter separating individual lines of
--  text within the program text image of an element. It is also used as the
--  delimiter separating individual lines of strings returned by Debug_Image.
--
------------------------------------------------------------------------------
--  20.23 function Element_Image
------------------------------------------------------------------------------

   function Element_Image (Element : Asis.Element) return Program_Text;

------------------------------------------------------------------------------
--  Element - Specifies the element to query
--
--  Returns a program text image of the element.  The image of an element can
--  span more than one line, in which case the program text returned by the
--  function Delimiter_Image separates the individual lines.  The bounds on
--  the returned program text value are 1..N, N is as large as necessary.
--
--  Returns a null string if not Is_Text_Available(Element).
--
--  If an Element's Span begins at column position P, the returned program text
--  will be padded at the beginning with P-1 white space characters (ASCII.' '
--  or ASCII.Ht).  The first character of the Element's image will thus begin
--  at character P of the returned program text. Due to the possible presence
--  of ASCII.Ht characters, the "column" position of characters within the
--  image might not be the same as their print-column positions when the image
--  is displayed on a screen or printed.
--
--  NOTE: The image of a large element can exceed the range of Program_Text.
--  In this case, the exception ASIS_Failed is raised with a Status of
--  Capacity_Error. Use the Lines function to operate on the image of large
--  elements.
--
------------------------------------------------------------------------------
--  20.24 function Line_Image
------------------------------------------------------------------------------

   function Line_Image (The_Line : Line) return Program_Text;

------------------------------------------------------------------------------
--  The_Line    - Specifies the line to query
--
--  Returns a program text image of the line.  The image of a single lexical
--  element can be sliced from the returned value using the first and last
--  column character positions from the Span of the Element.  The bounds on the
--  returned program text are 1 .. Length(Line).
--
--  If the Line is the first line from the Lines result for an Element, it can
--  represent only a portion of a line from the original compilation.  If the
--  span began at character position P, the first Line of it's Lines
--  result is padded at the beginning with P-1 white space characters
--  (ASCII.' ' or ASCII.Ht).  The first character of the image will
--  thus begin at character P of the program text for the first Line. Due to
--  the possible presence of ASCII.Ht characters, the "column" position of
--  characters within the image may not be the same as their print-column
--  positions when the image is displayed or printed.
--
--  Similarly, if the Line is the last line from the Lines result for an
--  Element, it may represent only a portion of a line from the original
--  compilation.  The program text image of such a Line is shorter than the
--  line from compilation and will contain only the initial portion of
--  that line.
--
--  Raises ASIS_Inappropriate_Line if Is_Nil (The_Line).
--
------------------------------------------------------------------------------
--  20.25 function Non_Comment_Image
------------------------------------------------------------------------------

   function Non_Comment_Image (The_Line : Line) return Program_Text;

------------------------------------------------------------------------------
--  The_Line    - Specifies the line to query
--
--  Returns a program text image of a Line up to, but excluding, any comment
--  appearing in that Line.
--
--  The value returned is the same as that returned by the Image function,
--  except that any hyphens ("--") that start a comment, and any characters
--  that follow those hyphens, are dropped.
--
--  The bounds on the returned program text are 1..N, where N is one less than
--  the column of any hyphens ("--") that start a comment on the line.
--
--  Raises ASIS_Inappropriate_Line if Is_Nil (The_Line).
--
------------------------------------------------------------------------------
--  20.26 function Comment_Image
------------------------------------------------------------------------------

   function Comment_Image (The_Line : Line) return Program_Text;

------------------------------------------------------------------------------
--  The_Line    - Specifies the line to query
--
--  Returns a program text image of any comment on that line, excluding any
--  lexical elements preceding the comment.
--
--  The value returned is the same as that returned by the Image function,
--  except that any program text prior to the two adjacent hyphens ("--") which
--  start a comment is replaced by an equal number of spaces.  If the hyphens
--  began in column P of the Line, they will also begin in character position
--  P of the returned program text.
--
--  A null string is returned if the line has no comment.
--
--  The bounds of the program text are 1..N, where N is as large as necessary.
--
--  Raises ASIS_Inappropriate_Line if Is_Nil (The_Line).
--
------------------------------------------------------------------------------
--  20.27 function Is_Text_Available
------------------------------------------------------------------------------

   function Is_Text_Available (Element : Asis.Element) return Boolean;

------------------------------------------------------------------------------
--  Element - Specifies the element to query
--
--  Returns True if the implementation can return a valid text image for the
--  given element.
--
--  Returns False for any Element that Is_Nil, Is_Part_Of_Implicit, or
--  Is_Part_Of_Instance.
--
--  Returns False if the text of the element cannot be located for any reason
--  such as renaming, deletion, or moving of text.
--
--  --|IR Implementation Requirements:
--  --|IR
--  --|IR An implementation shall make text available for all explicit
--  --|IR elements.
--
------------------------------------------------------------------------------
--  20.28 function Debug_Image
------------------------------------------------------------------------------

   function Debug_Image (The_Line : Line) return Wide_String;

------------------------------------------------------------------------------
--  The_Line    - Specifies the line to convert
--
--  Returns a string value containing implementation-defined debug
--  information associated with the line.
--
--  The return value uses Asis.Text.Delimiter_Image to separate the lines
--  of multi-line results.  The return value does not end with
--  Asis.Text.Delimiter_Image.
--
--  These values are intended for two purposes.  They are suitable for
--  inclusion in problem reports sent to the ASIS implementor.  They can
--  be presumed to contain information useful when debugging the
--  implementation itself. They are also suitable for use by the ASIS
--  application when printing simple application debugging messages during
--  application development.  They are intended to be, to some worthwhile
--  degree, intelligible to the user.
--
------------------------------------------------------------------------------

private

   --  The content of this private part is specific for the ASIS
   --  implementation for GNAT

------------------------------------------------------------------------------

   type Line is
      record
         Sloc              : Source_Ptr         := No_Location;
         Comment_Sloc      : Source_Ptr         := No_Location;
         Length            : Character_Position := 0;
         Rel_Sloc          : Source_Ptr         := No_Location;
         Enclosing_Unit    : Unit_Id            := Nil_Unit;
         Enclosing_Context : Context_Id         := Non_Associated;
         Enclosing_Tree    : Tree_Id            := Nil_Tree;
         Obtained          : ASIS_OS_Time       := Nil_ASIS_OS_Time;
      end record;

   Nil_Line : constant Line := (Sloc              => No_Location,
                                Comment_Sloc      => No_Location,
                                Length            => 0,
                                Rel_Sloc          => No_Location,
                                Enclosing_Unit    => Nil_Unit,
                                Enclosing_Context => Non_Associated,
                                Enclosing_Tree    => Nil_Tree,
                                Obtained          => Nil_ASIS_OS_Time);

   --  Note, that Line does not have the predefined "=" operation (it is
   --  overridden by an abstract "=". The predefined "=" is explicitly
   --  simulated in the implementation of Is_Nil query, so, if the full
   --  declaration for Line is changed, the body of Is_Nil should be revised.

   -----------------------------
   -- Fields in the Line type --
   -----------------------------

   --  Sloc : Source_Ptr         := No_Location;
   --    indicates the beginning of the corresponding line in the Source
   --    Buffer. If a given Line is the first line covering the Image of
   --    some Element, the position in the Source Buffer pointed by Sloc
   --    may or may not correspond to the beginning of the source text
   --    line
   --
   --  Comment_Sloc - represents the starting Sloc position of a comment
   --    that is a part of the line. Set to 0 if the line does not contain a
   --    a comment. Note, that we assume that in the comment text the bracket
   --    encoding can not be used for wide characters
   --
   --  Length : Character_Position := 0;
   --    represents the length of the Line, excluding any character
   --    signifying end of line (RM95, 2.2(2))
   --    Note, that in the compiler lines of the source code are represented
   --    using the String type, and if the line contains a wide character that
   --    requires more than one one-byte character for its representation, the
   --    length of one-byte character string used to represent wide-character
   --    string from the source code may be bigger then the length of the
   --    original source line (length here is the number of characters). In the
   --    Line type we keep the lenth of the source line counted in source
   --    characters, but not the length of the internal representation in
   --    one-byte characters. Note that this length does not depend on the
   --    encoding method.
   --
   --  Rel_Sloc : Source_Ptr := No_Location;
   --    needed to compare string representing elements of the same
   --    compilation units, but probably obtained from different trees
   --    containing this unit. Obtained in the same way as for Elements -
   --    by subtracting from Sloc field the source location of the
   --    N_Compilation_Unit node
   --
   --  Enclosing_Unit    : Unit_Id    := Nil_Unit;
   --  Enclosing_Context : Context_Id := Non_Associated;
   --    These fields represent the Context in which and the Compilation
   --    Unit from which the given line was obtained, they are needed
   --    for comparing Lines and for tree swapping when obtaining
   --    Line_Image
   --
   --  Enclosing_Tree : Tree_Id := Nil_Tree;
   --    Sloc field may be used for obtaining the image of a Line only in
   --    the tree from which it was obtained. So the Line has to keep
   --    the reference to the tree for tree swapping
   --
   --  Obtained : ASIS_OS_Time := Nil_ASIS_OS_Time;
   --    Lines, as well as Elements, cannot be used after closing the
   --    Context from which they were obtained. We use time comparing
   --    to check the validity of a Line

   --  In the current implementation, ASIS Lines are mapped onto logical
   --  GNAT lines, as defined in the Sinput package.

   --  The child package Asis.Text.Set_Get defines operations for
   --  accessing and updating fields of Lines, for checking the validity
   --  of a Line and for creating the new value of the Line type.
   --  (This package is similar to the Asis.Set_Get package, which
   --  defines similar things for other ASIS abstractions - Element,
   --  Context, Compilation_Unit.)

   Nil_Line_List : constant Line_List (1 .. 0) := (1 .. 0 => Nil_Line);

------------------------------------------------------------------------------

end Asis.Text;

Add the ASIS file $i

Add the ASIS file $i


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                         A 4 G . C O N T T . U T                          --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (C) 1995-2011, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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  ASIS-for-GNAT; see file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  AdaCore.                  --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

--  This package defines for each ASIS Context the corresponding Unit Table,
--  which contains all the information needed for the black-box ASIS queries
--  about Compilation Units. This table also provides the mechanism for
--  searching for a unit by its Ada name, this mechanism is some slight
--  modification of the GNAT Namet package.

with Asis;            use Asis;
with Asis.Extensions; use Asis.Extensions;

package A4G.Contt.UT is        --  Context_Table.Unit_Tables

   ---------------------
   -- ASIS Unit Table --
   ---------------------

   --  ASIS Unit Table is the main part of the implementation of ASIS Context
   --  and ASIS Compilation Unit abstractions. The table is organized in the
   --  following way:

   --  - the internal representation of an ASIS Compilation Unit is the
   --    value of the corresponding Unit Record which is kept in Unit Table
   --    and indicated by Unit Id;

   --  - each ASIS Context has its own Unit Table, so most the routines
   --    dealing with Unit Table contain the Id of an Enclosing Context
   --    as a Parameter;

   --  - each ASIS Compilation Units keeps the Id of its enclosing
   --    Context as a part of its value;

   --  - The fully expanded Ada name, together for the spec/body sign,
   --    uniquely identifies a given unit inside its enclosing
   --    Context/Context; so the triple - expanded Ada name, spec/body
   --    sign and some identification of the Unit's enclosing Context/Context
   --    uniquely identifies a given unit among all the Unit processed
   --    by ASIS;

   --  - The normalized Ada name, is obtained from the fully expanded
   --    Ada Unit name by folding all the upper case letters in the
   --    corresponding lower case letters, appending the spec/body sign
   --    (which has the form "%s" for a spec and "%b" for a body);

   --  The entries in the table are accessed using a Unit_Id that ranges
   --  from First_Unit_Id to Last_Unit_Id. The fields of each entry and
   --  the corresponding interfaces may be subdivided into four groups.

   --  The first group, called as Unit Name Table,  provides the modified
   --  version of the functionality of the GNAT Namet package, it is used
   --  for storing the names of the Units in two forms - in the normalized
   --  and in the form corresponding to the (defining) occurrence of a
   --  given name in a source text. Each unit can be effectively searched
   --  by its normalized name.

   --  The second group contains the black-box attributes of a Unit.

   --  The third group contains the information about relations (semantic
   --  dependencies) between the given unit and the other units in the
   --  enclosing Context/Context Note, that Ada Unit name,
   --  included in the first group, logically should also be considered
   --  as a black-box Unit attribute.

   --  And the fourth group contains the fields needed for organization of the
   --  tree swapping during the multiple Units processing.

   ---------------------
   -- Unit Name Table --
   ---------------------

   --  Each Unit entry contain the following fields:

   --  "Normalized" Ada name  "Normalized" Ada names of the ASIS Compilation
   --                          Units are their names with upper case letters
   --                          folded to lower case (by applying the
   --                          Ada.Character.Handling.To_Lower functions;
   --                          this lover-case-folding has no relation to GNAT
   --                          conventions described in Namet!), appended by
   --                          suffix %s or %b for spec or bodies/subunits, as
   --                          defined in Uname (spec), and prepended by
   --                          the string image of the Id value of the unit's
   --                          enclosing Context. Each of the names of this
   --                          kind may have only one entry in Unit Name Table.
   --
   --  Ada name                Ada names of the ASIS Compilation Units are
   --                          stored keeping the casing from the source text.
   --                          These entries are used to implement the ASIS
   --                          query (-ies?) returning the Ada name of the
   --                          Unit. Ada names may be included more than one
   --                          time in Unit Name Table as the parts of the
   --                          different table entries, as the name of a spec
   --                          and the name of a corresponding body.
   --
   --  Source File Name        The name of the Ada source file used to compile
   --                          the given compilation unit (on its own or as a
   --                          supporter of some other unit).
   --
   --  Reference File Name     The name of the source file which represents
   --                          the unit source from the user's viewpoint. It is
   --                          the same as the Source File name unless the
   --                          Source_Reference pragma presents for the given
   --                          unit.

   type Column is (Norm_Ada_Name, Ada_Name, Source_File_Name, Ref_File_Name);
   --  This enumeration type defines literals used to make the difference
   --  between different forms of names stored in the Unit Table

   --  Really every name is kept as the reference into the Char table,
   --  together with the length of its name.

   --  The normalized names are hashed, so that a given normalized name appears
   --  only once in the table.

   --  Opposite to the GNAT name table, this name table does not handle the
   --  one-character values in a special way (there is no need for it, because
   --  storing an one-character name does not seem to be a usual thing
   --  for this table.)

   --  ASIS "normalized" Unit names follow the convention which is
   --  very similar to the GNAT convention defined in Uname (spec), the
   --  only difference is that ASIS folds all the upper case
   --  letters to the corresponding lower case letters without any encoding.
   --  ASIS packages implementing the ASIS Context model for GNAT contain
   --  "ASIS-related counterparts" of some facilities provided by three
   --  GNAT packages - Namet, Uname and Fname.

   --  We keep storing the two values, one of type Int and one of type Byte,
   --  with each names table entry and subprograms are provided for setting
   --  and retrieving these associated values. But for now these values are
   --  of no use in ASIS - we simply are keeping this mechanism from the
   --  GNAT name table - just in case.

   --  Unit Name Table may be considered as having the external view
   --  of the two-column table - for each row indicated by Unit_Id the
   --  first column contains the Ada name of the corresponding Unit and
   --  the second column contains Unit's "normalized" name.

   --  In fact we do not use any encoding-decoding in Unit Name Table. ASIS
   --  supports only a standard mode of GNAT (that is, it relies on the fact
   --  that all the identifiers contain only Row 00 characters). ASIS also
   --  assumes that all the names of the source files are the values of
   --  the Ada predefined String type.

   --  All the Unit Tables shares the same Name Buffer, see the specification
   --  of the parent package for its definition.

   ---------------------------------
   -- Unit Name Table Subprograms --
   ---------------------------------

   procedure Get_Name_String (Id : Unit_Id; Col : Column);
   --  Get_Name_String is used to retrieve the one of the three strings
   --  associated with an entry in the names table. The Col parameter
   --  indicates which of the names should be retrieved (Ada name, normalized
   --  Ada name or source file name) by indicating the "column" in the table
   --  The resulting string is stored in Name_Buffer and Name_Len is set.

   function Length_Of_Name (Id : Unit_Id; Col : Column) return Nat;
   --  ??? pragma Inline (Length_Of_Name);
   --  Returns length of given name in characters, the result is equivalent to
   --  calling Get_Name_String and reading Name_Len, except that a call to
   --  Length_Of_Name does not affect the contents of Name_Len and Name_Buffer.

   function Name_Find (C : Context_Id) return Unit_Id;
   --  Name_Find is called with a string stored in Name_Buffer whose length
   --  is in Name_Len (i.e. the characters of the name are in subscript
   --  positions 1 to Name_Len in Name_Buffer). It searches the names
   --  table to see if the string has already been stored. If so the Id of
   --  the existing entry is returned. Otherwise (opposite to the GNAT name
   --  table, in which a new entry is created it this situation with its
   --  Name_Table_Info field set to zero) the Id value corresponding to the
   --  ASIS Nil_Compilation_Unit, that is Nil_Unit, is returned.
   --
   --  Only normalized Ada names are hashed, so this function is intended to
   --  be applied to the normalized names only (in is not an error to apply
   --  it to other forms of names stored in the table, but the result will
   --  always be Nil_Unit.

   function Allocate_Unit_Entry (C : Context_Id) return Unit_Id;
   --  Allocates the new entry in the Unit Name Table for the "normalized"
   --  Ada Unit name stored in the Name_Buffer (Name_Len should be set
   --  in a proper way). This routine should be called only if the
   --  immediately preceding call to an operation working with Unit Name
   --  Table is the call to Name_Find which has yielded Nil_Unit as a
   --  result. Note, that this function sets only the "normalized" unit name,
   --  it does not set the Ada name or the source file name. It also
   --  increases by one the counter of allocated bodies or specs, depending
   --  on the suffix in the normalized unit name.

   function Allocate_Nonexistent_Unit_Entry (C : Context_Id) return Unit_Id;
   --  Differs from the previous function in the following aspects:
   --  -  'n' is added to the name suffix to mark that this entry
   --     corresponds to the nonexistent unit;
   --  -  The body/spec counters are not increased
   --  -  all the attributes of the allocated nonexistent unit are set by
   --     this procedure.
   --
   --  Allocates the new entry in the Unit Name Table for the "normalized"
   --  Ada Unit name stored in the Name_Buffer (Name_Len should be set
   --  in a proper way). This routine should be called only if the
   --  immediately preceding call to an operation working with Unit Name
   --  Table is the call to Name_Find which has yielded Nil_Unit as a
   --  result. Note, that this function sets only the "normalized" unit name,
   --  it does not set the Ada name or the source file name.

   function Set_Unit (C : Context_Id; U : Unit_Number_Type) return Unit_Id;
   --  Creates the Unit table entry for the unit U and sets the normalized
   --  unit name (which is supposed to be stored in A_Name_Buffer when this
   --  procedure is called) and the time stamp for the unit. It also adds
   --  the (Id of the) currently accessed tree to the (empty) list
   --  of (consistent) trees for this unit. All the other unit attributes
   --  are set to nil values. The ID of the created entry is returned as a
   --  result

   procedure Set_Ada_Name (Id : Unit_Id);
   pragma Inline (Set_Ada_Name);
   --  Sets the string stored in Name_Buffer whose length is Name_Len as the
   --  value of the Ada name of the ASIS Unit indicated by Id value

   procedure Set_Norm_Ada_Name (Id : Unit_Id);
   pragma Inline (Set_Norm_Ada_Name);
   --  Sets the string stored in Name_Buffer whose length is Name_Len as the
   --  value of the "normalized" Ada name of the ASIS Unit indicated by Id
   --  value

   procedure Set_Ref_File_As_Source_File (U : Unit_Id);
   --  For a given unit in a given context, sets the reference file name equal
   --  to the source file name (by copying the corresponding references to
   --  the ASIS Chars table

   procedure Set_Source_File_Name (Id  : Unit_Id; Ref : Boolean := False);
   pragma Inline (Set_Source_File_Name);
   --  Sets the string stored in the A_Name_Buffer whose length is A_Name_Len
   --  as the value of the source or reference (depending on the actual set
   --  for the Ref parameter) file name of the ASIS Unit indicated by Id value

   procedure Set_Norm_Ada_Name_String;
   --  Sets the Normalized Ada Unit name as the value of Name_Buffer.
   --  This normalized version of the Ada Unit name is
   --  obtained by folding to lover cases of the GNAT unit name
   --  which should be previously get as the content of
   --  Namet.Name_Buffer (that means that every call to this procedure
   --  should be preceded by the appropriate call to
   --  Namet.Get_Unqualified_Decoded_Name_String (or
   --  Namet.Get_Decoded_Name_String if the caller is sure, that the name is
   --  not qualified)

   procedure Set_Norm_Ada_Name_String_With_Check
     (Unit    :     Unit_Number_Type;
      Success : out Boolean);
   --  This is the modified version of Set_Norm_Ada_Name_String: after setting
   --  the ASIS name buffer it checks if Unit should be considered as
   --  Compilation_Unit by ASIS. The need for this check caused by artificial
   --  compilation units created by the compiler for library-level generic
   --  instantiations. If the check is successful, Success is set True,
   --  otherwise it is set False.
   --
   --  In case of a tree created for library-level instantiation of a generic
   --  package (only package ???) GNAT sets the suffix of the name of the
   --  corresponding unit in its unit table as '%b', but ASIS has to see
   --  this unit as a spec, therefore in this case this procedure resets the
   --  suffix of the unit name to '%s'

   procedure Set_Ref_File_Name_String (U : Unit_Id);
   --  Is supposed to be called when GNAT Namet.Name_Buffer contains a full
   --  reference file name. It sets the Reference File name as the value of
   --  A_Name_Buffer. This name is composed from the reference file name
   --  obtained from the tree and from the source file name (in which the
   --  directory information is already adjusted , if needed, by the
   --  corresponding call to Set_S_File_Name_String) to contain the directory
   --  information needed to access this file from the current directory.

   -------------------------------
   -- Black-Box Unit Attributes --
   -------------------------------

   --  Each Unit entry contains the following fields, representing the Unit
   --  black-box attributes, which are for the direct interest for the ASIS
   --  queries from the Asis_Compilation_Unit package, the primary idea of
   --  implementing the Context/Compilation_Unit stuff in ASIS-for-GNAT is
   --  to compute each of these attribute only once, when the new tree is
   --  inputted by ASIS for the first time, and then store them in Unit
   --  Table, so then ASIS queries will be able to get the required
   --  answer without any new tree processing:

   --  Top : Node_Id;
   --    The top node of the unit subtree in the currently accessed full tree.
   --    From one side, this node should be reset every time the full tree
   --    is changed. From the other side, the corresponding actions may be
   --    considered as too time-consumed. This problem is postponed now as
   --    OPEN PROBLEM, it is not important till we are working under the
   --    limitation "only one tree can be accessed at a time"

   --  Enclosing_Context : Context_Id;
   --    The reference to the Context table which indicates the Enclosing
   --    Context for a Unit

   --  Kind : Unit_Kinds;
   --    The kind of a Compilation Unit, as defined by Asis.Unit_Kinds
   --    package

   --  Class : Unit_Classes;
   --    The class of a Compilation Unit, as defined by Asis.Unit_Kinds
   --    package

   --  Origin : Unit_Origins;
   --    The origin of a Compilation Unit, as defined by Asis.Unit_Kinds
   --    package

   --  Main_Unit : Boolean;
   --    The boolean flag indicating if a Compilation Unit may be treated
   --    as the main unit for a partition (See RM 10.2(7))
   --    GNAT-specific!!??

   --  Is_Body_Required : Boolean;
   --    The boolean flag indicating if a Compilation Unit requires a body
   --    as a completion

   -----------------------------------------------------------
   --  Black-Box Unit Attributes Access and Update Routines --
   -----------------------------------------------------------

   function Top (U : Unit_Id) return Node_Id;
   --  this function is not trivial, it can have tree swapping as its
   --  "side effect"

   function Kind (C : Context_Id; U : Unit_Id) return Unit_Kinds;
   function Class (C : Context_Id; U : Unit_Id) return Unit_Classes;
   function Origin (C : Context_Id; U : Unit_Id) return Unit_Origins;
   function Is_Main_Unit (C : Context_Id; U : Unit_Id) return Boolean;
   function Is_Body_Required (C : Context_Id; U : Unit_Id) return Boolean;
   --  This function does not reset Context, a Caller is responsible for this
   function Time_Stamp (C : Context_Id; U : Unit_Id) return Time_Stamp_Type;
   function Is_Consistent (C : Context_Id; U : Unit_Id) return Boolean;
   function Source_Status (C : Context_Id; U : Unit_Id)
      return Source_File_Statuses;
   function Main_Tree (C : Context_Id; U : Unit_Id) return Tree_Id;

   function Has_Limited_View_Only (C : Context_Id; U : Unit_Id) return Boolean;
   --  Checks if U has only limited view in C

   --------

   procedure Set_Top              (C : Context_Id; U : Unit_Id;
                                   N : Node_Id);
   procedure Set_Kind             (C : Context_Id; U : Unit_Id;
                                   K : Unit_Kinds);
   procedure Set_Class            (C : Context_Id; U : Unit_Id;
                                   Cl : Unit_Classes);
   procedure Set_Origin           (C : Context_Id; U : Unit_Id;
                                   O : Unit_Origins);
   procedure Set_Is_Main_Unit     (C : Context_Id; U : Unit_Id;
                                   M : Boolean);
   procedure Set_Is_Body_Required (C : Context_Id; U : Unit_Id;
                                   B : Boolean);
   procedure Set_Time_Stamp       (C : Context_Id; U : Unit_Id;
                                   T : Time_Stamp_Type);

   procedure Set_Is_Consistent    (C : Context_Id; U : Unit_Id;
                                   B : Boolean);

   procedure Set_Source_Status    (C : Context_Id; U : Unit_Id;

                                   S : Source_File_Statuses);
   -------------------------------------------------

   ---------------------------
   -- Semantic Dependencies --
   ---------------------------

   ----------------------------------------------------
   -- Subprograms for Semantic Dependencies Handling --
   ----------------------------------------------------

   function Not_Root return Boolean;
   --  Checks if U is not a root library unit (by checking if
   --  its name contains a dot). This function itself does not set the
   --  normalized name of U in A_Name_Buffer, it is supposed to be called
   --  when a proper name is already set.

   function Subunits (C : Context_Id;  U : Unit_Id) return Unit_Id_List;
   --  Returns the full list of Ids of subunits for U (if any). The full list
   --  contains nonexistent units for missed subunits
   --
   --  Note, that this function does not reset Context, it should be done in
   --  the caller!

   function Get_Subunit
     (Parent_Body : Asis.Compilation_Unit;
      Stub_Node   : Node_Id)
      return Asis.Compilation_Unit;
   --  This function is intended to be used only when all the Unit attributes
   --  are already computed. It gets the Parent_Body, whose tree should
   --  contain Stub_Node as a node representing some body stub, and it
   --  returns the Compilation Unit containing the proper body for this stub.
   --  It returns a Nil_Compilation_Unit, if the Compilation Unit containing
   --  the proper body does not exist in the enclosing Context or if it is
   --  inconsistent with Parent_Body.

   function Children (U : Unit_Id) return Unit_Id_List;
   --  returns the list of Ids of children for U (if any)
   --
   --  Note, that this function does not reset Context, it should be done in
   --  the caller!

   function GNAT_Compilation_Dependencies (U : Unit_Id) return Unit_Id_List;
   --  Returns the full list of GNAT compilation dependencies for U
   --  This list is empty if and only if U is not a main unit of some
   --  compilation which creates some tree for C.

   procedure Form_Parent_Name;
   --  supposing A_Name_Buffer containing a normalized unit name, this
   --  function forms the normalized name of its parent by stripping out
   --  the suffix in the Ada part of the name (that is, the part of the
   --  name between the rightmost '.' and '%") and changing the
   --  "normalized" suffix to "%s". A_Name_Len is set in accordance with
   --  this. If the Ada part of the name contains no suffix (that is, if
   --  it corresponds to a root library unit), A_Name_Len is set equal
   --  to 0.

   function Get_Parent_Unit (C : Context_Id; U : Unit_Id) return Unit_Id;
   --  returns the Id of the parent unit declaration for U. If U is
   --  First_Unit_Id, returns Nil_Unit.
   --
   --  Note, that this function does not reset Context, it should be done in
   --  the caller!

   function Get_Body (C : Context_Id; U : Unit_Id) return Unit_Id;
   --  returns the Id of the library_unit_body for the unit U.
   --  Nil_Unit is not a valid argument  for this function.
   --
   --  Note, that this function does not reset Context, it should be done in
   --  the caller!

   function Get_Declaration (C : Context_Id; U : Unit_Id) return Unit_Id;
   --  returns the Id of the library_unit_declaration for the unit U.
   --  Nil_Unit is not a valid argument  for this function.
   --
   --  Note, that this function does not reset Context, it should be done in
   --  the caller!

   function Get_Subunit_Parent_Body
     (C : Context_Id;
      U : Unit_Id)
      return Unit_Id;
   --  returns the Id of the library_unit_body or subunit being the parent
   --  body for subunit U (a caller is responsible for calling this function
   --  for subunits).

   function Get_Nonexistent_Unit (C : Context_Id) return Unit_Id;
   --  Is supposed to be called just after an attempt to get a unit which is
   --  supposed to be a needed declaration or a needed body (that is,
   --  A_Name_Buffer contains a normalized unit name ending with "%s" or "%b"
   --  respectively). Tries to find the unit of A_Nonexistent_Declaration
   --  or A_Nonexistent_Body kind with this name, if this attempt fails,
   --  allocates the new unit entry for the corresponding nonexistent unit.
   --  Returns the Id of found or allocated unit.

   function Get_Same_Unit
     (Arg_C  : Context_Id;
      Arg_U  : Unit_Id;
      Targ_C : Context_Id)
   return Unit_Id;
   --  Tries to find in Targ_C just the same unit as Arg_U is in Arg_C.
   --  Just the same means, that Arg_U and the result of this function
   --  should have just the same time stamps. If Arg_C = Targ_C, Arg_U
   --  is returned. If there is no "just the same" unit in Targ_C,
   --  Nil_Unit is returned.
   --
   --  If No (Arg_U), then the currently accessed Context is not reset (but
   --  this function is not supposed to be called for Arg_U equal to
   --  Nil_Unit_Id, although it is not an error). Otherwise Context is reset
   --  to Targ_C

   --------------------------------------
   -- General-Purpose Unit Subprograms --
   --------------------------------------

   procedure Finalize (C : Context_Id);
   --  Currently this routine is only used to generate debugging output
   --  for the Unit Table of a given Context.

   function Present (Unit : Unit_Id) return Boolean;
   --  Tests given Unit Id for equality with Nil_Unit. This allows
   --  notations like "if Present (Current_Supporter)" as opposed to
   --  "if Current_Supporter /= Nil_Unit

   function No (Unit : Unit_Id) return Boolean;
   --  Tests given Unit Id for equality with Nil_Unit. This allows
   --  notations like "if No (Current_Supporter)" as opposed to
   --  "if Current_Supporter = Nil_Unit

   function Last_Unit return Unit_Id;
   --  Returns the Unit_Id of the last unit which has been allocated in the
   --  Unit Name Table. Used to define that the Unit_Id value returned by
   --  Name_Find corresponds to the ASIS Compilation Unit which is not
   --  known to ASIS.

   function Lib_Unit_Decls (C : Context_Id) return Natural;
   --  returns the number of library_unit_declaratios allocated in the
   --  Context Unit table

   function Comp_Unit_Bodies (C : Context_Id) return Natural;
   --  returns the number of library_unit_bodies and subunits allocated
   --  in the Context Unit table

   function Next_Decl (D : Unit_Id) return Unit_Id;
   --  Returns the Unit_Id of the next unit (starting from, but not including
   --  D), which is a library_unit_declaration. Returns Nil_Unit, if there
   --  is no such a unit in C.
   --
   --  Note, that this function does not reset Context, it should be done in
   --  the caller!

   function First_Body return Unit_Id;
   --  Returns the Unit_Id of the first unit which is a
   --  compilation_unit_body or a subunit. Returns Nil_Unit, if there is
   --  no such a unit in a current Context.
   --
   --  Note, that this function does not reset Context, it should be done in
   --  the caller!

   function Next_Body (B : Unit_Id) return Unit_Id;
   --  Returns the Unit_Id of the next unit (starting from, but not including
   --  B)  which is a compilation_unit_body or a subunit. Returns Nil_Unit,
   --  if there is no such a unit in C.
   --
   --  Note, that this function does not reset Context, it should be done in
   --  the caller!

   procedure Output_Unit (C : Context_Id; Unit : Unit_Id);
   --  Produces the debug output of the Unit Table entry corresponding
   --  to Unit
   --  DO WE NEED THIS PROCEDURE IN THE SPECIFICATION????

   procedure Print_Units (C : Context_Id);
   --  Produces the debug output from the Unit table for the Context C.

   function Enclosing_Unit
     (Cont : Context_Id;
      Node : Node_Id)
      return Asis.Compilation_Unit;
   --  This function is intended to be used to define the enclosing
   --  unit for an Element obtained as a result of some ASIS semantic query.
   --  It finds the N_Compilation_Unit node for the subtree enclosing
   --  the Node given as its argument, and then defines the corresponding
   --  Unit Id, which is supposed to be the Id of Enclosing Unit for an
   --  Element built up on the base of Node. It does not change the tree
   --  being currently accessed. All these computations are supposed
   --  to be performed for a Context Cont.
   --  Node should not be a result of Atree.Original_Node, because
   --  it is used as an argument for Atree.Parent function
   --
   --  Note, that this function does no consistency check, that is, the
   --  currently accessed tree may be not from the list of consistent trees
   --  for the resulted Unit.

   ---------------
   -- NEW STUFF --
   ---------------

   procedure Register_Units (Set_First_New_Unit : Boolean := False);
   --  When a new tree file is read in during Opening a Context, this procedure
   --  goes through all the units represented by this tree and checks if these
   --  units are already known to ASIS. If some unit is unknown, this
   --  procedure "register" it - it creates the corresponding entry in the
   --  unit table, and it sets the normalized unit name. It does not set any
   --  other field of unit record except Kind. It sets Kind as Not_A_Unit
   --  to indicate, that this unit is only registered, but not processed.
   --
   --  We need this (pre-)registration to be made before starting unit
   --  processing performed by Process_Unit_New, because we need all the units
   --  presenting in the tree to be presented also in the Context unit table
   --  when storing the dependency information.
   --
   --  Note, that all the consistency checks are made by Process_Unit_New,
   --  even though we can make them here. The reason is to separate this
   --  (pre-)registration (which is an auxiliary technical action) from
   --  unit-by-unit processing to facilitate the maintainability of the code.
   --
   --  If Set_First_New_Unit is set ON, stores in A4G.Contt.First_New_Unit
   --  the first new unit being registered. If Set_First_New_Unit is set OFF
   --  or if no new units has been registered, First_New_Unit is set to
   --  Nil_Unit
   --
   --  ??? The  current implementation uses Set_Unit, which also sets time
   --  ???  stamp for a unit being registered. It looks like we do not need
   --  ???  this, so we can get rid of this.

   function Already_Processed (C : Context_Id; U : Unit_Id) return Boolean;
   --  Checks if U has already been processed when scanning previous trees
   --  during opening C

   procedure Check_Source_Consistency
     (C : Context_Id;
      U_Id : Unit_Id);
   --  Is called when a Unit is being investigated as encountered for the first
   --  time during opening the Context C. It checks the existence of the source
   --  file for this unit, and if the source file exists, it checks that the
   --  units as represented by the tree is consistent with the source (if this
   --  is required by the options associated with the Context).
   --  This procedure should be called after extracting the source file name
   --  from the tree and putting this into the Context unit table.

   procedure Check_Consistency
     (C : Context_Id;
      U_Id : Unit_Id;
      U_Num : Unit_Number_Type);
   --  Is called when a unit is encountered again when opening C. Checks if in
   --  the currently accessed tree this unit has the same time stamp as it had
   --  in all the previously processed trees. In case if this check fails, it
   --  raises ASIS_Failed and forms the diagnosis on behalf of
   --  Asis.Ada_Environments.Open. (This procedure does not check the source
   --  file for the unit - this should be done by Check_Source_Consistency
   --  when the unit was processed for the first time)

   function TS_From_OS_Time (T : OS_Time) return Time_Stamp_Type;
   --  Converts OS_Time into Time_Stamp_Type. Is this the right place for
   --  this function???

   procedure Reset_Cache;
   --  Resents to the empty state the cache data structure used to speed up the
   --  Top function. Should be called as a part of closing a Context.

end A4G.Contt.UT;

Add the ASIS file $i

Add the ASIS file $i


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                           A 4 G . U _ C O N V                            --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (c) 1995-2006, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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  ASIS-for-GNAT; see file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by AdaCore                     --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

with GNAT.OS_Lib; use GNAT.OS_Lib;

package A4G.U_Conv is

--  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
--  !!                                                                 !!
--  !!  This package should be completely revised (and very likely -   !!
--  !!  removed), when migration to using pre-created trees as to the  !!
--  !!  *ONLY* ASIS operation mode is completed                        !!
--  !!                                                                 !!
--  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

--  This paskage contain routines supporting the ASIS and ASIS-GNAT conventions
--  for file and unit names.

   -----------------
   -- Subprograms --
   -----------------

   procedure Get_Norm_Unit_Name (U_Name           :     String;
                                 N_U_Name         : out String;
                                 Spec             :     Boolean;
                                 May_Be_Unit_Name : out Boolean);
   --  Having got U_Name as supposetely being an Ada unit name, this procedure
   --  checks if it satisfies the Ada unit name syntax structure and tries to
   --  convert it into "normalized" form by folding all the letters to
   --  lower case and appending the "%s" or "%b" suffix depending on the
   --  value of Spec (See also unitt.ads). If U_Name can be treated as Ada
   --  unit name, its "normalized" version is returned as the value of
   --  N_U_Name, and May_Be_Unit_Name is set True. If the structure of
   --  U_Name does not satisfy the syntax rules imposed on the Ada unit
   --  names, May_Be_Unit_Name is set False, and the value of N_U_Name is
   --  undefined.
   --
   --  The caller is responcible for the fact, that the length of the actual
   --  for N_U_Name is the length of the actual for U_Name plus 2
   --  (for "%s" or "%b") ).  The caller is also responsible for the
   --  fact that the lower bounds of U_Name and N_U_Name are the same.
   --  (Otherwise CONSTRAINT_ERROR will be raised). It is also supposed
   --  that this procedure will  never be called for the empty string as an
   --  actual for U_Name.
   --
   --  Note, that the "normalized" Unit name returned by this routine
   --  does not contain the prefix indicating the enclosing Context.

   function Source_From_Unit_Name
     (S    : String;
      Spec : Boolean)
      return String_Access;
   --  Converts S into the ada source file name according to the file name
   --  rules specified in GNAT DOCUMENT INTRO. The suffix of the file name
   --  is set as ".ads" if Spec is True or ".adb" otherwise.
   --
   --  It is supposed that this function is called for S that is non-empty
   --  string having a structure of the fully expynded Ada unit unit name.
   --  This function does not check the content of S leaving it to the
   --  caller.
   --
   --  The result of this function is NUL-terminated

   function Tree_From_Source_Name (S : String_Access) return String_Access;
   --  Returns the reference to a newly created NUL-terminated string.
   --  It is supposed to be called only for the (references to the) Ada
   --  source file names obtained as the results of the Locate_In_Context
   --  function. It is also supposed that S points to a NUL-terminated
   --  string. The content of the returned string is obtained by
   --  transforming the content of the string pointed by S and interpreted
   --  as Ada source file name into the name of the corresponding tree
   --  output file.
   --
   --  This function requires revising if the effect of Source_File_Name
   --  pragma is implemented!

   function Is_Predefined_File_Name (S : String_Access) return Boolean;
   --  This function is the full analog of the GNAT function
   --  Fname.Is_Predefined_File_Name, but it works with the string
   --  value which is not stored in the GNAT name buffer.

   function To_String (S : String_Access) return String;
   --  Should be applied only to the references to NUL terminated
   --  strings (usially - file names). Returns the content of the
   --  referenced string without the trailing NUL character.

end A4G.U_Conv;

Add the ASIS file $i

Add the ASIS file $i


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                          A 4 G . U _ C O N V                             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (c) 1995-2006, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY  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 ASIS-for-GNAT; see   file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by AdaCore                     --
-- (http://www.adaccore.com).                                               --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;

with Namet;                   use Namet;
with Fname;                   use Fname;
with Krunch;
with Opt;                     use Opt;

package body A4G.U_Conv is

   ---------------------------------
   -- Local Types and Subprograms --
   ---------------------------------

   --  We use the trivial finite state automata to analyse and to transform
   --  strings passed as parameters to ASIS interfaces and processed by ASIS
   --  itself below there are type and routines definitions for various
   --  versions of this automata

   type State is (Beg_Ident, Mid_Ident, Und_Line);
   --  The states of the automata. Some versions may use only a part of the
   --  whole set of states.

   procedure Normalize_Char (In_Char    :        Character;
                             Curr_State : in out State;
                             Out_Char   : out    Character;
                             OK         : out    Boolean);
   --  One step of the finite-state-automata analyzing the string which is
   --  supposed to be an Ada unit name and producind the "normalized"
   --  version of the name. If In_Char under in the state Curr_State may be
   --  considered as belonging to the Ada unit name, the "low-case version"
   --  of this character is assigned to Out_Char, and OK is ste True,
   --  otherwise OK is set false

   function Convert_Char (Ch : Character) return Character;
   --  performs upper case -> lover case conversion in the GNAT file
   --  name style (see GNAT Document INTRO and Fnames.ads - only letters
   --  from the A .. Z range are folded to lower case)

   ------------------
   -- Convert_Char --
   ------------------

   function Convert_Char (Ch : Character) return Character is
   begin

      if Ch = '.' then
         return '-';
      else
         return To_Lower (Ch);
      end if;

   end Convert_Char;

   ------------------------
   -- Get_Norm_Unit_Name --
   ------------------------

   procedure Get_Norm_Unit_Name
     (U_Name           :     String;
      N_U_Name         : out String;
      Spec             :     Boolean;
      May_Be_Unit_Name : out Boolean)
   is
      Current_State : State := Beg_Ident;
   begin

      May_Be_Unit_Name := False;

      for I in U_Name'Range loop

         Normalize_Char (U_Name   (I), Current_State,
                         N_U_Name (I), May_Be_Unit_Name);

         exit when not May_Be_Unit_Name;

      end loop;

      if not May_Be_Unit_Name then
         return;

      elsif N_U_Name (U_Name'Last) = '_' or else
            N_U_Name (U_Name'Last) = '.'
      then
         --  something like "Ab_" -> "ab_" or "Ab_Cd." -> "ab_cd."
         May_Be_Unit_Name := False;
         return;
      end if;

      --  here we have all the content of U_Name parced and
      --  May_Be_Unit_Name is True. All we have to do is to append
      --  the "%s" or "%b" suffix

      N_U_Name (N_U_Name'Last - 1) := '%';

      if Spec then
         N_U_Name (N_U_Name'Last) := 's';
      else
         N_U_Name (N_U_Name'Last) := 'b';
      end if;

   end Get_Norm_Unit_Name;

   -----------------------------
   -- Is_Predefined_File_Name --
   -----------------------------

   function Is_Predefined_File_Name (S : String_Access) return Boolean is
   begin
      Namet.Name_Len := S'Length - 1;
      --  "- 1" is for trailing ASCII.NUL in the file name
      Namet.Name_Buffer (1 .. Namet.Name_Len) := To_String (S);
      return Fname.Is_Predefined_File_Name (Namet.Name_Enter);
   end Is_Predefined_File_Name;

   --------------------
   -- Normalize_Char --
   --------------------

   procedure Normalize_Char
     (In_Char    :        Character;
      Curr_State : in out State;
      Out_Char   : out    Character;
      OK         : out    Boolean)
   is
   begin

      OK := True;

      case Curr_State is

         when Beg_Ident =>

            if Is_Letter (In_Char) then
               Curr_State := Mid_Ident;
            else
               OK := False;
            end if;

         when Mid_Ident =>

            if Is_Letter (In_Char) or else
               Is_Digit (In_Char)
            then
               null;
            elsif In_Char = '_' then
               Curr_State := Und_Line;
            elsif In_Char = '.' then
               Curr_State := Beg_Ident;
            else
               OK := False;
            end if;

         when Und_Line =>
            if Is_Letter (In_Char) or else
               Is_Digit  (In_Char)
            then
               Curr_State := Mid_Ident;
            else
               OK := False;
            end if;

      end case;

      Out_Char := To_Lower (In_Char);

   end Normalize_Char;

   ---------------------------
   -- Source_From_Unit_Name --
   ---------------------------

   function Source_From_Unit_Name
     (S    : String;
      Spec : Boolean)
      return String_Access
   is
      Result_Prefix   : String (1 .. S'Length);
      Result_Selector : String (1 .. 4) := ".adb";

      Initial_Length  : constant Natural := S'Length;
      Result_Length   : Natural          := Initial_Length;
      --  this is for the name krunching
   begin
      for I in S'Range loop
         Result_Prefix (I) := Convert_Char (S (I));
      end loop;

      Krunch
       (Buffer    => Result_Prefix,
        Len       => Result_Length,
        Maxlen    => Integer (Maximum_File_Name_Length),
        No_Predef => False);

      if Spec then
         Result_Selector (4) := 's';
      end if;

      return new String'(Result_Prefix (1 .. Result_Length)
                       & Result_Selector
                       & ASCII.NUL);

   end Source_From_Unit_Name;

   ---------------
   -- To_String --
   ---------------

   function To_String (S : String_Access) return String is
   begin
      return S.all (S'First .. S'Last - 1);
   end To_String;

   ---------------------------
   -- Tree_From_Source_Name --
   ---------------------------

   function Tree_From_Source_Name (S : String_Access) return String_Access is
      Return_Val : String_Access;
   begin
      Return_Val := new String'(S.all);
      --  the content of S should be "*.ad?" & ASCII.NUL
      Return_Val (Return_Val'Last - 1) := 't'; -- ".ad?" -> ".adt"
      return Return_Val;
   end Tree_From_Source_Name;

end A4G.U_Conv;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  mat-targets-gtkmat - Gtk target management
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Gtk.Widget;
with Gtkada.Builder;
package MAT.Targets.Gtkmat is

   type Target_Type is new MAT.Targets.Target_Type with private;

   --  Initialize the widgets and create the Gtk gui.
   procedure Initialize_Widget (Target : in out Target_Type;
                                Widget : out Gtk.Widget.Gtk_Widget);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   overriding
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

private

   type Target_Type is new MAT.Targets.Target_Type with record
      Builder : Gtkada.Builder.Gtkada_Builder;
   end record;

end MAT.Targets.Gtkmat;

Define a targets package for the Gtk UI

Define a targets package for the Gtk UI