Geek Gadgets 1

home *** CD-ROM | disk | FTP | other *** search

/ Geek Gadgets 1 / ADE-1.bin / ade-bin / lib / gcc-lib / m68k-amigaos / 2.7.2.1 / adainclude / a-chahan.adb < prev next >

Wrap

Text File | 1995-10-17 | 18.2 KB | 577 lines

------------------------------------------------------------------------------ -- -- -- GNAT RUNTIME COMPONENTS -- -- -- -- A D A . C H A R A C T E R S . H A N D L I N G -- -- -- -- B o d y -- -- -- -- $Revision: 1.15 $ -- -- -- -- Copyright (c) 1992,1993,1994 NYU, All Rights Reserved -- -- -- -- The GNAT library is free software; you can redistribute it and/or modify -- -- it under terms of the GNU Library General Public License as published by -- -- the Free Software Foundation; either version 2, or (at your option) any -- -- later version. The GNAT library is distributed in the hope that it will -- -- be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- -- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- -- Library General Public License for more details. You should have -- -- received a copy of the GNU Library General Public License along with -- -- the GNAT library; see the file COPYING.LIB. If not, write to the Free -- -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -- -- -- ------------------------------------------------------------------------------ with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; with Ada.Strings.Maps; use Ada.Strings.Maps; with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; package body Ada.Characters.Handling is pragma Preelaborate (Handling); ------------------------------------ -- Character Classification Table -- ------------------------------------ type Character_Flags is mod 256; for Character_Flags'Size use 8; Control : constant Character_Flags := 1; Lower : constant Character_Flags := 2; Upper : constant Character_Flags := 4; Basic : constant Character_Flags := 8; Hex_Digit : constant Character_Flags := 16; Digit : constant Character_Flags := 32; Special : constant Character_Flags := 64; Letter : constant Character_Flags := Lower or Upper; Alphanum : constant Character_Flags := Letter or Digit; Graphic : constant Character_Flags := Alphanum or Special; Char_Map : constant array (Character) of Character_Flags := ( NUL => Control, SOH => Control, STX => Control, ETX => Control, EOT => Control, ENQ => Control, ACK => Control, BEL => Control, BS => Control, HT => Control, LF => Control, VT => Control, FF => Control, CR => Control, SO => Control, SI => Control, DLE => Control, DC1 => Control, DC2 => Control, DC3 => Control, DC4 => Control, NAK => Control, SYN => Control, ETB => Control, CAN => Control, EM => Control, SUB => Control, ESC => Control, FS => Control, GS => Control, RS => Control, US => Control, Space => Special, Exclamation => Special, Quotation => Special, Number_Sign => Special, Dollar_Sign => Special, Percent_Sign => Special, Ampersand => Special, Apostrophe => Special, Left_Parenthesis => Special, Right_Parenthesis => Special, Asterisk => Special, Plus_Sign => Special, Comma => Special, Hyphen => Special, Full_Stop => Special, Solidus => Special, '0' .. '9' => Digit + Hex_Digit, Colon => Special, Semicolon => Special, Less_Than_Sign => Special, Equals_Sign => Special, Greater_Than_Sign => Special, Question => Special, Commercial_At => Special, 'A' .. 'F' => Upper + Basic + Hex_Digit, 'G' .. 'Z' => Upper + Basic, Left_Square_Bracket => Special, Reverse_Solidus => Special, Right_Square_Bracket => Special, Circumflex => Special, Low_Line => Special, Grave => Special, 'a' .. 'f' => Lower + Basic + Hex_Digit, 'g' .. 'z' => Lower + Basic, Left_Curly_Bracket => Special, Vertical_Line => Special, Right_Curly_Bracket => Special, Tilde => Special, DEL => Control, Reserved_128 => Control, Reserved_129 => Control, BPH => Control, NBH => Control, Reserved_132 => Control, NEL => Control, SSA => Control, ESA => Control, HTS => Control, HTJ => Control, VTS => Control, PLD => Control, PLU => Control, RI => Control, SS2 => Control, SS3 => Control, DCS => Control, PU1 => Control, PU2 => Control, STS => Control, CCH => Control, MW => Control, SPA => Control, EPA => Control, SOS => Control, Reserved_153 => Control, SCI => Control, CSI => Control, ST => Control, OSC => Control, PM => Control, APC => Control, No_Break_Space => Special, Inverted_Exclamation => Special, Cent_Sign => Special, Pound_Sign => Special, Currency_Sign => Special, Yen_Sign => Special, Broken_Bar => Special, Section_Sign => Special, Diaeresis => Special, Copyright_Sign => Special, Feminine_Ordinal_Indicator => Special, Left_Angle_Quotation => Special, Not_Sign => Special, Soft_Hyphen => Special, Registered_Trade_Mark_Sign => Special, Macron => Special, Degree_Sign => Special, Plus_Minus_Sign => Special, Superscript_Two => Special, Superscript_Three => Special, Acute => Special, Micro_Sign => Special, Pilcrow_Sign => Special, Middle_Dot => Special, Cedilla => Special, Superscript_One => Special, Masculine_Ordinal_Indicator => Special, Right_Angle_Quotation => Special, Fraction_One_Quarter => Special, Fraction_One_Half => Special, Fraction_Three_Quarters => Special, Inverted_Question => Special, UC_A_Grave => Upper, UC_A_Acute => Upper, UC_A_Circumflex => Upper, UC_A_Tilde => Upper, UC_A_Diaeresis => Upper, UC_A_Ring => Upper, UC_AE_Diphthong => Upper + Basic, UC_C_Cedilla => Upper, UC_E_Grave => Upper, UC_E_Acute => Upper, UC_E_Circumflex => Upper, UC_E_Diaeresis => Upper, UC_I_Grave => Upper, UC_I_Acute => Upper, UC_I_Circumflex => Upper, UC_I_Diaeresis => Upper, UC_Icelandic_Eth => Upper + Basic, UC_N_Tilde => Upper, UC_O_Grave => Upper, UC_O_Acute => Upper, UC_O_Circumflex => Upper, UC_O_Tilde => Upper, UC_O_Diaeresis => Upper, Multiplication_Sign => Special, UC_O_Oblique_Stroke => Upper, UC_U_Grave => Upper, UC_U_Acute => Upper, UC_U_Circumflex => Upper, UC_U_Diaeresis => Upper, UC_Y_Acute => Upper, UC_Icelandic_Thorn => Upper + Basic, LC_German_Sharp_S => Lower + Basic, LC_A_Grave => Lower, LC_A_Acute => Lower, LC_A_Circumflex => Lower, LC_A_Tilde => Lower, LC_A_Diaeresis => Lower, LC_A_Ring => Lower, LC_AE_Diphthong => Lower + Basic, LC_C_Cedilla => Lower, LC_E_Grave => Lower, LC_E_Acute => Lower, LC_E_Circumflex => Lower, LC_E_Diaeresis => Lower, LC_I_Grave => Lower, LC_I_Acute => Lower, LC_I_Circumflex => Lower, LC_I_Diaeresis => Lower, LC_Icelandic_Eth => Lower + Basic, LC_N_Tilde => Lower, LC_O_Grave => Lower, LC_O_Acute => Lower, LC_O_Circumflex => Lower, LC_O_Tilde => Lower, LC_O_Diaeresis => Lower, Division_Sign => Special, LC_O_Oblique_Stroke => Lower, LC_U_Grave => Lower, LC_U_Acute => Lower, LC_U_Circumflex => Lower, LC_U_Diaeresis => Lower, LC_Y_Acute => Lower, LC_Icelandic_Thorn => Lower + Basic, LC_Y_Diaeresis => Lower ); --------------------- -- Is_Alphanumeric -- --------------------- function Is_Alphanumeric (Item : in Character) return Boolean is begin return (Char_Map (Item) and Alphanum) /= 0; end Is_Alphanumeric; -------------- -- Is_Basic -- -------------- function Is_Basic (Item : in Character) return Boolean is begin return (Char_Map (Item) and Basic) /= 0; end Is_Basic; ------------------ -- Is_Character -- ------------------ function Is_Character (Item : in Wide_Character) return Boolean is begin return Wide_Character'Pos (Item) < 256; end Is_Character; ---------------- -- Is_Control -- ---------------- function Is_Control (Item : in Character) return Boolean is begin return (Char_Map (Item) and Control) /= 0; end Is_Control; -------------- -- Is_Digit -- -------------- function Is_Digit (Item : in Character) return Boolean is begin return Item in '0' .. '9'; end Is_Digit; -------------------------- -- Is_Hexadecimal_Digit -- -------------------------- function Is_Hexadecimal_Digit (Item : in Character) return Boolean is begin return (Char_Map (Item) and Hex_Digit) /= 0; end Is_Hexadecimal_Digit; ---------------- -- Is_ISO_646 -- ---------------- function Is_ISO_646 (Item : in Character) return Boolean is begin return Item in ISO_646; end Is_ISO_646; -- Note: much more efficient coding of the following function is possible -- by testing several 16#80# bits in a complete word in a single operation function Is_ISO_646 (Item : in String) return Boolean is begin for J in Item'Range loop if Item (J) not in ISO_646 then return False; end if; end loop; return True; end Is_ISO_646; ---------------- -- Is_Graphic -- ---------------- function Is_Graphic (Item : in Character) return Boolean is begin return (Char_Map (Item) and Graphic) /= 0; end Is_Graphic; --------------- -- Is_Letter -- --------------- function Is_Letter (Item : in Character) return Boolean is begin return (Char_Map (Item) and Letter) /= 0; end Is_Letter; -------------- -- Is_Lower -- -------------- function Is_Lower (Item : in Character) return Boolean is begin return (Char_Map (Item) and Lower) /= 0; end Is_Lower; ---------------- -- Is_Special -- ---------------- function Is_Special (Item : in Character) return Boolean is begin return (Char_Map (Item) and Special) /= 0; end Is_Special; --------------- -- Is_String -- --------------- function Is_String (Item : in Wide_String) return Boolean is begin for J in Item'Range loop if Wide_Character'Pos (Item (J)) >= 256 then return False; end if; end loop; return True; end Is_String; -------------- -- Is_Upper -- -------------- function Is_Upper (Item : in Character) return Boolean is begin return (Char_Map (Item) and Upper) /= 0; end Is_Upper; -------------- -- To_Basic -- -------------- function To_Basic (Item : in Character) return Character is begin return Value (Basic_Map, Item); end To_Basic; function To_Basic (Item : in String) return String is Result : String (1 .. Item'Length); begin for J in Item'Range loop Result (J - (Item'First - 1)) := Value (Basic_Map, Item (J)); end loop; return Result; end To_Basic; ------------------ -- To_Character -- ------------------ function To_Character (Item : in Wide_Character; Substitute : in Character := ' ') return Character is begin if Is_Character (Item) then return Character'Val (Wide_Character'Pos (Item)); else return Substitute; end if; end To_Character; ---------------- -- To_ISO_646 -- ---------------- function To_ISO_646 (Item : in Character; Substitute : in ISO_646 := ' ') return ISO_646 is begin if Item in ISO_646 then return Item; else return Substitute; end if; end To_ISO_646; function To_ISO_646 (Item : in String; Substitute : in ISO_646 := ' ') return String is Result : String (1 .. Item'Length); begin for J in Item'Range loop if Item (J) in ISO_646 then Result (J - (Item'First - 1)) := Item (J); else Result (J - (Item'First - 1)) := Substitute; end if; end loop; return Result; end To_ISO_646; -------------- -- To_Lower -- -------------- function To_Lower (Item : in Character) return Character is begin return Value (Lower_Case_Map, Item); end To_Lower; function To_Lower (Item : in String) return String is Result : String (1 .. Item'Length); begin for J in Item'Range loop Result (J - (Item'First - 1)) := Value (Lower_Case_Map, Item (J)); end loop; return Result; end To_Lower; --------------- -- To_String -- --------------- function To_String (Item : in Wide_String; Substitute : in Character := ' ') return String is Result : String (1 .. Item'Length); begin for J in Item'Range loop Result (J) := To_Character (Item (J), Substitute); end loop; return Result; end To_String; -------------- -- To_Upper -- -------------- function To_Upper (Item : in Character) return Character is begin return Value (Upper_Case_Map, Item); end To_Upper; function To_Upper (Item : in String) return String is Result : String (1 .. Item'Length); begin for J in Item'Range loop Result (J - (Item'First - 1)) := Value (Upper_Case_Map, Item (J)); end loop; return Result; end To_Upper; ----------------------- -- To_Wide_Character -- ----------------------- function To_Wide_Character (Item : in Character) return Wide_Character is begin return Wide_Character'Val (Character'Pos (Item)); end To_Wide_Character; -------------------- -- To_Wide_String -- -------------------- function To_Wide_String (Item : in String) return Wide_String is Result : Wide_String (1 .. Item'Length); begin for J in Item'Range loop Result (J - (Item'First - 1)) := To_Wide_Character (Item (J)); end loop; return Result; end To_Wide_String; end Ada.Characters.Handling;