|
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: 13194 (0x338a)
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 Character_Set;
package body Document_Handler is
Last_Time : Boolean := False;
Lines_Remaining : Natural;
--
Next_Char : Natural := 0;
Is_Char_Pending : Boolean := False;
Pending_Char : Character;
--
Last_Word_Index : Natural;
Last_Word_Length : Natural;
--
Output_File : Text_Io.File_Type;
Input_File : Text_Io.File_Type;
--
Context_Line : Context;
--
-- Set up for input of source file
--
procedure Open_Source (File_Name : String) is
begin
Text_Io.Open (Input_File, Text_Io.In_File, File_Name);
--
-- Initialize Context Buffer
--
for I in Context_Line'First .. Context_Line'Last loop
Context_Line (I).Line (1) := Ascii.Nul;
Context_Line (I).Last := 0;
end loop;
--
-- Read in first set of context lines from file
--
begin
for I in Target_Line_In_Context .. Number_Of_Lines_In_Context loop
Text_Io.Get_Line (Input_File,
Context_Line (I).Line (1 .. Max_Line - 1),
Context_Line (I).Last);
Context_Line (I).Last := Context_Line (I).Last + 1;
Context_Line (I).Line (Context_Line (I).Last) := Ascii.Nul;
end loop;
exception
when others =>
null; -- very short file
end;
--
-- Set index to first char of target_line_in_context
--
Next_Char := 1;
end Open_Source;
--
-- Set up for output of modified input file to a "restored" document
--
procedure Open_Destination (File_Name : String) is
begin
Text_Io.Create (Output_File, Text_Io.Out_File, File_Name);
exception
when others =>
Text_Io.Open (Output_File, Text_Io.Out_File, File_Name);
end Open_Destination;
--
-- Init all key system variables so DOCUMENT_HANDLER may be invoked several
-- times in one run
--
procedure Reset_Document_Handler is
begin
Last_Time := False;
Is_Char_Pending := False;
Next_Char := 0;
end Reset_Document_Handler;
--
-- Close Input and Output Files and Reset the Document Handler
--
procedure Close_Source_And_Destination is
begin
if Text_Io.Is_Open (Output_File) then
Text_Io.Close (Output_File);
end if;
if Text_Io.Is_Open (Input_File) then
Text_Io.Close (Input_File);
end if;
Reset_Document_Handler;
end Close_Source_And_Destination;
--
-- GET_NEW_LINE moves the context lines down one and inputs a new
-- third context line from the input file
--
procedure Get_New_Line is
Input_Line : String (1 .. Max_Line);
Input_Line_Length : Natural;
begin
if not Text_Io.Is_Open (Input_File) then
raise Source_Not_Open;
end if;
if Text_Io.Is_Open (Output_File) then
Text_Io.Put_Line
(Output_File,
Context_Line (Target_Line_In_Context).Line
(1 .. Context_Line (Target_Line_In_Context).Last - 1));
end if;
if not Last_Time then
--
-- Move context lines down one line
--
for I in 2 .. Number_Of_Lines_In_Context loop
Context_Line (I - 1) := Context_Line (I);
end loop;
--
-- Initialize last line in case GET_LINE fails
--
Context_Line (Number_Of_Lines_In_Context).Line (1) := Ascii.Nul;
Context_Line (Number_Of_Lines_In_Context).Last := 0;
--
-- Get next line from input file
--
Text_Io.Get_Line (Input_File, Input_Line (1 .. Max_Line - 1),
Input_Line_Length);
--
-- Store next line into last line in context
--
Context_Line (Number_Of_Lines_In_Context).Line := Input_Line;
Context_Line (Number_Of_Lines_In_Context).Line
(Input_Line_Length + 1) := Ascii.Nul;
Context_Line (Number_Of_Lines_In_Context).Last :=
Input_Line_Length + 1;
else
--
-- Move context lines down one line
--
for I in 2 .. Number_Of_Lines_In_Context loop
Context_Line (I - 1) := Context_Line (I);
end loop;
--
-- Clear last line in context
--
Context_Line (Number_Of_Lines_In_Context).Line (1) := Ascii.Nul;
Context_Line (Number_Of_Lines_In_Context).Last := 0;
Lines_Remaining := Lines_Remaining - 1;
if Lines_Remaining = 0 then
raise No_More_Words;
end if;
end if;
exception
when Text_Io.End_Error =>
Last_Time := True;
Lines_Remaining := Number_Of_Lines_In_Context -
Target_Line_In_Context;
when No_More_Words =>
raise;
when others =>
Text_Io.Put_Line ("Unknown Exception in GET_NEW_LINE");
raise;
end Get_New_Line;
--
-- GETC returns the next character from the input stream
--
procedure Getc (Ch : out Character) is
begin
if Is_Char_Pending then
Ch := Pending_Char;
Is_Char_Pending := False;
else
if Next_Char > Context_Line (Target_Line_In_Context).Last then
Next_Char := 1;
loop
Get_New_Line;
exit when Next_Char <= Context_Line
(Target_Line_In_Context).Last;
end loop;
end if;
Ch := Context_Line (Target_Line_In_Context).Line (Next_Char);
Next_Char := Next_Char + 1;
end if;
end Getc;
--
-- UNGETC prepends a character back into the front of the input stream
--
procedure Ungetc (Ch : Character) is
begin
Is_Char_Pending := True;
Pending_Char := Ch;
end Ungetc;
--
-- IS_DIGIT_ELEMENT returns true if the indicated char is a number or
-- one of the special numeric characters
--
function Is_Digit_Element (Ch : Character) return Boolean is
begin
if Character_Set.Is_Digit (Ch) or
Token_Definition.Is_Special_Char (Ch) then
return True;
else
return False;
end if;
end Is_Digit_Element;
--
-- GET_WORD returns the next word from the input stream
--
procedure Get_Word (Word : out Token; Word_In_Bounds : out Boolean) is
Letter_In : Character;
Word_In : String (1 .. Token_Definition.Token_Length);
Word_Index : Natural;
Alpha_Detected : Boolean;
--
-- Determine if the character is a part of a word
--
function Is_Part_Of_Word (Ch : Character) return Boolean is
Letter_Next : Character;
begin
if not (Character_Set.Is_Alpha_Numeric (Ch) or
Token_Definition.Is_Special_Char (Ch)) then
return False;
else
if Token_Definition.Is_Special_Char (Ch) then
Getc (Letter_Next);
Ungetc (Letter_Next);
if not Character_Set.Is_Alpha_Numeric (Letter_Next) then
return False;
else
return True;
end if;
else
return True;
end if;
end if;
end Is_Part_Of_Word;
--
-- Mainline of GET_WORD
--
begin
if not Text_Io.Is_Open (Input_File) then
raise Source_Not_Open;
end if;
--
-- Major loop in case an all-numeric/special-numeric word is built
--
loop
--
-- Look for the start of the next word
--
loop
Getc (Letter_In);
exit when Character_Set.Is_Alpha_Numeric (Letter_In);
end loop;
--
-- Set LAST_WORD_INDEX to point to first char of current word
--
if Next_Char = 1 then
Last_Word_Index := Next_Char;
else
Last_Word_Index := Next_Char - 1;
end if;
--
-- Build current word
--
Alpha_Detected := Character_Set.Is_Alpha (Letter_In);
Word_In (1) := Letter_In;
Word_Index := 1;
loop
Getc (Letter_In);
exit when not Is_Part_Of_Word (Letter_In);
if Word_Index = Word_In'Last then
loop
Word_Index := Word_Index + 1;
Getc (Letter_In);
if Character_Set.Is_Alpha (Letter_In) then
Alpha_Detected := True;
end if;
exit when not Is_Part_Of_Word (Letter_In);
end loop;
exit;
else
Word_Index := Word_Index + 1;
Word_In (Word_Index) := Letter_In;
if Character_Set.Is_Alpha (Letter_In) then
Alpha_Detected := True;
end if;
end if;
end loop;
if (Word_Index /= Word_In'Last) and
(Token_Definition.Is_Special_Char (Letter_In)) and
(Letter_In /= '-') then
Word_Index := Word_Index + 1;
Word_In (Word_Index) := Letter_In;
end if;
--
-- Exit major loop if the word contains at least one alphabetic
--
exit when Alpha_Detected;
end loop;
--
-- Set length of LAST_WORD in case RESTORE_WORD is called
--
Last_Word_Length := Word_Index;
--
-- Set returned values
--
Word.Word := Word_In;
if Word_Index <= Word_In'Last then
Word.Length := Word_Index;
Word_In_Bounds := True;
else
Word.Length := Word_In'Last;
Word_In_Bounds := False;
end if;
end Get_Word;
--
-- RESTORE_WORD replaces the word indexed by LAST_WORD_INDEX with the
-- passed word
--
procedure Restore_Word (Word : String) is
Length_Of_Prefix : Natural;
Length_Of_Postfix : Natural;
Length_Of_Restored_Line : Natural;
begin
--
-- Check to see that at least the input file is open
--
if not Text_Io.Is_Open (Input_File) then
raise Source_Not_Open;
end if;
--
-- Compute number of characters in prefix (before old word) and postfix
-- (after old word)
-- Compute length of line after new word is inserted into it
-- Compute location of NEXT_CHAR pointer (after new word)
--
Length_Of_Prefix := Last_Word_Index - 1;
Length_Of_Postfix := Context_Line (Target_Line_In_Context).Last -
(Last_Word_Index + Last_Word_Length - 1);
Length_Of_Restored_Line := Context_Line (Target_Line_In_Context).Last +
Word'Length - Last_Word_Length;
Next_Char := Last_Word_Index + Word'Length;
--
-- Check to see if the restore will fail
--
if Length_Of_Restored_Line > Max_Line - 1 then
raise Restore_Failed;
else
--
-- Copy current line up to old word, copy in new word,
-- and then copy in rest of current line after old word
--
Context_Line (Target_Line_In_Context).Line
(1 .. Length_Of_Restored_Line) :=
Context_Line (Target_Line_In_Context).Line
(1 .. Length_Of_Prefix) &
Word & Context_Line (Target_Line_In_Context).Line
(Last_Word_Index + Last_Word_Length ..
Context_Line (Target_Line_In_Context).Last);
--
-- Replace current line length
--
Context_Line (Target_Line_In_Context).Last :=
Length_Of_Restored_Line;
end if;
Last_Word_Length := Word'Length;
end Restore_Word;
--
-- CONTEXT_OF_LAST_GET_WORD returns the context lines
--
procedure Context_Of_Last_Get_Word (Lines : out Context;
Index : out Natural;
Length : out Natural) is
begin
if not Text_Io.Is_Open (Input_File) then
raise Source_Not_Open;
end if;
Lines := Context_Line;
Index := Last_Word_Index;
Length := Last_Word_Length;
end Context_Of_Last_Get_Word;
begin
Reset_Document_Handler;
end Document_Handler;