Natools

File src/natools-string_escapes.adb from the latest check-in

------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.String_Escapes is

   subtype Hex_Digit is Natural range 0 .. 15;

   function C_Escape_Hex (C : Character) return String;
      --  Return the string representing C in C-style escaped strings

   function Image (N : Hex_Digit) return Character;
      --  Return upper-case hexadecimal image of a digit



   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function C_Escape_Hex (C : Character) return String is
   begin
      case C is
         when Character'Val (0)  => return "\0";
         when Character'Val (8)  => return "\b";
         when Character'Val (9)  => return "\t";
         when Character'Val (10) => return "\n";
         when Character'Val (11) => return "\f";
         when Character'Val (12) => return "\v";
         when Character'Val (13) => return "\r";
         when Character'Val (34) => return "\""";

         when Character'Val (32) | Character'Val (33)
           | Character'Val (35) .. Character'Val (126) =>
            return String'(1 => C);

         when others =>
            declare
               Code : constant Natural := Character'Pos (C);
            begin
               return "\x" & Image (Code / 16) & Image (Code mod 16);
            end;
      end case;
   end C_Escape_Hex;


   function Image (N : Hex_Digit) return Character is
   begin
      case N is
         when 0 .. 9 =>
            return Character'Val (Character'Pos ('0') + N);
         when 10 .. 15 =>
            return Character'Val (Character'Pos ('A') + N - 10);
      end case;
   end Image;



   ----------------------
   -- Public Interface --
   ----------------------

   function C_Escape_Hex
     (S : String;
      Add_Quotes : Boolean := False)
     return String
   is
      Length : Natural := 0;
      O : Positive := 1;
      Sublength : Natural := 0;
   begin
      for I in S'Range loop
         case S (I) is
            when Character'Val (0) | '"'
              | Character'Val (8) .. Character'Val (13) =>
               Length := Length + 2;
            when Character'Val (32) | Character'Val (33)
              | Character'Val (35) .. Character'Val (126) =>
               Length := Length + 1;
            when others =>
               Length := Length + 4;
         end case;
      end loop;

      if Add_Quotes then
         Length := Length + 2;
      end if;

      return Result : String (1 .. Length) do
         if Add_Quotes then
            O := O + 1;
            Result (Result'First) := '"';
            Result (Result'Last) := '"';
         end if;

         for I in S'Range loop
            O := O + Sublength;

            declare
               Img : constant String := C_Escape_Hex (S (I));
            begin
               Sublength := Img'Length;
               Result (O .. O + Sublength - 1) := Img;
            end;
         end loop;
      end return;
   end C_Escape_Hex;

end Natools.String_Escapes;