with Ada.Text_IO; -- Debug. with Ada.Unchecked_Deallocation, Ada.Strings.Fixed, Ada.Characters.Handling; package body ARM_Database is -- -- Ada reference manual formatter (ARM_Form). -- -- This package contains the database to store items for non-normative -- appendixes. -- -- --------------------------------------- -- Copyright 2000, 2004, 2005, 2006, 2009, 2011, 2012 -- AXE Consultants. All rights reserved. -- P.O. Box 1512, Madison WI 53701 -- E-Mail: randy@rrsoftware.com -- -- ARM_Form is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License version 3 -- as published by the Free Software Foundation. -- -- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS" -- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY, -- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL. -- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL, -- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES, -- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -- DAMAGES. -- -- A copy of the GNU General Public License is available in the file -- gpl-3-0.txt in the standard distribution of the ARM_Form tool. -- Otherwise, see . -- -- If the GPLv3 license is not satisfactory for your needs, a commercial -- use license is available for this tool. Contact Randy at AXE Consultants -- for more information. -- -- --------------------------------------- -- -- Edit History: -- -- 5/16/00 - RLB - Created package. -- 8/28/00 - RLB - Added revision info to database. -- 10/28/04 - RLB - Added Inserted_Normal_Number change kind. -- 11/02/04 - RLB - Added Deleted_Inserted_Number change kind. -- 12/06/04 - RLB - Added Revised_Inserted_Number change kind. -- 12/14/04 - RLB - Made the hang item bigger. -- 1/19/05 - RLB - Added Added_Version. -- 10/17/05 - RLB - Fixed indexing of the Glossary. -- 10/18/06 - RLB - Added No_Deleted_Paragraph_Messages to Report. -- 11/30/09 - RLB - Made the hang item bigger again (to make room to -- handle commands like @ChgAdded). -- 10/18/11 - RLB - Changed to GPLv3 license. -- 10/20/11 - RLB - Added Initial_Version parameter. -- 3/19/12 - RLB - Added code to suppress indexing of deleted glossary items. type String_Ptr is access String; type Item is record Next : Item_List; Sort_Key : String(1 .. 50); Hang : String(1 .. 75); Hang_Len : Natural; Text : String_Ptr; Change_Kind : Paragraph_Change_Kind_Type; Version : Character; Initial_Version : Character; end record; procedure Free is new Ada.Unchecked_Deallocation (Item, Item_List); procedure Free is new Ada.Unchecked_Deallocation (String, String_Ptr); procedure Create (Database_Object : in out Database_Type) is -- Initialize a database object. begin Database_Object.Is_Valid := True; Database_Object.List := null; Database_Object.Item_Count := 0; end Create; procedure Destroy (Database_Object : in out Database_Type) is -- Destroy a database object, freeing any resources used. Temp : Item_List; begin if not Database_Object.Is_Valid then raise Not_Valid_Error; end if; while Database_Object.List /= null loop Temp := Database_Object.List; Database_Object.List := Temp.Next; Free (Temp.Text); Free (Temp); end loop; Database_Object.Is_Valid := False; end Destroy; procedure Insert (Database_Object : in out Database_Type; Sort_Key : in String; Hang_Item : in String; Text : in String; Change_Kind : in Paragraph_Change_Kind_Type := ARM_Database.None; Version : in Character := '0'; Initial_Version : in Character := '0') is -- Insert an item into the database object. -- Sort_Key is the string on which this item will be sorted (if it -- is sorted). Hang_Item is the item which hangs out for the item -- in the report (if any). Text is the text for the item; the text -- may include formatting codes. Change_Kind and Version are the -- revision status for this item. Initial_Version is the version of -- the initial text for this item. Temp_Item : Item; begin if not Database_Object.Is_Valid then raise Not_Valid_Error; end if; Ada.Strings.Fixed.Move (Target => Temp_Item.Sort_Key, Source => Ada.Characters.Handling.To_Lower(Sort_Key), Drop => Ada.Strings.Right, Pad => ' '); Ada.Strings.Fixed.Move (Target => Temp_Item.Hang, Source => Hang_Item, Drop => Ada.Strings.Error, Pad => ' '); Temp_Item.Hang_Len := Hang_Item'Length; -- Note: If this second item doesn't fit, we error so we can make -- the size larger. Temp_Item.Text := new String'(Text); Temp_Item.Change_Kind := Change_Kind; Temp_Item.Version := Version; Temp_Item.Initial_Version := Initial_Version; Temp_Item.Next := Database_Object.List; Database_Object.List := new Item'(Temp_Item); Database_Object.Item_Count := Database_Object.Item_Count + 1; end Insert; --generic -- with procedure Format_Text (Text : in String; -- Text_Name : in String); procedure Report (Database_Object : in out Database_Type; In_Format : in Format_Type; Sorted : in Boolean; Added_Version : Character := '0'; No_Deleted_Paragraph_Messages : in Boolean := False) is -- Output the items with the appropriate format to the -- "Format_Text" routine. "Format_Text" allows all commands -- for the full formatter. (Text_Name is an identifying name -- for error messages). This is an added list for Added_Version -- ('0' meaning it is not added); in that case, use normal numbers -- for items with a version less than or equal to Added_Version. -- (This is intended to be used to output the items to -- appropriate Format and Output objects; but we can't do that -- directly because that would make this unit recursive with -- ARM_Format. -- No paragraphs will be have deleted paragraph messages if -- No_Deleted_Paragraph_Messages is True. Temp : Item_List; function Change_if_Needed (Item : in Item_List) return String is begin -- Note: In the report, we always decide inserted/not inserted -- as determined by the initial version number, and not the -- original class. case Item.Change_Kind is when None => return ""; when Inserted | Inserted_Normal_Number => if Item.Initial_Version <= Added_Version then return "@ChgRef{Version=[" & Item.Version & "],Kind=[AddedNormal]}"; else return "@ChgRef{Version=[" & Item.Version & "],Kind=[Added]}"; end if; when Revised | Revised_Inserted_Number => if Item.Initial_Version <= Added_Version then return "@ChgRef{Version=[" & Item.Version & "],Kind=[Revised]}"; else return "@ChgRef{Version=[" & Item.Version & "],Kind=[RevisedAdded]}"; end if; when Deleted | Deleted_Inserted_Number => if Item.Initial_Version <= Added_Version then if No_Deleted_Paragraph_Messages then return "@ChgRef{Version=[" & Item.Version & "],Kind=[DeletedNoDelMsg]}"; else return "@ChgRef{Version=[" & Item.Version & "],Kind=[Deleted]}"; end if; else if No_Deleted_Paragraph_Messages then return "@ChgRef{Version=[" & Item.Version & "],Kind=[DeletedAddedNoDelMsg]}"; else return "@ChgRef{Version=[" & Item.Version & "],Kind=[DeletedAdded]}"; end if; end if; when Deleted_No_Delete_Message | Deleted_Inserted_Number_No_Delete_Message => if Item.Initial_Version <= Added_Version then return "@ChgRef{Version=[" & Item.Version & "],Kind=[DeletedNoDelMsg]}"; else return "@ChgRef{Version=[" & Item.Version & "],Kind=[DeletedAddedNoDelMsg]}"; end if; end case; end Change_if_Needed; begin if not Database_Object.Is_Valid then raise Not_Valid_Error; end if; if Sorted then declare Items : array (1..Database_Object.Item_Count) of Item_List; begin -- Load the items: Temp := Database_Object.List; for I in Items'range loop Items(I) := Temp; Temp := Temp.Next; end loop; -- Sort the items array (use an insertion sort because it is -- stable): declare Left : Natural; -- Left sorting stop begin for Right In Items'First+1 .. Items'Last loop -- Right sorting stop Temp := Items(Right); Left := Right - 1; while Temp.Sort_Key <= Items(Left).Sort_Key loop -- Switch items Items(Left + 1) := Items(Left); Left := Left - 1; exit when Left = 0; end loop; Items(Left + 1) := Temp; end loop; end; -- Relink the items in the sorted order: for I in Items'First .. Items'Last - 1 loop Items(I).Next := Items(I+1); end loop; if Items'Length > 0 then Items(Items'Last).Next := null; Database_Object.List := Items(1); else Database_Object.List := null; end if; end; end if; case In_Format is when Hanging_List => Format_Text ("@begin(description)" & Ascii.LF, "Prefix"); Temp := Database_Object.List; while Temp /= null loop --** Debug: --Ada.Text_IO.Put_Line ("^^ " & Paragraph_Change_Kind_Type'Image(Temp.Change_Kind) & -- " for " & Temp.Hang(1..Temp.Hang_Len) & " ref=" & Change_if_Needed (Temp)); --Ada.Text_IO.Put_Line (" " & Change_if_Needed (Temp) & --Temp.Hang(1..Temp.Hang_Len) & "@\" & --Temp.Text.all & Ascii.LF & Ascii.LF); Format_Text (Change_if_Needed (Temp) & Temp.Hang(1..Temp.Hang_Len) & "@\" & Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key); Temp := Temp.Next; end loop; Format_Text ("@end(description)" & Ascii.LF, "Suffix"); when Bullet_List => Format_Text ("@begin(itemize)" & Ascii.LF, "Prefix"); Temp := Database_Object.List; while Temp /= null loop Format_Text (Change_if_Needed (Temp) & Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key); Temp := Temp.Next; end loop; Format_Text ("@end(itemize)" & Ascii.LF, "Suffix"); when Normal_List => Format_Text ("@begin(intro)" & Ascii.LF, "Prefix"); Temp := Database_Object.List; while Temp /= null loop Format_Text (Change_if_Needed (Temp) & Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key); Temp := Temp.Next; end loop; Format_Text ("@end(intro)" & Ascii.LF, "Suffix"); when Normal_Indexed_List => Format_Text ("@begin(intro)" & Ascii.LF, "Prefix"); Temp := Database_Object.List; while Temp /= null loop case Temp.Change_Kind is when None | Inserted | Inserted_Normal_Number | Revised | Revised_Inserted_Number => --** Debug: --Ada.Text_IO.Put_Line("Format " & Change_if_Needed (Temp) & -- "@defn{" & Ada.Strings.Fixed.Trim (Temp.Sort_Key, Ada.Strings.Right) & "}" & Ascii.LF & -- Temp.Text.all); -- Index this item. Format_Text (Change_if_Needed (Temp) & "@defn{" & Ada.Strings.Fixed.Trim (Temp.Sort_Key, Ada.Strings.Right) & "}" & Ascii.LF & Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key); when Deleted | Deleted_Inserted_Number | Deleted_No_Delete_Message | Deleted_Inserted_Number_No_Delete_Message => --** Debug: --Ada.Text_IO.Put_Line("Format " & Change_if_Needed (Temp) & Ascii.LF & -- Temp.Text.all); -- Don't index deleted items. Format_Text (Change_if_Needed (Temp) & Ascii.LF & Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key); end case; Temp := Temp.Next; end loop; Format_Text ("@end(intro)" & Ascii.LF, "Suffix"); end case; end Report; end ARM_Database;