Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / pdl / dd.src < prev next >

Wrap

Text File | 1988-05-03 | 339.8 KB | 8,337 lines

--:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --DDRELEASE.ADA --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: function DD_Release return String is --| Returns current release number for data dictionary tools begin return "1.1"; end DD_Release; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --SSTRINGS.SPC --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package Screen_Strings is --| Varying length strings which are no longer than the maximum number of --| columns on a terminal screen. --| Overview --| --| The following operations are provided: --| --| Create (2) - Create a Screen_String from a string --| Unchecked_Create - Create a Screen_String from a string --| Value - Returns the string value of a Screen_String --| Length - Returns the length of a Screen_String --| "<" (3) - Less than operation --| Equal (3) - Equality operation --| "&" (3) - Concatenation operation --| Substring - Returns a substring of a given Screen_String --| Match_Prefix (3) - Returns whether one screen string is a prefix --| - of another --| Match_Pattern (3) - Returns starting index of matching pattern --| ------------------------------------------------------------------------------- -- Exceptions String_Too_Long : exception; --| Raised when Create is attempted for a --| string with length > Max_Screen_Columns Invalid_Substring : exception; --| Raised when substring specified is --| outside the bounds of the Screen_String ------------------------------------------------------------------------------- -- Types and Objects type Screen_String is private; Max_Screen_Columns : constant := 80; --| Maximum length of Screen_String subtype Length_Range is natural range 0 .. Max_Screen_Columns; ------------------------------------------------------------------------------- -- Operations function Create( --| Create a Screen_String from a string S : String --| String to create a Screen_String from ) return Screen_String; --| Raises: String_Too_Long --| Effects: Creates a value of type Screen_String from the String s. --| String_Too_Long is raised if the length of S is greater than --| Max_Screen_Columns. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Create( --| Create Screen_String from string S : String; --| String to create Screen_String from SS : out Screen_String; --| Return value Truncated : out Boolean --| Whether any text was truncated ); --| Effects: Creates a value of type Screen_String from the String s. --| If the length of s is greater than Max_Screen_Columns, the text --| is truncated and Truncated is true. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Unchecked_Create( --| Create a Screen_String from a string S : String --| String to create Screen_String from ) return Screen_String; --| Effects: Creates a value of type Screen_String from the string s. --| If the length of s is greater than Max_Screen_Columns, the text --| is truncated. --------------------------------------------------------------------------- function Value( --| Returns the string value of a Screen_String SS : Screen_String --| Screen_String value ) return String; --| Effects: Returns the value of Screen_String SS. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Length( --| Returns the length of a Screen_String SS : Screen_String --| Screen_String whose length to return ) return Length_Range; --| Effects: Returns the length of Screen_String SS. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function "<"( --| Returns Value(SS1) < Value(SS2) SS1, SS2 : Screen_String --| Screen_Strings to compare ) return Boolean; --| Effects: Returns true if Value(SS1) < Value(SS2); false otherwise. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function "<"( --| Returns Value(SS) < S SS : Screen_String; --| Screen_String to compare S : String --| String to compare ) return Boolean; --| Effects: Returns true if Value(SS) < S; false otherwise. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function "<"( --| Returns S < Value(SS) S : String; --| String to compare SS : Screen_String --| Screen_String to compare ) return Boolean; --| Effects: Returns true if S < Value(SS); false otherwise. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Equal( --| Returns Value(SS1) = Value(SS2) SS1, SS2 : Screen_String --| Screen_Strings to compare ) return Boolean; --| Effects: Returns true if Value(SS1) = Value(SS2); false otherwise. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Equal( --| Returns Value(SS) = S SS : Screen_String; --| Screen_String to compare S : String --| String to compare ) return Boolean; --| Effects: Returns true if Value(SS) = S; false otherwise. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Equal( --| Returns S = Value(SS) S : String; --| String to compare SS : Screen_String --| Screen_String to compare ) return Boolean; --| Effects: Returns true if S = Value(SS); false otherwise. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function "&"( --| Concatenation operation SS1 : Screen_String; --| First Screen_String to concatenate SS2 : Screen_String --| Second Screen_String to concatenate ) return Screen_String; --| Raises: String_Too_Long --| Effects: Concatenates Value(SS1) with Value(SS2) and returns a --| Screen_String. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function "&"( --| Concatenation operation SS : Screen_String; --| Screen_String to concatenate S : String --| String to concatenate ) return Screen_String; --| Raises: String_Too_Long --| Effects: Concatenates Value(SS) with S and returns a Screen_String. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function "&"( --| Concatenation operation S : String; --| String to concatenate SS : Screen_String --| Screen_String to concatenate ) return Screen_String; --| Raises: String_Too_Long --| Effects: Concatenates S with Value(SS) and returns a Screen_String. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Substring( --| Returns a substring of SS SS : Screen_String; --| Screen string from which to get substring Start : Length_Range; --| Starting index of substring Length : Length_Range --| Length of substring ) return Screen_String; --| Raises: Invalid_Substring --| Effects: Returns the substring of SS starting at Start and having --| length Length. Invalid_Substring is raised when the combination of --| Start and Length is outside the bounds of SS. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Match_Prefix( --| Returns whether SS1 is a prefix of SS2 SS1 : Screen_String; --| The prefix Screen_String SS2 : Screen_String --| Screen_String to compare prefix against ) return Boolean; --| Effects: If SS1 is a prefix of SS2, returns true. Otherwise returns --| false. Note that this subprogram is not case sensitive; eg. --| CR would be a valid prefix of create. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Match_Prefix( --| Returns whether S is a prefix of SS S : String; --| The prefix String SS : Screen_String --| Screen_String to compare prefix against ) return Boolean; --| Effects: If S is a prefix of SS, returns true. Otherwise returns --| false. Note that this subprogram is not case sensitive; eg. --| CR would be a valid prefix of create. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Match_Prefix( --| Returns whether SS is a prefix of S SS : Screen_String; --| The prefix Screen_String S : String --| String to compare prefix against ) return Boolean; --| Effects: If SS is a prefix of S, returns true. Otherwise returns --| false. Note that this subprogram is not case sensitive; eg. --| CR would be a valid prefix of create. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Match_Pattern( --| Matches a pattern in a screen_string Pattern : Screen_String; --| The pattern to match Text : Screen_String --| Text in which to search for pattern ) return Length_Range; --| Effects: Returns the index into Text where it matches Pattern. --| If the pattern is not found, then 0 is returned. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Match_Pattern( --| Matches a pattern in a screen_string Pattern : String; --| The pattern to match Text : Screen_String --| Text in which to search for pattern ) return Length_Range; --| Effects: Returns the index into Text where it matches Pattern. --| If the pattern is not found, then 0 is returned. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Match_Pattern( --| Matches a pattern in a screen_string Pattern : Screen_String; --| The pattern to match Text : String --| Text in which to search for pattern ) return Length_Range; --| Effects: Returns the index into Text where it matches Pattern. --| If the pattern is not found, then 0 is returned. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- private type Screen_String is record Length : Length_Range; Text : String(1 .. Length_Range'Last); end record; --------------------------------------------------------------------------- end Screen_Strings; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TEMPLATES.SPC --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Screen_Strings; ------------------------------------------------------------------------------- package Templates is --| Provide a collection of templates and the functions to access them. --| Overview --| --| This package provides all of the templates for the Data Dictionary. The --| templates are initialized in the body of this package so that they may be --| changed without requiring recompilation of all packages dependent on this --| specification. --| --| The following operations are provided: --| --| Field_Count - Returns the number of fields in a template --| Variable_Field_Count - Returns the number of variable fields --| Variable_Field_Number - Returns the variable field number, given the --| actual field number --| Variable_Field_Number - Returns the variable field number, given the --| field name --| Actual_Field_Number - Returns the actual field number, given the --| variable field number --| Actual_Field_Number - Returns the actual field number, given the --| field name --| First_Variable_Field_Number --| - Returns the variable field number of the first --| variable field on a line --| Template_Label - Returns the label of a template --| Field_Mode - Returns the mode of a field --| Field_Position - Returns the position of a field --| Field_Label - Returns the label of a field --| Field_Length - Returns the length of a field --| Field_Help - Returns help line for a field ------------------------------------------------------------------------------- package SS renames Screen_Strings; ------------------------------------------------------------------------------- -- Types and Objects type Template_Name is --| All template types (Object_Decl, Type_Decl, Procedure_Decl, Function_Decl, Package_Decl, Task_Decl, Exception_Decl); -- generics? type Position_Descriptor is --| Position of a template field record Line : Positive; --| Line where field begins Column : Positive; --| Column where field begins end record; Max_Fields : constant := 45; -- arbitrary and may need to be changed type Actual_Field_Range is new Natural range 0 .. Max_Fields; subtype Actual_Field_Number_Range is Actual_Field_Range range 1 .. Actual_Field_Range'Last; type Variable_Field_Range is new Natural range 0 .. Max_Fields; subtype Variable_Field_Number_Range is Variable_Field_Range range 1 .. Variable_Field_Range'Last; type Field_Mode_Name is --| Whether or not the field text always appears (Variable, Static); --| on the screen (Variable means that the field --| text is replaced by the text in a dictionary --| entry when the template is filled in. ------------------------------------------------------------------------------- -- Exceptions No_Such_Field : exception; --| The specified field doesn't --| exist No_Such_Line : exception; --| The specified line doesn't --| exit No_Variable_Field_On_Line : exception; --| No variable fields were found --| on the specified line Not_A_Variable_Field : exception; --| Attempt to find variable field --| number for a static field ------------------------------------------------------------------------------- -- Operations function Field_Count( --| Returns the number of fields in template Template : Template_Name --| Template containing fields ) return Actual_Field_Range; --| Effects: The number of fields in a template are returned. "Number of --| fields" refers to the total number of fields. Whether the fields are --| variable or static is irrelevant to this count. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Variable_Field_Count( --| Returns the number of variable fields Template : Template_Name --| Template containing fields ) return Variable_Field_Range; --| Effects: The number of variable fields in a template are returned. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Variable_Field_Number( --| Returns the variable field number, --| given the actual field number Template : Template_Name; --| Template containing fields Actual_Field_Number : Actual_Field_Number_Range --| actual field number (out of total) ) return Variable_Field_Number_Range; --| Raises: No_Such_Field, Not_A_Variable_Field --| Effects: Returns the variable field number for the field designated by --| the actual (total) field number --| For example, in the template: --| --| <identifier> : <type> --| --| The actual field numbers are: --| <identifier> 1 --| : 2 --| <type> 3 --| --| but the variable field numbers are: --| <identifier> 1 --| : not a variable field --| <type> 2 --| --| No_Such_Field is raised when the specified field doesn't exist. --| Not_A_Variable_Field is raised when the specified field is a static --| field. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Variable_Field_Number( --| Returns the variable field number, --| given the field name Template : Template_Name; --| Template containing fields Field_Name : SS.Screen_String --| name of the field ) return Variable_Field_Number_Range; --| Raises: No_Such_Field --| Effects: Returns the variable field number for the field Field_Name --| No_Such_Field is raised if no variable field with name Field_Name --| exists. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Actual_Field_Number( --| Returns the actual field number, --| given the variable field number Template : Template_Name; --| Template containing fields Variable_Field_Number : Variable_Field_Number_Range ) return Actual_Field_Number_Range; --| Raises: No_Such_Field --| Effects: Returns the actual field number for the nth variable field, --| where n is Variable_Field_Number. --| For example, in the template: --| --| <identifier> : <type> --| --| The actual field numbers are: --| <identifier> 1 --| : 2 --| <type> 3 --| --| but the variable field numbers are: --| <identifier> 1 --| : not a variable field --| <type> 2 --| --| No_Such_Field is raised if the specified field doesn't exist. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Actual_Field_Number( --| Returns the actual field number, --| given the field name Template : Template_Name; --| Template containing fields Field_Name : SS.Screen_String --| name of the field ) return Actual_Field_Number_Range; --| Raises: No_Such_Field --| Effects: Returns the variable field number for the field Field_Name --| No_Such_Field is raised if no field with name Field_Name exists. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function First_Variable_Field_Number( --| Returns the variable field --| number of the first field on --| a line Template : Template_Name; --| Template containing field Line : Positive --| Line within template ) return Variable_Field_Number_Range; --| Raises: No_Such_Line, No_Variable_Field_On_Line --| Effects: Returns the variable field number for the first field on --| the given line. No_Such_Line is raised if the specified line doesn't --| exist. No_Variable_Field_on_Line is raised if no variable field exists --| on the specified line. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Template_Label( --| Returns the label of a template Template : Template_Name --| Template from which to get label ) return SS.Screen_String; --| Effects: Returns a label such as "Object Declaration" for the template --| specified by Template. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Field_Mode( --| Returns the mode of a field Template : Template_Name; --| Template containing field Field_Number : Actual_Field_Number_Range --| Field whose mode to return ) return Field_Mode_Name; --| Raises: No_Such_Field --| Effects: The mode (static or variable) of a field is returned for --| the given Template and Field_Number. If Field_Number is greater --| than the number of fields, No_Such_Field is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Field_Position( --| Returns the position of a field Template : Template_Name; --| Template containing field Field_Number : Actual_Field_Number_Range --| Field whose position to return ) return Position_Descriptor; --| Raises: No_Such_Field --| Effects: The position of a field, which includes its line and --| starting column, is returned for the given Template and Field_Number. --| If Field_Number is greater than the number of fields, No_Such_Field --| is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Field_Label( --| Returns the label of a field Template : Template_Name; --| Template containing field Field_Number : Actual_Field_Number_Range --| Field whose label to return ) return SS.Screen_String; --| Raises: No_Such_Field --| Effects: The label of a field is returned for the given Template and --| Field_Number. For static fields, the label is just the text of that --| field. For variable fields, the label is what would be displayed on --| the screen if that field is blank. If Field_Number is greater --| than the number of fields, No_Such_Field is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Field_Length( --| Returns the length of a field Template : Template_Name; --| Template containing field Field_Number : Actual_Field_Number_Range --| Field whose length to return ) return Positive; --| Raises: No_Such_Field --| Effects: The length of a field is returned for the given Template --| and Field_Number. If Field_Number is greater than the number of --| fields, No_Such_Field is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Field_Help( --| Returns help line for a field Template : Template_Name; --| Template containing field Field_Number : Variable_Field_Number_Range --| Field whose help to return ) return SS.Screen_String; --| Raises: No_Such_Field --| Effects: The help line for a field is returned for the given Template --| and Field_Number. The help line is one line explaining what --| information belongs in a particular field. If Field_Number is greater --| than the number of fields, No_Such_Field is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- end Templates; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --DICTMGR.SPC --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Direct_IO; with Screen_Strings; with Templates; ------------------------------------------------------------------------------- package Dictionary_Manager is --| Provide operations to manage a collection of dictionary entries associated --| with various template types. --| Overview --| --| This package provides operations to access a data dictionary containing --| entries which are associated with the template types provided in package --| Templates. The operations provided allow creation, deletion and updating --| of dictionary entries. --| --| Open_Dictionary must be called before any accessing of the dictionary --| can be performed. Close_Dictionary must be called to close all open --| files in the dictionary. --| --| The following operations are provided: --| --| Create_Dictionary - Creates a new dictionary --| Open_Dictionary - Opens all dictionary files --| Close_Dictionary - Closes all dictionary files --| New_Entry_Handle - Returns handle to new dictionary entry --| Entry_Handle - Returns handle to existing entry --| Entry_Exists - Determines whether an entry is exists --| Unique_Entry - Determines whether an entry is unique --| Overloads - Returns overload fields for an entry --| Delete_Entry - Deletes dictionary entry --| Create_Entry - Creates a new entry --| Update_Entry - Updates an existing dictionary entry --| Update_Field - Updates a field in a dictionary entry --| Field_Contents - Returns the contents of a field --| Template_Kind - Returns the template type for this handle --| ------------------------------------------------------------------------------- package SS renames Screen_Strings; package TP renames Templates; ------------------------------------------------------------------------------- -- Exceptions Cant_Create_Directory : exception; --| Error occured while trying to --| create a directory Invalid_Dictionary_File : exception; --| An attempt was made to refer to --| a nonexistent dictionary file Dictionary_Locked : exception; --| The dictionary requested is --| already locked by another user Lock_is_Missing : exception; --| The lock file for the dictionary --| is missing No_Dictionary_File : exception; --| Open_Dictionary hasn't been --| called Index_File_Error : exception; --| Error occurred while trying to --| open an index file Data_File_Error : exception; --| Error occurred while trying to --| open a data file No_Such_Dictionary_Entry : exception; --| An attempt was made to refer to --| a nonexistent entry No_Such_Occurrence : exception; --| An attempt was made to refer to --| a nonexistent occurrence of --| template type + identifier Invalid_Entry_Handle : exception; --| Entry handle is null Field_Not_Found : exception; --| An attempt was made to refer to --| a nonexistent field of an entry Null_Identifier : exception; --| An attempt was made to create or --| update an entry with null --| identifier field. No_Overload_Field : exception; --| An attempt was made to create a --| non-unique entry which had no --| overload field Too_Many_Overloads : exception; --| The number of overloads is at --| its maximum Cant_Update_New_Entry : exception; --| An attempt was made to "update" --| an entry which wasn't originally --| read from the dictionary ------------------------------------------------------------------------------- package Report_Utilities is --| Provides subprograms to produce reports on dictionary entries. --| Overview --| --| The following operations are provided: --| --| Set_Up_Report - initializes parameters for reporting --| Make_Report - makes the report --| --------------------------------------------------------------------------- -- Types type Report_Name is (Summary, Full, Command_File); --------------------------------------------------------------------------- -- Exceptions Abort_Report : exception; --| Dictionary or file couldn't be opened --| want to return error status in driver --------------------------------------------------------------------------- -- Operations procedure Set_Up_Report( --| Initializes parameters for reporting Dictionary_Name : in String; --| Name of dictionary to open Entries : in String; --| Entries to report on Entry_Name : in String --| File containing entries to report ); --| Raises: Abort_Report --| Effects: Opens the dictionary and reads and parses the entries --| specified in file Entry_Name to set up which entries are to be --| included in the report. An error message is printed and --| Abort_Report is raised if an error occurs while trying to open --| Entry_Name. --| N/A: Requires, Modifies ----------------------------------------------------------------------- procedure Make_Report( --| Makes the report Report : in Report_Name; --| Which type of report to make Output_Name : in String --| Name of output file ); --| Raises: No_Dictionary_File --| Effects: Makes the report. Report determines whether to make --| a Summary, Full or Command_File report. The summary report is --| paginated and has the following form: --| --| template-name Entries: --| identifier --| first overload of identifier --| second overload of identifier --| . --| . --| . --| . --| . --| . --| . --| . --| . --| --| The full report has an entry for each selected identifier which is --| very similar to the format which appears on the screen in the --| Edit_Dictionary tool. It is also paginated. Each entry in the --| Command_File report has the form: --| --| UPDATE template-type identifier occurrence --| <field-label>field-contents --| . --| . --| . --| --| The Command_File report is not paginated, as it is intended for --| use as input to the Update_Dictionary tool. --| N/A: Requires, Modifies ----------------------------------------------------------------------- end Report_Utilities; ------------------------------------------------------------------------------- -- Types and Objects type Dictionary_Entry_Handle is private; Max_Overloads : constant Natural := 10; --| Maximum number of times a name can be overloaded for one template type subtype Overload_Range is positive range 1 .. Max_Overloads; type Overload_Array is array(Overload_Range) of SS.Screen_String; --| Array of <overload> fields for all instances of a name for one template --| type ------------------------------------------------------------------------------- -- Operations procedure Create_Dictionary( --| Creates a new dictionary Dictionary_Name : in String --| Name of dictionary to create ); --| Raises: Cant_Create_Directory --| Effects: Creates a new dictionary with name Dictionary_Name and --| all associated files. Cant_Create_Directory is raised if an error --| occurs while trying to create the dictionary. The files are not --| left open; i.e., Open_Dictionary must be called if other dictionary --| manager subprograms are to be called after Create_Dictionary. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Open_Dictionary( --| Opens all dictionary files Dictionary_Name : in String --| Name of dictionary ); --| Raises: Invalid_Dictionary_File, Dictionary_Locked, Lock_is_Missing, --| Data_File_Error --| Effects: Opens all the necessary files in the dictionary and makes --| the dictionary the current directory. Invalid_Dictionary_File is --| raised if the dictionary requested doesn't exist. Dictionary_Locked --| is raised if another user is accessing the same dictionary. --| Lock_is_Missing is raised if the lock file for the dictionary is --| missing. Data_File_Error is raised if an error occurred while trying --| to open the dictionary's data files. --| Modifies: Current Dictionary File --| N/A: Requires --------------------------------------------------------------------------- procedure Close_Dictionary; --| Closes all dictionary files --| Raises: No_Dictionary_File --| Effects: Closes all open files in the dictionary and writes out the --| index files. No_Dictionary_File is raised if Open_Dictionary hasn't --| been called first. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function New_Entry_Handle( --| Returns handle to new dictionary entry Template : TP.Template_Name --| Template type to associate with entry ) return Dictionary_Entry_Handle; --| Raises: No_Dictionary_File --| Effects: Returns a handle to a new dictionary entry associated with --| a template of type Template. If Open_Dictionary hasn't been --| called first, No_Dictionary_File is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Entry_Handle( --| Returns handle to existing entry Template : TP.Template_Name; --| Template type of entry Identifier : SS.Screen_String; --| Entry identifier Occurrence : Overload_Range --| Occurrence of Entry_Handle to := 1 --| retrieve. ) return Dictionary_Entry_Handle; --| Raises: No_Dictionary_File, No_Such_Dictionary_Entry, --| No_Such_Occurrence --| Effects: Returns a handle to the occurrence Occurence of the dictionary --| entry having the type Template and the name Identifier. If --| Open_Dictionary hasn't been called first, No_Dictionary_File is raised. --| If the dictionary does not contain any entries having type Template and --| name identifier, No_Such_Dictionary_Entry is raised. If Occurrence is --| greater than the number of occurrences, No_Such_Occurrence is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Entry_Exists( --| Determines whether an entry exists Template : TP.Template_Name; --| Template type of entry Identifier : SS.Screen_String; --| Entry identifier Occurrence : Overload_Range --| Occurrence of template, identifier := 1 ) return Boolean; --| Raises: No_Dictionary_File --| Effects: This function returns whether or not an entry of type Template --| and name Identifier exists. If Open_Dictionary hasn't been called --| first, No_Dictionary_File is raised. In order to check whether a --| Template + Identifier pair exists (without checking for a specific --| occurrence), let Occurrence default to 1. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Unique_Entry( --| Determines whether an entry is unique Template : TP.Template_Name; --| Template type of entry Identifier : SS.Screen_String --| Entry identifier ) return Boolean; --| Raises: No_Dictionary_File, No_Such_Dictionary_Entry --| Effects: This function returns whether or not an entry of type Template --| and name Identifier is unique. If exactly one entry of type Template --| and name Identifier exists, Unique_Entry returns True. If more than --| one entry with type Template and name Identifier exists, Unique_Entry --| returns false. If Open_Dictionary hasn't been called first, --| No_Dictionary_File is raised. If no entry with type Template and name --| Identifier exists in the dictionary, No_Such_Dictionary_Entry is --| raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Overloads( --| Returns overload fields for an entry Template : TP.Template_Name; --| Template type of entry Identifier : SS.Screen_String --| Entry identifier ) return Overload_Array; --| Raises: No_Dictionary_File, No_Such_Dictionary_Entry --| Effects --| Returns an array of <overload> fields for all instances of an --| "overloaded" name (i.e. a name of an entry of a particular template --| type which appears more than one time in the dictionary). --| If Open_Dictionary hasn't been called first, No_Dictionary_File is --| raised. If no entry with type Template and name Identifier exists in --| the dictionary, No_Such_Dictionary_Entry is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Delete_Entry( --| Deletes dictionary entry Entry_Handle : Dictionary_Entry_Handle --| Entry to delete ); --| Raises: Invalid_Entry_Handle, No_Such_Dictionary_Entry --| Effects: The entry referenced by Entry_Handle is deleted. --| If Entry_Handle is null, Invalid_Entry_Handle is raised. --| If Entry_Handle wasn't originally retrieved from the dictionary (i.e. --| it was created with New_Entry_Handle or it was previously deleted), --| No_Such_Dictionary_Entry is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Create_Entry( --| Creates a new entry Entry_Handle : Dictionary_Entry_Handle --| Entry to create ); --| Raises: No_Dictionary_File, Invalid_Entry_Handle, Null_Identifier, --| No_Overload_Field, Too_Many_Overloads --| Effects: A new data dictionary entry is created from Entry_Handle. --| No_Dictionary_File is raised if Open_Dictionary hasn't been --| called first. Invalid_Entry_Handle is raised if Entry_Handle is null. --| Null_Identifier is raised when the identifier field in the handle is --| the null string. No_Overload_Field is raised if there are more than --| one entry with the particular template type and identifier as --| specified in the object referenced by Entry_Handle, and the <overload> --| field is not filled out. Too_Many_Overloads is raised when an attempt --| is made to create an entry whose name has already been overloaded the --| maximum number of times. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Update_Entry( --| Updates an existing dictionary entry Entry_Handle : Dictionary_Entry_Handle --| Handle referencing entry to update ); --| Raises: No_Dictionary_File, Invalid_Entry_Handle, Null_Identifier --| No_Overload_Field, Too_Many_Overloads, Cant_Update_New_Entry --| Effects: The entry in the data dictionary corresponding to the object --| referenced by Entry_Handle is updated. No_Dictionary_File is raised if --| Open_Dictionary hasn't been called. Invalid_Entry_Handle is raised --| when the Entry_Handle is null. Null_Identifier is raised when the --| identifier field in the handle is the null string. Too_Many_Overloads --| is raised when an attempt is made to create (by updating with a --| a different identifier field) an entry whose name has already been --| overloaded the maximum number of times. Cant_Update_New_Entry is --| raised when an attempt to update an item which does not already exist --| in the dictionary. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Update_Field( --| Updates a field in entry Entry_Handle : Dictionary_Entry_Handle; --| Entry to update Field_Number : TP.Variable_Field_Number_Range; --| Which field to update New_Contents : SS.Screen_String --| new contents of field ); --| Raises: Field_Not_Found, Invalid_Entry_Handle --| Effects: The contents of field Field_Number are changed to --| New_Contents in the entry referenced by Entry_Handle. If the --| Entry_Handle is null, Invalid_Entry_Handle is raised. If the --| Field_Number is invalid, Field_Not_Found is raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Field_Contents( --| Returns the contents of a field Entry_Handle : Dictionary_Entry_Handle; --| Entry from which to get field contents Field_Number : TP.Variable_Field_Number_Range --| Which field to retrieve ) return SS.Screen_String; --| Raises: Invalid_Entry_Handle, Field_Not_Found --| Effects: The contents of the field Field_Number in the entry referenced --| by Entry_Handle are returned. If the Entry_Handle is null, --| Invalid_Entry_Handle is rasied. If the Field_Number is invalid, --| Field_Not_Found is raised. Field_Number is the variable field number --| of the field (Dictionary_Manager has no knowledge of static fields). --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Template_Kind( --| Returns the template type for handle Entry_Handle : Dictionary_Entry_Handle --| Entry from which to get template ) return TP.Template_Name; --| Raises: Invalid_Entry_Handle --| Effects: The template type for Entry_Handle is returned. --| Invalid_Entry_Handle is raised if Entry_Handle is null. --| N/A: Requires, Modifies --------------------------------------------------------------------------- private type Data_Array is array(TP.Variable_Field_Number_Range) of SS.Screen_String; package DIO is new Direct_IO(Data_Array); type Dictionary_Entry_Descriptor is record Template : TP.Template_Name; --| Name of corresponding template Data : Data_Array; --| Contents of fields --| Data(TP.Variable_Field_Number_Range'First): identifier field --| Data(TP.Variable_Field_Number_Range'First + 1): overload field Read_From : DIO.Count; --| File position from which item --| was read. end record; type Dictionary_Entry_Handle is access Dictionary_Entry_Descriptor; --------------------------------------------------------------------------- end Dictionary_Manager; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --CDRIVER.ADA --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Text_IO; use Text_IO; with Dictionary_Manager; with Standard_Interface; with DD_Release; with String_Pkg; with Host_Lib; ------------------------------------------------------------------------------- function Create_Dictionary_Driver return Integer is --| Interprets command line and calls DM routine to create a data dictionary package DM renames Dictionary_Manager; package SI renames Standard_Interface; package SP renames String_Pkg; package Str_Argument is new SI.String_Argument("String"); Create_Handle : SI.Process_Handle; begin -- Error messages go to standard error Host_Lib.Set_Error; SI.Set_Tool_Identifier(DD_Release); SI.Define_Process( Name => "Create_Dictionary", Help => "Create a data dictionary", Proc => Create_Handle); Str_Argument.Define_Argument( Proc => Create_Handle, Name => "Dictionary", Help => "Full directory name of dictionary to be created"); SI.Parse_Line(Create_Handle); DM.Create_Dictionary(SP.Value(Str_Argument.Get_Argument( Proc => Create_Handle, Name => "Dictionary"))); return Host_Lib.Return_Code(Host_Lib.Success); exception when SI.Abort_Process => return Host_Lib.Return_Code(Host_Lib.Error); when SI.Process_Help => return Host_Lib.Return_Code(Host_Lib.Information); when DM.Cant_Create_Directory => Put_Line( "Can't create dictionary " & SP.Value(Str_Argument.Get_Argument( Proc => Create_Handle, Name => "Dictionary")) & "."); return Host_Lib.Return_Code(Host_Lib.Error); when others => Put_Line("Create_Dictionary internal error."); return Host_Lib.Return_Code(Host_Lib.Error); end Create_Dictionary_Driver; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --SCREENMGR.SPC --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Screen_Strings; with Dictionary_Manager; with Templates; ------------------------------------------------------------------------------- package Screen_Manager is --| Provide functions for displaying templates, menus, text and lines on the --| screen. --| Overview --| --| This package provides all screen management functions for use in --| displaying and editing templates on the screen. The following --| operations are provided: --| --| Clear_Message_Line - Clears the message line --| Scroll_Prompt_Lines - Scrolls the prompt lines --| Display_Message - Displays a message on the message line --| Display_Blank_Template - Displays a blank template form --| Display_Filled_Template - Displays a filled in template --| Display_Prompt - Displays a prompt on the prompt line --| Display_Secondary_Prompt - Displays a "secondary" prompt on prompt line --| Display_Menu - Displays a menu of choices --| Position_For_Exit - Repositions the cursor at bottom of screen --| Display_Command_List - Displays a list of commands --| Display_Field - Displays the contents of a field --| --| The screen is divided into 3 sections: the first 20 lines are reserved --| for the template, the 21st line is blank, the 22nd and 23rd lines are the --| prompt lines (22nd line contains what was just entered and 23rd line is --| where user types), and the 24th line is the message line. ------------------------------------------------------------------------------- package SS renames Screen_Strings; package DM renames Dictionary_Manager; package TP renames Templates; ------------------------------------------------------------------------------- -- Exceptions Secondary_Prompt_Too_Long : exception; --| Secondary prompt is too long to --| fit within line ------------------------------------------------------------------------------- -- Types and Objects type Message_Name is (Error, Warning, Help, Info); --| Type of message being displayed on message line type Menu_Mode_Name is (Prompt, Continue); --| Type of menu being presented (a menu to make a choice from, or just a --| list. Max_Lines : constant := 24; --| Maximum number of lines on the screen subtype Line_Range is Positive range 1 .. Max_Lines; --| Range of lines for the entire screen subtype Section1_Line_Range is Positive range Line_Range'First .. Line_Range'Last - 3; --| Range of lines for section one of the screen type Screen_Array is array(Section1_Line_Range) of SS.Screen_String; --| Array of screen strings corresponding to what is displayed on screen ------------------------------------------------------------------------------- -- Operations procedure Clear_Message_Line; --| Clears message line --| Effects: The message line is cleared. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Scroll_Prompt_Lines( --| Scrolls the prompt lines Old_Text : SS.Screen_String --| Text entered at last prompt ); --| Effects: The line containing the command entered is scrolled up --| one line and the "current prompt" (set by Display_Prompt) is redrawn --| on the prompt line. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Display_Message( --| Displays message on the message line Text : SS.Screen_String; --| Text to be displayed Name : Message_Name := Error --| Type of message ); --| Effects: A message is displayed on the message line. The first --| part of the message is a code for the type of message, specified --| by Name, and the second part is the message text, specified by Text. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Display_Blank_Template( --| Displays a blank template form Template : TP.Template_Name --| Type of template to display ); --| Effects: Displays a blank template of type Template on the screen. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Display_Filled_Template( --| Displays filled in template Entry_Handle : DM.Dictionary_Entry_Handle --| Entry which contains information to display ); --| Effects: Displays a template filled in with the information in --| the dictionary entry referenced by Entry_Handle. If the text in --| a field is null, the field label is displayed rather than the text. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Display_Prompt( --| Displays prompt on prompt line Prompt_Text : SS.Screen_String; --| Text for the prompt Field_Prompt : Boolean := True --| type of prompt ); --| Effects: Displays a prompt. If the prompt is a field prompt (as --| specified by Field_Prompt), it consists of the text Prompt_Text --| enclosed in angle brackets and followed by a colon and a space --| on the prompt line. Otherwise, just Prompt_Text is displayed, and --| current prompt and previous prompt are not modified. --| Modifies: current prompt, previous prompt --| N/A: Raises, Requires --------------------------------------------------------------------------- procedure Display_Secondary_Prompt( --| Displays a "secondary" prompt on --| the prompt line Prompt_Text : SS.Screen_String --| Text for the prompt ); --| Raises: Secondary_Prompt_Too_Long --| Effects: Displays a prompt which consists of the text Prompt_Text --| on the prompt line, but starting at the middle column on the screen --| rather than at the left edge of the screen. The "current prompt" is --| not altered. Secondary_Prompt_too_Long is raised if Prompt_Text + 5 --| (to allow room for a response) is too long to fit on the screen. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Display_Menu( --| Displays a menu of choices Menu : DM.Overload_Array; --| Menu to display Menu_Mode : Menu_Mode_Name := --| Mode of menu Prompt; Template : TP.Template_Name := --| Name of template to which menu TP.Object_Decl; --| corresponds Identifier : SS.Screen_String := --| Name of identifier to which menu SS.Create("") --| corresponds ); --| Effects: The contents of Menu are numbered and displayed on the --| screen. Menu_Mode specifies whether to display a prompt for a choice --| or the message "--Press return to continue--." If Identifier is not --| the null string, then a "header" for the menu is printed containing --| template and identifier. If Identifier is the null string, this header --| is not printed and the contents of template are irrelevant. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Position_for_Exit; --| Repositions cursor at bottom of the screen --| Effects: The cursor is repositioned at the bottom of the screen in --| order that the editor exits neatly. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Display_Command_List( --| Displays a list of commands Command_List : Screen_Array --| List of commands ); --| Effects: Command_List is displayed on the screen. The message --| "--Press return to continue--" is displayed on the prompt line. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Display_Field( --| Displays contents of a field Entry_Handle : DM.Dictionary_Entry_Handle; --| Entry containing field to display Field_Number : TP.Actual_Field_Number_Range --| Which field to display ); --| Effects: The contents of the Field Field_Number in dictionary entry --| referenced by Entry_Handle are displayed on the screen. If the text in --| a field is null, the field label is displayed rather than the text. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- end Screen_Manager; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --COMMANDS.SPC --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Screen_Strings; use Screen_Strings; with Templates; ------------------------------------------------------------------------------- package Commands is --| Provide procedures to process all interactive commands. --| Overview --| --| This package provides procedures to process all of the interactive --| commands. Nested package Editing_Commands contains all of the procedures --| for processing the commands once they are parsed. Procedure --| Process_Commands opens the dictionary, calls the internal procedures which --| parse the commands and call the Editing_Commands procedures, and closes --| the dictionary. ------------------------------------------------------------------------------- -- Exceptions Abort_Commands : exception; --| Raised when interrupt or end of file --| character is read -- Operations procedure Process_Commands( --| Processes editor commands Dictionary_Name : in String; --| Name of dictionary Template : in Templates.Template_Name; --| Type of template to edit Identifier : in Screen_String := Create("") --| Name of dictionary entry ); --| Raises: Abort_Commands --| Effects: This procedure opens the dictionary, processes editor commands --| and closes the dictionary. Abort_Commands is raised when an interrupt --| or end of file character is read. --| N/A: Requires, Modifies --------------------------------------------------------------------------- package Editing_Commands is procedure Edit( --| Displays template for editing Template : in Templates.Template_Name; --| Type of template to edit Identifier : in Screen_String := Create("") --| Name of dictionary entry ); --| Raises: Abort_Commands --| Effects: This procedure displays a template on the screen for --| editing. If Identifier is "", the default, then an empty template --| is displayed. If the entry specified by Template and Identifier --| is not found in the dictionary, an empty template is displayed --| along with a warning message. The user's prompt is then --| displayed as the first field. If there are two or more entries --| in the dictionary with the same template type (Template) and name --| (Identifier), a menu of all <overload> fields, which distinguish --| entries with the same name from one another is displayed and the --| user must select the appropriate entry. Abort_Commands is raised --| when an interrupt or end of file character is read. --| N/A: Requires, Modifies ----------------------------------------------------------------------- procedure Delete( --| Deletes an entry from the dictionary Template : in Templates.Template_Name; --| Type of template to delete Identifier : in Screen_String --| Name of entry to delete ); --| Raises: Abort_Commands --| Effects: This procedure deletes a dictionary entry of type Template --| and with name Identifier from the dictionary. If the entry is not --| found in the dictionary, an error message is given. If there are --| two or more entries in the dictionary with the same template type --| and identifier, a menu of all <overload> fields, which distinguish --| entries with the same name from one another is displayed and the --| user must select the appropriate entry. Abort_Commands is raised --| when an interrupt or end of file character is read. --| N/A: Requires, Modifies ----------------------------------------------------------------------- procedure Show_Overloads( --| Displays a menu of <overload>s Template : in Templates.Template_Name; --| Template type to show Identifier : in Screen_String --| Dictionary entry to show ); --| Raises: Abort_Commands --| Effects: This procedure displays a menu of the <overload> fields --| for all templates of type Template and having name Identifier. --| If the entry is not found in the dictionary, an error message is --| given. The user does not have to make any choice from this menu --| and may go back to editing by hitting the return key. --| Abort_Commands is raised when an interrupt or end of file --| character is read. --| N/A: Requires, Modifies ----------------------------------------------------------------------- procedure Show_Commands; --| Displays a list of commands --| Raises: Abort_Commands --| Effects: Displays a list of all the commands which are legal --| in the current context. Abort_Commands is raised when an --| interrupt or end of file character is read. --| N/A: Requires, Modifies ----------------------------------------------------------------------- procedure Refresh; --| Refreshes screen display --| Effects: Redraws the contents of the screen. --| N/A: Raises, Requires, Modifies ----------------------------------------------------------------------- procedure Show_Help_Field; --| Shows help associated with a field --| Effects: Displays the help associated with the current field. --| N/A: Raises, Requires, Modifies ----------------------------------------------------------------------- procedure n_Lines( --| Move a specified number of lines n : in Integer := 1 --| Number of lines to move ); --| Effects: The first field on the line n lines from the current --| field becomes the current field (and prompt). If n is positive, --| the field is n lines after the current line; if n is negative, the --| field is n lines before the current line. The furthest away that --| one may move with this command is the last line on the screen in --| the forward direction and the first line on the screen in the --| backward direction. --| Modifies: Current line, current field and prompt. --| N/A: Raises, Requires ----------------------------------------------------------------------- procedure nth_Line( --| Move to the specified line. n : in Integer --| Line to move to. ); --| Effects: The first field on the nth line becomes the current --| field (and prompt). If n < 1, the first field on the first --| line becomes the current field; if n > number of fields, the --| first field on the last line becomes the current field. --| Modifies: Current line, current field and prompt. --| N/A: Raises, Requires ----------------------------------------------------------------------- procedure n_Fields( --| Move a specified number of fields n : in Integer := 1 --| Number of fields to move ); --| Effects: The field n fields from the current field becomes the --| current field (and prompt). If n is positive, the field is n --| fields after the current field; if n is negative, the --| field is n fields before the current field. The furthest away that --| one may move with this command is the last field on the screen in --| the forward direction and the first field on the screen in the --| backward direction. --| Modifies: Current line, current field and prompt. --| N/A: Raises, Requires ----------------------------------------------------------------------- procedure nth_Field( --| Move to the specified field. n : in Integer --| Field to move to. ); --| Effects: The nth field becomes the current field (and prompt). --| If n < 1, the first field becomes the current field; if n > --| number of fields, the last field becomes the current field. --| Modifies: Current line, current field and prompt. --| N/A: Raises, Requires ----------------------------------------------------------------------- procedure Go_To_Field( --| Move to the specified field. Fieldname : in Screen_String --| Field to move to. ); --| Effects: The field with name Fieldname becomes the current field --| (and prompt). If Fieldname doesn't exist in template, an error --| message is given and current field doesn't change. --| Modifies: Current line, current field and prompt. --| N/A: Raises, Requires ----------------------------------------------------------------------- procedure Insert_Text( --| Enters text in current field Text : in Screen_String --| Text to enter ); --| Effects: Inserts Text into the current field. The previous --| contents of the field are overwritten. A warning message is --| given if text must be truncated in order to fit in the field. --| N/A: Raises, Requires, Modifies ----------------------------------------------------------------------- procedure Substitute( --| Substitutes a string for another From_Text : in Screen_String; --| old string To_Text : in Screen_String --| new string ); --| Effects: Substitutes To_Text for From_Text in the current field. --| A warning message is given if the From_Text does not exist in --| the current field. A warning message is given if new text would --| be too long too fit into the current field. --| N/A: Raises, Requires, Modifies ----------------------------------------------------------------------- procedure Create; --| Creates a dictionary entry from current template --| Effects: A new dictionary entry is created from the template on the --| screen. If an entry with this name already exists, the <overload> --| field in the template must be filled out in order for the entry to --| be created. --| N/A: Raises, Requires, Modifies ----------------------------------------------------------------------- procedure Update; --| Updates a dictionary entry from current template --| Effects: Updates an entry in the dictionary. For new entries this --| command has the same effect as Create. --| N/A: Raises, Requires, Modifies ----------------------------------------------------------------------- procedure Exit_Editor; --| Exits from the editor --| Raises: Abort_Commands --| Effects: Repositions the cursor at the bottom of the screen and --| exits. Abort_Commands is raised when an interrupt or end of file --| character is read. --| N/A: Requires, Modifies ----------------------------------------------------------------------- end Editing_Commands; --------------------------------------------------------------------------- end Commands; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --UPDATE.SPC --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ------------------------------------------------------------------------------- package Update is --| Update command processor -- Exceptions Abort_Update : exception; --| Raised when error occurred opening any files -- Operations procedure Process_Update_Commands( --| Processes all update commands Dictionary_Name : String; --| Name of dictionary Command_File_Name : String --| File of update commands ); --| Effects: Reads Command_File and processes update commands. Commands --| are create, update and delete. --| --| delete template-type identifier --| {create, update} template-type identifier --| <fieldname>contents --| <fieldname>contents --| etc. --| --| for example: --| create function foo --| <type>bar --| <overload>explanation -- Exceptions Command_File_Error : exception; --| Error occurred while opening command --| file --------------------------------------------------------------------------- end Update; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --COMMANDS.BDY --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Terminal_IO; with Dictionary_Manager; with Screen_Manager; with String_Utilities; ------------------------------------------------------------------------------- package body Commands is --| Provide procedures to process all interactive commands. --| Overview --| --| This package provides procedures to process all of the interactive --| commands. Nested package Editing_Commands contains all of the subprograms --| for processing the commands once they are parsed. Procedure --| Process_Commands opens the dictionary, processes editor commands and calls --| Interpret_Command, and closes the dictionary. Procedure Interpret_Command --| parses the command and calls the appropriate procedure in the nested --| package Editing_Commands. --------------------------------------------------------------------------- -----------------------------Local Declarations---------------------------- package TIO renames Terminal_IO; package DM renames Dictionary_Manager; package EC renames Editing_Commands; package SM renames Screen_Manager; package SS renames Screen_Strings; package SU renames String_Utilities; package TP renames Templates; package Screen_String_Utilities is new SU.Generic_String_Utilities( Generic_String_Type => SS.Screen_String, To_Generic => SS.Unchecked_Create, From_Generic => SS.Value); package SSU renames Screen_String_Utilities; Command_List : SM.Screen_Array := ( SS.Create("ED[IT] template-type [identifier] - edit dictionary entry"), SS.Create("D[ELETE] template-type identifier - delete dictionary entry"), SS.Create("S[HOW] template-type identifier - show overloads for dictionary entry"), SS.Create("CO[MMANDS] - show command list"), SS.Create("R[EFRESH] - refresh the screen"), SS.Create("H[ELP] - help for field"), SS.Create("+nL[INES] - go down n lines"), SS.Create("-nL[INES] - go up n lines"), SS.Create("nL[INE] - go to nth line"), SS.Create("+n[FIELDS] - go down n fields"), SS.Create("-n[FIELDS] - go up n fields"), SS.Create("nF[IELD] - go to nth field"), SS.Create("<fieldname> - go to field named 'fieldname'"), SS.Create("&text - insert 'text'"), SS.Create("/oldstring/newstring[/] - replace 'oldstring' with 'newstring'"), SS.Create("CR[EATE] - create new entry in dictionary"), SS.Create("U[PDATE] - update existing entry in dictionary"), SS.Create("EX[IT] - exit editor"), SS.Create(""), SS.Create("Available templates are: OBJECT_DECL, TYPE_DECL, PROCEDURE_DECL,"), SS.Create("FUNCTION_DECL, TASK_DECL, EXCEPTION_DECL"), SS.Create(""), others => SS.Create("")); -- work around DEC compiler bug with "when others =>" type Abort_Code_Name is (End_of_File_Condition, Interrupt_Condition); --| what type of signal was received, causing an abort Exit_Found : Boolean := False; --| Whether exit command was --| entered Current_Template : TP.Template_Name; --| Template being edited Current_Handle : DM.Dictionary_Entry_Handle; --| Handle of entry being edited Current_Field : TP.Variable_Field_Number_Range := 1; --| Current field being edited Prompt_Line : SS.Screen_String := SS.Create(""); --| Current contents of prompt Modified_Template : Boolean := False; --| Whether any changes have --| been made to current entry -- Character constants Plus_Key : constant Character := '+'; --| Forward key Minus_Key : constant Character := '-'; --| Backward key Open_Fieldname_Key : constant Character := '<'; --| Start of fieldname --| symbol Close_Fieldname_Key : constant Character := '>'; --| End of fieldname --| symbol Insert_Key : constant Character := '&'; --| Insert text command Substitute_Delimiter : constant Character := '/'; --| Substitute command Escape_Character : constant Character := '''; --| Substitute command --| escape character --------------------------------------------------------------------------- -- Exceptions Nonexistent_Command : exception; --| Raised when command entered is not --| one of the editor commands Ambiguous_Command : exception; --| Raised when command does not --| uniquely match an editor command Too_Many_Parameters : exception; --| Raised when command line contains --| characters in addition to command --| and appropriate number of parameters Missing_Nth_Line_or_Field_Command --| Raised when line or field : exception; --| command is not entered Missing_Fieldname : exception; --| Raised when fieldname is not entered Incomplete_Fieldname : exception; --| Raised when Close_Fieldname_Key is --| missing Missing_Old_String : exception; --| Raised when oldstring is not entered Incomplete_Substitution --| Raised when Substitute_Delimiter : exception; --| between old and new strings is --| missing Invalid_Escape_Sequence --| Raised when the Escape_Character is : exception; --| not typed in conjunction with itself --| or the Substitute_Delimiter Invalid_Substitute_Delimiter --| Raised when Substitute_Delimiter : exception; --| not in appropriate location Missing_Template_Type --| Raised when a command which requires : exception; --| template parameter is missing it Invalid_Template_Type --| Raised when specified template_type : exception; --| doesn't exist Missing_Identifier : exception; --| Raised when command which requires --| identifier parameter is missing it Not_In_Dictionary : exception; --| Raised when dictionary entry --| (Template, Identifier) doesn't exist Fieldname_Not_In_Template --| Raised when specified fieldname does : exception; --| not exist in current template No_Oldstring_Match : exception; --| Raised when substitution oldstring --| does not exist in template field Too_Long_For_Field : exception; --| Raised when substitution newstring --| would not fit in current field Internal_Error : exception; --| Raised in case statement for --| 'when others' which should never --| execute --------------------------------------------------------------------------- -----------------------Local Subprogram Specifications--------------------- procedure Abort_Editor( --| Stops processing of editing commands Abort_Code : Abort_Code_Name --| What caused processing to abort ); --| Raises: Abort_Commands --| Effects: The dictionary is closed and an error message is printed. --| The text of the error message is determined by the Abort_Code. --| Abort_Commands is always raised. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Interpret_Command( --| Parses In_Text; returns command name In_Text : in Screen_String --| Command to parse ); --| Effects: This procedure parses In_Text and calls the appropriate --| command routine in nested package Editing_Commands. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Parse_n_Lines_or_Fields( --| Parses for number and command and --| calls either n_Fields or n_Lines Text_Scanner : in SU.Scanner --| Command to parse ); --| Raises: Too_Many_Parameters, Nonexistent_Command --| Effects: Parses Text_Scanner for number and command (lines/fields) --| and calls either n_Fields or n_Lines. The acceptable formats for the --| Move n Fields or Lines commands are as follows, where brackets denote --| optional parts: +nF[IELDS] , -nF[IELDS] , +nL[INES] , -nL[INES] . --| Too_Many_Parameters is raised if command line contains characters --| after lines/fields command. Nonexistent_Command is raised if --| command after n is not either lines or fields command. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Parse_nth_Line_or_Field( --| Parses for number and command, --| calls either nth_Field or nth_Line Text_Scanner : in SU.Scanner --| Command to parse ); --| Raises: Missing_Nth_Line_or_Field_Command, --| Too_Many_Parameters, Nonexistent_Command --| Effects: Parses Text_Scanner for number and command (line/field) --| and calls either nth_Field or nth_Line. The acceptable formats for the --| Go to nth Field or Line commands are as follows, where brackets denote --| optional parts: nL[INE] , nF[IELD] . Missing_Nth_Line_or_Field_Command --| is raised if line/field command is not entered. Too_Many_Parameters --| is raised if command line contains characters after line/field command --| Nonexistent_Command is raised if command is not either line or field --| command. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Parse_Fieldname( --| Parses Text for fieldname, calls --| Go_to_Field Text_Scanner : in SU.Scanner --| Command to parse ); --| Raises: Incomplete_Fieldname, Missing_Fieldname, --| Too_Many_Parameters --| Effects: Parses Text_Scanner for parameter (fieldname) and calls --| Go_to_Field. The acceptable format for the Go to Fieldname command is --| as follows : <fieldname> . Incomplete_Fieldname is raised if --| Close_Fieldname_Key is missing. Missing_Fieldname is raised if --| fieldname is not entered. Too_Many_Parameters is raised if command --| line contains characters after Close_Fieldname_Key (>). --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Parse_Insert( --| Parses for text to insert, --| calls Insert_Text Text_Scanner : in SU.Scanner --| Command to parse ); --| Effects: Parses Text_Scanner for parameter (text to insert) --| and calls Insert_Text. The acceptable format for the Insert Text --| command is as follows : &text . --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Get_Substitution_String( Text_Scanner : in SU.Scanner; --| Command to parse Delimiter : in Character; --| Substitution delimiter Escape : in Character; --| Escape character Result : in out SS.Screen_String; --| Substitution string End_of_Line : out Boolean --| Signals end of line ); --| Raises: Invalid_Substitute_Delimiter, Invalid_Escape_Sequence --| Effects: Parses Text_Scanner for string and checks for presence --| of escape character (''') turning delimiter ('/') and escape into --| literals. Invalid_Substitute_Delimiter is raised if --| Substitute_Delimiter not in appropriate location. --| Invalid_Escape_Sequence is raised if the Escape_Character is not --| typed in conjunction with itself or the Substitute_Delimiter. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Parse_Substitute( --| Parses Text for oldstring and --| newstring and calls Substitute Text_Scanner : in SU.Scanner --| Command to parse ); --| Raises: Missing_Old_String, Incomplete_Substitution, --| Too_Many_Parameters --| Effects: Parses Text_Scanner for parameters (oldstring, newstring) --| and calls Substitute. The acceptable format for the Substitution --| command is as follows, where brackets denote optional parts: --| /oldstring/newstring[/] . Missing_Old_String is raised if oldstring --| is not entered. Incomplete_Substitution is raised if the delimiter --| between old and new strings is missing. Too_Many_Parameters is raised --| if command line contains characters after closing delimiter. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Parse_Alphabetic_Commands( --| Parses Text for command and --| parameters and calls appropriate --| procedure Text_Scanner : in SU.Scanner --| Command to parse ); --| Raises: Ambiguous_Command, Nonexistent_Command, --| Too_Many_Parameters, Missing_Template_Type, --| Invalid_Template_Type, Missing_Identifier --| Effects: Parses Text_Scanner for command and parameters and calls --| appropriate procedure. The following are the acceptable formats for --| the alphabetic commands, where brackets denote optional parts: --| CO[MMANDS], --| ED[IT] template-type [identifier] , D[ELETE] template-type identifier , --| S[HOW] template-type identifier , R[EFRESH] , H[ELP] , CR[EATE] , --| U[PDATE] , EX[IT] . Ambiguous_Command is raised if specified command --| does not uniquely match one of array of editor commands. --| Nonexistent_Command is raised if command is not one of acceptable --| editor commands. Missing_Template_Type is raised if Delete, Edit, or --| Show commands are typed without any parameters. Missing_Identifier --| is raised if Delete or Show commands are typed without a second --| parameter. Too_Many_Parameters is raised if the command line contains --| characters after command and parameters. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Identifier_Text( --| Checks text about to be inserted to --| identifier field Text : SS.Screen_String --| Text to be checked ) return SS.Screen_String; --| Effects: Text is checked to ensure that it is only one word long. --| If it is more than one word long, an error message is printed and --| the first word in the Text is returned. Otherwise, Text is returned. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- -----------------------External Subprogram Bodies-------------------------- procedure Process_Commands( Dictionary_Name : in String; --| Name of dictionary Template : in Templates.Template_Name; --| Type of template to edit Identifier : in SS.Screen_String := SS.Create("") --| Name of dictionary entry ) is Command_Line : Screen_String; --| Command_Line read from terminal Truncated : Boolean; --| whether or not a screen string was --| truncated on create. begin DM.Open_Dictionary(Dictionary_Name); TIO.Set_Cursor(1, 1); TIO.Clear_Screen; -- call edit with command line parameters EC.Edit(Template, Identifier); Exit_Found := False; while not Exit_Found loop begin SS.Create(TIO.Read, Command_Line, Truncated); exception when TIO.End_of_File_Error => Abort_Editor(End_of_File_Condition); end; if Truncated then SM.Display_Message( SS.Create("Text was truncated"), SM.Warning); end if; SM.Clear_Message_Line; -- interpret command line Interpret_Command(Command_Line); -- scroll the prompt lines if not Exit_Found then SM.Scroll_Prompt_Lines(Command_Line); end if; end loop; DM.Close_Dictionary; end Process_Commands; --------------------------------------------------------------------------- package body Editing_Commands is procedure Edit( --| Displays template for editing Template : in Templates.Template_Name; --| Type of template to edit Identifier : in SS.Screen_String := SS.Create("") --| Name of dictionary entry ) is Choice : SS.Screen_String --| Menu choice := SS.Create(""); Truncated : Boolean; --| whether screen_string was --| truncated on a create Occurrence : Integer := 1; --| which overload of template --| + identifier Dummy : SS.Screen_String; begin -- If template has been modified by insert or substitute, prompt -- user to save changes before executing edit command if Modified_Template then while (SS.Length(Choice) /= 1) or else not (SS.Equal(Choice, "n") or SS.Equal(Choice, "N") or SS.Equal(Choice, "y") or SS.Equal(Choice, "Y") or SS.Equal(Choice, "*")) loop SM.Display_Message( SS.Create("Template has been modified"), SM.Warning); SM.Display_Secondary_Prompt( SS.Create("Save? (y, n, * to abort) : ")); begin Choice := SS.Unchecked_Create(TIO.Read); exception when TIO.End_of_File_Error => Abort_Editor(End_of_File_Condition); end; Choice := SSU.Strip_Leading(Choice); Choice := SSU.Strip_Trailing(Choice); end loop; -- legal choices are n, N, y, Y, * case SS.Value(Choice)(1) is when 'n' | 'N' => SM.Clear_Message_Line; when 'y' | 'Y' => begin -- try to use update to save the changes. If it fails -- because entry doesn't already exist (and therefore -- not "updatable", then create instead.) EC.Update; SM.Display_Secondary_Prompt( SS.Create("--Press return to continue--")); begin Dummy := SS.Unchecked_Create(TIO.Read); exception when TIO.End_of_File_Error => Abort_Editor(End_of_File_Condition); end; exception when DM.Cant_Update_New_Entry => EC.Create; SM.Display_Secondary_Prompt(SS.Create( "--Press return to continue--")); begin Dummy := SS.Unchecked_Create(TIO.Read); exception when TIO.End_of_File_Error => Abort_Editor(End_of_File_Condition); end; end; when '*' => -- abort the edit command SM.Clear_Message_Line; return; when others => raise Internal_Error; end case; end if; Current_Field := 1; Current_Template := Template; if not DM.Entry_Exists(Template, Identifier) then -- if it's not found, put up blank template of type Template SM.Display_Blank_Template(Template); if not SS.Equal(Identifier, "") then SM.Display_Message( SS.Unchecked_Create( SS.Value(Identifier) & " not found. (New Template)"), SM.Warning); Current_Handle := DM.New_Entry_Handle(Template); -- fill in identifier field with specified identifier DM.Update_Field( Current_Handle, Current_Field, Identifier); SM.Display_Field( Current_Handle, TP.Actual_Field_Number(Template, Current_Field)); -- set Modified_Template, since specifying a new identifier -- is a modification Modified_Template := True; else SM.Display_Message( SS.Create("New Template"), SM.Warning); Current_Handle := DM.New_Entry_Handle(Template); end if; else -- if Template + Identifier exists in the dictionary but isn't -- unique, display a menu of choices if not DM.Unique_Entry(Template, Identifier) then SM.Display_Menu( DM.Overloads(Template, Identifier), SM.Prompt, Template, Identifier); loop -- Get menu choice SM.Display_Prompt( SS.Create("Enter choice: "), Field_Prompt => False); begin SS.Create(TIO.Read, Choice, Truncated); exception when TIO.End_of_File_Error => Abort_Editor(End_of_File_Condition); end; SM.Clear_Message_Line; if Truncated then SM.Display_Message( SS.Create("Text was truncated"), SM.Warning); end if; begin Occurrence := Integer'Value(SS.Value(Choice)); exception when Constraint_Error => Occurrence := DM.Overload_Range'Last + 1; end; if Occurrence not in DM.Overload_Range then SM.Display_Message( SS.Create("Invalid menu choice"), SM.Warning); end if; exit when Occurrence in DM.Overload_Range; end loop; end if; -- set Modified_Template to False, since the new template -- hasn't been modified yet Modified_Template := False; SM.Clear_Message_Line; Current_Handle := DM.Entry_Handle(Template, Identifier, Occurrence); SM.Display_Filled_Template(Current_Handle); end if; Prompt_Line := TP.Field_Label(Template, TP.Actual_Field_Number(Template, 1)); SM.Display_Prompt(Prompt_Line); end Edit; ----------------------------------------------------------------------- procedure Delete( --| Deletes an entry from the dictionary Template : in Templates.Template_Name; --| Type of template to delete Identifier : in SS.Screen_String --| Name of entry to delete ) is Choice : SS.Screen_String --| menu choice := SS.Create(""); Truncated : Boolean; --| whether or not screen string --| was truncated on create Occurrence : Integer := 1; --| which occurrence of Template + --| Identifier begin if not DM.Entry_Exists(Template, Identifier) then raise Not_In_Dictionary; end if; if not DM.Unique_Entry(Template, Identifier) then SM.Display_Menu(DM.Overloads(Template, Identifier), SM.Prompt, Template, Identifier); loop -- Get menu choice SM.Display_Prompt( SS.Create("Enter choice (* to abort): "), Field_Prompt => False); begin SS.Create(TIO.Read, Choice, Truncated); exception when TIO.End_of_File_Error => Abort_Editor(End_of_File_Condition); end; Choice := SSU.Strip_Leading(Choice); Choice := SSU.Strip_Trailing(Choice); SM.Clear_Message_Line; if Truncated then SM.Display_Message( SS.Create("Text was truncated"), SM.Warning); end if; if SS.Value(Choice) /= "*" then begin Occurrence := Integer'Value(SS.Value(Choice)); exception when Constraint_Error => Occurrence := DM.Overload_Range'Last + 1; end; if Occurrence not in DM.Overload_Range then SM.Display_Message( SS.Create("Invalid menu choice"), SM.Warning); end if; end if; exit when (Occurrence in DM.Overload_Range) or SS.Value(Choice) = "*"; end loop; SM.Display_Filled_Template(Current_Handle); end if; if SS.Value(Choice) = "*" then SM.Display_Message( SS.Unchecked_Create( SS.Value(TP.Template_Label(Template)) & " " & SS.Value(Identifier) & " was not deleted"), SM.Info); else DM.Delete_Entry( DM.Entry_Handle(Template, Identifier, Occurrence)); end if; exception when Not_In_Dictionary => SM.Display_Message( SS.Unchecked_Create( SS.Value(TP.Template_Label(Template)) & " " & SS.Value(Identifier) & " not in dictionary"), SM.Error); end Delete; ----------------------------------------------------------------------- procedure Show_Overloads( --| Displays menu of <overload>s Template : in Templates.Template_Name; --| Template type to show Identifier : in SS.Screen_String --| Dictionary entry to show ) is Dummy : SS.Screen_String; begin if not DM.Entry_Exists(Template, Identifier) then raise Not_In_Dictionary; end if; SM.Display_Menu( DM.Overloads(Template, Identifier), SM.Continue, Template, Identifier); begin Dummy := SS.Unchecked_Create(TIO.Read); exception when TIO.End_of_File_Error => Abort_Editor(End_of_File_Condition); end; SM.Display_Filled_Template(Current_Handle); exception when Not_In_Dictionary => SM.Display_Message( SS.Unchecked_Create( SS.Value(TP.Template_Label(Template)) & " " & SS.Value(Identifier) & " not in dictionary"), SM.Error); end Show_Overloads; ----------------------------------------------------------------------- procedure Show_Commands is --| Displays a list of commands Dummy : SS.Screen_String; begin SM.Display_Command_List(Command_List); begin Dummy := SS.Unchecked_Create(TIO.Read); exception when TIO.End_of_File_Error => Abort_Editor(End_of_File_Condition); end; SM.Display_Filled_Template(Current_Handle); end Show_Commands; ----------------------------------------------------------------------- procedure Refresh is --| Refreshes screen display begin SM.Display_Filled_Template(Current_Handle); end Refresh; ----------------------------------------------------------------------- procedure Show_Help_Field is --| Shows help associated with a field begin SM.Display_Message( TP.Field_Help(Current_Template, Current_Field), SM.Help); end Show_Help_Field; ----------------------------------------------------------------------- procedure n_Lines( --| Move a specified number of lines n : in Integer := 1 --| Number of lines to move ) is First_Field : constant TP.Variable_Field_Number_Range --| First (variable) field in the template := 1; First_Field_on_Last_Line : constant TP.Variable_Field_Number_Range --| First (variable) field on the last line := TP.First_Variable_Field_Number( Current_Template, TP.Field_Position( Current_Template, TP.Actual_Field_Number( Current_Template, TP.Variable_Field_Count( Current_Template))).Line); Current_Line : Positive --| Line where current field is := TP.Field_Position( Current_Template, TP.Actual_Field_Number( Current_Template, Current_Field)).Line; begin -- If number of lines to move forward is outside bounds of template, -- go to first field on the last line if (Current_Line + n) > TP.Field_Position( Current_Template, TP.Actual_Field_Number( Current_Template, First_Field_on_Last_Line)).Line then Current_Field := First_Field_on_Last_Line; -- If number of lines to move back is outside bounds of template, go -- to the first field in the template elsif (Current_Line + n) < TP.Field_Position( Current_Template, TP.Actual_Field_Number( Current_Template, First_Field)).Line then Current_Field := First_Field; -- If number of lines to move forward or back is within bounds of -- template, go to Current_Line + n (or the next line containing -- a variable field) else for i in First_Field .. First_Field_on_Last_Line loop if TP.Field_Position( Current_Template, TP.Actual_Field_Number(Current_Template, i)).Line >= (Current_Line + n) then Current_Field := i; exit; end if; end loop; end if; -- Set prompt to current_field Prompt_Line := TP.Field_Label( Current_Template, TP.Actual_Field_Number(Current_Template, Current_Field)); SM.Display_Prompt(Prompt_Line); end n_Lines; ----------------------------------------------------------------------- procedure nth_Line( --| Move to the specified line. n : in Integer --| Line to move to. ) is First_Field : constant TP.Variable_Field_Number_Range --| First (variable) field in the template := 1; First_Field_on_Last_Line : constant TP.Variable_Field_Number_Range --| First (variable) field on the last line in template := TP.First_Variable_Field_Number( Current_Template, TP.Field_Position( Current_Template, TP.Actual_Field_Number( Current_Template, TP.Variable_Field_Count( Current_Template))).Line); Current_Line : Positive --| Line where current field is := TP.Field_Position( Current_Template, TP.Actual_Field_Number( Current_Template, Current_Field)).Line; begin -- If specified line number is too large, go to the first field on -- the last line if n > TP.Field_Position( Current_Template, TP.Actual_Field_Number( Current_Template, First_Field_on_Last_Line)).Line then Current_Field := First_Field_on_Last_Line; -- If specified line number is too small, go to the first field elsif n < TP.Field_Position( Current_Template, TP.Actual_Field_Number( Current_Template, First_Field)).Line then Current_Field := First_Field; -- If specified line number to move to is within bounds of -- template, go to nth line (or the next line containing -- a variable field) else for i in First_Field .. First_Field_on_Last_Line loop if TP.Field_Position( Current_Template, TP.Actual_Field_Number( Current_Template, i)).Line >= n then Current_Field := i; exit; end if; end loop; end if; Prompt_Line := TP.Field_Label( Current_Template, TP.Actual_Field_Number(Current_Template, Current_Field)); SM.Display_Prompt(Prompt_Line); end nth_Line; ----------------------------------------------------------------------- procedure n_Fields( --| Move a specified number of fields n : in Integer := 1 --| Number of fields to move ) is First_Field : constant TP.Variable_Field_Number_Range := 1; --| First (variable) field in template Last_Field : constant TP.Variable_Field_Number_Range --| Last (variable) field in template := TP.Variable_Field_Count(Current_Template); begin -- explicit check for n /= 0 because of type conversion problem if n /= 0 then -- If number of fields to move forward is outside bounds of -- template, then go to last field if (Integer(Current_Field) + n) > Integer(Last_Field) then Current_Field := Last_Field; -- If number of fields to move back is outside bounds of -- template, then go to first field elsif (Integer(Current_Field) + n) < Integer(First_Field) then Current_Field := First_Field; else Current_Field := TP.Variable_Field_Number_Range( Integer(Current_Field) + n); end if; end if; -- Set prompt to current field Prompt_Line := TP.Field_Label( Current_Template, TP.Actual_Field_Number(Current_Template, Current_Field)); SM.Display_Prompt(Prompt_Line); end n_Fields; ----------------------------------------------------------------------- procedure nth_Field( --| Move to the specified field. n : in Integer --| Field to move to. ) is First_Field : constant TP.Variable_Field_Number_Range := 1; --| First (variable) field in template Last_Field : constant TP.Variable_Field_Number_Range --| Last (variable) field in template := TP.Variable_Field_Count(Current_Template); begin -- If specified field number is too large, go to the last field if n > Integer(Last_Field) then Current_Field := Last_Field; -- If specified field number is too small, go to the first field elsif n < Integer(First_Field) then Current_Field := First_Field; else -- Set current field to field n Current_Field := TP.Variable_Field_Number_Range(n); end if; -- Set prompt to current field Prompt_Line := TP.Field_Label( Current_Template, TP.Actual_Field_Number(Current_Template, Current_Field)); SM.Display_Prompt(Prompt_Line); end nth_Field; ----------------------------------------------------------------------- procedure Go_to_Field( --| Move to the specified field. Fieldname : in SS.Screen_String --| Field to move to. ) is Fieldname_Exists : Boolean := False; begin for i in 1..TP.Variable_Field_Count(Current_Template) loop exit when Fieldname_Exists; if SS.Equal( Fieldname, TP.Field_Label( Current_Template, TP.Actual_Field_Number(Current_Template, i))) then Fieldname_Exists := True; Current_Field := i; -- Set prompt to field with <fieldname> Prompt_Line := TP.Field_Label( Current_Template, TP.Actual_Field_Number( Current_Template, Current_Field)); SM.Display_Prompt(Prompt_Line); end if; end loop; if not Fieldname_Exists then raise Fieldname_Not_In_Template; end if; end Go_to_Field; ----------------------------------------------------------------------- procedure Insert_Text( --| Inserts text in current field Text : in SS.Screen_String --| Text to insert ) is Start : Length_Range := 1; Length_Field : Length_Range; Truncated_Text : SS.Screen_String := Text; begin -- If text is longer than variable part of field, truncate text Length_Field := TP.Field_Length( Current_Template, TP.Actual_Field_Number(Current_Template, Current_Field)); if SS.Length(Text) > Length_Field then Truncated_Text := SS.Substring(Text, Start, Length_Field); SM.Display_Message( SS.Create("Text was truncated"), SM.Warning); end if; -- if current field is the identifier field, restrict contents to one -- word if TP."="(Current_Field, 1) then Truncated_Text := Identifier_Text(Truncated_Text); end if; -- Change contents of current field to as much text as fits and -- redisplay DM.Update_Field( Current_Handle, Current_Field, Truncated_Text); SM.Display_Field( Current_Handle, TP.Actual_Field_Number(Current_Template, Current_Field)); -- Set the current field to the next field n_Fields; -- Set flag indicating that template has been changed Modified_Template := True; end Insert_Text; ----------------------------------------------------------------------- procedure Substitute( --| Substitutes one string for another From_Text : in SS.Screen_String; --| old string To_Text : in SS.Screen_String --| new string ) is Original_Text : SS.Screen_String; Index : Integer; First_Start : Length_Range := 1; First_Remainder : SS.Screen_String; Second_Start : Length_Range; Second_Length : Length_Range; Second_Remainder : SS.Screen_String; New_Text : SS.Screen_String; Length_Field : Length_Range; begin Original_Text := DM.Field_Contents(Current_Handle, Current_Field); Index := SS.Match_Pattern(From_Text, Original_Text); -- If From_Text is not found in current field if Index = 0 then raise No_Oldstring_Match; end if; -- Find remaining pieces of Original_Text not being substituted First_Remainder := SS.Substring(Original_Text, First_Start, Index - 1); Second_Start := Index + SS.Length(From_Text); Second_Length := SS.Length(Original_Text) - SS.Length(First_Remainder) - SS.Length(From_Text); Second_Remainder := SS.Substring(Original_Text, Second_Start, Second_Length); -- Concatenate remaining Orginal_Text with To_Text New_Text := SS."&"(SS."&"(First_Remainder, To_Text),Second_Remainder); Length_Field := TP.Field_Length( Current_Template, TP.Actual_Field_Number(Current_Template, Current_Field)); -- if current field is the identifier field, restrict contents to one -- word if TP."="(Current_Field, 1) then New_Text := Identifier_Text(New_Text); end if; -- If New_Text is longer than variable part of field if SS.Length(New_Text) > Length_Field then raise Too_Long_For_Field; end if; -- Change contents of current field to reflect substitution -- and redisplay DM.Update_Field(Current_Handle, Current_Field, New_Text); SM.Display_Field( Current_Handle, TP.Actual_Field_Number(Current_Template, Current_Field)); -- Set flag indicating that template has been changed Modified_Template := True; end Substitute; ----------------------------------------------------------------------- procedure Create is --| Creates a dictionary entry from current template begin DM.Create_Entry(Current_Handle); Modified_Template := False; SM.Display_Message( SS.Unchecked_Create( SS.Value(TP.Template_Label(Current_Template)) & " " & SS.Value( DM.Field_Contents( Current_Handle, TP.Variable_Field_Number_Range'First)) & " has been created"), SM.Info); end Create; ----------------------------------------------------------------------- procedure Update is --| Updates a dictionary entry from current template begin DM.Update_Entry(Current_Handle); Modified_Template := False; SM.Display_Message( SS.Unchecked_Create( SS.Value(TP.Template_Label(Current_Template)) & " " & SS.Value( DM.Field_Contents( Current_Handle, TP.Variable_Field_Number_Range'First)) & " has been updated"), SM.Info); end Update; ----------------------------------------------------------------------- procedure Exit_Editor is --| Exits from the editor Choice : SS.Screen_String --| menu choice := SS.Create(""); begin -- If template has been modified by insert or substitute, prompt -- user to save changes before executing edit command if Modified_Template then while (SS.Length(Choice) /= 1) or else not (SS.Equal(Choice, "n") or SS.Equal(Choice, "N") or SS.Equal(Choice, "y") or SS.Equal(Choice, "Y") or SS.Equal(Choice, "*")) loop SM.Display_Message( SS.Create("Template has been modified"), SM.Warning); SM.Display_Secondary_Prompt( SS.Create("Save? (y, n, * to abort) : ")); begin Choice := SS.Unchecked_Create(TIO.Read); exception when TIO.End_of_File_Error => Abort_Editor(End_of_File_Condition); end; Choice := SSU.Strip_Leading(Choice); Choice := SSU.Strip_Trailing(Choice); end loop; case SS.Value(Choice)(1) is when 'n' | 'N' => SM.Clear_Message_Line; when 'y' | 'Y' => begin EC.Update; exception when DM.Cant_Update_New_Entry => EC.Create; end; when '*' => SM.Clear_Message_Line; return; when others => raise Internal_Error; end case; end if; SM.Position_for_Exit; Exit_Found := True; end Exit_Editor; ----------------------------------------------------------------------- end Editing_Commands; --------------------------------------------------------------------------- -----------------------Local Subprogram Bodies----------------------------- procedure Abort_Editor( --| Stops processing of editing commands Abort_Code : Abort_Code_Name --| What caused processing to abort ) is begin case Abort_Code is when End_of_File_Condition => SM.Display_Message( SS.Create("End of file detected. Exiting..."), SM.Warning); when Interrupt_Condition => SM.Display_Message( SS.Create("Interrupt detected. Exiting..."), SM.Warning); end case; DM.Close_Dictionary; SM.Position_for_Exit; raise Abort_Commands; end Abort_Editor; --------------------------------------------------------------------------- procedure Interpret_Command( In_Text : in SS.Screen_String --| Command to parse ) is --| Parses Text and calls appropriate editor procedure. If command is not --| one of acceptable editor commands, Nonexistent_Command is raised. Text : SS.Screen_String; --| Input text without leading blanks First_Character : Character; --| First character of Text Text_Scanner : SU.Scanner; --| Text converted to scanner begin -- Scan first non blank character Text := SSU.Strip_Leading(In_Text); if not SS.Equal(Text, "") then -- Check first character of command line against special edit -- characters and call appropriate parsing procedure Text_Scanner := SSU.Make_Scanner(Text); First_Character := SS.Value(Text)(1); case First_Character is when Plus_Key | Minus_Key => Parse_n_Lines_or_Fields(Text_Scanner); when '0'..'9' => Parse_nth_Line_or_Field(Text_Scanner); when Open_Fieldname_Key => Parse_Fieldname(Text_Scanner); when Insert_Key => Parse_Insert(Text_Scanner); when Substitute_Delimiter => Parse_Substitute(Text_Scanner); when 'a'..'z' | 'A'..'Z' => Parse_Alphabetic_Commands(Text_Scanner); when others => raise Nonexistent_Command; end case; else EC.n_Fields; end if; exception when Nonexistent_Command => SM.Display_Message( SS.Create("Nonexistent command"), SM.Error); when Ambiguous_Command => SM.Display_Message( SS.Create("Ambiguous command"), SM.Error); when Too_Many_Parameters => SM.Display_Message( SS.Create("Too many parameters"), SM.Error); when Missing_Nth_Line_or_Field_Command => SM.Display_Message( SS.Create("Missing line or field command"), SM.Error); when Missing_Fieldname => SM.Display_Message( SS.Create("Missing fieldname"), SM.Error); when Incomplete_Fieldname => SM.Display_Message( SS.Create("Incomplete fieldname"), SM.Error); when Missing_Old_String => SM.Display_Message( SS.Create("Missing old string"), SM.Error); when Incomplete_Substitution => SM.Display_Message( SS.Create("Incomplete substitution"), SM.Error); when Invalid_Escape_Sequence => SM.Display_Message( SS.Create("Invalid placement of escape character"), SM.Error); when Invalid_Substitute_Delimiter => SM.Display_Message( SS.Create("Invalid substitute delimiter"), SM.Error); when Missing_Template_Type => SM.Display_Message( SS.Create("Missing template type"), SM.Error); when Invalid_Template_Type => SM.Display_Message( SS.Create("Invalid template type"), SM.Error); when Missing_Identifier => SM.Display_Message( SS.Create("Missing identifier"), SM.Error); when Fieldname_Not_In_Template => SM.Display_Message( SS.Create("No field by that name in template"), SM.Error); when No_Oldstring_Match => SM.Display_Message( SS.Create("Substitution string does not exist in field"), SM.Error); when Too_Long_For_Field => SM.Display_Message( SS.Create("Substitution is too long for field"), SM.Error); when DM.Null_Identifier => SM.Display_Message( SS.Create("Identifier field must be filled out"), SM.Error); when DM.No_Overload_Field => SM.Display_Message( SS.Create("Overload field must be filled out"), SM.Error); when DM.Too_Many_Overloads => SM.Display_Message( SS.Create( "Too many overloads of this identifier already exist"), SM.Error); when DM.Cant_Update_New_Entry => SM.Display_Message( SS.Create("Cannot update a new entry - use create"), SM.Error); end Interpret_Command; --------------------------------------------------------------------------- procedure Parse_n_Lines_or_Fields( --| Parses Text for number and command --| (lines/fields) and calls either --| n_Fields or n_Lines procedure Text_Scanner : in SU.Scanner --| Command to parse ) is Sign : Character; Number : Integer; Found : Boolean; Dummy : SS.Screen_String; Large_Number : constant := 9999999; Command : SS.Screen_String; Fields_String : SS.Screen_String := SS.Create("fields"); Lines_String : SS.Screen_String := SS.Create("lines"); begin -- First character of command line is Plus_Key or Minus_Key -- Not specifying the number of lines/field = 1 line/field if not SU.Is_Signed_Number(Text_Scanner) then SU.Next(Text_Scanner, Sign); if Sign = '+' then Number := 1; elsif Sign = '-' then Number := -1; end if; else -- Parse for number of lines/fields to move begin SU.Scan_Signed_Number(Text_Scanner, Found, Number); exception when SU.Number_Too_Large => SU.Next(Text_Scanner, Sign); if Sign = '+' then Number := Large_Number; elsif Sign = '-' then Number := -Large_Number; end if; -- skip past the number SSU.Scan_Signed_Number(Text_Scanner, Found, Dummy); end; SU.Skip_Space(Text_Scanner); end if; if SU.Is_Word(Text_Scanner) then -- Parse for lines/fields command SSU.Scan_Word(Text_Scanner, Found, Command); SU.Skip_Space(Text_Scanner); else -- Nonexistent command name will be assumed to be "fields" command Command := Fields_String; end if; if SU.More(Text_Scanner) then raise Too_Many_Parameters; end if; -- Call appropriate procedure for command name if SS.Match_Prefix(Command, Fields_String) then EC.n_Fields(Number); elsif SS.Match_Prefix(Command, Lines_String) then EC.n_Lines(Number); else raise Nonexistent_Command; end if; end Parse_n_Lines_or_Fields; --------------------------------------------------------------------------- procedure Parse_nth_Line_or_Field( --| Parses Text for number and command --| (line/field) and calls either --| nth_Field or nth_Line Text_Scanner : in SU.Scanner --| Command to parse ) is Found : Boolean; Number : Integer; Dummy : SS.Screen_String; Large_Number : constant := 9999999; Command : SS.Screen_String; Field_string : SS.Screen_String := SS.Create("field"); Line_string : SS.Screen_String := SS.Create("line"); begin -- First character of command line is a number -- Parse for line/field number to move to begin SU.Scan_Number(Text_Scanner, Found, Number); exception when SU.Number_Too_Large => Number := Large_Number; -- skip past the number SSU.Scan_Number(Text_Scanner, Found, Dummy); end; SU.Skip_Space(Text_Scanner); if not SU.Is_Word(Text_Scanner) then raise Missing_nth_Line_or_Field_Command; end if; -- Parse for line/field command SSU.Scan_Word(Text_Scanner, Found, Command); SU.Skip_Space(Text_Scanner); if SU.More(Text_Scanner) then raise Too_Many_Parameters; end if; -- Call appropriate procedure for command name if SS.Match_Prefix(Command, Field_String) then EC.nth_Field(Number); elsif SS.Match_Prefix(Command, Line_String) then EC.nth_Line(Number); else raise Nonexistent_Command; end if; end Parse_nth_Line_or_Field; --------------------------------------------------------------------------- procedure Parse_Fieldname( --| Parses Text for parameter --| (fieldname), calls Go_to_Field Text_Scanner : in SU.Scanner --| Command to parse ) is Found : Boolean; Fieldname : SS.Screen_String; begin -- First character of command line is Open_Fieldname_Key -- Parse for closing delimiter and fieldname parameter SSU.Scan_Enclosed( Open_Fieldname_Key, Close_Fieldname_Key, Text_Scanner, Found, Fieldname, Skip => True); if not Found then -- missing Close_Fieldname_Key raise Incomplete_fieldname; end if; Fieldname := SSU.Strip_Leading(Fieldname); Fieldname := SSU.Strip_Trailing(Fieldname); if SS.Equal(Fieldname, "") then raise Missing_fieldname; end if; if SU.More(Text_Scanner) then raise Too_Many_Parameters; end if; EC.Go_to_Field(Fieldname); end Parse_Fieldname; --------------------------------------------------------------------------- procedure Parse_Insert( --| Parses Text for parameter (text to insert), --| calls Insert_Text Text_Scanner : in SU.Scanner --| Command to parse ) is Found : Boolean; Text_to_Insert : SS.Screen_String; begin -- First character of command line is Insert_Key SU.Forward(Text_Scanner); -- Parse for Text_to_Insert parameter and call procedure Text_to_Insert := SSU.Get_Remainder(Text_Scanner); EC.Insert_Text(Text_to_Insert); end Parse_Insert; --------------------------------------------------------------------------- procedure Get_Substitution_String( Text_Scanner : in SU.Scanner; Delimiter : in Character; Escape : in Character; Result : in out SS.Screen_String; End_of_Line : out Boolean ) is Temp_String : SS.Screen_String; Double_Escape : Boolean; Found : Boolean; Index : Positive; Del_Char : Character; EOL : Boolean := False; begin Result := SS.Create(""); loop SSU.Scan_Enclosed( Delimiter, Delimiter, Text_Scanner, Found, Temp_String); if not Found then if not SU.More(Text_Scanner) then raise Invalid_Substitute_Delimiter; end if; SU.Next(Text_Scanner, Del_Char); if Del_Char /= Delimiter then raise Invalid_Substitute_Delimiter; end if; Temp_String := SSU.Get_Remainder(Text_Scanner); EOL := True; end if; Index := 1; Double_Escape := True; for i in 1 .. SS.Length(Temp_String) loop if SS.Value(Temp_String)(i .. i) = Escape & "" then if not Double_Escape then Result := SS."&"(Result, SS.Substring(Temp_String, Index, i-Index)); Index := i + 1; end if; Double_Escape := not Double_Escape; elsif not Double_Escape then raise Invalid_Escape_Sequence; end if; end loop; if EOL and not Double_Escape then raise Invalid_Escape_Sequence; end if; exit when Index > SS.Length(Temp_String); Result := SS."&"(Result, SS.Substring( Temp_String, Index, SS.Length(Temp_String) - Index)); if Double_Escape then Result := SS."&"(Result, SS.Substring( Temp_String, SS.Length(Temp_String), 1)); exit; else Result := SS."&"(Result, Delimiter & ""); end if; SU.Backward(Text_Scanner); end loop; End_of_Line := EOL; if not EOL then SU.Backward(Text_Scanner); end if; end Get_Substitution_String; --------------------------------------------------------------------------- procedure Parse_Substitute( --| Parses Text for parameters (oldstring, --| newstring), calls Substitute Text_Scanner : in SU.Scanner --| Command to parse ) is Old_String : SS.Screen_String; New_String : SS.Screen_String; Remainder : SS.Screen_String; End_Of_Line : Boolean; begin -- Parse for oldstring parameter and second delimiter Get_Substitution_String( Text_Scanner, Substitute_Delimiter, Escape_Character, Old_String, End_Of_Line); if SS.Equal(Old_String, "") then raise Missing_old_string; end if; if End_Of_Line then raise Incomplete_Substitution; end if; -- Parse for newstring parameter and call procedure Get_Substitution_String( Text_Scanner, Substitute_Delimiter, Escape_Character, New_String, End_Of_Line); if not End_Of_Line then SU.Forward(Text_Scanner); SU.Skip_Space(Text_Scanner); if SU.More(Text_Scanner) then raise Too_Many_Parameters; end if; end if; EC.Substitute(Old_String, New_String); end Parse_Substitute; --------------------------------------------------------------------------- procedure Parse_Alphabetic_Commands( --| Parses Text for command, parameters --| and calls appropriate procedure Text_Scanner : in SU.Scanner --| Command to parse ) is Found : Boolean; Command : SS.Screen_String; Template_Image : SS.Screen_String; Template_Type : TP.Template_Name; Identifier : SS.Screen_String; type Editor_Command_Name is (Commands_Command, Create_Command, Exit_Command, Help_Field_Command, Refresh_Command, Update_Command, Delete_Command, Edit_Command, Show_Overloads_Command); subtype No_Parameters_Command_Name is Editor_Command_Name range Commands_Command .. Update_Command; Command_Name : Editor_Command_Name; Editor_Strings : constant array (1..9) of Screen_String := (SS.Create("commands"), SS.Create("create"), SS.Create("delete"), SS.Create("edit"), SS.Create("exit"), SS.Create("help"), SS.Create("refresh"), SS.Create("show"), SS.Create("update")); begin SSU.Scan_Word(Text_Scanner, Found, Command); -- Check for ambiguous command for i in Editor_Strings'First .. Editor_Strings'Last - 1 loop if SS.Match_Prefix(Command, Editor_Strings(i)) then if SS.Match_Prefix(Command, Editor_Strings(i + 1)) then raise Ambiguous_Command; end if; end if; end loop; -- Match incoming command string against array of command strings if SS.Match_Prefix(Command, Editor_Strings(1)) then Command_Name := Commands_Command; elsif SS.Match_Prefix(Command, Editor_Strings(2)) then Command_Name := Create_Command; elsif SS.Match_Prefix(Command, Editor_Strings(3)) then Command_Name := Delete_Command; elsif SS.Match_Prefix(Command, Editor_Strings(4)) then Command_Name := Edit_Command; elsif SS.Match_Prefix(Command, Editor_Strings(5)) then Command_Name := Exit_Command; elsif SS.Match_Prefix(Command, Editor_Strings(6)) then Command_Name := Help_Field_Command; elsif SS.Match_Prefix(Command, Editor_Strings(7)) then Command_Name := Refresh_Command; elsif SS.Match_Prefix(Command, Editor_Strings(8)) then Command_Name := Show_Overloads_Command; elsif SS.Match_Prefix(Command, Editor_Strings(9)) then Command_Name := Update_Command; else raise Nonexistent_Command; end if; SU.Skip_Space(Text_Scanner); if not SU.More(Text_Scanner) then -- If there is nothing more on the command line, call appropriate -- procedure if command doesn't take parameters and raise missing -- parameter exception if command takes parameters. case Command_Name is when Commands_Command => EC.Show_Commands; when Create_Command => EC.Create; when Exit_Command => EC.Exit_Editor; when Help_Field_Command => EC.Show_Help_Field; when Refresh_Command => EC.Refresh; when Update_Command => EC.Update; when others => raise Missing_template_type; end case; else if Command_Name in No_Parameters_Command_Name then raise Too_Many_Parameters; end if; -- If there is more on the command line, parse for first parameter SSU.Scan_Word(Text_Scanner, Found, Template_Image); begin Template_Type := TP.Template_Name'Value(SS.Value(Template_Image)); exception when Constraint_Error => raise Invalid_Template_Type; end; SU.Skip_Space(Text_Scanner); if SU.More(Text_Scanner) then -- If there is more on the command line, parse for second -- parameter SSU.Scan_Word(Text_Scanner, Found, Identifier); SU.Skip_Space(Text_Scanner); -- If there is more on the command line after 2nd parameter, -- raise exception if SU.More(Text_Scanner) then raise Too_Many_Parameters; end if; -- Call appropriate procedure if command takes 2 parameters -- and raise too many parameters exception if command -- doesn't take parameters. case Command_Name is when Delete_Command => EC.Delete(Template_Type, Identifier); when Edit_Command => EC.Edit(Template_Type, Identifier); when Show_Overloads_Command => EC.Show_Overloads(Template_Type, Identifier); when others => raise Too_Many_Parameters; end case; else -- If there is no more on the command line after 1st parameter, -- call appropriate procedure if command has default 2nd -- parameter, raise missing parameter exception if command -- requires 2 parameters, and raise too many parameters -- exception if command doesn't take parameters. case Command_Name is when Edit_Command => EC.Edit(Template_Type); when Delete_Command => raise Missing_identifier; when Show_Overloads_Command => raise Missing_identifier; when others => raise Too_Many_Parameters; end case; end if; end if; end Parse_Alphabetic_Commands; --------------------------------------------------------------------------- function Identifier_Text( --| Checks text about to be inserted to --| identifier field Text : SS.Screen_String --| Text to be checked ) return SS.Screen_String is Scan_Text : SU.Scanner; Return_Word : SS.Screen_String; Word : SS.Screen_String; Found : Boolean; begin Scan_Text := SSU.Make_Scanner(Text); SSU.Scan_Word(Scan_Text, Found, Return_Word, Skip => True); if SU.More(Scan_Text) then SSU.Scan_Word(Scan_Text, Found, Word, Skip => True); if Found then SM.Display_Message( SS.Create("Identifier field must be only one word:" & " text was truncated"), SM.Warning); return Return_Word; end if; end if; return Text; end Identifier_Text; --------------------------------------------------------------------------- --------------------------------------------------------------------------- end Commands; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --DICTMGR.BDY --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Host_Lib; with File_Manager; with DD_Release; with Labeled_Trees; with Lists; with String_Utilities; with Paginated_Output; with Text_IO; ------------------------------------------------------------------------------- package body Dictionary_Manager is --| Provide operations to manage a collection of dictionary entries associated --| with various template types. --------------------------------------------------------------------------- -- Local declarations --------------------------------------------------------------------------- package FM renames File_Manager; package SU renames String_Utilities; package PO renames Paginated_Output; package Int_IO is new Text_IO.Integer_IO(DIO.Count); package FL is new Lists(ItemType => DIO.Positive_Count); package SSU is new SU.Generic_String_Utilities( Generic_String_Type => SS.Screen_String, To_Generic => SS.Unchecked_Create, From_Generic => SS.Value); Position_Free_Lists : array(TP.Template_Name) of FL.List := (others => FL.Create); --| Array of free lists for each template type type File_Position_Array is array(Overload_Range) of DIO.Count; --| Array of file positions for an identifier package IT is new Labeled_Trees( Label_Type => SS.Screen_String, Value_Type => File_Position_Array, "<" => SS."<"); type Lock_Mode_Name is (Unlocked, Locked); Lock_File : Text_IO.File_Type; --| File object for lock file Version_File : Text_IO.File_Type; --| File object for version file Identifier_Index : constant TP.Variable_Field_Number_Range := TP.Variable_Field_Number_Range'First; --| TP.Variable_Field_Range'First is defined as the index in data array --| at which identifier occurs Overload_Index : constant TP.Variable_Field_Number_Range := TP."+"(Identifier_Index, 1); --| TP.Variable_Field_Range'First + 1 is defined as the index in data array --| at which overload field occurs type Index_Tree_Descriptor is record Tree : IT.Tree; --| Index used in conjunction with --| Direct_IO file Initialized : Boolean; --| Whether tree has been initialized end record; Index_Trees : array(TP.Template_Name) of Index_Tree_Descriptor := (others => (IT.Create, False)); --| Index trees for all template types in dictionary Current_Dict : SS.Screen_String := SS.Create(""); --| Current dictionary directory name type Dictionary_File_Type is --| File objects for index and data record Index_File : Text_IO.File_Type; --| Index file object for a template type Data_File : DIO.File_Type; --| Data file object for a template type end record; File_Types : array(TP.Template_Name) of Dictionary_File_Type; --| File objects for all files in data dictionary --------------------------------------------------------------------------- -- Local subprogram specifications --------------------------------------------------------------------------- procedure Read_Index( --| Reads in index tree for a template type Template : in TP.Template_Name --| Template type for which to read in tree ); --| Raises: No_Dictionary_File, Index_File_Error --| Effects: Reads in the index tree for a particular template type. --| Also reads in the free list of available positions to which dictionary --| items can be written. No_Dictionary_File is raised when --| Open_Dictionary hasn't been called before this procedure is called. --| An error message is printed and Index_File_Error is raised when an --| index file in the dictionary doesn't exist or can't be opened. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Write_Index( --| Writes out the index tree for a template type Template : in TP.Template_Name --| Template type for which to write out tree ); --| Raises: No_Dictionary_File, Index_File_Error --| Effects: Writes out the free list of available positions to which --| dictionary items can be written, and writes out the index tree for --| a particular template type. No_Dictionary_File is raised when --| Open_Dictionary hasn't been called before this procedure is called. --| An error message is printed and Index_File_Error is raised when an --| index file in the dictionary doesn't exist or can't be opened. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Attach_File_Position( --| Adds a file position to the array File_Positions : in File_Position_Array; --| Array of file positions Item : DIO.Positive_Count --| File position to attach ) return File_Position_Array; --| Raises: Too_Many_Overloads --| Effects: Adds a new file position to the array of file positions. --| Too_Many_Overloads is raised when the maximum number of overloads --| already exists in the File_Position_Array. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Delete_File_Position( --| Deletes a file position from the array File_Positions : in File_Position_Array; --| Array of file positions Item : DIO.Positive_Count --| File position to delete ) return File_Position_Array; --| Raises: No_Such_Occurrence --| Effects: Deletes a file position from the array of file positions --| No_Such_Occurrence is raised when an Item is not in the array. --| N/A: Requires, Modifies --------------------------------------------------------------------------- function Data_File_Name( --| Returns the data file name for a template Template : TP.Template_Name ) return String; --| Effects: Determines a name for the dictionary data file based on the --| Template_Name passed in. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Index_File_Name( --| Returns the index file name for a template Template : TP.Template_Name ) return String; --| Effects: Determines a name for the dictionary index file based on the --| Template_Name passed in. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Lock_File_Name( --| Returns the lock file name Lock_Mode : Lock_Mode_Name --| Name for unlocked or locked file ) return String; --| Effects: Returns a name for the lock file. Lock_Mode determines --| whether the name is for the unlock file or the lock file. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- package body Report_Utilities is --| Provides subprograms to produce reports on dictionary entries. use Text_IO; Output_File : PO.Paginated_File_Handle; --| Handle for report output package Identifier_Lists is new Lists( ItemType => SS.Screen_String, Equal => SS.Equal); type Inclusion_Descriptor is record All_Selected : Boolean; --| whether to print all entries of this template type Identifier_List : Identifier_Lists.List; --| the list of identifiers to print for this template type end record; Entries_to_Include : array(TP.Template_Name) of Inclusion_Descriptor := (others => (False, Identifier_Lists.Create)); --| array containing information on which entries to print ----------------------------------------------------------------------- -- Local subprogram specifications ----------------------------------------------------------------------- procedure Parse_Entries( --| Parses Entries or line from Entry_Name Entry_Text : in String --| Text to parse ); --| Effects: Parses an entry specification either from Entries or from --| a line in file Entry_Name. To parse successfully, the line should --| have the form: template-name identifier identifier identifier ... --| Entries_to_Include is updated to reflect which entries were --| specified in Entry_Text. Error messages are printed for --| nonexistent template types and nonexistent entries. --| Modifies: Entries_to_Include --| N/A: Raises, Requires ----------------------------------------------------------------------- procedure Print_Full_Entry( --| Produces the full report for an entry Entry_Handle : in Dictionary_Entry_Handle --| Handle of entry on which to report ); --| Effects: Prints a full report for the entry specified by --| Entry_Handle. All fields of the entry are printed. Empty --| fields are replaced by the template label for the field. --| N/A: Raises, Requires, Modifies ----------------------------------------------------------------------- procedure Make_Command_File_Entry( --| Produces command file line Entry_Handle : in Dictionary_Entry_Handle --| Handle of entry to put in --| command file ); --| Effects: Prints a command file entry for the entry specified by --| Entry_Handle. The format of the command file entry is such that --| it may be used as input to the Update_Dictionary tool. Each entry --| in the command file is of the form: <field-label>field-contents --| N/A: Raises, Requires, Modifies ----------------------------------------------------------------------- -- External subprogram bodies ----------------------------------------------------------------------- procedure Set_Up_Report( --| Initializes parameters for reporting Dictionary_Name : in String; --| Name of dictionary to open Entries : in String; --| Entries to report on Entry_Name : in String --| File containing entries to report ) is Entry_File : File_Type; --| File object for entry file Text : String(1 .. 256); --| Text read from entry file -- arbitrary length Last : Natural; --| Last index of Text read begin Open_Dictionary(Dictionary_Name); -- Entry_Name and Entries both null ==> select everything if Entry_Name = "" then if Entries = "" then for i in TP.Template_Name loop Entries_to_Include(i).All_Selected := True; end loop; end if; else -- read and parse entries from Entry_File Open(Entry_File, In_File, Entry_Name); while not End_of_File(Entry_File) loop Get_Line(Entry_File, Text, Last); Parse_Entries(Text(1 .. Last)); end loop; end if; -- parse Entries parameter if Entries /= "" then Parse_Entries(Entries); end if; exception when Name_Error | Status_Error | Use_Error => Host_Lib.Set_Error; Put_Line("Error opening file " & Entry_Name & " for input."); Close_Dictionary; raise Abort_Report; end Set_Up_Report; ----------------------------------------------------------------------- procedure Make_Report( --| Makes the report Report : in Report_Name; --| Which type of report to make Output_Name : in String --| Name of output file ) is Index_Iter : IT.Tree_Iter; --| Index tree iterator Label : SS.Screen_String; --| Identifier Label in tree File_Positions : File_Position_Array; --| Array of file positions --| in tree Temp_Data : Data_Array; --| all data for particular --| entry begin if Report = Command_File then -- don't want to paginate the command file PO.Create_Paginated_File( File_Handle => Output_File, File_Name => Output_Name, Header_Size => 0, Footer_Size => 0, Page_Size => 0); else PO.Create_Paginated_File( File_Handle => Output_File, File_Name => Output_Name); PO.Set_Header(File_Handle => Output_File, Header_Line => 1, Header_Text => "Data Dictionary Report Output on ~d at " & "~t ~p"); end if; for Template in TP.Template_Name loop if not Index_Trees(Template).Initialized then Read_Index(Template); end if; -- don't want to print any headers without anything under them -- in summary report if (Report = Summary) and -- all were selected and there are some in the tree ((Entries_to_Include(Template).All_Selected and not IT.Is_Empty(Index_Trees(Template).Tree)) or -- not all were selected and list of entries isn't empty not (Entries_to_Include(Template).All_Selected or Identifier_Lists.IsEmpty( Entries_to_Include(Template).Identifier_List))) then PO.Skip_Line(Output_File, 2); PO.Put_Line( Output_File, TP.Template_Name'Image(Template) & " Entries:"); PO.Skip_Line(Output_File); end if; -- Iterate over index tree for the Template Index_Iter := IT.Make_Tree_Iter_In(Index_Trees(Template).Tree); while IT.More(Index_Iter) loop IT.Next(Index_Iter, File_Positions, Label); -- only print it if all were selected or it is in the list if (Entries_to_Include(Template).All_Selected or Identifier_Lists.IsInList( Entries_to_Include(Template).Identifier_List, Label)) and then -- only print it if file positions are in the index DIO."/="( File_Positions(File_Positions'First), 0) then if Report = Summary then PO.Put(Output_File, " "); PO.Put(Output_File, SS.Value(Label)); PO.Skip_Line(Output_File); end if; for i in File_Positions'Range loop exit when DIO."="(File_Positions(i), 0); case Report is when Summary => -- read overload and put it out DIO.Read( File => File_Types(Template).Data_File, Item => Temp_Data, From => File_Positions(i)); PO.Put(Output_File, " "); PO.Put( Output_File, SS.Value(Temp_Data(Overload_Index))); PO.Skip_Line(Output_File); when Full => PO.Skip_Line(Output_File, 2); Print_Full_Entry( Entry_Handle(Template, Label, i)); when Command_File => PO.Put_Line( Output_File, "UPDATE " & TP.Template_Name'Image(Template) & " " & SS.Value(Label) & " " & Overload_Range'Image(i)); Make_Command_File_Entry( Entry_Handle(Template, Label, i)); end case; end loop; -- over overloads end if; -- if it is in the list to include end loop; -- over identifiers end loop; -- over template_name Close_Dictionary; exception when PO.File_Error => Put_Line("Error opening file " & Output_Name & " for output."); Close_Dictionary; raise Abort_Report; end Make_Report; ----------------------------------------------------------------------- -- Local subprogram bodies ----------------------------------------------------------------------- procedure Parse_Entries( --| Parses Entries or line from Entry_Name Entry_Text : in String --| Text to parse ) is Invalid_Template_Type : exception; --| Raised when the given --| template is invalid Line : SU.Scanner; --| String scanner created --| from Entry_Text to parse Found : Boolean; --| Whether scanner operation --| completed successfully Word : SS.Screen_String; --| Word found in scanner --| operation Template : TP.Template_Name; --| Template found in --| Entry_Text Entries_Specified : Boolean := False; begin declare Text : SS.Screen_String; Truncated : Boolean; begin SS.Create(Entry_Text, Text, Truncated); Line := SSU.Make_Scanner(Text); if Truncated then -- print warning message Put_Line(Entry_Text); Put_Line("truncated to:"); Put_Line(SS.Value(Text)); end if; end; -- Get template SSU.Scan_Word(Line, Found, Word, Skip => True); if Found then -- check template's validity begin Template := TP.Template_Name'Value(SS.Value(Word)); exception when Constraint_Error => raise Invalid_Template_Type; end; end if; -- Get selected identifiers for this template while SU.More(Line) and Found loop SSU.Scan_Word(Line, Found, Word, Skip => True); if Found then -- some entries were actually requested, although they -- will not be put on list if they don't exist in -- dictionary Entries_Specified := True; if not Entry_Exists(Template, Word) then -- print a warning message to standard error Put_Line("No dictionary entry for " & TP.Template_Name'Image(Template) & " " & SS.Value(Word)); else Identifier_Lists.Attach( Entries_to_Include(Template).Identifier_List, Word); end if; end if; end loop; if not Entries_Specified then -- Mark all entries for template type Template as selected Entries_to_Include(Template).All_Selected := True; end if; exception when Invalid_Template_Type => Put_Line("Invalid Template: " & SS.Value(Word)); end Parse_Entries; ----------------------------------------------------------------------- procedure Print_Full_Entry( --| Produces the full report for an entry Entry_Handle : in Dictionary_Entry_Handle --| Handle of entry on which to report ) is Template : TP.Template_Name --| The template type for := Template_Kind(Entry_Handle); --| this Entry_Handle Position : TP.Position_Descriptor --| "Screen" position of a := (1, 1); --| field Last_Position : TP.Position_Descriptor; --| "Screen" position of --| previous field New_Lines : Integer; --| New_Lines between the --| last and current field Column : Positive := 1; --| Current column Blanks : String(1 .. SS.Max_Screen_Columns) := (others => ' '); begin PO.Put(Output_File, SS.Value(TP.Template_Label(Template))); -- loop through all fields and print them out for i in TP.Actual_Field_Number_Range'First .. TP.Field_Count(Template) loop Last_Position := Position; Position := TP.Field_Position(Template, i); New_Lines := Position.Line - Last_Position.Line; if New_Lines > 0 then PO.Skip_Line(Output_File, New_Lines); Column := 1; end if; PO.Put(Output_File, Blanks(1 .. Position.Column - Column)); if TP."="(TP.Field_Mode(Template, i), TP.Static) then PO.Put(Output_File, SS.Value(TP.Field_Label(Template, i))); Column := Position.Column + TP.Field_Length(Template, i) + 1; elsif SS.Equal( Field_Contents( Entry_Handle, TP.Variable_Field_Number(Template, i)), "") then PO.Put( Output_File, "<" & SS.Value(TP.Field_Label(Template, i)) & ">"); Column := Position.Column + SS.Length(TP.Field_Label(Template, i)) + 3; else PO.Put( Output_File, SS.Value(Field_Contents( Entry_Handle, TP.Variable_Field_Number(Template, i)))); Column := Position.Column + SS.Length(Field_Contents( Entry_Handle, TP.Variable_Field_Number(Template, i))) + 1; end if; end loop; PO.Skip_Line(Output_File); end Print_Full_Entry; ----------------------------------------------------------------------- procedure Make_Command_File_Entry( --| Produces command file entry Entry_Handle : in Dictionary_Entry_Handle --| Handle of entry to put in --| command file ) is Template : TP.Template_Name := Template_Kind(Entry_Handle); --| Template-Type for this Entry_Handle begin for i in TP.Variable_Field_Number_Range'First .. TP.Variable_Field_Count(Template) loop PO.Put_Line( Output_File, "<" & SS.Value( TP.Field_Label( Template, TP.Actual_Field_Number(Template, i))) & ">" & SS.Value(Field_Contents(Entry_Handle, i))); end loop; end Make_Command_File_Entry; ----------------------------------------------------------------------- end Report_Utilities; --------------------------------------------------------------------------- -- External subprogram bodies --------------------------------------------------------------------------- procedure Create_Dictionary( --| Creates a new dictionary Dictionary_Name : in String --| Name of dictionary to create ) is begin -- if the dictionary already exists, can't create it again if FM.Is_Directory(Dictionary_Name) then raise Cant_Create_Directory; end if; -- create dictionary directory FM.Create_Directory(Dictionary_Name); for i in TP.Template_Name loop -- create each data file DIO.Create( File => File_Types(i).Data_File, Mode => DIO.Inout_File, Name => FM.Path_Name( Dictionary_Name, Data_File_Name(i))); DIO.Close(File_Types(i).Data_File); -- create each index file Text_IO.Create( File => File_Types(i).Index_File, Mode => Text_IO.Out_File, Name => FM.Path_Name(Dictionary_Name, Index_File_Name(i))); Text_IO.Close(File_Types(i).Index_File); end loop; -- create the (unlocked) lock file Text_IO.Create( File => Lock_File, Mode => Text_IO.Out_File, Name => FM.Path_Name(Dictionary_Name, Lock_File_Name(Unlocked))); Text_IO.Close(Lock_File); -- create the version file Text_IO.Create( File => Version_File, Mode => Text_IO.Out_File, Name => FM.Path_Name(Dictionary_Name, "version")); Text_IO.Put_Line(Version_File, DD_Release); Text_IO.Close(Version_File); exception when FM.Create_Error | FM.Parse_Error => raise Cant_Create_Directory; end Create_Dictionary; --------------------------------------------------------------------------- procedure Open_Dictionary( --| Opens all dictionary files Dictionary_Name : in String --| Name of dictionary ) is begin begin if not FM.Is_Directory(Dictionary_Name) then Host_Lib.Set_Error; Text_IO.Put_Line( "Error opening dictionary " & Dictionary_Name & "."); raise Invalid_Dictionary_File; end if; exception when FM.Parse_Error => Host_Lib.Set_Error; Text_IO.Put_Line( "Error opening dictionary " & Dictionary_Name & "."); raise Invalid_Dictionary_File; end; Current_Dict := SS.Unchecked_Create(Dictionary_Name); -- try to unlock the dictionary. If this fails, raise exceptions begin FM.Rename( FM.Path_Name(SS.Value(Current_Dict), Lock_File_Name(Unlocked)), FM.Path_Name(SS.Value(Current_Dict), Lock_File_Name(Locked))); exception when others => -- check for existence of locked lock file declare Lock_File : Text_IO.File_Type; begin begin Text_IO.Open( File => Lock_File, Mode => Text_IO.In_File, Name => FM.Path_Name( SS.Value(Current_Dict), Lock_File_Name(Locked))); exception when Text_IO.Name_Error => raise Lock_is_Missing; end; Text_IO.Close(Lock_File); raise Dictionary_Locked; end; end; for i in TP.Template_Name loop begin DIO.Open( File => File_Types(i).Data_File, Mode => DIO.Inout_File, Name => FM.Path_Name( SS.Value(Current_Dict), Data_File_Name(i))); exception when DIO.Name_Error => Host_Lib.Set_Error; Text_IO.Put_Line( "Dictionary data file for " & TP.Template_Name'Image(i) & " does not exist."); Close_Dictionary; raise Data_File_Error; when DIO.Use_Error | DIO.Status_Error => Host_Lib.Set_Error; Text_IO.Put_Line( "Dictionary data file for " & TP.Template_Name'Image(i) & " cannot be opened."); Text_IO.Put_Line( "Check protections and that versions of dictionary " & "and tool are compatible."); Close_Dictionary; raise Data_File_Error; end; end loop; end Open_Dictionary; --------------------------------------------------------------------------- procedure Close_Dictionary is begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; for i in TP.Template_Name loop if DIO.Is_Open(File => File_Types(i).Data_File) then DIO.Close(File => File_Types(i).Data_File); end if; if Index_Trees(i).Initialized then Write_Index(i); end if; end loop; -- rename the lock file back to unlocked status FM.Rename( FM.Path_Name(SS.Value(Current_Dict), Lock_File_Name(Locked)), FM.Path_Name(SS.Value(Current_Dict), Lock_File_Name(Unlocked))); exception when Index_File_Error => -- rename the lock file back to unlocked status FM.Rename( FM.Path_Name(SS.Value(Current_Dict), Lock_File_Name(Locked)), FM.Path_Name(SS.Value(Current_Dict), Lock_File_Name(Unlocked))); end Close_Dictionary; --------------------------------------------------------------------------- function New_Entry_Handle( --| Returns handle to new dictionary entry Template : TP.Template_Name --| Template type to associate with entry ) return Dictionary_Entry_Handle is begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; if not Index_Trees(Template).Initialized then Read_Index(Template); end if; return new Dictionary_Entry_Descriptor'( Template => Template, Data => (others => SS.Create("")), Read_From => 0); end New_Entry_Handle; --------------------------------------------------------------------------- function Entry_Handle( --| Returns handle to existing entry Template : TP.Template_Name; --| Template type of entry Identifier : SS.Screen_String; --| Entry identifier Occurrence : Overload_Range --| Occurrence of Entry_Handle to := 1 --| retrieve. ) return Dictionary_Entry_Handle is File_Positions : File_Position_Array; --| Array of file positions for --| template, identifier pair Temp_Data : Data_Array; --| Data read from data file begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; if not Index_Trees(Template).Initialized then Read_Index(Template); end if; if not IT.Is_Label_In_Tree(Index_Trees(Template).Tree, Identifier) then raise No_Such_Dictionary_Entry; end if; -- if the identifier is in the index tree, get the list of file -- positions from the tree File_Positions := IT.Fetch_Value(Index_Trees(Template).Tree, Identifier); if DIO."="(File_Positions(Occurrence), 0) then raise No_Such_Occurrence; end if; -- Read in data for handle DIO.Read( File => File_Types(Template).Data_File, Item => Temp_Data, From => File_Positions(Occurrence)); return new Dictionary_Entry_Descriptor'( Template => Template, Data => Temp_Data, Read_From => File_Positions(Occurrence)); end Entry_Handle; --------------------------------------------------------------------------- function Entry_Exists( --| Determines whether an entry exists Template : TP.Template_Name; --| Template type of entry Identifier : SS.Screen_String; --| Entry identifier Occurrence : Overload_Range --| Occurrence of template, identifier := 1 ) return Boolean is begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; if not Index_Trees(Template).Initialized then Read_Index(Template); end if; -- Label must be in tree and file position list non-empty at -- location Occurrence for Entry_Exists to be true return (IT.Is_Label_In_Tree( Index_Trees(Template).Tree, Identifier)) and then DIO."/="( IT.Fetch_Value( Index_Trees(Template).Tree, Identifier)(Occurrence), 0); end Entry_Exists; --------------------------------------------------------------------------- function Unique_Entry( --| Determines whether an entry is unique Template : TP.Template_Name; --| Template type of entry Identifier : SS.Screen_String --| Entry identifier ) return Boolean is begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; if not Index_Trees(Template).Initialized then Read_Index(Template); end if; if not IT.Is_Label_In_Tree(Index_Trees(Template).Tree, Identifier) then raise No_Such_Dictionary_Entry; end if; return DIO."="( IT.Fetch_Value( Index_Trees(Template).Tree, Identifier)(Overload_Range'First + 1), 0); end Unique_Entry; --------------------------------------------------------------------------- function Overloads( --| Returns overload fields for an entry Template : TP.Template_Name; --| Template type of entry Identifier : SS.Screen_String --| Entry identifier ) return Overload_Array is File_Positions : File_Position_Array; Temp_Data : Data_Array; Temp_Array : Overload_Array := (others => SS.Create("")); begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; if not Index_Trees(Template).Initialized then Read_Index(Template); end if; if not IT.Is_Label_In_Tree(Index_Trees(Template).Tree, Identifier) then raise No_Such_Dictionary_Entry; end if; File_Positions := IT.Fetch_Value(Index_Trees(Template).Tree, Identifier); for i in Overload_Range loop exit when DIO."="(File_Positions(i), 0); -- Read in data for handle DIO.Read( File => File_Types(Template).Data_File, Item => Temp_Data, From => File_Positions(i)); Temp_Array(i) := Temp_Data(Overload_Index); end loop; return Temp_Array; end Overloads; --------------------------------------------------------------------------- procedure Delete_Entry( --| Deletes dictionary entry Entry_Handle : Dictionary_Entry_Handle --| Entry to delete ) is begin if (Entry_Handle = null) then raise Invalid_Entry_Handle; end if; if DIO."="(Entry_Handle.Read_From, 0) then raise No_Such_Dictionary_Entry; end if; -- Delete the file position for this entry from the file position -- list in the tree. IT.Store_Value( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index), Delete_File_Position( IT.Fetch_Value( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index)), Entry_Handle.Read_From)); -- put the index it was read from on the free list and set its -- read_from to 0. FL.Attach( Entry_Handle.Read_From, Position_Free_Lists(Entry_Handle.Template)); -- write the index out to the index file to keep index file in synch -- with the deletion which just occurred Write_Index(Entry_Handle.Template); Entry_Handle.Read_From := 0; end Delete_Entry; --------------------------------------------------------------------------- procedure Create_Entry( --| Creates a new entry Entry_Handle : Dictionary_Entry_Handle --| Entry to create ) is Next_Position : DIO.Positive_Count; --| Next available file --| position for writing. begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; if Entry_Handle = null then raise Invalid_Entry_Handle; end if; if SS.Equal(Entry_Handle.Data(Identifier_Index), "") then raise Null_Identifier; end if; if IT.Is_Label_In_Tree( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index)) then -- Can't create entry if no <overload> field exists when there is -- another dictionary item with the same name. if SS.Equal(Entry_Handle.Data(Overload_Index), "") and -- check that the list of file positions isn't empty (i.e. that -- all other instances of this identifier have been deleted) DIO."/="( IT.Fetch_Value( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index)) (Overload_Range'First), 0) then raise No_Overload_Field; end if; -- If the maximum number of overloads already exist, raise error if DIO."/="( IT.Fetch_Value( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index)) (Max_Overloads), 0) then raise Too_Many_Overloads; end if; else -- if name isn't already in the tree, have to call insert_node -- and start a new list of file positions IT.Insert_Node( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index), (others => 0)); end if; -- Calculate the next free position for writing. If position is -- available on the free list, write the item there; otherwise write -- to the nth position, where n is equal to (current size + 1). if not FL.IsEmpty( Position_Free_Lists(Entry_Handle.Template)) then Next_Position := FL.FirstValue( Position_Free_Lists(Entry_Handle.Template)); -- delete from free list for this template type FL.DeleteHead( Position_Free_Lists(Entry_Handle.Template)); else Next_Position := DIO.Positive_Count'Succ( DIO.Size(File_Types(Entry_Handle.Template).Data_File)); end if; DIO.Write( File => File_Types(Entry_Handle.Template).Data_File, Item => Entry_Handle.Data, To => Next_Position); -- Add Next_Position to the file position list in the tree IT.Store_Value( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index), Attach_File_Position( IT.Fetch_Value( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index)), Next_Position)); -- write the index out to the index file to keep index file in synch -- with data file Write_Index(Entry_Handle.Template); Entry_Handle.Read_From := Next_Position; end Create_Entry; --------------------------------------------------------------------------- procedure Update_Entry( --| Updates an existing dictionary entry Entry_Handle : Dictionary_Entry_Handle --| Handle referencing entry to update ) is Compare_Data : Data_Array; --| array to compare identifier field begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; if Entry_Handle = null then raise Invalid_Entry_Handle; end if; if SS.Equal(Entry_Handle.Data(Identifier_Index), "") then raise Null_Identifier; end if; -- Can't "update" an entry that was not read from the dictionary (or -- was deleted from the dictionary) if DIO."="(Entry_Handle.Read_From, 0) then raise Cant_Update_New_Entry; end if; -- Can't allow empty <overload> field if it is not the only one. if IT.Is_Label_In_Tree( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index)) and then SS.Equal(Entry_Handle.Data(Overload_Index), "") and then -- check that there are no more than one instance of this -- identifier DIO."/="( IT.Fetch_Value( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index)) (Overload_Range'First + 1), 0) then raise No_Overload_Field; end if; -- Compare identifier fields. -- if the identifier field is different, the index tree must -- be updated DIO.Read( File => File_Types(Entry_Handle.Template).Data_File, Item => Compare_Data, From => Entry_Handle.Read_From); if not SS.Equal( Compare_Data(Identifier_Index), Entry_Handle.Data(Identifier_Index)) then -- see whether new identifier is in tree. If so, check that it -- doesn't already have the maximum overloads before deleting -- old identifier from tree if IT.Is_Label_In_Tree( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index)) and then DIO."/="( IT.Fetch_Value( Index_Trees(Entry_Handle.Template).Tree, Entry_Handle.Data(Identifier_Index)) (Max_Overloads), 0) then raise Too_Many_Overloads; end if; -- delete the file position from the old identifier's list and -- call Create_Entry for the new identifier IT.Store_Value( Index_Trees(Entry_Handle.Template).Tree, Compare_Data(Identifier_Index), Delete_File_Position( IT.Fetch_Value( Index_Trees(Entry_Handle.Template).Tree, Compare_Data(Identifier_Index)), Entry_Handle.Read_From)); Create_Entry(Entry_Handle); else -- Write the item to the place it was read from. DIO.Write( File => File_Types(Entry_Handle.Template).Data_File, Item => Entry_Handle.Data, To => Entry_Handle.Read_From); -- index doesn't change, so no need to write the index file end if; end Update_Entry; --------------------------------------------------------------------------- procedure Update_Field( --| Updates a field in entry Entry_Handle : Dictionary_Entry_Handle; --| Entry to update Field_Number : TP.Variable_Field_Number_Range; --| Which field to update New_Contents : SS.Screen_String --| new contents of field ) is begin if Entry_Handle = null then raise Invalid_Entry_Handle; end if; if TP.">"( Field_Number, TP.Variable_Field_Count(Entry_Handle.Template)) then raise Field_Not_Found; end if; Entry_Handle.Data(Field_Number) := New_Contents; end Update_Field; --------------------------------------------------------------------------- function Field_Contents( --| Returns the contents of a field Entry_Handle : Dictionary_Entry_Handle; --| Entry from which to get field contents Field_Number : TP.Variable_Field_Number_Range --| Which field to retrieve ) return SS.Screen_String is begin if Entry_Handle = null then raise Invalid_Entry_Handle; end if; if TP.">"( Field_Number, TP.Variable_Field_Count(Entry_Handle.Template)) then raise Field_Not_Found; end if; return Entry_Handle.Data(Field_Number); end Field_Contents; --------------------------------------------------------------------------- function Template_Kind( --| Returns the template type for handle Entry_Handle : Dictionary_Entry_Handle --| Entry from which to get template ) return TP.Template_Name is begin if Entry_Handle = null then raise Invalid_Entry_Handle; end if; return Entry_Handle.Template; end Template_Kind; --------------------------------------------------------------------------- -- Local subprogram bodies --------------------------------------------------------------------------- procedure Read_Index(Template : in TP.Template_Name) is File_Position : DIO.Count; --| Position read from file position list Node_Label : String(1 .. SS.Length_Range'Last); --| Identifier read from index file Last : Natural; --| Length of Node_Label File_Positions : File_Position_Array; --| Array being built to put into tree begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; begin Text_IO.Open( File => File_Types(Template).Index_File, Mode => Text_IO.In_File, Name => FM.Path_Name( SS.Value(Current_Dict), Index_File_Name(Template))); exception when Text_IO.Name_Error => Host_Lib.Set_Error; Text_IO.Put_Line( "Dictionary index file for " & TP.Template_Name'Image(Template) & " does not exist."); Close_Dictionary; raise Index_File_Error; when Text_IO.Use_Error | Text_IO.Status_Error => Host_Lib.Set_Error; Text_IO.Put_Line( "Dictionary index file for " & TP.Template_Name'Image(Template) & " cannot be opened: check protections."); Close_Dictionary; raise Index_File_Error; end; -- read in free list while not Text_IO.End_of_Line(File_Types(Template).Index_File) loop Int_IO.Get(File_Types(Template).Index_File, File_Position); -- check that it isn't just a placeholder if DIO."/="(File_Position, 0) then FL.Attach(Position_Free_Lists(Template), File_Position); end if; end loop; Text_IO.Skip_Line(File_Types(Template).Index_File); -- Read in tree while not Text_IO.End_Of_File(File_Types(Template).Index_File) loop Text_IO.Get_Line( File => File_Types(Template).Index_File, Item => Node_Label, Last => Last); -- reinitialize File_Positions File_Positions := (others => 0); for i in Overload_Range loop exit when Text_IO.End_Of_Line(File_Types(Template).Index_File); Int_IO.Get(File_Types(Template).Index_File, File_Positions(i)); end loop; Text_IO.Skip_Line(File_Types(Template).Index_File); IT.Insert_Node( Index_Trees(Template).Tree, SS.Create(Node_Label(1 .. Last)), File_Positions); end loop; Index_Trees(Template).Initialized := True; Text_IO.Close(File_Types(Template).Index_File); end Read_Index; --------------------------------------------------------------------------- procedure Write_Index(Template : in TP.Template_Name) is Count_Iter : FL.ListIter := --| File position iterator FL.MakeListIter(Position_Free_Lists(Template)); Index_Iter : IT.Tree_Iter := --| Index tree iterator IT.Make_Tree_Iter_Pre(Index_Trees(Template).Tree); Label : SS.Screen_String; --| Label in list File_Positions : File_Position_Array; --| Array of file positions begin if SS.Equal(Current_Dict, "") then raise No_Dictionary_File; end if; begin Text_IO.Open( File => File_Types(Template).Index_File, Mode => Text_IO.Out_File, Name => FM.Path_Name( SS.Value(Current_Dict), Index_File_Name(Template))); exception when Text_IO.Name_Error => Host_Lib.Set_Error; Text_IO.Put_Line( "Dictionary index file for " & TP.Template_Name'Image(Template) & " does not exist."); raise Index_File_Error; when Text_IO.Use_Error | Text_IO.Status_Error => Host_Lib.Set_Error; Text_IO.Put_Line( "Dictionary index file for " & TP.Template_Name'Image(Template) & " cannot be opened: check protections."); raise Index_File_Error; end; -- If free list is empty, write out zero as a place holder if FL.IsEmpty(Position_Free_Lists(Template)) then Int_IO.Put(File_Types(Template).Index_File, 0); else -- Iterate over free list and write it out on one line while FL.More(Count_Iter) loop Int_IO.Put( File_Types(Template).Index_File, FL.CellValue(Count_Iter)); FL.Forward(Count_Iter); end loop; end if; Text_IO.New_Line(File_Types(Template).Index_File); -- Iterate over index tree and write out tree in the form: -- node_identifier -- position position position ... -- node_identifier -- position position position ... -- etc. while IT.More(Index_Iter) loop IT.Next(Index_Iter, File_Positions, Label); -- don't put it if file position list is empty (i.e. all with -- that name have been deleted) if DIO."/="(File_Positions(Overload_Range'First), 0) then Text_IO.Put_Line( File_Types(Template).Index_File, SS.Value(Label)); for i in Overload_Range loop exit when DIO."="(File_Positions(i), 0); Int_IO.Put( File_Types(Template).Index_File, File_Positions(i)); end loop; Text_IO.New_Line(File_Types(Template).Index_File); end if; end loop; Text_IO.Close(File_Types(Template).Index_File); end Write_Index; --------------------------------------------------------------------------- function Attach_File_Position( --| Adds a file position to the array File_Positions : in File_Position_Array; --| Array of file positions Item : DIO.Positive_Count --| File position to attach ) return File_Position_Array is Temp_File_Positions : File_Position_Array := --| return value being built up File_Positions; Index : Overload_Range := --| Index to iterate over array Overload_Range'First; begin if DIO."/="(File_Positions(File_Position_Array'Last), 0) then raise Too_Many_Overloads; end if; while DIO."/="(File_Positions(Index), 0) loop Index := Index + 1; end loop; Temp_File_Positions(Index) := Item; return Temp_File_Positions; end Attach_File_Position; --------------------------------------------------------------------------- function Delete_File_Position( --| Deletes a file position from the array File_Positions : in File_Position_Array; --| Array of file positions Item : DIO.Positive_Count --| File position to delete ) return File_Position_Array is Temp_File_Positions : File_Position_Array := --| return value being built up File_Positions; Index : Positive := --| Index to iterate over array 1; begin -- Find index of item to delete while Index in File_Position_Array'Range loop exit when DIO."="(File_Positions(Index), Item); Index := Index + 1; end loop; if not (Index in File_Position_Array'Range) then raise No_Such_Occurrence; end if; -- special case if item to be deleted is last item if Index = File_Position_Array'Last then Temp_File_Positions(Index) := 0; else -- Do slice assignments to delete the item Temp_File_Positions(Index .. File_Position_Array'Last - 1) := File_Positions(Index + 1 .. File_Position_Array'Last); Temp_File_Positions(File_Position_Array'Last) := 0; end if; return Temp_File_Positions; end Delete_File_Position; --------------------------------------------------------------------------- function Data_File_Name( --| Returns the data file name for a template Template : TP.Template_Name ) return String is begin return TP.Template_Name'Image(Template) (1 .. TP.Template_Name'Image(Template)'Last - 5) & ".DAT"; end Data_File_Name; --------------------------------------------------------------------------- function Index_File_Name( --| Returns the index file name for a template Template : TP.Template_Name ) return String is begin return TP.Template_Name'Image(Template) (1 .. TP.Template_Name'Image(Template)'Last - 5) & ".INX"; end Index_File_Name; --------------------------------------------------------------------------- function Lock_File_Name( --| Returns the lock file name Lock_Mode : Lock_Mode_Name --| Name for unlocked or locked file ) return String is begin case Lock_Mode is when Unlocked => return "UNLOCKED.LCK"; when Locked => return "LOCKED.LCK"; end case; end Lock_File_Name; --------------------------------------------------------------------------- end Dictionary_Manager; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --UPDATE.BDY --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Text_IO; use Text_IO; with Screen_Strings; with String_Utilities; with Dictionary_Manager; with Templates; ------------------------------------------------------------------------------- package body Update is --| Update command processor package SS renames Screen_Strings; package SU renames String_Utilities; package DM renames Dictionary_Manager; package TP renames Templates; package SSU is new SU.Generic_String_Utilities( Generic_String_Type => SS.Screen_String, To_Generic => SS.Unchecked_Create, From_Generic => SS.Value); package Count_IO is new Text_IO.Integer_IO(Count); Missing_Template : exception; --| Raised when Template is missing --| from a command which requires it Invalid_Template : exception; --| Raised when Template given is --| not one of the valid templates Missing_Identifier : exception; --| Raised when identifier is --| missing from a command which --| requires it Invalid_Occurrence : exception; --| Raised when Occurrence given is --| invalid Too_Many_Parameters : exception; --| Raised when extra parameters --| appear on a command line Entry_Doesnt_Exist : exception; --| Raised when attempt is made to --| refer to an entry which doesn't --| exist Occurrence_Doesnt_Exist : exception; --| Raised when attempt is made to --| to an occurrence which doesn't --| exist Entry_Isnt_Unique : exception; --| Raised when attempt is made to --| refer to a non-unique entry --| without specifying an occurrence Identifier_Index : constant TP.Variable_Field_Number_Range := TP.Variable_Field_Number_Range'First; --| The first (variable) field in a template is defined as the identifier --| field Overload_Index : constant TP.Variable_Field_Number_Range := TP."+"(Identifier_Index, 1); --| The second (variable) field in a template is defined as the overload --| field Opening_Field_Delimiter : constant Character := '<'; Closing_Field_Delimiter : constant Character := '>'; Command_File : File_Type; --| Handle for the command file Current_File_Name : SS.Screen_String; --| Command file name Current_Line : SU.Scanner --| Current line read from --| command file := SSU.Make_Scanner(SS.Create("")); Current_Line_Number : Count := 0; --| Current line number of file Previous_Command_Line : SU.Scanner; --| Previous command line read Previous_Command_Line_Number : Count; --| Line number of previous --| command read type Command_Name is (Create, Update, Delete, Field, Not_A_Command); subtype Real_Command_Name is Command_Name range Create .. Delete; subtype Add_Command_Name is Command_Name range Create .. Update; --------------------------------------------------------------------------- -- Local subprogram specifications --------------------------------------------------------------------------- function Next_Input_Line( --| Returns the next line in From_File From_File : File_Type --| File to read ) return SU.Scanner; --| Effects: Reads the current line and makes a scanner from it. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- function Command_Mode( --| Scans a line for the command on it Line : SU.Scanner --| Line to scan ) return Command_Name; --| Effects: Scans Line for the first word and returns what kind of --| command it is. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Add_to_Dictionary( --| Adds a dictionary entry to dictionary Add_Mode : Add_Command_Name --| whether to create or update ); --| Effects: Adds a dictionary entry to the dictionary. Add_Mode --| determines whether to create a new entry or update an existing one. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Delete; --| Deletes a dictionary entry from dictionary --| Effects: Deletes a dictionary entry. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Put_Error( --| Prints an error message Error_Line : SU.Scanner; --| Text of line where error occurred Line_Number : Count; --| Line number where error occurred Text : String --| Message text ); --| Effects: Prints out the line number and the line containing --| the error and prints the error message Text on the next line. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- procedure Get_Parameters( --| Scans line for template, --| identifier and occurrence Line : SU.Scanner; --| Line to scan Template : out TP.Template_Name; --| Template found Identifier : out SS.Screen_String; --| Identifier found Occurrence : out Integer --| Occurrence found ); --| Raises: Missing_Template, Invalid_Template, Missing_Identifier, --| Invalid_Occurrence, Too_Many_Parameters --| Effects: Scans a line and returns the template, identifier and --| occurrence on it (second, third and fourth words). Checks whether --| or not Template is a legal template, and whether or not occurrence --| is a legal occurrence. Missing_Template is raised if the Template --| parameter is missing; Invalid_Template is raised if the Template --| parameter given isn't one of the valid template names; --| Missing_Identifier is raised if the identifier parameter is missing; --| Invalid_Occurrence is raised if the occurrence given is invalid; --| Too_Many_Parameters is raised if more than three parameters appear --| on the line. If Occurrence is not on command line, 0 is returned --| for Occurrence. --| N/A: Requires, Modifies --------------------------------------------------------------------------- procedure Skip_Fields( --| Skips over lines containing fields From_File : File_Type --| File containing lines to skip ); --| Effects: Skips over lines in From_File containing fields. --| N/A: Raises, Requires, Modifies --------------------------------------------------------------------------- -- External subprogram bodies --------------------------------------------------------------------------- procedure Process_Update_Commands( --| Processes all update commands Dictionary_Name : String; --| Name of dictionary Command_File_Name : String --| File of update commands ) is Read : Boolean := True; begin begin Open(Command_File, In_File, Command_File_Name); exception when others => Put_Line( "Error opening file " & Command_File_Name & " for input."); raise Abort_Update; end; Current_File_Name := SS.Unchecked_Create(Command_File_Name); DM.Open_Dictionary(Dictionary_Name); while not End_of_File(Command_File) loop -- only read when Current_Line has already been processed. -- Current_Line is updated in Add_to_Dictionary but not -- processed, so don't read after calls to Add_to_Dictionary if Read then SU.Destroy_Scanner(Current_Line); Current_Line := Next_Input_Line(Command_File); end if; Previous_Command_Line := SSU.Make_Scanner(SSU.Get_String( Current_Line)); Previous_Command_Line_Number := Current_Line_Number; case Command_Mode(Current_Line) is when Create => Read := False; Add_To_Dictionary(Create); when Update => Read := False; Add_To_Dictionary(Update); when Delete => Read := True; Delete; when others => Read := True; Put_Error( Current_Line, Current_Line_Number, "No command found on line"); end case; end loop; -- after the loop, if a command hasn't been processed, -- process it if not Read then case Command_Mode(Current_Line) is when Create => Add_to_Dictionary(Create); when Update => Add_to_Dictionary(Update); when Delete => Delete; when Field => null; -- has already been processed when others => Put_Error( Current_Line, Current_Line_Number, "No command found on line"); end case; end if; DM.Close_Dictionary; end Process_Update_Commands; --------------------------------------------------------------------------- -- Local subprogram bodies --------------------------------------------------------------------------- function Next_Input_Line( --| Returns the next line in From_File From_File : File_Type --| File to read ) return SU.Scanner is Line : String(1 .. 256); -- arbitrary length Last : Natural; Line_String : SS.Screen_String; Truncated : Boolean; Return_Scanner : SU.Scanner; begin while not End_of_File(From_File) loop -- get lines until non-blank line is found Get_Line(From_File, Line, Last); Current_Line_Number := Current_Line_Number + 1; SS.Create(Line(1 .. Last), Line_String, Truncated); if Truncated then Put_Line( Count'Image(Current_Line_Number) & ": " & Line(1 .. Last)); Put_Line("Line was truncated"); end if; Return_Scanner := SSU.Make_Scanner(Line_String); SU.Skip_Space(Return_Scanner); exit when SU.More(Return_Scanner); end loop; return Return_Scanner; end Next_Input_Line; --------------------------------------------------------------------------- function Command_Mode( --| Scans a line for the command on it Line : SU.Scanner --| Line to scan ) return Command_Name is Word : SS.Screen_String; Found : Boolean; Commands : array(Real_Command_Name) of SS.Screen_String := (SS.Create("create"), SS.Create("update"), SS.Create("delete")); begin -- Don't want to update the scanner, just want to test for what kind -- of command it is, so mark the scanner before calling Scan_Word and -- restore it afterwards. SU.Mark(Line); SSU.Scan_Word(Line, Found, Word, Skip => True); SU.Restore(Line); for i in Real_Command_Name loop if SS.Match_Prefix(Word, Commands(i)) then return i; end if; end loop; -- don't want to update scanner SU.Mark(Line); SSU.Scan_Enclosed( Opening_Field_Delimiter, Closing_Field_Delimiter, Line, Found, Word, Skip => True); SU.Restore(Line); if Found then return Field; end if; return Not_A_Command; end Command_Mode; --------------------------------------------------------------------------- procedure Add_to_Dictionary( --| Adds a dictionary entry to dictionary Add_Mode : Add_Command_Name --| whether to create or update ) is Template : TP.Template_Name; Identifier : SS.Screen_String; Occurrence : Integer range 0 .. DM.Overload_Range'Last; Handle : DM.Dictionary_Entry_Handle; Found : Boolean; Word : SS.Screen_String; Field_Number : TP.Variable_Field_Number_Range; No_Fields : exception; --| Raised when create or update --| appears with no fields following No_Occurrence_for_Create : exception; begin if End_of_File(Command_File) then raise No_Fields; end if; Get_Parameters(Current_Line, Template, Identifier, Occurrence); SU.Destroy_Scanner(Current_Line); Current_Line := Next_Input_Line(Command_File); if Command_Mode(Current_Line) /= Field then raise No_Fields; end if; if Add_Mode = Create then -- can't specify an occurrence with create command if Occurrence /= 0 then raise No_Occurrence_for_Create; end if; Handle := DM.New_Entry_Handle(Template); -- update identifier field with identifier read from command line DM.Update_Field(Handle, Identifier_Index, Identifier); else -- if no occurrences of this entry exist, raise exception if not DM.Entry_Exists(Template, Identifier) then raise Entry_Doesnt_Exist; end if; -- if it isn't unique and the occurrence hasn't been specified, -- raise Entry_Isnt_Unique. If occurrence hasn't been specified -- but the entry is unique, set occurrence to 1. if (Occurrence = 0) then if not DM.Unique_Entry(Template, Identifier) then raise Entry_Isnt_Unique; end if; Occurrence := 1; end if; -- if occurrence of this entry doesn't exist, raise exception if not DM.Entry_Exists(Template, Identifier, Occurrence) then raise Occurrence_Doesnt_Exist; end if; Handle := DM.Entry_Handle(Template, Identifier, Occurrence); end if; while not End_of_File(Command_File) and (Command_Mode(Current_Line) = Field) loop SSU.Scan_Enclosed( Opening_Field_Delimiter, Closing_Field_Delimiter, Current_Line, Found, Word, Skip => True); Field_Number := TP.Variable_Field_Number(Template, Word); DM.Update_Field( Handle, Field_Number, SSU.Get_Remainder(Current_Line)); SU.Destroy_Scanner(Current_Line); Current_Line := Next_Input_Line(Command_File); end loop; -- set Identifier variable to the first field of the entry in case -- it has changed, so error messages will be correct Identifier := DM.Field_Contents(Handle, Identifier_Index); if Add_Mode = Create then begin DM.Create_Entry(Handle); exception when DM.No_Overload_Field => DM.Update_Field( Handle, Overload_Index, SS.Unchecked_Create( "File " & SS.Value(Current_File_Name) & " line " & Count'Image(Previous_Command_Line_Number))); DM.Create_Entry(Handle); end; else begin DM.Update_Entry(Handle); exception when DM.No_Overload_Field => DM.Update_Field( Handle, Overload_Index, SS."&"( Current_File_Name, SS.Unchecked_Create( Count'Image(Current_Line_Number)))); DM.Update_Entry(Handle); end; end if; exception when No_Fields => Put_Error( Previous_Command_Line, Previous_Command_Line_Number, "No fields found for " & Real_Command_Name'Image(Add_Mode) & " command"); when No_Occurrence_for_Create => Put_Error( Previous_Command_Line, Previous_Command_Line_Number, "Occurrence parameter cannot be specified for CREATE command"); Skip_Fields(Command_File); when Missing_Template => Put_Error( Current_Line, Current_Line_Number, "Template parameter for " & Real_Command_Name'Image(Add_Mode) & " command is missing"); Skip_Fields(Command_File); when Invalid_Template => Put_Error( Current_Line, Current_Line_Number, "Template is invalid"); Skip_Fields(Command_File); when Missing_Identifier => Put_Error( Current_Line, Current_Line_Number, "Identifier parameter for " & Real_Command_Name'Image(Add_Mode) & " command is missing"); Skip_Fields(Command_File); when Invalid_Occurrence => Put_Error( Current_Line, Current_Line_Number, "Occurrence is invalid"); Skip_Fields(Command_File); when Too_Many_Parameters => Put_Error( Current_Line, Current_Line_Number, "Too many parameters for " & Real_Command_Name'Image(Add_Mode) & " command"); Skip_Fields(Command_File); when Entry_Doesnt_Exist => Put_Error( Previous_Command_Line, Previous_Command_Line_Number, "No dictionary entry for " & TP.Template_Name'Image(Template) & " " & SS.Value(Identifier)); Skip_Fields(Command_File); when Occurrence_Doesnt_Exist => Put_Error( Previous_Command_Line, Previous_Command_Line_Number, "No occurrence " & DM.Overload_Range'Image(Occurrence) & " for dictionary entry " & TP.Template_Name'Image(Template) & " " & SS.Value(Identifier)); Skip_Fields(Command_File); when Entry_Isnt_Unique => Put_Error( Previous_Command_Line, Previous_Command_Line_Number, "Dictionary entry " & TP.Template_Name'Image(Template) & " " & SS.Value(Identifier) & " is not unique"); Skip_Fields(Command_File); when TP.No_Such_Field => Put_Error( Current_Line, Current_Line_Number, "No such field " & SS.Value(Word) & " for template " & TP.Template_Name'Image(Template)); SU.Destroy_Scanner(Current_Line); Current_Line := Next_Input_Line(Command_File); when DM.Null_Identifier => Put_Error( Previous_Command_Line, Previous_Command_Line_Number, "Can't " & Real_Command_Name'Image(Add_Mode) & " entry with null identifier field"); when DM.Too_Many_Overloads => Put_Error( Previous_Command_Line, Previous_Command_Line_Number, "Too many overloads of " & TP.Template_Name'Image(Template) & " " & SS.Value(Identifier) & " already exist"); end Add_to_Dictionary; --------------------------------------------------------------------------- procedure Delete is --| Deletes a dictionary entry from dictionary Template : TP.Template_Name; Identifier : SS.Screen_String; Occurrence : Integer range 0 .. DM.Overload_Range'Last; Handle : DM.Dictionary_Entry_Handle; begin Get_Parameters(Current_Line, Template, Identifier, Occurrence); -- if no entry of type template and with name identifier exists, -- then raise exception if not DM.Entry_Exists(Template, Identifier) then raise Entry_Doesnt_Exist; end if; -- if it isn't unique and the occurrence hasn't been specified -- then raise exception if (Occurrence = 0) then if not DM.Unique_Entry(Template, Identifier) then raise Entry_Isnt_Unique; end if; Occurrence := 1; end if; -- if occurrence of this entry doesn't exist, raise exception if not DM.Entry_Exists(Template, Identifier, Occurrence) then raise Occurrence_Doesnt_Exist; end if; Handle := DM.Entry_Handle(Template, Identifier, Occurrence); DM.Delete_Entry(Handle); exception when Missing_Template => Put_Error( Current_Line, Current_Line_Number, "Template parameter is missing for DELETE command"); when Invalid_Template => Put_Error( Current_Line, Current_Line_Number, "Template is invalid"); when Missing_Identifier => Put_Error( Current_Line, Current_Line_Number, "Identifier parameter for DELETE command is missing"); when Invalid_Occurrence => Put_Error( Current_Line, Current_Line_Number, "Occurrence is invalid"); when Too_Many_Parameters => Put_Error( Current_Line, Current_Line_Number, "Too many parameters for DELETE command"); when Entry_Doesnt_Exist => Put_Error( Current_Line, Current_Line_Number, "No Dictionary entry for " & TP.Template_Name'Image(Template) & " " & SS.Value(Identifier)); when Occurrence_Doesnt_Exist => Put_Error( Current_Line, Current_Line_Number, "No occurrence " & DM.Overload_Range'Image(Occurrence) & " for dictionary entry " & TP.Template_Name'Image(Template) & " " & SS.Value(Identifier)); Skip_Fields(Command_File); when Entry_Isnt_Unique => Put_Error( Current_Line, Current_Line_Number, "Dictionary entry " & TP.Template_Name'Image(Template) & " " & SS.Value(Identifier) & " is not unique"); end Delete; --------------------------------------------------------------------------- procedure Get_Parameters( --| Scans line for template, --| identifier and occurrence Line : SU.Scanner; --| Line to scan Template : out TP.Template_Name; --| Template found Identifier : out SS.Screen_String; --| Identifier found Occurrence : out Integer --| Occurrence found ) is Template_Text : SS.Screen_String; Found : Boolean; Temp_Occurrence : Integer := 0; begin -- forward scanner over the command part SSU.Scan_Word(Line, Found, Template_Text, True); if not SU.More(Line) then raise Missing_Template; end if; -- get the template SSU.Scan_Word(Line, Found, Template_Text, True); -- check template's validity begin Template := TP.Template_Name'Value(SS.Value(Template_Text)); exception when Constraint_Error => raise Invalid_Template; end; if not SU.More(Line) then raise Missing_Identifier; end if; -- get the identifier SSU.Scan_Word(Line, Found, Identifier, True); -- get the occurrence if it exists if SU.More(Line) then SU.Scan_Number(Line, Found, Temp_Occurrence, True); -- check occurrence's validity if not Found then Temp_Occurrence := 0; elsif Temp_Occurrence not in DM.Overload_Range then raise Invalid_Occurrence; end if; end if; Occurrence := Temp_Occurrence; if SU.More(Line) then raise Too_Many_Parameters; end if; end Get_Parameters; --------------------------------------------------------------------------- procedure Put_Error( --| Prints an error message Error_Line : SU.Scanner; --| Text of line where error occurred Line_Number : Count; --| Line number where error occurred Text : String --| Message text ) is begin Count_IO.Put(Line_Number, 0); Put_Line(": " & SS.Value(SSU.Get_String(Error_Line))); Put_Line(Text); New_Line; end Put_Error; --------------------------------------------------------------------------- procedure Skip_Fields( --| Skips over lines containing fields From_File : File_Type --| File containing lines to skip ) is begin loop SU.Destroy_Scanner(Current_Line); Current_Line := Next_Input_Line(From_File); exit when End_Of_File(From_File) or (Command_Mode(Current_Line) /= Field); end loop; end Skip_Fields; --------------------------------------------------------------------------- end Update; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --EDRIVER.ADA --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Text_IO; use Text_IO; with Commands; with Dictionary_Manager; with Templates; with String_Pkg; with Screen_Strings; with Standard_Interface; with DD_Release; with Terminal_IO; with Host_Lib; ------------------------------------------------------------------------------- function Edit_Dictionary_Driver return Integer is --| Interprets command line and calls the editor package DM renames Dictionary_Manager; package SP renames String_Pkg; package SS renames Screen_Strings; package SI renames Standard_Interface; package TIO renames Terminal_IO; package Str_Argument is new SI.String_Argument( String_Type_Name => "String"); package Template_Name_Argument is new SI.Enumerated_Argument( Enum_Type => Templates.Template_Name, Enum_Type_Name => "Template_Name"); Edit_Handle : SI.Process_Handle; begin -- Error messages go to standard error Host_Lib.Set_Error; -- initialize terminal type TIO.Initialize(Host_Lib.Get_Terminal_Type); SI.Set_Tool_Identifier(DD_Release); SI.Define_Process( Name => "Edit_Dictionary", Help => "Call the interactive dictionary editor", Proc => Edit_Handle); -- define the parameters of Edit_Dictionary Str_Argument.Define_Argument( Proc => Edit_Handle, Name => "Dictionary", Help => "Full directory name for dictionary"); Template_Name_Argument.Define_Argument( Proc => Edit_Handle, Name => "Template", Help => "Type of template to edit"); Str_Argument.Define_Argument( Proc => Edit_Handle, Name => "Identifier", Default => "", Help => "Name of dictionary entry"); -- parse the command line SI.Parse_Line(Edit_Handle); -- set output back to standard output Host_Lib.Reset_Error; -- Call Process_Commands with the appropriate parameters Commands.Process_Commands( SP.Value(Str_Argument.Get_Argument( Proc => Edit_Handle, Name => "Dictionary")), Template_Name_Argument.Get_Argument( Proc => Edit_Handle, Name => "Template"), SS.Unchecked_Create(SP.Value(Str_Argument.Get_Argument( Proc => Edit_Handle, Name => "Identifier")))); return Host_Lib.Return_Code(Host_Lib.Success); exception when SI.Abort_Process => return Host_Lib.Return_Code(Host_Lib.Error); when SI.Process_Help => return Host_Lib.Return_Code(Host_Lib.Information); when Commands.Abort_Commands => Host_Lib.Set_Error; return Host_Lib.Return_Code(Host_Lib.Information); when DM.Dictionary_Locked => Host_Lib.Set_Error; Put_Line("Dictionary is locked by another user."); return Host_Lib.Return_Code(Host_Lib.Error); when DM.Lock_is_Missing => Host_Lib.Set_Error; Put_Line("Lock file for dictionary is missing."); return Host_Lib.Return_Code(Host_Lib.Error); when DM.Invalid_Dictionary_File => Host_Lib.Set_Error; return Host_Lib.Return_Code(Host_Lib.Error); when DM.Index_File_Error => Host_Lib.Set_Error; return Host_Lib.Return_Code(Host_Lib.Error); when DM.Data_File_Error => Host_Lib.Set_Error; return Host_Lib.Return_Code(Host_Lib.Error); when TIO.Unsupported_Terminal => Host_Lib.Set_Error; begin Put_Line( "Unsupported terminal type: " & Host_Lib.Terminal_Type'Image(Host_Lib.Get_Terminal_Type)); exception when Host_Lib.Terminal_Not_Attached => Put_Line("Terminal not attached."); end; return Host_Lib.Return_Code(Host_Lib.Error); when Host_Lib.Terminal_Not_Attached => Host_Lib.Set_Error; Put_Line("Terminal not attached."); return Host_Lib.Return_Code(Host_Lib.Error); when others => Host_Lib.Set_Error; Put_Line("Edit_Dictionary internal error."); begin DM.Close_Dictionary; exception when others => null; end; return Host_Lib.Return_Code(Host_Lib.Error); end Edit_Dictionary_Driver; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --RDRIVER.ADA --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Text_IO; use Text_IO; with Dictionary_Manager; with Standard_Interface; with DD_Release; with String_Pkg; with Host_Lib; ------------------------------------------------------------------------------- function Dictionary_Report_Driver return Integer is --| Interprets command line and calls reporting routines package SI renames Standard_Interface; package SP renames String_Pkg; package DM renames Dictionary_Manager; package RU renames DM.Report_Utilities; package Str_Argument is new SI.String_Argument("String"); package Report_Name_Argument is new SI.Enumerated_Argument( Enum_Type => RU.Report_Name, Enum_Type_Name => "Report_Name"); Report_Handle : SI.Process_Handle; begin -- Error messages go to standard error Host_Lib.Set_Error; SI.Set_Tool_Identifier(DD_Release); SI.Define_Process( Name => "Report_Dictionary", Help => "Produce report from data dictionary", Proc => Report_Handle); Str_Argument.Define_Argument( Proc => Report_Handle, Name => "Dictionary", Help => "Full directory name of dictionary to report"); Report_Name_Argument.Define_Argument( Proc => Report_Handle, Name => "Report", Default => RU.Summary, Help => "Which kind of report to produce"); Str_Argument.Define_Argument( Proc => Report_Handle, Name => "Entries", Default => "", Help => "Entries in dictionary from which to produce report"); Str_Argument.Append_Argument_Help( Proc => Report_Handle, Name => "Entries", Help => "(If Entries = """" and Entry_File = """" then entire"); Str_Argument.Append_Argument_Help( Proc => Report_Handle, Name => "Entries", Help => "dictionary is reported on)"); Str_Argument.Define_Argument( Proc => Report_Handle, Name => "Entry_File", Default => "", Help => "File containing entries in dictionary on which to report"); Str_Argument.Define_Argument( Proc => Report_Handle, Name => "Output", Default => "", Help => "Output file for report (default is standard output)"); SI.Parse_Line(Report_Handle); RU.Set_Up_Report( SP.Value(Str_Argument.Get_Argument(Report_Handle, "Dictionary")), SP.Value(Str_Argument.Get_Argument(Report_Handle, "Entries")), SP.Value(Str_Argument.Get_Argument(Report_Handle, "Entry_File"))); RU.Make_Report( Report_Name_Argument.Get_Argument(Report_Handle, "Report"), SP.Value(Str_Argument.Get_Argument(Report_Handle, "Output"))); return Host_Lib.Return_Code(Host_Lib.Success); exception when SI.Abort_Process => return Host_Lib.Return_Code(Host_Lib.Error); when SI.Process_Help => return Host_Lib.Return_Code(Host_Lib.Information); when RU.Abort_Report => return Host_Lib.Return_Code(Host_Lib.Error); when DM.Dictionary_Locked => Put_Line("Dictionary is locked by another user."); return Host_Lib.Return_Code(Host_Lib.Error); when DM.Lock_is_Missing => Put_Line("Lock file for dictionary is missing."); return Host_Lib.Return_Code(Host_Lib.Error); when DM.Invalid_Dictionary_File => return Host_Lib.Return_Code(Host_Lib.Error); when DM.Index_File_Error => return Host_Lib.Return_Code(Host_Lib.Error); when DM.Data_File_Error => return Host_Lib.Return_Code(Host_Lib.Error); when others => Put_Line("Report_Dictionary internal error."); begin DM.Close_Dictionary; exception when others => null; end; return Host_Lib.Return_Code(Host_Lib.Error); end Dictionary_Report_Driver; --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --SCREENMGR.BDY --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Text_IO; use Text_IO; with Terminal_IO; ------------------------------------------------------------------------------- package body Screen_Manager is --| Provide functions for displaying templates, menus, text and lines on the --| screen. package TIO renames Terminal_IO; Continue_Message : constant SS.Screen_String := SS.Create("--Press return to continue--"); Blanks : constant SS.Screen_String := SS.Create((1 .. SS.Max_Screen_Columns => ' ')); Current_Prompt : SS.Screen_String --| Last field prompt displayed on := SS.Create(""); --| screen Previous_Prompt : SS.Screen_String --| Last field prompt displayed prior := SS.Create(""); --| to Current_Prompt --------------------------------------------------------------------------- -- External subprogram bodies --------------------------------------------------------------------------- procedure Clear_Message_Line is --| Clears message line begin TIO.Set_Cursor(Max_Lines, 1); TIO.Clear_Line; end Clear_Message_Line; --------------------------------------------------------------------------- procedure Scroll_Prompt_Lines( --| Scrolls the prompt lines Old_Text : SS.Screen_String --| Text entered at last prompt ) is begin TIO.Set_Cursor(Max_Lines - 2, 1); Put("<" & SS.Value(Previous_Prompt) & ">: "); TIO.Clear_Line; Put(SS.Value(Old_Text)); Display_Prompt(Current_Prompt); end Scroll_Prompt_Lines; --------------------------------------------------------------------------- procedure Display_Message( --| Displays message on the message line Text : SS.Screen_String; --| Text to be displayed Name : Message_Name := Error --| Type of message ) is Dummy : SS.Screen_String; Trunc : Boolean; begin TIO.Set_Cursor(Max_Lines, 1); TIO.Clear_Line; Put(Message_Name'Image(Name) & ": " & SS.Value(Text)); end Display_Message; --------------------------------------------------------------------------- procedure Display_Blank_Template( --| Displays a blank template form Template : TP.Template_Name --| Type of template to display ) is Position : TP.Position_Descriptor; --| Position of a field begin for i in 1 .. Section1_Line_Range'Last loop TIO.Set_Cursor(i, 1); TIO.Clear_Line; end loop; TIO.Set_Cursor(1, 1); Put_Line(SS.Value(TP.Template_Label(Template))); for i in TP.Actual_Field_Number_Range'First .. TP.Field_Count(Template) loop Position := TP.Field_Position(Template, i); TIO.Set_Cursor(Position.Line, Position.column); -- if field is variable, then put open brackets around field label if TP."="(TP.Field_Mode(Template, i), TP.Variable) then Put_Line("<" & SS.Value(TP.Field_Label(Template, i)) & ">"); else Put_Line(SS.Value(TP.Field_Label(Template, i))); end if; end loop; end Display_Blank_Template; --------------------------------------------------------------------------- procedure Display_Filled_Template( --| Displays filled in template Entry_Handle : DM.Dictionary_Entry_Handle --| Entry which contains information to display ) is Position : TP.Position_Descriptor; Template : TP.Template_Name := DM.Template_Kind(Entry_Handle); begin for i in Section1_Line_Range loop TIO.Set_Cursor(i, 1); TIO.Clear_Line; end loop; TIO.Set_Cursor(1, 1); Put_Line(SS.Value(TP.Template_Label(Template))); for i in TP.Actual_Field_Number_Range'First .. TP.Field_Count(Template) loop Position := TP.Field_Position(Template, i); TIO.Set_Cursor(Position.Line, Position.Column); if TP."="(TP.Field_Mode(Template, i), TP.Static) then Put_Line(SS.Value(TP.Field_Label(Template, i))); -- if the field is empty, then display the field label elsif SS.Equal( DM.Field_Contents( Entry_Handle, TP.Variable_Field_Number(Template, i)), "") then Put_Line("<" & SS.Value(TP.Field_Label(Template, i)) & ">"); -- if the field is filled out, then display contents of field else Put_Line( SS.Value( DM.Field_Contents( Entry_Handle, TP.Variable_Field_Number(Template, i)))); end if; end loop; end Display_Filled_Template; --------------------------------------------------------------------------- procedure Display_Prompt( --| Displays prompt on prompt line Prompt_Text : SS.Screen_String; --| Text for the prompt Field_Prompt : Boolean := True --| type of prompt ) is begin TIO.Set_Cursor(Max_Lines - 1, 1); TIO.Clear_Line; if not Field_Prompt then Put(SS.Value(Prompt_Text)); -- so ^X will work on VMS (clears what has been typed) TIO.Set_Cursor(Max_Lines - 1, SS.Length(Prompt_Text) + 1); else Put("<" & SS.Value(Prompt_Text) & ">: "); -- so ^X will work on VMS (clears what has been typed) -- +4 for the characters <>: , +1 to get to column after prompt TIO.Set_Cursor(Max_Lines - 1, SS.Length(Prompt_Text) + 5); -- check for "" in case this is the first time it's being called if not SS.Equal(Current_Prompt, "") then Previous_Prompt := Current_Prompt; else Previous_Prompt := Prompt_Text; end if; Current_Prompt := Prompt_Text; end if; end Display_Prompt; --------------------------------------------------------------------------- procedure Display_Secondary_Prompt( --| Displays a "secondary" prompt on --| the prompt line Prompt_Text : SS.Screen_String --| Text for the prompt ) is Start_Column : constant SS.Length_Range := 40; --| Column on screen at which to position cursor before secondary --| prompt is written begin TIO.Set_Cursor(Max_Lines - 1, Start_Column); TIO.Clear_Line; -- add 5 to allow room for response if SS.Length(Prompt_Text) + 5 > SS.Max_Screen_Columns then raise Secondary_Prompt_Too_Long; end if; Put(SS.Value(Prompt_Text)); -- so ^X will work TIO.Set_Cursor( Max_Lines - 1, Start_Column + SS.Length(Prompt_Text)); end Display_Secondary_Prompt; --------------------------------------------------------------------------- procedure Display_Menu( --| Displays a menu of choices Menu : DM.Overload_Array; --| Menu to display Menu_Mode : Menu_Mode_Name := --| Mode of menu Prompt; Template : TP.Template_Name := --| Name of template to which menu TP.Object_Decl; --| corresponds Identifier : SS.Screen_String := --| Name of identifier to which menu SS.Create("") --| corresponds ) is begin TIO.Set_Cursor(1, 1); TIO.Clear_Screen; if not SS.Equal(Identifier, "") then Put_Line( "Overloads for " & TP.Template_Name'Image(Template) & " " & SS.Value(Identifier)); New_Line; end if; for i in DM.Overload_Range loop exit when (i > 1) and SS.Equal(Menu(i), ""); if i < 10 then Put_Line( DM.Overload_Range'Image(i) & " : " & SS.Value(Menu(i))); else Put_Line( DM.Overload_Range'Image(i) & ": " & SS.Value(Menu(i))); end if; end loop; if Menu_Mode = Continue then Display_Prompt(Continue_Message, Field_Prompt => False); end if; end Display_Menu; --------------------------------------------------------------------------- procedure Position_for_Exit is --| Repositions cursor at bottom of the --| screen begin TIO.Set_Cursor(Max_Lines, 1); New_Line; end Position_For_Exit; --------------------------------------------------------------------------- procedure Display_Command_List( --| Displays a list of commands Command_List : Screen_Array --| List of commands ) is Longest_Length : SS.Length_Range := 0; Blanks_Length : SS.Length_Range; begin TIO.Set_Cursor(1, 1); TIO.Clear_Screen; -- find the longest line (for centering) for i in Section1_Line_Range loop if SS.Length(Command_List(i)) > Longest_Length then Longest_Length := SS.Length(Command_List(i)); end if; end loop; -- find the length of white space needed to center list Blanks_Length := (SS.Max_Screen_Columns - Longest_Length) / 2; for i in Section1_Line_Range loop Put_Line( SS.Value(SS.Substring(Blanks, 1, Blanks_Length)) & SS.Value(Command_List(i))); end loop; Display_Prompt(Continue_Message, Field_Prompt => False); end Display_Command_List; --------------------------------------------------------------------------- procedure Display_Field( --| Displays contents of a field Entry_Handle : DM.Dictionary_Entry_Handle; --| Entry containing field to display Field_Number : TP.Actual_Field_Number_Range --| Which field to display ) is Position : TP.Position_Descriptor; Template : TP.Template_Name := DM.Template_Kind(Entry_Handle); begin Position := TP.Field_Position(Template, Field_Number); TIO.Set_Cursor(Position.Line, Position.Column); -- blank out the current contents of the field Put(SS.Value(Blanks)(1 .. TP.Field_Length(Template, Field_Number))); TIO.Set_Cursor(Position.Line, Position.Column); -- if the field is empty, then display the field label if SS.Equal( DM.Field_Contents( Entry_Handle, TP.Variable_Field_Number(Template, Field_Number)), "") then Put_Line("<" & SS.Value(TP.Field_Label(Template, Field_Number)) & ">"); else Put_Line( SS.Value( DM.Field_Contents( Entry_Handle, TP.Variable_Field_Number(Template, Field_Number)))); end if; end Display_Field; --------------------------------------------------------------------------- end Screen_Manager; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --SSTRINGS.BDY --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with String_Utilities; package body Screen_Strings is --| Varying length strings which are no longer than the maximum number of --| columns on a terminal screen. package SU renames String_Utilities; package SSU is new SU.Generic_String_Utilities( Generic_String_Type => Screen_String, To_Generic => Unchecked_Create, From_Generic => Value); --------------------------------------------------------------------------- -- External subprogram bodies --------------------------------------------------------------------------- function Create( --| Create a Screen_String from a string S : String --| String to create a Screen_String from ) return Screen_String is Temp_Screen_String : Screen_String; begin if S'Length > Length_Range'Last then raise String_Too_Long; end if; Temp_Screen_String.Text(1 .. S'Length) := S; Temp_Screen_String.Length := S'Length; return Temp_Screen_String; end Create; --------------------------------------------------------------------------- procedure Create( --| Create Screen_String from string S : String; --| String to create Screen_String from SS : out Screen_String; --| Return value Truncated : out Boolean --| Whether any text was truncated ) is begin Truncated := False; if S'Length > Length_Range'Last then Truncated := True; SS.Text(1 .. Length_Range'Last) := S(1 .. Length_Range'Last); SS.Length := Length_Range'Last; else SS.Text(1 .. S'Length) := S; SS.Length := S'Length; end if; end Create; --------------------------------------------------------------------------- function Unchecked_Create( --| Create a Screen_String from a string S : String --| String to create Screen_String from ) return Screen_String is Temp_Screen_String : Screen_String; begin if S'Length > Length_Range'Last then Temp_Screen_String.Text := S(1 .. Length_Range'Last); Temp_Screen_String.Length := Length_Range'Last; else Temp_Screen_String.Text(1 .. S'Length) := S; Temp_Screen_String.Length := S'Length; end if; return Temp_Screen_String; end Unchecked_Create; --------------------------------------------------------------------------- function Value( --| Returns the string value of a Screen_String SS : Screen_String --| Screen_String value ) return String is begin return SS.Text(1 .. SS.Length); end Value; --------------------------------------------------------------------------- function Length( --| Returns the length of a Screen_String SS : Screen_String --| Screen_String whose length to return ) return Length_Range is begin return SS.Length; end Length; --------------------------------------------------------------------------- function "<"( --| Returns SS1 < SS2 SS1, SS2 : Screen_String --| Screen_Strings to compare ) return Boolean is begin if SS1.Length < SS2.Length then return True; end if; if SS1.Length > SS2.Length then return False; end if; return SS1.Text(1 .. SS1.Length) < SS2.Text(1 .. SS2.Length); end "<"; --------------------------------------------------------------------------- function "<"( --| Returns Value(SS) < S SS : Screen_String; --| Screen_String to compare S : String --| String to compare ) return Boolean is begin if SS.Length < S'Length then return True; end if; if SS.Length > S'Length then return False; end if; return SS.Text(1 .. SS.Length) < S; end "<"; --------------------------------------------------------------------------- function "<"( --| Returns S < Value(SS) S : String; --| String to compare SS : Screen_String --| Screen_String to compare ) return Boolean is begin if S'Length < SS.Length then return True; end if; if S'Length > SS.Length then return False; end if; return S < SS.Text(1 .. SS.Length); end "<"; --------------------------------------------------------------------------- function Equal( --| Returns Value(SS1) = Value(SS2) SS1, SS2 : Screen_String --| Screen_Strings to compare ) return Boolean is begin if SS1.Length /= SS2.Length then return False; end if; return SS1.Text(1 .. SS1.Length) = SS2.Text(1 .. SS2.Length); end Equal; --------------------------------------------------------------------------- function Equal( --| Returns Value(SS) = S SS : Screen_String; --| Screen_String to compare S : String --| String to compare ) return Boolean is begin if SS.Length /= S'Length then return False; end if; return SS.Text(1 .. SS.Length) = S; end Equal; --------------------------------------------------------------------------- function Equal( --| Returns S = Value(SS) S : String; --| String to compare SS : Screen_String --| Screen_String to compare ) return Boolean is begin if S'Length /= SS.Length then return False; end if; return S = SS.Text(1 .. SS.Length); end Equal; --------------------------------------------------------------------------- function "&"( --| Concatenation operation SS1 : Screen_String; --| First Screen_String to concatenate SS2 : Screen_String --| Second Screen_String to concatenate ) return Screen_String is begin if SS1.Length + SS2.Length > Max_Screen_Columns then raise String_Too_Long; end if; return Create(Value(SS1) & Value(SS2)); end "&"; --------------------------------------------------------------------------- function "&"( --| Concatenation operation SS : Screen_String; --| Screen_String to concatenate S : String --| String to concatenate ) return Screen_String is begin if SS.Length + S'Length > Max_Screen_Columns then raise String_Too_Long; end if; return Create(Value(SS) & S); end "&"; --------------------------------------------------------------------------- function "&"( --| Concatenation operation S : String; --| String to concatenate SS : Screen_String --| Screen_String to concatenate ) return Screen_String is begin if S'Length + SS.Length > Max_Screen_Columns then raise String_Too_Long; end if; return Create(S & Value(SS)); end "&"; --------------------------------------------------------------------------- function Substring( --| Returns a substring of SS SS : Screen_String; --| Screen string from which to get substring Start : Length_Range; --| Starting index of substring Length : Length_Range --| Length of substring ) return Screen_String is End_Index : Integer := Start + Length - 1; begin if (End_Index not in Length_Range) or (End_Index > SS.Length) then raise Invalid_Substring; end if; return Create(SS.Text(Start .. End_Index)); end Substring; --------------------------------------------------------------------------- function Match_Prefix( --| Returns whether SS1 is a prefix of SS2 SS1 : Screen_String; --| The prefix Screen_String SS2 : Screen_String --| Screen_String to compare prefix against ) return Boolean is Canon_SS1 : Screen_String := SS1; Canon_SS2 : Screen_String := SS2; begin if SS1.Length > SS2.Length then return False; end if; -- make canonical form of SS1 to compare to, since Match_Prefix is -- not case sensitive for i in 1 .. SS1.Length loop if SS1.Text(i) in 'a' .. 'z' then Canon_SS1.Text(i) := Character'Val(Character'Pos(SS1.Text(i)) - Character'Pos('a') + Character'Pos('A')); end if; end loop; -- make canonical form of SS2 to compare to, since Match_Prefix is -- not case sensitive for i in 1 .. SS2.Length loop if SS2.Text(i) in 'a' .. 'z' then Canon_SS2.Text(i) := Character'Val(Character'Pos(SS2.Text(i)) - Character'Pos('a') + Character'Pos('A')); end if; end loop; return Canon_SS1.Text(1 .. SS1.Length) = Canon_SS2.Text(1 .. SS1.Length); end Match_Prefix; --------------------------------------------------------------------------- function Match_Prefix( --| Returns whether S is a prefix of SS S : String; --| The prefix String SS : Screen_String --| Screen_String to compare prefix against ) return Boolean is begin return Match_Prefix(Create(S), SS); end Match_Prefix; --------------------------------------------------------------------------- function Match_Prefix( --| Returns whether SS is a prefix of S SS : Screen_String; --| The prefix Screen_String S : String --| String to compare prefix against ) return Boolean is begin return Match_Prefix(SS, Create(S)); end Match_Prefix; --------------------------------------------------------------------------- function Match_Pattern( --| Matches a pattern in a screen_string Pattern : Screen_String; --| The pattern to match Text : Screen_String --| Text in which to search for pattern ) return Length_Range is Text_Scanner : SU.Scanner := SSU.Make_Scanner(Text); begin for i in 1 .. Text.Length loop if SSU.Is_Literal(Pattern, Text_Scanner) then return i; end if; SU.Forward(Text_Scanner); end loop; return 0; end Match_Pattern; --------------------------------------------------------------------------- function Match_Pattern( --| Matches a pattern in a screen_string Pattern : String; --| The pattern to match Text : Screen_String --| Text in which to search for pattern ) return Length_Range is begin return Match_Pattern(Create(Pattern), Text); end Match_Pattern; --------------------------------------------------------------------------- function Match_Pattern( --| Matches a pattern in a screen_string Pattern : Screen_String; --| The pattern to match Text : String --| Text in which to search for pattern ) return Length_Range is begin return Match_Pattern(Pattern, Create(Text)); end Match_Pattern; --------------------------------------------------------------------------- end Screen_Strings; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --TEMPLATES.BDY --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: package body Templates is ----------------------------------------------------------------- -- Local declarations for package Templates ----------------------------------------------------------------- type Template_Field(Mode : Field_Mode_Name) is record Position : Position_Descriptor; Label : SS.Screen_String; case Mode is when Variable => Length : Positive; Help_Line : SS.Screen_String; when Static => null; end case; end record; type Template_Field_Handle is access Template_Field; type Field_Array is array(Actual_Field_Number_Range) of Template_Field_Handle; type Template_Descriptor is record Label : SS.Screen_String; Fields : Field_Array := (others => null); end record; type Template_Handle is access Template_Descriptor; -- All templates initialized here. Template_Info : array(Template_Name) of Template_Handle := ( Object_Decl => new Template_Descriptor'( Label => SS.Create("Object, Constant or Number Declaration"), Fields => ( new Template_Field'( Mode => Variable, Position => (3, 1), Label => SS.Create("ident"), Length => 30, Help_Line => SS.Create("Object declaration identifier")), new Template_Field'( Mode => Static, Position => (3, 31), Label => SS.Create(": -- ")), new Template_Field'( Mode => Variable, Position => (3, 36), Label => SS.Create("overload"), Length => 45, Help_Line => SS.Create( "Comment distinguishing this object from others " & "with the same <ident>")), new Template_Field'( Mode => Variable, Position => (4, 5), Label => SS.Create("type"), Length => 76, Help_Line => SS.Create("The type of the object")), new Template_Field'( Mode => Static, Position => (5, 9), Label => SS.Create(":= ")), new Template_Field'( Mode => Variable, Position => (5, 12), Label => SS.Create("expr"), Length => 69, Help_Line => SS.Create( "Initializing expression for object declaration")), new Template_Field'( Mode => Static, Position => (7, 1), Label => SS.Create("-- Synonym: ")), new Template_Field'( Mode => Variable, Position => (7, 13), Label => SS.Create("syn"), Length => 68, Help_Line => SS.Create( "Identifier which is a synonym for this <ident>")), new Template_Field'( Mode => Static, Position => (8, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (8, 4), Label => SS.Create("date"), Length => 28, Help_Line => SS.Create( "Date on which this object declaration was written")), new Template_Field'( Mode => Variable, Position => (8, 33), Label => SS.Create("author"), Length => 48, Help_Line => SS.Create( "Author of this object declaration")), new Template_Field'( Mode => Static, Position => (10, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (10, 4), Label => SS.Create("1.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), new Template_Field'( Mode => Static, Position => (11, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (11, 4), Label => SS.Create("2.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), new Template_Field'( Mode => Static, Position => (12, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (12, 4), Label => SS.Create("3.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), new Template_Field'( Mode => Static, Position => (13, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (13, 4), Label => SS.Create("4.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), new Template_Field'( Mode => Static, Position => (14, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (14, 4), Label => SS.Create("5.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), new Template_Field'( Mode => Static, Position => (15, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (15, 4), Label => SS.Create("6.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), new Template_Field'( Mode => Static, Position => (16, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (16, 4), Label => SS.Create("7.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), new Template_Field'( Mode => Static, Position => (17, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (17, 4), Label => SS.Create("8.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), new Template_Field'( Mode => Static, Position => (18, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (18, 4), Label => SS.Create("9.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), new Template_Field'( Mode => Static, Position => (19, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (19, 4), Label => SS.Create("10.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for object declaration")), -- explicit "null" for elements before the others clause -- because of DEC Ada compiler bug null, others => null)), Type_Decl => new Template_Descriptor'( Label => SS.Create("Type Declaration"), Fields => ( new Template_Field'( Mode => Static, Position => (3, 1), Label => SS.Create("type ")), new Template_Field'( Mode => Variable, Position => (3, 6), Label => SS.Create("ident"), Length => 26, Help_Line => SS.Create("Type declaration identifier")), new Template_Field'( Mode => Static, Position => (3, 33), Label => SS.Create("is -- ")), new Template_Field'( Mode => Variable, Position => (3, 39), Label => SS.Create("overload"), Length => 42, Help_Line => SS.Create( "Comment distinguishing this type from others " & "with the same <ident>")), new Template_Field'( Mode => Variable, Position => (4, 5), Label => SS.Create("1.def"), Length => 76, Help_Line => SS.Create( "Type definition for type <ident>")), new Template_Field'( Mode => Variable, Position => (5, 5), Label => SS.Create("2.def"), Length => 76, Help_Line => SS.Create( "Type definition for type <ident>")), new Template_Field'( Mode => Variable, Position => (6, 5), Label => SS.Create("3.def"), Length => 76, Help_Line => SS.Create( "Type definition for type <ident>")), new Template_Field'( Mode => Variable, Position => (7, 5), Label => SS.Create("4.def"), Length => 76, Help_Line => SS.Create( "Type definition for type <ident>")), new Template_Field'( Mode => Variable, Position => (8, 5), Label => SS.Create("5.def"), Length => 76, Help_Line => SS.Create( "Type definition for type <ident>")), new Template_Field'( Mode => Variable, Position => (9, 5), Label => SS.Create("6.def"), Length => 76, Help_Line => SS.Create( "Type definition for type <ident>")), new Template_Field'( Mode => Variable, Position => (10, 5), Label => SS.Create("7.def"), Length => 76, Help_Line => SS.Create( "Type definition for type <ident>")), new Template_Field'( Mode => Variable, Position => (11, 5), Label => SS.Create("8.def"), Length => 76, Help_Line => SS.Create( "Type definition for type <ident>")), new Template_Field'( Mode => Static, Position => (13, 1), Label => SS.Create("-- Synonym: ")), new Template_Field'( Mode => Variable, Position => (13, 13), Label => SS.Create("syn"), Length => 68, Help_Line => SS.Create( "Identifier which is a synonym for this <ident>")), new Template_Field'( Mode => Static, Position => (14, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (14, 4), Label => SS.Create("date"), Length => 28, Help_Line => SS.Create( "Date on which this type declaration was written")), new Template_Field'( Mode => Variable, Position => (14, 33), Label => SS.Create("author"), Length => 48, Help_Line => SS.Create( "Author of this type declaration")), new Template_Field'( Mode => Static, Position => (16, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (16, 4), Label => SS.Create("1.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for type declaration")), new Template_Field'( Mode => Static, Position => (17, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (17, 4), Label => SS.Create("2.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for type declaration")), new Template_Field'( Mode => Static, Position => (18, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (18, 4), Label => SS.Create("3.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for type declaration")), new Template_Field'( Mode => Static, Position => (19, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (19, 4), Label => SS.Create("4.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for type declaration")), new Template_Field'( Mode => Static, Position => (20, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (20, 4), Label => SS.Create("5.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for type declaration")), -- explicit "null" for elements before the others clause -- because of DEC Ada compiler bug null, others => null)), Procedure_Decl => new Template_Descriptor'( Label => SS.Create("Procedure Declaration"), Fields => ( new Template_Field'( Mode => Static, Position => (3, 1), Label => SS.Create("procedure ")), new Template_Field'( Mode => Variable, Position => (3, 11), Label => SS.Create("ident"), Length => 25, Help_Line => SS.Create("Procedure declaration identifier")), new Template_Field'( Mode => Static, Position => (3, 36), Label => SS.Create("( -- ")), new Template_Field'( Mode => Variable, Position => (3, 41), Label => SS.Create("overload"), Length => 40, Help_Line => SS.Create( "Comment distinguishing this procedure from others " & "with the same <ident>")), new Template_Field'( Mode => Variable, Position => (4, 5), Label => SS.Create("1.param"), Length => 33, Help_Line => SS.Create("Parameter of procedure <ident>")), new Template_Field'( Mode => Static, Position => (4, 38), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (4, 41), Label => SS.Create("1.comm"), Length => 40, Help_Line => SS.Create("Comment describing this parameter")), new Template_Field'( Mode => Variable, Position => (5, 5), Label => SS.Create("2.param"), Length => 33, Help_Line => SS.Create("Parameter of procedure <ident>")), new Template_Field'( Mode => Static, Position => (5, 38), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (5, 41), Label => SS.Create("2.comm"), Length => 40, Help_Line => SS.Create("Comment describing this parameter")), new Template_Field'( Mode => Variable, Position => (6, 5), Label => SS.Create("3.param"), Length => 33, Help_Line => SS.Create("Parameter of procedure <ident>")), new Template_Field'( Mode => Static, Position => (6, 38), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (6, 41), Label => SS.Create("3.comm"), Length => 40, Help_Line => SS.Create("Comment describing this parameter")), new Template_Field'( Mode => Variable, Position => (7, 5), Label => SS.Create("4.param"), Length => 33, Help_Line => SS.Create("Parameter of procedure <ident>")), new Template_Field'( Mode => Static, Position => (7, 38), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (7, 41), Label => SS.Create("4.comm"), Length => 40, Help_Line => SS.Create("Comment describing this parameter")), new Template_Field'( Mode => Static, Position => (8, 5), Label => SS.Create(");")), new Template_Field'( Mode => Static, Position => (10, 1), Label => SS.Create("-- Synonym: ")), new Template_Field'( Mode => Variable, Position => (10, 13), Label => SS.Create("syn"), Length => 68, Help_Line => SS.Create( "Identifier which is a synonym for this <ident>")), new Template_Field'( Mode => Static, Position => (11, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (11, 4), Label => SS.Create("date"), Length => 28, Help_Line => SS.Create( "Date on which this procedure declaration was " & "written")), new Template_Field'( Mode => Variable, Position => (11, 33), Label => SS.Create("author"), Length => 48, Help_Line => SS.Create( "Author of this procedure declaration")), new Template_Field'( Mode => Static, Position => (13, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (13, 4), Label => SS.Create("1.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for procedure declaration")), new Template_Field'( Mode => Static, Position => (14, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (14, 4), Label => SS.Create("2.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for procedure declaration")), new Template_Field'( Mode => Static, Position => (15, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (15, 4), Label => SS.Create("3.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for procedure declaration")), new Template_Field'( Mode => Static, Position => (16, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (16, 4), Label => SS.Create("4.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for procedure declaration")), new Template_Field'( Mode => Static, Position => (17, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (17, 4), Label => SS.Create("5.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for procedure declaration")), new Template_Field'( Mode => Static, Position => (18, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (18, 4), Label => SS.Create("6.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for procedure declaration")), new Template_Field'( Mode => Static, Position => (19, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (19, 4), Label => SS.Create("7.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for procedure declaration")), new Template_Field'( Mode => Static, Position => (20, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (20, 4), Label => SS.Create("8.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for procedure declaration")), -- explicit "null" for elements before the others clause -- because of DEC Ada compiler bug null, others => null)), Function_Decl => new Template_Descriptor'( Label => SS.Create("Function Declaration"), Fields => ( new Template_Field'( Mode => Static, Position => (3, 1), Label => SS.Create("function ")), new Template_Field'( Mode => Variable, Position => (3, 10), Label => SS.Create("ident"), Length => 26, Help_Line => SS.Create("Function declaration identifier")), new Template_Field'( Mode => Static, Position => (3, 36), Label => SS.Create("( -- ")), new Template_Field'( Mode => Variable, Position => (3, 41), Label => SS.Create("overload"), Length => 40, Help_Line => SS.Create( "Comment distinguishing this function from others " & "with the same <ident>")), new Template_Field'( Mode => Variable, Position => (4, 5), Label => SS.Create("1.param"), Length => 33, Help_Line => SS.Create("Parameter of function <ident>")), new Template_Field'( Mode => Static, Position => (4, 38), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (4, 41), Label => SS.Create("1.comm"), Length => 40, Help_Line => SS.Create("Comment describing this parameter")), new Template_Field'( Mode => Variable, Position => (5, 5), Label => SS.Create("2.param"), Length => 33, Help_Line => SS.Create("Parameter of function <ident>")), new Template_Field'( Mode => Static, Position => (5, 38), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (5, 41), Label => SS.Create("2.comm"), Length => 40, Help_Line => SS.Create("Comment describing this parameter")), new Template_Field'( Mode => Variable, Position => (6, 5), Label => SS.Create("3.param"), Length => 33, Help_Line => SS.Create("Parameter of function <ident>")), new Template_Field'( Mode => Static, Position => (6, 38), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (6, 41), Label => SS.Create("3.comm"), Length => 40, Help_Line => SS.Create("Comment describing this parameter")), new Template_Field'( Mode => Variable, Position => (7, 5), Label => SS.Create("4.param"), Length => 33, Help_Line => SS.Create("Parameter of function <ident>")), new Template_Field'( Mode => Static, Position => (7, 38), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (7, 41), Label => SS.Create("4.comm"), Length => 40, Help_Line => SS.Create("Comment describing this parameter")), new Template_Field'( Mode => Static, Position => (8, 5), Label => SS.Create(") return ")), new Template_Field'( Mode => Variable, Position => (8, 14), Label => SS.Create("type"), Length => 67, Help_Line => SS.Create("Return type for this function")), new Template_Field'( Mode => Static, Position => (10, 1), Label => SS.Create("-- Synonym: ")), new Template_Field'( Mode => Variable, Position => (10, 13), Label => SS.Create("syn"), Length => 68, Help_Line => SS.Create( "Identifier which is a synonym for this <ident>")), new Template_Field'( Mode => Static, Position => (11, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (11, 4), Label => SS.Create("date"), Length => 28, Help_Line => SS.Create( "Date on which this function declaration was " & "written")), new Template_Field'( Mode => Variable, Position => (11, 33), Label => SS.Create("author"), Length => 48, Help_Line => SS.Create( "Author of this function declaration")), new Template_Field'( Mode => Static, Position => (13, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (13, 4), Label => SS.Create("1.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for function declaration")), new Template_Field'( Mode => Static, Position => (14, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (14, 4), Label => SS.Create("2.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for function declaration")), new Template_Field'( Mode => Static, Position => (15, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (15, 4), Label => SS.Create("3.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for function declaration")), new Template_Field'( Mode => Static, Position => (16, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (16, 4), Label => SS.Create("4.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for function declaration")), new Template_Field'( Mode => Static, Position => (17, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (17, 4), Label => SS.Create("5.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for function declaration")), new Template_Field'( Mode => Static, Position => (18, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (18, 4), Label => SS.Create("6.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for function declaration")), new Template_Field'( Mode => Static, Position => (19, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (19, 4), Label => SS.Create("7.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for function declaration")), new Template_Field'( Mode => Static, Position => (20, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (20, 4), Label => SS.Create("8.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for function declaration")), -- explicit "null" for elements before the others clause -- because of DEC Ada compiler bug null, others => null)), Package_Decl => new Template_Descriptor'( Label => SS.Create("Package Declaration"), Fields => ( new Template_Field'( Mode => Static, Position => (3, 1), Label => SS.Create("package ")), new Template_Field'( Mode => Variable, Position => (3, 9), Label => SS.Create("ident"), Length => 23, Help_Line => SS.Create("Package declaration identifier")), new Template_Field'( Mode => Static, Position => (3, 33), Label => SS.Create("is -- ")), new Template_Field'( Mode => Variable, Position => (3, 40), Label => SS.Create("overload"), Length => 41, Help_Line => SS.Create( "Comment distinguishing this package from others " & "with the same <ident>")), new Template_Field'( Mode => Static, Position => (4, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (4, 4), Label => SS.Create("comment"), Length => 77, Help_Line => SS.Create("Short comment describing this package")), new Template_Field'( Mode => Static, Position => (6, 1), Label => SS.Create("-- Synonym: ")), new Template_Field'( Mode => Variable, Position => (6, 13), Label => SS.Create("syn"), Length => 68, Help_Line => SS.Create( "Identifier which is a synonym for this <ident>")), new Template_Field'( Mode => Static, Position => (7, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (7, 4), Label => SS.Create("date"), Length => 28, Help_Line => SS.Create( "Date on which this package declaration was " & "written")), new Template_Field'( Mode => Variable, Position => (7, 33), Label => SS.Create("author"), Length => 48, Help_Line => SS.Create( "Author of this package declaration")), new Template_Field'( Mode => Static, Position => (9, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (9, 4), Label => SS.Create("1.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (10, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (10, 4), Label => SS.Create("2.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (11, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (11, 4), Label => SS.Create("3.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (12, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (12, 4), Label => SS.Create("4.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (13, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (13, 4), Label => SS.Create("5.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (14, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (14, 4), Label => SS.Create("6.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (15, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (15, 4), Label => SS.Create("7.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (16, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (16, 4), Label => SS.Create("8.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (17, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (17, 4), Label => SS.Create("9.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (18, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (18, 4), Label => SS.Create("10.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for package declaration")), new Template_Field'( Mode => Static, Position => (20, 1), Label => SS.Create("end; ")), -- explicit "null" for elements before the others clause -- because of DEC Ada compiler bug null, others => null)), Task_Decl => new Template_Descriptor'( Label => SS.Create("Task Declaration"), Fields => ( new Template_Field'( Mode => Static, Position => (3, 1), Label => SS.Create("task ")), new Template_Field'( Mode => Variable, Position => (3, 6), Label => SS.Create("ident"), Length => 26, Help_Line => SS.Create("Task declaration identifier")), new Template_Field'( Mode => Static, Position => (3, 33), Label => SS.Create("is -- ")), new Template_Field'( Mode => Variable, Position => (3, 39), Label => SS.Create("overload"), Length => 42, Help_Line => SS.Create( "Comment distinguishing this task from others " & "with the same <ident>")), new Template_Field'( Mode => Static, Position => (4, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (4, 4), Label => SS.Create("comment"), Length => 77, Help_Line => SS.Create("Short comment describing this task")), new Template_Field'( Mode => Static, Position => (5, 5), Label => SS.Create("entry ")), new Template_Field'( Mode => Variable, Position => (5, 11), Label => SS.Create("1.decl"), Length => 25, Help_Line => SS.Create("Entry declaration")), new Template_Field'( Mode => Static, Position => (5, 36), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (5, 39), Label => SS.Create("1.comm"), Length => 42, Help_Line => SS.Create( "Comment describing this entry declaration")), new Template_Field'( Mode => Static, Position => (6, 5), Label => SS.Create("entry ")), new Template_Field'( Mode => Variable, Position => (6, 11), Label => SS.Create("2.decl"), Length => 25, Help_Line => SS.Create("Entry declaration")), new Template_Field'( Mode => Static, Position => (6, 36), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (6, 39), Label => SS.Create("2.comm"), Length => 42, Help_Line => SS.Create( "Comment describing this entry declaration")), new Template_Field'( Mode => Static, Position => (7, 5), Label => SS.Create("entry ")), new Template_Field'( Mode => Variable, Position => (7, 11), Label => SS.Create("3.decl"), Length => 25, Help_Line => SS.Create("Entry declaration")), new Template_Field'( Mode => Static, Position => (7, 36), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (7, 39), Label => SS.Create("3.comm"), Length => 42, Help_Line => SS.Create( "Comment describing this entry declaration")), new Template_Field'( Mode => Static, Position => (8, 5), Label => SS.Create("entry ")), new Template_Field'( Mode => Variable, Position => (8, 11), Label => SS.Create("4.decl"), Length => 25, Help_Line => SS.Create("Entry declaration")), new Template_Field'( Mode => Static, Position => (8, 36), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (8, 39), Label => SS.Create("4.comm"), Length => 42, Help_Line => SS.Create( "Comment describing this entry declaration")), new Template_Field'( Mode => Static, Position => (9, 1), Label => SS.Create("end;")), new Template_Field'( Mode => Static, Position => (11, 1), Label => SS.Create("-- Synonym: ")), new Template_Field'( Mode => Variable, Position => (11, 13), Label => SS.Create("syn"), Length => 68, Help_Line => SS.Create( "Identifier which is a synonym for this <ident>")), new Template_Field'( Mode => Static, Position => (12, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (12, 4), Label => SS.Create("date"), Length => 28, Help_Line => SS.Create( "Date on which this task declaration was " & "written")), new Template_Field'( Mode => Variable, Position => (12 ,33), Label => SS.Create("author"), Length => 48, Help_Line => SS.Create( "Author of this task declaration")), new Template_Field'( Mode => Static, Position => (14, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (14, 4), Label => SS.Create("1.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for task declaration")), new Template_Field'( Mode => Static, Position => (15, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (15, 4), Label => SS.Create("2.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for task declaration")), new Template_Field'( Mode => Static, Position => (16, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (16, 4), Label => SS.Create("3.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for task declaration")), new Template_Field'( Mode => Static, Position => (17, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (17, 4), Label => SS.Create("4.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for task declaration")), new Template_Field'( Mode => Static, Position => (18, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (18, 4), Label => SS.Create("5.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for task declaration")), new Template_Field'( Mode => Static, Position => (19, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (19, 4), Label => SS.Create("6.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for task declaration")), new Template_Field'( Mode => Static, Position => (20, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (20, 4), Label => SS.Create("7.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for task declaration")), -- explicit "null" for elements before the others clause -- because of DEC Ada compiler bug null, others => null)), Exception_Decl => new Template_Descriptor'( Label => SS.Create("Exception Declaration"), Fields => ( new Template_Field'( Mode => Variable, Position => (3, 1), Label => SS.Create("ident"), Length => 30, Help_Line => SS.Create("Exception declaration identifier")), new Template_Field'( Mode => Static, Position => (3, 31), Label => SS.Create(": -- ")), new Template_Field'( Mode => Variable, Position => (3, 36), Label => SS.Create("overload"), Length => 42, Help_Line => SS.Create( "Comment distinguishing this object from others " & "with the same <ident>")), new Template_Field'( Mode => Static, Position => (4, 5), Label => SS.Create("exception;")), new Template_Field'( Mode => Static, Position => (6, 1), Label => SS.Create("-- Synonym: ")), new Template_Field'( Mode => Variable, Position => (6, 13), Label => SS.Create("syn"), Length => 68, Help_Line => SS.Create( "Identifier which is a synonym for this <ident>")), new Template_Field'( Mode => Static, Position => (7, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (7, 4), Label => SS.Create("date"), Length => 28, Help_Line => SS.Create( "Date on which this exception declaration was " & "written")), new Template_Field'( Mode => Variable, Position => (7, 33), Label => SS.Create("author"), Length => 48, Help_Line => SS.Create( "Author of this exception declaration")), new Template_Field'( Mode => Static, Position => (9, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (9, 4), Label => SS.Create("1.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), new Template_Field'( Mode => Static, Position => (10, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (10, 4), Label => SS.Create("2.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), new Template_Field'( Mode => Static, Position => (11, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (11, 4), Label => SS.Create("3.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), new Template_Field'( Mode => Static, Position => (12, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (12, 4), Label => SS.Create("4.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), new Template_Field'( Mode => Static, Position => (13, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (13, 4), Label => SS.Create("5.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), new Template_Field'( Mode => Static, Position => (14, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (14, 4), Label => SS.Create("6.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), new Template_Field'( Mode => Static, Position => (15, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (15, 4), Label => SS.Create("7.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), new Template_Field'( Mode => Static, Position => (16, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (16, 4), Label => SS.Create("8.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), new Template_Field'( Mode => Static, Position => (17, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (17, 4), Label => SS.Create("9.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), new Template_Field'( Mode => Static, Position => (18, 1), Label => SS.Create("-- ")), new Template_Field'( Mode => Variable, Position => (18, 4), Label => SS.Create("10.desc"), Length => 77, Help_Line => SS.Create( "Descriptive comments for exception declaration")), -- explicit "null" for elements before the others clause -- because of DEC Ada compiler bug null, others => null))); --------------------------------------------------------------------------- -- Bodies of subprograms global to package Templates --------------------------------------------------------------------------- function Field_Count( --| Returns the number of fields in template Template : Template_Name --| Template containing fields ) return Actual_Field_Range is Count : Actual_Field_Range := 0; begin while (Count < Max_Fields) and then (Template_Info(Template).Fields(Count + 1) /= null) loop Count := Count + 1; end loop; return Count; end Field_Count; --------------------------------------------------------------------------- function Variable_Field_Count( --| Returns the number of variable fields Template : Template_Name --| Template containing fields ) return Variable_Field_Range is Count : Actual_Field_Range := 0; Variable_Count : Variable_Field_Range := 0; begin while (Count < Max_Fields) and then (Template_Info(Template).Fields(Count + 1) /= null) loop if Template_Info(Template).Fields(Count + 1).Mode = Variable then Variable_Count := Variable_Count + 1; end if; Count := Count + 1; end loop; return Variable_Count; end Variable_Field_Count; --------------------------------------------------------------------------- function Variable_Field_Number( --| Returns the variable field number, --| given the actual field number Template : Template_Name; --| Template containing fields Actual_Field_Number : Actual_Field_Number_Range --| actual field number (out of total) ) return Variable_Field_Number_Range is Count : Variable_Field_Range := 0; begin if Actual_Field_Number > Field_Count(Template) then raise No_Such_Field; end if; if Template_Info(Template).Fields(Actual_Field_Number).Mode /= Variable then raise Not_A_Variable_Field; end if; for i in 1 .. Actual_Field_Number loop if Template_Info(Template).Fields(i).Mode = Variable then Count := Count + 1; end if; end loop; return Count; end Variable_Field_Number; --------------------------------------------------------------------------- function Variable_Field_Number( --| Returns the variable field number, --| given the field name Template : Template_Name; --| Template containing fields Field_Name : SS.Screen_String --| name of the field ) return Variable_Field_Number_Range is Count : Actual_Field_Range := 0; Variable_Count : Variable_Field_Range := 0; begin while (Count < Max_Fields) and then (Template_Info(Template).Fields(Count + 1) /= null) loop if Template_Info(Template).Fields(Count + 1).Mode = Variable then Variable_Count := Variable_Count + 1; if SS.Equal( Template_Info(Template).Fields(Count + 1).Label, Field_Name) then return Variable_Count; end if; end if; Count := Count + 1; end loop; raise No_Such_Field; end Variable_Field_Number; --------------------------------------------------------------------------- function Actual_Field_Number( --| Returns the actual field number, --| given the variable field number Template : Template_Name; --| Template containing fields Variable_Field_Number : Variable_Field_Number_Range ) return Actual_Field_Number_Range is Count_Total : Actual_Field_Range := 0; Count_Var : Variable_Field_Range := 0; begin while Count_Var < Variable_Field_Number loop if Count_Total = Actual_Field_Number_Range'Last then raise No_Such_Field; end if; Count_Total := Count_Total + 1; if (Template_Info(Template).Fields(Count_Total) = null) then raise No_Such_Field; end if; if Template_Info(Template).Fields(Count_Total).Mode = Variable then Count_Var := Count_Var + 1; end if; end loop; return Count_Total; end Actual_Field_Number; --------------------------------------------------------------------------- function Actual_Field_Number( --| Returns the actual field number, --| given the field name Template : Template_Name; --| Template containing fields Field_Name : SS.Screen_String --| name of the field ) return Actual_Field_Number_Range is Count : Actual_Field_Range := 0; begin while (Count < Max_Fields) and then (Template_Info(Template).Fields(Count + 1) /= null) loop Count := Count + 1; if SS.Equal( Template_Info(Template).Fields(Count).Label, Field_Name) then return Count; end if; end loop; raise No_Such_Field; end Actual_Field_Number; --------------------------------------------------------------------------- function First_Variable_Field_Number( --| Returns the variable field --| number of the first field on --| a line Template : Template_Name; --| Template containing field Line : Positive --| Line within template ) return Variable_Field_Number_Range is Last_Field : Actual_Field_Range := Field_Count(Template); Count : Actual_Field_Number_Range := 1; Variable_Count : Variable_Field_Range := 0; Variable_Found : Boolean := False; begin if Line > Field_Position(Template, Last_Field).Line then raise No_Such_Line; end if; -- loop through template descriptor, counting variable fields -- until the requested line is found while Field_Position(Template, Count).Line < Line loop if Template_Info(Template).Fields(Count).Mode = Variable then Variable_Count := Variable_Count + 1; end if; Count := Count + 1; end loop; -- loop until first variable field is found while not Variable_Found and then (Count <= Last_Field) and then (Field_Position(Template, Count).Line = Line) loop if Template_Info(Template).Fields(Count).Mode = Variable then Variable_Found := True; end if; if Count < Last_Field then Count := Count + 1; end if; end loop; if not Variable_Found then raise No_Variable_Field_On_Line; end if; return Variable_Count + 1; end First_Variable_Field_Number; --------------------------------------------------------------------------- function Template_Label( --| Returns the label of a template Template : Template_Name --| Template from which to get label ) return SS.Screen_String is begin return Template_Info(Template).Label; end Template_Label; --------------------------------------------------------------------------- function Field_Mode( --| Returns the mode of a field Template : Template_Name; --| Template containing field Field_Number : Actual_Field_Number_Range --| Field whose mode to return ) return Field_Mode_Name is Field_Handle : Template_Field_Handle; begin Field_Handle := Template_Info(Template).Fields(Field_Number); if Field_Handle = null then raise No_Such_Field; end if; return Field_Handle.Mode; end Field_Mode; --------------------------------------------------------------------------- function Field_Position( --| Returns the position of a field Template : Template_Name; --| Template containing field Field_Number : Actual_Field_Number_Range --| Field whose position to return ) return Position_Descriptor is Field_Handle : Template_Field_Handle; begin Field_Handle := Template_Info(Template).Fields(Field_Number); if Field_Handle = null then raise No_Such_Field; end if; return Field_Handle.Position; end Field_Position; --------------------------------------------------------------------------- function Field_Label( --| Returns the label of a field Template : Template_Name; --| Template containing field Field_Number : Actual_Field_Number_Range --| Field whose label to return ) return SS.Screen_String is Field_Handle : Template_Field_Handle; begin Field_Handle := Template_Info(Template).Fields(Field_Number); if Field_Handle = null then raise No_Such_Field; end if; return Field_Handle.Label; end Field_Label; --------------------------------------------------------------------------- function Field_Length( --| Returns the length of a field Template : Template_Name; --| Template containing field Field_Number : Actual_Field_Number_Range --| Field whose length to return ) return Positive is Field_Handle : Template_Field_Handle; begin Field_Handle := Template_Info(Template).Fields(Field_Number); if Field_Handle = null then raise No_Such_Field; end if; if Field_Handle.Mode = Variable then return Field_Handle.Length; end if; return SS.Length(Field_Handle.Label); end Field_Length; --------------------------------------------------------------------------- function Field_Help( --| Returns help line for a field Template : Template_Name; --| Template containing field Field_Number : Variable_Field_Number_Range --| Field whose help to return ) return SS.Screen_String is Field_Handle : Template_Field_Handle; Count_Total : Actual_Field_Range := 0; Count_Var : Variable_Field_Range := 0; begin while Count_Var < Field_Number loop if Count_Total = Actual_Field_Number_Range'Last then raise No_Such_Field; end if; Count_Total := Count_Total + 1; if (Template_Info(Template).Fields(Count_Total) = null) then raise No_Such_Field; end if; if Template_Info(Template).Fields(Count_Total).Mode = Variable then Count_Var := Count_Var + 1; end if; end loop; Field_Handle := Template_Info(Template).Fields(Count_Total); return Field_Handle.Help_Line; end Field_Help; --------------------------------------------------------------------------- end Templates; ------------------------------------------------------------------------------- --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: --UDRIVER.ADA --:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: with Text_IO; use Text_IO; with Update; with Dictionary_Manager; with Standard_Interface; with DD_Release; with String_Pkg; with Host_Lib; ------------------------------------------------------------------------------- function Update_Dictionary_Driver return Integer is --| Interprets command line and calls Update_Dictionary routine package DM renames Dictionary_Manager; package SI renames Standard_Interface; package SP renames String_Pkg; package Str_Argument is new SI.String_Argument("String"); Update_Handle : SI.Process_Handle; begin -- Error messages go to standard error Host_Lib.Set_Error; SI.Set_Tool_Identifier(DD_Release); SI.Define_Process( Name => "Update_Dictionary", Help => "Update data dictionary", Proc => Update_Handle); Str_Argument.Define_Argument( Proc => Update_Handle, Name => "Dictionary", Help => "Full directory name of dictionary to be updated"); Str_Argument.Define_Argument( Proc => Update_Handle, Name => "Command_File", Help => "Command file containing update directives"); SI.Parse_Line(Update_Handle); Update.Process_Update_Commands( SP.Value(Str_Argument.Get_Argument( Proc => Update_Handle, Name => "Dictionary")), SP.Value(Str_Argument.Get_Argument( Proc => Update_Handle, Name => "Command_File"))); return Host_Lib.Return_Code(Host_Lib.Success); exception when SI.Abort_Process => return Host_Lib.Return_Code(Host_Lib.Error); when SI.Process_Help => return Host_Lib.Return_Code(Host_Lib.Information); when Update.Abort_Update => return Host_Lib.Return_Code(Host_Lib.Error); when DM.Invalid_Dictionary_File => return Host_Lib.Return_Code(Host_Lib.Error); when DM.Dictionary_Locked => Put_Line("Dictionary is locked by another user."); return Host_Lib.Return_Code(Host_Lib.Error); when DM.Lock_is_Missing => Put_Line("Lock file for dictionary is missing."); return Host_Lib.Return_Code(Host_Lib.Error); when DM.Index_File_Error => return Host_Lib.Return_Code(Host_Lib.Error); when DM.Data_File_Error => return Host_Lib.Return_Code(Host_Lib.Error); when others => Put_Line("Update_Dictionary internal error."); begin DM.Close_Dictionary; exception when others => null; end; return Host_Lib.Return_Code(Host_Lib.Error); end Update_Dictionary_Driver;