with Text_Io, Character_Set, Count_Of_Ada_Statements; package body Pager_Support is -- -- Common variables and exceptions -- Max_String : constant := 1024; New_File : Text_Io.File_Type; Paged_File : Text_Io.File_Type; Last : Natural; Line : String (1 .. Max_String); type File_Name_String is record Name : String (1 .. File_Name_Length); Length : Natural; end record; File_Create_Error : exception; File_Open_Error : exception; -- ============================================================== package Fn_List is -- -- This package provides simple manipulation for a singly-linked list -- of objects of type FILE_NAME_STRING -- procedure Initialize_List; -- -- Initialize the list -- procedure Append_Element (Element : File_Name_String); -- -- Add element onto the end of the list -- procedure Set_First; -- -- Goto the front of the list -- function Return_Current_Element return File_Name_String; -- -- Return the current element in the list -- function Current_Next return Boolean; -- -- Advance to next element in the list; return TRUE if done -- end Fn_List; package body Fn_List is type File_Name_Element; type Element_Pointer is access File_Name_Element; type File_Name_Element is record Data : File_Name_String; Next : Element_Pointer; end record; First_Element : Element_Pointer; Current_Element : Element_Pointer; procedure Initialize_List is begin First_Element := null; end Initialize_List; procedure Append_Element (Element : File_Name_String) is begin if First_Element = null then First_Element := new File_Name_Element; Current_Element := First_Element; Current_Element.Next := null; Current_Element.Data := Element; else Current_Element.Next := new File_Name_Element; Current_Element := Current_Element.Next; Current_Element.Next := null; Current_Element.Data := Element; end if; end Append_Element; procedure Set_First is begin Current_Element := First_Element; end Set_First; function Return_Current_Element return File_Name_String is begin return Current_Element.Data; end Return_Current_Element; function Current_Next return Boolean is begin if Current_Element = null then return False; elsif Current_Element.Next = null then return False; else Current_Element := Current_Element.Next; return True; end if; end Current_Next; end Fn_List; -- ============================================================== package Nat_Io is new Text_Io.Integer_Io (Natural); -- -- Open the input file -- procedure Open_Input (Input_File_Name : String) is begin Text_Io.Open (Paged_File, Text_Io.In_File, Input_File_Name); exception when others => raise File_Open_Error; end Open_Input; -- -- Create the paged output file -- procedure Create_File (Output_File_Name : String) is begin Text_Io.Create (Paged_File, Text_Io.Out_File, Output_File_Name); exception when others => raise File_Create_Error; end Create_File; -- -- Close the paged file if it is open -- procedure Close_Paged_File is begin if Text_Io.Is_Open (Paged_File) then Text_Io.Close (Paged_File); end if; end Close_Paged_File; -- -- Test to see if current line denotes another file -- function File_Name_Line return Boolean is begin if Last >= 10 and then (Line (1 .. 10) = "::::::::::" or Line (1 .. 10) = "--::::::::") then return True; else return False; end if; end File_Name_Line; -- -- PAGE accepts a number of file names and generates a paged file -- containing each of the indicated files prefixed by the form: -- :::::::::: -- filename -- :::::::::: -- procedure Page (Output_File_Name : String) is -- -- Variables for PAGE -- File_Name_Entry : File_Name_String; File_Name : String (1 .. File_Name_Length); Length : Natural; -- -- Append indicated file to end of output file -- procedure Append_File (File_Name : String) is Input_File : Text_Io.File_Type; Inline : String (1 .. Max_String); Length : Natural; Line_Count : Natural := 0; begin Text_Io.Open (Input_File, Text_Io.In_File, File_Name); if Comment_Prefix then Text_Io.Put (Paged_File, "--"); end if; Text_Io.Put_Line (Paged_File, "::::::::::"); if Comment_Prefix then Text_Io.Put (Paged_File, "--"); end if; Text_Io.Put_Line (Paged_File, File_Name); if Comment_Prefix then Text_Io.Put (Paged_File, "--"); end if; Text_Io.Put_Line (Paged_File, "::::::::::"); while not Text_Io.End_Of_File (Input_File) loop Text_Io.Get_Line (Input_File, Inline, Length); Text_Io.Put_Line (Paged_File, Inline (1 .. Length)); begin Line_Count := Line_Count + 1; exception when others => null; -- trap overflow end; end loop; Text_Io.Close (Input_File); if Verbose then Text_Io.Put (" "); Nat_Io.Put (Line_Count, 8); Text_Io.Put_Line (" Lines"); end if; exception when Text_Io.Name_Error => Text_Io.Put_Line (" File Name Error"); Text_Io.Close (Input_File); raise File_Open_Error; when others => Text_Io.Close (Input_File); raise File_Open_Error; end Append_File; -- -- Process the indicated file as an include file; ie, this file -- contains a list of files to be included -- procedure Include_File (File_Name : String) is Ifile : Text_Io.File_Type; Ifile_Name : String (1 .. File_Name_Length); Length : Natural; procedure Name_Include_File is begin if Verbose then Text_Io.Put (" "); Text_Io.Put_Line (File_Name_Entry.Name (1 .. File_Name_Entry.Length)); end if; end Name_Include_File; begin if Verbose then Text_Io.Put (" Include File: "); Text_Io.Put_Line (File_Name); end if; -- -- Try to open include file -- Text_Io.Open (Ifile, Text_Io.In_File, File_Name); -- -- If INCLUDE_FILE_PREFIX is true, add the include file itself -- if Include_File_Prefix then File_Name_Entry.Name (1 .. File_Name'Length) := File_Name; File_Name_Entry.Length := File_Name'Length; Fn_List.Append_Element (File_Name_Entry); Name_Include_File; end if; -- -- Add each file in the include file; omit blank lines and -- lines beginning with - (comment lines) -- loop begin Text_Io.Get_Line (Ifile, Ifile_Name, Length); if Length /= 0 and Ifile_Name (1) /= '-' then -- -- Allow for include file nesting -- if Ifile_Name (1) = Include_File_Prefix_Char then Include_File (Ifile_Name (2 .. Length)); -- -- Include a conventional file -- else File_Name_Entry.Name := Ifile_Name; File_Name_Entry.Length := Length; Fn_List.Append_Element (File_Name_Entry); Name_Include_File; end if; end if; exception when Text_Io.End_Error => Text_Io.Close (Ifile); if Verbose then Text_Io.Put (" End of Include File "); Text_Io.Put_Line (File_Name); end if; exit; when Text_Io.Name_Error => Text_Io.Close (Ifile); Text_Io.Put_Line (" File Name Error"); when others => Text_Io.Close (Ifile); raise; end; end loop; exception when Text_Io.End_Error => Text_Io.Put_Line (" Include File "); Text_Io.Put (File_Name); Text_Io.Put_Line (" NOT Found"); when others => raise; end Include_File; -- -- Mainline of PAGE -- begin Create_File (Output_File_Name); Fn_List.Initialize_List; Text_Io.Put_Line ("Enter Names of Files (RETURN when done)"); loop Text_Io.Put (" Input File Name > "); Text_Io.Get_Line (File_Name, Length); exit when Length = 0; if File_Name (1) = Include_File_Prefix_Char then Include_File (File_Name (2 .. Length)); else File_Name_Entry.Name := File_Name; File_Name_Entry.Length := Length; Fn_List.Append_Element (File_Name_Entry); end if; end loop; Text_Io.New_Line; Text_Io.Put_Line (" Component Files --"); Fn_List.Set_First; loop begin File_Name_Entry := Fn_List.Return_Current_Element; Text_Io.Put (" "); Text_Io.Put_Line (File_Name_Entry.Name (1 .. File_Name_Entry.Length)); Append_File (File_Name_Entry.Name (1 .. File_Name_Entry.Length)); exit when not Fn_List.Current_Next; exception when File_Open_Error => Text_Io.Put (" -- File NOT Found"); exit when not Fn_List.Current_Next; when others => raise; end; end loop; Close_Paged_File; exception when File_Create_Error => Text_Io.Put (" Error in creating output file "); Text_Io.Put_Line (Output_File_Name); Close_Paged_File; when File_Open_Error => Text_Io.Put (" Error in opening input file "); Text_Io.Put_Line (File_Name_Entry.Name (1 .. File_Name_Entry.Length)); Close_Paged_File; when others => Close_Paged_File; end Page; -- -- UNPAGE extracts the component files from a paged file and writes them -- out to their respective files -- procedure Unpage (Input_File_Name : String) is Line_Count : Natural; -- -- Open new file for output -- procedure Open_New_File is Name_Start : Integer; begin Text_Io.Get_Line (Paged_File, Line, Last); Text_Io.Put (" "); Text_Io.Put_Line (Line (1 .. Last)); if Line (1 .. 2) = "--" then Name_Start := 3; else Name_Start := 1; end if; loop begin Text_Io.Create (New_File, Text_Io.Out_File, Line (Name_Start .. Last)); exit; exception when Text_Io.Name_Error => Text_Io.New_Line; Text_Io.Put (" Invalid File Name ("); Text_Io.Put (Line (Name_Start .. Last)); Text_Io.Put_Line (")"); Text_Io.Put (" Enter Valid File Name > "); Text_Io.Get_Line (Line, Last); Name_Start := 1; when others => raise; end; end loop; --Skip over the trailing ":::::::::::::" line Text_Io.Get_Line (Paged_File, Line, Last); exception when others => raise File_Create_Error; end Open_New_File; -- -- Mainline of UNPAGE -- begin Open_Input (Input_File_Name); -- -- Search for first component in paged file -- loop Text_Io.Get_Line (Paged_File, Line, Last); exit when File_Name_Line; end loop; -- -- Process each component in paged file -- Open_New_File; Line_Count := 0; loop Text_Io.Get_Line (Paged_File, Line, Last); if File_Name_Line then Text_Io.Close (New_File); if Verbose then Text_Io.Put (" "); Nat_Io.Put (Line_Count, 8); Text_Io.Put_Line (" Lines"); end if; Line_Count := 0; Open_New_File; else begin Line_Count := Line_Count + 1; exception when others => null; -- trap overflow end; Text_Io.Put_Line (New_File, Line (1 .. Last)); end if; end loop; exception when File_Create_Error => Text_Io.Put_Line (" Error in creating output file"); Close_Paged_File; when File_Open_Error => Text_Io.Put_Line (" Error in opening input file"); Close_Paged_File; when Text_Io.End_Error => if Text_Io.Is_Open (New_File) then Text_Io.Close (New_File); if Verbose then Text_Io.Put (" "); Nat_Io.Put (Line_Count, 8); Text_Io.Put_Line (" Lines"); end if; end if; Close_Paged_File; when others => Close_Paged_File; end Unpage; -- -- ADA_CHECK computes and displays the number of Ada statements, Ada -- comments, text lines, and a checksum hash code for the indicated file -- procedure Ada_Check (Input_File_Name : String) is Statements : Natural; Lines : Natural; Comments : Natural; Hash : Natural; begin Count_Of_Ada_Statements (Input_File_Name, Statements, Lines, Comments, Hash); Text_Io.Put ("Input File: "); Text_Io.Put_Line (Input_File_Name); Text_Io.Put (" Ada Statements: "); Nat_Io.Put (Statements, 6); Text_Io.New_Line; Text_Io.Put (" Ada Comments: "); Nat_Io.Put (Comments, 6); Text_Io.New_Line; Text_Io.Put (" Text Lines: "); Nat_Io.Put (Lines, 6); Text_Io.New_Line; Text_Io.Put (" Checksum: "); Nat_Io.Put (Hash, 6); Text_Io.New_Line; end Ada_Check; -- -- SCANPAGE scans a paged file and prints out the names of the files -- contained therein -- procedure Scanpage (Input_File_Name : String) is -- -- Variables et al -- Line_Count : Natural; -- -- Advance to a new file -- procedure New_File is Name_Start : Natural; begin -- Get file name Text_Io.Get_Line (Paged_File, Line, Last); -- Print file name if Line (1 .. 2) = "--" then Name_Start := 3; else Name_Start := 1; end if; Text_Io.Put (" "); Text_Io.Put (Line (Name_Start .. Last)); Line_Count := 0; -- Skip over the trailing ":::::::::::::" line Text_Io.Get_Line (Paged_File, Line, Last); end New_File; -- -- Print value of LINE_COUNT -- procedure Print_Line_Count is begin Text_Io.New_Line; if Verbose then Text_Io.Put (" "); Nat_Io.Put (Line_Count, 8); Text_Io.Put_Line (" Lines"); end if; end Print_Line_Count; -- -- Mainline of SCANPAGE -- begin Ada_Check (Input_File_Name); Open_Input (Input_File_Name); -- -- Search for first component in paged file -- loop Text_Io.Get_Line (Paged_File, Line, Last); exit when File_Name_Line; end loop; Text_Io.Put_Line (" Component Files -- "); -- -- Process each component in paged file -- New_File; loop begin Text_Io.Get_Line (Paged_File, Line, Last); begin Line_Count := Line_Count + 1; exception when others => null; -- trap overflow end; if File_Name_Line then begin Line_Count := Line_Count - 1; exception when others => null; -- trap overflow end; Print_Line_Count; New_File; end if; exception when Text_Io.End_Error => Print_Line_Count; exit; when others => raise; end; end loop; Close_Paged_File; exception when File_Create_Error => Text_Io.Put_Line (" Error in creating output file"); Close_Paged_File; when File_Open_Error => Text_Io.Put_Line (" Error in opening input file"); Close_Paged_File; when Text_Io.End_Error => Close_Paged_File; when others => Close_Paged_File; end Scanpage; -- -- COMMAND inputs and does a simple parse of the command line -- function Command return Character is Index : Natural; Fn_Index : Natural; Command_Line : String (1 .. 256); Command_Length : Natural; Command_Character : Character; begin loop Text_Io.Get_Line (Command_Line, Command_Length); Command_Line (Command_Length + 1) := Ascii.Nul; if Command_Length > 0 then Command_Character := Command_Line (1); Index := 1; -- Skip over command name loop exit when Character_Set.Is_Space (Command_Line (Index)) or Command_Line (Index) = Ascii.Nul; Index := Index + 1; end loop; -- Skip over space chars loop exit when (not Character_Set.Is_Space (Command_Line (Index))) or Command_Line (Index) = Ascii.Nul; Index := Index + 1; end loop; -- Save file name Fn_Index := 1; loop exit when Command_Line (Index) = Ascii.Nul; Input_File_Name (Fn_Index) := Command_Line (Index); Index := Index + 1; Fn_Index := Fn_Index + 1; end loop; Input_File_Name (Fn_Index) := Ascii.Nul; Input_File_Name_Length := Fn_Index - 1; exit; end if; end loop; return Character_Set.To_Upper (Command_Character); end Command; end Pager_Support;