format.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 FMT

class FMT is -- This class implements formatting of text output for all cultural environments. -- -- This class provides an ability to create an object which then -- immediately transforms the values and descriptions into a textual -- representation. The first argument of format creation is expected to be -- a descriptor of a sentence/clause as a format string. In this string all -- pairs of angle brackets '<' and '>' are considered to be the description -- of the form in which some value is to be rendered; as such they are passed -- in the form of a descriptor to the corresponding object to format itself! -- Note that the 'escape' character in a Sather format string is the percent -- symbol (see examples below). -- -- General Format Syntax -- --------------------- -- The syntax of a clause describing format string must conform to -- the following :-- -- fmt-expr -> "<" [selector] [options] pad-expr [options] ">" -- selector -> positive integer ":" -- pad-expr -> [sign] padding [prec-pad] | anchor-pad -- anchor-pad -> [filling] padding -- filling -> "F" followed by any single character. -- sign -> "+" or "-". -- padding -> hash-chars [justify hash-chars] -- justify -> "^" -- the anchor position for justify -- hash_chars -> arbitrary number of "#". -- prec-pad -> "." followed by an arbitrary number of "#". -- -- Restrictions -- ------------ -- The following general restrictions on the use of this class are :-- -- -- a. Exponents are possible and considered as an option 'e' to -- floating point numbers. -- -- b. Options can be used by user defined classes to feature special -- print formats. User defined options should always start with a lower -- case letter. -- -- c. Only numbers can have precisions. -- -- d. Fill characters are not (yet) allowed with numbers. -- -- e. Precision and anchors cannot be used together. -- -- Examples -- -------- -- In the examples below spaces in the output string are indicated by -- a low line for clarity only. -- FMT::create("<> + <> %> <###>",1,2,0) returns "1_+_2_>___0" -- FMT::create("<+###.##>",3.14159) returns "__+3.14" -- FMT::create("<##.##e##>",3.14159) returns "_3.14e00" -- FMT::create("<^#####>","left") returns "left__" -- FMT::create("<F*###^###>",false) returns "*false*" -- -- NOTE 1. Hash-chars indicate padding only if the value field when -- represented contains fewer characters than that indicated by -- the number of hash/anchor, etc chars. -- -- 2. Note that any numeric (or other) value rounding due to precision -- limitations is defined by the class which is being represented, -- NOT by the formatting classes. -- -- 3. The presence of a filling specification does NOT occupy any -- character positions in the formatted string representaton. -- Version 1.3 Sep 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 25 Jul 96 bg/hk Original for Sather 1.1 distribution -- 2 May 97 kh Modified for portability -- 17 Dec 97 kh Commented out C-style stuff because of -- inlined_C restriction -- 17 Sep 98 kh Now an interim class for formatting readonly attr str : STR ; -- the result of formatting! private const -- internal state enumeration Dummy, Normal_State, Percent_State, Format_State, Escape_State ; private const -- Messages indices Illegal_Arg_No, Wrong_Type, Impossible_Happened, Unexpected_End, Decimal_First, Already_Anchored, Unexpected_Sign, Unexpected_Caret, Unexpected_Decimal, Unknown_Char, Filler_Already, Escapes_at_End ; private const Msg_Count : CARD := Escapes_at_End + 1 ; private shared Messages : ARRAY{STR} ; private shared report : REPORTER ; private init(lib : LIBCHARS) is -- This routine sets up the shared elements of the formatting if not already set up. if void(Messages) then Messages := lib.culture.resources.read(SYS::rune_name(self),Msg_Count) ; report := REPORTER::create(Messages) end end ; create(format_string : STR,list : ARRAY{$FMT},lib : LIBCHARS) : SAME pre (format_string.size > 0) and ~void(list) and ~void(lib) post true is --This routine creates a new format object as a result of parsing the -- format string with the given list of objects to be formatted using the -- library and culture specified by lib. me : SAME := new ; me.str := format_string ; -- Just in case of exception me.init(lib) ; me := me.parse(format_string,list,lib) ; return me end ; create(format_string : STR,list : ARRAY{$FMT}) : SAME pre (format_string.size > 0) and ~void(list) post true is -- This routine creates a new format object as a result of parsing the -- format string with the given list of objects to be formatted, using the -- default library and culture. return create(format_string,list,LIBCHARS::default) end ; create(format_string : STR,val : $FMT,lib : LIBCHARS) : SAME pre (format_string.size > 0) and ~void(val) and ~void(lib) post true is -- This routine is a convenience for format strings which take a single argument. return create(format_string,ARRAY{$FMT}::create(| val |),lib) end ; create(format_string : STR, val : $FMT) : SAME pre (format_string.size > 0) and ~void(val) post true is -- This routine is a convenience for format strings which take a single -- argument, using the default library and culture.. return create(format_string,ARRAY{$FMT}::create(| val |),LIBCHARS::default) end ; create(format_string : STR,val_1 : $FMT,val_2 : $FMT,lib : LIBCHARS) : SAME pre (format_string.size > 0) and ~void(val_1) and ~void(val_2) and ~void(lib) post true is --This routine is a convenience for format strings which take two arguments. return create(format_string, ARRAY{$FMT}::create(| val_1,val_2 |),lib) end ; create(format_string : STR, val_1 : $FMT, val_2 : $FMT) : SAME -- pre (format_string.size > 0) and ~void(val_1) and ~void(val_2) post true is -- This routine is a convenience for format strings which take two arguments. if ~(format_string.size > 0) then raise "arg string is too short.\n"; end; if void(val_1) then #OUT+"format.sa create:"+format_string+"\n"; raise "arg format 1 is void.\n"; end; if void(val_2) then raise "arg format 2 is void.\n"; end; return create(format_string,ARRAY{$FMT}::create(| val_1,val_2 |),LIBCHARS::default) end ; private descriptor_scan(str : STR, lib : LIBCHARS) : $VAL_DESCR pre (str.size > 0) and ~void(lib) post (report.error_free and ~void(result)) or void(result) is --This private routine attempts to create a value layout descriptor -- from the given string argument, using the lib argument to define the -- necessary components. loc_cursor : STR_CURSOR := str.cursor ; first : CARD := 0 ; second : CARD := 0 ; exp_size : CARD := 0 ; -- fill : CHAR_CODE := lib.Null ; force_val : BOOL := false ; force_exp : BOOL := false ; escaped : BOOL := false ; -- phase : CARD := 1 ; anchored : BOOL := false ; -- report.non_fatal ; report.clear_errors ; -- loop if loc_cursor.is_done then break! end ; chcode : CHAR_CODE := loc_cursor.get_item.code ; if ~escaped then if chcode = lib.Exponent_Mark then if phase < 2 then report.error(Decimal_First,str) elsif anchored then report.error(Already_Anchored,str) else phase := 3 end elsif chcode = lib.Minus_Sign then if phase = 1 then first := first + 1 elsif phase = 3 then exp_size := exp_size + 1 else report.error(Unexpected_Sign,str) end elsif chcode = lib.Plus_Sign then if phase = 1 then force_val := true ; first := first + 1 elsif phase = 3 then force_exp := true else report.error(Unexpected_Sign,str) end elsif chcode = lib.Number_Sign then case phase when 1 then first := first + 1 when 2 then second := second + 1 when 3 then exp_size := exp_size + 1 else report.error(Impossible_Happened) end elsif chcode = lib.Caret then if phase = 1 then phase := 2 ; anchored := true else report.error(Unexpected_Caret,str) end elsif chcode = lib.Decimal_Mark then if phase = 1 then phase := 2 else report.error(Unexpected_Decimal,str) end else if chcode = lib.Filler then escaped := true else report.error(Unknown_Char,chcode.str)
end end else escaped := false ; if (fill = lib.Null) then fill := chcode else report.error(Filler_Already, str) end end end ; if escaped then report.error(Escapes_at_End,str) end ; report.fatal ; if ~report.error_free then return void end ; if (fill = lib.Null) then fill := lib.Space end ; if anchored then return ANCHORED_DESCR::create(fill,first,second) elsif phase = 3 then return FLT_DESCR::create(fill,first,second, exp_size,force_val,force_exp) elsif phase = 2 then return FIXED_DESCR::create(fill,first,second,force_val) else return EXACT_DESCR::create(fill,first,force_val) end end ; private do_fmt(object : $FMT,fmt : STR,lib : LIBCHARS) : STR pre ~void(object) and ~void(lib) post (result.size > 0) is --This routine attempts to create a descriptor for the formatting and, -- provided the object and descriptor format match then calls the object's -- fmt routine. If the parameter is empty then the descriptor is set to void. loc_descr : $VAL_DESCR := void ; if fmt.size > 0 then loc_descr := descriptor_scan(fmt,lib) end ; typecase loc_descr when EXACT_DESCR then typecase object when $EXACT_FMT then loc_exact : EXACT_DESCR := loc_descr ; return object.fmt(loc_exact,lib) else report.error(Wrong_Type,fmt) end when FIXED_DESCR then typecase object when $FIXED_FMT then loc_fixed : FIXED_DESCR := loc_descr ; return object.fmt(loc_fixed,lib) else report.error(Wrong_Type,fmt) end when FLT_DESCR then typecase object when $FLT_FMT then loc_flt : FLT_DESCR := loc_descr ; return object.fmt(loc_flt,lib) else report.error(Wrong_Type,fmt) end when ANCHORED_DESCR then typecase object when $ANCHORED_FMT then loc_anch : ANCHORED_DESCR := loc_descr ; return object.fmt(loc_anch,lib) else report.error(Wrong_Type,fmt) end else if void(loc_descr) then -- so just a simple string return object.str(lib) end end ; return void end ; private render(fmt_string : STR,args : ARRAY{$FMT},inout argnum : CARD,lib : LIBCHARS) : STR pre (argnum < args.size) and ~void(lib) post (result.size > 0) is --This routine processes one format expression, returning the string -- representation of the 'next' object. size : CARD := fmt_string.size ; fmt_index : CARD := 0 ; num : CARD := 0 ; is_position : BOOL := false ; loop until!(fmt_index >= size) ; next : CHAR := fmt_string[fmt_index] ; if next.code = lib.Colon then -- the index of the argument! is_position := true ; break! end ; until!(~next.is_digit) ; -- pick up a digit if not num := num * 10 + lib.card(next) ; fmt_index := fmt_index + 1 end ; if is_position then fmt_string := fmt_string.substring(fmt_index + 1,size - fmt_index - 1) ; num := num - 1 else num := argnum end ; if num >= args.size then report.error(Illegal_Arg_No,num.str) end ; argnum := num + 1 ; return do_fmt(args[num],fmt_string,lib) end ; private parse(fmt_string : STR,args : ARRAY{$FMT},lib : LIBCHARS) : SAME pre (fmt_string.size > 0) and ~void(args) and ~void(lib) post true is --This routine is the 'core' of the class which assembles the resultant -- string from the string descriptor and the list of values to be emitted. size : CARD := fmt_string.size ; fmt : STR := STR::create ; loc_str : STR := STR::create ; state : CARD := Normal_State ; -- initial assumption. pos : CARD := 0 ; current_arg : CARD := 0 ; next : CHAR_CODE ; loop until!(pos >= size) ; next := fmt_string[pos].code ; pos := pos + 1 ; -- for next pass through loop! case state when Normal_State then if next = lib.Percent then state := Percent_State elsif next = lib.Left_Angle then state := Format_State else loc_str := loc_str + next.char end when Percent_State then assert fmt = STR::create ; if (next = lib.Percent) or (next = lib.Left_Angle) or (next = lib.Right_Angle) then loc_str := loc_str + next.char ; state := Normal_State else fmt := STR::create + lib.Percent.char + next.char end when Format_State then if next = lib.Percent then state := Escape_State elsif next = lib.Right_Angle then loc_str := loc_str + render(fmt,args,inout current_arg,lib) ; state := Normal_State ; fmt := STR::create ; else fmt := fmt + next.char end when Escape_State then fmt := fmt + next.char ; state := Format_State else report.error(Impossible_Happened,state.str) end end ; if state = Normal_State then str := loc_str else report.error(Unexpected_End,fmt_string) end ; return self end ; end ; -- FMT