(Beginning_Of_Line, Clear_To_End_Of_Line): new subprograms

src/colors.c

@@ -1,8 +1,10 @@
 
 #ifdef _WIN32
 #include <windows.h>
+#include <wincon.h>
 #else
 #include <unistd.h>
+#include <sys/ioctl.h>
 #endif
 
 int gnatcoll_get_console_screen_buffer_info(int forStderr) {
@@ -10,7 +12,6 @@ int gnatcoll_get_console_screen_buffer_info(int forStderr) {
    const HANDLE handle =
       GetStdHandle (forStderr ? STD_ERROR_HANDLE : STD_OUTPUT_HANDLE);
    CONSOLE_SCREEN_BUFFER_INFO csbiInfo;
-
    if (GetConsoleScreenBufferInfo (handle, &csbiInfo)) {
       return csbiInfo.wAttributes;
    }
@@ -45,3 +46,38 @@ int gnatcoll_terminal_has_colors(int fd) {
    return isatty(fd);
 #endif
 }
+
+void gnatcoll_beginning_of_line(int forStderr) {
+#ifdef _WIN32
+   const HANDLE handle =
+      GetStdHandle (forStderr ? STD_ERROR_HANDLE : STD_OUTPUT_HANDLE);
+   CONSOLE_SCREEN_BUFFER_INFO csbiInfo;
+   if (GetConsoleScreenBufferInfo (handle, &csbiInfo)) {
+      csbiInfo.dwCursorPosition.X = 0;
+      SetConsoleCursorPosition(handle, csbiInfo.dwCursorPosition);
+   }
+#else
+   //  struct winsize ws;
+   //  ioctl(forStderr ? 2 : 1, TIOCGWINSZ, &ws);
+   write(forStderr ? 2 : 1, "\r", 1);
+#endif
+}
+
+void gnatcoll_clear_to_end_of_line(int forStderr) {
+#ifdef _WIN32
+   const HANDLE handle =
+      GetStdHandle (forStderr ? STD_ERROR_HANDLE : STD_OUTPUT_HANDLE);
+   CONSOLE_SCREEN_BUFFER_INFO csbiInfo;
+   if (GetConsoleScreenBufferInfo (handle, &csbiInfo)) {
+      DWORD numberOfCharsWritten;
+      FillConsoleOutputCharacter(
+            handle, ' ',
+            csbiInfo.dwSize.X - csbiInfo.dwCursorPosition.X + 1, // length
+            csbiInfo.dwCursorPosition, // dWriteCoord
+            &numberOfCharsWritten);
+   }
+
+#else
+   write(forStderr ? 2 : 1, "\033[0K", 4);
+#endif
+}

src/gnatcoll-terminal.adb

@@ -371,4 +371,39 @@ package body GNATCOLL.Terminal is
       end case;
    end Set_Color;
 
-end GNATCOLL.Terminal;
+   -----------------------
+   -- Beginning_Of_Line --
+   -----------------------
+
+   procedure Beginning_Of_Line
+      (Self : in out Terminal_Info;
+       Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output)
+   is
+      procedure Internal (Stderr : Integer);
+      pragma Import (C, Internal, "gnatcoll_beginning_of_line");
+   begin
+      if Self.FD = File or else Self.Colors = Unsupported then
+         null;
+      else
+         Internal (Boolean'Pos (Self.FD = Stderr));
+      end if;
+   end Beginning_Of_Line;
+
+   --------------------------
+   -- Clear_To_End_Of_Line --
+   --------------------------
+
+   procedure Clear_To_End_Of_Line
+      (Self : in out Terminal_Info;
+       Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output)
+   is
+      procedure Internal (Stderr : Integer);
+      pragma Import (C, Internal, "gnatcoll_clear_to_end_of_line");
+   begin
+      if Self.FD = File or else Self.Colors = Unsupported then
+         null;
+      else
+         Internal (Boolean'Pos (Self.FD = Stderr));
+      end if;
+   end Clear_To_End_Of_Line;
+ end GNATCOLL.Terminal;

src/gnatcoll-terminal.ads

@@ -42,6 +42,10 @@ package GNATCOLL.Terminal is
    --  is where text is actually output. The properties of that File_Type are
    --  queried and cached in the Terminal_Info.
 
+   ------------
+   -- Colors --
+   ------------
+
    type Supports_Color is (Yes, No, Auto);
    procedure Init_For_Stdout
       (Self   : in out Terminal_Info;
@@ -114,6 +118,21 @@ package GNATCOLL.Terminal is
        Term  : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output);
    --  Override specific colors.
 
+   -------------
+   -- Cursors --
+   -------------
+
+   procedure Beginning_Of_Line
+      (Self : in out Terminal_Info;
+       Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output);
+   --  Move the cursor back to the beginning of the line.
+   --  This has no impact on files, only in interactive terminals.
+
+   procedure Clear_To_End_Of_Line
+      (Self : in out Terminal_Info;
+       Term : Ada.Text_IO.File_Type := Ada.Text_IO.Standard_Output);
+   --  Delete from the cursor position to the end of line
+
 private
    type Color_Sequence_Type is (Unsupported, ANSI_Sequences, WIN32_Sequences);
 

src/test_colors.adb

@@ -53,4 +53,15 @@ begin
    Show ("magenta ", Magenta);
    Show ("cyan    ", Cyan);
    Show ("white   ", Grey);
+
+   for J in 1 .. 1_000 loop
+      if J mod 10 = 0 then
+         Put ("Processing file" & J'Img & " with long name");
+      else
+         Put ("Processing file" & J'Img);
+      end if;
+      delay 0.1;
+      Info.Beginning_Of_Line (Standard_Output);
+      Info.Clear_To_End_Of_Line (Standard_Output);
+   end loop;
 end Test_Colors;