with ConsAKD; use ConsAKD;
     with ErroAKD; use ErroAKD;
     with InteAKD;
     with StriAK;
     with TextAKD; use TextAKD;
     with Directory;
     with File_IO;

     package body DiskAKD is
     ---------------------------------------------------------------------------
     ---------------------------------------------------------------------------
     Dummy: File_IO.Transfer_Data;

     Procedure Append_File(
	      Append_File: in string;
	      In_Str: in string;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
     -- Opens the file or creates it and opens it.
     -- Appends the string.
     -- Closes the file.
     ---------------------------------------------------------------------------
       Append_File_Handle : File_Handle_Type;
       Temp_Error         : Error_DOS_Type;
     begin
       DiskAKD.Open_File (
      Append_File, Append_File_Handle, Temp_Error, false);
       if Temp_Error = File_Not_Found then
      DiskAKD.Open_New_File(Append_File, Append_File_Handle, Error);
       end if;
       DiskAKD.Append_File(Append_File_Handle, In_Str, Error);
       DiskAKD.Close_File(Append_File_Handle, Error);
     end Append_File;

     Procedure Append_File(
	      Handle: in File_Handle_Type;
	      In_Str: in string;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
     -- Moves the file pointer to the end of the file and adds the string.
     ---------------------------------------------------------------------------
       Dummy:  long_integer;
     begin
       File_IO.Move_File_Pointer(Handle, File_IO.Current_End, 0, Dummy,
      Error_DOS_Type ( Error ) );
       WriteLn(Handle, In_Str, Error);
     end Append_File;

     Procedure Close_File(
	      Handle: in File_Handle_Type;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
     begin
       Error := Error_DOS_Type ( File_IO.Close ( Handle ) );
     end Close_File;

     procedure Delete (
	      File_Name : in out File_Name_Type;
	      Error     :    out Error_DOS_Type;
	      Path_Name : in     string := "" ) is
     ---------------------------------------------------------------------------
     -- Accepts wildcards, returns un-wildcarded name in File_Name
     ---------------------------------------------------------------------------
       Transfer_Area : Transfer_Data;
       File_Data     : File_Data_Type;
       Error_Temp    : Error_DOS_Type;
     begin
       Find_First ( Path_Name & File_Name, Transfer_Area, File_Data,
      Error_Temp );
       if Error_Temp = OK then
      File_Name := File_Data.Name;
      Error := Error_DOS_Type ( File_IO.Delete ( Path_Name & File_Name ) );
       else
      Error := Error_Temp;
       end if;
     end Delete;

     procedure Delete (
       Path_File_Name : in     string;
       Error          :    out Error_DOS_Type ) is
     ---------------------------------------------------------------------------
     begin
       Error := Error_DOS_Type ( File_IO.Delete ( Path_File_Name ) );
     end Delete;

     procedure DelSub (
       Error     :    out Error_DOS_Type;
       Dead_File : in     File_Name_Type;
       Dir_Name  : in     Dir_Name_Type := "" ) is
     ---------------------------------------------------------------------------
       Error_Temp    : Error_DOS_Type;
       File_Data     : File_Data_Type;
       File_Name     : File_Name_Type;
       Transfer_Area : Transfer_Data;
     begin
       Find_First ( Dir_Name & Dead_File, Transfer_Area, File_Data,
      Error_Temp );
       loop
      if Error_Temp = No_More_Files then
	exit;
      elsif Error_Temp /= OK then
	Error := Error_Temp;
	return;
      end if;
      File_Name := File_Data.Name;
      Put ( Dir_Name & StriAK.Upcase (
	StriAK.Trim_White_Space ( File_Name ) ) );
      Delete ( File_Name, Error_Temp, Dir_Name );
      if Error_Temp /= OK then
	Put_Line ( " " & Error_DOS_Type'image ( Error_Temp ) );
      else
	Put_Line ( "" );
      end if;
      Find_Next ( Transfer_Area, File_Data, Error_Temp );
       end loop;
       Find_First ( Dir_Name & "*.*", Transfer_Area, File_Data, Error_Temp,
      Search_Attributes =>
	( File_IO.subdirectory => true, others => false ) );
       loop
      exit when Error_Temp /= OK;
      if ( File_Data.Name ( 1 ) /= '.' ) and
	File_Data.Attributes ( File_IO.Subdirectory ) then
	     DelSub ( Error_Temp, Dead_File, Dir_Name
	       & StriAK.Trim_White_Space ( File_Data.Name ) & "\" );
	     exit when Error_Temp /= OK;
      end if;
      Find_Next ( Transfer_Area, File_Data, Error_Temp );
       end loop;
       if Error_Temp = No_More_Files then
      Error_Temp := OK;
       end if;
       Error := Error_Temp;
     end DelSub;

     procedure Demo is
     ----------------------------------------------------------------------
       Template  : string ( 1..12 ) := "AdaKit.Exe  ";
       Nth       : positive := 1;
       File_Data : File_Data_Type;
       Error     : Error_DOS_Type;
     begin
       Put_Line ( Copyright );
       Put_Line ( "Demonstration of Find_Nth function." );
       New_Line;
       Ask ( Template, "File name with wildcards (Template) ", Template );
       Nth := InteAKD.Ask_Pos ( "Which one (Nth)? ", Nth );
       Find_Nth ( Template, Nth, File_Data, Error );
       if Error /= OK then
	 Put_Line ( Error_DOS_Type'image ( Error ) );
       else
	 Put_Line ( File_Data.Name );
       end if;
       Pause;
     end Demo;

     procedure Dir (
	      Template: in string;
	      Count: out natural ) is
     ---------------------------------------------------------------------------
       Err: Error_DOS_Type;
       File_Info: File_IO.File_Data;
       TempCount: natural := 0;
       Transfer_Area: File_IO.Transfer_Data;
     begin
       File_IO.Find_First ( Template, Transfer_Area, File_Info,
      Error_DOS_Type ( Err ) );
       while Err = OK loop
      TempCount := TempCount + 1;
      Put_Line(natural'image(TempCount) & ") " & File_Info.Name);
      File_IO.Find_Next ( Transfer_Area, File_Info,
	Error_DOS_Type ( Err ) );
       end loop;
       Count := TempCount;
     end Dir;

     function  Dir_Delete ( Dir_Name: in Dir_Name_Type ) return Error_DOS_Type is
     ---------------------------------------------------------------------------
     -- Deletes the files in the directory but not the sub-directory.
     -- Includes hidden, read-only, and system files.
     -- Returns OK when done unless error occurs.
     ---------------------------------------------------------------------------
       Error: Error_DOS_Type;
       File_Data: File_Data_Type;
     begin
       loop
      Find_Nth ( Dir_Name & "\*.*", 1, File_Data, Error,
	( File_IO.Read_Only    => true,
	     File_IO.Hidden       => true,
	     File_IO.System       => true,
	     File_IO.Volume_Label => false,
	     File_IO.Subdirectory => false,
	     File_IO.Archive      => true ) );
      exit when Error /= OK;
      Error := Error_DOS_Type ( File_IO.Set_Attributes (
	Dir_Name & '\' & File_Data.Name, ( others => false ) ) );
      if Error /= OK then
	return Error;
      end if;
      Error := Error_DOS_Type (
	File_IO.Delete ( Dir_Name & '\' & File_Data.Name ) );
      if Error /= OK then
	return Error;
      end if;
       end loop;
       if Error = No_More_Files then
      return OK;
       else
      return Error;
       end if;
     end Dir_Delete;

     function  File_Exists ( File_Name : in string ) return boolean is
     ----------------------------------------------------------------------
       Dummy : File_Data_Type;
       Error : Error_DOS_Type;
     begin
       Find_Nth ( File_Name, 1, Dummy, Error );
       if Error = OK then
	 return true;
       elsif Error = No_More_Files then
	 return false;
       else
	 raise Name_Error;
       end if;
     end File_Exists;

     Function  File_Picked(
	      Template: in string)
	      return string is
     ---------------------------------------------------------------------------
     -- Returns "            " if no file is successfully picked.
     ---------------------------------------------------------------------------
       Count: natural;
       Err: Error_DOS_Type;
       File_Info: File_IO.File_Data;
       NoFile: constant string(1..12) := (others => ' ');
       Transfer_Area: File_IO.Transfer_Data;
     begin
       DiskAKD.Dir(Template, Count);
       if Count = 0 then
      Put_Line("There are no " & Template
	& " files in the default directory.");
      ConsAKD.Pause;
      return NoFile;
       end if;
       Put_Line ( "" );
       Count := InteAKD.Ask_Nat ( "Please choose a file ", Count );
       DiskAKD.Find_Nth(Template, Count, File_Info, Err);
       if Err = OK then
      return File_Info.Name;
       else
      return NoFile;
       end if;
     exception
       when others => Notify("DiskAKD.File_Picked");
		      raise;
     end File_Picked;

     procedure Find_First (
	      Template          : in     string;
	      Transfer_Area     : in out Transfer_Data;
	      File_Data         :    out File_Data_Type;
	      Error             :    out Error_DOS_Type;
	      Search_Attributes : in     File_Attributes
		:= ( others => false ) ) is
     ---------------------------------------------------------------------------
     begin
       File_IO.Find_First ( Template, Transfer_Area, File_Data,
      Error_DOS_Type ( Error ), Search_Attributes );
     end Find_First;

     procedure Find_Next (
	      Transfer_Area : in out Transfer_Data;
	      File_Data     :    out File_Data_Type;
	      Error         :    out Error_DOS_Type ) is
     ---------------------------------------------------------------------------
     begin
       File_IO.Find_Next ( Transfer_Area, File_Data,
      Error_DOS_Type ( Error ) );
     end Find_Next;

     procedure Find_Nth (
	      Template          : in     string;
	      Nth               : in     positive;
	      File_Data         :    out File_Data_Type;
	      Error             :    out Error_DOS_Type;
	      Search_Attributes : in     File_IO.File_Attributes
		:= ( others => false ) ) is
     ---------------------------------------------------------------------------
     -- Error = ??? when file not found.
     ---------------------------------------------------------------------------
       Transfer_Area: File_IO.Transfer_Data;
     begin
       Find_First ( Template, Transfer_Area, File_Data, Error,
	 Search_Attributes );
       for index in 2..Nth loop
	 Find_Next ( Transfer_Area, File_Data, Error );
       end loop;
     exception
       when others =>
	 Notify("DiskAKD.Find_Nth");
	 raise;
     end Find_Nth;

     function  Move ( From : in string; To : in string ) return Error_DOS_Type is
     ---------------------------------------------------------------------------
     begin
       return Rename ( From, To );
     end Move;

     Procedure Open_File (
	      File_Name: in string;
	      Handle: out File_Handle_Type;
	      Error: out Error_DOS_Type;
	      Warn: in boolean := true ) is
     ---------------------------------------------------------------------------
       TempError: Error_DOS_Type;
     begin
       File_IO.Open ( File_Name, Handle, Error_DOS_Type ( TempError ) );
       if Warn and ( TempError /= OK ) then
	 ErroAKD.Warn ( Error_DOS_Type'image ( TempError ) );
       end if;
       Error := TempError;
     end Open_File;

     Procedure Open_New_File (
	      File_Name: in string;
	      Handle: out File_Handle_Type;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
     -- If file already exists, it is overwritten.
     ---------------------------------------------------------------------------
       TempError: Error_DOS_Type;
     begin
       File_IO.Create ( File_Name, Handle, Error_DOS_Type ( TempError));
       if TempError /= OK then
      Warn(Error_DOS_Type'image(TempError));
       end if;
       Error := TempError;
     exception
       when others =>
      Notify("DiskAKD.Open_New_File");
      raise;
     end Open_New_File;

     function  Prune ( Dir_Name: in Dir_Name_Type ) return Error_DOS_Type is
     ---------------------------------------------------------------------------
     -- Prunes directories even if they contain sub-directories, hidden,
     -- read-only, and system files.
     ---------------------------------------------------------------------------
       Dir_Data: File_Data_Type;
       Error: Error_DOS_Type;
       File_Data: File_Data_Type;
     begin
       Error := Dir_Delete ( Dir_Name );
       if Error /= OK then
      return Error;
       end if;
       loop
      Find_Nth ( Dir_Name & "\*.*", 1, Dir_Data, Error,
	( File_IO.subdirectory => true, others => false ) );
      exit when Error /= OK;
      Error := Prune ( Dir_Name & '\' & Dir_Data.Name );
      if Error /= OK then
	return Error;
      end if;
       end loop;
       if Error /= No_More_Files then
      return Error;
       end if;
       return Error_DOS_Type ( Directory.Remove ( Dir_Name ) );
     end Prune;

     Procedure ReadLn(
	      Handle: in File_Handle_Type;
	      OutStr: out string;
	      Is_End_of_File: out boolean;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
     -- If OutStr < Disk string, all of Disk string is read anyway.
     ---------------------------------------------------------------------------
       Bytes_Read: natural;
       Str_Len: natural := 0;
       Temp_OutStr: string(OutStr'first..OutStr'last);
       TempStr: string(OutStr'first..OutStr'last+1);
     begin
       Is_End_of_File := false;
       loop
      File_IO.Read ( Handle, 1, TempStr(Str_Len+1)'address, Bytes_Read,
	Error_DOS_Type ( Error ) );
      if Bytes_Read = 0 then
	Is_End_Of_File := true;
	exit;
      end if;
      if TempStr(Str_Len+1) = ASCII.CR then
	File_IO.Read ( Handle, 1, TempStr(Str_Len+1)'address, Bytes_Read,
	     Error_DOS_Type ( Error ) );
	exit;
      end if;
      if Str_Len < OutStr'last then
	Str_Len := Str_Len + 1;
      end if;
       end loop;
       for index in (Str_Len+1..OutStr'last) loop
      TempStr(index) := ' ';
       end loop;
       StriAK.Copy(Temp_OutStr, TempStr, 1, Temp_OutStr'last);
       OutStr := Temp_OutStr;
     exception
       when others =>
      Notify("DiskAKD.ReadLn");
      raise;
     end ReadLn;

     function  Rename ( From : in string; To : in string ) return Error_DOS_Type is
     ---------------------------------------------------------------------------
     begin
       return Error_DOS_Type ( File_IO.Rename ( Old_Name => From, New_Name => To ));
     end Rename;

     Procedure Show_File (
	      File_Name    : in     string;
	      Error        :    out Error_DOS_Type;
	      Warn         : in     boolean := true;
	      Clear_Screen : in     boolean := true;
	      End_Pause    : in     boolean := true ) is
     ---------------------------------------------------------------------------
       Error_Temp : Error_DOS_Type;
       Handle: File_Handle_Type;
       In_Str: string ( 1..80 );
       Is_EOF: boolean;
       Line_Count: natural := 0;
     begin
       Open_File ( File_Name, Handle, Error_Temp, Warn );
       Error := Error_Temp;
       if Error_Temp /= OK then
      return;
       end if;
       if Clear_Screen then
      ConsAKD.Clear_Screen;
       end if;
       loop
      ReadLn(Handle, In_Str, Is_EOF, Error);
      Put(In_Str);
      Line_Count := Line_Count + 1;
      if (Line_Count = 25 - 1) and not(Is_EOF) then
	Pause;
	ConsAKD.Clear_Screen;
	Line_Count := 0;
      end if;
      exit when Is_EOF;
       end loop;
       Close_File ( Handle, Error );
       if End_Pause then
      Pause;
       end if;
     end Show_File;

     Procedure Split_File_Name(
	      Original_Name: in string;
	      First_8: out string;
	      Extension: out string) is
     ---------------------------------------------------------------------------
       Count: positive range 1..12;
       Temp_8: string(1..8) := "        ";
       Temp_4: string(1..4) := ".   ";
     begin
       for count in 1..8 loop
      exit when Original_Name(count) = '.';
      Temp_8(count) := Original_Name(count);
       end loop;
       First_8 := Temp_8;
       for count in 1..12 loop
      exit when Original_Name(count) = '.';
       end loop;
       for index in 2..4 loop
      if count+index-1 <= 12 then
	Temp_4(index) := Original_Name(count+index - 1);
      end if;
       end loop;
       Extension := Temp_4;
     exception
       when others =>
      Notify("DiskAKD.Split_File_Name");
      raise;
     end Split_File_Name;

     Procedure Write(
	      Handle: in File_Handle_Type;
	      InStr: in string;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
       Bytes_Written: natural;
     begin
       File_IO.Write(Handle, InStr'last, InStr(1)'address, Bytes_Written,
      Error_DOS_Type ( Error ) );
     end Write;

     Procedure WriteLn(
	      Handle: in File_Handle_Type;
	      InStr: in string;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
       LineStr: string(1..InStr'last+2);
     begin
       LineStr := InStr & ASCII.CR & ASCII.LF;
       Write(Handle, LineStr, Error);
     end WriteLn;

     Procedure Write_Both(
	      Handle: in File_Handle_Type;
	      InStr: in string;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
     begin
       Put(InStr);
       Write(Handle, InStr, Error);
     end Write_Both;

     Procedure WriteLn_Both(
	      Handle: in File_Handle_Type;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
     begin
       WriteLn_Both( Handle, "", Error);
     end WriteLn_Both;

     Procedure WriteLn_Both(
	      Handle: in File_Handle_Type;
	      InStr: in string;
	      Error: out Error_DOS_Type) is
     ---------------------------------------------------------------------------
     begin
       Put_Line(InStr);
       WriteLn(Handle, InStr, Error);
     end WriteLn_Both;

     ---------------------------------------------------------------------------
     ---------------------------------------------------------------------------
     end DiskAKD;