This document contains most of the major modifications made to the EVE editor to produce ADAM and FRED. The following EVE procedures have been deleted. ! eve$split_line ! eve$compress_whitespace ! eve$backup_over_whitespace ! eve_capitalize_word ! eve_set_shift_key ! eve$vt200_keys ! eve$vt100_keys ! eve$init_do_key ! tpu$local_init ! eve$insert_text ! eve$overstrike_text ! eve$find_buffer ! eve$unmap_if_mapped ! eve$map_if_not_mapped ! eve$create_buffer_globals ! eve$parser_dispatch ! eve$package_init ! eve$init_settings The following are new procedures. ! eve$insist_y_n ! eve_append ! eve_switch_tab ! eve_erase_line ! eve_erase_start_word ! eve_line_feed ! eve_form_feed ! eve_adam ! eve_fred ! eve_not_adam ! eve$get_number_to_indent ! eve_if_then ! eve_common ! eve_open ! eve_loop ! eve$subprogram ! eve_subroutine ! eve_function ! eve_program ! eve$is_blank_line ! eve$prologue Modified EVEPLUS procedures included: ! eve$is_wildcard ! eve_sort_buffer ! eveplus$$string_compare ! eveplus$$shell_sort ! eveplus_insert_text ! eve_strip ! eve_untab ! eve_where ! eveplus_search_quietly ! eveplus_replace ! eve_display ! eve_fix ! eve_list_commands ! eve$search_controls ! eve_print ! eveplus_find buffer ! eveplus_key ! eveplus_restore_key ! eve_list_buffers ! eve_list_all_buffers ! bufed_list_buffers ! bufed_remove_buffer ! bufed_destroy_buffer ! bufed_select_buffer ! bufed_get_the_buffer ! eveplus_set_mode ! eveplus_advance_horizontal ! eve_search ! build_pattern ! tpu$local_init ! edd_current_column ! edd_replace_tabs_with_blanks_and_pad ! eve_draw_box ! eve_rectangular_remove ! eve_rectangular_insert_here ! eve_rectangular_select ! eveplus_pad_blank ! eve_rectangular ! eveplus_blank_chars The following are EVE procedures that have been significantly modified: ! eve$init_variables ! eve$append_line ! eve$set_status_line ! eve$find ! eve_help ! eve$help_keypad ! eve$fill_line ! eve_center_line ! eve_tab ! eve_replace ! eve_get_file ! eve_include_file ! eve$show_buffer_info ! eve$init_files ! eve$init_procedure ! eve_erase_line *** Renamed to eve_erase_end_line ! eve_start_of_line ! eve_erase_start_of_line ! eve$standard_keys ! eve_fill_paragraph ! eve_lowercase_word ! eve_uppercase_word ! eve_write_file --- NEW PROCEDURES --- procedure eve$insist_y_n (the_prompt) ! procedure to get a yes/no answer. A null answer defaults to "yes", ! otherwise the answer must be either "yes" or "no" or an abbreviation ! thereof. local original_reply, ! String returned by read_line after prompt lower_reply; ! Lowercase version of original_reply ! Loop until we get a yes/no reply (or just CR for yes) loop lower_reply := read_line (the_prompt); original_reply := lower_reply; change_case (lower_reply, lower); if (length (lower_reply) = 0) or (lower_reply = substr ("yes", 1, length (lower_reply))) then return (TRUE); else if lower_reply = substr ("no", 1, length (lower_reply)) then return (FALSE); else message (fao ("Don't understand !AS;", original_reply) + " please answer yes or no"); endif; endif; endloop; endprocedure; procedure eve_append local this_position, ! Marker for current cursor position remove_range; ! Range being removed ! new procedure based on REMOVE (31 Mar 1986) this_position := mark (none); if eve$x_select_position <> 0 then if get_info (eve$x_select_position, "buffer") <> current_buffer then message ("Append must be used in the same buffer as Select."); else remove_range := select_range; ! Select & Remove in same spot => erase this character if remove_range = 0 then if this_position = end_of (current_buffer) then message ("Nothing to append"); eve$x_select_position := 0; return; else remove_range := create_range (mark (none), mark (none), none); endif; endif; position (paste_buffer); move_text (remove_range); position (this_position); eve$x_select_position := 0; remove_range := 0; message ("Append completed."); endif; else message ("Use Select before using Append."); endif; endprocedure; procedure eve_switch_tabs ! Procedure to toggle tab command between spaces and tabs ! Cannot switch tabs when in FRED if eve$in_fred then eve_not_adam ("SWITCH TABS"); return; endif; if eve$space_tabs then eve$space_tabs := false; message ("TAB will now insert TABS"); else eve$space_tabs := true; message ("TAB will now insert SPACES"); endif; endprocedure; procedure eve_erase_line ! Formerly, eve_erase_whole_line ! !AER --- 13 Jan 1986 (new routine) ! ! Erase the whole line, regardless of cursor location ! eve$x_restoring_line := 1; eve$x_restore_text := erase_line; endprocedure; procedure eve_erase_start_word ! !AER --- 14 Jan 1986 ! ! This is a modification of EVE_ERASE_WORD to erase to the start of the ! next word. ! local this_buffer, ! Current buffer this_mode, ! Keyword for current mode temp_string, ! String used to check for start of line start_erase_word, ! Marker for beginning of previous word end_erase_word, ! Marker for end of previous word spaces_to_erase, ! Number of between-word spaces to erase erase_word_range; ! Range for previous word if current_window = eve$command_window then eve_erase_previous_word; return; endif; this_buffer := current_buffer; if mark (none) = end_of (this_buffer) then return; endif; ! Are we on a space between words? If so, delete to start of next word. if index (eve$x_whitespace, current_character) <> 0 then start_erase_word := mark (none); loop move_horizontal(1); exitif index(eve$x_whitespace, current_character) = 0 endloop; move_horizontal(-1); end_erase_word := mark (none); erase_word_range := create_range (start_erase_word, end_erase_word, none); position (start_erase_word); eve$x_restore_text := erase_character (length (erase_word_range)); eve$x_restoring_line := 0; return; endif; ! Check for end of line if current_character = eve$x_null then if current_offset = 0 then temp_string := ascii (10); else move_horizontal (-1); temp_string := current_character; move_horizontal (1); endif; move_horizontal (1); eve$append_line; if mark (none) <> end_of (this_buffer) then if index (eve$x_word_separators, temp_string) = 0 then this_mode := get_info (this_buffer, "mode"); set (insert, this_buffer); copy_text (" "); set (this_mode, this_buffer); endif; endif; eve$x_restoring_line := 1; eve$x_restore_text := eve$x_null; else start_erase_word := mark (none); eve$end_of_word; move_horizontal (-1); end_erase_word := mark (none); erase_word_range := create_range (start_erase_word, end_erase_word, none); position (start_erase_word); eve$x_restore_text := erase_character (length (erase_word_range)); eve$x_restoring_line := 0; endif; endprocedure; procedure eve_line_feed ! Procedure to insert a line-feed eveplus_insert_text(ascii(10)); endprocedure; procedure eve_form_feed ! Procedure to insert a form-feed eveplus_insert_text(ascii(12)); endprocedure; ! ! FRED procedures begin here ! procedure eve_adam ! Procedure to change from the FORTRAN editor FRED to ! the text editor ADAM if not eve$in_fred then message ("Already in ADAM"); return; else eve$in_fred := false; endif; ! Set margins eve$x_default_right_margin := 1; set (margins, current_buffer, eve$x_default_left_margin, get_info (eve$main_window, eve$kt_width) - eve$x_default_right_margin); eve$x_hot_zone_size := 8; eve$kt_version := "ADAM Version IV.0"; ! Redefine the keypad for text editing define_key ("eve_center_line", key_name( pf3, shift_key), " center_line", eve$x_vt100_keys); define_key ("eve_rectangular", key_name( kp3, shift_key), " rectangular", eve$x_vt100_keys); define_key ("eve_fill_paragraph", key_name( kp0, shift_key), " fill_paragraph", eve$x_vt100_keys); define_key ("eve_not_adam ('IF_THEN')", key_name ('I', shift_key), " if_then", eve$x_standard_keys); define_key ("eve_not_adam ('COMMON')", key_name ('C', shift_key), " common", eve$x_standard_keys); define_key ("eve_not_adam ('OPEN')", key_name ('O', shift_key), " open", eve$x_standard_keys); define_key ("eve_not_adam ('LOOP')", key_name ('D', shift_key), " loop", eve$x_standard_keys); define_key ("eve_not_adam ('SUBROUTINE')", key_name ('S', shift_key), " subroutine", eve$x_standard_keys); define_key ("eve_not_adam ('FUNCTION')", key_name ('F', shift_key), " function", eve$x_standard_keys); define_key ("eve_not_adam ('PROGRAM')", key_name ('P', shift_key), " program", eve$x_standard_keys); eve$update_status_lines; if eve$x_number_of_windows = 2 then eve_other_window; eve$update_status_lines; eve_other_window; endif; endprocedure; procedure eve_fred ! ! Procedure to change from the text editor ADAM to the ! FORTRAN editor FRED ! local num_lines, this_buffer, count; if eve$in_fred then message ("Already in FRED"); return; endif; ! If in rectangular mode, get out if eveplus_rectangular then eve_rectangular; endif; eve$in_fred := true; ! Reset window width and margins for 73 column word wrapping set (width, eve$main_window, 80); eve$kt_version := "FRED Version I.5"; eve$x_default_right_margin := 8; eve$x_hot_zone_size := 0; set (margins, current_buffer, eve$x_default_left_margin, get_info (eve$main_window, eve$kt_width) - eve$x_default_right_margin); ! Redefine the keypad for FORTRAN editing define_key ("eve_not_adam ('CENTER')", key_name( pf3, shift_key), " center_line", eve$x_vt100_keys); define_key ("eve_not_adam ('RECTANGULAR')", key_name( kp3, shift_key), " rectangular", eve$x_vt100_keys); define_key ("eve_not_adam ('FILL')", key_name( kp0, shift_key), " fill_paragraph", eve$x_vt100_keys); define_key ("eve_if_then", key_name ('I', shift_key), " if_then", eve$x_standard_keys); define_key ("eve_common", key_name ('C', shift_key), " common", eve$x_standard_keys); define_key ("eve_open", key_name ('O', shift_key), " open", eve$x_standard_keys); define_key ("eve_loop('')", key_name ('D', shift_key), " loop", eve$x_standard_keys); define_key ("eve_subroutine('')", key_name ('S', shift_key), " subroutine", eve$x_standard_keys); define_key ("eve_function('')", key_name ('F', shift_key), " function", eve$x_standard_keys); define_key ("eve_program('')", key_name ('P', shift_key), " program", eve$x_standard_keys); ! Reset the status line to show FRED editor eve$update_status_lines; if eve$x_number_of_windows = 2 then eve_other_window; eve$update_status_lines; eve_other_window; endif; ! Check for Author info. file for Prologues if not have_author_info then have_author_info := true; author_file := file_search ("sys$login:author.dat"); if author_file <> "" then author_buffer := create_buffer ("author_buf",author_file); num_lines := get_info (author_buffer,"record_count"); set (no_write, author_buffer); this_buffer := current_buffer; position (author_buffer); count := 0; loop count := count + 1; copy_text ("C* "); exitif (count=num_lines); move_vertical(1); eve_start_of_line; endloop; position(this_buffer); endif; endif; endprocedure; procedure eve_not_adam (command) ! Procedure to produce an error message when invalid commands are ! attempted in ADAM or FRED mode if eve$in_fred then message(fao("Command !AS works in ADAM, but not FRED!",command)); else message(fao("Command !AS works in FRED, but not ADAM",command)); endif; endprocedure; procedure eve$get_number_to_indent (how_many) !FRED - Procedure to get number of spaces to indent FORTRAN commands if current_column <= 7 then how_many := 6; else how_many := current_column - 1; if how_many > 39 then how_many := 39; endif; endif; endprocedure; procedure eve_if_then local right_here, how_many_spaces, blanks, line_all_spaces; ! Command not valid for ADAM editing if not eve$in_fred then eve_not_adam ("IF THEN"); return; endif; if get_info(current_buffer,eve$kt_mode) <> INSERT then set (INSERT, current_buffer); endif; line_all_spaces:= eve$is_blank_line(7); ! Get number of spaces to indent eve$get_number_to_indent (how_many_spaces); blanks := substr (eve$kt_spaces, 1, how_many_spaces); if current_offset > 0 then if line_all_spaces then loop exitif current_offset >= how_many_spaces; copy_text(" "); endloop; else eve_end_of_line; split_line; copy_text(blanks); endif; else if not line_all_spaces then split_line; cursor_vertical(-1); endif; copy_text(blanks); endif; copy_text("IF ()"); cursor_horizontal(-1); right_here := mark(none); cursor_horizontal(1); copy_text(" THEN"); split_line; copy_text(blanks+"ELSE"); split_line; copy_text(blanks+"ENDIF"); if not line_all_spaces then eve_return; endif; position(right_here); endprocedure; procedure eve_common local line_all_spaces, put_cursor_here; ! Command not valid in ADAM if not eve$in_fred then eve_not_adam ("COMMON"); return; endif; if get_info(current_buffer,eve$kt_mode) <> INSERT then set (INSERT, current_buffer); endif; ! check for blank or empty line line_all_spaces := eve$is_blank_line(7); if current_offset > 0 then eve_start_of_line; endif; copy_text(" COMMON //"); cursor_horizontal(-1); put_cursor_here := mark(none); if not line_all_spaces then cursor_horizontal(1); eve_return; position (put_cursor_here); endif; endprocedure; procedure eve_open local start_here, blanks, how_many_spaces, line_all_spaces; ! Command not valid for the ADAM editor if not eve$in_fred then eve_not_adam ("OPEN"); return; endif; if get_info(current_buffer,eve$kt_mode) <> INSERT then set (INSERT, current_buffer); endif; line_all_spaces := eve$is_blank_line(7); eve$get_number_to_indent (how_many_spaces); blanks := substr (eve$kt_spaces, 1, how_many_spaces); if current_offset > 0 then if line_all_spaces then loop exitif current_offset >= how_many_spaces; copy_text(" "); endloop; else eve_end_of_line; split_line; copy_text(blanks); endif; else if not line_all_spaces then split_line; cursor_vertical(-1); endif; copy_text(blanks); endif; copy_text("OPEN (UNIT=,"); cursor_horizontal(-1); start_here := mark(none); cursor_horizontal (1); copy_text(" FILE=, STATUS='OLD', ERR=)"); if not line_all_spaces then eve_return; endif; position(start_here); endprocedure; procedure eve_loop (do_label) local go_here, new_num, length_new_num, blanks, how_many_spaces, line_all_spaces; ! Command not valid in ADAM if not eve$in_fred then eve_not_adam ("LOOP"); return; endif; if get_info(current_buffer,eve$kt_mode) <> INSERT then set (INSERT, current_buffer); endif; if not (eve$prompt_string (do_label, new_num, "Do label: ", "No label entered")) then return; endif; length_new_num := length(new_num); if length_new_num > 5 then message ("Do label too long"); return; endif; line_all_spaces := eve$is_blank_line(7); eve$get_number_to_indent (how_many_spaces); blanks := substr (eve$kt_spaces, 1, how_many_spaces); if current_offset > 0 then if line_all_spaces then loop exitif current_offset >= how_many_spaces; copy_text(" "); endloop; else eve_end_of_line; split_line; copy_text(blanks); endif; else if not line_all_spaces then split_line; cursor_vertical(-1); endif; copy_text(blanks); endif; copy_text("DO " + new_num + " I = "); cursor_horizontal (-1); go_here := mark(none); cursor_horizontal (1); if length_new_num < 5 then loop new_num := new_num + " "; length_new_num := length_new_num + 1; exitif length_new_num = 5; endloop; endif; split_line; copy_text (new_num); copy_text (substr (eve$kt_spaces, 1, how_many_spaces-5)); copy_text ("CONTINUE"); if not line_all_spaces then eve_return; endif; position (go_here); endprocedure; procedure eve$subprogram (which, subpro_name) ! Procedure to insert FORTRAN subprogram stubs (SUBROUTINE, ! FUNCTION, PROGRAM) in the current buffer, including ! baseline prologue and corresponding code ! local put_here, length_subpro_name, this_mode, need_eve_return; on_error endon_error; this_mode := get_info (current_buffer, eve$kt_mode); set (INSERT, current_buffer); if current_offset > 0 then eve_start_of_line; endif; if current_character <> eve$kt_null then need_eve_return := true; else need_eve_return := false; endif; if substr(subpro_name,1,1) = eve$kt_blank then edit (subpro_name, trim_leading); endif; length_subpro_name := length(subpro_name); if substr (subpro_name, length_subpro_name, 1) = eve$kt_blank then edit (subpro_name, trim_trailing); endif; if which = "PROGRAM" then copy_text (" " + which + " " + subpro_name + " "); eve$prologue (subpro_name); eve_return; copy_text(" "); cursor_horizontal (-1); put_here := mark(none); cursor_horizontal (1); split_line; copy_text(" STOP"); else copy_text (" " + which + " " + subpro_name + " ()"); cursor_horizontal (-1); put_here := mark(none); cursor_horizontal (1); eve$prologue(subpro_name); split_line; copy_text(" RETURN"); endif; split_line; copy_text(" END"); split_line; copy_text("C"); split_line; copy_text("C---END " + subpro_name); split_line; copy_text ("C"); if need_eve_return then eve_return; endif; position (put_here); if this_mode <> INSERT then set (this_mode, current_buffer); endif; endprocedure; procedure eve_subroutine (sub_name) ! Procedure to insert FORTRAN SUBROUTINE stub in the ! current buffer including baseline prologue and RETURN/END ! statements ! local new_name; ! Not a valid ADAM command if not eve$in_fred then eve_not_adam ("SUBROUTINE"); return; endif; if not (eve$prompt_string (sub_name, new_name, "Subroutine name: ", "No name entered")) then return; endif; eve$subprogram ("SUBROUTINE",new_name); endprocedure; procedure eve_function (fun_name) ! ! Procedure to insert FORTRAN FUNCTION stub in current buffer ! including baseline prologue and RETURN/END statements ! local temp_name; ! Not an ADAM command if not eve$in_fred then eve_not_adam ("FUNCTION"); return; endif; if not (eve$prompt_string (fun_name, temp_name, "Function name: ", "No name entered")) then return; endif; eve$subprogram ("FUNCTION", temp_name); endprocedure; Procedure eve_program (program_name) ! ! Procedure to insert FORTRAN program stub in current buffer ! local dummy_name; ! Not a text-editing command if not eve$in_fred then eve_not_adam ("PROGRAM"); return; endif; if not (eve$prompt_string (program_name, dummy_name, "Program name: ", "No name entered")) then return; endif; eve$subprogram ("PROGRAM", dummy_name); endprocedure; Procedure eve$is_blank_line ( start ) !FRED - Procedure to determine if the current line is blank !Based on code in Procedure eve$append_line local this_line, this_line_length, this_line_index; on_error endon_error; this_line := current_line; this_line_index := start; this_line_length := length (this_line); loop exitif this_line_index > this_line_length; exitif substr (this_line, this_line_index, 1) <> " "; this_line_index := this_line_index + 1; endloop; if this_line_index > this_line_length then return (true); else return (false); endif; endprocedure; procedure eve$prologue (stub_name) ! ! Procedure to create prologues for FORTRAN PROGRAM, SUBROUTINES, ! or FUNCTIONS ! local date_and_time, date, length_of_name, centered_at, column_counter, end_box_at; column_counter := 23; end_box_at := 50; date_and_time := FAO ("!%D", 0); date := substr (date_and_time, 1, 11); length_of_name := length(stub_name); if length_of_name > 27 then stub_name := substr(stub_name,1,27); length_of_name := 27; endif; centered_at := 36 - length_of_name / 2; split_line; copy_text("C*"); split_line; copy_text("C* *******************************"); split_line; copy_text("C* *******************************"); split_line; copy_text("C* ** **"); split_line; copy_text("C* **"); loop exitif column_counter = centered_at; copy_text(" "); column_counter := column_counter + 1; endloop; copy_text(stub_name); column_counter := column_counter + length_of_name; loop exitif column_counter = end_box_at; copy_text(" "); column_counter := column_counter + 1; endloop; copy_text("**"); split_line; copy_text("C* ** **"); split_line; copy_text("C* *******************************"); split_line; copy_text("C* *******************************"); split_line; copy_text("C*"); split_line; copy_text("C* SUBPROGRAM :"); split_line; copy_text("C* "+stub_name); split_line; copy_text("C*"); split_line; copy_text("C* AUTHOR :"); split_line; ! Check for Author information file if author_file <> "" then copy_text(author_buffer); endif; copy_text("C*"); split_line; copy_text("C* PURPOSE :"); split_line; copy_text("C*"); split_line; copy_text("C* INPUT ARGUMENTS :"); split_line; copy_text("C*"); split_line; copy_text("C* OUTPUT ARGUMENTS :"); split_line; copy_text("C*"); split_line; copy_text("C* COMMON BLOCKS :"); split_line; copy_text("C*"); split_line; copy_text("C* SUBPROGRAM REFERENCES :"); split_line; copy_text("C*"); split_line; copy_text("C* ASSUMPTIONS AND RESTRICTIONS :"); split_line; copy_text("C*"); split_line; copy_text("C* LANGUAGE AND COMPILER :"); split_line; copy_text("C* ANSI FORTRAN 77"); split_line; copy_text("C*"); split_line; copy_text("C* VERSION AND DATE :"); split_line; copy_text("C* VERSION I.0 - "+date); split_line; copy_text("C*"); split_line; copy_text("C* CHANGE HISTORY :"); split_line; copy_text("C* "+ date + " - INITIAL VERSION"); split_line; copy_text("C*"); split_line; copy_text("C***********************************************************************"); split_line; copy_text("C*"); endprocedure; --- MODIFIED "EVEPLUS" ROUTINES --- procedure eve$is_wildcard (the_string) if index (the_string, "*") <> 0 then return (TRUE); endif; if index (the_string, "%") <> 0 then return (TRUE); endif; if index (the_string, "...") <> 0 then return (TRUE); endif; return (FALSE); endprocedure; ! ! Sort the named buffer. Prompt for buffer name if not specified ! procedure eve_sort_buffer (buffer_to_sort) local flag, p_buf, this_window; flag := 0; ! if a buffer name was entered... sort it if buffer_to_sort <> eve$kt_null then p_buf := eveplus_find_buffer (buffer_to_sort); ! no buffer name was entered, use current buffer else ! if no text is selected, sort current buffer if eve$x_select_position = 0 then p_buf := current_buffer; else eve_remove; this_window := current_window; p_buf := create_buffer ('tempsort'); position (p_buf); eve_insert_here; flag := 1; endif; endif; if (p_buf <> 0) then eveplus$$shell_sort (p_buf); if flag <> 0 then position (this_window); copy_text (p_buf); delete (p_buf); endif; message ("Sort completed."); else message ("Buffer "+buffer_to_sort+" not found"); endif; endprocedure; ! ! Compare two strings ! ! Returns: ! 1 if string1 > string2 ! 0 if string1 = string2 ! -1 if string1 < string2 ! procedure eveplus$$string_compare (string1, string2) local v_alpha, v_c1, v_p1, v_c2, v_i, v_p2; v_alpha := " " + !Treat all control chars as spaces??? " " + " !""#$%&'()*+,-./"+ "0123456789:;<=>?" + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_" + "`abcdefghijklmnopqrstuvwxyz{|}~"; v_i := 1; loop if (length (string2) < v_i) then if (length (string2) = length (string1)) then return 0 else return 1 endif; endif; if (length (string1) < v_i) then return -1; endif; v_c1 := substr (string1, v_i, 1); change_case (v_c1, upper); v_c2 := substr (string2, v_i, 1); change_case (v_c2, upper); v_p1 := index (v_alpha, v_c1); v_p2 := index (v_alpha, v_c2); if (v_p1 < v_p2) then return -1; endif; if (v_p1 > v_p2) then return 1; endif; v_i := v_i + 1; endloop; return 1; endprocedure; ! ! This is the shell sort, described in knuth and also ! referred to as the Diminishing Increment Sort. ! procedure eveplus$$shell_sort (buffer_to_sort) local v_pos ,v_iline ,v_jline ,v_i ,v_j ,v_record ; on_error position (v_pos); return; endon_error; v_pos := mark (none); position (buffer_to_sort); eveplus$x_shellstep_0 := 1; eveplus$x_shellstep_1 := 4; eveplus$x_shellstep_2 := 13; eveplus$x_shellstep_3 := 40; eveplus$x_shellstep_4 := 121; eveplus$x_shellstep_5 := 364; eveplus$x_shellstep_6 := 1093; eveplus$x_shellstep_7 := 3280; eveplus$x_shellstep_8 := 9841; eveplus$x_shellstep_9:= 32767; eveplus$x_gshell := 0; eveplus$x_shell_index := 0; ! ! Find the highest step to use ! loop eveplus$x_gshell := 0; exitif (eveplus$x_shell_index >= 6); execute ("if (get_info (current_buffer, 'record_count') <"+ fao ("eveplus$x_shellstep_!UL)",eveplus$x_shell_index+2)+ " then eveplus$x_gshell := 1;endif;"); if eveplus$x_gshell then exitif 1; endif; eveplus$x_shell_index := eveplus$x_shell_index + 1; endloop; v_record := get_info (current_buffer, 'record_count'); ! ! Now we can sort the buffer. Outer loop loops over all the steps, ! decrementing eveplus$x_shell_index. ! loop execute (fao("eveplus$x_gshell := eveplus$x_shellstep_!UL", eveplus$x_shell_index)); v_j := eveplus$x_gshell + 1; !Set up loop for step+1-index loop position (beginning_of (current_buffer)); move_vertical (v_j - 1); !Get j'th line v_jline := current_line; v_i := v_j - eveplus$x_gshell; !i = j - h loop position (beginning_of (current_buffer)); move_vertical (v_i - 1); v_iline := current_line; if (eveplus$$string_compare (v_jline, v_iline) >= 0) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; else position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_iline); v_i := v_i - eveplus$x_gshell; if (v_i < 1) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; endif; endif; endloop; v_j := v_j + 1; exitif (v_j > v_record); endloop; eveplus$x_shell_index := eveplus$x_shell_index - 1; exitif (eveplus$x_shell_index < 0); endloop; position (v_pos); endprocedure; ! ! Routine to insert text, even in overstrike mode ! procedure eveplus_insert_text(the_text) ! Copy_text in insert mode LOCAL old_mode; old_mode := get_info(current_buffer, "mode"); set(INSERT, current_buffer); copy_text(the_text); set(old_mode, current_buffer); endprocedure; procedure Eve_strip message("Stripping buffer..."); eve$trim_buffer( current_buffer ); message("Stripping complete."); endprocedure; procedure eve_untab ! Turn TABs to spaces local here, target, n, every_x_columns, what_tabs; !AER suppress "string not found" message on_error endon_error; move_horizontal (-1); ! in case we're on a tab now here := mark(none); position(beginning_of(current_buffer)); every_x_columns := 8; what_tabs := get_info (current_buffer, "tab_stops"); if get_info (what_tabs, eve$kt_type) = integer then every_x_columns := what_tabs; else message("Warning - the default for UNTAB with SET TABS AT is every 8 columns"); endif; loop target := search(ascii(9), FORWARD); exitif (target = 0); position(beginning_of(target)); erase_character(1); n := current_offset; n := n - (every_x_columns * (n / every_x_columns)); eveplus_insert_text(substr(" ", 1, every_x_columns - n)); endloop; position (here); move_horizontal (1); message ("UNTAB complete."); endprocedure; procedure eve_where ! What line am I on? local this_position, ! marker - current position start_of_buffer, ! marker - beginning of current buffer this_line_position, ! marker - position at start of this_line this_column, ! integer - cursor column total_lines, ! integer - total lines in buffer high_line, ! integer - high line limit for binary search low_line, ! integer - low line limit for binary search this_line, ! integer - line number of current guess percent; ! integer - percent of way through buffer ! Initialization this_position := mark (none); this_column := current_offset+1; start_of_buffer := beginning_of (current_buffer); total_lines := get_info (current_buffer, "record_count") + 1; high_line := total_lines; if this_position = end_of (current_buffer) then low_line := total_lines; else low_line := 1; endif; ! Binary search loop exitif high_line - low_line <= 1; this_line := low_line + ((high_line - low_line) / 2); position (start_of_buffer); move_vertical (this_line - 1); if mark (none) > this_position then high_line := this_line; else low_line := this_line; if mark (none) = this_position then high_line := this_line; endif; endif; endloop; ! TPU will truncate numbers on division; make it round instead percent := (((low_line * 1000) / total_lines)+5)/10; ! Display message and return to original position message (fao ("You are in column !SL of line !SL out of !SL (!SL%)", this_column, low_line, total_lines, percent)); position (this_position); endprocedure; procedure eveplus_search_quietly(target, dir) ! Search w/o "String not found" on_error return(0); endon_error; return(search(target, dir)); endprocedure; procedure eveplus_replace(old, new) ! Simple replace function local ptr, old_mode; on_error return(0); endon_error; ptr := search(old, current_direction); if (ptr <> 0) then position(ptr); erase(ptr); old_mode := get_info(current_buffer, "mode"); set(INSERT, current_buffer); copy_text(new); set(old_mode, current_buffer); return(1); else return(0); endif; endprocedure; ! This procedure writes a one line message describing the current character ! in terms of Octal, Decimal, Hexadecimal and (sometimes ) '^' notation. ! procedure eve_display LOCAL i,cc; ! Handle end-of-buffer condition IF MARK( NONE ) = END_OF( CURRENT_BUFFER ) THEN MESSAGE( 'At end of buffer, no current character.' ); RETURN; ENDIF; ! Convert the character to an integer the hard way (no builtin yet) i := 0; LOOP; EXITIF i > 255; EXITIF CURRENT_CHARACTER = ASCII(i); i := i + 1; ENDLOOP; IF i > 255 THEN i := 0; ENDIF; ! On overflow, reset to NULL ! Provide ^ notation for ASCII control characters IF i < 32 THEN cc := ', ^' + ASCII(i+64); ELSE cc := ''; ENDIF; ! Format and output the results MESSAGE( FAO( "Current Character is '!AS', Octal=!OB, Decimal=!-!UB, " + "Hex=!-!XB!AS", CURRENT_CHARACTER, i, cc ) ); endprocedure; procedure eve_fix LOCAL the_range; on_error if (ERROR <> tpu$_STRNOTFOUND) then message("Error (" + str(ERROR) + ") at line " + str(ERROR_LINE)); return; endif; endon_error; ! ! First remove the CRLFs. If they are not at the EOL, add a line break. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(13)+ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Next remove naked LFs. If they are not at the EOL, add a line break. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(10), FORWARD); exitif (the_range = 0); erase(the_range); position(beginning_of(the_range)); if (current_character <> "") then split_line; endif; endloop; ! ! Finally, remove naked CRs. If they are not at the BOL, add a line break. ! position(beginning_of(current_buffer)); loop the_range := search(ascii(13), FORWARD); exitif (the_range = 0); position(end_of(the_range)); if (current_offset <> 0) then split_line; endif; erase(the_range); endloop; endprocedure; procedure eve_list_commands local the_names, column_width, total_width, how_many_columns, temp; eve_mark("eveplus_saved_buffer"); the_names := expand_name("eve_", procedures) + " "; position(eve$choice_buffer); erase(eve$choice_buffer); message("Building command list"); loop exitif (the_names = eve$x_null); temp := index (the_names, " "); if (temp = 0) then message("Can't find space"); return; endif; copy_text (substr (the_names, 1, temp-1)); the_names := substr(the_names, temp+1, length(the_names)); split_line; erase_line; endloop; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly(line_begin & "EVE_", FORWARD); exitif (temp = 0); position(temp); erase(temp); endloop; position(beginning_of(current_buffer)); loop exitif (eveplus_replace(" EVE_", " ") = 0); endloop; position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly(" ", FORWARD); exitif (temp = 0); position(temp); erase(temp); split_line; endloop; position(beginning_of(current_buffer)); loop exitif (eveplus_replace("_", " ") = 0); endloop; !AER message("Sorting command list"); !AER execute('eveplus$$shell_sort ( current_buffer );'); eve$format_choices; set (status_line, info_window, reverse, " Eve commands -- DO will remove this list"); position(show_buffer); erase(show_buffer); copy_text(eve$choice_buffer); position(beginning_of(current_buffer)); set(screen_update, off); eve_go_to("eveplus_saved_buffer"); set(screen_update, on); map (info_window, show_buffer); message(" "); endprocedure; ! ! The 3 following procedures copies the current buffer to another buffer, ! translates control characters to readable characters and writes the ! new buffer. It then submits the file to the specified print que (default ! sys$print). The first two procedures are taken from this note file ! and modified a bit. The last procedure calls the other two and creates ! the subprocess/writes the file/prints the file. ! ! This procedure controls the outer loop search for the special ! control characters that we want to view ! procedure eve$search_controls (this_buffer) local control_char_pat, control_char, char_to_translate; ! When the search fails we know that we have either hit the end of ! the buffer or there were no more special characters found. on_error position (translate_buffer); return; endon_error; if get_info(translate_buffer,"type") = UNSPECIFIED then translate_buffer := create_buffer ('translation'); set (no_write, translate_buffer); endif; control_char_pat := any (''); position (translate_buffer); erase (translate_buffer); copy_text (this_buffer); ! Make a copy of the original buffer position (beginning_of (translate_buffer)); loop ! Find all occurrences control_char := search (control_char_pat, forward); position (control_char); char_to_translate := current_character; ! Save the character erase (control_char); ! then erase it ! The backwards questions mark is the placeholder for control characters ! from ASCII(0) thru ASCII(31) on the VT2xx series of terminals CASE char_to_translate FROM '' TO '' [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [''] : COPY_TEXT (''); [INRANGE, OUTRANGE] : COPY_TEXT (char); endcase; endloop; endprocedure; ! ! Procedure to print the current buffer. ! procedure eve_print local this_position, this_buffer, buffer_name, file_name, this_range, print_command, print_process; on_error if error = tpu$_createfail then message("Subprocess could not be created"); return; endif; endon_error; set(informational,off); set(success,off); this_position := mark(none); this_buffer := current_buffer; ! if text is selected, just print it... otherwise whole buffer if eve$x_select_position = 0 then eve$search_controls(this_buffer); ! Translate control characters. else this_range := select_range; if this_range = 0 then eve$x_select_position := 0; eve$search_controls(this_buffer); else eve$search_controls(this_range); eve$x_select_position := 0; endif; endif; ! Get the output file from the original buffer and use it to write the ! translated buffer. buffer_name := get_info(this_buffer,"name"); file_name := read_line (fao("Enter a file name to write buffer !AS or press RETURN to cancel: ", buffer_name)); if file_name = "" then set(informational,on); set(success,on); return; endif; if ( index(file_name,";") <> 0 ) then file_name := substr(file_name,1,index(file_name,";") - 1); endif; ! Set the output file on the original buffer. Consistent with eve_write_file. set(output_file,this_buffer,file_name); set(output_file,translate_buffer,file_name); write_file(translate_buffer); print_command := read_line("Print command: "); if print_command = "" then print_command := "PRINT"; endif; print_command := print_command + " "; message(fao("Printing !AS with command !AS",file_name,print_command)); print_process := create_process(message_buffer,"$set noon"); send(print_command + file_name, print_process); delete(print_process); set(informational,on); set(success,on); update(message_window); position(this_position); endprocedure; ! This routine translates a buffer name to a buffer pointer ! ! Inputs: ! buffer_name String containing the buffer name ! procedure eveplus_find_buffer(buffer_name) ! Find a buffer by name local the_buffer, ! Used to hold the buffer pointer the_name; ! A read/write copy of the name the_name := buffer_name; change_case(the_name, UPPER); the_buffer := get_info(buffers, "first"); loop exitif (the_buffer = 0); exitif (the_name = get_info(the_buffer, "name")); the_buffer := get_info(buffer, "next"); endloop; return the_buffer; endprocedure; procedure eveplus_key ! Redefine a key, saving old definition ( new_pgm, ! Valid 1st argument for define_key builtin default_key, ! Default keyname if user hasn't defined one new_doc, ! Valid 3rd argument for define_key builtin key_string ) ! String containing name for user defined keys ! 1) Determine if we have a user specified key; if not, use default. ! 2) Save the present definition & doc. of the user specified key. ! 3) Do a define key on the new key information. ! A note on methods: ! We use a string argument for the variable name of the user specified key ! so that: 1) We can successfully pass it to this procedure if its not defined. ! 2) We can generate variables to hold the old key's info, avoiding ! passing more arguments for these. ! We combine the string argument with string constants to form valid TPU ! statements which we then execute. (Ha! We TPU programmers can limp ! along without LISP very well thanks!) on_error endon_error; eveplus$x := default_key; ! default, to global variables; the variables eveplus$x_string := key_string; ! Move arguments, which are local by eveplus$x_old_pgm := 0; ! in and EXECUTE statement are all global. ! Determine if we have a user specified key; if not, use default. if expand_name ( eveplus$x_string, variables ) <> eve$x_null then execute ( 'if(get_info('+eveplus$x_string+',"type")=integer)then ' +'eveplus$x:='+eveplus$x_string+';' +'else ' +eveplus$x_string+':=eveplus$x;' +'endif;' ); else execute ( eveplus$x_string+ ':= eveplus$x;' ); endif; ! Save the present definition & doc. of the user specified key ! one exists. eveplus$x_old_pgm := lookup_key ( eveplus$x, program); if (get_info ( eveplus$x_old_pgm, "type") = program) then execute( eveplus$x_string +'_doc := lookup_key ( eveplus$x, comment);' +eveplus$x_string +'_pgm := lookup_key ( eveplus$x, program);'); else execute( eveplus$x_string +'_doc := "~none~";'); endif; ! Do a define key on the new key information define_key ( new_pgm, eveplus$x, new_doc ); endprocedure; procedure eveplus_restore_key ( the_key ) ! Restore a saved key definition. ! This is the companion procedure to EVEplus_key, and restores the previous ! definition of a key saved during EVEplus_key. See EVEplus_key for ! more info. on_error endon_error; eveplus$x_string := the_key; if expand_name ( eveplus$x_string+'_pgm', variables ) <> eve$x_null then execute ( 'define_key('+eveplus$x_string+'_pgm,' +eveplus$x_string+',' +eveplus$x_string+'_doc); '); else execute ( 'undefine_key ('+eveplus$x_string+'); '); endif; endprocedure; procedure eve_list_buffers ! List non-system buffers bufed_list_buffers(FALSE) endprocedure; procedure eve_list_all_buffers ! List system and non-system buffers bufed_list_buffers(TRUE) endprocedure; ! The following procedure actually creates the formatted buffer list. ! It also temporarily rebinds the SELECT and REMOVE keys to routines ! that goto the buffer listed on the line the cursor is on or to ! delete it. ! ! Inputs: ! show_system Flag - causes system buffers to be listed ! procedure bufed_list_buffers(show_system) ! Build the buffer list local last_buffer, ! Used to tell when we've done the last one the_buffer, ! The buffer being listed temp; ! Used to build the record count as a string eve_buffer("LIST BUFFER"); set(system, current_buffer); set(no_write, current_buffer); erase(current_buffer); message("Collecting buffer list"); last_buffer := get_info(buffers, "last"); the_buffer := get_info(buffers, "first"); loop exitif (the_buffer = 0); if (show_system or (get_info(the_buffer, "system") = 0)) then split_line; eveplus_insert_text(" "); eveplus_insert_text(get_info(the_buffer, "name")); temp := fao("!6UL ", get_info(the_buffer, "record_count")); if (current_offset >= 33) then eveplus_insert_text(""); else loop exitif (current_offset > 33); eveplus_insert_text(" "); endloop; endif; eveplus_insert_text(temp); if (get_info(the_buffer, "modified")) then eveplus_insert_text("Modified "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "no_write")) then eveplus_insert_text("No-write "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "system")) then eveplus_insert_text("System "); else eveplus_insert_text(" "); endif; if (get_info(the_buffer, "permanent")) then eveplus_insert_text("Permanent"); else eveplus_insert_text(" "); endif; temp := current_line; move_horizontal (-current_offset); erase (create_range (mark (none), end_of (current_buffer), none)); edit (temp, trim_trailing); copy_text (temp); endif; exitif (the_buffer = last_buffer); the_buffer := get_info(buffers, "next"); endloop; !AER message("Sorting buffer list"); !AER execute('eveplus$$shell_sort ( current_buffer ); '); position(beginning_of(current_buffer)); loop temp := eveplus_search_quietly("", FORWARD); exitif (temp = 0); position(temp); erase(temp); eveplus_insert_text(" -"); split_line; eveplus_insert_text(" "); endloop; position(beginning_of(current_buffer)); eveplus_insert_text(" Buffer name Lines Attributes"); split_line; position(beginning_of(current_buffer)); move_vertical(2); move_horizontal(2); if (not bufed_x_active) then set(informational,off); eveplus_key("bufed_select_buffer", period, "select buffer", "bufed_select_key"); eveplus_key("bufed_remove_buffer", kp6, "remove buffer", "bufed_remove_key"); set(informational,on); endif; bufed_x_active := TRUE; message(" "); endprocedure; ! This routine is temporarily bound to the REMOVE key. It deletes ! the buffer listed on the current line. It only works in the ! "LIST BUFFER" buffer. If it is struck outside of that buffer, ! it restores the original binding of the SELECT and REMOVE keys and ! and executes the program originally associated with the REMOVE key. ! The routine bufed_select_buffer also unbinds this key. ! procedure bufed_remove_buffer ! Delete the buffer pointed to local the_buffer, ! Pointer to the buffer the_name, ! Name of the buffer as a string the_type; ! Type of the code bound to the key if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); set(informational,off); eveplus_restore_key("bufed_select_key"); eveplus_restore_key("bufed_remove_key"); set(informational,on); bufed_x_active := FALSE; the_type := get_info(bufed_remove_key_pgm, "type"); if ((the_type = LEARN) or (the_type = PROGRAM) or (the_type = STRING)) then execute(bufed_remove_key_pgm); endif; else if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then if (bufed_destroy_buffer(the_name, the_buffer)) then move_horizontal(-current_offset); move_vertical(1); move_horizontal(-2); if (current_character = "-") then move_horizontal(-current_offset); erase_line; else move_horizontal(-current_offset); endif; erase_line; endif; endif; endif; endprocedure; ! This routine actually destroys a specific buffer. ! ! Inputs: ! the_name The name of the buffer (display only) ! the_buffer Pointer to the buffer to destroy ! procedure bufed_destroy_buffer(the_name, the_buffer) ! Delete a buffer local answer, problem, new_buffer; bufed_destroy_buffer := FALSE; problem := ""; if ((get_info(the_buffer, "modified")) and (get_info(the_buffer, "record_count") <> 0)) then problem := "modified "; endif; if (get_info(the_buffer, "system")) then problem := problem + "system "; endif; if (problem <> "") then answer := read_line(substr(the_name, 1, 32) + " is a " + problem + "buffer. Are you sure? "); change_case (answer, lower); if ((length (answer) = 0) or (answer <> substr ("yes", 1, length (answer)))) then message("No buffer deleted."); return; endif; endif; if (current_buffer <> the_buffer) then delete(the_buffer); else new_buffer := get_info(buffers, "first"); loop exitif (new_buffer = 0); exitif ((get_info(new_buffer, "system") = FALSE) and (new_buffer <> current_buffer)); new_buffer := get_info(BUFFERS, "next"); endloop; if (new_buffer = 0) then eve_buffer("Main"); else eve_buffer(get_info(new_buffer, "name")); endif; if (get_info (the_buffer, "name") = "MAIN") then erase (the_buffer); else delete (the_buffer); endif; endif; bufed_destroy_buffer := TRUE; message("Deleted buffer " + the_name); new_buffer := get_info(BUFFERS, "first"); endprocedure; ! This routine is temporarily bound to the SELECT. It puts you in ! the buffer listed on the current line, and restores the original ! meanings of the SELECT and REMOVE keys. It only works in the ! "LIST BUFFERS" buffer. If it is invoked outside of that buffer, ! it restores the original bindings of the SELECT and REMOVE keys, ! and executes the code originally associated with SELECT. ! procedure bufed_select_buffer ! Goto the buffer pointed to local the_buffer, ! Pointer to the buffer the_name, ! Name of the buffer as a string the_type; ! Type of the code bound to the key if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); set(informational,off); eveplus_restore_key("bufed_select_key"); eveplus_restore_key("bufed_remove_key"); set(informational,on); bufed_x_active := FALSE; the_type := get_info(bufed_select_key_pgm, "type"); if ((the_type = LEARN) or (the_type = PROGRAM) or (the_type = STRING)) then execute(bufed_select_key_pgm); endif; else if (bufed_get_the_buffer(the_name, the_buffer) <> 0) then eve_buffer(the_name); set(informational,off); eveplus_restore_key("bufed_select_key"); eveplus_restore_key("bufed_remove_key"); set(informational,on); bufed_x_active := FALSE; endif; endif; endprocedure; ! This routine scans the line the cursor is on and if it is in the ! proper format for a buffer listing, it reurns both the name of ! the buffer and a pointer to it. ! procedure bufed_get_the_buffer(the_name, the_buffer) ! Scan a buffer line local the_start; ! A mark pointing to the buffer name. the_name := ""; the_buffer := 0; if (get_info(current_buffer, "name") <> "LIST BUFFER") then message("Not in the LIST BUFFER"); else move_horizontal(-current_offset); if (search(ANCHOR & " ", FORWARD) = 0) then message("This is not a buffer listing"); else move_horizontal(2); the_start := mark(none); move_horizontal(-2); move_vertical(1); move_horizontal(-2); if (current_character = "-") then move_horizontal(-2); else move_horizontal(32-current_offset); endif; the_name := create_range(the_start, mark(none), bold); the_name := substr(the_name, 1, length(the_name)); edit(the_name, TRIM_TRAILING, OFF); the_buffer := eveplus_find_buffer(the_name); if (the_buffer = 0) then message("No such buffer: " + the_name); endif; move_horizontal(2-current_offset); endif; endif; bufed_get_the_buffer := the_buffer; endprocedure; procedure eveplus_set_mode(new_mode) ! This procedure returns the current mode for the current buffer ! and sets it to the value in NEW_MODE. eveplus_set_mode := get_info(current_buffer,"MODE"); set(new_mode, current_buffer); endprocedure; ! eveplus_set_mode procedure eveplus_advance_horizontal(eveplus_v_columns,eveplus_v_blank_chars) ! This procedure advances current_offset to be eveplus_v_columns from ! current_offset. eveplus_v_blanks_chars must be ! a string of blank chars of at least length eveplus_v_columns. local eveplus_v_save_offset, ! current_offset on entry to this procedure eveplus_v_eol_columns; ! Number of columns to [EOL] eveplus_v_save_offset := current_offset; if eveplus_v_columns <= 0 then move_horizontal(eveplus_v_columns); else ! Find out how far to [EOL]. eveplus_v_eol_columns := length(current_line)-current_offset; if eveplus_v_eol_columns >= eveplus_v_columns then move_horizontal(eveplus_v_columns); else move_horizontal(eveplus_v_eol_columns); copy_text(substr(eveplus_v_blank_chars,1, eveplus_v_columns-eveplus_v_save_offset)); endif; endif; endprocedure; ! eveplus_advance_horizontal procedure eve_search(the_arg) ! Wild-card search procedure local the_direction, the_target, my_key; my_key := last_key; ! How were we invoked? if (my_key = RET_KEY) then ! Was it SEARCH ? my_key := DO; endif; if (current_direction = FORWARD) then the_direction := 'Forward '; else the_direction := 'Reverse '; endif; the_target := the_arg; if (the_arg = '') then the_target := read_line(the_direction + 'wild-card search: '); endif; if (the_target = '') then if (last_key <> my_key) then return; endif; else if (build_pattern(the_target, the_target) = 1) then execute( 'eveplus_search_target := ' + the_target +';' ); else eveplus_search_target := the_target; endif; endif; eve_find(eveplus_search_target); endprocedure; ! Build a pattern for pattern searching. Pattern characters are: ! ! | - beginning of line ! » - end of line ! % - single-character wildcard ! * - multi-character wildcard, do not cross record boundaries ! # - multi-character wildcard, cross record boundaries ! \ - quote next character ! ^ - next char. is ctrl character ! ! BUILD_PATTERN takes a search string in INPUT_STRING and returns either ! a search string or a pattern string in RESULT_STRING. If RESULT_STRING ! is a search string, BUILD_PATTERN returns 0. If it is a pattern string, ! BUILD_PATTERN returns 1. procedure build_pattern( input_string, result_string ) LOCAL s1, s2, i, j, c, quote_next, ctrl_next, match_started, pat; s1 := ''; s2 := ''; i := 1; quote_next := 0; ctrl_next := 0; match_started := 0; pat := ''; ! Process each character in the input string LOOP EXITIF i > LENGTH(input_string); c := SUBSTR(input_string, i, 1); ! Do quoting if we're supposed to IF quote_next = 1 THEN IF c = "'" THEN s1 := s1 + "''" ELSE s1 := s1 + c ENDIF; s2 := s2 + c; i := i + 1; quote_next := 0 ELSE ! Do CTRL/n quoting if we're supposed to IF ctrl_next = 1 THEN CHANGE_CASE(c, UPPER); c := ASCII(INDEX("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[8901", c) - 1); s1 := s1 + c; s2 := s2 + c; i := i + 1; ctrl_next := 0 ELSE ! A normal character or wildcard CASE c FROM '' TO 'ÿ' ['\']: !+ ! quote next character !- quote_next := 1; i := i + 1; ['^']: !+ ! CTRL next character !- ctrl_next := 1; i := i + 1; ['|']: !+ ! Begin-of-line !- IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& LINE_BEGIN"; i := i + 1; ['»']: ! End-of-line IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& LINE_END"; i := i + 1; ['#']: ! General match, crossing record boundaries. ! ! Start by eating all following wildcards. IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; LOOP EXITIF i > LENGTH(input_string); EXITIF INDEX('«»*#%', SUBSTR(input_string, i, 1)) = 0; i := i + 1 ENDLOOP; ! Ignore the wildcard if at end-of-pattern string IF i <= LENGTH(input_string) THEN ! Get the stop character (which may be quoted) CASE SUBSTR(input_string, i, 1) FROM '' TO 'ÿ' ['\']: IF i = LENGTH(input_string) THEN c := ASCII(0) ELSE c := SUBSTR(input_string, i+1, 1) ENDIF; ['^']: IF i = LENGTH(input_string) THEN c := ASCII(0) ELSE c := SUBSTR(input_string, i+1, 1); CHANGE_CASE(c, UPPER); c := ASCII(INDEX("@ABCDEFGHIJKLMNOPQRSTUVWXYZ[8901", c) - 1) ENDIF; [INRANGE]: c := SUBSTR(input_string, i, 1) ENDCASE; ! Double it if apostrophe IF c = "'" THEN c := "''" ENDIF; ! Put it in the pattern IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& SCANL('" + c + "')" ENDIF; ['*']: ! General wildcard, not crossing record boundaries ! ! Eat following * and % IF match_started THEN pat := pat + "')"; match_started := 0 ENDIF; LOOP EXITIF i > LENGTH(input_string); EXITIF INDEX('*%', SUBSTR(input_string, i, 1)) = 0; i := i + 1 ENDLOOP; ! Use REMAIN if at end of input_string IF i > LENGTH(input_string) THEN IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& REMAIN" ELSE ! Ignore * if followed by # IF SUBSTR(input_string, i, 1) <> "#" THEN IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; ! Use REMAIN if « or » follows IF (SUBSTR(input_string, i, 1) = "«") OR (SUBSTR(input_string, i, 1) = "»") THEN pat := pat + "& REMAIN" ELSE ! Use the MATCH built-in. We will accumulate ! MATCH characters until another special marker ! is encountered. pat := pat + "& MATCH('"; match_started := 1 ENDIF ENDIF ENDIF; ['%']: ! Single-character wildcard. ! ! Start by counting consecutive %s j := 0; LOOP EXITIF i > LENGTH(input_string); EXITIF SUBSTR(input_string, i, 1) <> "%"; i := i + 1; j := j + 1 ENDLOOP; ! Put it in the pattern IF LENGTH(s1) > 0 THEN pat := pat + "& '" + s1 + "'"; s1 := '' ENDIF; pat := pat + "& ARB(" + STR(j) + ")"; ["'"]: ! Apostrophes must be doubled in STR1 s1 := s1 + "''"; s2 := s2 + "'"; i := i + 1; [INRANGE]: ! Just an ordinary character s1 := s1 + c; s2 := s2 + c; i := i + 1; ENDCASE ENDIF ENDIF ENDLOOP; ! Empty out STR1 IF (LENGTH(s1) > 0) AND (LENGTH(pat) > 0) THEN IF match_started THEN pat := pat + s1 + "')" ELSE pat := pat + "& '" + s1 + "'" ENDIF ENDIF; ! Return either a string or a pattern string IF LENGTH(pat) > 0 THEN result_string := SUBSTR(pat, 3, LENGTH(pat) - 2); RETURN 1 ELSE result_string := s2; RETURN 0 ENDIF endprocedure; procedure tpu$local_init ! BufEd init procedures. bufed_x_active := FALSE; bufed_select_key_pgm := compile("message('Key not defined');"); bufed_remove_key_pgm := compile("message('Key not defined');"); eve$arg1_destroy_buffer := eve$arg1_buffer; eveplus_v_begin_select := 0; eveplus_rectangular := false; eve$arg1_search := eve$arg1_buffer; eveplus_search_target := ''; eve$arg1_sort_buffer := eve$arg1_buffer; endprocedure; ! ! Rectangular CUT/PASTE provides a way to select a corner of a rectangular ! region on the screen that is to be CUT. This select point is highlighted ! in reverse video. The cursor can then be positioned to the opposite ! corner of the box at which point the CUT can be done to place the rectangular ! region in paste_buffer. PASTE can then be done to overstrike the ! rectangular region in paste_buffer onto the current_buffer using the ! current position as the upper left corner for the pasted region. Note ! that no provision is made if there are TAB chars in the current buffer. ! Also, no provision is made if the cut or paste is done with part of the ! region to be cut or pasted over not being visible on the screen. ! ! These procedures can be run with the current buffer set to overstrike ! or insert mode - CUT/PASTE need to switch to insert mode temporarily ! to get the chars replaced properly, but the previous mode setting for ! the current buffer is restored when either the cut or paste routine completes. ! ! GLOBAL VARIABLES created/used ! eveplus_v_begin_select - position where selected region begins ! ! GLOBAL VARIABLES used ! current_buffer ! paste_buffer ! ! This TPU file rebinds the SELECT/REMOVE/INSERT HERE keys to the included ! routines and initializes the eveplus_v_begin_select variable when the ! eve_set_rectangular procedure is executed. The standard Eve key bindings ! are restored when the eve_set_norectangular procedure is executed. ! ! Procedure to calculate the current column from the current offset, treating ! TAB characters as up to 8 blanks. !- procedure edd_current_column LOCAL i, line, col; line := current_line; IF INDEX(line,ASCII(9)) = 0 THEN edd_current_column := current_offset ELSE i := 1; col := 0; LOOP EXITIF i > current_offset; IF SUBSTR(line,i,1) = ASCII(9) THEN col := ((col + 8)/8)*8 ELSE col := col + 1 ENDIF; i := i + 1 ENDLOOP; edd_current_column := col ENDIF endprocedure; !+ ! Procedure to replace TAB characters by the appropriate number of ! blanks on the current line, then pad the line out to a given length, if it ! is shorter. The routine assumes overstrike mode is in ! effect. It leave the current position at the beginning of the line. !- procedure edd_replace_tabs_with_blanks_and_pad(target_length) LOCAL i, col, cur_length, new_line, eight_blanks; !+ ! Make sure we're not on the EOB marker. !- IF MARK(NONE) <> END_OF(CURRENT_BUFFER) THEN IF INDEX(CURRENT_LINE, ASCII(9)) <> 0 THEN new_line := ''; eight_blanks := " "; i := 1; col := 0; LOOP EXITIF i > LENGTH(CURRENT_LINE); IF SUBSTR(CURRENT_LINE,i,1) = ASCII(9) THEN col := ((col + 8)/8)*8; new_line := new_line + SUBSTR(eight_blanks,1,col-LENGTH(new_line)) ELSE new_line := new_line + SUBSTR(CURRENT_LINE,i,1); col := col + 1 ENDIF; i := i + 1 ENDLOOP; MOVE_HORIZONTAL(-CURRENT_OFFSET); COPY_TEXT(new_line) ENDIF ENDIF; MOVE_HORIZONTAL(-CURRENT_OFFSET); !+ ! Now pad out the line if we have to !- IF MARK(NONE) = END_OF(CURRENT_BUFFER) THEN cur_length := 0 ELSE cur_length := LENGTH(CURRENT_LINE) ENDIF; IF cur_length < target_length THEN MOVE_HORIZONTAL(cur_length); COPY_TEXT(eveplus_blank_chars(target_length - cur_length)); ENDIF; MOVE_HORIZONTAL(-CURRENT_OFFSET) endprocedure; procedure eve_draw_box LOCAL saved_mode, end_column, start_column, temp, end_select, top_bottom_text; if not eveplus_rectangular then message("DRAW BOX only works in RECTANGULAR mode"); return; endif; ! Check for no select active IF eveplus_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN ENDIF; ! Set INSERT mode saved_mode := eveplus_set_mode(INSERT); ! Make sure there is a character at the corner of the box opposite ! the begin_select mark. If the end_select mark is before the ! begin_select mark, juggle the markers so that begin_select precedes ! end_select. eveplus_pad_blank; IF MARK(NONE) >= eveplus_v_begin_select THEN end_select := MARK(NONE) ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); POSITION(end_select) ENDIF; ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. end_column := edd_current_column; POSITION(eveplus_v_begin_select); eveplus_v_begin_select := MARK(NONE); start_column := edd_current_column; ! We may have the upper right and lower left corners of the box ! selected. If so, START_COLUMN and END_COLUMN need to be reversed. IF start_column > end_column THEN temp := end_column; end_column := start_column; start_column := temp ENDIF; ! We may be building the box on the first line of the buffer. In ! that case, we must put a new top line in the buffer. MOVE_HORIZONTAL(-CURRENT_OFFSET); IF MARK(NONE) = BEGINNING_OF(CURRENT_BUFFER) THEN SPLIT_LINE; POSITION(BEGINNING_OF(CURRENT_BUFFER)); COPY_TEXT(eveplus_blank_chars(start_column)); MOVE_VERTICAL(1); MOVE_HORIZONTAL(-CURRENT_OFFSET) ENDIF; ! Move back one line and put in the top line of the box top_bottom_text := '+' + eveplus_blank_chars(end_column-start_column+1) + '+'; TRANSLATE(top_bottom_text, "-", " "); SET(OVERSTRIKE, current_buffer); MOVE_VERTICAL(-1); ! Replace all TABs with blanks on this line and pad it, if we need to. edd_replace_tabs_with_blanks_and_pad(end_column + 1); IF start_column <> 0 THEN MOVE_HORIZONTAL(start_column - 1) ENDIF; COPY_TEXT(top_bottom_text); MOVE_VERTICAL(1); MOVE_HORIZONTAL(-CURRENT_OFFSET); ! Step through the selected lines, putting vertical bars on either side ! of the selected text. LOOP EXITIF MARK(NONE) > end_select; ! Replace all TABs with blanks on this line, if we need to. edd_replace_tabs_with_blanks_and_pad(end_column + 1); ! If START_COLUMN is zero, we must insert a vertical bar to do the ! left column, then put the right vertical bar one column farther out ! than normal. IF start_column = 0 THEN SET(INSERT, CURRENT_BUFFER); COPY_TEXT("|"); SET(OVERSTRIKE, CURRENT_BUFFER); MOVE_HORIZONTAL(end_column + 1); ELSE MOVE_HORIZONTAL(start_column-1); COPY_TEXT("|"); MOVE_HORIZONTAL(end_column - CURRENT_OFFSET + 1) ENDIF; COPY_TEXT("|"); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_VERTICAL(1) ENDLOOP; ! Now put in the bottom line of the box. ! ! Replace all TABs with blanks on this line, if we need to. edd_replace_tabs_with_blanks_and_pad(end_column + 1); IF start_column <> 0 THEN MOVE_HORIZONTAL(start_column - 1) ENDIF; COPY_TEXT(top_bottom_text); ! Position to the beginning of the cut area, reset BEGIN_SELECT, ! restore old insert/overstrike setting POSITION(eveplus_v_begin_select); eveplus_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); IF start_column = 0 THEN MOVE_HORIZONTAL(1) ELSE MOVE_HORIZONTAL(start_column) ENDIF; SET(saved_mode, CURRENT_BUFFER) endprocedure; PROCEDURE eve_rectangular_remove LOCAL end_select, end_column, start_column, temp, temp_mode, pad_chars, save_position, blank_chars, cut_text; ! Check for no select active IF eveplus_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN ENDIF; ERASE(paste_buffer); ! Make sure there is a character at the corner of the box opposite ! the begin_select mark. If the end_select mark is before the ! begin_select mark, juggle the markers so that begin_select precedes ! end_select. eveplus_pad_blank; IF MARK(NONE) >= eveplus_v_begin_select THEN end_select := MARK(NONE) ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); POSITION(end_select) ENDIF; ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. end_column := edd_current_column; POSITION(eveplus_v_begin_select); eveplus_v_begin_select := MARK(NONE); start_column := edd_current_column; ! We may have the upper right and lower left corners of the box ! selected. If so, START_COLUMN and END_COLUMN need to be reversed. IF start_column > end_column THEN temp := end_column; end_column := start_column; start_column := temp ENDIF; ! Get a string of the appropriate number of blanks to paste back in pad_chars := eveplus_blank_chars(end_column - start_column + 1); ! Step through the selected lines, copying the text to the paste buffer ! and replacing it with blanks as we go. Replace all TABs with blanks ! before we look at it so we get the columns straight. MOVE_HORIZONTAL(-current_offset); LOOP EXITIF MARK(NONE) > end_select; ! Replace all TABs with blanks on this line, if we need to. edd_replace_tabs_with_blanks_and_pad(end_column + 1); temp_mode := get_info(current_buffer,"mode"); MOVE_HORIZONTAL(start_column); if temp_mode = overstrike then ! Obtain the text we're cutting cut_text := SUBSTR(CURRENT_LINE, start_column + 1, end_column - start_column + 1); ! Replace the text with blanks COPY_TEXT(pad_chars); else cut_text := erase_character (end_column - start_column + 1); endif; ! Copy the text to the paste buffer save_position := MARK(NONE); POSITION(paste_buffer); COPY_TEXT(cut_text); MOVE_HORIZONTAL(1); ! Reposition to the other buffer and move to the next line POSITION(save_position); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_VERTICAL(1) ENDLOOP; ! Position to the beginning of the cut area, reset BEGIN_SELECT POSITION(eveplus_v_begin_select); eveplus_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); endprocedure; PROCEDURE eve_rectangular_insert_here ! This procedure pastes the rectangular region in the paste buffer ! using the current position in the current buffer as the upper left corner. LOCAL save_position, start_column, paste_line, save_buffer; save_buffer := CURRENT_BUFFER; save_position := MARK(NONE); start_column := edd_current_column; POSITION(BEGINNING_OF(paste_buffer)); IF MARK(NONE) = END_OF(paste_buffer) THEN MESSAGE("Paste buffer is empty"); position(save_buffer); RETURN ENDIF; ! Loop through lines in the paste buffer, putting them at the ! appropriate offset in the current buffer. LOOP EXITIF MARK(NONE) = END_OF(paste_buffer); ! Get the current line of the paste buffer. paste_line := CURRENT_LINE; MOVE_VERTICAL(1); ! Convert tabs to blanks on the line in the current buffer. POSITION(save_buffer); edd_replace_tabs_with_blanks_and_pad(start_column+1); ! Position at the correct offset and overwrite the text there. MOVE_HORIZONTAL(start_column); COPY_TEXT(paste_line); MOVE_VERTICAL(1); POSITION(paste_buffer) ENDLOOP; ! Position to start of pasted text and restore old mode setting. POSITION(save_position); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); endprocedure; procedure eve_rectangular_select if eveplus_v_begin_select = 0 then eveplus_pad_blank; eveplus_v_begin_select := mark(REVERSE); message("Selection started. Press Remove when finished."); else eveplus_v_begin_select := 0; message("Selection cancelled"); endif; endprocedure; ! eve_rectangular_select procedure eveplus_pad_blank ! This procedure drops a space at the current position if the current ! character is null so that any mark will be for an existing character. ! In EDD, we really want a mark in a particular screen column. In TPU, ! an EOL mark would move if the line were extended. Also in EDD, we ! want to highlight the select point so we need a character there. ! The cursor is returned to its original position after the space is ! copied to the current position in the current buffer. IF MARK(NONE) = END_OF(CURRENT_BUFFER) THEN copy_text(" "); move_horizontal(-1) ELSE if current_character = "" then copy_text(" "); move_horizontal(-1); endif ENDIF endprocedure; ! eveplus_pad_blank procedure eve_rectangular !FRED - not a valid command for FRED editing if eve$in_fred then eve_not_adam ("RECTANGULAR"); return; endif; if eveplus_rectangular then eveplus_v_begin_select := 0; define_key("eve_remove", kp6, "remove"); define_key("eve_remove", e3, "remove"); define_key("eve_insert_here", kp3, "insert_here"); define_key("eve_insert_here", e2, "insert_here"); define_key("eve_select", period, "select"); define_key("eve_select", e4, "select"); eveplus_rectangular := false; eve$rect_string := " "; else if eve$x_select_position <> 0 then ! LEJ this_position := mark(none); position (eve$x_select_position); eve$x_select_position := 0; eveplus_v_begin_select := mark(reverse); position (this_position); else eveplus_v_begin_select := 0; endif; define_key("eve_rectangular_remove", kp6, "edd_remove"); define_key("eve_rectangular_remove", e3, "edd_remove"); define_key("eve_rectangular_insert_here", kp3, "edd_insert_here"); define_key("eve_rectangular_insert_here", e2, "edd_insert_here"); define_key("eve_rectangular_select", period, "edd_select"); define_key("eve_rectangular_select", e4, "edd_select"); eveplus_rectangular := true; eve$rect_string := "Rectang"; endif; eve$update_status_lines; endprocedure; procedure eveplus_blank_chars(eveplus_v_blank_count) ! This procedure returns a string of eveplus_v_blank_count blank chars. local eveplus_v_blank_chars, eveplus_v_oldlen, eveplus_v_blanks_so_far; ! Length of blank char string so far IF eveplus_v_blank_count = 0 THEN RETURN "" ENDIF; eveplus_v_blank_chars := " "; eveplus_v_blanks_so_far := 1; loop exitif eveplus_v_blanks_so_far >= eveplus_v_blank_count; eveplus_v_oldlen := LENGTH(eveplus_v_blank_chars); eveplus_v_blank_chars := eveplus_v_blank_chars + eveplus_v_blank_chars; eveplus_v_blanks_so_far := eveplus_v_blanks_so_far + eveplus_v_oldlen; endloop; IF eveplus_v_blanks_so_far > eveplus_v_blank_count THEN eveplus_v_blank_chars := SUBSTR(eveplus_v_blank_chars,1,eveplus_v_blank_count) ENDIF; RETURN eveplus_v_blank_chars endprocedure; ! eveplus_blank_chars ! --- MODIFIED EVE PROCEDURES - CHANGES ONLY procedure eve$init_variables ! New global constants, variables and argument types eve$kt_version := "ADAM Version III.11"; !AER 24 mar 1986 eve$rect_string := " "; !AER eve$kt_comment_characters := "CcDd!$*"; ! FRED eve$in_fred := 0; !FRED - True if in FORTRAN editing mode eve$space_tabs := 0; !LEJ - If true, tabs to insert spaces eve$arg1_function := eve$arg1_buffer; !FRED eve$arg1_is_blank_line := eve$arg1_line; !FRED eve$arg1_get_number_to_indent := eve$arg1_line; !FRED eve$arg1_loop := eve$arg1_buffer; !FRED eve$arg1_program := eve$arg1_buffer; !FRED !AER eve$arg1_sort_buffer := eve$arg1_buffer; !AER --- for help command only eve$arg1_subprogram := eve$arg1_buffer; !FRED eve$arg2_subprogram := eve$arg1_buffer; eve$arg1_subroutine := eve$arg1_buffer; !FRED procedure eve$append_line ! CODE THAT DOES CHECKING FOR A BLANK LINE WAS REMOVED ! AND PUT INTO A NEW PROCEDURE "EVE$IS_BLANK_LINE" eve$is_blank_line(1); procedure eve$set_status_line (this_window) local which_editor !FRED ! Status line modified to show which editor (ADAM or FRED) ! and to include a space for rectangular mode. if eve$in_fred then which_editor := "Fred"; else which_editor := "Adam"; endif; set (status_line, this_window, reverse, " Buffer " + buffer_name + " " + eve$rect_string + " " + mode_string + " " + direction_string + " " + which_editor); procedure eve$find (target, replacing) ! CODE PERTAINING TO CASE SENSITIVITY WAS DELETED procedure eve_help (first_topic) ! Help for TOOLS library of routines MERLIB included else if (lowercase_topic = "merlib") then !FRED this_topic := "adam merlib"; procedure eve$help_keypad ! FRED and ADAM graphic keypads included SET (TEXT, info_window, NO_TRANSLATE); !AER *** for graphic keypad if eve$in_fred then eve$help_text ("fredkey"); !FRED else eve$help_text ("adamkey"); !AER endif; eve$help_text ("adamkey"); !AER eve$help_text ("adam " + which_topic); !AER 14 feb 86 SET (TEXT, info_window, BLANK_TABS); !AER *** for graphic keypad ! ALL REFERENCES TO THE VT100 AND VT200 KEYPADS WERE DELETED. procedure eve$fill_line (insert_space) local char_in_col_one; ! FRED ! For FRED editor, procedure wraps and either inserts a comment character in ! column 1, or a continuation character in column 6. if eve$in_fred then move_vertical(-1); char_in_col_one := current_character; move_vertical(1); if index(eve$kt_comment_characters,char_in_col_one) > 0 then copy_text(char_in_col_one+" "); else copy_text(" $ "); endif; endif; procedure eve_center_line !FRED - not a valid command for FRED mode editing if eve$in_fred then eve_not_adam ('CENTER'); return; endif; ! CODE THAT RESETS RIGHT MARGIN WAS DELETED. procedure eve_tab local next_tab, !FRED next_tab_stop, where_tabs_are !LEJ ! For FRED editor, tabs insert spaces. First tab at column 7, the rest ! every 3 columns thereafter. if eve$in_fred then counter := current_column; if current_column < 7 then next_tab := 7; else next_tab_stop := (current_column - 7) / 3 + 1; next_tab := 3 * next_tab_stop + 7; endif; loop eve_space; counter := counter + 1; exitif counter = next_tab; endloop; else ! Tabs may also insert spaces for SET TABS EVERY command if eve$space_tabs then where_tabs_are := get_info (current_buffer, "tab_stops"); if get_info (where_tabs_are, eve$kt_type) = integer then this_range := 1; found := false; loop if ((this_range-1) * where_tabs_are + 1 <= current_column) and (current_column <= this_range * where_tabs_are) then found := true; else this_range := this_range + 1; endif; exitif found; endloop; tab_to_column := this_range * where_tabs_are + 1; how_many_spaces := tab_to_column - current_column; counter := 0; loop eve_space; counter := counter + 1; exitif counter = how_many_spaces; endloop; else message ("Tabs At not available for inserting spaces"); endif; procedure eve_replace (replace_parameter_1, replace_parameter_2) ! CODE PERTAINING TO CASE SENSITIVITY WAS DELETED. procedure eve_get_file (get_file_parameter) !FRED - default to .FOR file type if no type entered if eve$in_fred then if index(get_file_name,".") = 0 then get_file_name := get_file_name + ".FOR"; endif; endif; procedure eve_include_file (include_file_parameter) !FRED - default file type is .FOR if eve$in_fred then if index(include_file_name,".") = 0 then include_file_name := include_file_name + ".FOR"; endif; endif; procedure eve$show_buffer_info (this_buffer, this_window) if eve$in_fred then copy_text (" Tab stops at columns 7 and every three columns thereafter"); ! Show TAB mode if eve$space_tabs then copy_text (" Tab inserts spaces"); else copy_text (" Tab inserts tabs"); endif; procedure eve$init_files local length_of_name, !FRED ! Default filetype for FRED editor is .FOR if eve$in_fred then if index(input_file,".") = 0 then input_file := input_file + ".FOR"; endif; else ! If filetype is .FOR, switch to FRED editor length_of_name := length(input_file); last_four_char := substr (input_file, length_of_name-3, 4); if (last_four_char = '.for') or (last_four_char = '.FOR') then eve_fred; endif; endif; procedure eve$init_procedure ! If editor invoked with "FRED" switch to FRED editor if call_user(1,"") = "FRED" then eve_fred; endif; procedure eve_erase_line eve$x_restoring_line := 0; !AER 14 jan 86 ! CODE FOR APPENDING NEXT LINE DELETED. procedure eve_start_of_line local offset; !AER offset := get_info (current_buffer, eve$kt_left_margin) - current_offset - 1; !AER if offset > -1 then !AER move_horizontal (offset); !AER procedure eve_erase_start_of_line !AER - erase only to left margin erase_length := erase_length - get_info (current_buffer, eve$kt_left_margin) +1; if erase_length > 0 then eve$x_restore_text := erase_character (- erase_length); eve$x_restoring_line := 0; endif; procedure eve$standard_keys ! ADAM keypad is different from EVE define_key ("eve_help('keypad')", pf2, " help", eve$x_vt100_keys); define_key ("eve_find('')", pf3, " find", eve$x_vt100_keys); define_key ("eve_do('')", pf4, " do", eve$x_vt100_keys); define_key ("eve_previous_screen", kp7, " previous_screen", eve$x_vt100_keys); define_key ("eve_next_screen", kp8, " next_screen", eve$x_vt100_keys); define_key ("eve_erase_whole_line", kp9, " erase_whole_line", eve$x_vt100_keys); define_key ("eve_erase_start_word", minus, " erase_start_word", eve$x_vt100_keys); define_key ("eve_top", kp4, " top", eve$x_vt100_keys); define_key ("eve_bottom", kp5, " bottom", eve$x_vt100_keys); define_key ("eve_remove", kp6, " remove", eve$x_vt100_keys); define_key ("eve_erase_character", comma, " erase_character", eve$x_vt100_keys); define_key ("eve_move_by_word", kp1, " move_by_word", eve$x_vt100_keys); define_key ("eve_move_by_line", kp2, " move_by_line", eve$x_vt100_keys); define_key ("eve_insert_here", kp3, " insert_here", eve$x_vt100_keys); define_key ("eve_restore", kp0, " restore", eve$x_vt100_keys); define_key ("eve_select", period, " select", eve$x_vt100_keys); define_key ("eve_return", enter, " return", eve$x_vt100_keys); !AER GOLD keys define_key ("eve_help('keypad')", key_name( pf2, shift_key), " help", eve$x_vt100_keys); define_key ("eve_center_line", key_name( pf3, shift_key), " center_line", eve$x_vt100_keys); define_key ("eve_print", key_name( pf4, shift_key), " print", eve$x_vt100_keys); define_key ("eve_change_mode", key_name( kp7, shift_key), " change_mode", eve$x_vt100_keys); define_key ("eve_change_direction", key_name( kp8, shift_key), " change_direction", eve$x_vt100_keys); define_key ("eve_erase_line", key_name( kp9, shift_key), " erase_line", eve$x_vt100_keys); define_key ("eve_erase_word", key_name( minus, shift_key), " erase_word", eve$x_vt100_keys); define_key ("eve_two_windows", key_name( kp4, shift_key), " two_windows", eve$x_vt100_keys); define_key ("eve_other_window", key_name( kp5, shift_key), " other_window", eve$x_vt100_keys); define_key ("eve_one_window", key_name( kp6, shift_key), " one_window", eve$x_vt100_keys); define_key ("eve_list_buffers", key_name( comma, shift_key), " list_buffers", eve$x_vt100_keys); define_key ("eve_uppercase_word", key_name( kp1, shift_key), " uppercase_word", eve$x_vt100_keys); define_key ("eve_lowercase_word", key_name( kp2, shift_key), " lowercase_word", eve$x_vt100_keys); define_key ("eve_rectangular", key_name( kp3, shift_key), " rectangular", eve$x_vt100_keys); define_key ("eve_fill_paragraph", key_name( kp0, shift_key), " fill_paragraph", eve$x_vt100_keys); define_key ("eve_append", key_name( period, shift_key), " append", eve$x_vt100_keys); define_key ("eve_show", key_name( enter, shift_key), " show", eve$x_vt100_keys); define_key ("eve_lf", ctrl_j_key, " lf", eve$x_standard_keys); define_key ("eve_ff", ctrl_l_key, " ff", eve$x_standard_keys); ! DEFINITIONS OF VT100 AND VT200 NUMERIC KEYPADS DELETED - ADAM HAS ONE KEYPAD FOR BOTH. procedure eve_fill_paragraph ! Procedure modified to fill highlighted text !FRED - not a valid command for FRED mode if eve$in_fred then eve_not_adam ("FILL"); return; endif; if eve$x_select_position = 0 then !AER !AER fill entire paragraph !AER else !AER 22 jan 86 ! ! FILL SELECTED TEXT ! if get_info(eve$x_select_position,"buffer") <> current_buffer then message("Can only fill selected text in the same buffer."); else fill_range := select_range; if fill_range = 0 then message("No text selected to fill."); eve$x_select_position := 0; else fill (fill_range, eve$x_word_separators); position (this_position); eve$x_select_position := 0; eve$show_first_line; endif; endif; endif; !AER procedure eve_lowercase_word ! Procedure modified to operate on highlighted text if eve$x_select_position = 0 then !AER word_range := eve$current_word; !AER else !AER word_range := select_range; !AER endif; !AER if eve$x_select_position <> 0 then !AER eve$x_select_position := 0; !AER endif; !AER procedure eve_uppercase_word ! Modified as in eve_lowercase_word procedure eve_write_file (write_file_name) ! Modified to write highlighted text local temp_file_name, !AER temporary dynamic string !AER !AER if text is selected, only write that text !AER if eve$x_select_position = 0 then else temp_file_name := write_file_name; if temp_file_name = eve$kt_null then if not (eve$prompt_string("",temp_file_name, "File to write: ","No file specified")) then return; endif endif; write_result := write_file (select_range, temp_file_name); eve$x_select_position := 0; endif; !AER