-- Skywalker is another attempt of A. i. written with Ada. -- Skywalker is Copyright (C) 2024 Manuel De Girardi ;  -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA -- -- Date := "2024-11-11 15:56:20" -- Version := "0.0.2r" with GNAT.Directory_Operations.Iteration; with Gnat.Regexp; with Gnat.Directory_Operations; with Ada.Strings.Fixed; use Ada.Strings; use Gnat.Directory_Operations; with Gnat.Command_Line; with Text_Io; use Text_Io; with System.Os_Constants; use System.Os_Constants; with Ada.Characters.Handling; use Ada.Characters; package body Sky.Tools is function Delete_Local_Prefix(Filename : in String) return String is begin if Filename'Length > 2 then if Filename(Filename'First..Filename'First+1) = Local_Prefix then return Filename(Filename'First+2..Filename'Last); else return Filename; end if; else return Filename; end if; end Delete_Local_Prefix; function Normalize_Quoted_Argument(Arg : in String) return String is Local : String(1..Arg'Length) := Arg; Local_Index : Natural := 0; begin for I in Arg'First .. Arg'Last loop if Arg(i) /= '"' then Local(Local_Index + 1) := Arg(I); Local_Index := Local_Index + 1; end if; end loop; if Local_Index /= 0 then return Local(Local'First..Local_index); else return Arg; end if; end Normalize_Quoted_Argument; function Search_Regexp (Path : in String; Pattern : in String) return String is Full_Line : String_Access := new String ' (""); procedure Action (Filename : in String; Index : in Positive; Verax : in out Boolean) is Buffer : String_Access := new String ' (""); Tmp : String_Access := new String ' (""); Is_Out : Boolean := True; Regular_Exp : Gnat.Regexp.Regexp; begin --Text_Io.Put_line("File : "& Filename & "; Pattern : " & Pattern);  Regular_Exp := Gnat.Regexp.Compile("*" & Pattern, True, True); if Gnat.Regexp.Match(Filename, Regular_Exp) then if Fixed.Index(Filename, " ") /= 0 then for I in Filename'First..Filename'Last-1 loop if Filename(I) = Character'Val(32) then Buffer := new String ' (Tmp.all & " "); Free(Tmp); Tmp := new String ' (Buffer.all); Free(Buffer); elsif Filename(I) = '/' then if Fixed.Index(Filename, " ", I) > I and Fixed.Index(Filename, "/", I+1) > Fixed.Index(Filename, " ", I) then if Is_Out then Buffer := new String ' (Tmp.all & Filename(I) & """"); Free(Tmp); Tmp := new String ' (Buffer.all); Free(Buffer); Is_Out := False; else Buffer := new String ' (Tmp.all & Filename(I)); Free(Tmp); Tmp := new String ' (Buffer.all); Free(Buffer); end if; elsif Fixed.Index(Filename, " ", I) > I and Fixed.Index(Filename, "/", I+1) = 0 then if Is_Out then Buffer := new String ' (Tmp.all & Filename(I) & """"); Free(Tmp); Tmp := new String ' (Buffer.all); Free(Buffer); Is_Out := False; else Buffer := new String ' (Tmp.all & Filename(I)); Free(Tmp); Tmp := new String ' (Buffer.all); Free(Buffer); end if; else Buffer := new String ' (Tmp.all & Filename(I)); Free(Tmp); Tmp := new String ' (Buffer.all); Free(Buffer); end if; else Buffer := new String ' (Tmp.all & Filename(I)); Free(Tmp); Tmp := new String ' (Buffer.all); Free(Buffer); end if; end loop; Buffer := new String ' (Tmp.all & Filename(Filename'Last)); if not Is_Out then Buffer := new String ' (Tmp.all & """"); Free(Tmp); Tmp := new String ' (Buffer.all); Free(Buffer); end if; --Text_Io.Put_Line("Matched :" & Full_Line.all); if Full_Line'Length > 0 then Buffer := new String ' (Full_Line.all & ' ' & "" & Delete_Local_Prefix(Tmp.all) & ""); Free(Full_Line); Full_Line := new String ' (Buffer.all); Free(Buffer); else Buffer := new String ' (Full_Line.all & "" & Delete_Local_Prefix(Tmp.all) & ""); Free(Full_Line); Full_Line := new String ' (Buffer.all); Free(Buffer); end if; --Text_Io.Put_Line("Matche :" & Tmp.all); else --Text_Io.Put_Line("Matched :" & filename); if Full_Line'Length > 0 then Buffer := new String ' (Full_Line.all & ' ' & Delete_Local_Prefix(filename)); Free(Full_Line); Full_Line := new String ' (Buffer.all); Free(Buffer); else Buffer := new String ' (Full_Line.all & "" & Delete_Local_Prefix(filename) & ""); Free(Full_Line); Full_Line := new String ' (Buffer.all); Free(Buffer); end if; --Text_Io.Put_Line("Matche :" & filename); end if; end if; Verax := False; end Action; procedure File_Search is new Iteration.Wildcard_iterator(Action); begin --Text_Io.Put_Line("pattern for : " & Expand_Path(Pattern)); if Expand_Path(Pattern) /= "" then File_Search(Path); end if; if Full_Line'Length > 0 then declare Result : constant String := Full_Line.all; begin Free(Full_Line); return Result; end; else return Expand_Path(Pattern); end if; exception when others => if Full_Line'Length > 0 then declare Result : constant String := Full_Line.all; begin Free(Full_Line); return Result; end; else return Expand_Path(Pattern); end if; end Search_Regexp; function Expand_filename (Line : in String) return String is Absolute_Path : constant Character := '/'; procedure Recursive_Expand (Line : in String; Result : in out String_Access) is Start, Stop : Natural := 0; begin if Line'Length > 1 then if Start = 0 then Start := Line'First; end if; Stop := Fixed.Index(Line, " ", Start+1); if Stop /= 0 then if Line(Start) /= Absolute_Path then Result := new String ' (Result.all & ' ' & Search_Regexp(Expand_Path(Line(Start..Stop-1)), Line(Start..Stop-1))); else Result := new String ' (Result.all & ' ' & Search_Regexp(Expand_Path(Line(Start..Stop-1)), Line(Start..Stop-1))); end if; Recursive_Expand(Line(Stop+1..Line'last), Result); else if Line(Start) /= Absolute_Path then Result := new String ' (Result.all & ' ' & Search_Regexp(Expand_Path(Line(Start..Line'last)), Line(Start..Line'Last))); else Result := new String ' (Result.all & ' ' & Search_Regexp(Expand_Path(Line(Start..Line'last)), Line(Start..Line'Last))); end if; end if; else if Start = 0 then Start := Line'First; end if; if Line(Start) /= Absolute_Path then Result := new String ' (Result.all & ' ' & Search_Regexp(Expand_Path(Line(Start..Line'Last)), Line(Start..Line'Last))); else Result := new String ' (Result.all & ' ' & Search_Regexp(Expand_Path(Line(Start..Line'last)), Line(Start..Line'Last))); end if; end if; end Recursive_Expand; Full_Set : String_Access := new String ' (""); begin Recursive_Expand(Line(Fixed.Index_Non_Blank(Line)..Fixed.Index_Non_Blank(Line, Backward)), Full_Set); if Full_Set'Length > 0 then declare Result : constant String := Full_Set.all(Fixed.Index_Non_Blank(Full_Set.all)..Fixed.Index_Non_Blank(Full_Set.all, Backward)); begin Free(Full_Set); return Result; end; else return ""; end if; end Expand_Filename; procedure Change_directory (Line : in String;Old_Pwd : in out String_Access) is Command : Gnat.Command_Line.Command_Line; Args_List : Argument_List_Access; Buffer : String_Access; begin Gnat.Command_Line.Set_Command_Line(Command, Line); Gnat.Command_Line.Build(Command, Args_List, False); if Args_List'Last > 2 then return; elsif Args_List'Last = 2 then if Args_List(2) /= null and then Args_List(2).all /= "" then if Args_List(2).all = "-" then if Old_Pwd'Length /= 0 then buffer := new String ' (Get_Current_Dir); Change_Dir(Old_Pwd.all); Free(Old_Pwd); Old_Pwd := new String ' (Buffer.all); Free(Buffer); else Put_Line("no old_pwd."); end if; else Free(Old_Pwd); Old_Pwd := new String ' (Get_Current_Dir); Change_Dir(Args_List(2).all); end if; end if; else case Target_Os is when Windows => Free(Old_Pwd); Old_Pwd := new String ' (Get_Current_Dir); Change_Dir(Getenv("HOMEPATH").all); when Other_OS => Free(Old_Pwd); Old_Pwd := new String ' (Get_Current_Dir); Change_Dir(Getenv("HOME").all); end case; end if; end Change_Directory; use Gnat.Regexp; procedure Find_At_Path (Path : in String; Pattern : in String; Result : in Wide_Result_Access) is Reg_Exp : constant Gnat.Regexp.Regexp := Gnat.Regexp.Compile(Pattern, True, True); procedure Find_Action (Item : String; Index : Positive; Quit : in out Boolean) is Buffer : U_array_Access; begin if Match(Item, Reg_Exp) then Buffer := new u_Array(1..(Result.Wlines'Length)+1); Buffer(Buffer'First..Buffer'Last-1) := Result.Wlines.all; Buffer(Buffer'Last) := (+(Handling.To_Wide_String(Item))); U_Array_free(Result.Wlines); Result.Wlines := new U_Array ' (Buffer.all); Quit := False; end if; end Find_Action; procedure Wildcard_Iterator is new GNAT.Directory_Operations.Iteration.Wildcard_Iterator(Find_Action); begin Wildcard_Iterator(Path); end Find_At_Path; procedure Completion (Line : in String; Full_Command : out Wide_String_Access; Result : out Wide_Result_Access) is Top : constant Natural := Fixed.Index_Non_Blank(Line); Bot : constant Natural := Fixed.Index_Non_Blank(Line, Backward); Blank_Index : constant Natural := Fixed.Index(Line(Top..Bot), " ", Backward); begin Result := new spawn_Result_Record; Result.Wlines := new U_Array (1..1); if Blank_Index < Bot then declare Path : constant String := Line(Blank_Index+1..Bot); Directory_Index : constant Natural := Fixed.Index(Path, "/", Backward); begin if Directory_Index > 0 and Directory_Index < Path'Last then declare Directory : constant String := Path(Path'First..Directory_Index); begin Find_At_Path(Directory, "*" & Path(Directory_Index+1..Path'Last) & "*", Result); end; elsif Directory_Index > 0 then declare Directory : constant String := Path(Path'First..Directory_Index); begin Find_At_Path(Directory, "*", Result); end; else begin Find_At_Path(Get_Current_Dir, "*" & Path & "*", Result); end; end if; end; else begin Find_At_Path(Get_Current_Dir, "*", Result); end; end if; if Result.Wlines'Length = 2 then Full_Command := new Wide_String ' (Handling.To_Wide_String(Line(Line'First..Blank_Index)) & Handling.To_Wide_String(Delete_Local_Prefix(Handling.To_String((-Result.Wlines(2)))))); end if; end Completion; end Sky.Tools ;