! ! The following code was added 860704 -- RHS ! ! User defined procedures follow ! These include tab settings, changing, & more as listed below... ! ! PROCEDURE EVE_APPEND (PCE_FILE_TO_APPEND)! added 870806 ! PROCEDURE EVE_CUT_LEADING ! added 880330 ! PROCEDURE EVE_DIRECTORY (PCE_DIR_STRING) ! added 870806 ! PROCEDURE EVE_INSERT_DATE ! added 880203 ! PROCEDURE EVE_INSERT_TIME ! added 880203 ! PROCEDURE EVE_MAIL ! added 870810 ! PROCEDURE EVE_NUMBER_LINES ! added 870811 ! PROCEDURE EVE_PERFORM(CMD_FILE) ! added 880120 ! PROCEDURE EVE_PHONE ! added 870810 ! PROCEDURE EVE_SET_AUTO_INDENT ! added 870812 ! PROCEDURE EVE_SET_NOAUTO_INDENT ! added 870812 ! PROCEDURE EVE_TEST_COMPILE ! added 870814 ! PROCEDURE EVE_UNDERLINE_THIS_LINE ! added 880203 ! PROCEDURE EVE_UNNUMBER_LINES ! added 870811 ! PROCEDURE EVE_WHICH_COLUMN ! added 871002 ! ! PROCEDURE PCE$STANDARD_KEYS ! PROCEDURE PCE$VT100_KEYS ! PROCEDURE PCE$VT200_KEYS ! PROCEDURE PCE$POSITION_IN_MIDDLE ! added 880204 ! PROCEDURE PCE_AUTO_SHIFT_LEFT ! added 880301 ! PROCEDURE PCE_AUTO_SHIFT_RIGHT ! added 880301 ! PROCEDURE PCE_BUFFER(BUF_PARM) ! added 880208 ! PROCEDURE PCE_CAPITALIZE_WORD ! PROCEDURE PCE_CC_LINE ! PROCEDURE PCE_CC_RANGE ! PROCEDURE PCE_CENTER_LINE ! PROCEDURE PCE_CHANGE_CASE ! PROCEDURE PCE_CHANGE_SCROLLING ! PROCEDURE PCE_CHANGE_WIDTH ! PROCEDURE PCE_COLUMN_XCHANGE ! PROCEDURE PCE_COLUMN_XCHG(STRING1, STRING2) ! PROCEDURE PCE_DCL_WINDOW ! PROCEDURE PCE_DELETE_CHARACTER ! PROCEDURE PCE_DELETE_LINE ! PROCEDURE PCE_ERASE_BOL ! PROCEDURE PCE_ERASE_EOL ! PROCEDURE PCE_ERASE_TO_END_OF_BUFFER ! PROCEDURE PCE_ERASE_TO_START_OF_BUFFER ! PROCEDURE PCE_EXEC_CMD_FILE (FILE) ! added 870803 ! PROCEDURE PCE_GKI ! deleted 870805 ! PROCEDURE PCE_GOTO_LINE_NUMBER(PCE_LINE_NUMBER) ! repl. 870806 (EVE_LINE) ! PROCEDURE PCE_HELP (TOPIC) ! PROCEDURE PCE_INDENT_LINE ! added 870812 ! PROCEDURE PCE_INITILIZE ! added 870803 ! PROCEDURE PCE_INIT_TRANSLATE ! deleted 880316 ! PROCEDURE PCE_INSERT_PAGE_MARKS ! added 870803 ! PROCEDURE PCE_KEY_MAP_EXISTS (KEY_MAP) ! added 880331 ! PROCEDURE PCE_MOVE_BY_LINE ! PROCEDURE PCE_NEXT_SCREEN (THIS_DIRECTION) ! added 870804 ! PROCEDURE PCE_ONE_WINDOW ! modified 870805 ! PROCEDURE PCE_OTHER_WINDOW ! added 870805 ! PROCEDURE PCE_PAGE ! added 870803 ! PROCEDURE PCE_PREV_BUF ! added 880208 ! PROCEDURE PCE_RECORD_LENGTH ! PROCEDURE PCE_REG_WINDOW ! deleted 870806 ! PROCEDURE PCE_REMOVE_PAGE_MARKS ! added 870803 ! PROCEDURE PCE_SET_WC(VALUE1, VALUE2) ! PROCEDURE PCE_SHOW_COLUMNS ! PROCEDURE PCE_SWITCH_EDITORS ! added 880318 ! PROCEDURE PCE_TOGGLE_AUTO_SHIFT_MODE ! added 880318 ! PROCEDURE PCE_TOGGLE_BETWN_BUFRS ! repl by PCE_OTHER_WINDOW 870805 ! PROCEDURE PCE_TRANSLATE_CONTROLS (CHAR) ! deleted 880316 ! PROCEDURE PCE_TWO_FILES(NEW_BUFFER_NAME) ! repl by PCE_TWO_WINDOWS 870805 ! PROCEDURE PCE_TWO_WINDOWS(NEW_WINDOW) ! added 870805 ! PROCEDURE PCE_TYPE_ALL(SEARCH_STRING) ! moved to TYPE_ALL.TPU 880203 ! PROCEDURE PCE_UNDELETE_LAST_ITEM_DELETED ! PROCEDURE PCE_VIEW_CONTROLS (BUF_NAME) ! PROCEDURE PCE_WIDE_WINDOW ! deleted 870806 ! PROCEDURE USER$TAB_CONVERSION ! modified 880121 ! ! EVEPlus Procedures ! ! PROCEDURE EVE_WHAT_LINE ! ! ! Spell Checking Procedures ! ! PROCEDURE LOAD_DICTIONARIES ! ! PROCEDURE SPELL_CHECK_RANGE (SPELL_RANGE)! ! PROCEDURE CHECK_FOR_PARAGRAPH_BREAK ! ! PROCEDURE EVE_SPELL (SPELL_PARAMETER) ! ! PROCEDURE TEST_IF_BUFFER_EXISTS (BUFFER_NAME) ! ! PROCEDURE EVE_LOAD_USER_DICTIONARY ! ! PROCEDURE EVE_UPDATE_USER_DICTIONARY ! ! PROCEDURE SPELL_CHECK_C ! ! PROCEDURE SPELL_CHECK_DCL ! ! PROCEDURE SPELL_CHECK_FORTRAN ! ! PROCEDURE SPELL_CHECK_MACRO ! ! PROCEDURE SPELL_CHECK_RNO ! ! ! All procedures not otherwise noted as being modified/changed/new/etc. ! were contained in the original version of Extended_EVE (8603-rhs) ! !**************************************** PROCEDURE EVE_APPEND_FILE (PCE_FILE_TO_APPEND) ! ! added 870806 - RHS ! Local file_name, pce_file_to_append; if eve$prompt_string(pce_file_to_append, file_name, "File to append: ", "No file appended") then position(end_of(current_buffer)); eve_include_file(file_name); endif; ENDPROCEDURE; !**************************************** PROCEDURE EVE_CUT_LEADING ! ! This procedure will cut all LEADING whitespace from the current line ! ! added 880330 - RHS ! local this_line; move_horizontal(-current_offset); this_line := erase_line; edit(this_line, trim_leading); copy_text(this_line); split_line; move_vertical(-1); ENDPROCEDURE; !**************************************** PROCEDURE EVE_DIRECTORY (PCE_DIR_STRING) ! ! added 870806 - RHS ! Local pce_dir_string, dir_target; if eve$prompt_string(pce_dir_string, dir_target, "Dir of what? : ", "Contents of current dir.") then ! spawn('directory ' + dir_target); eve_dcl('directory ' + dir_target); else ! spawn('directory'); eve_dcl('directory '); endif; ENDPROCEDURE; !**************************************** PROCEDURE EVE_INSERT_DATE ! ! insert current date at cursor position ! added - 3-FEB-1988 ! local tim_str; ! tim_str := FAO("!%D",0); tim_str := substr (tim_str,1,11); edit (tim_str,trim); move_text(tim_str); ENDPROCEDURE; !**************************************** PROCEDURE EVE_INSERT_TIME ! ! insert current time at cursor position ! added - 3-FEB-1988 ! local tim_str; ! tim_str := FAO("!%T",0); edit (tim_str,trim); move_text(tim_str); ENDPROCEDURE; !**************************************** PROCEDURE EVE_MAIL ! ! added 870810 - RHS ! spawn('mail'); ENDPROCEDURE; !**************************************** PROCEDURE EVE_NUMBER_LINES local line_number; line_number := 1; position(beginning_of(current_buffer)); loop if (((line_number / 250) * 250) = line_number) then message("Numbering line " + str(line_number)); endif; exitif (mark(none) = end_of(current_buffer)); eveplus_insert_text(fao("!6UL ", line_number)); line_number := line_number + 1; move_horizontal(-current_offset); move_vertical(1); endloop; pce_line_numbers := 1; ENDPROCEDURE; !**************************************** PROCEDURE EVE_PERFORM(CMD_FILE) ! ! This routine will read in, compile, and execute a file containing ! TPU commands. The file, unless otherwise commanded, will execute against ! the current buffer. One last note, the file to execute can be any series ! of valid TPU commands, BUT if the file only contains 1 procedure and no ! statement to execute that procedure then this procedure will not work. ! local this_file, this_window, this_buffer, this_program; this_file := cmd_file; this_window := current_window; this_buffer := current_buffer; ! Make sure user specified a file name, if no file then exit if this_file = "" then message("No file specified -- reenter command specifing a file to execute"); return; endif; if eve$x_number_of_windows = 2 then ! if already 2 windows move to the other window and get the file pce_other_window; eve_get_file(this_file); else ! Only one window, split the screen, and get the file pce_two_windows(this_file); endif; update(current_window); ! Compile the 'new' buffer this_program := compile(current_buffer); ! Reposition to the previous buffer pce_other_window; pce_one_window; ! Execute the compiled program if this_program <> 0 then execute(this_program); else message("ERROR - No program to execute!"); endif; ENDPROCEDURE; !**************************************** PROCEDURE EVE_PHONE ! ! added 870810 - RHS ! spawn('phone'); ENDPROCEDURE; !**************************************** PROCEDURE EVE_SET_AUTO_INDENT pce_auto_indent := 1; define_key("pce_indent_line", ret_key, "auto indent"); ENDPROCEDURE; !**************************************** PROCEDURE EVE_SET_NOAUTO_INDENT pce_auto_indent := 0; define_key("eve_return", ret_key, "return"); ENDPROCEDURE; !**************************************** PROCEDURE EVE_TEST_COMPILE ! --------------------------------------------------------------------- ! Compile the current buffer's source in its language ! --------------------------------------------------------------------- LOCAL fname, ftype, com, mod_status, mode_status, i; ! ---------------------------------------------- ! Construct names for the temporary output files ! ---------------------------------------------- fname := GET_INFO (CURRENT_BUFFER, "file_name"); IF fname = 0 THEN MESSAGE ('The current buffer is not assigned to a file'); RETURN; ENDIF; i := INDEX (fname, ';'); if i <> 0 then fname := SUBSTR (fname, 1, i-1); endif; i := INDEX (fname, ']'); if i <> 0 then fname := SUBSTR (fname, i+1, 255); endif; i := INDEX (fname, '.'); if i <> 0 then ftype := SUBSTR (fname, i+1, 255); fname := SUBSTR (fname, 1, i-1); endif; ! ---------------------- ! Build the command line ! ---------------------- IF ftype = 'FOR' THEN com := 'FOR/LIS/NOOBJ ' + fname; ELSE IF ftype = 'COB' THEN com := 'COB/LIS/NOOBJ ' + fname; ELSE IF ftype = 'MAR' THEN com := 'MACRO/LIS/NOOBJ ' + fname; ELSE MESSAGE ('The file type of the current buffer is not supported'); RETURN; ENDIF; ENDIF; ENDIF; ! ----------------------------------------------------- ! Write the contents of the current buffer to that file ! ----------------------------------------------------- mod_status := GET_INFO (CURRENT_BUFFER, "modified"); WRITE_FILE (CURRENT_BUFFER); ! ------------------------------------------------------- ! If the buffer was modified, writing it out will have ! erased its modification status memory. Reset the flag, ! if appropriate. ! ------------------------------------------------------- IF mod_status = 1 THEN mode_status := GET_INFO (CURRENT_BUFFER, "mode"); IF mode_status = OVERSTRIKE THEN SET (INSERT, CURRENT_BUFFER); ENDIF; copy_text (' '); move_horizontal(-1); erase_character(1); IF mode_status = OVERSTRIKE THEN SET (OVERSTRIKE, CURRENT_BUFFER); ENDIF; ENDIF; ! ----------------------- ! Perform the compilation ! ----------------------- eve_dcl (com); ENDPROCEDURE; !**************************************** PROCEDURE EVE_UNDERLINE_THIS_LINE ! ! to underline current line ! added - 3-FEB-1988 ! local this_line, ! current line this_char, ! current char char_cnt; ! char count this_line := erase_line; edit (this_line, trim_trailing); char_cnt := 0; loop char_cnt := char_cnt + 1; exitif char_cnt > length(this_line); this_char := substr (this_line ,char_cnt, 1); exitif (this_char <> " ") and (this_char <> " "); endloop; if char_cnt <= length(this_line) then this_line := this_line + ascii(13) + substr (this_line, 1, char_cnt - 1) + substr (pce$x_underlines, 1, length(this_line) - char_cnt + 1); endif; move_text(this_line); split_line; ENDPROCEDURE; !**************************************** PROCEDURE EVE_UNNUMBER_LINES local line_number; if pce_line_numbers = 1 then line_number := 1; position(beginning_of(current_buffer)); move_horizontal(-current_offset); loop if (((line_number / 250) * 250) = line_number) then message("UNnumbering line " + str(line_number)); endif; exitif (mark(none) = end_of(current_buffer)); erase_character(8); line_number := line_number + 1; move_vertical(1); endloop; pce_line_numbers := 0; else message("Lines are not numbered -- file not changed"); endif; ENDPROCEDURE; !**************************************** PROCEDURE EVE_WHICH_COLUMN Local this_column; this_column := current_column; message(fao("Current column = !SL",this_column)); ENDPROCEDURE; !**************************************** PROCEDURE PCE$STANDARD_KEYS ! pce$x_standard_keys := "pce$std_keys"; pce$x_vt100_keys := "pce$100_keys"; pce$x_vt200_keys := "pce$200_keys"; create_key_map ("pce$std_keys"); create_key_map ("pce$100_keys"); create_key_map ("pce$200_keys"); ! define_key ("user$tab_conversion", tab_key, "TAB", "pce$std_keys"); ! ! PF numeric keypad keys define_key ("position(beginning_of(current_buffer))", pf2, "top", "pce$std_keys"); define_key ("position(end_of(current_buffer))", key_name(pf2,shift_key), "bottom", "pce$std_keys"); define_key ("eve_line('')", pf3, "go to line #", "pce$std_keys"); define_key ("eve_what_line", key_name(pf3, shift_key), "show line #", "pce$std_keys"); ! non-numeric numeric keypad keys define_key ("eve_set_tabs_at ('7 11 15 19 23 27 31 35 39 43 47 51 55 59 63 67 71 75 79 83 87 91 95 99 103 107 111')", minus, "FORTRAN TABS (SPACES)", "pce$std_keys"); define_key ("eve_set_tabs_every (8)", key_name(minus,shift_key), "8 COLUMN TABS (TABS)", "pce$std_keys"); define_key ("pce_page", comma, "go to start of next page", "pce$std_keys"); define_key ("pce_delete_character", period, "delete character", "pce$std_keys"); define_key ("pce_delete_line", key_name(period,shift_key),"delete line", "pce$std_keys"); define_key ("pce_undelete_last_item_deleted", enter, "undelete last item deleted", "pce$std_keys"); define_key ("eve_restore", key_name(enter,shift_key), "unerase last item erased", "pce$std_keys"); ! numeric keypad keys define_key ("eve_set_width(80);", kp1, "80 col scr", "pce$std_keys"); define_key ("eve_set_width(132);", key_name(kp1,shift_key), "132 col scr", "pce$std_keys"); define_key ("pce_show_columns", kp2, "show columns", "pce$std_keys"); define_key ("pce_record_length", key_name(kp2,shift_key), "show recl", "pce$std_keys"); define_key ("scroll(current_window,-1)", kp4, "scroll up 1 line", "pce$std_keys"); define_key ("pce_center_line", key_name(kp4,shift_key), "center line", "pce$std_keys"); define_key ("scroll(current_window, 1)", kp5, "scroll dn 1 line", "pce$std_keys"); define_key ("eve_replace('','')", key_name(kp5,shift_key), "replace", "pce$std_keys"); define_key ("pce_column_xchange", key_name(kp6,shift_key), "columnar xchange", "pce$std_keys"); ! kp 7 / shift kp 7 are defined in local_init.tpu define_key ("pce_cc_range", kp8, "change case, range", "pce$std_keys"); define_key ("eve_cut_leading", key_name(kp8,shift_key), "cut leading spaces", "pce$std_keys"); define_key ("pce_change_case", kp9, "change case, char", "pce$std_keys"); define_key ("pce_cc_line", key_name(kp9,shift_key), "change case, line", "pce$std_keys"); ! shifted arrow keys define_key ("shift(current_window, 25)", key_name(left,shift_key), "shift left 25", "pce$std_keys"); define_key ("shift(current_window,-25)", key_name(right,shift_key), "shift right 25", "pce$std_keys"); ! control keys define_key ("move_horizontal(-(current_offset+1))", ctrl_p_key, "move to end of previous line", "pce$std_keys"); define_key ("eve_learn", ctrl_k_key, "learn", "pce$std_keys"); ! shifted (typing) keys define_key ("eve_append_file('')", key_name('a', shift_key), "append file", "pce$std_keys"); define_key ("pce_switch_editors", key_name('e', shift_key), "switch editors", "pce$std_keys"); define_key ("eve_get_file('')", key_name('g', shift_key), "get file", "pce$std_keys"); define_key ("pce_toggle_auto_shift_mode", key_name('h', shift_key), "toggle auto shift", "pce$std_keys"); define_key ("eve_include_file('')", key_name('i', shift_key), "include file", "pce$std_keys"); define_key ("eve_repeat('')", key_name('r', shift_key), "repeat cmd n times", "pce$std_keys"); define_key ("pce_change_scrolling", key_name('s', shift_key), "change scrolling type", "pce$std_keys"); define_key ("eve_write_file('')", key_name('w', shift_key), "write file", "pce$std_keys"); ! ! vt100/Rainbow key definitions ! define_key ("eve_do ('')", pf4, "do", "pce$100_keys"); define_key ("eve_write_file('')", key_name(pf4,shift_key), "write file", "pce$100_keys"); ! define_key ("eve_help('keypad_diagrams user_100keypad')", kp3, "keypad diag", "pce$100_keys"); define_key ("pce_other_window", key_name(kp3,shift_key), "bufr toggle", "pce$100_keys"); define_key ("eve_change_mode", key_name(kp8,shift_key), "change mode", "pce$100_keys"); ! unshifted control keys define_key ("eve_find ('')", ctrl_f_key, "find", "pce$100_keys"); define_key ("eve_select", ctrl_g_key, "select", "pce$100_keys"); define_key ("eve_erase_word", ctrl_j_key, "erase_word", "pce$100_keys"); define_key ("eve_move_by_line", ctrl_l_key, "move_by_line", "pce$100_keys"); ! shifted control keys define_key ("eve_remove", key_name(ctrl_g_key,shift_key), "remove", "pce$100_keys"); define_key ("eve_insert_here", key_name(ctrl_i_key,shift_key), "insert_here", "pce$100_keys"); define_key ("eve_move_by_word", key_name(ctrl_l_key,shift_key), "move by word", "pce$100_keys"); define_key ("eve_change_direction", key_name(ctrl_r_key,shift_key), "change_direction", "pce$100_keys"); define_key ("pce_erase_eol", key_name(ctrl_u_key,shift_key), "erase to eol", "pce$100_keys"); define_key ("quit", key_name(ctrl_z_key,shift_key), "quit", "pce$100_keys"); define_key ("eve_next_screen", key_name(down,shift_key), "next_screen", "pce$100_keys"); define_key ("eve_previous_screen", key_name(up,shift_key), "previous_screen", "pce$100_keys"); ! shifted keyboard keys define_key ("pce_one_window", key_name("1",shift_key), "one screen", "pce$100_keys"); define_key ("pce_two_windows('')", key_name("2",shift_key), "split screen", "pce$100_keys"); ! ! vt200 key definitions ! ! vt200 only key definitions follow ! define_key ("pce_truncate_lines('')", key_name(e3, shift_key), "truncate line length","pce$200_keys"); define_key ("pce_prev_buf", key_name(e4, shift_key), "select prev buffer", "pce$200_keys"); ! define_key ("pce_capitalize_word", f8, "capitalize word", "pce$200_keys"); define_key ("eve_fill_paragraph", key_name(f8, shift_key), "fill paragraph", "pce$200_keys"); define_key ("eve_learn", f9, "learn", "pce$200_keys"); define_key ("pce_exec_cmd_file('')", key_name(f9, shift_key), "execute cmd file", "pce$200_keys"); define_key ("eve_tpu ('')", key_name(do, shift_key), "tpu", "pce$200_keys"); define_key ("eve_move_by_word", f12, "move by line", "pce$200_keys"); define_key ("pce_move_by_line", key_name(f12, shift_key), "move by word", "pce$200_keys"); define_key ("pce_erase_bol", f17, "erase to bol", "pce$200_keys"); define_key ("pce_erase_to_start_of_buffer", key_name(f17, shift_key), "erase to bob", "pce$200_keys"); define_key ("pce_erase_eol", f18, "erase to eol", "pce$200_keys"); define_key ("pce_erase_to_end_of_buffer", key_name(f18, shift_key), "erase to eob", "pce$200_keys"); define_key ("pce_other_window", f19, "buffer toggle", "pce$200_keys"); define_key ("pce_split_screen", key_name(f19, shift_key), "split/unsplit scr", "pce$200_keys"); define_key ("quit", f20, "quit", "pce$200_keys"); ! define_key ("eve_directory('')", pf4, "directory", "pce$200_keys"); define_key ("eve_set_tabs_at('5 9 13 17 21 25 29 33 37 41 45 49 53 57 61 65 69 73 77 81 85 89 93 97 101 105 109')", key_name(pf4,shift_key), "COBOL TABS (SPACES)", "pce$200_keys"); ! define_key ("eve_help('keypad_diagrams user_200keypad')", kp3, "keypad diag", "pce$200_keys"); ! control keys define_key ("eve_line('')", ctrl_l_key, "go to line #", "pce$200_keys"); ! shifted control keys define_key ("pce_dcl_window", key_name(ctrl_d_key, shift_key),"DCL window", "pce$200_keys"); define_key ("pce_insert_page_marks", key_name(ctrl_i_key, shift_key),"insert page marks", "pce$200_keys"); define_key ("pce_remove_page_marks", key_name(ctrl_r_key, shift_key),"remove page marks", "pce$200_keys"); define_key ("pce_change_width", key_name(ctrl_w_key, shift_key),"Change width.", "pce$200_keys"); ! shifted typing keys define_key ("eve_what_line", key_name("l", shift_key), "show line #", "pce$200_keys"); ! ! End of user defined keys ! remove_key_map(eve$x_key_map_list, eve$x_user_keys, ALL); remove_key_map(eve$x_key_map_list, eve$x_vt100_keys, ALL); remove_key_map(eve$x_key_map_list, eve$x_vt200_keys, ALL); remove_key_map(eve$x_key_map_list, eve$x_standard_keys, ALL); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_vt200_keys); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_standard_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_user_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_vt200_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_standard_keys); ENDPROCEDURE; !**************************************** PROCEDURE PCE$VT100_KEYS on_error endon_error; pce$x_standard_keys := "pce$std_keys"; pce$x_vt100_keys := "pce$100_keys"; pce$x_vt200_keys := "pce$200_keys"; remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_standard_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_user_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_standard_keys, ALL); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_vt100_keys); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_standard_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_user_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_vt100_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_standard_keys); eve$x_vt200_keypad := FALSE; ENDPROCEDURE; !**************************************** PROCEDURE PCE$VT200_KEYS on_error endon_error; pce$x_standard_keys := "pce$std_keys"; pce$x_vt100_keys := "pce$100_keys"; pce$x_vt200_keys := "pce$200_keys"; remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_standard_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_user_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_standard_keys, ALL); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_vt200_keys); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_standard_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_user_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_vt200_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_standard_keys); eve$x_vt200_keypad := TRUE; ENDPROCEDURE; !**************************************** PROCEDURE PCE_AUTO_SHIFT_LEFT local line_length, window_width, this_column, line_position; line_length := length(current_line); window_width := get_info(current_window, "width"); this_column := get_info(current_window, "current_column"); line_position := get_info(current_buffer, "offset") + 1; !message(fao("len = !SL, wid = !SL, col = !SL, pos = !SL", ! line_length,window_width,this_column,line_position)); if line_position < line_length then if ((this_column >= (window_width - 1)) and ((line_position + pce$total_shift) < line_length)) then pce$total_shift := shift(current_window, 1); ! message(fao("total shift = !SL",pce$total_shift)); else cursor_horizontal(1); endif; else cursor_horizontal(1); endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_AUTO_SHIFT_RIGHT local line_length, window_width, this_column; line_length := length(current_line); window_width := get_info(current_window, "width"); this_column := get_info(current_window, "current_column"); line_position := get_info(current_buffer, "offset") + 1; !message(fao("len = !SL, wid = !SL, col = !SL, pos = !SL", ! line_length,window_width,this_column,line_position)); if this_column = 1 then if pce$total_shift >= 1 then pce$total_shift := shift(current_window, -1); endif; else cursor_horizontal(-1); endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_BUFFER(BUF_PARM) ! ! new - 880208 - RHS ! ! This routine will be called instead of eve_buffer so that pce$x_prev_buf ! can be set. In other words, eve_buffer is called from this routine ! after a global variable is set that saves the current buffer. ! pce$x_prev_buf := current_buffer; ! set global var eve_buffer(buf_parm); ! call tpu buffer routine if pce$x_prev_buf = current_buffer then pce$x_prev_buf := 0; ! if user doesn't chg buffers reset ! pce$x_prev_buf to 0 endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_CAPITALIZE_WORD ! ! new - 861209 - RHS ! ! This procedure is a modified version of the EVE command procedure ! CAPITALIZE WORD. This version will capitalize the current word and ! then move to the beginning of the next word. ! local word_range, word_string, this_mode; word_range := eve$current_word; if(word_range <> 0) and (current_offset > 0) then word_string := erase_character (-length (word_range)); eve$capitalize_string (word_string); this_mode := get_info(current_buffer, eve$kt_mode); set (insert, current_buffer); copy_text (word_string); set (this_mode, current_buffer); endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_CC_LINE ! ! Change case of this line ! local this_line; this_line := erase_line; change_case(this_line,invert); split_line; move_vertical(-1); copy_text(this_line); ENDPROCEDURE; !**************************************** PROCEDURE PCE_CC_RANGE ! ! Changes case of range selected by user ! local this_mode; if beginning_of (paste_buffer) <> end_of (paste_buffer) then this_mode := get_info (current_buffer, eve$kt_mode); set (insert, current_buffer); change_case(paste_buffer,invert); copy_text (paste_buffer); append_line; ! did a split_line during eve_remove set (this_mode, current_buffer); eve$show_first_line; else if eve$x_select_position <> 0 then message ("Nothing to insert. Use Remove to select a range of text."); else message ("Nothing to insert. Use Select to select a range of text."); endif; endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_CENTER_LINE ! ! Center the current line between the L & R margins ! local this_line, line_length, lm, rm, useable_space, tmp1, tmp2, start_col, edit_line, spaces; ! spaces := " "; this_line := current_line; ! edit(this_line, trim, off); ! line_length := length(this_line); lm := get_info(current_buffer,"left_margin"); rm := get_info(current_buffer,"right_margin"); useable_space := rm - lm + 1; tmp1 := useable_space / 2; tmp2 := line_length / 2; start_col := tmp1 - tmp2; move_horizontal(-current_offset); pce_erase_eol; copy_text(substr(spaces,1,start_col) + this_line); ENDPROCEDURE; !**************************************** PROCEDURE PCE_CHANGE_CASE ! ! Changes case of current character ! local char, current_mode; ! char := current_character; current_mode := get_info(current_buffer,"mode"); if char <> "" then set (overstrike,current_buffer); change_case(char,invert); copy_text(char); set (current_mode,current_buffer); else move_horizontal(1); endif; ! ENDPROCEDURE; !**************************************** PROCEDURE PCE_CHANGE_SCROLLING local this_window, window_to_set_scroll, amount_of_scroll; this_window := current_window; if this_window = eve$command_window then if eve$x_ambiguous_parse then window_to_set_scroll := eve$choice_window; else window_to_set_scroll := eve$x_pre_command_window; endif; position (window_to_set_scroll); else window_to_set_scroll := this_window; endif; amount_of_scroll := get_info(window_to_set_scroll, "visible_length"); if pce_scroll_type = "STD" then define_key("pce_next_screen(-1)", e5, "previous screen"); define_key("pce_next_screen(1)", e6, "next screen"); set(scrolling, window_to_set_scroll, ON, 5, 5, amount_of_scroll); pce_scroll_type := "ALT"; message("Scrolling now set to ALT"); return; else define_key("eve_previous_screen", e5, "previous screen"); define_key("eve_next_screen", e6, "next screen"); set(scrolling, window_to_set_scroll, ON, 0, 0, 0); pce_scroll_type := "STD"; message("Scrolling now set to STD"); return; endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_CHANGE_WIDTH ! ! swaps between normal and widescreen for single window screens ! if (pce$width_size = 'WIDE') then set (width, current_window, 80); pce$width_size := 'NORMAL'; else set (width, current_window, 132); pce$width_size := 'WIDE'; endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_COLUMN_XCHANGE pce_set_wc('',''); pce_column_xchg('',''); ENDPROCEDURE; !**************************************** PROCEDURE PCE_COLUMN_XCHG(STRING1, STRING2) local old_string, new_string, temp, this_string, this_record, string1, string2, string_len, this_position, number_of_xchgs, old_len, new_len, this_mode; this_mode := get_info(current_buffer,"MODE"); number_of_xchgs := 0; string_len := pce_wc_end - pce_wc_start + 1; old_string := string1; new_string := string2; if eve$prompt_string(string1, temp, "Old string: ", "nothing entered -- xchange cancelled") then old_string := temp; if eve$prompt_string(string2, temp, "New string: ", "nothing entered -- xchange cancelled") then new_string := temp; old_len := length(old_string); new_len := length(new_string); loop; this_record := current_line; this_string := substr(this_record, pce_wc_start, string_len); if this_string = old_string then move_horizontal(-current_offset); move_horizontal(pce_wc_start - 1); copy_text(new_string); if (new_len < old_len) and (this_mode = OVERSTRIKE) then erase_character(old_len - new_len); endif; number_of_xchgs := number_of_xchgs + 1; else if (old_len = 1) and (old_string = '@') then if (new_string = '@') then new_string := ""; endif; move_horizontal(-current_offset); move_horizontal(pce_wc_start - 1); if this_mode = OVERSTRIKE then erase_character(pce_wc_end - pce_wc_start + 1); endif; copy_text(new_string); number_of_xchgs := number_of_xchgs + 1; endif; if (old_len = 1) and (old_string = '^') then this_string := substr(current_line,pce_wc_start,string_len); edit(this_string,UPPER); set(OVERSTRIKE,current_buffer); move_horizontal(-current_offset); move_horizontal(pce_wc_start - 1); copy_text(this_string); set(this_mode,current_buffer); number_of_xchgs := number_of_xchgs + 1; endif; if (old_len = 1) and (old_string = '~') then this_string := substr(current_line,pce_wc_start,string_len); edit(this_string,LOWER); set(OVERSTRIKE,current_buffer); move_horizontal(-current_offset); move_horizontal(pce_wc_start - 1); copy_text(this_string); set(this_mode,current_buffer); number_of_xchgs := number_of_xchgs + 1; endif; endif; move_horizontal(-current_offset); move_vertical(1); exitif mark(none) = end_of(current_buffer); endloop; message(fao('Xchange completed -- !SL exchanges made',number_of_xchgs)); endif; endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_DCL_WINDOW ! ! new 860502 -- rhs ! ! This procedure initiates a DCL command window for the user using the ! command procedure utilized by VPW ! ! NOTE: This procedure requires that VPW be installed or at least the ! DCLWINDOW.COM file be installed on the system ! spawn ("@sys$sysvpwfiles:dclwindow"); ENDPROCEDURE; !**************************************** PROCEDURE PCE_DELETE_CHARACTER ! ! modified 860402 -- rhs -- to allow for 'undeleting' ! ! Delete the current character, will wrap lines ! local deleted_char; ! if current_character = "" then move_horizontal(1); if current_offset = 0 then append_line; else move_horizontal(-1); pce_deleted_item := erase_character(1); pce_deleted_item_position := mark(none); endif; else pce_deleted_item := erase_character(1); pce_deleted_item_position := mark(none); endif; pce_deleted_item_type := 0; ENDPROCEDURE; !**************************************** PROCEDURE PCE_DELETE_LINE ! ! new 850402 -- rhs ! pce_deleted_item := erase_line; pce_deleted_item_position := mark(none); pce_deleted_item_type := 1; ENDPROCEDURE; !**************************************** PROCEDURE PCE_ERASE_BOL ! ! Erases from current character position to bol ! local returned_position; ! returned_position := get_info(current_buffer, "offset"); eve$x_restore_text := erase_character(-(returned_position+1)); eve$x_restoring_line := 0; ! ENDPROCEDURE; !**************************************** PROCEDURE PCE_ERASE_EOL ! ! Erases from current character position to eol ! eve$x_restore_text := erase_character(500); eve$x_restoring_line := 0; ! ENDPROCEDURE; !**************************************** PROCEDURE PCE_ERASE_TO_END_OF_BUFFER ! new - 860522 -- RHS ! This procedure will delete the contents of the current buffer from the ! current character position to the end of the buffer. ! Local start_of_range, this_range; start_of_range := select(none); position(end_of(current_buffer)); this_range := select_range; erase(this_range); start_of_range := 0; ENDPROCEDURE; !**************************************** PROCEDURE PCE_ERASE_TO_START_OF_BUFFER ! new - 860522 -- RHS ! This procedure will delete the contents of the current buffer from the ! beginning of the buffer to the current character position. ! Local start_of_range, this_range; start_of_range := select(none); position(beginning_of(current_buffer)); this_range := select_range; erase(this_range); start_of_range := 0; 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 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 PCE_INDENT_LINE Local previous_line, space_char, tab_char, null_char, this_col, this_offset, length_prev_line; if pce_auto_indent = 0 then message("Auto indentation not set -- procedure not executed"); return; endif; if current_buffer = eve$command_buffer then eve_return; return; endif; space_char := " "; tab_char := ascii(9); null_char := ""; if current_offset < 1 then this_offset := 2; else this_offset := 1; endif; eve_return; move_vertical(-this_offset); previous_line := current_line; length_prev_line:= length(previous_line); move_vertical(this_offset); this_col := 0; loop this_col := this_col + 1; exitif this_col > length_prev_line; this_char := substr(previous_line,this_col,1); if length_prev_line > 0 then if (this_char <> space_char) and (this_char <> tab_char) and (this_char <> null_char) then eve$indent_line_to(this_col); return; else if this_char = tab_char then message( "Previous line contains leading TABS (ascii(9)) - replace with spaces"); endif endif; endif; endloop; ! if by chance the above loop is exited then assume a blank line for prev. line ! or a line of blanks eve$indent_line_to(length_prev_line+1); ENDPROCEDURE; !**************************************** PROCEDURE PCE_INITILIZE ! ! added 870803 - RHS ! ! procedure arguments eve$arg1_directory := "string"; eve$arg1_append_file := "string"; pce$width_size := "NORMAL"; ! options are NORMAL or WIDE pce$shift_mode := "NORMAL"; ! optione are NORMAL or AUTO pce$x_prev_buf := 0; pce$x_standard_keys := "pce$std_keys"; pce$x_vt100_keys := "pce$100_keys"; pce$x_vt200_keys := "pce$200_keys"; EDTP$x_standard_keys := "edtp$std_keys"; pce$x_underlines := "__________________________________________________________________" + "__________________________________________________________________"; pce_dir_string := ""; pce_deleted_item := ""; pce_file_to_append := ""; pce_form_feed := ascii(12); pce_tab_setting := "TABS"; ! options are TABS or SPACES pce_scroll_type := "STD"; ! options are STD or ALT ! numeric constants pce$total_shift := 0; pce_display_columns := 0; pce_deleted_item_type := 0; pce_auto_indent := 0; pce_number_lines := 0; pce_page_size := 59; pce_wc_start := 1; pce_wc_end := 500; ! key list constants pce$x_vt100_keys := "pce$100_keys"; pce$x_vt200_keys := "pce$200_keys"; pce$x_standard_keys := "pce$standard_keys"; ! spell pkg constants eve$arg1_spell := 'string'; ! > added 870713 - RHS dictionary$available := 0; ! > added 870713 - RHS dictionary$buffer := 0; ! > added 870713 - RHS default$buffer := 0; ! > added 870713 - RHS set(timer, on, "Executing..."); ENDPROCEDURE; !**************************************** PROCEDURE PCE_INSERT_PAGE_MARKS ! ! added 870803 - RHS ! LOCAL found_range, This_Line, Line_Len, Start, End, Here, Search_Range, New_key, ESC, Res_Key; ON_ERROR ENDON_ERROR LOOP found_range := SEARCH(pce_form_feed,REVERSE,EXACT); IF found_range=0 THEN POSITION (BEGINNING_OF(CURRENT_BUFFER)); EXITIF found_range=0; ELSE POSITION(found_range); This_line := CURRENT_LINE; Line_len := LENGTH(This_line); EXITIF (Line_len = 1); ENDIF; MOVE_VERTICAL(-1); ENDLOOP; LOOP MOVE_VERTICAL(+1); MOVE_HORIZONTAL(+1); MOVE_HORIZONTAL(-CURRENT_OFFSET); Start := MARK(NONE); MOVE_VERTICAL(pce_page_size); End := MARK(NONE); POSITION(Start); LOOP found_range := SEARCH(pce_form_feed,FORWARD,EXACT); IF found_range=0 THEN POSITION (END_OF(CURRENT_BUFFER)); EXITIF found_range=0; ELSE POSITION(found_range); This_line := CURRENT_LINE; Line_len := LENGTH(This_line); EXITIF (Line_len = 1); ENDIF; MOVE_VERTICAL(+1); ENDLOOP; Here := MARK(NONE); IF (Here = End) and (End = END_OF(CURRENT_BUFFER)) THEN ! ! Check to see if user has the buffer clearing feature ! MESSAGE('Operation Finished'); RETURN 1; ELSE IF Here > End THEN POSITION(End); UPDATE(CURRENT_WINDOW); ERASE(MESSAGE_BUFFER); MESSAGE(' Insert Page? [Y(es),Q(uit) Arrow keys to move]'); ESC := ASCII(27); LOOP Res_Key := READ_CHAR; CHANGE_CASE(Res_Key,UPPER); IF (Res_Key = ESC) THEN Res_Key := READ_CHAR; Res_Key := READ_CHAR; ENDIF; EXITIF Res_Key = "Y"; EXITIF Res_Key = "Q"; IF Res_Key = "A" THEN MOVE_VERTICAL(-1); UPDATE(CURRENT_WINDOW); ENDIF; IF Res_Key = "B" THEN MOVE_VERTICAL(+1); UPDATE(CURRENT_WINDOW); ENDIF; ENDLOOP; IF Res_Key = "Q" THEN MESSAGE('Operation Finished'); RETURN 1; ENDIF; IF Res_Key = "Y" THEN SPLIT_LINE; MOVE_VERTICAL(-1); COPY_TEXT(pce_form_feed); UPDATE(CURRENT_WINDOW); ENDIF; ENDIF; ENDIF; ENDLOOP; ENDPROCEDURE !**************************************** PROCEDURE PCE_KEY_MAP_EXISTS(MAP_TO_CHECK_FOR) local this_map, key_map_name, key_map_list_name; this_map := map_to_check_for; edit(this_map, upper); ! get the current key map list name key_map_list_name := get_info(current_buffer, "key_map_list"); ! get the first key map name key_map_name := get_info(key_map, "first", key_map_list_name); loop exitif key_map_name = this_map; exitif key_map_name = 0; key_map_name := get_info(key_map, "next", key_map_list_name); endloop; return key_map_name; ENDPROCEDURE; !**************************************** PROCEDURE PCE_MOVE_BY_LINE ! ! This is a modified version of the Procedure EVE_MOVE_BY_LINE ! ! 870302 -- RHS ! if current_direction = REVERSE then if mark(none) <> beginning_of(current_buffer) then ! If in command buffer, don't back up beyond prompt if current_buffer = eve$command_buffer then if substr (current_line, 1, eve$x_command_prompt_length) = eve$x_command_prompt then move_horizontal (eve$x_command_prompt_length); endif; else move_horizontal(-current_offset); move_vertical(-1); endif; endif; else if mark(none) <> end_of(current_buffer) then move_horizontal(-current_offset); move_vertical(1); endif; endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_NEXT_SCREEN (THIS_DIRECTION) Local this_direction, this_row, this_column, this_window, amount_of_scroll, old_scroll_top, old_scroll_bottom, old_scroll_amount, scroll_window; on_error endon_error; this_window := current_window; if this_window = eve$command_window then if eve$x_ambiguous_parse then scroll_window := eve$choice_window; else scroll_window := eve$x_pre_command_window; endif; position (scroll_window); else scroll_window := this_window; endif; amount_of_scroll := get_info(scroll_window, "visible_length"); if get_info(scroll_window, "status_line") <> "" then amount_of_scroll := amount_of_scroll - 3; else amount_of_scroll := amount_of_scroll - 2; endif; if amount_of_scroll <= 0 then amount_of_scroll := 1; endif; this_row := get_info (scroll_window, "current_row"); this_column := get_info (scroll_window, "current_column"); old_scroll_top := get_info (scroll_window, "scroll_top"); old_scroll_bottom := get_info (scroll_window, "scroll_bottom"); old_scroll_amount := get_info (scroll_window, "scroll_amount"); if (this_direction >= 0) then if mark(none) = end_of(current_buffer) then return; else move_vertical(amount_of_scroll); endif; else if mark(none) = beginning_of(current_buffer) then return; else move_vertical(-amount_of_scroll); endif; endif; cursor_horizontal(this_column - get_info(scroll_window, "current_column")); if this_window <> current_window then position (this_window); endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_ONE_WINDOW ! ! Switches back to 1 window from split screen edits ! local this_position, this_buffer; ! this_position := mark(none); this_buffer := current_buffer; ! if eve$x_number_of_windows = 1 then message ("Only one window on screen"); else unmap(eve$top_window); unmap(eve$bottom_window); map(eve$main_window,this_buffer); eve$set_status_line(eve$main_window); position(this_position); eve$position_in_middle(this_buffer); eve$x_number_of_windows := 1; eve$x_this_window := current_window; endif; ! ENDPROCEDURE; !**************************************** PROCEDURE PCE_OTHER_WINDOW ! ! Switches the cursor between 2 windows created by Pce_two_files ! if eve$x_number_of_windows = 1 then message ("Only one window on screen"); else if current_window = eve$top_window then position (eve$bottom_window); else position (eve$top_window); endif; eve$x_this_window := current_window; endif; ! ENDPROCEDURE; !**************************************** PROCEDURE PCE_PAGE LOCAL dir, next_page; on_error if error = tpu$_strnotfound then if dir = REVERSE then position(beginning_of(current_buffer)) else position(end_of(current_buffer)) endif; endif; return; endon_error; dir := current_direction; if dir = FORWARD then move_horizontal(1) else move_horizontal(-1) endif; next_page := search(ascii(12),dir); position(beginning_of(next_page)); eve$position_in_middle(mark(none)); ENDPROCEDURE; !**************************************** PROCEDURE PCE_PREV_BUF ! This routine will automatically retrieve the previous buffer ! without having to specify the name of it. local temp_buf; ! temporary buffer ! if no previous buffer, ask for the new buffer name if pce$x_prev_buf = 0 then ! this gets us around having to set the previous buffer's name the 1st time pce_buffer(""); else ! set temp buf to current buf temp_buf := current_buffer; ! map buffer to current window map(current_window,pce$x_prev_buf); ! set status line eve$set_status_line (current_window); ! set prev buf to temp buf pce$x_prev_buf := temp_buf; eve$position_in_middle(mark(none)); endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_RECORD_LENGTH message(fao('line length (characters) = !UL', length(current_line))); ENDPROCEDURE; !**************************************** ! ! added 870803 - RHS ! PROCEDURE PCE_REMOVE_PAGE_MARKS LOCAL found_range, This_Line, Line_len; ON_ERROR MESSAGE('Page Marks Removed. Operation Completed.'); RETURN; ENDON_ERROR POSITION (BEGINNING_OF(CURRENT_BUFFER)); LOOP found_range := SEARCH(pce_form_feed,FORWARD,EXACT); IF found_range=0 THEN RETURN 1; ENDIF; POSITION(found_range); This_line := CURRENT_LINE; Line_len := LENGTH(This_line); IF (Line_len = 1) THEN ERASE_LINE; ENDIF; MOVE_VERTICAL(+1); ENDLOOP ENDPROCEDURE !**************************************** PROCEDURE PCE_SET_WC(VALUE1, VALUE2) local temp, this_value; if eve$prompt_number(value1, temp, "Start column: ", "nothing entered -- original setting unchanged") then this_value := temp; if eve$prompt_number(value2, temp, "End column: ", "nothing entered -- original setting unchanged") then pce_wc_start := this_value; pce_wc_end := temp; endif; endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_SHOW_COLUMNS ! if pce_display_columns = 0 then pce_display_columns := 1; if get_info(current_window,"width") >= 81 then set(status_line, current_window, reverse, "12345678901234567890123456789012345678901234567890"+ "12345678901234567890123456789012345678901234567890"+ "12345678901234567890123456789012"); else set(status_line, current_window, reverse, "12345678901234567890123456789012345678901234567890"+ "123456789012345678901234567890"); endif; else pce_display_columns := 0; eve$set_status_line(current_window); endif; ! ENDPROCEDURE; !**************************************** PROCEDURE PCE_SWITCH_EDITORS local file_search_result, file_to_execute; set(screen_update, OFF); if pce$x_current_editor = "XEVEPLUS" then file_search_result := file_search ("SYS$LOGIN:EDTP_INIT.TPU"); if file_search_result = eve$x_null then file_search_result := file_search ("PUB:EDTP_INIT.TPU"); if file_search_result = eve$x_null then message("Cannot switch to EDTP keypad - can't file init file"); set(screen_update, ON); return; endif; endif; eve_perform(file_search_result); pce$x_current_editor := "XEDTPLUS"; else file_search_result := file_search ("SYS$LOGIN:LOCAL_INIT.TPU"); if file_search_result = eve$x_null then file_search_result := file_search ("PUB:LOCAL_INIT.TPU"); if file_search_result = eve$x_null then message("Cannot switch to Extended_EVEPlus keypad - can't file init file"); set(screen_update, ON); return; endif; endif; eve_perform(file_search_result); pce$x_current_editor := "XEVEPLUS"; endif; set(screen_update, ON); message(fao("Keypad has been switched to !AS",pce$x_current_editor)); eve$position_in_middle(mark(none)); ENDPROCEDURE; !**************************************** PROCEDURE PCE_TOGGLE_AUTO_SHIFT_MODE if pce$shift_mode = "NORMAL" then define_key ("pce_auto_shift_right", left, "auto cursor left"); define_key ("pce_auto_shift_left", right, "auto cursor right"); pce$shift_mode := "AUTO"; else define_key ("move_horizontal(-1)", left, "cursor left"); define_key ("move_horizontal(1)", right, "cursor right"); pce$shift_mode := "NORMAL"; endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_SPLIT_SCREEN if eve$x_number_of_windows = 1 then pce_two_windows(""); else pce_one_window; endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_TWO_WINDOWS(NEW_BUFFER_NAME) ! ! Switches from one screen (window) to split screen (2 windows) editing ! local second_file, second_buffer, sec_buf_name, first_buf_name, first_buffer, check_name, check_buffer, last_key_name; ! if eve$x_number_of_windows = 2 then message("Already 2 windows on screen"); else ! get files, names for both buffers pce_main_window := current_window; first_buffer := current_buffer; first_buf_name := get_info(first_buffer,"name"); ! check to see if the user supplied the name for the 2nd file (buffer) ! in his call to this routine second_file := new_buffer_name; if new_buffer_name = "" then second_file := read_line("file name for 2nd buffer: "); last_key_name := eve$lookup_comment(last_key); if (last_key_name = "exit") or (last_key_name = "do") then return; endif; if length(second_file) = 0 then second_file := first_buf_name; endif; endif; unmap(pce_main_window); ! set up the bottom window to hold the current buffer map (eve$bottom_window, first_buffer); eve$set_status_line(eve$bottom_window); update(eve$bottom_window); ! set up the top window to hold the 2nd buffer sec_buf_name := second_file; change_case(sec_buf_name,upper); ! check to see if same buffer for both windows if first_buf_name <> sec_buf_name then ! find out if buffer requested for top window is already defined ! if it is then use it check_buffer := get_info(buffers,"last"); check_name := get_info(check_buffer,"name"); loop; if (sec_buf_name = check_name)or(sec_buf_name = check_buffer)then map (eve$top_window, check_buffer); eve$set_status_line(eve$top_window); update(eve$top_window); eve$x_number_of_windows := 2; return; endif; check_buffer := get_info(buffers, "previous"); exitif (check_buffer = 0); check_name := get_info(check_buffer,"name"); endloop; second_buffer := create_buffer(sec_buf_name, second_file); map (eve$top_window, second_buffer); else map (eve$top_window, first_buffer); endif; eve$set_status_line(eve$top_window); update(eve$top_window); ! update window counters eve$x_number_of_windows := 2; eve$x_this_window := current_window; endif; ! ENDPROCEDURE; !**************************************** PROCEDURE PCE_TRUNCATE_LINES(TRUNC_LENGTH) ! ! Truncates lines to user specified length ! ! NEW - 870721 - RHS ! local trunc_length, temp; if eve$prompt_number(trunc_length, temp, "Length to truncate to: ", "nothing entered -- truncation cancelled") then message(fao('Truncating lines to !SL characters',temp)); move_horizontal(-current_offset); move_horizontal(temp); loop pce_erase_eol; move_vertical(1); exitif mark(none) = end_of(current_buffer); endloop; message('Truncation completed'); endif; ENDPROCEDURE; !**************************************** PROCEDURE PCE_UNDELETE_LAST_ITEM_DELETED ! ! new 860402 -- rhs ! ! Differs from the eve_restore procedure because this macro ! not only restores the last item deleted (as deleted by the ! keys), but puts it back from where it came from ! not at the current position. ! ! NOTE: This macro could be latched not only to the delete character ! and delete line keys but also to the erase word () key ! by modifying the eve_erase_word procedure ! local item_length; item_length := length(pce_deleted_item); if item_length <> 0 then position(pce_deleted_item_position); copy_text(pce_deleted_item); if pce_deleted_item_type = 1 then split_line; move_vertical(-1); else move_horizontal(-item_length); endif; pce_deleted_item_type := 0; pce_deleted_item := ""; ! clear out the last item del. string ! because once it is undeleted we don't ! want to undelete it again else message("Nothing to undelete"); endif; ENDPROCEDURE; !**************************************** PROCEDURE USER$TAB_CONVERSION ! ! modified 880121-RHS to correctly handle tabbing beyond current tab settings ! local tab_value, this_column, tab_to_col, search_string, pce_string, pce_index1, pce_index2, pce_index3, rest_of_str, string_length; tab_value := get_info(current_buffer, "tab_stops"); this_column := current_offset + 1; if pce_tab_setting = "TABS" then eve_tab; else ! convert current tab settings to integer values search_string := " "; pce_index1 := 1; pce_index2 := index(tab_value,search_string) -1; string_length := length(tab_value) - 1; if string_length <= 0 then copy_text(" "); else loop; pce_string := substr(tab_value, pce_index1, pce_index2); tab_to_col := int(pce_string); exitif this_column < tab_to_col; ! Exit if tab setting found pce_index3 := pce_index1 + pce_index2 + 1; exitif pce_index3 >= string_length; ! Exit if no more tab settings rest_of_str := substr(tab_value,pce_index3, (string_length-pce_index3)+1); pce_index1 := pce_index3; pce_index2 := index(rest_of_str,search_string) -1; endloop; if pce_index3 >= string_length then copy_text(" "); ! 1 space else if (pce_index3 >= string_length) or (this_column >= tab_to_col) then copy_text(" "); ! 1 space else eve$to_column(tab_to_col); ! n spaces endif; endif; endif; endif; ENDPROCEDURE; !**************************************** ! ! EVEPlus procedures follow: ! These routines were obtained from DECUS and copied ! here. ! !+ ! WHAT.TPU - Displays a message with the current line number, ! total number of lines in the file, and the percentage. !- ! PROCEDURE EVE_WHAT_LINE ! 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 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); 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 on line !SL out of !SL (!SL%)", low_line, total_lines, percent)); position (this_position); ENDPROCEDURE; !**************************************** ! ! Following code is for the SPELLING CHECKER ! All of the following procedures were initially added on 870714 by RHS ! Any changes made since that time will be noted in the individual procedure ! PROCEDURE LOAD_DICTIONARIES !=========================================================================== ! Load Dictionaries Into Internal Data Structure(s) !=========================================================================== local project_dict, ! integer - project dict available flag use_dict, ! integer - user dictionary available flag func, ! integer - call_user function code ret; ! string - call_user returned string (not used) message('Loading common, project and user dictionaries'); ! load common dictionary func := 1; ret := call_user(func,''); if func = 0 then message('Error - common dictionary not found'); return(0); endif; ! load project dictionary func := 2; ret := call_user(func,''); if func = 1 then project_dict := 1; else project_dict := 0; endif; ! load user dictionary func := 3; ret := call_user(func,''); if func = 1 then user_dict := 1; else user_dict := 0; endif; ! display a warning messages if appropriate if (project_dict = 0) and (user_dict = 0) then message('Warning - project and user dictionaries not found'); endif; if (project_dict = 0) and (user_dict = 1) then message('Warning - project dictionary not found'); endif; if (project_dict = 1) and (user_dict = 0) then message('Warning - user dictionary not found'); endif; dictionary$available := 1; return(1); ENDPROCEDURE; PROCEDURE SPELL_CHECK_RANGE (SPELL_RANGE) !=========================================================================== ! Spell Check A Specified Range !=========================================================================== local word_range, ! range - range of current word word_pattern, ! pattern - word recognition pattern replacement_word, ! string - replacement word func, ! integer - call_user function code ret; ! string - call_user returned string (not used) ! ignore string not found error on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return (0); endif; endon_error; ! set buffer direction set (forward,current_buffer); ! check the spelling of all of the words within the range word_pattern := span('abcdefghijklmnopqrstuvwxyz'); position(beginning_of(spell_range)); loop word_range := search(word_pattern,forward,no_exact); exitif word_range = 0; exitif beginning_of(word_range) >= end_of(spell_range); position(end_of(word_range)); word_range := create_range(beginning_of(word_range), end_of(word_range),reverse); update(current_window); func := 4; ret := call_user(func,substr(word_range,1,length(word_range))); if func = 0 then replacement_word := read_line ('Enter replacement word : '); update(eve$command_window); if last_key = ctrl_z_key then word_range := create_range(beginning_of(word_range), end_of(word_range),none); return(1); endif; if length(replacement_word) > 0 then erase(word_range); copy_text(replacement_word); update(current_window); endif; endif; word_range := create_range(beginning_of(word_range), end_of(word_range),none); move_horizontal(1); endloop; position(end_of(spell_range)); return(1); ENDPROCEDURE; PROCEDURE CHECK_FOR_PARAGRAPH_BREAK !=========================================================================== ! Check If The Current Line Is A Paragraph Break !=========================================================================== local paragraph_break; on_error return (0); endon_error; paragraph_break := anchor & line_begin & ((eve$x_null | span(eve$x_word_separators)) & line_end); if search(paragraph_break,forward) <> 0 then return (1); endif; ENDPROCEDURE; PROCEDURE EVE_SPELL (SPELL_PARAMETER) !=========================================================================== ! Select A Range Of Lines In The Current Buffer To Spell Check ! And The Method Of How It Will Be Checked !=========================================================================== local cmd, ! string - first letter of selection current, ! marker - current position start_paragraph, ! marker - start of the current paragraph end_paragraph, ! marker - end of the current paragraph spell_range; ! range - range to be spell checked ! set the buffer direction to forward set (forward,current_buffer); ! check for empty buffer if beginning_of(current_buffer) = end_of(current_buffer) then message('Buffer empty'); return(1); endif; ! load the dictionaries if they are not already available if dictionary$available = 0 then if load_dictionaries = 0 then return(1); endif; endif; ! check for empty (null) parameter, if yes spell check current buffer. if length(spell_parameter) = 0 then spell_range := create_range(beginning_of(current_buffer), end_of(current_buffer),none); if spell_check_range(spell_range)then message('End of Spelling Check'); endif; return(1); endif; ! get the first character of the parameter change_case(spell_parameter,upper); cmd := substr(spell_parameter,1,1); ! check if the spell parameter is 'BUFFER' if cmd = 'B' then spell_range := create_range(beginning_of(current_buffer), end_of(current_buffer),none); if spell_check_range(spell_range)then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'PARAGRAPH' if cmd = 'P' then ! save current position current := mark(none); ! find the beginning of the current paragraph move_horizontal(-current_offset); loop exitif mark(none) = beginning_of(current_buffer); move_vertical(-1); if check_for_paragraph_break then move_vertical(1); exitif 1; endif; endloop; start_paragraph := mark(none); ! find the end of the current paragraph position(current); move_horizontal(-current_offset); loop exitif mark(none) = end_of(current_buffer); exitif check_for_paragraph_break; move_vertical(1); endloop; end_paragraph := mark(none); ! set the spell check range to current paragraph spell_range := create_range(start_paragraph,end_paragraph,none); if spell_check_range(spell_range)then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'C' if cmd = 'C' then if spell_check_c then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'DCL' if cmd = 'D' then if spell_check_dcl then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'FORTRAN' if cmd = 'F' then if spell_check_fortran then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'MACRO' if cmd = 'M' then if spell_check_macro then message('End of Spelling Check'); endif; return(1); endif; ! check if the spell parameter is 'RNO' if cmd = 'R' then if spell_check_rno then message('End of Spelling Check'); endif; return(1); endif; ! display error message message(fao('Unknown spell parameter (!AS)',spell_parameter)); ENDPROCEDURE; PROCEDURE TEST_IF_BUFFER_EXISTS (BUFFER_NAME) !=========================================================================== ! Test If A Buffer Already Exists !=========================================================================== local test_buffer; test_buffer := get_info(buffers,'first'); loop exitif test_buffer = 0; if get_info(test_buffer,'name') = buffer_name then return (1); else test_buffer := get_info(buffer,'next'); endif; endloop; return (0); ENDPROCEDURE; PROCEDURE EVE_LOAD_USER_DICTIONARY !=========================================================================== ! Load The Words In The User Dictionary Into A Special Buffer !=========================================================================== local count, ! integer - word count func, ! integer - call_user function code retstr; ! string - call_user returned string ! save the current buffer default$buffer := current_buffer; ! test if the user dictionary buffer already exists if test_if_buffer_exists('USER DICTIONARY') = 0 then dictionary$buffer := create_buffer('USER DICTIONARY'); set (no_write,dictionary$buffer,on); endif; ! empty the user dictionary buffer and map it to the current window erase (dictionary$buffer); map(current_window,dictionary$buffer); eve$set_status_line(current_window); ! get first word from use dictionary func := 8; retstr := call_user(func,''); ! if no word was found insert the default word list into the buffer ! otherwise insert word from user dictionary into the buffer if func = 0 then copy_text('ar'); split_line; copy_text('dept'); split_line; message('User dictionary empty, initial word list loaded into buffer'); else copy_text(retstr); count := 1; loop func := 9; retstr := call_user(func,''); exitif func = 0; split_line; copy_text(retstr); count := count + 1; endloop; message(fao('!SL word(s) loaded from user dictionary',count)); endif; ENDPROCEDURE; PROCEDURE EVE_UPDATE_USER_DICTIONARY !=========================================================================== ! Insert the words in the current buffer in to the user dictionary !=========================================================================== local word_pattern, ! pattern - word recognition pattern word_count, ! integer - number of words saved in dictionary func, ! integer - call_user function code ret; ! string - call_user returned string (not used) ! ignore string not found error on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! set the buffer direction to forward set (forward,current_buffer); ! initialize use dictionary data structure(s) func := 5; ret := call_user(func,''); ! insert all of the words in the current buffer into the user dictionary word_pattern := span('abcdefghijklmnopqrstuvwxyz'); position(beginning_of(current_buffer)); loop word_range := search(word_pattern,forward,no_exact); exitif word_range = 0; exitif beginning_of(word_range) >= end_of(current_buffer); word_range := create_range(beginning_of(word_range), end_of(word_range),reverse); update(current_window); func := 6; ret := call_user(func,substr(word_range,1,length(word_range))); if func = 1 then word_count := word_count + 1; word_range := create_range(beginning_of(word_range), end_of(word_range),none); position(end_of(word_range)); move_horizontal(1); else if func = 2 then message('Error - maximum word size exceeded'); endif; if func = 3 then message('Error - word buffer overflow'); endif; if func = 4 then message('Error - maximum number of words exceeded'); endif; word_range := create_range(beginning_of(word_range), end_of(word_range),none); return(0); endif; endloop; position(end_of(current_buffer)); ! write the user dictionary data structure(s) to a file func := 7; ret := call_user(func,''); if func = 1 then if default$buffer <> 0 then map(current_window,default$buffer); eve$set_status_line(current_window); endif; message(fao('!SL word(s) stored in user dictionary file',word_count)); else if func = 2 then message('Error opening user dictionary file'); endif; if func = 3 then message('Error writing user dictionary file'); endif; endif; ENDPROCEDURE; PROCEDURE SPELL_CHECK_C !====================================================================== ! Spell Check A C Source Code File !====================================================================== local spell_range, ! range - range to be spell checked pat1; ! pattern - comment recognition pattern on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := '/*' & match('*/'); ! C comment ! spell check comments !position(beginning_of(current_buffer)); loop spell_range := search(pat1,forward); exitif spell_range = 0; spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; position(end_of(spell_range)); endloop; position(end_of(current_buffer)); return(1); ENDPROCEDURE; PROCEDURE SPELL_CHECK_DCL !====================================================================== ! Spell Check A DCL Command File !====================================================================== local spell_range, ! range - range to be spell checked pat1; ! pattern - comment recognition pattern on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := any("!") & remain; ! DCL comment ! spell check comments !position(beginning_of(current_buffer)); loop exitif mark(none) = end_of(current_buffer); move_horizontal(-current_offset); spell_range := search(pat1,forward,no_exact); ! look for a comment if spell_range <> 0 then spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; move_vertical(1); endloop; position(end_of(current_buffer)); return(1); ENDPROCEDURE; PROCEDURE SPELL_CHECK_FORTRAN !====================================================================== ! Spell Check A FORTRAN Source Code File !====================================================================== local spell_range, ! range - range to be spell checked pat1, ! pattern - comment recognition pattern pat2, ! pattern - comment recognition pattern pat3; ! pattern - character constant recognition pattern on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := anchor & line_begin & ("c" | "C") & remain; ! FORTRAN comment pat2 := any("!") & remain; ! FORTRAN comment pat3 := any("'") & scan("'"); ! character constant ! spell check comments position(beginning_of(current_buffer)); loop ! look for comment lines starting with a "C" in column one exitif mark(none) = end_of(current_buffer); move_horizontal(-current_offset); spell_range := search(pat1,forward); if spell_range <> 0 then if length(spell_range) > 1 then move_horizontal(1); spell_range := create_range(mark(none),end_of(spell_range),none); spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; else ! look for comment starting with a "!" spell_range := search(pat2,forward,no_exact); if spell_range <> 0 then spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; endif; move_vertical(1); endloop; ! spell check character constants message('Spell checking all character constants'); position(beginning_of(current_buffer)); loop exitif mark(none) = end_of(current_buffer); spell_range := search(pat3,forward,no_exact); exitif spell_range = 0; spell_check_range(spell_range); exitif last_key = ctrl_z_key; position(end_of(spell_range)); move_horizontal(1); endloop; position(end_of(current_buffer)); return(1); ENDPROCEDURE; PROCEDURE SPELL_CHECK_MACRO !====================================================================== ! Spell Check A MACRO Source Code File !====================================================================== local spell_range, ! range - range to be spell checked pat1; ! pattern - comment recognition pattern on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := any(";") & remain; ! spell check comments ! MACRO comment !position(beginning_of(current_buffer)); loop exitif mark(none) = end_of(current_buffer); move_horizontal(-current_offset); spell_range := search(pat1,forward,no_exact); ! look for a comment if spell_range <> 0 then spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; move_vertical(1); endloop; position(end_of(current_buffer)); return(1); ENDPROCEDURE; PROCEDURE SPELL_CHECK_RNO !====================================================================== ! Spell Check A RUNOFF Source Code File !====================================================================== local spell_range, ! range - range to be spell checked pat1, ! pattern - command recognition pattern pat2, ! pattern - secondary command recognition pattern pat3, ! pattern - secondary command recognition pattern curr_post; ! position- position in buffer where checking starts on_error if error <> TPU$_STRNOTFOUND then message('Internal error - contact system support'); return(0); endif; endon_error; ! create recognition pattern(s) pat1 := anchor & notany(".") & remain; ! RUNOFF command pat2 := anchor & any(".") & match(";") & remain; ! RUNOFF command w/text pat3 := any(";") & remain; ! spell check non-RUNOFF-command lines !position(beginning_of(current_buffer)); curr_post := mark(none); loop exitif mark(none) = end_of(current_buffer); spell_range := search(pat1,forward,no_exact); if spell_range <> 0 then spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; move_horizontal(-current_offset); move_vertical(1); endloop; ! ! now check the command lines that begin with a '.' and have a ';' ! somewhere on the line (e.g. .le;) ! message('Spell checking all Runoff commands with text'); position(curr_post); loop exitif mark(none) = end_of(current_buffer); spell_range := search(pat2,forward,no_exact); spell_range := search(pat3,forward,no_exact); if spell_range <> 0 then spell_check_range(spell_range); if last_key = ctrl_z_key then return(1); endif; endif; move_horizontal(-current_offset); move_vertical(1); endloop; position(end_of(current_buffer)); return(1); ENDPROCEDURE; ! ! Define the keys, user_variables, save the section, and quit. ! pce$standard_keys; compile("procedure pce$standard_keys endprocedure"); save ("tpu$eveplus:extended_eve.tpu$section"); quit;