gcc/ada/libgnat/a-stbubo.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                     ADA.STRINGS.TEXT_BUFFERS.BOUNDED                     --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 2020-2023, Free Software Foundation, Inc.       --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 with Ada.Characters.Handling;
  33 with Ada.Strings.UTF_Encoding.Conversions;
  34 with Ada.Strings.UTF_Encoding.Strings;
  35 with Ada.Strings.UTF_Encoding.Wide_Strings;
  36 with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
  37 package body Ada.Strings.Text_Buffers.Bounded is
  38
  39    --  Pretty much the same as the Unbounded version, except where different.
  40    --
  41    --  One could imagine inventing an Input_Mapping generic analogous to
  42    --  the existing Output_Mapping generic to address the Get-related
  43    --  Bounded/Unbounded code duplication issues, but let's not. In the
  44    --  Output case, there was more substantial duplication and there were
  45    --  3 clients (Bounded, Unbounded, and Files) instead of 2.
  46
  47    function Text_Truncated (Buffer : Buffer_Type) return Boolean is
  48      (Buffer.Truncated);
  49
  50    function Get (Buffer : in out Buffer_Type) return String is
  51    --  If all characters are 7 bits, we don't need to decode;
  52    --  this is an optimization.
  53    --  Otherwise, if all are 8 bits, we need to decode to get Latin-1.
  54    --  Otherwise, the result is implementation defined, so we return a
  55    --  String encoded as UTF-8. Note that the RM says "if any character
  56    --  in the sequence is not defined in Character, the result is
  57    --  implementation-defined", so we are not obliged to decode ANY
  58    --  Latin-1 characters if ANY character is bigger than 8 bits.
  59    begin
  60       if Buffer.All_8_Bits and not Buffer.All_7_Bits then
  61          return UTF_Encoding.Strings.Decode (Get_UTF_8 (Buffer));
  62       else
  63          return Get_UTF_8 (Buffer);
  64       end if;
  65    end Get;
  66
  67    function Wide_Get (Buffer : in out Buffer_Type) return Wide_String is
  68    begin
  69       return UTF_Encoding.Wide_Strings.Decode (Get_UTF_8 (Buffer));
  70    end Wide_Get;
  71
  72    function Wide_Wide_Get (Buffer : in out Buffer_Type) return Wide_Wide_String
  73    is
  74    begin
  75       return UTF_Encoding.Wide_Wide_Strings.Decode (Get_UTF_8 (Buffer));
  76    end Wide_Wide_Get;
  77
  78    function Get_UTF_8
  79      (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_8_String
  80    is
  81    begin
  82       return
  83         Result : constant UTF_Encoding.UTF_8_String :=
  84           UTF_Encoding.UTF_8_String
  85             (Buffer.Chars (1 .. Text_Buffer_Count (Buffer.UTF_8_Length)))
  86       do
  87          --  Reset buffer to default initial value.
  88          declare
  89             Defaulted : Buffer_Type (0);
  90
  91             --  If this aggregate becomes illegal due to new field, don't
  92             --  forget to add corresponding assignment statement below.
  93             Dummy : array (1 .. 0) of Buffer_Type (0) :=
  94               [others =>
  95                  (Max_Characters            => 0,
  96                   Chars                     => <>,
  97                   Indentation               => <>,
  98                   Indent_Pending            => <>,
  99                   UTF_8_Length              => <>,
 100                   UTF_8_Column              => <>,
 101                   Trim_Leading_White_Spaces => <>,
 102                   All_7_Bits                => <>,
 103                   All_8_Bits                => <>,
 104                   Truncated                 => <>)];
 105          begin
 106             Buffer.Indentation    := Defaulted.Indentation;
 107             Buffer.Indent_Pending := Defaulted.Indent_Pending;
 108             Buffer.UTF_8_Length   := Defaulted.UTF_8_Length;
 109             Buffer.UTF_8_Column   := Defaulted.UTF_8_Column;
 110             Buffer.All_7_Bits     := Defaulted.All_7_Bits;
 111             Buffer.All_8_Bits     := Defaulted.All_8_Bits;
 112             Buffer.Truncated      := Defaulted.Truncated;
 113          end;
 114       end return;
 115    end Get_UTF_8;
 116
 117    function Wide_Get_UTF_16
 118      (Buffer : in out Buffer_Type) return UTF_Encoding.UTF_16_Wide_String
 119    is
 120    begin
 121       return
 122         UTF_Encoding.Conversions.Convert
 123           (Get_UTF_8 (Buffer), Input_Scheme => UTF_Encoding.UTF_8);
 124    end Wide_Get_UTF_16;
 125
 126    procedure Put_UTF_8_Implementation
 127      (Buffer : in out Root_Buffer_Type'Class;
 128       Item   : UTF_Encoding.UTF_8_String)
 129    is
 130       procedure Buffer_Type_Implementation (Buffer : in out Buffer_Type);
 131       --  View the passed-in Buffer parameter as being of type Buffer_Type,
 132       --  not of Root_Buffer_Type'Class.
 133
 134       procedure Buffer_Type_Implementation (Buffer : in out Buffer_Type) is
 135       begin
 136          for Char of Item loop
 137             if Buffer.UTF_8_Length = Integer (Buffer.Max_Characters) then
 138                Buffer.Truncated := True;
 139                return;
 140             end if;
 141
 142             Buffer.All_7_Bits :=
 143               @ and then Character'Pos (Char) < 128;
 144             Buffer.Trim_Leading_White_Spaces :=
 145               @ and then Characters.Handling.Is_Space (Char);
 146
 147             Buffer.UTF_8_Length                                    := @ + 1;
 148             Buffer.UTF_8_Column                                    := @ + 1;
 149             Buffer.Chars (Text_Buffer_Count (Buffer.UTF_8_Length)) := Char;
 150          end loop;
 151       end Buffer_Type_Implementation;
 152    begin
 153       if Item'Length > 0 then
 154          Buffer_Type_Implementation (Buffer_Type (Buffer));
 155       end if;
 156    end Put_UTF_8_Implementation;
 157
 158 end Ada.Strings.Text_Buffers.Bounded;