package String_Pack is -- *********************************************************************** -- Programmer Name : J. Allison/S. Mouton -- Program Name : String_Pack -- Revision Number : Rev 1.0 -- Date Created : October 20, 1986 -- Function Description : Utility procedures and functions that operate on -- fixed and variable length strings. --************************************************************************* type Vstring (Max_Len : Integer) is limited private; -- ********************************************************************* -- Functional Description : The following functions compare two variable -- length strings for equality/inequality. The maximum declared length -- of the two variable length strings may be different. Spaces dont -- count (i.e. "harry smith " is equal to "harry smith" function "=" (Left, Right : Vstring) return Boolean; function ">=" (Left, Right : Vstring) return Boolean; function "<=" (Left, Right : Vstring) return Boolean; function ">" (Left, Right : Vstring) return Boolean; function "<" (Left, Right : Vstring) return Boolean; Upper_Case : constant String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; Lower_Case : constant String := "abcdefghijklmnopqrstuvwxyz"; Numeric : constant String := "0123456789"; Alphabet : constant String := Upper_Case & Lower_Case; Alphanumeric : constant String := Alphabet & Numeric; Valid_For_Id : constant String := Alphanumeric & "_"; type Compare is (Less_Than, Equal, Greater_Than); Start_Out_Of_Range, Non_Blank_Truncation : exception; -- ********************************************************************* -- Functional Description : This function returns a null string .. that -- is a variable length string of length 0. function Null_Vstring return Vstring; -- ********************************************************************* -- Functional Description : This function returns the greater of two -- values .. if the values are equal, then the -- first number input is returned. function Max (I1, I2 : Integer) return Integer; -- ********************************************************************* -- Functional Description : This function returns the smaller of two -- values..if the two are equal, then the first -- number input is returned. function Min (I1, I2 : Integer) return Integer; -- ********************************************************************* -- Functional Description : This function returns the minimum of two -- numbers. However, if the minimum value is -- less than or equal to zero, then the larger -- of the two is returned. function Non_Zero_Min (I1, I2 : Integer) return Integer; -- ********************************************************************* -- Functional Description : This function will return the length that -- the input string is declared to be .. for -- example, function would return 17 if it was -- called with a string declared as -- a_string : string(4..20) with a value of -- "harry smith " function Length (Input : String) return Integer; -- ********************************************************************* -- Functional Description : This function returns the current value of -- the length portion of a variable length string. function Length (Input : Vstring) return Integer; -- ********************************************************************* -- Functional Description : This function returns the declared maximum -- length of the variable lengthed string -- parameter. Example..if the parameter is -- declared as var_str : vstring(24), then the -- value returned by Max_Length will always be -- 24, no matter what the value of var_str.length function Max_Length (Input : Vstring) return Integer; -- ********************************************************************* -- Functional Description : This procedure will get (from the terminal) -- a variable_length string. If the string -- input on the terminal is greater than the -- declared length of the parameter "line" then -- the excess input is left in the system input -- buffer and may cause probems in subsequent -- "gets". procedure Get (Line : in out Vstring); -- ********************************************************************* -- Functional Description : This procedure will put variable lengthed -- strings out to the screen. Only the valid -- part of the variable lengthed string is -- displayed. procedure Put (Word : in Vstring); -- ********************************************************************* -- Functional Description : This procedure will put the cursor at the -- beginning of the next line. procedure New_Line; -- ********************************************************************* -- Functional Description : The procedure will fill the variable_lengthed -- string parameter 'X' with whaterver is defined -- as Fill_Char (the default is " ". The declared -- maximum length of the variable string is used -- to determine the amount to fill. procedure Fill (X : in out Vstring; Fill_Char : Character := ' '); -- ********************************************************************* -- Functional Description : The procedure will fill a string from x'first -- to x'last with the fill character..default is -- the ' '. function High_String (Length : Integer) return String; function Low_String (Length : Integer) return String; procedure Fill (X : in out String; Fill_Char : Character := ' '); -- ******************************************************************** -- Functional Description : The procedure will be used for debugging -- purposes..when called. It outputs the -- variable length of the input, the maximum -- length of the input and the current value -- of the variable string.. procedure Dump (Input : Vstring); -- ********************************************************************* -- Functional Description : The following function will return 'true' if -- the input string is blank filled or null and -- false otherwise. function Nada (X : String) return Boolean; -- ********************************************************************* -- Functional Description : The following function will return 'true' -- if the input vstring is blank filled or null -- and false otherwise. function Nada (X : Vstring) return Boolean; -- ********************************************************************* -- Functional Description : The following procedure will take a string -- slice out of 'source' starting at position -- 'source_start' and of length 'source_length' -- and place that slice in the string 'target' -- in the slice starting at position 'target_start' -- and of length 'target_length'. If the slice -- is larger than the allotted space in the -- target string, then the slice is chopped off -- on the right end. If the slice is smaller than -- the allotted space, then it is blank padded on -- the right end to match the length of the space. procedure Substr (Source : String; Source_Start, Source_Length : Integer; Target : in out String; Target_Start, Target_Length : Integer); -- ********************************************************************* -- Functional Description : The following procedure will take a string -- slice out of 'source' starting at position -- 'source_start' and of length 'source_length' -- and place that slice in the string 'target' -- in the slice starting at position -- 'target_start' and of length 'target_length'. -- If the slice is larger than the allotted space -- in the target string, then the slice is chopped -- off on the left end. If the slice is smaller -- than the allotted space, then it is blank padded -- on the left end to match the length of the -- space. procedure Substr_Reverse (Source : String; Source_Start, Source_Length : Integer; Target : in out String; Target_Start, Target_Length : Integer); -- ********************************************************************* -- Functional Description : The following functions will return a string -- slice from 'source' starting at position -- source_start and which is source_length -- long. If the source_length parameter is left -- off, then the slice returned is the 'rest of -- the string' starting at position source_start. function Substr (Source : String; Source_Start, Source_Length : Integer) return String; function Substr (Source : String; Source_Start : Integer) return String; -- ********************************************************************* -- Functional Description : The following functions will return a -- vstring slice from 'source' starting at -- position source_start and which is -- source_length long. If the source_length -- parameter is left off, then the slice -- returned is the 'rest of the string' starting -- at position source_start. function Substr (Source : Vstring; Source_Start, Source_Length : Integer) return Vstring; function Substr (Source : Vstring; Source_Start : Integer) return Vstring; -- ******************************************************************** -- Functional Description : The move procedures are like assigns, except -- that truncation or blank fill will be done in -- the case of unequal lengths. In the case of -- move, left alignment is assumed. Move_Reverse -- provides right alignment. procedure Move (Source : in Vstring; Target : in out Vstring); procedure Move (Source : in String; Target : in out String); procedure Move_Reverse (Source : in String; Target : in out String); -- ********************************************************************* -- Functional Description : The following functions return the exact -- reverse of the source string or vstring that -- is input. The length of the returned -- string (or vstring) is the same as the source. function Reverse_String (Source : in String) return String; function Reverse_String (Source : in Vstring) return Vstring; -- ********************************************************************* -- Functional Description : The following function will take as input an -- Ada string and return its value in a vstring. -- The vstring will be the same length as -- the declared length of the input source. function Var (Input : String) return Vstring; -- ********************************************************************* -- Functional Description : The following function will take as input a -- variable string and return its value in a -- regular Ada string the length of the -- variable string. function Fix (Input : Vstring) return String; -- ********************************************************************* -- Functional Description : The function will compare two strings. -- Independent of the length each of them is -- declared, the function returns an enumeration -- type of 'equal' ('less_than' or 'greater_than' -- when applicable) if the 'meaningful' portions -- of the two strings are equal, thereby ignoring -- trailing blanks of either string. function Comstr (Source : String; Source_Start, Source_Length : Integer; Target : String; Target_Start, Target_Length : Integer) return Compare; -- ********************************************************************* -- Functional Description : The function will compare two strings. -- Independent of the length each of them is -- declared, the function returns an enumeration -- type of 'equal' ('less_than' or 'greater_than' -- when applicable) if the 'meaningful' portions -- of the two strings are equal, thereby ignoring -- trailing blanks of either string. function Comstr (Source, Target : String; Case_Sensitive : Boolean := True; Wild_Card : Character := Ascii.Nul) return Compare; -- ********************************************************************* -- Functional Description : The following function will search the -- source string for the first instance of the -- pattern and return its position in the -- source string. If it is not found, then 0 -- is returned. Also if either the source or -- pattern's length is not > 0 then 0 is -- returned. function Indx (Source : String; Source_Start, Source_Length : Integer; Pattern : String; Pattern_Start, Pattern_Length : Integer) return Integer; -- ********************************************************************* -- Functional Description : The following function will search the -- source string for the first instance of the -- pattern and return its position in the -- source string. If it is not found, then 0 -- is returned. Also if either the source or -- pattern's length is not > 0 then 0 is -- returned. function Indx (Source : String; Pattern : String) return Integer; -- ********************************************************************* -- Functional Description : The following functions will search the -- source string (from left to right) looking -- for a character that is NOT present in the -- set of valid characters. If an invalid -- character is found in the source string, -- then its position in the source string is -- returned. If all the characters in the -- source ARE valid then a 0 is returned. function Verify (Source : String; Source_Start, Source_Length : Integer; Valid_Characters : String; Valid_Character_Start, Valid_Character_Length : Integer) return Integer; function Verify (Source : String; Valid_Characters : String) return Integer; -- ********************************************************************* -- Functional Description : The following function examines characters -- from the source string one at a time (from -- left to right) and scans a character set for -- an occurence of the character. If found, its -- position in the set is returned. If it is not -- found, the scan continues until the end of the -- source string is reached (in this case a 0 is -- returned) or a character from source is found -- in the target set. function Anything (Source : String; Character_Set : String) return Integer; -- ********************************************************************* -- Functional Description : The function will compare two vstrings. -- Independent of the length each of them is -- declared, the function returns an enumeration -- type of 'equal' ('less_than' or 'greater_than' -- when applicable) if the 'meaningful' portions -- of the two strings are equal, thereby ignoring -- trailing blanks of either string. function Comstr (Source, Target : Vstring; Case_Sensitive : Boolean := True; Wild_Card : Character := Ascii.Nul) return Compare; -- ********************************************************************* -- Functional Description : The following function will search the source -- vstring for the first instance of the target -- vstring and return its position in the source. -- If it is not found, then 0 is returned. Also -- if either the source or target's length is -- not > 0 then 0 is returned. function Indx (Source : Vstring; Target : Vstring) return Integer; -- ********************************************************************* -- Functional Description : The following function examines characters -- from the source vstring one at a time (from -- left to right) and scans a character set for -- an occurence of the character. If found, its -- position in the character set is returned. -- If it is not found, the scan continues until -- the end of the source vstring is reached (in -- this case a 0 is returned) or a character from -- source is found in target. function Anything (Source : Vstring; Character_Set : Vstring) return Integer; -- ********************************************************************* -- Functional Description : The following function will search the -- source vstring (from left to right) looking -- for a character that is NOT present in the -- target vstring. If a character is NOT found -- in the target string then its position in the -- source string is returned. If all the -- characters in the source ARE found in the -- target then a 0 is returned. function Verify (Source : Vstring; Target : Vstring) return Integer; -- ********************************************************************* -- Functional Description : The following function will return the last -- character of a given vstring that is not equal -- to the character 'ignore'. function Last_Character (Source : Vstring; Ignore : Character := ' ') return Integer; -- ********************************************************************* -- Functional Description : The following function will return the first -- character of a given vstring that is not equal -- to the character 'ignore'. function First_Character (Source : Vstring; Ignore : Character := ' ') return Integer; -- ********************************************************************* -- Functional Description : The following function will 'stretch' a -- vstring out to some length 'target_length' by -- inserting blanks within the vstring. The -- position to insert these blanks into is -- determined by the string defined in the -- parameter stretch_after. The vstring is -- scanned from left to right searching for -- 'stretch_after'. If the string is found, -- then the blanks are inserted after the string. -- If the string is not found, then the blanks -- are added at the end of the vstring. function Stretch (Source : Vstring; Target_Length : Integer; Stretch_After : String) return Vstring; -- ********************************************************************* -- Functional Description : The following procedure will scan a vstring -- 'Source' searching for a vstring 'find'. If -- the vstring 'find' is found, then it is -- removed and the vstring replace is put in its -- place. This continues until the source string -- has been completely scanned for the 'find' -- string (ie all occurrences of 'find' are -- replaced). The vstring returned size will -- reflect the new size of the vstring after all -- replacements have been found. If 'find' is -- never found then the vstring is returned unchanged. procedure Replace (Source : in out Vstring; Find, Replace : Vstring); -- ********************************************************************* -- Functional Description : The following functions will take as input -- a string (or vstring and return the input -- string without any blanks. If blanks appear -- within single quotes within the string, however, -- they will be left alone. For example the string -- "The boy ran" as source will return the string -- "Theboyran". The string "The 'b y' ran" -- will return the string "Theb yran". type Strip_What is (All_Blanks, Leading, Trailing, All_But_One); function Compress (Source : String; What : Strip_What := All_Blanks) return String; function Compress (Source : Vstring; What : Strip_What := All_Blanks) return Vstring; -- ********************************************************************* -- Functional Description : The following function will strip leading or -- trailing BLANKS from the given string. function Strip (From : String; What : Strip_What := All_Blanks) return String; -- ********************************************************************* -- Functional Description : The following procedures will take a source -- vstring, search left to right for any character -- in 'break string' and return in source what -- came after that character in the break string, -- and what came before the character in break -- string in target. If the break string is not -- found in source, then source is returned as a -- null string and target attains the value of -- source. procedure Split_String (Source : in out Vstring; Target : in out Vstring; Break_String : in String := " "); procedure Split_String (Source : in out Vstring; Target : out Integer; Break_String : in String := " "); -- ********************************************************************* -- Functional Description : The following functions will take a vstring -- as input, scan from left to right for a legal -- string representation of an integer -- (this includes '+' and '-' signs) and returns -- the integer equivalent. If an integer -- representation is not present in the string, -- then 0 is returned. function Inparm (Line : Vstring; Start, Length : Integer) return Integer; function Inparm (Line : Vstring) return Integer; -- ********************************************************************* -- Functional Description : The following routines will convert a string -- into an integer OR an integer to a -- pre_defined Ada string. procedure String_To_Number (Source : String; Target : out Integer; Worked : out Boolean; Base : Natural := 10); function Number_To_String (Value : Integer; Base : Natural := 10; Width : Natural := 0; Leading : Character := ' ') return String; -- ********************************************************************* -- Functional Description : The following functions will convert the -- input string OR vstring to upper or lower case. function Change_To_Upper_Case (S : String) return String; function Change_To_Lower_Case (S : String) return String; function Change_To_Upper_Case (Var_S : Vstring) return Vstring; function Change_To_Lower_Case (Var_S : Vstring) return Vstring; procedure Upshift (X : in out String); procedure Downshift (X : in out String); -- ********************************************************************* -- Functional Description : The following functions work just as defined -- Ada concatenation except that the resulting -- vstring now has a length equal to the -- two concatenated parts. function "&" (Left : Vstring; Right : Vstring) return Vstring; function "&" (Left : String; Right : Vstring) return Vstring; function "&" (Left : Vstring; Right : String) return Vstring; ----------------------------------------------------------------------------- private type Vstring (Max_Len : Integer) is record Length : Integer := 0; -- count of actual characters in the string Bod : String (1 .. Max_Len) := (others => ' '); end record; end String_Pack;