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 @@ -363,11 +363,11 @@ if Atom_Maps.Key (Cursor).First < Values.First then declare Old_Key : constant Interval := Atom_Maps.Key (Cursor); Prefix_Key : constant Interval := (Old_Key.First, T'Pred (Values.First)); - Prefix_Image : constant Atom_Refs.Immutable_Reference + Prefix_Image : constant Displayed_Atom := Atom_Maps.Element (Cursor); begin Delete_And_Next (Map, Cursor); Map.Insert (Prefix_Key, Prefix_Image); @@ -389,11 +389,11 @@ then declare Old_Key : constant Interval := Atom_Maps.Key (Cursor); Suffix_Key : constant Interval := (T'Succ (Values.Last), Old_Key.Last); - Suffix_Image : constant Atom_Refs.Immutable_Reference + Suffix_Image : constant Displayed_Atom := Atom_Maps.Element (Cursor); begin Delete_And_Next (Map, Cursor); Map.Insert (Suffix_Key, Suffix_Image); end; @@ -402,16 +402,17 @@ procedure Include (Map : in out Atom_Maps.Map; Values : in Interval; - Image : in Atom_Refs.Immutable_Reference) is + Image : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width) is begin Exclude (Map, Values); if not Image.Is_Empty then - Map.Insert (Values, Image); + Map.Insert (Values, (Image, Width)); end if; end Include; procedure Parse @@ -422,14 +423,19 @@ Lock : Lockable.Lock_State; begin loop case Event is when Events.Add_Atom => - Include - (Map, - (T'First, T'Last), - Create (Expression.Current_Atom)); + declare + Image : constant Atom := Expression.Current_Atom; + begin + Include + (Map, + (T'First, T'Last), + Create (Image), + Image'Length); + end; when Events.Open_List => Expression.Lock (Lock); begin @@ -492,20 +498,52 @@ end Read_Interval; Event : Events.Event := Expression.Current_Event; Lock : Lockable.Lock_State; Affix : Atom_Refs.Immutable_Reference; + Affix_Width : Width := 0; begin case Event is when Events.Add_Atom => declare Current : constant Atom := Expression.Current_Atom; begin if Current'Length > 0 then Affix := Create (Current); + Affix_Width := Current'Length; + end if; + end; + + when Events.Open_List => + Expression.Lock (Lock); + + begin + Expression.Next (Event); + if Event /= Events.Add_Atom then + Expression.Unlock (Lock, False); + return; + end if; + + Affix := Create (Expression.Current_Atom); + Affix_Width := Affix.Query.Data.all'Length; + + Expression.Next (Event); + if Event = Events.Add_Atom then + begin + Affix_Width := Width'Value + (To_String (Expression.Current_Atom)); + exception + when Constraint_Error => null; + end; end if; + exception + when others => + Expression.Unlock (Lock, False); + raise; end; + + Expression.Unlock (Lock); when others => return; end case; @@ -516,20 +554,22 @@ when Events.Add_Atom => declare Value : T; begin Value := T'Value (To_String (Expression.Current_Atom)); - Include (Map, (Value, Value), Affix); + Include (Map, (Value, Value), Affix, Affix_Width); exception when Constraint_Error => null; end; when Events.Open_List => Expression.Lock (Lock); begin - Include (Map, Read_Interval (Expression), Affix); + Include + (Map, Read_Interval (Expression), + Affix, Affix_Width); exception when Constraint_Error => null; when others => Expression.Unlock (Lock, False); @@ -594,11 +634,11 @@ declare Cursor : constant Atom_Maps.Cursor := Template.Images.Find ((Value, Value)); begin if Atom_Maps.Has_Element (Cursor) then - return Atom_Maps.Element (Cursor).Query.Data.all; + return Atom_Maps.Element (Cursor).Image.Query.Data.all; end if; end Check_Explicit_Image; if Value < 0 then Reverse_Render (-Value, Symbols.Query.Data.all, Output, Length); @@ -621,11 +661,16 @@ declare Cursor : constant Atom_Maps.Cursor := Template.Prefix.Find ((Value, Value)); begin if Atom_Maps.Has_Element (Cursor) then - Output.Append_Reverse (Atom_Maps.Element (Cursor).Query.Data.all); + declare + Data : constant Displayed_Atom := Atom_Maps.Element (Cursor); + begin + Output.Append_Reverse (Data.Image.Query.Data.all); + Length := Length + Data.Width; + end; end if; end Add_Prefix; Output.Invert; @@ -633,11 +678,16 @@ declare Cursor : constant Atom_Maps.Cursor := Template.Suffix.Find ((Value, Value)); begin if Atom_Maps.Has_Element (Cursor) then - Output.Append (Atom_Maps.Element (Cursor).Query.Data.all); + declare + Data : constant Displayed_Atom := Atom_Maps.Element (Cursor); + begin + Output.Append (Data.Image.Query.Data.all); + Length := Length + Data.Width; + end; end if; end Add_Suffix; if Length > Template.Maximum_Width then return Safe_Atom (Template.Overflow_Message, ""); @@ -738,11 +788,11 @@ procedure Remove_Prefix (Object : in out Format; Values : in Interval) is begin - Set_Prefix (Object, Values, Atom_Refs.Null_Immutable_Reference); + Set_Prefix (Object, Values, Atom_Refs.Null_Immutable_Reference, 0); end Remove_Prefix; procedure Remove_Suffix (Object : in out Format; @@ -754,11 +804,11 @@ procedure Remove_Suffix (Object : in out Format; Values : in Interval) is begin - Set_Suffix (Object, Values, Atom_Refs.Null_Immutable_Reference); + Set_Suffix (Object, Values, Atom_Refs.Null_Immutable_Reference, 0); end Remove_Suffix; procedure Set_Align (Object : in out Format; Value : in Alignment) is begin @@ -769,11 +819,11 @@ procedure Set_Image (Object : in out Format; Value : in T; Image : in Atom_Refs.Immutable_Reference) is begin - Include (Object.Images, (Value, Value), Image); + Include (Object.Images, (Value, Value), Image, 0); end Set_Image; procedure Set_Image (Object : in out Format; @@ -869,40 +919,62 @@ procedure Set_Prefix (Object : in out Format; Value : in T; - Prefix : in Atom_Refs.Immutable_Reference) is + Prefix : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width) is begin - Set_Prefix (Object, (Value, Value), Prefix); + Set_Prefix (Object, (Value, Value), Prefix, Width); end Set_Prefix; procedure Set_Prefix (Object : in out Format; Value : in T; Prefix : in Atom) is begin - Set_Prefix (Object, Value, Create (Prefix)); + Set_Prefix (Object, Value, Prefix, Prefix'Length); + end Set_Prefix; + + + procedure Set_Prefix + (Object : in out Format; + Value : in T; + Prefix : in Atom; + Width : in Generic_Integers.Width) is + begin + Set_Prefix (Object, Value, Create (Prefix), Width); end Set_Prefix; procedure Set_Prefix (Object : in out Format; Values : in Interval; - Prefix : in Atom_Refs.Immutable_Reference) is + Prefix : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width) is begin - Include (Object.Prefix, Values, Prefix); + Include (Object.Prefix, Values, Prefix, Width); end Set_Prefix; procedure Set_Prefix (Object : in out Format; Values : in Interval; Prefix : in Atom) is begin - Set_Prefix (Object, Values, Create (Prefix)); + Set_Prefix (Object, Values, Prefix, Prefix'Length); + end Set_Prefix; + + + procedure Set_Prefix + (Object : in out Format; + Values : in Interval; + Prefix : in Atom; + Width : in Generic_Integers.Width) is + begin + Set_Prefix (Object, Values, Create (Prefix), Width); end Set_Prefix; procedure Set_Right_Padding (Object : in out Format; @@ -921,40 +993,62 @@ procedure Set_Suffix (Object : in out Format; Value : in T; - Suffix : in Atom_Refs.Immutable_Reference) is + Suffix : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width) is begin - Set_Suffix (Object, (Value, Value), Suffix); + Set_Suffix (Object, (Value, Value), Suffix, Width); end Set_Suffix; procedure Set_Suffix (Object : in out Format; Value : in T; Suffix : in Atom) is begin - Set_Suffix (Object, Value, Create (Suffix)); + Set_Suffix (Object, Value, Suffix, Suffix'Length); + end Set_Suffix; + + + procedure Set_Suffix + (Object : in out Format; + Value : in T; + Suffix : in Atom; + Width : in Generic_Integers.Width) is + begin + Set_Suffix (Object, Value, Create (Suffix), Width); end Set_Suffix; procedure Set_Suffix (Object : in out Format; Values : in Interval; - Suffix : in Atom_Refs.Immutable_Reference) is + Suffix : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width) is begin - Include (Object.Suffix, Values, Suffix); + Include (Object.Suffix, Values, Suffix, Width); end Set_Suffix; procedure Set_Suffix (Object : in out Format; Values : in Interval; Suffix : in Atom) is begin - Set_Suffix (Object, Values, Create (Suffix)); + Set_Suffix (Object, Values, Suffix, Suffix'Length); + end Set_Suffix; + + + procedure Set_Suffix + (Object : in out Format; + Values : in Interval; + Suffix : in Atom; + Width : in Generic_Integers.Width) is + begin + Set_Suffix (Object, Values, Create (Suffix), Width); end Set_Suffix; procedure Set_Symbols (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 ("prefix" 0 (10 20) ...) ("prefix" 2) ...) -- +-- (prefix ("prefix" 0 (10 20) ...) (("prefix" width) 2) ...) -- -- (right-padding "symbol") -- -- (sign "plus sign" ["minus sign"]) -- --- (suffix ("suffix" 0 (10 20) ...) ("suffix" 2) ...) -- +-- (suffix ("suffix" 0 (10 20) ...) (("suffix" width) 2) ...) -- -- (width "fixed width") -- -- (width "min width" "max width" ["overflow text"]) -- -- Top-level atoms are taken as the image for the next number. -- ------------------------------------------------------------------------------ @@ -118,13 +118,18 @@ with Dynamic_Predicate => not (Interval.Last < Interval.First); function "<" (Left, Right : Interval) return Boolean is (Left.Last < Right.First); -- Strict non-overlap comparison + + type Displayed_Atom is record + Image : Atom_Refs.Immutable_Reference; + Width : Generic_Integers.Width; + end record; package Atom_Maps is new Ada.Containers.Ordered_Maps - (Interval, Atom_Refs.Immutable_Reference, "<", Atom_Refs."="); + (Interval, Displayed_Atom, "<"); function Next_Index (Map : Atom_Maps.Map) return T is (if Map.Is_Empty then T'First else Map.Last_Key.Last + 1); -- Index of the next element to insert in sequential lists @@ -134,11 +139,12 @@ -- Remove the given interval from the map procedure Include (Map : in out Atom_Maps.Map; Values : in Interval; - Image : in Atom_Refs.Immutable_Reference); + Image : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width); -- Add Image to the given interval, overwriting any existing values. -- If Image is empty, behave like Exclude. procedure Parse_Single_Affix (Map : in out Atom_Maps.Map; @@ -209,26 +215,38 @@ (Object : in out Format; Value : in T); procedure Set_Prefix (Object : in out Format; Value : in T; - Prefix : in Atom_Refs.Immutable_Reference); + Prefix : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width); procedure Set_Prefix (Object : in out Format; Value : in T; Prefix : in Atom); + procedure Set_Prefix + (Object : in out Format; + Value : in T; + Prefix : in Atom; + Width : in Generic_Integers.Width); procedure Remove_Prefix (Object : in out Format; Values : in Interval); procedure Set_Prefix (Object : in out Format; Values : in Interval; - Prefix : in Atom_Refs.Immutable_Reference); + Prefix : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width); procedure Set_Prefix (Object : in out Format; Values : in Interval; Prefix : in Atom); + procedure Set_Prefix + (Object : in out Format; + Values : in Interval; + Prefix : in Atom; + Width : in Generic_Integers.Width); procedure Set_Right_Padding (Object : in out Format; Symbol : in Atom_Refs.Immutable_Reference); procedure Set_Right_Padding @@ -239,26 +257,38 @@ (Object : in out Format; Value : in T); procedure Set_Suffix (Object : in out Format; Value : in T; - Suffix : in Atom_Refs.Immutable_Reference); + Suffix : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width); procedure Set_Suffix (Object : in out Format; Value : in T; Suffix : in Atom); + procedure Set_Suffix + (Object : in out Format; + Value : in T; + Suffix : in Atom; + Width : in Generic_Integers.Width); procedure Remove_Suffix (Object : in out Format; Values : in Interval); procedure Set_Suffix (Object : in out Format; Values : in Interval; - Suffix : in Atom_Refs.Immutable_Reference); + Suffix : in Atom_Refs.Immutable_Reference; + Width : in Generic_Integers.Width); procedure Set_Suffix (Object : in out Format; Values : in Interval; Suffix : in Atom); + procedure Set_Suffix + (Object : in out Format; + Values : in Interval; + Suffix : in Atom; + Width : in Generic_Integers.Width); procedure Set_Symbols (Object : in out Format; Symbols : in Atom_Arrays.Immutable_Reference); procedure Set_Symbols