ADDED src/natools-string_escapes.adb Index: src/natools-string_escapes.adb ================================================================== --- src/natools-string_escapes.adb +++ src/natools-string_escapes.adb @@ -0,0 +1,121 @@ +------------------------------------------------------------------------------ +-- 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; ADDED src/natools-string_escapes.ads Index: src/natools-string_escapes.ads ================================================================== --- src/natools-string_escapes.ads +++ src/natools-string_escapes.ads @@ -0,0 +1,34 @@ +------------------------------------------------------------------------------ +-- 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. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.String_Escapes provides escaping and unescaping for Strings in -- +-- various formats. -- +------------------------------------------------------------------------------ + +package Natools.String_Escapes is + pragma Pure; + + function C_Escape_Hex + (S : String; + Add_Quotes : Boolean := False) + return String; + -- Replace non-ASCII-printable characters of S with C-style escapes, + -- either two-character (like "\n") or hexadecimal four-character + -- (like "\xC3"). + -- Add double quotes at the beginning and end if Add_Quotes. + +end Natools.String_Escapes;