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