+ generic replacer

source/examples/add_cr.adb

@@ -11,6 +11,7 @@ with Ada.Unchecked_Conversion;
 with Encodings.Line_Endings.Add_CR;
 with Encodings.Utility;
 use Encodings.Utility;
+
 procedure Add_CR is
 	-- String version of Stream.Read
 	--procedure Read_String(

source/library/encodings-generic_single_replace.adb

@@ -0,0 +1,67 @@
+package body Encodings.Generic_Single_Replace is
+
+	procedure Reset (
+		This : in out Converter)
+	is
+	begin
+		This.S := Initial;
+		This.SI := Original'First;
+		This.TI := Replacement'Last;
+	end Reset;
+
+	procedure Process (
+		This          : in out Converter;
+		Source        : in     String_Type;
+		Source_Cursor :    out Natural;
+		Target        :    out String_Type;
+		Target_Cursor :    out Natural)
+	is
+		procedure Put (C : Character_Type) is
+		begin
+			Target_Cursor := Target_Cursor + 1;
+			Target (Target_Cursor) := C;
+		end Put;
+		C : Character_Type;
+	begin
+		Source_Cursor := Source'First - 1;
+		Target_Cursor := Target'First - 1;
+		while Source_Cursor < Source'Last and Target_Cursor < Target'Last loop
+			case This.S is
+			when Initial =>
+				Source_Cursor := Source_Cursor + 1;
+				C := Source (Source_Cursor);
+				if C = Original (This.SI) then -- original match
+					if This.SI = Original'Last then -- full string matched
+						This.TI := Replacement'First - 1;
+						This.S := Output_Replacement;
+					else
+						This.SI := This.SI + 1;
+					end if;
+				else -- no match
+					if This.SI = Original'First then -- no matched prefix
+						Put (C);
+					else
+						This.TI := Original'First - 1;
+						This.C := C;
+						This.S := Output_Original;
+					end if;
+				end if;
+			when Output_Original =>
+				This.TI := This.TI + 1;
+				if This.TI = This.SI then -- whole matched part already written
+					Put (This.C);
+					This.S := Initial;
+				else
+					Put (Original (This.TI));
+				end if;
+			when Output_Replacement =>
+				This.TI := This.TI + 1;
+				Put (Replacement (This.TI));
+				if This.TI = Replacement'Last then
+					This.S := Initial;
+				end if;
+			end case;
+		end loop;
+	end Process;
+
+end Encodings.Generic_Single_Replace;

source/library/encodings-generic_single_replace.ads

@@ -0,0 +1,45 @@
+--
+--  Performs single string replacement. Useful to make CR-LF translation.
+--
+
+with Encodings.Generic_Converters;
+
+generic
+	type Character_Type is (<>); -- Character, Wide_Character, Wide_Wide_Character (or whatever)
+	type String_Type    is array (Positive range <>) of Character_Type;
+	Original            : in String_Type; -- Source string to replace
+	Replacement         : in String_Type; -- Replacement string
+	with package Converter_Base is new Encodings.Generic_Converters (
+		Source_Character => Character_Type,
+		Target_Character => Character_Type,
+		Source_String    => String_Type,
+		Target_String    => String_Type); -- Base package
+package Encodings.Generic_Single_Replace is
+
+	type Converter is new Converter_Base.Converter with private;
+
+	overriding procedure Reset (
+		This : in out Converter);
+
+	overriding procedure Process (
+		This          : in out Converter; -- Converter state
+		Source        : in     String_Type; -- String to be converted
+		Source_Cursor :    out Natural; -- Last index of source string read
+		Target        :    out String_Type; -- Converted string
+		Target_Cursor :    out Natural); -- Last Index of destination string written
+
+private
+
+	type State is (
+		Initial,              -- matching / copying
+		Output_Original,      -- partial original match, outputting matched part then unmatched character
+		Output_Replacement);  -- full original match, outputting replacement
+
+	type Converter is new Converter_Base.Converter with record
+		S  : State   := Initial;
+		SI : Natural := Original'First; -- Source string match index
+		TI : Natural := Replacement'Last; -- Target string output index
+		C  : Character_Type; -- Character match is failed on
+	end record;
+
+end Encodings.Generic_Single_Replace;