File : a-wichun.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --         A D A . W I D E _ C H A R A C T E R T S . U N I C O D E          --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2005-2010, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31 
  32 package body Ada.Wide_Characters.Unicode is
  33 
  34    package G renames System.UTF_32;
  35 
  36    ------------------
  37    -- Get_Category --
  38    ------------------
  39 
  40    function Get_Category (U : Wide_Character) return Category is
  41    begin
  42       return Category (G.Get_Category (Wide_Character'Pos (U)));
  43    end Get_Category;
  44 
  45    --------------
  46    -- Is_Digit --
  47    --------------
  48 
  49    function Is_Digit (U : Wide_Character) return Boolean is
  50    begin
  51       return G.Is_UTF_32_Digit (Wide_Character'Pos (U));
  52    end Is_Digit;
  53 
  54    function Is_Digit (C : Category) return Boolean is
  55    begin
  56       return G.Is_UTF_32_Digit (G.Category (C));
  57    end Is_Digit;
  58 
  59    ---------------
  60    -- Is_Letter --
  61    ---------------
  62 
  63    function Is_Letter (U : Wide_Character) return Boolean is
  64    begin
  65       return G.Is_UTF_32_Letter (Wide_Character'Pos (U));
  66    end Is_Letter;
  67 
  68    function Is_Letter (C : Category) return Boolean is
  69    begin
  70       return G.Is_UTF_32_Letter (G.Category (C));
  71    end Is_Letter;
  72 
  73    ------------------------
  74    -- Is_Line_Terminator --
  75    ------------------------
  76 
  77    function Is_Line_Terminator (U : Wide_Character) return Boolean is
  78    begin
  79       return G.Is_UTF_32_Line_Terminator (Wide_Character'Pos (U));
  80    end Is_Line_Terminator;
  81 
  82    -------------
  83    -- Is_Mark --
  84    -------------
  85 
  86    function Is_Mark (U : Wide_Character) return Boolean is
  87    begin
  88       return G.Is_UTF_32_Mark (Wide_Character'Pos (U));
  89    end Is_Mark;
  90 
  91    function Is_Mark (C : Category) return Boolean is
  92    begin
  93       return G.Is_UTF_32_Mark (G.Category (C));
  94    end Is_Mark;
  95 
  96    --------------------
  97    -- Is_Non_Graphic --
  98    --------------------
  99 
 100    function Is_Non_Graphic (U : Wide_Character) return Boolean is
 101    begin
 102       return G.Is_UTF_32_Non_Graphic (Wide_Character'Pos (U));
 103    end Is_Non_Graphic;
 104 
 105    function Is_Non_Graphic (C : Category) return Boolean is
 106    begin
 107       return G.Is_UTF_32_Non_Graphic (G.Category (C));
 108    end Is_Non_Graphic;
 109 
 110    --------------
 111    -- Is_Other --
 112    --------------
 113 
 114    function Is_Other (U : Wide_Character) return Boolean is
 115    begin
 116       return G.Is_UTF_32_Other (Wide_Character'Pos (U));
 117    end Is_Other;
 118 
 119    function Is_Other (C : Category) return Boolean is
 120    begin
 121       return G.Is_UTF_32_Other (G.Category (C));
 122    end Is_Other;
 123 
 124    --------------------
 125    -- Is_Punctuation --
 126    --------------------
 127 
 128    function Is_Punctuation (U : Wide_Character) return Boolean is
 129    begin
 130       return G.Is_UTF_32_Punctuation (Wide_Character'Pos (U));
 131    end Is_Punctuation;
 132 
 133    function Is_Punctuation (C : Category) return Boolean is
 134    begin
 135       return G.Is_UTF_32_Punctuation (G.Category (C));
 136    end Is_Punctuation;
 137 
 138    --------------
 139    -- Is_Space --
 140    --------------
 141 
 142    function Is_Space (U : Wide_Character) return Boolean is
 143    begin
 144       return G.Is_UTF_32_Space (Wide_Character'Pos (U));
 145    end Is_Space;
 146 
 147    function Is_Space (C : Category) return Boolean is
 148    begin
 149       return G.Is_UTF_32_Space (G.Category (C));
 150    end Is_Space;
 151 
 152    -------------------
 153    -- To_Lower_Case --
 154    -------------------
 155 
 156    function To_Lower_Case
 157      (U : Wide_Character) return Wide_Character
 158    is
 159    begin
 160       return
 161         Wide_Character'Val
 162           (G.UTF_32_To_Lower_Case (Wide_Character'Pos (U)));
 163    end To_Lower_Case;
 164 
 165    -------------------
 166    -- To_Upper_Case --
 167    -------------------
 168 
 169    function To_Upper_Case
 170      (U : Wide_Character) return Wide_Character
 171    is
 172    begin
 173       return
 174         Wide_Character'Val
 175           (G.UTF_32_To_Upper_Case (Wide_Character'Pos (U)));
 176    end To_Upper_Case;
 177 
 178 end Ada.Wide_Characters.Unicode;