MODULE READ_RALLY IDENT 'V2.5.2'; CONSTANT version_number = '2.5.2'; !++ ! ! ABSTRACT: ! ! Read a RALLY REPORT file (/DETAIL_LEVEL=FULL) and output the menus, ! external links, action_lists, tasks and forms. ! ! AUTHORS: ! ! Stew Stryker ! ! CREATION DATE: 12-DEC-1989 ! ! MODIFICATION HISTORY: ! 1/25/90 - Stew - Added support for form/reports and tasks - V1.5 ! 3/29/90 - Stew - Expanded input buffer further and fixed form_end - V1.8 ! 3/29/90 - Stew - Added support for indexes - V2.0 ! 4/3/90 - Stew - Added support for form/report packets - V2.1 ! 6/7/90 - Stew - Remove EOL requirement - V2.2.1 ! 8/21/90 - Stew - Finally add DSD support - V2.3 ! 8/24/90 - Stew - Check for existance of input file ! 8/29/90 - Stew - Add support for parameter packets and ADL - V2.4 ! 8/31/90 - Stew - Index calls from ADL procedures - V2.5 ! !-- ! Sets SET alpha ( 'a'..'z' OR 'A'..'Z' ); SET digit ( '0'..'9' ); ! Tokens ! DSD Tokens TOKEN semicolon ALIAS ';' { ';' }; TOKEN dsd_key { 'DSD ' }; TOKEN date CASELESS { digit [digit] '-' alpha alpha alpha '-' digit digit [digit digit] }; TOKEN rec_manip_key { 'Record manipulation options:' }; TOKEN equal ALIAS '=' { '=' }; TOKEN greater_equal { '>=' }; TOKEN less_equal { '<=' }; TOKEN less { '<' }; TOKEN greater { '>' }; TOKEN not_equal { '<>' }; TOKEN starts_with { 'STARTS_WITH' }; TOKEN missing { 'MISSING' }; TOKEN contains { 'CONTAINS' }; TOKEN matches { 'MATCHES' }; TOKEN dsd_based { 'This DSD is based on' }; TOKEN db_type_rdb { 'Rdb/VMS' }; TOKEN db_type_RMS { 'RMS' }; ! Check these TOKEN db_type_DTR { 'DATATRIEVE' }; ! Check these TOKEN db_file_key { 'The database file name: ' }; TOKEN source_key { 'The source statement:' }; TOKEN num_records_key { 'Records' }; TOKEN dsd_from_key { 'From' }; TOKEN dsd_which { 'Which Is' }; TOKEN dsd_such { 'Such That' }; TOKEN dsd_no_rest { 'There Are No Restrictions' }; TOKEN dsd_using { 'Using Only' }; TOKEN dsd_reduced { 'Reduced To' }; TOKEN dsd_sorted { 'Sorted By' }; TOKEN dsd_sort_desc { 'Descending' }; TOKEN dsd_sort_asc { 'Ascending' }; TOKEN dsd_relation { 'Relation' }; TOKEN dsd_reserved { 'reserved for' }; TOKEN dsd_reserved_key { 'Relation reserve list:' }; TOKEN read_key { 'READ' }; TOKEN write_key { 'WRITE' }; TOKEN shared_key { 'SHARED' }; TOKEN protected_key { 'PROTECTED' }; TOKEN exclusive_key { 'EXCLUSIVE' }; TOKEN only_key { 'ONLY' }; TOKEN cross { 'Cross' }; TOKEN not_key { 'Not' }; TOKEN and_key { 'And' }; TOKEN or_key { 'Or' }; TOKEN wait_locked { 'Wait if locked:' }; ! DSD field tokens TOKEN dsd_field_key { 'DSD Field' }; TOKEN field_valid { 'Validation/input options:' }; TOKEN field_valid_optn { 'Required field' | 'Must fill field' | 'Modifiable only when inserting new record' }; TOKEN field_int_type { 'Internal data type:' }; TOKEN field_init { 'Initial value is' }; TOKEN field_null { 'Null value:' }; TOKEN field_out_form { 'Output format:' }; TOKEN field_in_form { 'Input format:' }; TOKEN field_min { 'Minimum value:' }; TOKEN field_max { 'Maximum value:' }; TOKEN field_local { 'The local field name:' }; TOKEN field_int_size { 'Maximum size:' }; TOKEN field_ext_scale { 'Scale:' }; TOKEN field_relation { 'Rdb relation name:' }; TOKEN oparen ALIAS '(' { '(' }; TOKEN cparen ALIAS ')' { ')' }; TOKEN option_key { 'Options:' }; TOKEN legend_number { 'Legend number:' }; TOKEN before_fr_key { 'Before form/report' }; TOKEN after_fr_key { 'After form/report' }; TOKEN before_qry_key { 'Before query' }; TOKEN after_qry_key { 'After query' }; TOKEN before_com_key { 'Before commit' }; TOKEN after_com_key { 'After commit' }; TOKEN before_roll_key { 'Before rollback' }; TOKEN after_roll_key { 'After rollback' }; TOKEN loc_fun_key { 'Local function' }; TOKEN pkt_form_key { 'Form/report:' }; TOKEN pkt_mode_key { 'Initial mode:' }; TOKEN form_field_key { 'Form/Report Field' }; TOKEN global_var_key { 'Global Variable' }; TOKEN adl_export_key { 'ADL Export Field' }; TOKEN field_type_key { 'Type of field:' }; TOKEN computed_by_key { 'Computed by:' }; TOKEN copy_field_key { 'Copy field is' }; TOKEN form_group_key { 'Form/Report Group' }; TOKEN form_key { 'Form/Report ' }; TOKEN field_options_key { 'Field options:' }; TOKEN main_group_type_key { 'Type of group: MAIN' }; TOKEN group_type_key { 'Type of group:' }; TOKEN form_structure_key { 'FORM/REPORT Structure:' }; TOKEN period ALIAS '.' { '.' }; TOKEN quote ALIAS '''' { '''' }; TOKEN agg_field_key { 'Field 1 is' }; TOKEN data_field_key { 'DSD field' }; ! within f/r description TOKEN dsd_name_start_key { 'DSD:' }; TOKEN dsd_name_stop_key { '- DSD' }; TOKEN space IGNORE { { ' ' | s'ht' }... | s'vt' | s'eol' }; TOKEN menu_choice_key { 'Choice ' digit [digit]... }; TOKEN choice_key { 'choice' }; TOKEN appl_key { 'Report of Application File' }; TOKEN task_key { 'Task ' }; TOKEN task_stop_key { 'Task window:' }; TOKEN task_action_key { 'Initial action:' }; TOKEN action_list_key { 'Action List ' }; TOKEN action_stop_key { 'This action list performs' }; TOKEN action_key { 'Action' }; TOKEN action_item_key2 { 'will' }; TOKEN menu_key { 'Menu ' }; TOKEN menu_stop_key { 'Menu area:' }; TOKEN pkt_key { 'Form/Report Packet ' }; TOKEN menu_choice_legend_key { 'Menu Choice Legend' }; TOKEN adl_key { 'ADL ' }; TOKEN action_types { 'CALL' | 'EXECUTE' | 'RETURN_TO' | 'FORK' | 'START' | 'RESUME' | 'CALL_CMD' | 'EXECUTE_CMD' }; TOKEN comment_start_key { 'Comment:' }; TOKEN menu_display_start_key { 'Menu text:' }; TOKEN cursor_position { 'Cursor position:' }; TOKEN help_number { 'Help number:' }; TOKEN dash { '- ' }; CONSTANT spaces = ' '; TOKEN number { digit... }; TOKEN bracket { '[' | ']' }; TOKEN colon_prefix { ': ' }; TOKEN colon ALIAS ':' { ':' }; TOKEN eof { s'eos' }; TOKEN comma ALIAS ',' { ',' }; TOKEN link_key { 'External Program Link ' }; TOKEN link_image_key { 'Name of shareable image:' }; TOKEN link_routine_key { 'Name of routine:' }; TOKEN parameter_number_key { 'Parameter number:' }; TOKEN parameter_type_key { 'Parameter type:' }; TOKEN link_field_name_key { 'Field name:' }; TOKEN external_data_type { 'External data type: ' }; TOKEN link_length_key { 'External maximum length: ' }; TOKEN appl_report_stop_key { 'Report Index' }; ! ADL Tokens TOKEN ADL_procedure_text { 'The text for this procedure is:' }; CONSTANT ADL_end_procedure_text = ' '&s'eol'&s'eol'&s'eol'; ! New Tokens ! Parameter Packet Tokens TOKEN parameter_pkt_key { 'Parameter Packet ' }; TOKEN num_of_params_key { 'Number of parameters: ' digit [digit]... }; TOKEN ppkt_parameter_key { 'Parameter ' digit [digit]... ':' }; ! Last Tokens TOKEN identifier { alpha [ alpha | digit | '_' | '$']... }; ! Groups and variables ! New Groups GROUP db_access ( read_key or write_key or only_key or shared_key or protected_key or exclusive_key ); GROUP rel_op ( equal OR not_equal OR greater OR less OR greater_equal OR less_equal OR starts_with OR contains OR matches ); GROUP dsd_sort_grp ( dsd_sort_desc OR dsd_sort_asc ); GROUP db_types ( db_type_rdb OR db_type_RMS OR db_type_DTR ); GROUP and_or ( and_key OR or_key ); GROUP word ( identifier OR number ); GROUP menu_object_grp ( menu_key OR pkt_key OR form_key OR adl_key OR link_key OR action_list_key OR parameter_pkt_key OR task_key); GROUP action_site_grp ( before_fr_key OR after_fr_key OR before_qry_key OR after_qry_key OR before_com_key OR after_com_key OR before_roll_key OR after_roll_key OR loc_fun_key ); GROUP link_param_type_grp ( form_field_key OR global_var_key OR adl_export_key); ! New Variables DECLARE dsd_name_gbl : DYNAMIC STRING; ! Old Variables DECLARE link_found, link_parameter_found, packet_found, dsd_found, adl_found, ppkt_found : GLOBAL BOOLEAN; DECLARE para_num_gbl : GLOBAL INTEGER; DECLARE para_type_gbl, para_name_gbl, task_name_gbl, comment_gbl : GLOBAL DYNAMIC STRING; DECLARE object_level : INTEGER; DECLARE menu_found, output_all_text, menu_display_found, action_found, action_items_found, choice_found, task_found: GLOBAL BOOLEAN; DECLARE call_type_gbl, choice_gbl, object_type_gbl, menu_name_gbl, link_name_gbl : GLOBAL DYNAMIC STRING; DECLARE outfile : GLOBAL FILE; DECLARE menu_display_block, appl_name_gbl, infile_name, outfile_name : GLOBAL DYNAMIC STRING; DECLARE text_lines : GLOBAL TREE (INTEGER) OF DYNAMIC STRING; DECLARE form_name_gbl, field_name_gbl, group_name_gbl : GLOBAL DYNAMIC STRING; DECLARE num_form_elements_gbl : GLOBAL INTEGER; DECLARE form_found : GLOBAL BOOLEAN; TYPE form_group_rec : RECORD DSD_name : VARYING STRING (50), group_type : VARYING STRING (12), comment : VARYING STRING (512), END RECORD; DECLARE form_groups : GLOBAL TREE (STRING) OF form_group_rec; TYPE form_element_rec : RECORD level : INTEGER, element : VARYING STRING (50), END RECORD; DECLARE form_elements : GLOBAL TREE (INTEGER) OF form_element_rec; TYPE field_rec : RECORD element_type : VARYING STRING (12), element_value : VARYING STRING (50), END RECORD; DECLARE fields : GLOBAL TREE (STRING) OF field_rec; CONSTANT left_margin GLOBAL = 6; ! # of spaces CONSTANT top_margin GLOBAL = 6; ! # of lines CONSTANT call_executecmd_list = 'CALL_CMD\EXECUTE_CMD\' ; CONSTANT object_types_list = '- Form/Report Packet\- Parameter Packet\'& '- Action List\- Menu\- ADL\'& '- External Program Link'; ! Procedures ! index_adl - external procedure external procedure index_adl( string, string ); ! Get calls from ADLs !+ ! Define VMS Run-Time-Library functions to be external so ! that they can be used. These procedures search for certain ! wildcard file specifications and returns all file specifications ! that satisfy that wild card specification. !- EXTERNAL PROCEDURE lib$find_file ( STRING, STRING, INTEGER ) OF INTEGER; EXTERNAL PROCEDURE lib$find_file_end ( INTEGER ) OF INTEGER; ! get_filespecs - Get user input for the input and output file names PROCEDURE get_filespecs; DECLARE filetype_pos, input_file_exists, context : INTEGER; DECLARE full_file_name : DYNAMIC STRING; input_file_exists = 0; ! Display heading WRITE 'READ_RALLY V', version_number, ' by Stew Stryker'; WRITE; WRITE; WRITE 'This program will scan a RALLY application REPORT and generate'; WRITE 'a descriptive file for processing via VAX DOCUMENT'; WRITE ''; WRITE 'Default file type is ".DMP"'; ! Get filespec until input file found WHILE input_file_exists <> 1; READ PROMPT ('Enter input filename (e.g. DBQ.DMP): ') infile_name; ! Generate output filespec filetype_pos = INDEX( infile_name, '.' ); IF filetype_pos > 0 THEN outfile_name = UPPER( infile_name[1 .. filetype_pos - 1] & '.SDML'); ELSE outfile_name = UPPER( infile_name & '.SDML' ); infile_name = UPPER ( infile_name & '.DMP' ); END IF; input_file_exists = (lib$find_file ( infile_name, full_file_name, context ) AND 1); IF input_file_exists <> 1 THEN WRITE 'File ', infile_name, ' not found!'; WRITE 'Please try again.'; WRITE; END IF; END WHILE; ! Tell user output filespec WRITE ''; WRITE 'The output file will be: ', outfile_name; WRITE ''; WRITE ''; !+ ! Deallocate any saved Record Management Service (RMS) context ! and deallocate the virtual memory used to hold the allocated ! context block. !- IF (lib$find_file_end ( context ) AND 1) <> 1 THEN WRITE 'Error freeing the find_file context.'; END IF; END PROCEDURE /* get_filespecs */; ! trim_all - Trim cr's and spaces from input string PROCEDURE trim_all ( instring : DYNAMIC STRING ) OF DYNAMIC STRING; DECLARE filter, outstring : DYNAMIC STRING; filter = s'eol' & s'lf' & s'ht' & s'nel' & ' '; outstring= TRIM( instring, filter ); RETURN outstring; END PROCEDURE /* trim_all */; ! break_block - separate into component lines of comment PROCEDURE break_block ( text_block : STRING ) OF INTEGER; ! Given a block of text, break into component lines, w/o CRs ! Just like break_display, only lines are trimmed DECLARE cr_pos, block_length, i, num_lines : AUTOMATIC INTEGER; num_lines = 0; block_length = LENGTH( text_block ); cr_pos = INDEX(text_block, s'eol'); WHILE (block_length > 0) AND (cr_pos > 0); cr_pos = INDEX(text_block, s'eol'); block_length = LENGTH( text_block ); IF cr_pos > 0 THEN IF block_length > cr_pos THEN num_lines = num_lines + 1; text_lines(num_lines) = TRIM( text_block[1 .. cr_pos - 1]); text_block = text_block [cr_pos + 1 .. LENGTH( text_block)]; ELSE num_lines = num_lines + 1; text_lines(num_lines) = text_block[1 .. cr_pos - 1]; cr_pos = 0; ! Set so loop fails END IF; END IF; END WHILE; RETURN num_lines; END PROCEDURE /* break_block */; ! break_display - separate into component lines of space-dependent text PROCEDURE break_display ( input_block : STRING ) OF INTEGER; DECLARE cr_pos, block_length, i, num_lines, last_non_blank_line : AUTOMATIC INTEGER; DECLARE text_block : DYNAMIC STRING; num_lines = 0; text_block = input_block; block_length = LENGTH( text_block ); cr_pos = INDEX(text_block, s'eol'); WHILE (block_length > 0) AND (cr_pos > 0); cr_pos = INDEX(text_block, s'eol'); block_length = LENGTH( text_block ); IF cr_pos > 0 THEN IF block_length > cr_pos THEN num_lines = num_lines + 1; ! Don't trim line, because you lose the leading spaces. text_lines(num_lines) = text_block[1 .. cr_pos - 1]; text_block = text_block [cr_pos + 1 .. LENGTH( text_block)]; ELSE num_lines = num_lines + 1; text_lines(num_lines) = text_block[1 .. cr_pos - 1]; cr_pos = 0; ! Set so loop fails END IF; ! Only save lines until last non-blank line IF TRIM( text_lines(num_lines) ) > '' THEN last_non_blank_line = num_lines; END IF; END IF; END WHILE; RETURN last_non_blank_line; END PROCEDURE /* break_display */; ! break_form_block - load structure block into form_elements array PROCEDURE break_form_block ( text_block : STRING ) OF INTEGER; ! This procedure is based on break_block, except that it loads lines into ! form_elements array, and determines what the field's indentation level is ! ! Given a block of text, break into component lines, w/o CRs DECLARE element_line : DYNAMIC STRING; DECLARE cr_pos, ff_pos, i, num_lines, level : AUTOMATIC INTEGER; PROCEDURE get_indent ( input_line : DESCRIPTOR DYNAMIC STRING ) OF INTEGER; ! return the level of identation of the given line ! first subtract the left_margin, then divide by 2 ! because each level is indented 2 spaces; DECLARE line_indent : INTEGER; line_indent = (LENGTH( element_line ) - LENGTH(TRIM(element_line)) - left_margin)/2 + 1; RETURN line_indent; END PROCEDURE /* get_indent */; num_lines = 0; cr_pos = INDEX(text_block, s'eol'); WHILE (LENGTH( text_block ) > 1) AND (cr_pos > 0); cr_pos = INDEX(text_block, s'eol'); IF cr_pos > 0 THEN element_line = text_block[1 .. cr_pos - 1]; IF TRIM(element_line) > '' ! Collect only non-blank lines THEN num_lines = num_lines + 1; ! element indentation level shows group level form_elements(num_lines).level = get_indent(element_line); form_elements(num_lines).element = TRIM(element_line); END IF; text_block = text_block [cr_pos + 1 .. LENGTH( text_block)]; END IF; END WHILE; RETURN num_lines; END PROCEDURE /* break_form_block */; ! write_form_chapter - write out header for form chapter PROCEDURE write_form_chapter; WRITE FILE (outfile); WRITE FILE (outfile); WRITE FILE (outfile) '(Form/Reports)'; WRITE FILE (outfile); WRITE FILE (outfile) '

