Index: src/natools-s_expressions-templates-generic_integers.adb ================================================================== --- src/natools-s_expressions-templates-generic_integers.adb +++ src/natools-s_expressions-templates-generic_integers.adb @@ -30,10 +30,16 @@ procedure Insert_Image (State : in out Format; Context : in Meaningless_Type; Image : in Atom); + procedure Update_Image + (State : in out Format; + Context : in Meaningless_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class); + procedure Update_Format (State : in out Format; Context : in Meaningless_Type; Name : in Atom; Arguments : in out Lockable.Descriptor'Class); @@ -51,10 +57,39 @@ pragma Unreferenced (Context); begin State.Append_Image (Image); end Insert_Image; + + procedure Update_Image + (State : in out Format; + Context : in Meaningless_Type; + Name : in Atom; + Arguments : in out Lockable.Descriptor'Class) + is + pragma Unreferenced (Context); + Value : T; + begin + begin + Value := T'Value (To_String (Name)); + exception + when Constraint_Error => + return; + end; + + case Arguments.Current_Event is + when Events.Add_Atom => + State.Set_Image (Value, Arguments.Current_Atom); + when others => + State.Remove_Image (Value); + end case; + end Update_Image; + + + procedure Image_Interpreter is new Interpreter_Loop + (Format, Meaningless_Type, Update_Image, Insert_Image); + procedure Update_Format (State : in out Format; Context : in Meaningless_Type; Name : in Atom; @@ -98,11 +133,11 @@ when Commands.Base => State.Set_Symbols (Arguments); when Commands.Images => - Parse (State.Images, Arguments); + Image_Interpreter (Arguments, State, Meaningless_Value); when Commands.Padding => case Arguments.Current_Event is when Events.Add_Atom => State.Left_Padding := Create (Arguments.Current_Atom); @@ -370,11 +405,14 @@ (Map : in out Atom_Maps.Map; Values : in Interval; Image : in Atom_Refs.Immutable_Reference) is begin Exclude (Map, Values); - Map.Insert (Values, Image); + + if not Image.Is_Empty then + Map.Insert (Values, Image); + end if; end Include; procedure Parse (Map : in out Atom_Maps.Map; @@ -384,25 +422,21 @@ Lock : Lockable.Lock_State; begin loop case Event is when Events.Add_Atom => - declare - Index : constant T := Next_Index (Map); - begin - Include - (Map, - (Index, Index), - Create (Expression.Current_Atom)); - end; + Include + (Map, + (T'First, T'Last), + Create (Expression.Current_Atom)); when Events.Open_List => Expression.Lock (Lock); begin Expression.Next; - Parse_Single_Image (Map, Expression); + Parse_Single_Affix (Map, Expression); exception when others => Expression.Unlock (Lock, False); raise; end; @@ -418,74 +452,99 @@ Expression.Next (Event); end loop; end Parse; - procedure Parse_Single_Image + procedure Parse_Single_Affix (Map : in out Atom_Maps.Map; Expression : in out Lockable.Descriptor'Class) is + function Read_Interval (Exp : in out Descriptor'Class) return Interval; + + function Read_Interval (Exp : in out Descriptor'Class) return Interval is + Event : Events.Event; + First, Last : T; + begin + Exp.Next (Event); + + case Event is + when Events.Add_Atom => + First := T'Value (To_String (Exp.Current_Atom)); + + when others => + raise Constraint_Error with "Lower bound not an atom"; + end case; + + Exp.Next (Event); + + case Event is + when Events.Add_Atom => + Last := T'Value (To_String (Exp.Current_Atom)); + + when others => + raise Constraint_Error with "Upper bound not an atom"; + end case; + + if Last < First then + raise Constraint_Error with "Invalid interval (Last < First)"; + end if; + + return (First, Last); + end Read_Interval; + Event : Events.Event := Expression.Current_Event; Lock : Lockable.Lock_State; - First, Last : T; + Affix : Atom_Refs.Immutable_Reference; begin case Event is when Events.Add_Atom => - begin - First := T'Value (To_String (Expression.Current_Atom)); - Last := First; - exception - when Constraint_Error => - return; - end; - - when Events.Open_List => - Expression.Lock (Lock); - - begin - Expression.Next (Event); - if Event = Events.Add_Atom then - First := T'Value (To_String (Expression.Current_Atom)); - else - Expression.Unlock (Lock, False); - return; - end if; - - Expression.Next (Event); - if Event = Events.Add_Atom then - Last := T'Value (To_String (Expression.Current_Atom)); - else - Expression.Unlock (Lock, False); - return; - end if; - exception - when Constraint_Error => - Expression.Unlock (Lock, False); - return; - when others => - Expression.Unlock (Lock, False); - raise; - end; - - Expression.Unlock (Lock); + declare + Current : constant Atom := Expression.Current_Atom; + begin + if Current'Length > 0 then + Affix := Create (Current); + end if; + end; when others => return; end case; - if Last < First then - return; - end if; - - Expression.Next (Event); - - if Event = Events.Add_Atom then - Include (Map, (First, Last), Create (Expression.Current_Atom)); - else - Exclude (Map, (First, Last)); - end if; - end Parse_Single_Image; + loop + Expression.Next (Event); + + case Event is + when Events.Add_Atom => + declare + Value : T; + begin + Value := T'Value (To_String (Expression.Current_Atom)); + Include (Map, (Value, Value), Affix); + exception + when Constraint_Error => null; + end; + + when Events.Open_List => + Expression.Lock (Lock); + + begin + Include (Map, Read_Interval (Expression), Affix); + exception + when Constraint_Error => + null; + when others => + Expression.Unlock (Lock, False); + raise; + end; + + Expression.Unlock (Lock); + + when others => + exit; + end case; + end loop; + end Parse_Single_Affix; ---------------------- -- Public Interface -- @@ -830,15 +889,11 @@ procedure Set_Prefix (Object : in out Format; Values : in Interval; Prefix : in Atom_Refs.Immutable_Reference) is begin - if Prefix.Is_Empty then - Exclude (Object.Prefix, Values); - else - Include (Object.Prefix, Values, Prefix); - end if; + Include (Object.Prefix, Values, Prefix); end Set_Prefix; procedure Set_Prefix (Object : in out Format; @@ -886,15 +941,11 @@ procedure Set_Suffix (Object : in out Format; Values : in Interval; Suffix : in Atom_Refs.Immutable_Reference) is begin - if Suffix.Is_Empty then - Exclude (Object.Suffix, Values); - else - Include (Object.Suffix, Values, Suffix); - end if; + Include (Object.Suffix, Values, Suffix); end Set_Suffix; procedure Set_Suffix (Object : in out Format; Index: src/natools-s_expressions-templates-generic_integers.ads ================================================================== --- src/natools-s_expressions-templates-generic_integers.ads +++ src/natools-s_expressions-templates-generic_integers.ads @@ -24,14 +24,14 @@ -- (image (0 "symbol 0") (2 "symbol 2") ...) -- -- (max-width "max width" ["overflow text"]) -- -- (min-width "min width") -- -- (padding "left-symbol" "right-symbol") -- -- (padding "symbol") -- --- (prefix (0 "prefix 0") (2 "prefix 2") ...) -- +-- (prefix ("prefix" 0 (10 20) ...) ("prefix" 2) ...) -- -- (right-padding "symbol") -- -- (sign "plus sign" ["minus sign"]) -- --- (suffix (0 "suffix 0") (2 "suffix 2") ...) -- +-- (suffix ("suffix" 0 (10 20) ...) ("suffix" 2) ...) -- -- (width "fixed width") -- -- (width "min width" "max width" ["overflow text"]) -- -- Top-level atoms are taken as the image for the next number. -- ------------------------------------------------------------------------------ @@ -135,22 +135,23 @@ procedure Include (Map : in out Atom_Maps.Map; Values : in Interval; Image : in Atom_Refs.Immutable_Reference); - -- Add Image to the given interval, overwriting any existing values + -- Add Image to the given interval, overwriting any existing values. + -- If Image is empty, behave like Exclude. - procedure Parse_Single_Image + procedure Parse_Single_Affix (Map : in out Atom_Maps.Map; Expression : in out Lockable.Descriptor'Class); - -- Parse Expression to match `value image` or `(first last) image`, - -- and include it to Map. + -- Parse Expression as an affix atom, followed by single numbers (atoms) + -- or ranges (lists of two atoms). procedure Parse (Map : in out Atom_Maps.Map; Expression : in out Lockable.Descriptor'Class); - -- Parse Expression as a list of single image expression (see above) + -- Parse Expression as a list of single image expressions (see above) --------------------- -- Format Mutators -- ---------------------