linenoise_ada_1.1.2_d96796f6/src/linenoise.adb

-- SPDX-License-Identifier: BSD-2-Clause
-- For more license details, see LICENSE.

pragma Ada_2012;

with Ada.Strings.Maps;

package body Linenoise is

	---------------
	-- Linenoise --
	---------------

	function Get_Line (Prompt : String := "") return String is
		Prompt_Ptr, Line_Ptr : chars_ptr;
	begin
		Prompt_Ptr := New_String(Prompt);
		Line_Ptr := linenoise(Prompt_Ptr);
		Free(Prompt_Ptr);
		if Line_Ptr = Null_Ptr then
			raise End_Error;
		else
			declare
				Line : constant String := Value(Line_Ptr);
			begin
				Free(Line_Ptr);
				return Line;
			end;
		end if;
	end Get_Line;


	--------------------
	-- Multiline_Mode --
	--------------------

	procedure Multiline_Mode (Enabled : Boolean) is
		Dummy : int;
	begin
		Dummy := linenoiseSetMultiLine((if Enabled then 1 else 0));
		pragma Unreferenced(Dummy);
	end Multiline_Mode;


	-----------------
	-- History_Add --
	-----------------

	procedure History_Add (Line : String) is
		Line_Ptr : chars_ptr;
		Dummy : int;
	begin
		Line_Ptr := New_String(Line);
		Dummy := linenoiseHistoryAdd(Line_Ptr);
		pragma Unreferenced(Dummy);
		Free(Line_Ptr);
	end History_Add;


	--------------------------------
	-- History_Set_Maximum_Length --
	--------------------------------

	procedure History_Set_Maximum_Length (Length : History_Length) is
		Dummy : int;
	begin
		Dummy := linenoiseHistorySetMaxLen(int(Length));
		pragma Unreferenced(Dummy);
	end History_Set_Maximum_Length;


	------------------
	-- History_Load --
	------------------

	procedure History_Load (Filename : String) is
		Filename_Ptr : chars_ptr;
		Status : int;
	begin
		Filename_Ptr := New_String(Filename);
		Status := linenoiseHistoryLoad(Filename_Ptr);
		Free(Filename_Ptr);
		if Status < 0 then
			raise History_File_Error;
		end if;
	end History_Load;

	------------------
	-- History_Save --
	------------------

	procedure History_Save (Filename : String) is
		Filename_Ptr : chars_ptr;
		Status : int;
	begin
		Filename_Ptr := New_String(Filename);
		Status := linenoiseHistorySave(Filename_Ptr);
		Free(Filename_Ptr);
		if Status < 0 then
			raise History_File_Error;
		end if;
	end History_Save;


	----------------------------------
	-- Register_Completion_Callback --
	----------------------------------

	procedure Register_Completion_Callback (Callback : Completion_Callback) is
	begin
		Completer := Callback;
		linenoiseSetCompletionCallback(Completion_Wrapper'Access);
	end Register_Completion_Callback;


	-------------------------------
	-- Clear_Completion_Callback --
	-------------------------------

	procedure Clear_Completion_Callback is
	begin
		Completer := null;
		linenoiseSetCompletionCallback(null);
	end Clear_Completion_Callback;


	----------------------------
	-- Register_Hint_Callback --
	----------------------------

	procedure Register_Hint_Callback (Callback : Hint_Callback) is
	begin
		Hinter := Callback;
		linenoiseSetHintsCallback(Hint_Wrapper'Access);
		linenoiseSetFreeHintsCallback(free_hint_helper'Access);
	end Register_Hint_Callback;


	-------------------------
	-- Clear_Hint_Callback --
	-------------------------

	procedure Clear_Hint_Callback is
	begin
		Hinter := null;
		linenoiseSetHintsCallback(null);
		linenoiseSetFreeHintsCallback(null);
	end Clear_Hint_Callback;


	---------------
	-- Mask_Mode --
	---------------

	procedure Mask_Mode (Enabled : Boolean) is
	begin
		if Enabled then
			linenoiseMaskModeEnable;
		else
			linenoiseMaskModeDisable;
		end if;
	end Mask_Mode;


	-----------
	-- Split --
	-----------

	function Split (S : String) return String_Vectors.Vector is
		use Ada.Strings.Maps;
		use String_Vectors;

		Whitespace : constant Character_Set := To_Set(" " & ASCII.HT);

		Quote_Char : Character;
		Start : Positive := S'First;
		Finish : Positive;
		O : Vector := Empty_Vector;
	begin
		if S'Length = 0 then
			return O;
		end if;

		while Start <= S'Last loop
			while Start <= S'Last and then Is_In(S(Start), Whitespace) loop
				Start := Start + 1;
			end loop;
			if Start > S'Last then
				return O;
			end if;
			Finish := Start;

			if S(Start) = '"' or S(Start) = ''' then
				Quote_Char := S(Start);
				Finish := Start + 1;
				while Finish <= S'Last and then S(Finish) /= Quote_Char loop
					Finish := Finish + 1;
				end loop;
				if Finish > S'Last or else S(Finish) /= Quote_Char then
					raise Malformed_Command with "Unclosed quoted argument";
				end if;
				pragma Assert(S(Start) = Quote_Char);
				pragma Assert(S(Finish) = Quote_Char);
				O.Append(S(Start + 1 .. Finish - 1));
				if
					Finish + 1 <= S'Last and then
					not Is_In(S(Finish + 1), Whitespace)
				then
					raise Malformed_Command with "Quoted arguments must be separated from adjacent arguments by whitespace";
				end if;
				Start := Finish + 1;
			else
				while
					Finish <= S'Last and then
					not Is_In(S(Finish), Whitespace)
				loop
					Finish := Finish + 1;
				end loop;
				if Finish > S'Last then
					Finish := S'Last;
				else
					-- Since Finish will be on whitespace if we're not past the
					-- end, we back up one to be on the end of the word.
					Finish := Finish - 1;
				end if;
				O.Append(S(Start .. Finish));
				Start := Finish + 1;
			end if;
		end loop;
		return O;
	end Split;


	------------------------
	-- Completion_Wrapper --
	------------------------

	procedure Completion_Wrapper
		(line : chars_ptr; lc : access linenoiseCompletions)
	is
		use String_Vectors;

		Completions : Vector;
		Ptr : chars_ptr := Null_Ptr;
	begin
		Completions := Completer(Value(line));
		for C of Completions loop
			Ptr := New_String(C);
			linenoiseAddCompletion(lc, Ptr);
			-- Linenoise makes a copy of the string
			Free(Ptr);
		end loop;
	end Completion_Wrapper;


	------------------
	-- Hint_Wrapper --
	------------------

	function Hint_Wrapper
		(line : chars_ptr; color : access int; bold : access int)
		return chars_ptr
	is
		Color_Ada : Color_Codes := Default;
		Bold_Ada : Boolean := False;
		Hint : constant String := Hinter(Value(line), Color_Ada, Bold_Ada);
		Ptr, Corrected : chars_ptr;
	begin
		if Color_Ada /= Default then
			color.all := (
				case Color_Ada is
					when Red => 31,
					when Green => 32,
					when Yellow => 33,
					when Blue => 34,
					when Magenta => 35,
					when Cyan => 36,
					when White => 37,
					when Default => raise Program_Error with "Unreachable"
			);
		end if;
		bold.all := (if Bold_Ada then 1 else 0);
		Ptr := New_String(Hint);
		Corrected := hint_string_helper(Ptr);
		Free(Ptr);
		return Corrected;
	end Hint_Wrapper;

end Linenoise;