This chapter describes the forms and ', 'report, along with their groups.'; WRITE FILE (outfile); END PROCEDURE /* write_form_chapter */; ! group_fields_exist - check to see if the group has any fields PROCEDURE group_fields_exist (group_name : DYNAMIC STRING) OF BOOLEAN; !++ ! Loop through fields in group ! If you find any fields, return TRUE ! Else, return FALSE !-- ! Declare and initialize local variables DECLARE target_level, current_level, element_count : INTEGER; DECLARE current_element, current_value, group_type : DYNAMIC STRING; IF group_name = 'MAIN' THEN target_level = 1; ELSE target_level = 999; ! Set to max so test fails until group found END IF; element_count = 1; ! Procedure loop WHILE (element_count <= num_form_elements_gbl) AND (form_elements(element_count).level <= target_level); current_element = TRIM(form_elements(element_count).element); IF current_element = group_name ! set target to current level THEN target_level = form_elements(element_count).level + 1; END IF; IF EXISTS( fields(current_element) ) AND (target_level = form_elements(element_count).level) THEN RETURN TRUE; END IF; element_count = element_count + 1; END WHILE; ! looping through group elements ! Return FALSE if not found RETURN FALSE; END PROCEDURE /* group_fields_exist */; ! print_comment - Print out contents of a comment, if available PROCEDURE print_comment ( comment_string : DYNAMIC STRING ); DECLARE num_comment_lines, line_count : INTEGER; IF comment_string > '' THEN num_comment_lines = break_block(comment_string); WRITE FILE (outfile) '

