libchars.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand        --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  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 Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------


class LIBCHARS < $IS_EQ

class LIBCHARS < $IS_EQ is -- This class provides the special characters used in this library -- for different syntactic purposes in parsing or rendering date of -- all classes. In effect it is an 'enumeration' of chars, including -- those needed for rendering numeric values - which depend on cultural -- definitions. -- -- NOTE The correct operation of the values provided by this class rely on -- the fact that all have single character encodings. If enhancement -- is made for user purposes then this rule must be observed. -- -- WARNING THERE ARE NO PRE/POST CONDITIONS AVAILABLE IN THIS CLASS -- IMPLEMENTATION SINCE ALL CALLS CHECK THAT THE CLASS IS INITIALISED -- AS A PRELIMINARY ACTION. IF NOT THEN INITIALISATION IS DONE -- AT THAT TIME DURING PROGRAM EXECUTION. -- Version 1.1 Feb 99. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 26 Jun 97 kh Original -- 15 Feb 99 kh Added multi-code routines. include COMPARABLE ; readonly attr culture : CULTURE ; private attr misc_chars : ARRAY{CHAR_CODE} ; private shared priv_default : SAME ; private shared converter : CODE_CONVERTER ; private const escape, unicode_mark, -- specials for booting! -- Sather format/number specials decimal_prefix, exponent, hex_prefix, octal_prefix, fmt_filler, -- punctuation - and space! - in code point order space, exclaim, quote_mark, num_sign, dollar, --- percent, ampersand, apostrophe, left_paren, right_paren, asterisk, plus_sign, comma, minus_sign, fullstop, solidus, colon, semicolon, left_angle, equals, right_angle, question_mark, commercial_at, left_bracket, rev_solidus, right_bracket, caret, low_line, grave, left_brace, vert_line, right_brace, tilde, -- line mark - OS defined! - not characters! lmark_one, lmark_two; private const Msg_Count : CARD := lmark_two + 1 ; readonly attr file_modes : ARRAY{STR} ; private attr path_tokens : ARRAY{CODE_STR} ; private const root_name, self_name, parent_name, system_sep, root_sep, component_sep, kind_sep, search_sep ; private const token_cnt : CARD := search_sep + 1 ; readonly attr has_combining : BOOL ; readonly attr my_size : CARD ; private work_out_size : CARD is -- This routine calculates the storage size of the default characters -- from an environment generated string (the current working directory path -- name). loc_ref : REFERENCE := FUDGE_FILESYS::get_cwd ; length : CARD := SATHER_ENGINE::strlen(loc_ref) ; if (length % 2) /= 0 then -- quick short-cut! return 1 end ; loc_str : STR := STR::raw_create(length) ; dummy : REFERENCE := SATHER_ENGINE::memcpy( loc_str.array_ptr,loc_ref,length) ; loc_bin : BINSTR := loc_str.binstr ; -- Now search for null octets which will always be present in -- a file path string for 'punctuation' characters (which are given -- codes less than a single octet). got_first : BOOL := false ; first : CARD := 0 ; loop index : CARD := 0.upto!(loc_bin.size - 1) ; if loc_bin[index] = OCTET::null then if got_first then -- now to work out size! if (index - first) = 1 then return 4 else return 2 end else got_first := true ; first := index end end end ; if got_first then -- but no second encountered! return 2 else return 1 -- just a single octet string end end ; private Env_Name_ref( lib : SAME ) : STR is -- e.g. SATHER_ENV=/usr/local/lib/sather/resources/en_NZ/bin/LIBCHARS -- This routine is more or less 'magic' in that it creates entities -- which refer to this object currently being created. This works since -- the manipulations required only involve the 'my_size' component of self. -- Otherwise, of course, the routine would fail recursively. Do NOT alter -- any of the methods used without carefully checking that this method will -- still work correctly. if self = lib then my_size := lib.work_out_size end ; -- Now the environment enquiry string can be set up! loc_res : CODE_STR := CODE_STR::create(lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_S.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_A.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_T.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_H.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_E.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_R.card,lib) + CHAR_CODE::create(UNICODE::LOW_LINE.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_E.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_N.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_V.card,lib) ; res : STR := loc_res.tgt_str ; return res end ; private def_read : BIN_CURSOR is -- This private routine carries out the finding and reading of the file -- indicated by the environment variable SATHER_ENV, returning a binary -- cursor indicating its contents. file_name : STR := OPSYS::get_env(self.Env_Name_ref(self)) ; fyle : REFERENCE ; contents : BIN_CURSOR ; if void(file_name) then -- this one has to be fatal! #OUT+"libchars.sa def_read: error void(file_name).\n"; OUT::flush; SYS_ERROR::blind_error(self,self.Env_Name_ref(self),self) end ; fyle := FILE_SYS::raw_open(file_name) ; -- NOTE The above statement uses the 'default' "open for read" file opening mode! if void(fyle) -- also fatal! or FILE_SYS::error(fyle) then #OUT+"libchars.sa def_read: error void(fyle).\n"; OUT::flush; SYS_ERROR::blind_error(self,file_name,self) end ; file_size : CARD ; if ~FILE_SYS::size(fyle,out file_size) then -- another fatal one! #OUT+"libchars.sa def_read: error ~FILE_SYS::size(fyle,out file_size).\n"; OUT::flush; SYS_ERROR::blind_error(self,file_name,self) end ; loc_contents : FBINSTR := FBINSTR::create(file_size) ; if FILE_SYS::file_read(loc_contents,1,inout file_size,fyle) then contents := loc_contents.binstr.cursor ; FILE_SYS::close(fyle) else -- Oh! Dear! another fatality! #OUT+"libchars.sa def_read: error ~FILE_SYS::file_read(...).\n"; OUT::flush; SYS_ERROR::blind_error(self,file_name,self) end ; return contents end ; private normal_read( fpath : FILE_PATH ) : BIN_CURSOR is -- This private routine carries out the finding and reading of the file -- indicated by the environment variable SATHER_ENV, returning a binary -- cursor indicating its contents. bfyle : BIN_FILE ; contents : BIN_CURSOR ; leaf_name : STR := SYS::str_for_tp(SYS::tp(self)) ; file_name : STR := fpath.head.append(leaf_name).str ; bfyle := BIN_FILE::open_for_read(file_name) ; if void(bfyle) -- also fatal! or bfyle.error then #OUT+"libchars.sa normal_read: error void(bfyle).\n"; OUT::flush; SYS_ERROR::blind_error(self,file_name,self) end ; contents := bfyle.buffer.binstr.cursor ; bfyle.close ; return contents end ; private bin_read( fpath : FILE_PATH ) : BIN_CURSOR is -- This private routine carries out the finding and reading of the file -- indicated by the environment variable SATHER_ENV, returning a binary -- cursor indicating its contents. if void(fpath) then return def_read else return normal_read(fpath) end end ; get_file_modes( cursor : BIN_CURSOR ) is -- This routine retrieves the file mode reference strings needed for -- creation/opening, etc. They are set into the auxiliary array file_modes. loc_cnt : CARD := cursor.get_item.card ; if loc_cnt /= FILE_MODES::cardinality then -- Oops! another fatal error #OUT+"libchars.sa get_file_modes: error loc_cnt /= FILE_MODES::cardinality.\n"; OUT::flush; SYS_ERROR::blind_error(self,self.Env_Name_ref(self),self) else file_modes := ARRAY{STR}::create(loc_cnt) end ; loop index : CARD := 0.upto!(loc_cnt - 1) ; file_modes[index] := cursor.get_sized.str(self) end end ; get_path_tokens( cursor : BIN_CURSOR ) is -- This routine retrieves the file mode reference strings needed for -- creation/opening, etc. They are set into the auxiliary array path_tokens. -- Note that the loop expires at the end of the buffer - if not before! loc_cnt : CARD := cursor.get_item.card ; if loc_cnt /= token_cnt then #OUT+"libchars.sa get_path_tokens: error loc_cnt /= token_cnt.\n"; OUT::flush; SYS_ERROR::blind_error(self,self.Env_Name_ref(self),self) else path_tokens := ARRAY{CODE_STR}::create(loc_cnt) end ; loop while!(cursor.remaining > 1) ; loc_tmp : CODE_STR := CODE_STR::raw_create(cursor.get_sized,self) ; path_tokens.set!(loc_tmp) end end ; create( cult : CULTURE, fpath : FILE_PATH ) : SAME pre ~void(cult) post ~void(result) -- or an exception has been raised is -- This routine creates a new object containing the Sather library -- character values - taking the data from the specified culture. if cult.state > cult.Library then return cult.sather_lib end ; loc_cursor : BIN_CURSOR ; me : SAME := new ; me.culture := cult ; if ~REP_LIB_LIST::insert(me) then #OUT+"libchars.sa create: error ~REP_LIB_LIST::insert(me).\n"; OUT::flush; SYS_ERROR::blind_error(me,"",me); end; -- put into the global list! loc_cursor := me.bin_read(fpath) ; -- succeeds - or fatal! -- NOTE If fpath is void the above routine has the side effect of -- setting the my_size attribute. loc_kind : CODE_KINDS := CODE_KINDS::build(loc_cursor) ; if (cult = CULTURE::default) then priv_default := me; end ; if void(fpath) then if loc_kind.size = me.my_size then cult.init_kind(loc_kind) else -- Fatal inconsistency!! #OUT+"libchars.sa create: error loc_kins.size/=me.my_size.\n"; OUT::flush; SYS_ERROR::blind_error(me,self.Env_Name_ref(self),me) end else -- not the default culture/lib me.my_size := loc_kind.size ; cult.init_kind(loc_kind) end ; count : CARD := loc_cursor.get_item.card ; -- First the Sather required library special chars (as codes!) if count /= Msg_Count then #OUT+"libchars.sa create: error count /= Msg_Count.\n"; OUT::flush; SYS_ERROR::blind_error(me,culture.resource_path.str,me) end ; me.misc_chars := ARRAY{CHAR_CODE}::create(count) ; loop -- one character strings! index : CARD := 0.upto!(count - 1) ; me.misc_chars[index] := CHAR_CODE::raw_build(loc_cursor,me) end ; -- Second the code strings used by the OS to signify various file modes. me.get_file_modes(loc_cursor) ; -- Finally the OS specific file name syntax tokens. me.get_path_tokens(loc_cursor) ; --assert me.my_size=me.culture.kind.size; return me end ; dummy_lib( kind : CODE_KINDS ) : SAME pre ~void(kind) -- and ~void(self) post ~void(result) is -- This routine is provided for use solely when carrying out code mapping -- and there is a need for a libchars value for size and combining tests, etc. -- It should always be used as a restricted local variable or private -- attribute - never being persistent. --#OUT+"dummy_lib 1\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; me : SAME := new ; if ~REP_LIB_LIST::insert(me) then -- put into the global list! #OUT+"lichars.sa dummy_lib: SYS_EXPT::RANGE_Error.\n"; OUT::flush; SYS_ERROR::create.error(self,SYS_EXCEPT::Range_Error,kind.str) end ; --#OUT+"dummy_lib 2\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; tmp:SAME:=default; --#OUT+"dummy_lib 2.1\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; --#OUT+"dummy_lib 2.2\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; me.culture := tmp.culture.copy; --tmp.culture; --#OUT+"dummy_lib 2.3\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; me.culture.init_kind(kind); -- test --#OUT+"dummy_lib 2.4\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; me.misc_chars := tmp.misc_chars ; --#OUT+"dummy_lib 3\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; me.file_modes := tmp.file_modes ; me.path_tokens := tmp.path_tokens ; --#OUT+"dummy_lib 4\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; me.my_size := kind.size ; --#OUT+"dummy_lib 5\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; me.has_combining := (kind = CODE_KINDS::Unicode) or (kind = CODE_KINDS::UCS2) or (kind = CODE_KINDS::UCS4) ; --if ~REP_LIB_LIST::insert(me) then -- put into the global list! --SYS_ERROR::create.error(self,SYS_EXCEPT::Range_Error,kind.str) --end ; --#OUT+"dummy_lib 6\n"; REP_LIB_LIST::inspect; assert REP_LIB_LIST::check; --assert me.my_size=me.culture.kind.size; --REP_LIB_LIST::inspect; --assert REP_LIB_LIST::check; return me end ; default : SAME is -- This routine returns a default object - which may involve retrieving -- data from the Operating System current culture specifications. if void(priv_default) then -- culture not built either! loc_culture : CULTURE := CULTURE::default ; -- build it and set default! res : SAME := loc_culture.sather_lib ; if void(res) then -- Oops! partly built! return REP_LIB_LIST::lib_list[0] else return res end end ; return priv_default end ; private init : SAME is -- This routine returns the current object or default if self is void. if void(self) then return default else return self end end ; is_eq( other : SAME ) : BOOL is -- This predicate is provided to enable comparison for equality to -- affect the action taken as needed. if true then return SYS::ob_eq(self,other) elsif SYS::ob_eq(self,other) then return true; elsif void(self) and void(other) then return true; elsif void(self) or void(other) then return false; else return (culture=other.culture) --and(misc_chars=other.misc_chars) --and(file_modes=other.file_modes) --and(path_tokens=other.path_tokens) and(my_size=other.my_size) and(has_combining=other.has_combining); end; end ; -- The remaining routines in this class merely return -- character/string values as determined by the culture. Ampersand : CHAR_CODE is return init.misc_chars[ampersand] end ; Apostrophe : CHAR_CODE is return init.misc_chars[apostrophe] end ; Asterisk : CHAR_CODE is return init.misc_chars[asterisk] end ; At : CHAR_CODE is return init.misc_chars[commercial_at] end ; Caret : CHAR_CODE is return init.misc_chars[caret] end ; Code_Point : CHAR_CODE is return init.misc_chars[unicode_mark] end ; Colon : CHAR_CODE is return init.misc_chars[colon] end ; Comma : CHAR_CODE is return init.misc_chars[comma] end ; Component_Separator : CODE_STR is return init.path_tokens[component_sep] end ; Currency_Symbol : CHAR_CODE is return init.culture.currency.local.currency_symbol[0] end ; Decimal_Mark : CHAR_CODE is return init.culture.numeric.format.decimal_mark end ; Decimal_Prefix : CHAR_CODE is return init.misc_chars[decimal_prefix] end ; Dollar : CHAR_CODE is return init.misc_chars[dollar] end ; Equal_Mark : CHAR_CODE is return init.misc_chars[equals] end ; Escape : CHAR_CODE is return init.misc_chars[escape] end ; Exclamation : CHAR_CODE is return init.misc_chars[exclaim] end ; Exponent_Mark : CHAR_CODE is return init.misc_chars[exponent] end ; Filler : CHAR_CODE is return init.misc_chars[fmt_filler] end ; Fullstop : CHAR_CODE is return init.misc_chars[fullstop] end ; Grave_Accent : CHAR_CODE is return init.misc_chars[grave] end ; Hex_Prefix : CHAR_CODE is return init.misc_chars[hex_prefix] end ; Hyphen : CHAR_CODE is return init.misc_chars[minus_sign] end ; Justify : CHAR_CODE is return init.misc_chars[caret] end ; Kind_Separator : CODE_STR is return init.path_tokens[kind_sep] end ; Left_Angle : CHAR_CODE is return init.misc_chars[left_angle] end ; Left_Brace : CHAR_CODE is return init.misc_chars[left_brace] end ; Left_Bracket : CHAR_CODE is return init.misc_chars[left_bracket] end ; Left_Parenthesis : CHAR_CODE is return init.misc_chars[left_paren] end ; Line_Mark : CODE_STR is -- The result of this routine is operating system dependent. me : SAME := init ; res : CODE_STR := CODE_STR::create(me.misc_chars[lmark_one]) ; if me.misc_chars[lmark_two] /= Null then res := res + me.misc_chars[lmark_two] end ; return res end ; Low_Line : CHAR_CODE is return init.misc_chars[low_line] end ; Minus_Sign : CHAR_CODE is return init.misc_chars[minus_sign] end ; Null : CHAR_CODE is return CHAR_CODE::create(CONTROL_CODES::NUL.card,self) end ; Number_Ignore : CHAR_CODE is return init.culture.numeric.format.thousands_sep end ; Number_Sign : CHAR_CODE is return init.misc_chars[num_sign] end ; Octal_Prefix : CHAR_CODE is return init.misc_chars[octal_prefix] end ; Parent_Name : CODE_STR is return init.path_tokens[parent_name] end ; Percent : CHAR_CODE is return init.misc_chars[percent] end ; Plus_Sign : CHAR_CODE is return init.misc_chars[plus_sign] end ; Question_Mark : CHAR_CODE is return init.misc_chars[question_mark] end ; Quotation_Mark : CHAR_CODE is return init.misc_chars[quote_mark] end ; Reverse_Solidus : CHAR_CODE is return init.misc_chars[rev_solidus] end ; Right_Angle : CHAR_CODE is return init.misc_chars[right_angle] end ; Right_Brace : CHAR_CODE is return init.misc_chars[right_brace] end ; Right_Bracket : CHAR_CODE is return init.misc_chars[right_bracket] end ; Right_Parenthesis : CHAR_CODE is return init.misc_chars[right_paren] end ; Root_Name : CODE_STR is return init.path_tokens[root_name] end ; Root_Separator : CODE_STR is return init.path_tokens[root_sep] end ; Search_Separator : CODE_STR is return init.path_tokens[search_sep] end ; Self_Name : CODE_STR is return init.path_tokens[self_name] end ; Semicolon : CHAR_CODE is return init.misc_chars[semicolon] end ; Solidus : CHAR_CODE is return init.misc_chars[solidus] end ; Space : CHAR_CODE is return init.misc_chars[space] end ; System_Separator : CODE_STR is return init.path_tokens[system_sep] end ; Tilde : CHAR_CODE is return init.misc_chars[tilde] end ; Vline : CHAR_CODE is return init.misc_chars[vert_line] end ; private code_card( ch : CHAR_CODE, chclass : CHAR_CLASS ) : CARD is -- This private routine returns the value of the cardinal number -- corresponding in the given class to the digit signified by the given -- character code. rngs : FLIST{RANGE} := (init.culture.char_data.classes).get(chclass).ranges ; base : CARD := 0 ; loop rng : RANGE := rngs.elt! ; if rng.contains(ch.card) then return base + ch.card - rng.low elsif chclass = CHAR_CLASS::Hex_Digit then base := 10 end end ; return CARD::nil end ; card( ch : CHAR ) : CARD is -- This routine returns the value of the cardinal number corresponding to -- the given character. return code_card(ch.code,CHAR_CLASS::Digit) end ; private digit_code( val : CARD, chclass : CHAR_CLASS ) : CHAR_CODE is -- This private routine returns the character code in this culture -- which is used to represent the given digit value. If the digit given is -- out of range then CHAR_CODE::invalid is returned. rngs : FLIST{RANGE} := (init.culture.char_data.classes).get(chclass).ranges ; loc_range : RANGE := rngs[0] ; -- arbitrary default if val < 10 then return CHAR_CODE::create((rngs[0].low + val),self) elsif chclass = CHAR_CLASS::Hex_Digit then return CHAR_CODE::create((rngs[1].low + val - 10),self) else return CHAR_CODE::invalid end end ; digit( val : CARD ) : CHAR_CODE pre (val < 10) post true is -- This routine returns the character representation of the given -- digit value if it is within range, otherwise void. return digit_code(val,CHAR_CLASS::Digit) end ; alt_digits : CARD is -- This routine returns the number of digits provided in the alternate set. return init.culture.numeric.digits.size end ; oct_card( ch : CHAR ) : CARD is -- This routine returns the value of the cardinal number corresponding to -- the given character. res : CARD := code_card(ch.code,CHAR_CLASS::Digit) ; if res < OCTET::Octet_Bits then return res else return CARD::nil end end ; oct_digit( val : CARD ) : CHAR_CODE pre (val < OCTET::Octet_Bits) post true is -- This routine returns the character representation of the given -- digit value if it is within range, otherwise void. return digit_code(val,CHAR_CLASS::Digit) end ; hex_card( ch : CHAR ) : CARD is -- This routine returns the value of the cardinal number corresponding to -- the given character. res : CARD := code_card(ch.code,CHAR_CLASS::Hex_Digit) ; if res < 16 then return res else return CARD::nil end end ; hex_digit( val : CARD ) : CHAR_CODE is -- This routine returns the character corresponding to the given -- digit value if it is within range, otherwise void. return digit_code(val,CHAR_CLASS::Hex_Digit) end ; alt_card( str : STR ) : CARD is -- This routine returns the value of the cardinal number corresponding to -- the given string which is expected to be an alternate digit string res : ALT_DIGITS := init.culture.numeric.digits ; if void(res) then return CARD::nil end ; loc_codes : CODE_STR := CODE_STR::create(str.index_lib) ; loop index : CARD := 0.upto!(str.size - 1) ; loc_codes := loc_codes + str.code! end ; return res.card(loc_codes) end ; alt_digit( val : CARD) : STR is -- This routine returns the character representation of the given -- digit value if it is within range, otherwise void. res : ALT_DIGITS := init.culture.numeric.digits ; if void(res) then return void elsif val < res.size then return res[val].tgt_str else return void end end ; end ; -- LIBCHARS