1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT RUN-TIME COMPONENTS                         --
4--                                                                          --
5--                    ADA.STRINGS.TEXT_BUFFERS.FORMATTING                   --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--            Copyright (C) 2020-2021, 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
32with Ada.Strings.Text_Buffers.Unbounded;
33with Ada.Strings.Text_Buffers.Files;
34
35package body Ada.Strings.Text_Buffers.Formatting is
36
37   use Ada.Strings.Text_Buffers.Files;
38   use Ada.Strings.Text_Buffers.Utils;
39
40   procedure Put
41     (S : in out Root_Buffer_Type'Class; T : Template;
42      X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.UTF_8_Lines := "")
43   is
44      J : Positive := T'First;
45      Used : array (1 .. 9) of Boolean := [others => False];
46   begin
47      while J <= T'Last loop
48         if T (J) = '\' then
49            J := J + 1;
50            case T (J) is
51               when 'n' =>
52                  New_Line (S);
53               when '\' =>
54                  Put_7bit (S, '\');
55               when 'i' =>
56                  Increase_Indent (S);
57               when 'o' =>
58                  Decrease_Indent (S);
59               when 'I' =>
60                  Increase_Indent (S, 1);
61               when 'O' =>
62                  Decrease_Indent (S, 1);
63
64               when '1' =>
65                  Used (1) := True;
66                  Put_UTF_8_Lines (S, X1);
67               when '2' =>
68                  Used (2) := True;
69                  Put_UTF_8_Lines (S, X2);
70               when '3' =>
71                  Used (3) := True;
72                  Put_UTF_8_Lines (S, X3);
73               when '4' =>
74                  Used (4) := True;
75                  Put_UTF_8_Lines (S, X4);
76               when '5' =>
77                  Used (5) := True;
78                  Put_UTF_8_Lines (S, X5);
79               when '6' =>
80                  Used (6) := True;
81                  Put_UTF_8_Lines (S, X6);
82               when '7' =>
83                  Used (7) := True;
84                  Put_UTF_8_Lines (S, X7);
85               when '8' =>
86                  Used (8) := True;
87                  Put_UTF_8_Lines (S, X8);
88               when '9' =>
89                  Used (9) := True;
90                  Put_UTF_8_Lines (S, X9);
91
92               when others =>
93                  raise Program_Error;
94            end case;
95         else
96            Put_7bit (S, T (J));
97         end if;
98
99         J := J + 1;
100      end loop;
101
102      if not Used (1) then
103         pragma Assert (X1 = "");
104      end if;
105      if not Used (2) then
106         pragma Assert (X2 = "");
107      end if;
108      if not Used (3) then
109         pragma Assert (X3 = "");
110      end if;
111      if not Used (4) then
112         pragma Assert (X4 = "");
113      end if;
114      if not Used (5) then
115         pragma Assert (X5 = "");
116      end if;
117      if not Used (6) then
118         pragma Assert (X6 = "");
119      end if;
120      if not Used (7) then
121         pragma Assert (X7 = "");
122      end if;
123      if not Used (8) then
124         pragma Assert (X8 = "");
125      end if;
126      if not Used (9) then
127         pragma Assert (X9 = "");
128      end if;
129   end Put;
130
131   function Format
132     (T : Template;
133      X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.UTF_8_Lines := "")
134     return Utils.UTF_8_Lines
135   is
136      Buffer : Unbounded.Buffer_Type;
137   begin
138      Put (Buffer, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
139      return Buffer.Get_UTF_8;
140   end Format;
141
142   procedure Put
143     (T : Template;
144      X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.UTF_8_Lines := "") is
145      Buffer : File_Buffer := Create_Standard_Output_Buffer;
146   begin
147      Put (Buffer, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
148   end Put;
149
150   procedure Err
151     (T : Template;
152      X1, X2, X3, X4, X5, X6, X7, X8, X9 : Utils.UTF_8_Lines := "") is
153      Buffer : File_Buffer := Create_Standard_Error_Buffer;
154   begin
155      Put (Buffer, T, X1, X2, X3, X4, X5, X6, X7, X8, X9);
156   end Err;
157
158end Ada.Strings.Text_Buffers.Formatting;
159