|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 12934 (0x3286)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Log;
with Errors;
with Syntax;
with Editor;
with Profile;
with Archive;
with New_Keys;
with Subtypes;
use Subtypes;
with Arguments;
with Pathnames;
with Structure;
with Window_Io;
with Assertions;
with Browse_Keys;
with Debug_Tools;
with More_Display;
with Directory_Tools;
with String_Utilities;
with Unbounded_String;
with Window_Utilities;
with Structure_Utilities;
with Singly_Linked_List_Generic;
with Single_Selection_Line_Menus;
package body Browser is
-- RENAMES:
function "=" (Key_1 : in Window_Io.Raw.Key; Key_2 : Window_Io.Raw.Key)
return Boolean renames Window_Io.Raw."=";
function "=" (This_Section_Kind : in Syntax.Section_Kinds;
That_Section_Kind : in Syntax.Section_Kinds) return Boolean
renames Syntax."=";
-- INSTANTIATION OF HELP GENERIC:
package Vstrings is new Unbounded_String;
package Help is new Singly_Linked_List_Generic (Vstrings.Variable_String);
-- INSTANTIATION OF TEXT GENERIC:
function Initialized_Text
(This_Text : in Structure.Text) return Structure.Text is
--
Working_Text : Structure.Text := This_Text;
--
begin
Structure.Reset (Working_Text);
return (Working_Text);
end Initialized_Text;
function Current_Line_Image (This_Text : in Structure.Text) return String is
begin
return (Structure.Contents_Of (Structure.Current_Line (This_Text)));
end Current_Line_Image;
procedure Display_Text is new More_Display (Structure.Text,
Structure.Text,
Initialized_Text,
Current_Line_Image,
Structure.Done,
Structure.Next,
New_Keys.Characters ('Q'));
-- IMPLEMENTATION OF HELP:
function Initialized_List (This_List : in Help.List) return Help.List is
--
Working_List : Help.List := This_List;
--
begin
Help.Reset (Working_List);
return (Working_List);
end Initialized_List;
function Current_Line (This_List : in Help.List) return String is
begin
return (Vstrings.Image (Help.Current (This_List)));
end Current_Line;
procedure Display_Help is new More_Display (Help.List,
Help.List,
Initialized_List,
Current_Line,
Help.Done,
Help.Next,
New_Keys.Characters ('Q'));
function Help_Message return Help.List is separate;
function Image_Of (This_Section : in Structure.Section) return String is
begin
return (Structure.Name_Of (This_Section));
end Image_Of;
function Image_Of (This_Item : in Structure.Item) return String is
begin
return (Structure.Name_Of (This_Item));
end Image_Of;
-- EXTRACTION FROM TAPE:
procedure Extract_Item (This_Item : in Structure.Item;
Input : in out Window_Io.File_Type;
Output : in out Window_Io.File_Type;
The_Library : in Full_Name;
Response : in String) is separate;
-- BROWSER:
procedure Browse_Catalog_In
(This_Library : in Full_Name; Response : in String) is
-- INSTANTIATION OF ERROR GENERIC:
Old_Response_Profile : Profile.Response_Profile := Profile.Get;
New_Response_Profile : Profile.Response_Profile :=
Profile.Value (Response);
package Error is new Errors
(Old_Response_Profile,
New_Response_Profile, "Browse_Catalog");
-- INSTANTIATION OF SECTION MENUS GENERIC:
procedure Unknown_Key (This_Key : in Window_Io.Raw.Key;
This_Section : in out Structure.Section);
package Section_Menu is
new Single_Selection_Line_Menus (Structure.Section,
Image_Of,
Unknown_Key);
-- INSTANTIATION OF ITEM MENUS GENERIC:
procedure Unknown_Key (This_Key : in Window_Io.Raw.Key;
This_Item : in out Structure.Item);
package Item_Menu is new Single_Selection_Line_Menus (Structure.Item,
Image_Of,
Unknown_Key);
-- GLOBAL VARIABLES AND CONSTANTS:
Input : Window_Io.File_Type;
Output : Window_Io.File_Type;
Cycle : exception;
Quit : exception;
Current_Catalog : Structure.Catalog;
Current_Section : Structure.Section;
Current_Item : Structure.Item;
Sections_Menu : Section_Menu.Menu_Definition;
Items_Menu : Item_Menu.Menu_Definition;
-- MENU CONSTRUCTORS:
function Menu_For (This_Catalog : in Structure.Catalog)
return Section_Menu.Menu_Definition is
--
Working_Catalog : Structure.Catalog := This_Catalog;
The_Menu : Section_Menu.Menu_Definition := Section_Menu.Make;
--
begin
Structure.Reset (Working_Catalog);
while (not Structure.Done (Working_Catalog)) loop
Section_Menu.Add
(Structure.Current_Section (Working_Catalog), The_Menu);
Structure.Next (Working_Catalog);
end loop;
return (The_Menu);
end Menu_For;
function Menu_For (This_Section : in Structure.Section)
return Item_Menu.Menu_Definition is
--
Working_Section : Structure.Section := This_Section;
The_Menu : Item_Menu.Menu_Definition := Item_Menu.Make;
--
begin
Structure.Reset (Working_Section);
while (not Structure.Done (Working_Section)) loop
Item_Menu.Add
(Structure.Current_Item (Working_Section), The_Menu);
Structure.Next (Working_Section);
end loop;
return (The_Menu);
end Menu_For;
-- KEYS:
procedure Unknown_Key (This_Key : in Window_Io.Raw.Key;
This_Section : in out Structure.Section) is
begin
if (This_Key = Browse_Keys.Quit) then
raise Quit;
elsif (This_Key = Browse_Keys.Give_Help) then
Window_Utilities.Erase (Output);
Display_Help (Output, Input, Help_Message);
raise Cycle;
elsif (This_Key = Browse_Keys.Display_Text) then
Window_Utilities.Erase (Output);
Display_Text (Output, Input,
Structure.Description_Of (This_Section));
raise Cycle;
else
Editor.Alert;
end if;
end Unknown_Key;
procedure Unknown_Key (This_Key : in Window_Io.Raw.Key;
This_Item : in out Structure.Item) is
begin
if (This_Key = Browse_Keys.Quit) then
raise Quit;
elsif (This_Key = Browse_Keys.Give_Help) then
Window_Utilities.Erase (Output);
Display_Help (Output, Input, Help_Message);
raise Cycle;
elsif (This_Key = Browse_Keys.Display_Text) then
Window_Utilities.Erase (Output);
Display_Text (Output, Input,
Structure.Description_Of (This_Item));
raise Cycle;
elsif (This_Key = Browse_Keys.Download_Item) then
Extract_Item (This_Item, Input, Output, This_Library, Response);
raise Cycle;
else
Editor.Alert;
end if;
end Unknown_Key;
begin
Profile.Set (New_Response_Profile);
begin
Assertions.Assert_Has_Archive_Data (This_Library);
Assertions.Assert_Has_Archive_Index (This_Library);
Log.Put_Line ("Parsing data file");
Current_Catalog :=
Structure.Catalog_From
(This_Data_File =>
Pathnames.Browser_Data_File_For (This_Library));
Structure.Assert_Is_Good (Current_Catalog);
Sections_Menu := Menu_For (Current_Catalog);
Window_Io.Open (Input, Window_Io.In_File,
"SOFTWARE LIBRARY BROWSER");
Window_Io.Open (Output, Window_Io.Out_File,
"SOFTWARE LIBRARY BROWSER");
loop
begin
Window_Utilities.Erase (Output);
Section_Menu.Display (Output, Sections_Menu, "SECTIONS");
Current_Section := Section_Menu.Get_Response
(Input, Output, Sections_Menu);
if (Structure.Kind_Of (Current_Section) =
Syntax.Text) then
raise Cycle;
else
Items_Menu := Menu_For (Current_Section);
loop
begin
Window_Utilities.Erase (Output);
Item_Menu.Display (Output, Items_Menu, "ITEMS");
Current_Item := Item_Menu.Get_Response
(Input, Output, Items_Menu);
exception
when Cycle =>
null;
when Quit =>
exit;
end;
end loop;
end if;
exception
when Cycle =>
null;
when Quit =>
Window_Io.Close (Input);
Window_Io.Delete (Output);
exit;
end;
end loop;
end;
Profile.Set (Old_Response_Profile);
--
exception
when Assertions.Has_No_Archive_Data =>
Error.Report
("Specified library contains no Data file for Archive");
--
when Assertions.Has_No_Archive_Index =>
Error.Report
("Specified library contains no Index file for Archive");
--
when Structure.Bad_Element =>
Structure_Utilities.Display_Diagnostic (Current_Catalog, Response);
Error.Report (Error.Nil_Message);
--
when Error.Propagate =>
raise;
--
when Error.Quit =>
null;
--
when others =>
Error.Report ("EXCEPTION: " & Debug_Tools.Get_Exception_Name);
--
end Browse_Catalog_In;
procedure Browse_Catalog_In (This_Library : in String;
Default_Version : in Full_Name;
Response : in String) is
--
Old_Response_Profile : Profile.Response_Profile := Profile.Get;
New_Response_Profile : Profile.Response_Profile :=
Profile.Value (Response);
--
package Error is new Errors
(Old_Response_Profile,
New_Response_Profile, "Browse_Catalog");
--
begin
Profile.Set (New_Response_Profile);
Log.Put_Line ("[Browse_Catalog (Located_In => """ & This_Library &
""", Response => """ & Response & """)]",
Profile.Auxiliary_Msg);
declare
The_Version : constant Full_Name :=
Arguments.Browser_Version_From (This_Library, Default_Version);
begin
Browse_Catalog_In (This_Library => The_Version,
Response => "PROPAGATE," & Response);
end;
Log.Put_Line
("[end of Browse_Catalog operation--no error(s) detected]");
Profile.Set (Old_Response_Profile);
--
exception
when others =>
Error.Report (Error.Nil_Message, Suppress_Closing_Message => True);
--
end Browse_Catalog_In;
end Browser;