!**************************************** ! ! PROCEDURE EVE_CONVERT_DATE (CD_BEG_COL) ! PROCEDURE EVE_DELETE_NULL_LINES ! PROCEDURE EVE_FIX_PARENTHESIS ! PROCEDURE EVE_QUICK_EDIT ! PROCEDURE EVE_REMAINING ! ! PROCEDURE ADD_COLUMNS(NUMBER_OF_COLS) ! PROCEDURE CHECK73 ! PROCEDURE CHECK_COLUMN(COLUMN_TO_CHECK) ! PROCEDURE PCE_EXEC_CMD_FILE (FILE) ! PROCEDURE SPLIT_LINES(RECL) ! !**************************************** !**************************************** PROCEDURE EVE_CONVERT_DATE (CD_BEG_COL) ! ! This procedure will convert an 8 character date field from the following ! formats (m/d/yy, mm/d/yy, mm/dd/yy, m/dd/yy, etc.) to 'YYMMDD '. ! The conversion begins on the current line and continues to the end of ! the current buffer. ! ! CD_BEG_COL - beginning column of date field ! local date_string, new_date_string, month, day, year, this_char, eocb; eocb := end_of (current_buffer); loop ! ! Change the 2nd parameter (the one after 'current_line, ') to the beginning ! column # of the date field in your file you wish to convert. ! if substr (current_line, cd_beg_col, 8) <> ' ' then ! ! Change the parameter in the following line to 1 less than the 2nd parameter ! in the above line ! move_horizontal (cd_beg_col - 1); date_string := erase_character (8); new_date_string := '000000'; this_char := index (date_string, '/'); month := substr (date_string, 1, (this_char - 1) ); if this_char-1 = 1 then month := '0' + month; endif; date_string := substr (date_string, (this_char + 1), (8 - this_char) ); this_char := index (date_string, '/'); day := substr (date_string, 1, (this_char - 1) ); if this_char-1 = 1 then day := '0' + day; endif; year := substr (date_string, (this_char + 1), 2); new_date_string := year + month + day + ' '; move_horizontal (-current_offset); ! ! Change the parameter in the following line to the same value in the ! move_horizontal statement found earlier in this procedure ! move_horizontal (cd_beg_col - 1); copy_text (new_date_string); endif; move_horizontal (-current_offset); move_vertical (1); exitif mark (none) = eocb; endloop; ENDPROCEDURE; !**************************************** PROCEDURE EVE_DELETE_NULL_LINES ! ! This procedure will delete all null lines (length = 0) in the current buffer. ! Local eocb, this_line, this_length; eocb := end_of (current_buffer); eve_trim_buffer; ! trim all trailing whitespace loop; this_line := current_line; this_length := length (this_line); if this_length = 0 then erase_line; ! delete this line if length = 0 exitif mark (none) = eocb; else move_vertical (1); ! skip this line when length > 0 exitif mark (none) = eocb; endif; endloop; ENDPROCEDURE; !**************************************** PROCEDURE EVE_FIX_PARENTHESIS local this_position, this_mode, this_range; on_error endon_error; this_position := mark (free_cursor); this_mode := get_info (current_buffer, "mode"); if this_mode <> insert then set (insert, current_buffer); endif; message ("Fixing x ("); loop this_range := (search (any ("abcdefghijklmnopqrstuvwxyz0123456789") + "(", forward, no_exact)); exitif this_range = 0; position (this_range); move_horizontal (1); copy_text (" "); endloop; position (this_position); message ("Fixing ) x"); loop this_range := (search (")" + any ("abcdefghijklmnopqrstuvwxyz0123456789"), forward, no_exact)); exitif this_range = 0; position (this_range); move_horizontal (1); copy_text (" "); endloop; set (this_mode, current_buffer); eve$position_in_middle (this_position); message ("Through fixing"); ENDPROCEDURE; !**************************************** PROCEDURE EVE_QUICK_EDIT local this_mode, this_char; this_mode := get_info (current_buffer, "mode"); set (overstrike, current_buffer); loop exitif current_character = " "; update (current_window); this_char := read_char; exitif this_char = ""; exitif this_char = " "; if this_char = "" then eve_delete; else copy_text (this_char); endif; update (current_window); exitif this_char = " "; endloop; set (this_mode, current_buffer); ENDPROCEDURE; !**************************************** PROCEDURE EVE_REMAINING ! ! Display number of character remaining on line from current cursor ! to end of line local this_length, remaining_length; this_length := length (current_line); remaining_length := this_length - current_offset; message (fao ('line length (characters) = !UL', remaining_length)); ENDPROCEDURE; !**************************************** PROCEDURE ADD_COLUMNS (NUMBER_OF_COLS) ! ! This procedure will add blanks to each line of the current buffer from ! the current line to the end of the buffer. Columns will be added at the ! current cursor column. User must specify the number of blanks to add. ! Up to 80 blanks per line may be specified. ! local eocb, blanks; eocb := end_of (current_buffer); blanks := " "; loop; copy_text (substr (blanks, 1, number_of_cols)); move_horizontal (-number_of_cols); move_vertical (1); exitif mark (none) = eocb; endloop; ENDPROCEDURE; !**************************************** PROCEDURE CHECK73 ! ! This procedure will check the current buffer to see if there are any non-null ! (including blanks) characters in column 73. When a non-null char is found ! in col. 73 the search will stop and the cursor will be placed in column ! 73 of the offending line. ! This macro is useful in checking FORTRAN programs for code that goes beyond ! column 72 for standard FORTRAN code. ! local eocb, this_char; eocb := end_of (current_buffer); loop move_horizontal (-current_offset); cursor_horizontal (72); this_char := current_character; exitif this_char <> ""; move_vertical (1); exitif mark (none) = eocb; endloop; eve_trim_buffer; ENDPROCEDURE; !**************************************** PROCEDURE CHECK_COLUMN (COLUMN_TO_CHECK) ! ! This procedure will check the current buffer to see if there are any non-null ! (including blanks) characters in column specified by the user. ! The search will stop and the cursor will be placed in column specified ! by the user of the offending line. ! local eocb, this_char; eocb := end_of (current_buffer); loop move_horizontal (-current_offset); cursor_horizontal (59); this_char := current_character; exitif this_char <> ""; move_vertical (1); exitif mark (none) = eocb; endloop; eve_trim_buffer; ENDPROCEDURE; !**************************************** PROCEDURE PCE_EXEC_CMD_FILE (FILE) ! ! Routine to read in and execute command files that the user ! has set up to customize tpu for him/her. ! ! added 870803 - RHS ! !LOCAL File, ! File variable ! file_name, ! file variable ! def_name, ! default file type ! my_commands,! program name ! proc_name, ! procedure name ! buffer_ptr; ! Pointer to User_Commands buffer LOCAL file_name, ! file variable def_name, ! default file type my_commands,! program name proc_name, ! procedure name buffer_ptr; ! Pointer to User_Commands buffer if eve$prompt_string (file, file_name, "Procedure name to execute: ", "Nothing entered -- Command file execution cancelled") then proc_name := file_name; def_name := ".TPU"; file_name := file_parse (file_name, def_name); buffer_ptr := create_buffer ('User_Commands', file_name); compile (buffer_ptr); ! Compile commands execute (proc_name); ! Execute commands delete (buffer_ptr); ! Delete the execution buffer endif; ENDPROCEDURE; !**************************************** PROCEDURE SPLIT_LINES (RECL) ! ! This procedure will split all lines in the current buffer from the current ! position to the end of the buffer at the column specified by the user ! if and only if the length of the current line is greater than the column ! specified by the user for spliting. ! Local this_offset, eocb; if recl = 0 then message ("No column specified for split -- reenter command specifying"); message (" a column value > 0."); return; endif; eocb := end_of (current_buffer); this_offset := recl; move_horizontal (-current_offset); loop; exitif mark (none) = eocb; if length (current_line) > this_offset then move_horizontal (this_offset); split_line; else move_vertical (1); endif; endloop; ENDPROCEDURE;