Patchwork [Ada] Allows Wide_String output on Windows console

login
register
mail settings
Submitter Arnaud Charlet
Date July 18, 2014, 9:58 a.m.
Message ID <20140718095830.GA376@adacore.com>
Download mbox | patch
Permalink /patch/371432/
State New
Headers show

Comments

Arnaud Charlet - July 18, 2014, 9:58 a.m.
Tested on x86_64-pc-linux-gnu, committed on trunk

2014-07-18  Pascal Obry  <obry@adacore.com>

	* s-crtl.ads, i-cstrea.ads (fputwc): New routine.
	* a-witeio.adb (Put): On platforms where there is translation
	done by the OS output the raw text.
	(New_Line): Use Put above to properly handle the LM wide characters.

Patch

Index: sysdep.c
===================================================================
--- sysdep.c	(revision 212717)
+++ sysdep.c	(working copy)
@@ -104,11 +104,12 @@ 
    file positioning function, unless the input operation encounters
    end-of-file.
 
-   The other target dependent declarations here are for the two functions
-   __gnat_set_binary_mode and __gnat_set_text_mode:
+   The other target dependent declarations here are for the three functions
+   __gnat_set_binary_mode, __gnat_set_text_mode and __gnat_set_wide_text_mode:
 
       void __gnat_set_binary_mode (int handle);
       void __gnat_set_text_mode   (int handle);
+      void __gnat_set_wide_text_mode   (int handle);
 
    These functions have no effect in Unix (or similar systems where there is
    no distinction between binary and text files), but in DOS (and similar
@@ -150,6 +151,12 @@ 
   WIN_SETMODE (handle, O_TEXT);
 }
 
+void
+__gnat_set_wide_text_mode (int handle)
+{
+  WIN_SETMODE (handle, _O_U16TEXT);
+}
+
 #ifdef __CYGWIN__
 
 char *
@@ -245,6 +252,12 @@ 
 __gnat_set_text_mode (int handle ATTRIBUTE_UNUSED)
 {
 }
+
+void
+__gnat_set_wide_text_mode (int handle ATTRIBUTE_UNUSED)
+{
+}
+
 char *
 __gnat_ttyname (int filedes)
 {
Index: s-crtl.ads
===================================================================
--- s-crtl.ads	(revision 212640)
+++ s-crtl.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2003-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -122,6 +122,9 @@ 
    function fputc (C : int; stream : FILEs) return int;
    pragma Import (C, fputc, "fputc");
 
+   function fputwc (C : int; stream : FILEs) return int;
+   pragma Import (C, fputwc, "fputwc");
+
    function fputs (Strng : chars; Stream : FILEs) return int;
    pragma Import (C, fputs, "fputs");
 
Index: i-cstrea.ads
===================================================================
--- i-cstrea.ads	(revision 212640)
+++ i-cstrea.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1995-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -119,6 +119,9 @@ 
    function fputc (C : int; stream : FILEs) return int
      renames System.CRTL.fputc;
 
+   function fputwc (C : int; stream : FILEs) return int
+     renames System.CRTL.fputwc;
+
    function fputs (Strng : chars; Stream : FILEs) return int
      renames System.CRTL.fputs;
 
@@ -223,8 +226,9 @@ 
    --  versa. These functions have no effect if text_translation_required is
    --  false (i.e. in normal unix mode). Use fileno to get a stream handle.
 
-   procedure set_binary_mode (handle : int);
-   procedure set_text_mode   (handle : int);
+   procedure set_binary_mode    (handle : int);
+   procedure set_text_mode      (handle : int);
+   procedure set_wide_text_mode (handle : int);
 
    ----------------------------
    -- Full Path Name support --
@@ -256,6 +260,7 @@ 
 
    pragma Import (C, set_binary_mode, "__gnat_set_binary_mode");
    pragma Import (C, set_text_mode, "__gnat_set_text_mode");
+   pragma Import (C, set_wide_text_mode, "__gnat_set_wide_text_mode");
 
    pragma Import (C, max_path_len, "__gnat_max_path_len");
    pragma Import (C, full_name, "__gnat_full_name");
Index: a-witeio.adb
===================================================================
--- a-witeio.adb	(revision 212640)
+++ a-witeio.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1082,13 +1082,13 @@ 
       FIO.Check_Write_Status (AP (File));
 
       for K in 1 .. Spacing loop
-         Putc (LM, File);
+         Put (File, Wide_Character'Val (LM));
          File.Line := File.Line + 1;
 
          if File.Page_Length /= 0
            and then File.Line > File.Page_Length
          then
-            Putc (PM, File);
+            Put (File, Wide_Character'Val (PM));
             File.Line := 1;
             File.Page := File.Page + 1;
          end if;
@@ -1220,6 +1220,14 @@ 
      (File : File_Type;
       Item : Wide_Character)
    is
+      text_translation_required : Boolean;
+      for text_translation_required'Size use Character'Size;
+      pragma Import (C, text_translation_required,
+                       "__gnat_text_translation_required");
+      --  Text translation is required on Windows only. This means that the
+      --  console is doing translation and we do not want to do any encoding
+      --  here. If this boolean is set we just output the character as-is.
+
       procedure Out_Char (C : Character);
       --  Procedure to output one character of a wide character sequence
 
@@ -1234,11 +1242,21 @@ 
          Putc (Character'Pos (C), File);
       end Out_Char;
 
+      R : int;
+      pragma Unreferenced (R);
+
    --  Start of processing for Put
 
    begin
       FIO.Check_Write_Status (AP (File));
-      WC_Out (Item, File.WC_Method);
+
+      if text_translation_required then
+         set_wide_text_mode (fileno (File.Stream));
+         R := fputwc (Wide_Character'Pos (Item), File.Stream);
+      else
+         WC_Out (Item, File.WC_Method);
+      end if;
+
       File.Col := File.Col + 1;
    end Put;