gcc/ada/libgnat/a-sttebu.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                         ADA.STRINGS.TEXT_BUFFERS                         --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 -- This specification is derived from the Ada Reference Manual for use with --
  10 -- GNAT.  In accordance with the copyright of that document, you can freely --
  11 -- copy and modify this specification,  provided that if you redistribute a --
  12 -- modified version,  any changes that you have made are clearly indicated. --
  13 --                                                                          --
  14 ------------------------------------------------------------------------------
  15
  16 with Ada.Strings.UTF_Encoding;
  17 package Ada.Strings.Text_Buffers with
  18    Pure
  19 is
  20
  21    type Text_Buffer_Count is range 0 .. Integer'Last;
  22
  23    New_Line_Count : constant Text_Buffer_Count := 1;
  24    --  There is no support for two-character CR/LF line endings.
  25
  26    type Root_Buffer_Type is abstract tagged limited private with
  27       Default_Initial_Condition => Current_Indent (Root_Buffer_Type) = 0;
  28
  29    procedure Put (Buffer : in out Root_Buffer_Type; Item : String) is abstract;
  30
  31    procedure Wide_Put
  32      (Buffer : in out Root_Buffer_Type; Item : Wide_String) is abstract;
  33
  34    procedure Wide_Wide_Put
  35      (Buffer : in out Root_Buffer_Type; Item : Wide_Wide_String) is abstract;
  36
  37    procedure Put_UTF_8
  38      (Buffer : in out Root_Buffer_Type;
  39       Item   :        UTF_Encoding.UTF_8_String) is abstract;
  40
  41    procedure Wide_Put_UTF_16
  42      (Buffer : in out Root_Buffer_Type;
  43       Item   :        UTF_Encoding.UTF_16_Wide_String) is abstract;
  44
  45    procedure New_Line (Buffer : in out Root_Buffer_Type) is abstract;
  46
  47    Standard_Indent : constant Text_Buffer_Count := 3;
  48
  49    function Current_Indent
  50      (Buffer : Root_Buffer_Type) return Text_Buffer_Count;
  51
  52    procedure Increase_Indent
  53      (Buffer : in out Root_Buffer_Type;
  54       Amount :        Text_Buffer_Count := Standard_Indent) with
  55       Post'Class => Current_Indent (Buffer) =
  56       Current_Indent (Buffer)'Old + Amount;
  57
  58    procedure Decrease_Indent
  59      (Buffer : in out Root_Buffer_Type;
  60       Amount :        Text_Buffer_Count := Standard_Indent) with
  61       Pre'Class => Current_Indent (Buffer) >= Amount
  62       --  or else raise Constraint_Error,
  63       or else Boolean'Val (Current_Indent (Buffer) - Amount),
  64       Post'Class => Current_Indent (Buffer) =
  65       Current_Indent (Buffer)'Old - Amount;
  66
  67    procedure Set_Trim_Leading_Spaces
  68      (Buffer : in out Root_Buffer_Type;
  69       Trim   : Boolean := True) with
  70       Post   => Trim_Leading_Spaces (Buffer) = Trim,
  71       Inline => True;
  72
  73    function Trim_Leading_Spaces
  74      (Buffer : Root_Buffer_Type) return Boolean
  75      with Inline;
  76
  77 private
  78
  79    type Root_Buffer_Type is abstract tagged limited record
  80       Indentation : Natural := 0;
  81       --  Current indentation
  82
  83       Indent_Pending : Boolean := True;
  84       --  Set by calls to New_Line, cleared when indentation emitted.
  85
  86       UTF_8_Length : Natural := 0;
  87       --  Count of UTF_8 characters in the buffer
  88
  89       UTF_8_Column : Positive := 1;
  90       --  Column in which next character will be written.
  91       --  Calling New_Line resets to 1.
  92
  93       All_7_Bits : Boolean := True;
  94       --  True if all characters seen so far fit in 7 bits
  95       All_8_Bits : Boolean := True;
  96       --  True if all characters seen so far fit in 8 bits
  97
  98       Trim_Leading_White_Spaces : Boolean := False;
  99       --  Flag set prior to calling any of the Put operations, which will
 100       --  cause white space characters to be discarded by any Put operation
 101       --  until a non-white-space character is encountered, at which point
 102       --  the flag will be reset.
 103
 104    end record;
 105
 106    generic
 107       --  This generic allows a client to extend Root_Buffer_Type without
 108       --  having to implement any of the abstract subprograms other than
 109       --  Put_UTF_8 (i.e., Put, Wide_Put, Wide_Wide_Put, Wide_Put_UTF_16,
 110       --  and New_Line). Without this generic, each client would have to
 111       --  duplicate the implementations of those 5 subprograms.
 112       --  This generic also takes care of handling indentation, thereby
 113       --  avoiding further code duplication. The name "Output_Mapping" isn't
 114       --  wonderful, but it refers to the idea that this package knows how
 115       --  to implement all the other output operations in terms of
 116       --  just Put_UTF_8.
 117       --
 118       --  The classwide parameter type here is somewhat tricky;
 119       --  there are no dispatching calls associated with this parameter.
 120       --  It would be more accurate to say that the parameter is of type
 121       --  Output_Mapping.Buffer_Type'Class, but that type hasn't been declared
 122       --  yet. Instantiators will typically declare a non-abstract extension,
 123       --  B2, of the buffer type, B1, declared in their instantiation. The
 124       --  actual Put_UTF_8_Implementation parameter may then have a
 125       --  precondition "Buffer in B2'Class" and that subprogram can safely
 126       --  access components declared as part of the declaration of B2.
 127
 128       with procedure Put_UTF_8_Implementation
 129         (Buffer : in out Root_Buffer_Type'Class;
 130          Item   :        UTF_Encoding.UTF_8_String);
 131    package Output_Mapping is
 132       type Buffer_Type is abstract new Root_Buffer_Type with null record;
 133
 134       overriding procedure Put (Buffer : in out Buffer_Type; Item : String);
 135
 136       overriding procedure Wide_Put
 137         (Buffer : in out Buffer_Type; Item : Wide_String);
 138
 139       overriding procedure Wide_Wide_Put
 140         (Buffer : in out Buffer_Type; Item : Wide_Wide_String);
 141
 142       overriding procedure Put_UTF_8
 143         (Buffer : in out Buffer_Type;
 144          Item   :        UTF_Encoding.UTF_8_String);
 145
 146       overriding procedure Wide_Put_UTF_16
 147         (Buffer : in out Buffer_Type; Item : UTF_Encoding.UTF_16_Wide_String);
 148
 149       overriding procedure New_Line (Buffer : in out Buffer_Type);
 150    end Output_Mapping;
 151
 152 end Ada.Strings.Text_Buffers;