'; FOR line_count = 1 TO num_comment_lines; WRITE FILE (outfile) text_lines(line_count); END FOR; WRITE FILE (outfile); END IF; END PROCEDURE /* print_comment */; ! write_group - write out group's field table PROCEDURE write_group ( group_name : DYNAMIC STRING ); ! Declare and initialize local variables DECLARE target_level, element_count : INTEGER; DECLARE current_element, current_value, group_type : DYNAMIC STRING; target_level = 0; element_count = 1; if EXISTS( form_groups(group_name) ) THEN group_type = TRIM(form_groups(group_name).group_type); ELSE RETURN; ! There are no groups or fields in this form END IF; ! Test if there are fields to write out in a table IF group_fields_exist(group_name) THEN ! Write out table header IF UPPER(group_name) = 'MAIN' THEN WRITE FILE (outfile); WRITE FILE (outfile) '(Main group)'; ELSE ! This is a data or format group ! Write the table header with the DSD IF group_type = 'DATA SOURCE' AND TRIM(form_groups(group_name).DSD_name) > '' THEN WRITE FILE (outfile); WRITE FILE (outfile) '
(', group_name, ' --- DSD: ', TRIM(form_groups(group_name).DSD_name), ')'; WRITE FILE (outfile) '(DSDs', TRIM(form_groups(group_name).DSD_name), ')'; WRITE FILE (outfile) '(', TRIM(form_groups(group_name).DSD_name), ')'; ELSE WRITE FILE (outfile) '
(', group_name, ' --- ', TRIM(group_type), ')'; END IF; END IF; ! Write out common table attributes WRITE FILE (outfile) '(WIDE)'; WRITE FILE (outfile) '(3\28\8)'; WRITE FILE (outfile) '(Field\Type\Calculated From)'; ! Find the group's position in the form structure IF group_name = 'MAIN' ! If the Main group THEN ! set the value to the first element in the first group target_level = 1; ELSE ! loop until you find the group or run out of elements WHILE (element_count <= num_form_elements_gbl) AND (target_level = 0); IF TRIM(form_elements(element_count).element) = group_name THEN target_level = form_elements(element_count).level + 1; ! Start at next element element_count = element_count + 1; ELSE element_count = element_count + 1; END IF; END WHILE; END IF; ! For all fields in that group - write out the field definition WHILE (element_count <= num_form_elements_gbl) AND (form_elements(element_count).level = target_level); current_element = TRIM(form_elements(element_count).element); IF EXISTS( fields(current_element) ) THEN current_value = TRIM(fields(current_element).element_value); WRITE FILE (outfile) '(', current_element, '\', TRIM(fields(current_element).element_type), '\', current_value, ')'; END IF; element_count = element_count + 1; END WHILE; ! Write the table footer WRITE FILE (outfile) ''; WRITE FILE (outfile); END IF; END PROCEDURE /* write_group */; ! write_form - write out top level form structure and comments PROCEDURE write_form; ! Write out form contents DECLARE element_count, current_level, num_comment_lines, line_count : AUTOMATIC INTEGER; DECLARE group_ptr : AUTOMATIC TREEPTR(STRING) TO form_group_rec; DECLARE current_element, current_comment : DYNAMIC STRING; WRITE FILE (outfile) '(', form_name_gbl, ')'; WRITE FILE (outfile) '(Form/Reports', form_name_gbl, '\BEGIN\BOLD)'; WRITE FILE (outfile) '(', form_name_gbl, '\BEGIN\BOLD)'; ! Display form comment, if it exists IF EXISTS( form_groups('MAIN') ) THEN current_comment = form_groups('MAIN').comment; CALL print_comment( current_comment ); END IF; ! Start displaying group overview WRITE FILE (outfile) '

