[Ada] Allows Wide_String output on Windows console
Arnaud Charlet
charlet@adacore.com
Fri Jul 18 10:01:00 GMT 2014
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.
-------------- next part --------------
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;
More information about the Gcc-patches
mailing list