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