(Groups:\BOLD)'; WRITE FILE (outfile) '(INDENT\1)(Main group\BOLD)'; ! Run through the elements, display group's attributes FOR element_count = 1 TO num_form_elements_gbl; current_element = TRIM(form_elements(element_count).element); current_level = form_elements(element_count).level; IF EXISTS( form_groups(current_element) ) THEN WRITE FILE (outfile) spaces[1 .. current_level], '(INDENT\', current_level + 1, ')(', current_element, '\BOLD) --- Type: ', form_groups(current_element).group_type; ! Write out comment, if any IF LENGTH(TRIM( form_groups(current_element).comment)) > 1 THEN current_comment = TRIM(form_groups(current_element).comment); num_comment_lines = break_block(current_comment); FOR line_count = 1 TO num_comment_lines; IF LENGTH( text_lines(line_count) ) > 0 THEN WRITE FILE (outfile) spaces[1 .. current_level + 1], '(INDENT\', current_level + 2, ')', text_lines(line_count); END IF; END FOR; WRITE FILE (outfile); END IF; ! Write out associated DSD, if any IF TRIM(form_groups(current_element).group_type) = 'DATA SOURCE' AND TRIM(form_groups(current_element).DSD_name) > '' THEN WRITE FILE (outfile) spaces[1 .. current_level + 1], '(INDENT\', current_level + 2, ') --- DSD: ', form_groups(current_element).DSD_name; END IF; END IF; END FOR; ! In order by form structure, print group tables CALL write_group('MAIN'); ! First, do the main group FOR element_count = 1 TO num_form_elements_gbl; current_element = TRIM(form_elements(element_count).element); IF EXISTS( form_groups(current_element) ) ! This is group THEN CALL write_group(current_element); END IF; END FOR; ! Mark end of report WRITE FILE (outfile) '(Form/Reports', form_name_gbl, '\END\BOLD)'; WRITE FILE (outfile) '(', form_name_gbl, '\END\BOLD)'; WRITE FILE (outfile); WRITE FILE (outfile); PRUNE form_groups, text_lines, fields,form_elements; END PROCEDURE /* write_form */; ! extract_comment - Extract everything after search string from comment PROCEDURE extract_comment ( instring : DYNAMIC STRING, locatestring : DYNAMIC STRING ) OF DYNAMIC STRING; DECLARE string_pos : INTEGER; DECLARE returnstring : DYNAMIC STRING; string_pos = INDEX( instring, locatestring ); IF string_pos > 0 THEN returnstring = instring[string_pos .. LENGTH( instring )]; instring = instring[1 .. string_pos-1]; RETURN returnstring; ELSE RETURN ''; END IF; END PROCEDURE /* extract_comment */; ! build_string - Build a string from a given tree (used by DSD components) PROCEDURE build_string ( intree : TREE (INTEGER) OF DYNAMIC STRING ) OF DYNAMIC STRING; DECLARE field_ptr : TREEPTR(INTEGER) TO DYNAMIC STRING; DECLARE outstring : DYNAMIC STRING; field_ptr = FIRST( intree ); WHILE field_ptr <> NIL; outstring = outstring & TRIM( VALUE( field_ptr ), s'enq'&' ' ); field_ptr = NEXT( field_ptr ); IF field_ptr <> NIL ! There are more elements THEN outstring = outstring & ', ' & s'eol'; END IF; END WHILE; outstring = outstring & '.'; RETURN outstring; END PROCEDURE /* build_string */; ! Macros ! filespec - Get all elements of a filespec MACRO filespec SYNTAX { full_spec: { [nodename] [disk] [directory] filename: identifier [filetype: '.' identifier] } }; ! nodename - parse out node name MACRO nodename SYNTAX { name: {identifier ':' ':'} }; ANSWER name; END MACRO /* nodename */; ! disk - parse out disk name MACRO disk SYNTAX { name: {identifier ':'} }; ANSWER name; END MACRO /* disk */; ! directory - parse out directory name MACRO directory SYNTAX { name: {bracket identifier ['.' identifier]... bracket} }; ANSWER name; END MACRO /* directory */; ANSWER full_spec; END MACRO /* filespec */; ! application_name MACRO application_name TRIGGER { appl_key loc_appl_name_gbl : filespec}; appl_name_gbl = loc_appl_name_gbl; END MACRO /* application_name */; ! menu_objects - identify all objects callable objects MACRO menu_objects SYNTAX { dash object_name: menu_object_grp }; ANSWER object_name; END MACRO /* menu_objects */; ! menu_choice_types - Identifies type of menu choices MACRO menu_choice_types SYNTAX { dash choice_type: identifier choice_key colon_prefix }; ANSWER choice_type; END MACRO /* menu_choice_types */; ! menu - Find each menu header MACRO menu TRIGGER { menu_key menu_name: identifier comment_block: [comment_section] menu_stop_key }; DECLARE line_num, num_lines : INTEGER; ! comment_section - comment portion of item MACRO comment_section SYNTAX { comment_start_key comment_block_loc: FIND('Menu area:') }; ANSWER comment_block_loc; END MACRO /* comment_section */; ! If they were working on an action list or task, close it IF action_found OR task_found THEN ! Finish the table WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; action_found = FALSE; action_items_found = false; task_found = FALSE; END IF; IF choice_found or menu_found ! They found a menu before THEN ! End the previous menu options table and reset variable WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; choice_found = false; ELSE ! This is the first menu WRITE 'Processing menus...'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '(Menus)'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '

'; WRITE FILE (outfile) 'This describes the menus in the ', appl_name_gbl, ' application, which are listed '; WRITE FILE (outfile) 'alphabetically.'; WRITE FILE (outfile) ''; END IF; menu_found = true; WRITE FILE (outfile) '(',menu_name,')'; WRITE FILE (outfile) '(Menus', menu_name, '\BOLD)'; WRITE FILE (outfile) '(', menu_name, '\BOLD)'; IF comment_block > '' ! If there was a comment THEN ! Write out menu comment num_lines = break_block( comment_block); ! Break up block into lines WRITE FILE (outfile) '

'; ! Write out all lines to the file FOR line_num = 1 TO num_lines; WRITE FILE( outfile ) text_lines(line_num); END FOR; END IF; menu_name_gbl = menu_name; END MACRO /* menu */; ! menu_choice - Print table row for each menu choice MACRO menu_choice TRIGGER { menu_choice_key colon_prefix call_type: action_types object_name: identifier object_type: {menu_objects | identifier} [ignore_legend_number] [ignore_help_number] menu_choice_id... }; DECLARE menu_choice_gbl : DYNAMIC STRING; ! ignore_legend_number - Placeholder for legend number MACRO ignore_legend_number SYNTAX { legend_number number }; END MACRO /* ignore_legend_number */; ! ignore_help_number - Placeholder MACRO ignore_help_number SYNTAX { help_number number }; END MACRO /* ignore_help_number */; ! menu_choice_id - Save each menu choice's id (e.g. word, letter) MACRO menu_choice_id SYNTAX { menu_choice_type: menu_choice_types menu_choice: {[quote] identifier [quote] | number | quote [identifier] quote } }; IF LENGTH( menu_choice_gbl ) > 0 THEN menu_choice_gbl = menu_choice_gbl & ','; END IF; IF menu_choice_type = 'Function' THEN menu_choice_gbl = menu_choice_gbl & 'Key # ' & trim_all( menu_choice ); ELSE menu_choice_gbl = menu_choice_gbl & trim_all( menu_choice ); END IF; END MACRO /* menu_choice_id */; ! For non-menu_object items, append name and type (e.g. FINISH ACTION) IF INDEX( call_executecmd_list, call_type&'\' ) > 0 THEN object_name = object_name & object_type; object_type = ''; ELSE object_name = object_name; object_type = TRIM(object_type); END IF; ! Print menu action row IF object_type <> '' ! if it's FINISH ACTION, change format THEN WRITE FILE (outfile) '(', menu_choice_gbl, '\', object_name, '\', object_type, '\', call_type, ')'; ! Index entries WRITE FILE (outfile) '(', object_type, 's', object_name, '\( tab))'; WRITE FILE (outfile) '(', object_name, '\( tab))'; ELSE WRITE FILE (outfile) '(', menu_choice_gbl, '\', object_name, ' ', object_type, '\\', call_type, ')'; END IF; menu_choice_gbl = ''; END MACRO /* menu_choice */; ! menu_display MACRO menu_display TRIGGER { menu_display_start_key display_block: FIND('This menu has') }; DECLARE line_num, num_lines : AUTOMATIC INTEGER; num_lines = break_display( display_block); ! Break up into lines WRITE FILE (outfile) ''; WRITE FILE (outfile) '

(Display of menu: ', menu_name_gbl, ')'; WRITE FILE (outfile) '(KEEP)'; WRITE FILE (outfile) '(KEEP)'; ! Write out all lines to the file FOR line_num = 1 TO num_lines; WRITE FILE( outfile ) text_lines(line_num); END FOR; WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; WRITE FILE (outfile) '

'; IF NOT choice_found ! menu choices haven't been found yet THEN WRITE FILE (outfile) '

(', menu_name_gbl, ' menu options)'; WRITE FILE (outfile) '(MULTIPAGE)'; WRITE FILE (outfile) '(4\8\25\15)'; WRITE FILE (outfile) '(Keywords', '\Object\Object Type\','Call Type)'; END IF; choice_found = TRUE; END MACRO /* menu_display */; ! form_packet - Collect and print form/report packet info MACRO form_packet TRIGGER { pkt_key pkt_name: identifier [comment_section] help_number number legend_number number [action_site]... [options] form_and_mode [action_site]... }; ! Local declarations DECLARE comment_block, before_qry_name, after_qry_name, before_com_name, after_com_name, before_roll_name, after_roll_name, loc_fun_name, before_fr_name, after_fr_name, form_name, mode : DYNAMIC STRING; DECLARE element_count, current_level, num_comment_lines, line_count, action_site_count, count : AUTOMATIC INTEGER; DECLARE current_element, current_comment : DYNAMIC STRING; TYPE action_site_rec : RECORD ! (e.g. Before f/r, After commit, etc) site_type : VARYING STRING (25), ! (e.g. CALL, EXECUTE, EXECUTE_CMD) call_type : VARYING STRING (20), ! (e.g. MAIN_MENU) object_name : VARYING STRING (31), ! (e.g. Menu) object_type : VARYING STRING (30), END RECORD; DECLARE pkt_action_sites : TREE (INTEGER) OF action_site_rec; ! comment_section - comment portion of item MACRO comment_section SYNTAX { comment_start_key comment_block_loc: FIND('Help number:') }; comment_block = comment_block_loc; END MACRO /* comment_section */; ! action_site - Store each action site and object in tree MACRO action_site SYNTAX { action_site_type: action_site_grp colon_prefix call_type: action_types object_name: identifier object_type: {menu_objects | identifier} }; ! For non-menu_object items, append name & type IF INDEX( call_executecmd_list, call_type&'\' ) > 0 THEN object_name = object_name & ' ' & object_type; END IF; action_site_count = action_site_count + 1; pkt_action_sites(action_site_count).site_type = action_site_type; pkt_action_sites(action_site_count).call_type = call_type; pkt_action_sites(action_site_count).object_name = object_name; pkt_action_sites(action_site_count).object_type = TRIM(object_type); END MACRO /* action_site */; ! options - form packet options MACRO options SYNTAX { option_key [dash identifier identifier identifier]... }; END MACRO /* options */; ! form_and_mode - required information in a form/packet MACRO form_and_mode SYNTAX { pkt_form_key form_name_loc: called_form pkt_mode_key mode_loc: identifier }; form_name = TRIM(form_name_loc); mode = mode_loc; END MACRO /* form_and_mode */; ! called_form - Save object called by action site MACRO called_form SYNTAX { object: {identifier [identifier] } menu_objects }; ANSWER object; END MACRO /* called_form */; ! Main processing for form_packet macro ! Check for menu and close IF menu_found THEN WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; menu_found = FALSE; END IF; ! Check for packet found before IF NOT packet_found THEN WRITE 'Processing form/report packets...'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '(Form/Report Packets)'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '

