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 16with Ada.Strings.UTF_Encoding; 17package Ada.Strings.Text_Buffers with 18 Pure 19is 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 67private 68 69 type Root_Buffer_Type is abstract tagged limited record 70 Indentation : Natural := 0; 71 -- Current indentation 72 73 Indent_Pending : Boolean := True; 74 -- Set by calls to New_Line, cleared when indentation emitted. 75 76 UTF_8_Length : Natural := 0; 77 -- Count of UTF_8 characters in the buffer 78 79 UTF_8_Column : Positive := 1; 80 -- Column in which next character will be written. 81 -- Calling New_Line resets to 1. 82 83 All_7_Bits : Boolean := True; 84 -- True if all characters seen so far fit in 7 bits 85 All_8_Bits : Boolean := True; 86 -- True if all characters seen so far fit in 8 bits 87 88 end record; 89 90 generic 91 -- This generic allows a client to extend Root_Buffer_Type without 92 -- having to implement any of the abstract subprograms other than 93 -- Put_UTF_8 (i.e., Put, Wide_Put, Wide_Wide_Put, Wide_Put_UTF_16, 94 -- and New_Line). Without this generic, each client would have to 95 -- duplicate the implementations of those 5 subprograms. 96 -- This generic also takes care of handling indentation, thereby 97 -- avoiding further code duplication. The name "Output_Mapping" isn't 98 -- wonderful, but it refers to the idea that this package knows how 99 -- to implement all the other output operations in terms of 100 -- just Put_UTF_8. 101 -- 102 -- The classwide parameter type here is somewhat tricky; 103 -- there are no dispatching calls associated with this parameter. 104 -- It would be more accurate to say that the parameter is of type 105 -- Output_Mapping.Buffer_Type'Class, but that type hasn't been declared 106 -- yet. Instantiators will typically declare a non-abstract extension, 107 -- B2, of the buffer type, B1, declared in their instantiation. The 108 -- actual Put_UTF_8_Implementation parameter may then have a 109 -- precondition "Buffer in B2'Class" and that subprogram can safely 110 -- access components declared as part of the declaration of B2. 111 112 with procedure Put_UTF_8_Implementation 113 (Buffer : in out Root_Buffer_Type'Class; 114 Item : UTF_Encoding.UTF_8_String); 115 package Output_Mapping is 116 type Buffer_Type is abstract new Root_Buffer_Type with null record; 117 118 overriding procedure Put (Buffer : in out Buffer_Type; Item : String); 119 120 overriding procedure Wide_Put 121 (Buffer : in out Buffer_Type; Item : Wide_String); 122 123 overriding procedure Wide_Wide_Put 124 (Buffer : in out Buffer_Type; Item : Wide_Wide_String); 125 126 overriding procedure Put_UTF_8 127 (Buffer : in out Buffer_Type; 128 Item : UTF_Encoding.UTF_8_String); 129 130 overriding procedure Wide_Put_UTF_16 131 (Buffer : in out Buffer_Type; Item : UTF_Encoding.UTF_16_Wide_String); 132 133 overriding procedure New_Line (Buffer : in out Buffer_Type); 134 end Output_Mapping; 135 136end Ada.Strings.Text_Buffers; 137