Natools

   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);

      Image : in Atom)
   is
      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;
      Arguments : in out Lockable.Descriptor'Class)
   is

         when Commands.Align_Right =>
            State.Set_Align (Right_Aligned);

         when Commands.Base =>
            State.Set_Symbols (Arguments);

         when Commands.Images =>
            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);
                  State.Right_Padding := State.Left_Padding;
               when others =>

   procedure Include
     (Map : in out Atom_Maps.Map;
      Values : in Interval;
      Image : in Atom_Refs.Immutable_Reference) is
   begin
      Exclude (Map, Values);

      if not Image.Is_Empty then
         Map.Insert (Values, Image);
      end if;
   end Include;


   procedure Parse
     (Map : in out Atom_Maps.Map;
      Expression : in out Lockable.Descriptor'Class)
   is
      Event : Events.Event := Expression.Current_Event;
      Lock : Lockable.Lock_State;
   begin
      loop
         case Event is
            when Events.Add_Atom =>



               Include
                 (Map,
                  (T'First, T'Last),
                  Create (Expression.Current_Atom));


            when Events.Open_List =>
               Expression.Lock (Lock);

               begin
                  Expression.Next;
                  Parse_Single_Affix (Map, Expression);
               exception
                  when others =>
                     Expression.Unlock (Lock, False);
                     raise;
               end;

               Expression.Unlock (Lock);
               Event := Expression.Current_Event;
               exit when Event in Events.Error | Events.End_Of_Input;

            when Events.Close_List | Events.Error | Events.End_Of_Input =>
               exit;
         end case;

         Expression.Next (Event);
      end loop;
   end Parse;


   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;
      Affix : Atom_Refs.Immutable_Reference;
   begin
      case Event is
         when Events.Add_Atom =>







            declare


               Current : constant Atom := Expression.Current_Atom;
            begin


               if Current'Length > 0 then




                  Affix := Create (Current);






               end if;







            end;



         when others =>
            return;
      end case;

      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 --
   ----------------------

   procedure Set_Prefix
     (Object : in out Format;
      Values : in Interval;
      Prefix : in Atom_Refs.Immutable_Reference) is
   begin



      Include (Object.Prefix, Values, Prefix);

   end Set_Prefix;


   procedure Set_Prefix
     (Object : in out Format;
      Values : in Interval;
      Prefix : in Atom) is

   procedure Set_Suffix
     (Object : in out Format;
      Values : in Interval;
      Suffix : in Atom_Refs.Immutable_Reference) is
   begin



      Include (Object.Suffix, Values, Suffix);

   end Set_Suffix;


   procedure Set_Suffix
     (Object : in out Format;
      Values : in Interval;
      Suffix : in Atom) is

--   (base "symbol 0" "symbol 1" "symbol 2" ...)                            --
--   (left-padding "symbol")                                                --
--   (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) ...)                     --
--   (right-padding "symbol")                                               --
--   (sign "plus sign" ["minus sign"])                                      --
--   (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.              --
------------------------------------------------------------------------------

with Ada.Containers.Ordered_Maps;
with Ada.Streams;

      Values : in Interval);
      --  Remove the given interval from the map

   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.
      --  If Image is empty, behave like Exclude.

   procedure Parse_Single_Affix
     (Map : in out Atom_Maps.Map;
      Expression : in out Lockable.Descriptor'Class);
      --  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 expressions (see above)

   ---------------------
   -- Format Mutators --
   ---------------------

   procedure Set_Align (Object : in out Format; Value : in Alignment);