-- aish is another attempt of A. i. written with Ada. -- Aish 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-04-29 20:25:34" -- Version := "1.1.0r" with Text_Io; with GNAT.Directory_Operations.Iteration; with Gnat.Regexp; with Gnat.Directory_Operations; with Gnat.Command_Line; with Ada.Strings.Fixed; with Ada.Characters.Handling; with System.Os_Constants; use System.Os_Constants; package body Ai.Shell is use Text_Io; use Gnat.Directory_Operations; use Ada.Strings.Fixed; use Ada.Characters; procedure Parse (Line : in String; Name : out String_Access; Image : out String_Access) is current : constant Natural := Index(Line, "="); Top : constant Natural := Index(Line(Line'First..current), " ", backward)+ 1; Bot : constant Natural := Index_Non_Blank(Line, Backward); begin if (Current = 0) or (Top = 0) or (Bot = 0) then return; end if; Name := new String ' (Line(Top..current-1)); Image := new String ' (Line(Current+1..Bot)); end Parse; function Make (Names : in String; Value : in String) return Attribut_Record is Att : Attribut_Record; begin Att.Tags := new String ' (Names); begin Att.boo := Boolean'Value(Value); Att.Enum := Boo; exception when Constraint_Error => begin Att.Int := Integer'Value(Value); Att.Enum := Int; exception when Constraint_Error => begin Att.Flt := float'Value(Value); Att.Enum := Flt; exception when Constraint_Error => begin Att.str := new String ' (Value); Att.Enum := Str; end; end; end; end; return Att; end Make; function names (Att : in Attribut_Record) return String is begin return Att.Tags.all; end Names; function images (Att : in Attribut_Record) return String is begin case Att.Enum is when Nil => return ""; when Boo => return Boolean'Image(Att.Boo); when Int => return Integer'Image(Att.Int); when Flt => return Float'Image(Att.Flt); when Str => return Att.Str.all; end case; end Images; procedure Alias (Line : in String; Alias_Set : in out Attributs) is Command : Gnat.Command_Line.Command_Line; Args_List : Argument_List_Access; --Buffer : U_Array_Access := Result.Wlines; Name : String_Access; Image : String_Access; Alias : Attribut_Record; begin Gnat.Command_Line.Set_Command_Line(Command, Line); Gnat.Command_Line.Build(Command, Args_List, False); if Args_List'Last > 2 then --Buffer := Add_Line(Buffer, "alias : error : "); --Buffer := Add_Line(Buffer, " -- To many argument in command --"); --Buffer := Add_Line(Buffer, " -- Try 'help cd' for more info --"); return; elsif Args_List'Last = 2 then if Args_List(2) /= null and then Args_List(2).all /= "" then Parse(Line, Name, Image); Alias := Make(Name.all, Image.all); Alias_Set.list(Alias_Set.Index + 1) := Alias; Alias_Set.Index := Alias_Set.Index + 1; end if; else for Iter in 1..Alias_Set.Index loop Put_Line(Names(Alias_Set.list(Iter)) & '=' & images(Alias_Set.list(Iter))); end loop; end if; exception when others => null; end Alias; procedure Unalias (Line : in String; Alias_Set : in out Attributs) is Command : Gnat.Command_Line.Command_Line; Args_List : Argument_List_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 for Iter in 1..Alias_Set.Index loop declare Alias : constant Attribut_Record := Alias_Set.List(Iter); begin if Names(Alias) = Args_List(2).all then for Left in Iter..Alias_Set.Index loop Alias_Set.List(Left) := Alias_Set.List(Left+1); Alias_Set.Index := Alias_Set.Index - 1; end loop; exit; end if; end; end loop; end if; end if; exception when others => null; end Unalias; procedure Set (Line : in String; Var_Set : in out Attributs) is begin Alias(Line, Var_Set); end Set; procedure Unset (Line : in String; Var_Set : in out Attributs) is begin Unalias(Line, Var_Set); end Unset; procedure Put(Name : in String; Var_Set : in out Attributs) is begin for Iter in 1..Var_Set.Index loop if Names(Var_Set.list(Iter)) = Name then Text_Io.Put(images(Var_Set.list(Iter))); end if; end loop; end Put; procedure Put_Line(Name : in String; Var_Set : in out Attributs) is begin Put(Name, Var_Set); New_Line; end Put_Line; Local_Prefix : constant String := "./"; 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; function Internal_Cmd_Value (Line : in String) return Int_Cmd_Enum is Cmd : Int_Cmd_Enum := None; First_Space : constant Natural := Index(Line, " "); begin if First_Space /= 0 then begin Cmd := Int_Cmd_Enum'Value(Line(Line'First..First_Space-1)); exception when others => Cmd := None; end; elsif Index_Non_Blank(Line) /= 0 then begin Cmd := Int_Cmd_Enum'Value(Line(Index_Non_Blank(Line)..Index_Non_Blank(Line, Backward))); exception when others => Cmd := none; end; end if; return Cmd; end Internal_Cmd_Value; function Command_Name (Line : in String) return String is begin if Line'Length = 0 then return ""; elsif Index_Non_Blank(Line) = 0 then return ""; elsif (Index(Line, " ") > Index_Non_Blank(Line)) then return Line(Index_Non_Blank(Line)..Index(Line, " ")-1); else return Line; end if; end Command_Name; procedure Add_Line (Set : in out Wide_String_Set; Last : in out Line_Index_Range; Line : in Wide_String) is begin Last := Set.Line_Last; if Last = Set.Lines'Last then Wide_Free (Set.Lines ( 1 ) ); for Line in 1..Last - 1 loop Set.Lines(Line) := Set.Lines (Line + 1); end loop; Set.lines(Last) := new Wide_String ' (Line); else Set.Lines(Last+1) := new Wide_String ' (Line); Last := Last + 1; end if; Set.Line_Last := Last; end Add_Line; procedure Set_Free(Set : in out Wide_String_Set) is begin for Iter in Set.Lines ' range loop Wide_Free(Set.Lines(Iter)); end loop; Set.Line_Last := 0; end Set_Free; end Ai.Shell ;