'; WRITE FILE (outfile) 'This describes the Form/Report Packets '; WRITE FILE (outfile) 'in this application, which are listed ', 'alphabetically.'; WRITE FILE (outfile) ''; END IF; packet_found = true; ! Write out all sections that are available WRITE FILE (outfile) '(', pkt_name, ')'; ! Packet index entry WRITE FILE (outfile) '(Form/Report Packets', pkt_name, '\BOLD)'; WRITE FILE (outfile) '(', pkt_name, '\BOLD)'; ! Display packet comment, if it exists IF comment_block > '' THEN current_comment = comment_block; CALL print_comment( current_comment ); END IF; ! Main section WRITE FILE (outfile) '

Form/report: (', form_name, '\BOLD) --- ', mode; WRITE FILE (outfile) '(Form/Reports', form_name, ')'; WRITE FILE (outfile) '(', form_name, ')'; ! Write out action sites IF action_site_count > 0 THEN ! Table header WRITE FILE (outfile); WRITE FILE (outfile) '

(', pkt_name, ' action sites)'; WRITE FILE (outfile) '(MULTIPAGE)'; WRITE FILE (outfile) '(4\12\25\15)'; WRITE FILE (outfile) '(Site\Object\Object Type\', 'Call Type)'; FOR count = 1 TO action_site_count; WRITE FILE (outfile) ' (', TRIM(pkt_action_sites(count).site_type), '\', TRIM(pkt_action_sites(count).object_name), '\', TRIM(pkt_action_sites(count).object_type), '\', TRIM(pkt_action_sites(count).call_type), ')'; ! Index entries WRITE FILE (outfile) ' (', TRIM(pkt_action_sites(count).object_type), 's', TRIM(pkt_action_sites(count).object_name), '\( tab))'; WRITE FILE (outfile) ' (', TRIM(pkt_action_sites(count).object_name), '\( tab))'; END FOR; WRITE FILE (outfile) ''; END IF; ! Add extra space WRITE FILE (outfile); WRITE FILE (outfile); PRUNE pkt_action_sites; END MACRO /* form_packet */; ! end_report MACRO end_report TRIGGER EXPOSE { report_end_char,ln_num,col_num : {eof | appl_report_stop_key | { menu_choice_legend_key identifier }} }; ! Test if trigger found within another object IF col_num > 3 THEN FAIL; END IF; ! Check for form/report and close IF form_found THEN CALL write_form; form_found = false; END IF; ! Ext Link Parameter - Check if you have to print an empty parameter row IF link_parameter_found ! external link rather than DSD THEN ! Write out all link parameter values WRITE FILE (outfile) '(', para_num_gbl, '\', para_name_gbl, '\', para_type_gbl, ')'; link_parameter_found = FALSE; END IF; ! Check for external link or menu IF link_found OR menu_found OR dsd_found THEN ! mark the end of external links WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; link_found = FALSE; menu_found = FALSE; dsd_found = FALSE; END IF; ! Check for action list and close IF action_found THEN action_found = FALSE; action_items_found = FALSE; WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; END IF; IF INDEX(report_end_char, s'eos') > 0 THEN ANSWER s'eos'; WRITE 'End of report found.', s'bel', s'bel'; ! Ring bell twice END IF; END MACRO /* end_report */; ! link MACRO link TRIGGER { link_key link_name: identifier [comment_start_key] comment_block: FIND('Type of external program link:') }; DECLARE line_num, num_lines : AUTOMATIC INTEGER; DECLARE current_comment : DYNAMIC STRING; link_name_gbl = link_name; ! First check if you have to print an empty parameter row IF link_parameter_found ! external link rather than DSD THEN ! Write out all link parameter values WRITE FILE (outfile) '(', para_num_gbl, '\', para_name_gbl, '\', para_type_gbl, ')'; link_parameter_found = FALSE; END IF; IF link_found ! previous link THEN WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; WRITE FILE (outfile) '(', link_name, ')'; ELSE link_found = TRUE; WRITE FILE (outfile) '(External Links)'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '

'; WRITE FILE (outfile) 'This section briefly describes the external ', 'links in'; WRITE FILE (outfile) 'this application.'; WRITE FILE (outfile) '

'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '(', link_name, ')'; WRITE 'Processing external links...'; END IF; ! Create index entries WRITE FILE (outfile) '(External Links', link_name, ')'; WRITE FILE (outfile) '(', link_name, '\BOLD)'; IF comment_block > '' THEN ! External link comment current_comment = comment_block; CALL print_comment( current_comment ); END IF; END MACRO /* link */; ! link_image MACRO link_image TRIGGER { link_image_key image_name: identifier }; WRITE FILE (outfile) '

Shareable image name: (', image_name, '\BOLD)'; END MACRO /* link_image */; ! link_routine MACRO link_routine TRIGGER { link_routine_key routine_name: identifier}; WRITE FILE (outfile) 'Routine name: (', routine_name, '\BOLD)'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '

