gcc/ada/libgnat/a-stbufo.adb

   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-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.Strings.Text_Buffers.Unbounded;
  33 with Ada.Strings.Text_Buffers.Files;
  34
  35 package 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
 158 end Ada.Strings.Text_Buffers.Formatting;