|
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: 9511 (0x2527)
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⟧
-------------------------PROLOGUE---------------------------------------
-- -*
-- Unit name : HELP_INFO_SUPPORT body
-- Date created : 9-10-84
-- Last update : 02-07-85 Tom Duke - deleted CLEAR_TEXT_ARRAY
----------------: procedure. Modified GET_NEXT_TOKEN procedure to
----------------: allow all ascii codes <= TOKEN_SEPARATER as valid
----------------: token separaters. Eliminated special case test for
----------------: ellipsis from procedure IDENTIFY_KEYWORD.
----------------: 01-07-85 Tom Duke - added logic to not allow
----------------: abbreviations of ellipsis symbol in IDENTIFY_KEYWORD.
-- -*
------------------------------------------------------------------------
-- -*
-- Abstract : The HELP_INFO_SUPPORT package provides the constants
----------------: and types to support the implementation of the AIM
----------------: Help and Info utilities.
-- -*
------------------------------------------------------------------------
--
-- Mnemonic :
-- Name :
-- Release date :
------------------ Revision history ------------------------------------
--
-- DATE AUTHOR HISTORY
--
--
--
--------------------END-PROLOGUE----------------------------------------
with Text_Io;
package body Help_Info_Support is
procedure Append_To_Display (Line : in String; Char_Count : in Natural) is
begin
if Line'Length <= File_Text_Line'Length then
Current_Line.Text_Line := File_Text_Line'(others => ' ');
Current_Line.Text_Line (1 .. Line'Length) := Line;
Current_Line.Line_Length := Char_Count;
else
Current_Line.Text_Line := Line (1 .. File_Text_Line'Length);
Current_Line.Line_Length := File_Text_Line'Length;
end if;
Previous_Line.Next_Line := Current_Line;
Current_Line.Next_Line := null;
Previous_Line := Current_Line;
Current_Line := new Text_Line;
exception
when others =>
raise;
end Append_To_Display;
----------
-- The procedure IDENTIFY_KEYWORD compares the parameter TOKEN_STRING
-- to the parameter KEYWORD in an
-- attempt to identify a match. The global array UPPER_CASE is used
-- to convert the input character to upper case for comparison purposes.
-- Note that the input token string actually remains unchanged.
-- The logic assumes that if the character position pointer TEST_POS
-- is incremented past the value of the parameter TOKEN_LENGTH (the
-- actual length of the input token string) then the TOKEN_STRING must
-- be valid. This logic allows for abbreviations as small as one character
-- to be identified.
-- If a character mismatch or the CONSTRAINT_ERROR exception is raised,
-- the exception KEYWORD_NOT_FOUND is raised.
----------
procedure Identify_Keyword (Token_String : in Help_Info_Text_Line;
Token_Length : in Line_Length;
Keyword : in Help_Info_Text_Line) is
Test_Pos : Positive; -- character test position
Done : Boolean;
begin
Test_Pos := 1;
Done := False;
while Test_Pos <= Token_Length and then not Done loop
case Token_String (Test_Pos) is
when Lower_Case_Range =>
if Upper_Case (Token_String (Test_Pos)) =
Keyword (Test_Pos) then
Test_Pos := Test_Pos + 1;
else
Done := True;
end if;
when others =>
if Token_String (Test_Pos) = Keyword (Test_Pos) then
Test_Pos := Test_Pos + 1;
else
Done := True;
end if;
end case;
end loop;
if Test_Pos <= Token_Length then
raise Keyword_Not_Found;
end if;
exception
when Constraint_Error =>
raise Keyword_Not_Found;
when Keyword_Not_Found =>
raise;
when others =>
raise;
end Identify_Keyword;
----------
-- The procedure GET_NEXT_TOKEN extracts, from INPUT_STRING, the
-- next character(s) bounded by a
-- valid token separater and another valid token separater or the end
-- of the string. This procedure assumes that INPUT_STRING_POS is
-- currently positioned between tokens (pointing at a separater
-- character) or is positioned at the first character of some token in
-- the INPUT_STRING.
-- The exception CONSTRAINT_ERROR will be raised when the global
-- variable INPUT_STRING_POS (of type POSITIVE)
-- is greater than the length of INPUT_STRING. Therefore, this
-- exception is not propagated upward but, is handled to identify the
-- last token in the INPUT_STRING and its length.
-- The expected format of INPUT_STRING is:
--
-- [^^^]AAA[^^^AAA...][^^^][<CR>]
--
-- where
-- ^^^ represents any number of separaters (spaces or less),
--
-- AAA represents any number of characters greater than spaces,
--
-- ... indicates the preceeding pattern may be repeated,
--
-- [ ] indicates an optional entry in the string,
--
-- <CR> represents the string delimiter,
-- normally ASCII.CR or ASCII.LF.
--
----------
procedure Get_Next_Token (Input_String : in String;
Next_String : out Help_Info_Text_Line;
Next_Length : out Line_Length;
Next_Pos : out Positive) is
Test_Pos : Line_Index; -- character test position
Temp_String : Help_Info_Text_Line := (others => ' ');
begin
Test_Pos := 1;
----------
-- Find first non-separater character. Will raise CONSTRAINT_ERROR
-- if INPUT_STRING has trailing spaces with no delimiter. The
-- exception block correctly handles this situation.
----------
Next_Pos := Input_String_Pos;
while Input_String (Input_String_Pos) <= Token_Separater loop
Input_String_Pos := Input_String_Pos + 1;
end loop;
Next_Pos := Input_String_Pos;
----------
-- Extract next token string from input buffer. A string delimiter,
-- normally ASCII.CR or ASCII.LF, is expected after the last token.
-- If no delimiter exists, a CONSTRINT_ERROR will be raised at the
-- end of the last token in the string. The exception block correctly
-- handles this situation.
----------
while Input_String (Input_String_Pos) > Token_Separater loop
Temp_String (Test_Pos) := Input_String (Input_String_Pos);
Test_Pos := Test_Pos + 1;
Input_String_Pos := Input_String_Pos + 1;
end loop;
Next_Length := Test_Pos - 1;
Next_String := Temp_String;
exception
when Constraint_Error =>
Next_Length := Test_Pos - 1;
Next_String := Temp_String;
when others =>
raise;
end Get_Next_Token;
----------
-- The procedure PARSE calls the procedure GET_NEXT_TOKEN to extract
-- individual tokens from the parameter INPUT_STRING
-- and places these tokens in the INPUT_TOKEN_TABLE along with their
-- length and position within the INPUT_STRING.
-- The exception CONSTRAINT_ERROR is trapped to prevent a premature
-- exit from the info utility. This exception will occur if the user
-- entered more than the allowable number of tokens, as defined by the
-- subtype TOKEN_ARRAY_RANGE.
-- It is expected that INPUT_STRING will not contain characters with
-- an ascii code less than TOKEN_SEPARATER (space character) except for
-- ASCII.HT (between tokens only) and ASCII.CR or ASCII.LF (possible
-- string delimiters). If any other character less than TOKEN_SEPARATER
-- is encountered, the character is treated as a string delimiter.
----------
procedure Parse (Input_String : in String) is
begin
Number_Of_Tokens := 0;
Input_String_Pos := 1;
Token_Length := 1;
while Input_String_Pos <= Input_String'Length and then
Token_Length > 0 loop
Get_Next_Token (Input_String, Token_String,
Token_Length, Token_Pos);
if Token_Length > 0 then
Number_Of_Tokens := Number_Of_Tokens + 1;
Input_Token_Table (Number_Of_Tokens).Token := Token_String;
Input_Token_Table (Number_Of_Tokens).Length := Token_Length;
Input_Token_Table (Number_Of_Tokens).Buffer_Pos := Token_Pos;
end if;
end loop;
exception
when Constraint_Error =>
-- occurs when NUMBER_OF_TOKENS > MAX_LEVEL
null;
when others =>
raise;
end Parse;
end Help_Info_Support;