(', link_name_gbl, ' Parameters)'; WRITE FILE (outfile) '(MULTIPAGE)'; WRITE FILE (outfile) '(4\5\20\15)'; WRITE FILE (outfile) '(Number\Name\Type\External Data Type)'; END MACRO /* link_routine */; ! link_parameter_number MACRO link_parameter_number TRIGGER { parameter_number_key para_num : number }; para_num_gbl = INTEGER( para_num ); link_parameter_found = TRUE; ! When you find a new parameter, blank out old global variables, in ! case of blanks. para_type_gbl = ''; para_name_gbl = ''; END MACRO /* link_parameter_number */; ! link_parameter_type MACRO link_parameter_type TRIGGER { parameter_type_key type_name: link_param_type_grp }; para_type_gbl = type_name; END MACRO /* link_parameter_type */; ! link_parameter_name MACRO link_parameter_name TRIGGER { link_field_name_key para_name : identifier }; para_name_gbl = para_name; END MACRO /* link_parameter_name */; ! link_parameter_data_type MACRO link_parameter_data_type TRIGGER { external_data_type para_data_type: {identifier [identifier]...} link_length_key }; IF link_found ! external link rather than DSD external data type THEN ! Write out all link parameter values WRITE FILE (outfile) '(', para_num_gbl, '\', para_name_gbl, '\', para_type_gbl, '\', para_data_type, ')'; END IF; ! Reset after printing so you can check it in end_links link_parameter_found = FALSE; END MACRO /* link_parameter_data_type */; ! task_action - Find and display task's action item MACRO task_action TRIGGER { task_action_key call_type: action_types object_name: identifier object_type: {menu_objects | identifier} }; DECLARE line_num, num_lines : AUTOMATIC INTEGER; ! For non-menu_object items, append name and type IF INDEX( call_executecmd_list, call_type&'\' ) > 0 THEN object_name = object_name & ' ' & object_type; WRITE 'Task action call_type: ', call_type, ' for ', object_name; END IF; object_type = TRIM( object_type ); ! Write out values WRITE FILE (outfile) '(', task_name_gbl, '\', object_name, '\', object_type, ')'; WRITE FILE (outfile) '(', task_name_gbl, '\( tab)\BOLD)'; WRITE FILE (outfile) '(', object_type, 's', object_name, '\( tab))'; WRITE FILE (outfile) '(', object_name, '\( tab))'; IF comment_gbl > '' ! If there was a comment THEN ! Write out task comment CALL print_comment( comment_gbl ); END IF; END MACRO /* task_action */; ! task MACRO task TRIGGER { task_key task_name: identifier comment: [task_comment] task_stop_key }; ! comment - Optional comment for task MACRO task_comment SYNTAX { comment_start_key comment_block_loc: FIND('Task window:') }; ANSWER comment_block_loc; END MACRO /* comment */; DECLARE line_num, num_lines : AUTOMATIC INTEGER; task_name_gbl = task_name; IF LENGTH( comment ) > 0 THEN ! Save comment for use after task action site comment_gbl = comment; END IF; IF NOT task_found ! They haven't found a task before THEN WRITE FILE (OUTFILE) ''; WRITE FILE (OUTFILE) '(Tasks)'; WRITE FILE (OUTFILE) ''; WRITE FILE (OUTFILE) '

'; WRITE FILE (OUTFILE) 'This section describes the application ', 'tasks in the ', appl_name_gbl, ' application.'; WRITE FILE (OUTFILE) ''; WRITE FILE (outfile) '(Tasks)'; WRITE FILE (OUTFILE) '

(Application Tasks)'; WRITE FILE (OUTFILE) '(WIDE)'; WRITE FILE (OUTFILE) '(3\15\25)'; WRITE FILE (OUTFILE) '(Task\Object', '\Object Type)'; task_found = TRUE; WRITE 'Processing tasks...'; END IF; END MACRO /* task */; ! action_list MACRO action_list TRIGGER { action_list_key action_name: identifier comment_block: [comment_section] action_stop_key }; DECLARE line_num, num_lines : AUTOMATIC INTEGER; DECLARE current_comment : DYNAMIC STRING; ! comment_section - comment portion of item MACRO comment_section SYNTAX { comment_start_key comment_block_loc: FIND('This action list performs') }; ANSWER comment_block_loc; END MACRO /* comment_section */; IF task_found ! They had found tasks, close old table THEN WRITE FILE (OUTFILE) ''; WRITE FILE (OUTFILE) ''; WRITE FILE (OUTFILE) ''; task_found = FALSE; END IF; IF (action_found AND action_items_found) ! Close old table THEN ! End the previous action options table and reset variable WRITE FILE (OUTFILE) ''; WRITE FILE (OUTFILE) ''; WRITE FILE (OUTFILE) ''; action_items_found = false; ELSE ! This is the first action list WRITE 'Processing action lists...'; WRITE FILE (OUTFILE) ''; WRITE FILE (OUTFILE) '(Action Lists)'; WRITE FILE (OUTFILE) ''; WRITE FILE (OUTFILE) '

'; WRITE FILE (OUTFILE) 'This section describes the action lists.'; WRITE FILE (OUTFILE) ''; END IF; action_found = TRUE; WRITE FILE (OUTFILE) '(', action_name, ')'; WRITE FILE (outfile) '(Action Lists', action_name, ')'; WRITE FILE (outfile) '(', action_name, '\BOLD)'; IF comment_block > '' ! If there was a comment THEN ! Write out action list comment current_comment = comment_block; CALL print_comment( current_comment ); END IF; ! Build table of action items WRITE FILE (OUTFILE) '

(', action_name, ' action items)'; WRITE FILE (OUTFILE) '(MULTIPAGE)'; WRITE FILE (OUTFILE) '(4\8\25\15)'; WRITE FILE (OUTFILE) '(Number\Object Name\Object Type\', 'Call Type)'; END MACRO /* action_list */; ! action_items - items in action list MACRO action_items TRIGGER { action_key action_number: number action_item_key2 call_type: action_types object_name: identifier object_type: {menu_objects | identifier} }; ! For non-menu_object items, append name and type IF INDEX( call_executecmd_list, call_type&'\' ) > 0 THEN object_name = object_name & ' ' & object_type; END IF; object_type= TRIM( object_type ); action_items_found = TRUE; ! Change format for application commands IF INDEX( call_type, 'CMD' ) = 0 THEN ! Non-RALLY command object WRITE FILE (OUTFILE) '(', action_number, '\', object_name, '\', object_type, '\', call_type, ')'; WRITE FILE (outfile) '(', object_type, 's', object_name, '\( tab))'; WRITE FILE (outfile) '(', object_name, '\( tab))'; ELSE ! if it's a RALLY command, change format WRITE FILE (OUTFILE) '(', action_number, '\', object_name, ' ', object_type, '\\', call_type, ')'; END IF; END MACRO /* action_items */; ! form_group - Save group name, type and comment MACRO form_group TRIGGER EXPOSE { form_group_key form_name: identifier period group_name: identifier [comment_start_key] comment: FIND('Type of group:') group_type_key group_type: {identifier [identifier]}}; ! Only fires on /DETAIL_LEVEL=FULL group_name_gbl = group_name; IF LENGTH( comment ) > 0 THEN form_groups(group_name_gbl).comment = comment; ELSE form_groups(group_name_gbl).comment = ''; END IF; form_groups(group_name_gbl).group_type = TRIM( group_type ); END MACRO /* form_group */; ! form - Save form name and comment MACRO form TRIGGER EXPOSE { form_key form_name: identifier period comment: [comment_section] main_group_type_key }; ! comment_section - comment portion of item MACRO comment_section SYNTAX { comment_start_key comment_block_loc: FIND('Type of group:') }; ANSWER comment_block_loc; END MACRO /* comment_section */; IF form_found ! You already found one form, dump it first THEN CALL write_form; ELSE form_found = TRUE; WRITE 'Processing forms...'; ! Set up new chapter header CALL write_form_chapter; END IF; form_name_gbl = form_name; ! Save comment IF LENGTH( comment ) > 0 THEN form_groups('MAIN').comment = comment; ELSE form_groups('MAIN').comment = ''; END IF; END MACRO /* form */; ! form_structure - capture form structure and load into array MACRO form_structure TRIGGER { form_structure_key structure: FIND( 'This group has' ) }; ! Captures the structure of the form, and loads it into an array of ! elements, in sequential order. ! Sequential order it used later to print out only groups in order. ! Break up structure into tree num_form_elements_gbl = break_form_block(structure); END MACRO /* form_structure */; ! dsd_name - Save name of DSD for data groups MACRO dsd_name TRIGGER { dsd_name_start_key dsd_name_loc: identifier dsd_name_stop_key }; form_groups(group_name_gbl).dsd_name = dsd_name_loc; END MACRO /* dsd_name */; ! Form field macros ! form_field - Create empty field element and save in global MACRO form_field TRIGGER { form_field_key form_name: identifier period field_name: identifier }; fields(field_name).element_type = 'VARIABLE'; ! dummy value fields(field_name).element_value = ''; ! dummy value field_name_gbl = field_name; END MACRO /* form_field */; ! field_type - Save field's type MACRO field_type TRIGGER { field_type_key field_type: identifier }; ! This works for all types except Data and Variable fields(field_name_gbl).element_type = field_type; END MACRO /* field_type */; ! computed_by - Save field's compute action (what computes it) MACRO computed_by TRIGGER { computed_by_key computor: identifier period }; fields(field_name_gbl).element_value = computor; END MACRO /* computed_by */; ! data_field_source - Save field's underlying DSD field MACRO data_field_source TRIGGER { data_field_key colon_prefix DSD_name: identifier period DSD_field: identifier }; fields(field_name_gbl).element_type = 'DSD'; fields(field_name_gbl).element_value = DSD_field; END MACRO /* data_field_source */; ! aggregate_source - Save aggregate's source field MACRO aggregate_source TRIGGER { agg_field_key form_name: identifier period source_name: identifier }; fields(field_name_gbl).element_value = source_name; END MACRO /* aggregate_source */; ! copy_source - Save copy field's source field MACRO copy_source TRIGGER { copy_field_key [form_name: identifier] period source_name: identifier} ; IF form_name > '' THEN fields(field_name_gbl).element_value = form_name & '.' & source_name; ELSE fields(field_name_gbl).element_value = 'GLOBAL VARIABLE: ' & source_name; END IF; END MACRO /* copy_source */; ! field_name - parse out the name of a field MACRO field_name SYNTAX { name: {identifier period identifier} }; ANSWER name; END MACRO /* field_name */; ! datatype - handle internal data type MACRO datatype SYNTAX { data_type : { identifier '(' {{identifier | number} \ comma} ')' } }; ANSWER data_type; END MACRO /* datatype */; ! relation_entry - syntax of relation MACRO relation_entry SYNTAX { relation_abbrev: identifier dsd_which relation_name: identifier }; ANSWER relation_abbrev, ' = ', relation_name; END MACRO /* relation-entry */; ! quoted_string - Handle single-quoted strings in RSE MACRO quoted_string SYNTAX { string_value: {'''' identifier [identifier]... ''''} }; ANSWER string_value; END MACRO /* quoted_string */; ! dsd - Complete DSD support MACRO dsd TRIGGER { dsd_key dsd_id: identifier [comment_section] rec_manip_section based_section source_section lock_section [reserve_section] }; ! DSD Variables CONSTANT dsd_manip = 1; ! Print order of objects CONSTANT dsd_from = 2; CONSTANT dsd_rse = 3; CONSTANT dsd_sort = 4; CONSTANT dsd_reduce = 5; DECLARE dsd_print, dsd_heading : TREE (INTEGER) OF DYNAMIC STRING; DECLARE comment_block : DYNAMIC STRING; DECLARE object_loop, num_lines, line_num : INTEGER; DECLARE dsd_filespec, dsd_type, dsd_access_mode, dsd_rec_count : DYNAMIC STRING; DECLARE field_ptr : TREEPTR(STRING) TO STRING; DECLARE dsd_fields : TREE (STRING) OF DYNAMIC STRING; ! comment_section - Optional comment MACRO comment_section SYNTAX { comment_start_key comment_block_loc: FIND('Record manipulation options:') }; comment_block = comment_block_loc; ANSWER 'Record manipulation options:'; END MACRO /* comment_section */; ! rec_manip_section - rec maniplation options ! only print if non-standard options selected MACRO rec_manip_section SYNTAX { rec_manip_key rec_options: [dash FIND( s'eol' )]... }; DECLARE rec_options_ptr : TREEPTR(INTEGER) TO STRING; DECLARE filter, outstring : DYNAMIC STRING; filter = s'eol' & '- '; rec_options_ptr = FIRST( rec_options ); dsd_heading(dsd_manip) = 'Record manipulation options:'; WHILE rec_options_ptr <> NIL AND INDEX( VALUE( rec_options_ptr ), 'supports transactions' ) = 0; ! Trim leading dash from options to improve readability dsd_print(dsd_manip) = dsd_print(dsd_manip) & ' ' & TRIM( VALUE( rec_options_ptr ), filter); rec_options_ptr = NEXT( rec_options_ptr ); IF rec_options_ptr <> NIL AND INDEX( VALUE( rec_options_ptr ), 'supports transactions' ) = 0 ! There are more THEN dsd_print(dsd_manip) = dsd_print(dsd_manip) & ', '; ELSE ! Only add ending if there's already something there IF EXISTS( dsd_print(dsd_manip) ) THEN dsd_print(dsd_manip) = dsd_print(dsd_manip) & '.'; END IF; END IF; END WHILE; END MACRO /* rec_manip_section */; ! based_section - DSD is based on what database and type MACRO based_section SYNTAX { dsd_based db_type: db_types period db_file_key db_name: filespec }; dsd_type = trim_all( db_type ); dsd_filespec = trim_all( db_name ); END MACRO /* based_section */; ! source_section - data source components MACRO source_section SYNTAX { source_key rec_tree: records_section from_tree: from_section rse_tree: rse_section [sort_tree: sort_section] [reduce_tree: reduce_section] using_section }; ! records_section - limits how many records are retrieved MACRO records_section SYNTAX { rec_count : {number | identifier} num_records_key }; dsd_rec_count = trim_all( rec_count ); END MACRO /* records_section */; ! from_section - records based on relations list MACRO from_section SYNTAX { dsd_from_key [relations: relation_entry [cross]]... }; dsd_heading(dsd_from) = 'Relations:'; dsd_print(dsd_from) = build_string( relations ); END MACRO /* from_section */; ! rse_entry - components of record selection expression ! limitation will not be available if MISSING clause used MACRO rse_entry SYNTAX { rse: {field_name [not_key] { { rel_op {number | field_name | date | quoted_string | identifier } } | missing } } }; ANSWER rse; END MACRO /* rse_entry */; ! rse_section - any and all record selection expressions MACRO rse_section SYNTAX { dsd_such { dsd_no_rest | expression} }; ! expression - Collection of RSEs MACRO expression SYNTAX { expressions: rse_entry \ log_ops: and_or }; DECLARE field_ptr : TREEPTR(INTEGER) TO DYNAMIC STRING; dsd_heading(dsd_rse) = 'RSE:'; field_ptr = FIRST( expressions ); WHILE field_ptr <> NIL; IF EXISTS(log_ops(SUBSCRIPT(field_ptr))) THEN dsd_print(dsd_rse) = dsd_print(dsd_rse) & ' ' & VALUE(log_ops(SUBSCRIPT(field_ptr))) & ' ' & trim_all( VALUE( field_ptr ) ); ELSE dsd_print(dsd_rse) = dsd_print(dsd_rse) & ' ' & trim_all( VALUE( field_ptr ) ); END IF; field_ptr = NEXT( field_ptr ); END WHILE; END MACRO /* expression */; END MACRO /* rse_section */; ! sort_section - Any sorts MACRO sort_section SYNTAX { dsd_sorted sorts: [sort_structure]... }; ! sort_structure - components of sort clause MACRO sort_structure SYNTAX { sort_direction: dsd_sort_grp sort_field: field_name [sort_more: comma] }; ANSWER sort_field, ' - ', sort_direction; END MACRO /* sort_structure */; dsd_print(dsd_sort) = build_string(sorts); dsd_heading(dsd_sort) = 'Sorted by:'; END MACRO /* sort_section */; ! reduce_section - Optional reduced to clauses MACRO reduce_section SYNTAX { dsd_reduced [reduce_fields: field_name [comma]]... }; dsd_print(dsd_reduce) = build_string(reduce_fields); dsd_heading(dsd_reduce) = 'Reduced to:'; END MACRO /* reduce_section */; ! using_section - Lists fields in DSD. Don't use MACRO using_section SYNTAX { dsd_using [fields: dsd_field_name [comma | period ]]... }; ! dsd_field_name - Save fields in chronological order MACRO dsd_field_name SYNTAX { name: field_name }; dsd_fields(trim_all( name )) = trim_all( name ); END MACRO /* dsd_field_name */; END MACRO /* using_section */; END MACRO /* source_section */; ! lock_section - Wait if locked clause MACRO lock_section SYNTAX { wait_locked lock_value: identifier }; END MACRO /* lock_section */; ! reserve_section - Structure for listing how relations are reserved MACRO reserve_section SYNTAX { dsd_reserved_key relation_entry... }; ! relation_entry - Lists each relations MACRO relation_entry SYNTAX { dsd_relation relation_name: identifier dsd_reserved access: { db_access db_access } }; dsd_access_mode = access; END MACRO /* relation_entry */; END MACRO /* reserve_section */; ! Processing section of DSD macro ! Process any leftover form definition IF form_found THEN CALL write_form; form_found = false; END IF; IF NOT dsd_found THEN WRITE 'Processing DSDs...'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '(Data Source Definitions)'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '

'; WRITE FILE (outfile) 'This describes the Data Source Definitions,' & 'which are listed alphabetically.'; WRITE FILE (outfile) ''; dsd_found = TRUE; ELSE ! Close existing DSD field table WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; END IF; ! Relation reserve list is blank for R/O transactions, so populate field IF dsd_access_mode = '' THEN dsd_access_mode = 'SHARED READ'; END IF; ! Write output dsd_name_gbl = dsd_id; ! save name for dsd field use WRITE FILE (outfile) '(', dsd_name_gbl, ')'; WRITE FILE (outfile) '(DSDs', dsd_name_gbl, '\BOLD)'; WRITE FILE (outfile) '(', dsd_name_gbl, '\BOLD)'; CALL print_comment( comment_block ); WRITE FILE (outfile) '

(Database:\BOLD) ', dsd_filespec; WRITE FILE (outfile) '(Type:\BOLD) ', dsd_type, ' - ', dsd_access_mode; IF dsd_rec_count <> 'All' THEN WRITE FILE (outfile) '(Record count:\BOLD) ', dsd_rec_count; END IF; ! Print source objects FOR object_loop = dsd_manip TO dsd_reduce; IF EXISTS( dsd_print(object_loop) ) THEN WRITE FILE (outfile) '(', dsd_heading(object_loop), '\BOLD)'; ! If you may get overflow, break up line IF INDEX( dsd_print(object_loop), ',' ) > 0 THEN num_lines = break_block( dsd_print(object_loop) ); FOR line_num = 1 TO num_lines; WRITE FILE( outfile ) text_lines(line_num); END FOR; END IF; WRITE FILE (outfile) TRIM( dsd_print(object_loop) ); END IF; END FOR; ! Print fields WRITE FILE (outfile) '

(Fields:\BOLD)'; WRITE FILE (outfile) '(SIMPLE)'; field_ptr = FIRST ( dsd_fields ); WHILE field_ptr <> NIL; WRITE FILE (outfile) '', SUBSCRIPT( field_ptr ); field_ptr = NEXT( field_ptr ); END WHILE; WRITE FILE (outfile) ''; WRITE FILE (outfile); ! Field table header WRITE FILE (outfile) '

(', dsd_name_gbl, ' fields)'; WRITE FILE (outfile) '(MULTIPAGE\WIDE\MAXIMUM)'; WRITE FILE (outfile) '(4\18\14\6)'; WRITE FILE (outfile) '(Name\External Type\' & 'Output Format\Description)'; END MACRO /* dsd */; ! dsd_field - Handles fields in DSD MACRO dsd_field TRIGGER { dsd_field_key dsd_name: identifier '.' dsd_field_name: identifier [comment_section] [valid_input_section] internal_section [value_section] [format_section] [min_max_section] local_section }; TYPE field_type : RECORD internal_type : VARYING STRING (31), external_type : VARYING STRING (31), output_format : VARYING STRING (31), field_size : FIXED STRING (3), comment : VARYING STRING (512), END RECORD; DECLARE dsd_field : field_type; DECLARE comment_block : DYNAMIC STRING; DECLARE comment_length : INTEGER; ! comment_section - Optional comment MACRO comment_section SYNTAX { comment_start_key comment: FIND('Internal data type:') }; DECLARE remainder : DYNAMIC STRING; ! Need to strip validation/input text from comment remainder = extract_comment ( comment,'Validation/input options:' ); dsd_field.comment = comment; END MACRO /* comment_section */; ! valid_input_section - Validation/input MACRO valid_input_section SYNTAX { field_valid [dash field_valid_optn]... }; END MACRO /* valid_input_section */; ! internal_section - RALLY internal field defintion MACRO internal_section SYNTAX { field_int_type internal_type: datatype}; dsd_field.internal_type = trim_all( internal_type ); END MACRO /* internal_section */; ! value_section - Initial/null values MACRO value_section SYNTAX { [{field_init | field_null} number]... }; END MACRO /* value_section */; ! format_section - numeric or date formats MACRO format_section SYNTAX { [out_format | in_format]... }; ! out_format - only save output formats MACRO out_format SYNTAX { field_out_form out_form: identifier dash [identifier]... }; dsd_field.output_format = out_form; END MACRO /* out_format */; ! in_format - ignore MACRO in_format SYNTAX { field_in_form identifier dash [identifier]... }; END MACRO /* in_format */; END MACRO /* format_section */; ! min_max_section - Minimums and maxes - ignore for now MACRO min_max_section SYNTAX { {{field_min | field_max} number}... }; END MACRO /* min_max_section */; ! local_section - local field definition MACRO local_section SYNTAX { field_local identifier field_int_size ext_size: number external_data_type ext_type: [identifier...] field_ext_scale ext_scale: number field_relation identifier }; IF trim_all( ext_type ) <> 'CHARACTER STRING' THEN dsd_field.external_type = ext_type & ' Scale ' & ext_scale; ELSE dsd_field.external_type = ext_type; END IF; dsd_field.field_size = ext_size; END MACRO /* local_section */; ! Write out values of all DSD fields in table format WRITE FILE (outfile) '(', trim_all( dsd_field_name ), '\', TRIM( dsd_field.external_type ), '\', TRIM( dsd_field.output_format ), '\'; comment_block = dsd_field.comment; IF comment_block > '' THEN WRITE FILE (outfile) trim_all( comment_block ), ')'; ELSE WRITE FILE (outfile) ')'; END IF; END MACRO /* dsd_field */; ! ADL - Main macro for capturing ADL procedure ! End-of-procedure marker is three blank lines MACRO ADL TRIGGER { ADL_key adl_name: identifier ADL_procedure_text adl_procedure: FIND( ADL_end_procedure_text ) }; DECLARE loop_count, num_lines : INTEGER; DECLARE adl_index : DYNAMIC STRING; ! Close existing DSD field table IF dsd_found THEN WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; WRITE FILE (outfile) ''; dsd_found = FALSE; END IF; ! Start ADL chapter, if needed IF NOT adl_found THEN WRITE 'Processing ADLs...'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '(ADL Procedures)'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '

'; WRITE FILE (outfile) 'This describes the Application Definition '; WRITE FILE (outfile) 'Language (ADL) procedures, which are ', 'listed alphabetically.'; WRITE FILE (outfile) ''; adl_found = TRUE; END IF; ! Main processing procedure WRITE FILE (outfile) '(', adl_name, ')'; WRITE FILE (outfile) '(ADLs', adl_name, '\BOLD)'; WRITE FILE (outfile) '(', adl_name, '\BOLD)'; WRITE FILE (outfile) '

'; WRITE FILE (outfile) '(WIDE)'; ! Write out text of ADL procedure num_lines = break_display( adl_procedure ); ! Break up into lines FOR loop_count = 3 TO num_lines; ! First 2 lines are blank WRITE FILE( outfile ) text_lines(loop_count); END FOR; ! End code example WRITE FILE (outfile) ''; ! Write out index entries from calls within ADL code CALL index_adl( adl_procedure, adl_index ); IF LENGTH( adl_index ) > 0 THEN ! Write out text of ADL index num_lines = break_block( adl_index ); ! Break up into lines FOR loop_count = 1 TO num_lines; WRITE FILE( outfile ) text_lines(loop_count); END FOR; END IF; WRITE FILE (outfile); WRITE FILE (outfile); END MACRO /* ADL */; ! parameter_pkt - Handle parameter packets MACRO parameter_pkt TRIGGER { parameter_pkt_key pkt_name: identifier [comment_section] pkt_action_line: ppkt_action num_of_params_key parameters: ppkt_parameters... }; DECLARE field_ptr : TREEPTR(INTEGER) TO DYNAMIC STRING; DECLARE comment_block : DYNAMIC STRING; ! comment_section - Optional comment MACRO comment_section SYNTAX { comment_start_key comment_block_loc: FIND( 'Action:' ) }; comment_block = comment_block_loc; ANSWER 'Action:'; END MACRO /* comment_section */; ! ppkt_action - Action of parameter packet - what's called MACRO ppkt_action SYNTAX { action_key colon_prefix call_type: action_types object_name: identifier object_type: menu_objects }; ANSWER call_type, ' ', object_name, ' - ', object_type; ANSWER s'cr', s'lf'; ANSWER '(',TRIM(object_type), 's', object_name, ')'; ANSWER s'cr', s'lf'; ANSWER '(', object_name, ')'; END MACRO /* ppkt_action */; ! ppkt_parameters - Build list element for each parameter in global tree MACRO ppkt_parameters SYNTAX { ppkt_parameter_key param: {field_name | identifier} }; ANSWER TRIM(param); END MACRO /* ppkt_parameters */; ! If this isn't the first parameter packet, print the chapter heading IF NOT ppkt_found THEN WRITE 'Processing Parameter Packets...'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '(Parameter Packets)'; WRITE FILE (outfile) ''; WRITE FILE (outfile) '

'; WRITE FILE (outfile) 'This describes the Parameter packets, ', ' which are ', 'listed alphabetically.'; WRITE FILE (outfile) ''; ppkt_found = TRUE; END IF; ! Print heading WRITE FILE (outfile) '(', pkt_name, ')'; WRITE FILE (outfile) '(Parameter Packets', pkt_name, '\BOLD)'; WRITE FILE (outfile) '(', pkt_name, '\BOLD)'; CALL print_comment( comment_block ); WRITE FILE (outfile) '

(Action:\BOLD) ', pkt_action_line; WRITE FILE (outfile) '

(Parameters:\BOLD)'; WRITE FILE (outfile) '(SIMPLE)'; ! Print parameters in list field_ptr = FIRST( parameters ); WHILE field_ptr <> NIL; WRITE FILE (outfile) '', VALUE( field_ptr ); field_ptr = NEXT( field_ptr ); END WHILE; WRITE FILE (outfile) ''; WRITE FILE (outfile); END MACRO /* parameter_pkt */; ! MAIN Procedure PROCEDURE main_routine MAIN ( ); !+ ! Start the picture matching process. !- ! initialize variables menu_found = FALSE; packet_found = FALSE; output_all_text = FALSE; menu_display_found = FALSE; choice_found = FALSE; action_found = FALSE; action_items_found = FALSE; CALL get_filespecs; ! Get user input of input file OPEN FILE( outfile ) AS outfile_name FOR OUTPUT; START SCAN DATA STACK 35000 INPUT FILE infile_name OUTPUT FILE 'nl:'; ! OUTPUT FILE 'SYS$OUTPUT'; CLOSE FILE( outfile ); END PROCEDURE; END MODULE /* READ_RALLY */;