! ------------------------------------------------------------------------------ ! DEV_TPU:EDTEM.TPU ! ----------------- ! ! PP&L standard TPU-emulated EDT with multiple enhancements ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! Here is the baseline editor................................................... ! ------------------------------------------------------------------------------ ! *** Bind all EDT and EDTEM keys *** PROCEDURE EDT$define_keys !define all keys LOCAL km0, km1, km2, km3; ! ------------------- ! Create the key maps ! ------------------- km0 := "TPU$KEY_MAP"; km1 := CREATE_KEY_MAP ("TTK_map_1"); km2 := CREATE_KEY_MAP ("TTK_map_2"); km3 := CREATE_KEY_MAP ("TTK_map_3"); ! arrow keys ! DEFINE_KEY ( 'ppl_left', LEFT, "-C (LEFT arrow)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;SHIFT ( CURRENT_WINDOW, +32 )', LEFT, "shift_left (GOLD-LEFT arrow)", km1 ); DEFINE_KEY ( 'ppl_right', RIGHT, "+C (RIGHT arrow)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;SHIFT ( CURRENT_WINDOW, -32 )', RIGHT, "shift_right (GOLD-RIGHT arrow)", km1 ); DEFINE_KEY ( 'ppl_down', DOWN, "DOWN (DOWN arrow)", km0 ); DEFINE_KEY ( 'ppl_up', UP, "UP (UP arrow)", km0 ); ! editing keypad keys ! DEFINE_KEY ( 'ppl_normal_find', E1, "Find (E1)", km0 ); DEFINE_KEY ( 'EDT$paste', E2, "Paste (E2)", km0 ); DEFINE_KEY ( 'EDT$cut', E3, "Cut (E3)", km0 ); DEFINE_KEY ( 'EDT$select', E4, "Select (E4)", km0 ); DEFINE_KEY ( 'EDT$section(REVERSE)', E5, "Previous_Screen (E5)", km0 ); DEFINE_KEY ( 'EDT$section(FORWARD)', E6, "Next_Screen (E6)", km0 ); ! function keys ! DEFINE_KEY ('ppl_reset_keymap_list;ppl_exit (1)', F10, 'F10 ...exit the editing session, saving all changes',km0); DEFINE_KEY ( 'ppl_keypad_help', HELP, "<0>HELP ...invoke keypad layout diagram", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;ppl_keypad_help', HELP, "<1>HELP ...invoke keypad layout diagram", km1 ); ! numeric/application keypad keys !first row ! DEFINE_KEY ( 'ppl_keypad_help', PF2, "<0>PF2 ...invoke keypad layout diagram", km0 ); DEFINE_KEY ( 'ppl_keypad_help;ppl_reset_keymap_list', PF2, "<1>PF2 ...invoke keypad layout diagram", km1 ); DEFINE_KEY ( 'P$_search_next ( GV$_search_string )', PF3, "next (PF3)", km0 ); DEFINE_KEY ( 'EDT$delete_line', PF4, "delete_L (PF4)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$undelete_line', PF4, "undelete_L (GOLD-PF4)", km1 ); ! second row ! DEFINE_KEY ( 'EDT$page', KP7, "page (KP7)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$command', KP7, "TPU_command (GOLD-KP7)", km1 ); DEFINE_KEY ( 'edt$section (CURRENT_DIRECTION)', KP8, "paragraph (KP8)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$fill (0)', KP8, "fill (GOLD-KP8)", km1 ); DEFINE_KEY ( 'EDT$append', KP9, "append (KP9)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$replace', KP9, "replace (GOLD-KP9)", km1 ); DEFINE_KEY ( 'EDT$delete_end_word', MINUS, "delete_W (MINUS)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$undelete_word', MINUS, "undelete_W (GOLD-MINUS)", km1 ); !third row ! DEFINE_KEY ( 'ppl_reset_keymap_list;ppl_eob', KP4, "bottom (GOLD-KP4)", km1 ); DEFINE_KEY ( 'ppl_reset_keymap_list;ppl_bob', KP5, "top (GOLD-KP5)", km1 ); DEFINE_KEY ( 'EDT$cut', KP6, "cut (KP6)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$paste', KP6, "paste (GOLD-KP6)", km1 ); DEFINE_KEY ( 'EDT$delete_char', COMMA, "delete_C (COMMA)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$undelete_char', COMMA, "undelete_C (GOLD-COMMA)", km1 ); !fourth row ! DEFINE_KEY ( 'EDT$move_word', KP1, "word (KP1)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$change_case', KP1, "change_case (GOLD-KP1)", km1 ); DEFINE_KEY ( 'EDT$end_of_line', KP2, "EOL (KP2)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$delete_to_eol', KP2, "delete_EOL (GOLD-KP2)", km1 ); DEFINE_KEY ( 'EDT$move_char', KP3, "char (KP3)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;COPY_TEXT (ASCII (INT (READ_LINE ("SpecIns: "))))', KP3, "SpecIns (GOLD-KP3)", km1 ); !fifth row ! DEFINE_KEY ( 'EDT$next_prev_line ( CURRENT_DIRECTION )', KP0, "line (KP0)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;ppl_open_line', KP0, "open_line (GOLD-KP0)", km1 ); DEFINE_KEY ( 'EDT$select', PERIOD, "select (PERIOD)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$reset', PERIOD, "reset (GOLD-PERIOD)", km1 ); DEFINE_KEY ( 'ppl_auto_scroll', ENTER, "ENTER ...auto scroll", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;EDT$substitute', ENTER, "substitute (ENTER)", km1 ); ! control keys ! DEFINE_KEY ('ppl_toggle_modes', CTRL_A_KEY, 'A ...toggle between insert and overstrike modes', km0); DEFINE_KEY ( 'ppl_toggle_status_line_mode', CTRL_B_KEY, 'B ...toggle between normal and brief status line modes', km0); DEFINE_KEY ( 'ppl_untab', CTRL_D_KEY, 'D ...Perform a de-tab operation', km0); DEFINE_KEY ( 'ppl_goto_eol', CTRL_E_KEY, 'E ...go to end of current line', km0 ); DEFINE_KEY ( 'ppl_box_comment', CTRL_F_KEY, 'F ...frame a single-line comment (according to language type)', km0); DEFINE_KEY ('ppl_untranspose', CTRL_G_KEY, 'G ...transpose current and previous characters', km0); DEFINE_KEY ( 'EDT$backspace', BS_KEY, " (BS,CTRL/H)", km0 ); DEFINE_KEY ( 'EDT$del_beg_word', LF_KEY, "delete_previous_word (LF,CTRL/J)", km0 ); DEFINE_KEY ( 'ppl_tab', TAB_KEY, ' ...tab to next tab stop', km0); DEFINE_KEY ( 'ppl_invert_word', CTRL_K_KEY, 'K ...invert the case of the previous or current word', km0); DEFINE_KEY ( 'COPY_TEXT (GV$_ff)', CTRL_L_KEY, " (FF,CTRL/L)", km0 ); DEFINE_KEY ( 'ppl_ret_key', RET_KEY, " (RETURN,CTRL/M)", km0 ); DEFINE_KEY ( 'ppl_indent_as_above (1)', CTRL_N_KEY, 'N ...indent to level of last non-comment, non-blank line (add below)', km0); DEFINE_KEY ( 'ppl_indent_as_above (-1)', CTRL_P_KEY, 'P ...indent to level of last non-comment, non-blank line (add above)', km0); DEFINE_KEY ( 'ppl_space', KEY_NAME (' '), ' ...enter a space into the text source', km0); ! ---------------------------------- ! Define the learn mode key sequence ! ---------------------------------- P$_toggle_learn; DEFINE_KEY ( 'EDT$delete_beg_line', CTRL_U_KEY, "delete_to_BOL (CTRL/U)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;ppl_align_to_previous_entry', ctrl_v_key, ' V ...align column against next non-blank column position of prev line', km0); DEFINE_KEY ( 'REFRESH', CTRL_W_KEY, "refresh_screen (CTRL/W)", km0 ); DEFINE_KEY ( 'ppl_reset_keymap_list;ppl_exit (1)', ctrl_z_key, ' Z ...exit the editing session, saving all changes',km0); ! GOLD-letter keys ! ! Define the numeric keys for use with ppl_repeat ! to execute EDT repeat counts: DEFINE_KEY ( 'ppl_repeat("0")', KEY_NAME('0'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("1")', KEY_NAME('1'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("2")', KEY_NAME('2'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("3")', KEY_NAME('3'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("4")', KEY_NAME('4'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("5")', KEY_NAME('5'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("6")', KEY_NAME('6'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("7")', KEY_NAME('7'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("8")', KEY_NAME('8'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("9")', KEY_NAME('9'), "", km1 ); DEFINE_KEY ( 'ppl_repeat("-")', KEY_NAME('-'), "", km1 ); ! --------------- ! EDTEM functions ! --------------- ! ------------------ ! Upper case version ! ------------------ DEFINE_KEY ('ppl_reset_keymap_list;ppl_adjust_window', KEY_NAME ('A'), ' A ...adjust the top and bottom limits of the current window',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_buffer', KEY_NAME ('B'), ' B ...go to specified buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_create_and_map', KEY_NAME ('C'), ' C ...create and map a window to the current buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_dcl_command ("",1)', KEY_NAME ('D'), ' D ...issue an online DCL command',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_exit (1)', KEY_NAME ('E'), ' E ...exit the editing session, saving all changes',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_flagged_buffer', KEY_NAME ('F'), ' F ...go to flagged buffer or include flagged file',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_display_on_full_screen', KEY_NAME ('G'), ' G ...display current buffer using full screen',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_help', KEY_NAME ('H'), ' H ...display user standard function descriptions',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_fetch_file ("")', KEY_NAME ('I'), ' I ...read a file into a new buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_cut_rectangle', KEY_NAME ('K'), ' K ...cut a marked rectangle',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_previous_buffer', KEY_NAME ('L'), ' L ...go to the previously active buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_main_buffer', KEY_NAME ('M'), ' M ...go to the main editing buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_keypad', KEY_NAME ('N'), ' N ...toggle between application and numeric keypad modes',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_output_mode', KEY_NAME ('O'), ' O ...toggle buffer output status modes (readonly, write)',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_write_buffer', KEY_NAME ('P'), ' P ...write the selected range to a device or file',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_quit (1)', KEY_NAME ('Q'), ' Q ...quit the editing session without saving changes',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_find_and_replace (1)', KEY_NAME ('R'), ' R ...sequential queried search and replace',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_show_buffers', KEY_NAME ('S'), ' S ...display active buffers with count of mapped windows',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_specify_output', KEY_NAME ('T'), ' T ...redefine the output file/device of the current buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_delete_window ("")', KEY_NAME ('U'), ' U ...delete the current window',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_mark_rectangle', KEY_NAME ('V'), ' V ...mark a rectangle paste boundary',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_visit_forward_windows', KEY_NAME ('W'), ' W ...step through the mapped windows',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_attach', KEY_NAME ('X'), ' X ...return to parent process (TPU command mode, only)',km1); ! ------------------ ! Lower case version ! ------------------ DEFINE_KEY ('ppl_reset_keymap_list;ppl_adjust_window', KEY_NAME ('a'), ' A ...adjust the top and bottom limits of the current window',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_buffer', KEY_NAME ('b'), ' B ...go to specified buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_create_and_map', KEY_NAME ('c'), ' C ...create and map a window to the current buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_dcl_command ("",1)', KEY_NAME ('d'), ' D ...issue an online DCL command',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_exit (1)', KEY_NAME ('e'), ' E ...exit the editing session, saving all changes',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_flagged_buffer', KEY_NAME ('f'), ' F ...go to flagged buffer or include flagged file',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_display_on_full_screen', KEY_NAME ('g'), ' G ...display current buffer using full screen',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_help', KEY_NAME ('h'), ' H ...display user standard function descriptions',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_fetch_file ("")', KEY_NAME ('i'), ' I ...read a file into a new buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_cut_rectangle', KEY_NAME ('k'), ' K ...cut a marked rectangle',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_previous_buffer', KEY_NAME ('l'), ' L ...go to the previously active buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_main_buffer', KEY_NAME ('m'), ' M ...go to the main editing buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_keypad', KEY_NAME ('n'), ' N ...toggle between application and numeric keypad modes',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_output_mode', KEY_NAME ('o'), ' O ...toggle buffer output status modes (readonly, write)',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_write_buffer', KEY_NAME ('p'), ' P ...write the selected range to a device or file',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_quit (1)', KEY_NAME ('q'), ' Q ...quit the editing session without saving changes',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_find_and_replace (1)', KEY_NAME ('r'), ' R ...sequential queried search and replace',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_show_buffers', KEY_NAME ('s'), ' S ...display active buffers with count of mapped windows',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_specify_output', KEY_NAME ('t'), ' T ...redefine the output file/device of the current buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_delete_window ("")', KEY_NAME ('u'), ' U ...delete the current window',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_mark_rectangle', KEY_NAME ('v'), ' V ...mark a rectangle paste boundary',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_visit_forward_windows', KEY_NAME ('w'), ' W ...step through the mapped windows',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_attach', KEY_NAME ('x'), ' X ...return to parent process (TPU command mode, only)',km1); ! ---------------- ! Non-letter stuff ! ---------------- DEFINE_KEY ('ppl_reset_keymap_list;ERASE (message_buffer)', KEY_NAME (' '), ' ...clear the message buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_spawn (1)', KEY_NAME ('+'), ' + ...spawn subprocess with optional one-shot command',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_set_right_margin', KEY_NAME ('<'), " < ...adjust current window's horizontal screen width",km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_set_left_margin', KEY_NAME ('>'), " > ...set left margin",km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_mark_cur_pos', KEY_NAME ('['), ' [ ...remember current position with current buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_last_marked_pos', KEY_NAME (']'), ' ] ...return to remembered position within current buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_describe_function', KEY_NAME ('`'), ' ` ...describe user function',km1); DEFINE_KEY ( 'ppl_reset_keymap_list;ppl_next_tab_stop', KEY_NAME (','), ', ...position to next space mode tab stop', km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_save_context', KEY_NAME ('|'), ' | ...save current function key definitions',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_show_ruler', KEY_NAME ('\'), ' \ ...display ruler in current buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_insert_ruler', KEY_NAME ('/'), ' / ...insert ruler into buffer above current line',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_trimt_all (1)', KEY_NAME ('{'), ' { ...trim trailing blanks and tabs from all lines',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_trimt', KEY_NAME ('}'), ' } ...trim trailing blanks and tabs from current line',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_comfile_mode', KEY_NAME ('$'), ' $ ...toggle command file auto prompt mode',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_compile_source (2)', KEY_NAME ('?'), ' ? ...compile source (/NOOBJECT/LIST) in current buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_sort', KEY_NAME ('='), ' = ...sort subset or all of current buffer contents', km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_create_scratch_buffer', ctrl_b_key, ' B ...create a scratch buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_declare_variable', ctrl_d_key, ' D ...declare / view source language variable',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_fill_comment (1)', ctrl_f_key, 'F ...fill and (re-)frame a comment block',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_include_file ("")', ctrl_i_key, ' I ...read a file into the current buffer at current line',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_paste_rectangular', ctrl_k_key, ' K ...paste a rectangle into the current buffer',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_find_and_replace (0)', ctrl_r_key, ' R ...resume find and replace operation',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_unmark_rectangle', ctrl_v_key, ' V ...remove a rectangle paste boundary',km1); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_width', ctrl_w_key, ' W ...toggle between normal (80) and wide (132) column modes',km1); ! ------------- ! DEC overrides ! ------------- DEFINE_KEY ('ppl_forward', Kp4, "advance (KP4)", km0); DEFINE_KEY ('ppl_reverse', Kp5, "backup (KP5)", km0); DEFINE_KEY ('ppl_reset_keymap_list;ppl_normal_find', PF3, "find (GOLD-PF3)", km1); DEFINE_KEY ('ppl_rubout', del_key, 'delete_previous_char () ! ---------------------- DEFINE_KEY ('ppl_reset_keymap_list;ppl_visit_forward_windows', PF3, '<2>PF3 ...step through the mapped windows', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_delete_window ("")', PF4, '<2>PF4 ...delete the current window', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_buffer', KP7, '<2>KP7 ...go to specified buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_previous_buffer', KP8, '<2>KP8 ...go to the previously active buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_mark_cur_pos', KP9, '<2>KP9 ...remember current position with current buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_last_marked_pos', MINUS, '<2>MINUS ...return to previous position', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_create_and_map', KP4, '<2>KP4 ...create and map a window to the current buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_main_buffer', KP5, '<2>KP5 ...go to the main editing buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_show_buffers', KP6, '<2>KP6 ...display active buffers with count of mapped windows', km2); DEFINE_KEY ('ppl_reset_keymap_list;EDT$backspace', COMMA, '<2>COMMA ...go to beginning of line', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_scroll', KP1, '<2>KP1 ...toggle between jump and smooth scroll modes', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_display_on_full_screen', KP2, '<2>KP2 ...display current buffer using full screen', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_compile_source (1)', KP3, '<2>KP3 ...compile source (/NOOBJECT/LIST) in current buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_equalize_window_sizes', KP0, '<2>KP0 ...equalize the size of all visible user windows', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_flagged_buffer', ENTER, '<2>ENTER ...go to flagged buffer or include flagged file', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_check_spelling', KEY_NAME ('C'), '<2>C ...check spelling', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_check_spelling', KEY_NAME ('c'), '<2>C ...check spelling', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_insert_date', KEY_NAME ('D'), '<2>D ...insert date', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_insert_date', KEY_NAME ('d'), '<2>D ...insert date', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_exit (0)', KEY_NAME ('E'), '<2>E ...exit session without checking for modified MAIN buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_exit (0)', KEY_NAME ('e'), '<2>E ...exit session without checking for modified MAIN buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_strip_nonprintables (CURRENT_BUFFER)', KEY_NAME ('K'), '<2>K ...strip commonly found non-printable characters from buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_strip_nonprintables (CURRENT_BUFFER)', KEY_NAME ('k'), '<2>K ...strip commonly found non-printable characters from buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_line', KEY_NAME ('L'), '<2>L ...go to specified line within current buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_line', KEY_NAME ('l'), '<2>L ...go to specified line within current buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_move_to_buffer ("", 0)', KEY_NAME ('M'), '<2>M ...copy the contents of current buffer to new buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_move_to_buffer ("", 0)', KEY_NAME ('m'), '<2>M ...copy the contents of current buffer to new buffer', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_replace_library_module', KEY_NAME ('O'), '<2>O ...return a library module to its library', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_replace_library_module', KEY_NAME ('o'), '<2>O ...return a library module to its library', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_quit (0)', KEY_NAME ('Q'), '<2>Q ...quit without checking for modified write-mode buffers', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_quit (0)', KEY_NAME ('q'), '<2>Q ...quit without checking for modified write-mode buffers', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_show_cursor', KEY_NAME ('S'), '<2>S ...display cursor statistics', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_show_cursor', KEY_NAME ('s'), '<2>S ...display cursor statistics', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_insert_time', KEY_NAME ('T'), '<2>T ...insert time', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_insert_time', KEY_NAME ('t'), '<2>T ...insert time', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_remember_search_column_range', KEY_NAME ('V'), '<2>V ...store limited search column range', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_remember_search_column_range', KEY_NAME ('v'), '<2>V ...store limited search column range', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_spawn (2)', KEY_NAME ('+'), '<2> + ...attach to previously spawned subprocess', km2); DEFINE_KEY ('ppl_reset_keymap_list;ppl_fill_comment (0)', CTRL_F_KEY, '<2>F ...reframe comment block without refilling', km2); ! ---------------------------- ! Level 3 () ! ---------------------------- DEFINE_KEY ('ppl_reset_keymap_list;ppl_find_all', PF3, '<3>PF3 ...list all occurences of a string in current buffer', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_convert_tabs', KP0, '<3>KP0 ...convert real tabs in current buffer to spaces', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_set_clr_tabs', KP1, '<3>KP1 ...set / clear tabs', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_chg_tab_mode', KP2, '<3>KP2 ...toggle between real and space tabs modes', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_auto_indent_mode', KP3, '<3>KP3 ...toggle between normal and auto-indent modes', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_cursor_mode', KP4, '<3>KP4 ...toggle between normal and free cursor modes', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_shift_source', KP5, '<3>KP5 ...shift source by tab stops', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_auto_wrap_mode', KP6, '<3>KP6 ...toggle between normal and auto-wrap modes', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_fill_and_justify', KP7, '<3>KP7 ...peform a fill and justify operation', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_right_justify (0)', KP8, '<3>KP8 ...perform a right-justification of selected text', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_mark_user_pos', KP9, '<3>KP9 ...mark user-specified position', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_go_to_user_pos', MINUS, '<3>MINUS ...return to user-specified position', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_tab_settings', COMMA, '<3>COMMA ...toggle between normal and auto-indent modes', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_translate', ENTER, '<3>ENTER ...translate current buffer', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_catch_all', PF4, '', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_edit_range (COMPRESS)', KEY_NAME (' '), '<3> ...compress buffer or range', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_vassar_spell', KEY_NAME ('C'), '<3>C ...invoke the Vassar spelling checker against current buffer', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_vassar_spell', KEY_NAME ('c'), '<3>C ...invoke the Vassar spelling checker against current buffer', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_submit_dcl', KEY_NAME ('D'), '<3>D ...submit a range of DCL commands from the current buffer', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_submit_dcl', KEY_NAME ('d'), '<3>D ...submit a range of DCL commands from the current buffer', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_edit_range (LOWER)', KEY_NAME ('L'), '<3>L ...convert buffer or selected range to lower case', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_edit_range (LOWER)', KEY_NAME ('l'), '<3>L ...convert buffer or selected range to lower case', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_scroll_mode', KEY_NAME ('S'), '<3>S ...toggle between normal and workstation scroll modes', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_toggle_scroll_mode', KEY_NAME ('s'), '<3>S ...toggle between normal and workstation scroll modes', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_edit_range (UPPER)', KEY_NAME ('U'), '<3>U ...convert buffer or selected range to upper case', km3); DEFINE_KEY ('ppl_reset_keymap_list;ppl_edit_range (UPPER)', KEY_NAME ('u'), '<3>U ...convert buffer or selected range to upper case', km3); ENDPROCEDURE !EDT$define_keys ! ------------------------------------------------------------- ! This function is invoked when a user presses an undefined key ! ------------------------------------------------------------- PROCEDURE ppl_catch_all ppl_message ("That key is currently undefined"); ENDPROCEDURE; ! -------------------------------------------------------------------------- ! This procedure does absolutely nothing (it acts as a software null device) ! -------------------------------------------------------------------------- PROCEDURE ppl_null ERASE (message_buffer); MESSAGE ("That key is not defined"); ENDPROCEDURE ! --------------------------------------------- ! Enter a new shift level (i.e., a new key map) ! --------------------------------------------- PROCEDURE ppl_shift_key LOCAL keymap; ON_ERROR ppl_message (' '); ppl_reset_keymap_list; ABORT; ENDON_ERROR; GV$_shift_count := GV$_shift_count + 1; keymap := "TTK_map_" + STR (GV$_shift_count); ADD_KEY_MAP ("TPU$KEY_MAP_LIST", "FIRST", keymap); IF GV$_status_line_mode = 1 THEN ppl_update_status_line (CURRENT_WINDOW); ENDIF; ENDPROCEDURE; ! ------------------------------------------ ! Unwind the key maps down to the base level ! ------------------------------------------ PROCEDURE ppl_reset_keymap_list LOCAL keymap; ON_ERROR ENDON_ERROR; LOOP EXITIF GV$_shift_count = 0; keymap := "TTK_map_" + STR (GV$_shift_count); REMOVE_KEY_MAP ("TPU$KEY_MAP_LIST", keymap); GV$_shift_count := GV$_shift_count - 1; ENDLOOP; GV$_search_range2 := 0; IF GV$_status_line_mode = 1 THEN ppl_update_status_line (CURRENT_WINDOW); ENDIF; ENDPROCEDURE; ! -------------------- ! Keypad help facility ! -------------------- PROCEDURE ppl_keypad_help LOCAL fname, level, dummy; level := STR (GV$_shift_count); fname := "SYS_MANAGER:EDTEM.GOLD_" + level + "_HLP"; keypad_help_window_ := CREATE_WINDOW (1, 23, OFF); MAP (keypad_help_window_, keypad_help_buffer_); READ_FILE (fname); POSITION (BEGINNING_OF (keypad_help_buffer_)); ppl_remember_bufferwindow; ERASE (message_buffer); MESSAGE (''); MESSAGE (' ...press any key to continue'); SET (STATUS_LINE, CURRENT_WINDOW, REVERSE, ' Keypad layout for shift level <' + level + '>'); UPDATE (CURRENT_WINDOW); dummy := READ_KEY; ppl_delete_window (CURRENT_WINDOW); ERASE (message_buffer); ENDPROCEDURE; ! ---------------------- ! Function help facility ! ---------------------- PROCEDURE ppl_function_help (idx) LOCAL s_str, r, pos, ans, spos1, spos2; ON_ERROR ERASE (message_buffer); IF GV$_function_help_loaded = 0 THEN MESSAGE (''); MESSAGE ('The primary help library is not located on this node'); POSITION (CURRENT_WINDOW); SET (SCREEN_UPDATE, ON); RETURN; ENDIF; IF spos1 = 0 THEN MESSAGE (''); MESSAGE ('There is no help available on that topic...'); RETURN; ENDIF; ENDON_ERROR; ! -------------------------------------------------------- ! Load in the primary function help text on the first call ! -------------------------------------------------------- IF GV$_function_help_loaded = 0 THEN GV$_function_help_buffer := ppl_create_buffer ('PPL_FUNCTION_HELP', 1); POSITION (GV$_function_help_buffer); ERASE (GV$_function_help_buffer); SET (SCREEN_UPDATE, OFF); READ_FILE ('SYS_MANAGER:EDTEM_FUNCTIONS.HLP'); ERASE (message_buffer); SET (SCREEN_UPDATE, ON); GV$_function_help_loaded := 1; ENDIF; ! -------------------------------- ! Locate the appropriate help text ! -------------------------------- POSITION (BEGINNING_OF (GV$_function_help_buffer)); s_str := '~' + STR (idx) + '~'; spos1 := SEARCH (s_str, FORWARD); POSITION (spos1); MOVE_HORIZONTAL (-CURRENT_OFFSET); MOVE_VERTICAL (+1); ! ----------------------------------------- ! Extract the part relevent to our function ! ----------------------------------------- pos := SELECT (NONE); spos2 := SEARCH ('~', FORWARD); IF spos2 = 0 THEN POSITION (END_OF (CURRENT_BUFFER)); ELSE POSITION (spos2); MOVE_HORIZONTAL (-CURRENT_OFFSET); ENDIF; r := SELECT_RANGE; ! -------------------------- ! Copy it to the help buffer ! -------------------------- ppl_go_to_buffer_immediate ('PPL_USER_HELP'); ERASE (CURRENT_BUFFER); COPY_TEXT (r); POSITION (BEGINNING_OF (CURRENT_BUFFER)); MESSAGE (''); MESSAGE ( 'Scroll Up: Scroll Down: Exit: Remove: ^Z'); pos := 0; ! ---------------------------------------------------------------- ! Now, let the user just go up, down or exit from this help window ! ---------------------------------------------------------------- LOOP UPDATE (CURRENT_WINDOW); ans := READ_KEY; IF ans = CTRL_Z_KEY THEN ppl_delete_window (CURRENT_WINDOW); UPDATE (CURRENT_WINDOW); RETURN; ENDIF; IF ans = RET_KEY THEN ppl_go_to_previous_buffer; UPDATE (CURRENT_WINDOW); RETURN; ENDIF; IF ans = UP THEN EDT$section (REVERSE); ENDIF; IF ans = DOWN THEN EDT$section (FORWARD); ENDIF; ENDLOOP; ENDPROCEDURE; ! ----------------------------------------- ! Go to the beginning of the current buffer ! ----------------------------------------- PROCEDURE ppl_bob POSITION (BEGINNING_OF (CURRENT_BUFFER)); IF CURRENT_DIRECTION = REVERSE THEN ppl_forward; ENDIF; ENDPROCEDURE; ! ----------------------------------- ! Go to the end of the current buffer ! ----------------------------------- PROCEDURE ppl_eob POSITION (END_OF (CURRENT_BUFFER)); ENDPROCEDURE; ! Procedures with names beginning with EDT$ are EDT commands. These ! procedures are subject to change. In the future, Digital may supply ! new procedures beginning with EDT$, remove some of the EDT$ procedures, ! or change existing EDT$ procedures. The same is true for global variables ! with names beginning with EDT$. User-written procedures should not ! begin with EDT$. PROCEDURE EDT$init_variables GV$_null := ""; TRUE := 1; !booleans FALSE := 0; GV$_range_length := 7; GV$_ranges := " SELECT WHOLE REST BEFORE = "; GV$_make_buf_var := "NEW"; GV$_TPU_command_prompt := "TPU Command"; GV$_TPU_execute_string := GV$_null; GV$_deleted_str := GV$_null; GV$_TT_answerback_msg := "VT100"; GV$_alpha := "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"; GV$_upalpha := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; GV$_loalpha := "abcdefghijklmnopqrstuvwxyz"; GV$_digits := "0123456789"; GV$_Spaces := " " + " " + " "; GV$_tab_settings := " T" + " T" + " T" + " T" + " T" + " T" + " T" + " T" + " T" + " T" + " T" + " T" + " T" + " T" + " T" + " T "; GV$_default_tab_settings:= GV$_tab_settings; GV$_user_tab_settings := GV$_tab_settings; GV$_tab_set_in_use := 0; GV$_real_tabs := 1; GV$_left_margin := 1; GV$_right_margin := 0; GV$_auto_indent_mode := 0; GV$_auto_wrap_mode := 0; GV$_delete_crlf := 0; GV$_appended_line := 0; GV$_section_distance := 16; GV$_beginning_of_select := 0; GV$_select_is_active := 0; GV$_search_range := 0; GV$_select_range := 0; GV$_repeat_count := 1; GV$_shift_count := 0; GV$_translation_ready := 0; GV$_ctrl_tran_ready := 0; GV$_limited_search := 0; GV$_function_help_loaded := 0; GV$_status_line_mode := 1; GV$_arrow_skip_size := 1; GV$_free_cursor := 0; GV$_deleted_char := GV$_null; GV$_deleted_word := GV$_null; GV$_deleted_line := GV$_null; GV$_search_string := GV$_null; GV$_pre_search_string := GV$_null; GV$_replace_string := GV$_null; GV$_pre_replace_string := GV$_null; GV$_search_begin := TRUE; GV$_search_case := NO_EXACT; GV$_learn_mode := EXACT; GV$_video := REVERSE; GV$_info_stats_video := REVERSE; GV$_default_library := GV$_null; GV$_filetype := GV$_null; GV$_filedirectory := GV$_null; GV$_filedevice := GV$_null; GV$_repair_window := GV$_null; GV$_repair_ftype := GV$_null; GV$_repair_mode := GV$_null; GV$_prev_subproc_name := GV$_null; ! at this point, original EDTSECINI had the following two assignments: ! (1) edt$x_word := ""; ! (2) edt$x_control_chars := ! "^A^B^C^D^E^F^G^H^N^O" ! + "^P^Q^R^S^T^U^V^W^X^Y^Z^\^]^^^_" ; ! ...where the string in quotes actually consisted of non-printing control ! characters. Since this just won't ever print rationally, the following ! procedure now performs this initialization in place of that assignment, ! allowing this file to be printed without problems. Of course, the original ! variables are now named "GV$_word" and "GV$_control_characters". P$_init_char_strings; GV$_white_pattern := LINE_BEGIN & ( LINE_END | ( SPAN ( GV$_spc_tab ) & LINE_END ) ) & LINE_BEGIN ; GV$_forward_word := ( ANCHOR ! don't move off current character position; & ( ! if on EOL, then match those ! leading spaces, on a word delimiter ( LINE_END ) | ( SPAN(GV$_spc) ) ) !!! ( ( SPAN(GV$_spc) ) & ( ANY(GV$_word) | GV$_null) ) ) | ( ANY(GV$_word) ) !no leading spaces, on word !delimiter, move one past it... | ( SCAN(GV$_word) ) !no leading spaces, on real !word, go one beyond it... | REMAIN !no leading spaces, on last !real word of line, match ) !rest of line... & ( LINE_BEGIN | SPAN(GV$_spc) | GV$_null !after matching, ); !skip over trailing !spaces, except if !match occurred at EOL. !In this case, don't !skip over blanks. dictionary$available := 0; ENDPROCEDURE !EDT$init_variables ! ------------------- ! Define key (toggle) ! ------------------- PROCEDURE P$_toggle ( km, key, p_def, p_descr, s_def, s_descr ) LOCAL key_program, key_comment; ON_ERROR !just consume error message ENDON_ERROR key_program := LOOKUP_KEY ( key, PROGRAM, km ); key_comment := LOOKUP_KEY ( key, COMMENT, km ); IF ( key_comment = s_descr ) OR ( key_program = 0 ) !for initialization THEN DEFINE_KEY ( p_def, key, p_descr, km); ELSE DEFINE_KEY ( s_def, key, s_descr, km); ENDIF; ENDPROCEDURE !P$_toggle PROCEDURE P$_toggle_learn P$_toggle ( "TPU$KEY_MAP", CTRL_R_KEY, 'P$_learn; ppl_reset_keymap_list', "start_learn", 'P$_remember; ppl_reset_keymap_list', "remember_learn" ); ENDPROCEDURE !P$_toggle_learn ! --------------------------------------------------------------------------- ! Check if a key is a printing character (in DEC Multinational set). Returns ! the character if alphabetic, else returns the null string. (utility) ! --------------------------------------------------------------------------- PROCEDURE F$_alphabetic (this_key) LOCAL ascii_key; ascii_key := ASCII (this_key); IF ( ascii_key = ASCII(0) ) !? THEN RETURN (GV$_null); ELSE RETURN (ascii_key); ENDIF; ENDPROCEDURE !F$_alphabetic ! --------------------- ! Learn mode procedures ! Begin learn sequence ! --------------------- PROCEDURE P$_learn LOCAL lmode; ERASE (message_buffer); MESSAGE (''); MESSAGE ('...Define user function'); UPDATE (CURRENT_WINDOW); ! ------------------------------ ! Pick up the needed particulars ! ------------------------------ lmode := READ_LINE ('Use EXACT mode? (Y, N, or RETURN to abort) '); IF lmode = '' THEN ppl_clear_prompt; ERASE (message_buffer); RETURN; ENDIF; CHANGE_CASE (lmode, UPPER); IF (lmode <> 'Y') AND (lmode <> 'N') THEN MESSAGE (lmode+' is an invalid response...aborting'); ppl_clear_prompt; RETURN; ENDIF; ! ---------------------------------------- ! Initiate the function definition process ! ---------------------------------------- MESSAGE ('Enter the keystrokes to be memorized... use R to terminate'); IF lmode = 'Y' THEN LEARN_BEGIN (EXACT); ELSE LEARN_BEGIN (NO_EXACT); ENDIF; P$_toggle_learn; ENDPROCEDURE ! ------------------------- ! Remember a learn sequence ! ------------------------- PROCEDURE P$_remember LOCAL learn_sequence, learn_key, key_comment, desc, ans, define_error; ON_ERROR IF ERROR = TPU$_NOTLEARNING THEN MESSAGE ("Nothing to remember"); P$_toggle_learn; RETURN; ELSE IF ERROR = TPU$_RECURLEARN THEN define_error := TRUE; ENDIF; ENDIF; ENDON_ERROR; ! -------------------- ! Store the keystrokes ! -------------------- learn_sequence := LEARN_END; ! ------------------ ! Pick a key to bind ! ------------------ ERASE (message_buffer); LOOP MESSAGE ("Bind-key for learn-sequence (No definitions... Z to quit)? "); learn_key := READ_KEY; ! ------------------------- ! Don't keep it, after all? ! ------------------------- IF ( learn_key = CTRL_Z_KEY ) THEN ERASE (message_buffer); MESSAGE ("Learn canceled"); P$_toggle_learn; ABORT; ENDIF; key_comment := LOOKUP_KEY ( learn_key, COMMENT ); EDIT ( key_comment, TRIM_LEADING ); ! --------------------------------------------------------- ! If this key is in use, make sure they wish to override it ! --------------------------------------------------------- ans := 'Y'; IF key_comment <> GV$_null THEN ERASE (message_buffer); MESSAGE (''); MESSAGE (key_comment); ans := READ_LINE ('That key is currently defined as shown below... do you wish to override? '); ppl_clear_prompt; EDIT (ans, UPPER); ENDIF; ! ---------------- ! Attempt the bind ! ---------------- IF ans = 'Y' THEN; IF ( F$_alphabetic (learn_key) = GV$_null ) THEN desc := READ_LINE ('Enter function description: '); ppl_clear_prompt; DEFINE_KEY (learn_sequence, learn_key, desc, "TPU$KEY_MAP"); IF define_error THEN MESSAGE ("Key recursively used in learn-sequence"); define_error := FALSE; ELSE ! clear LEARN message if still there ERASE (message_buffer); MESSAGE ("Sequence learned successfully"); EXITIF TRUE; !unconditional exit ENDIF; ELSE MESSAGE ("Cannot use a typing key for a learn sequence"); ENDIF; ENDIF; ENDLOOP; P$_toggle_learn; ENDPROCEDURE !P$_remember ! ------------------------------------------ ! Toggle between normal and auto-ident modes ! ------------------------------------------ PROCEDURE ppl_toggle_auto_indent_mode IF GV$_auto_indent_mode = 0 THEN GV$_auto_indent_mode := 1; ppl_message ('Auto-indent mode has been enabled'); ELSE GV$_auto_indent_mode := 0; ppl_message ('Auto-indent mode has been disabled'); ENDIF; ppl_update_all_status_lines; ENDPROCEDURE; ! ----------------------------------------- ! Toggle between normal and auto-wrap modes ! ----------------------------------------- PROCEDURE ppl_toggle_auto_wrap_mode IF GV$_auto_wrap_mode = 0 THEN GV$_auto_wrap_mode := 1; ppl_message ('Auto-wrap mode has been enabled'); ! ------------------------------------------------------------------- ! If the user is at the end of the buffer, pad out to the left margin ! ------------------------------------------------------------------- IF MARK (NONE) = END_OF (CURRENT_BUFFER) THEN COPY_TEXT (SUBSTR (spaces_, 1, GV$_left_margin-1)); ENDIF; ELSE GV$_auto_wrap_mode := 0; ppl_message ('Auto-wrap mode has been disabled'); ENDIF; ppl_update_all_status_lines; ENDPROCEDURE; ! ------------------------------------------------------------------------- ! Given a string, replace all occurences of a specified character with that ! of another, given character ! ------------------------------------------------------------------------- PROCEDURE ppl_replace_char (tstring, old_char, new_char) LOCAL ln, i, replace_count; ! -------------------- ! Reject a null string ! -------------------- ln := LENGTH (tstring); IF ln = 0 THEN RETURN (0); ENDIF; replace_count := 0; LOOP i := INDEX (tstring, old_char); EXITIF i = 0; tstring := SUBSTR (tstring,1,i-1) + new_char + SUBSTR (tstring,i+1,ln-i); replace_count := replace_count + 1; ENDLOOP; RETURN (replace_count); ENDPROCEDURE; ! -------------------------------------------- ! Perform a combination fill/justify operation ! -------------------------------------------- PROCEDURE ppl_fill_and_justify LOCAL save_range; ! ------------------------------------------ ! Make sure that something has been selected ! ------------------------------------------ EDT$select_range; IF GV$_select_range = 0 THEN ppl_message ('No range was specified'); GV$_repeat_count := 1; RETURN; ENDIF; save_range := GV$_select_range; ! ------------------ ! First, do the fill ! ------------------ EDT$fill (1); ! ------- ! Justify ! ------- GV$_select_range := save_range; ppl_right_justify (1); ENDPROCEDURE; ! ---------------------------------------------------------------------------- ! Perform a right-justication of the selected range of text. The justification ! is done against the current right margin position. ! ---------------------------------------------------------------------------- PROCEDURE ppl_right_justify (entry_type) LOCAL ln, jstring, mode, lpos, rpos; ! ------------------------------------ ! Make sure that a range was specified ! ------------------------------------ IF entry_type = 0 THEN EDT$select_range; IF GV$_select_range = 0 THEN ppl_message ('No range was specified'); GV$_repeat_count := 1; RETURN; ENDIF; ENDIF; ! -------------------------------- ! Get positioned to the first line ! -------------------------------- POSITION (BEGINNING_OF (GV$_select_range)); MOVE_HORIZONTAL (-CURRENT_OFFSET); mode := GET_INFO (CURRENT_BUFFER, "direction"); SET (FORWARD, CURRENT_BUFFER); ! --------------------------------------------- ! Perform the justification, one line at a time ! --------------------------------------------- LOOP ! ------------------------------------------ ! If this is the last line, don't justify it ! ------------------------------------------ MOVE_VERTICAL (+1); EXITIF MARK (NONE) >= END_OF (GV$_select_range); MOVE_VERTICAL (-1); ! --------------------------------------------------- ! Work on the line only if there is a line to justify ! --------------------------------------------------- ln := LENGTH (CURRENT_LINE); IF ln > GV$_left_margin THEN ! ----------------------------- ! Trim trailing blanks and tabs ! ----------------------------- ppl_trimt; MOVE_VERTICAL (-1); ! The above function leaves one down a line ! ------------------------------------------------------------------- ! Proceed only if the line beyond the left margin had something in it ! ------------------------------------------------------------------- ln := LENGTH (CURRENT_LINE); IF LENGTH (CURRENT_LINE) >= GV$_left_margin THEN ! ------------------------------------------------------------------ ! Remove any tabs in the justify range, replacing each with a space. ! Compress multiple blanks into single spaces. ! ------------------------------------------------------------------ jstring := SUBSTR (CURRENT_LINE, GV$_left_margin, ln); EDIT (jstring, TRIM, COMPRESS, OFF); ! --------------------------------------------------------------- ! There must be at least two words in order to do a justification ! --------------------------------------------------------------- IF INDEX (jstring, GV$_spc) <> 0 THEN ! ---------------------------------------------------------- ! Replace the area in the buffer beyond the left margin with ! our modified string ! ---------------------------------------------------------- MOVE_HORIZONTAL (GV$_left_margin-CURRENT_OFFSET-1); ERASE_CHARACTER (ln-GV$_left_margin+1); COPY_TEXT (jstring); rpos := MARK (NONE); ! --------------------------------------------------------- ! Add spaces between the words until the length of the line ! reaches the right margin position ! --------------------------------------------------------- MOVE_HORIZONTAL (GV$_left_margin-CURRENT_OFFSET-1); lpos := MARK (NONE); LOOP EXITIF LENGTH (CURRENT_LINE) >= GV$_right_margin; ! ------------------------------------------------- ! If at end of line, re-position to the left margin ! ------------------------------------------------- EDT$move_word_f; IF MARK (NONE) >= rpos THEN POSITION (lpos); ELSE COPY_TEXT (' '); ENDIF; ENDLOOP; ENDIF; ENDIF; POSITION (lpos); ENDIF; ! --------------------- ! Move to the next line ! --------------------- MOVE_HORIZONTAL (-CURRENT_OFFSET); MOVE_VERTICAL (+1); ENDLOOP; ! ------- ! Cleanup ! ------- SET (mode, CURRENT_BUFFER); GV$_select_range := 0; GV$_select_is_active := 0; ppl_update_status_line (CURRENT_WINDOW); ENDPROCEDURE; ! -------------------------------------------------------------------------- ! Perform a partial rewind (if necessary) and wrap to the left margin of the ! next (new) line ! -------------------------------------------------------------------------- PROCEDURE ppl_wrap_line (parm$_bias) LOCAL origline, last_char, ln, curmod, curcol; ! -------------------------------------------------- ! First of all, is the wrap necessary at this point? ! -------------------------------------------------- curcol := GET_INFO (CURRENT_BUFFER, "offset_column"); IF curcol <= (GV$_right_margin - parm$_bias) THEN RETURN (0); ENDIF; ! ----------------------------------- ! Remove any trailing blanks and tabs ! ----------------------------------- origline := CURRENT_LINE; LOOP EXITIF CURRENT_OFFSET = 0; last_char := ERASE_CHARACTER (-1); IF (last_char <> GV$_spc) AND (last_char <> GV$_tab) THEN COPY_TEXT (last_char); EXITIF; ENDIF; ENDLOOP; ! -------------------------------------------------------------- ! Just in case the line contained nothing but spaces and tabs... ! -------------------------------------------------------------- IF CURRENT_OFFSET = 0 THEN COPY_TEXT (origline); ln := 0; ! ------------------------ ! Locate the previous word ! ------------------------ ELSE ! ------------------------------------------- ! Make sure that we still need to wrap a word ! ------------------------------------------- curcol := GET_INFO (CURRENT_BUFFER, "offset_column"); IF curcol <= (GV$_right_margin + 1) THEN ln := 0; ELSE EDT$move_word_r; ! ---------------------------------------------- ! If there is just one word between the margins, ! then don't wrap the word to the next line ! ---------------------------------------------- curcol := GET_INFO (CURRENT_BUFFER, "offset_column"); IF curcol <= GV$_left_margin THEN EDT$move_word_f; ln := 0; ! ---------------------------------------- ! Trim remaining, trailing spaces and tabs ! ---------------------------------------- ELSE ln := LENGTH (CURRENT_LINE) - CURRENT_OFFSET; LOOP EXITIF CURRENT_OFFSET = 0; last_char := ERASE_CHARACTER (-1); IF (last_char <> GV$_spc) AND (last_char <> GV$_tab) THEN COPY_TEXT (last_char); EXITIF; ENDIF; ENDLOOP; ENDIF; ENDIF; ENDIF; ! -------------------------------------------------------------------- ! Move to a new line and indent up to the beginning of the left margin ! -------------------------------------------------------------------- curmod := GET_INFO (CURRENT_BUFFER, "mode"); SET (INSERT, CURRENT_BUFFER); P$_ret_key; IF GV$_left_margin > 1 THEN COPY_TEXT (SUBSTR (spaces_, 1, GV$_left_margin-1)); ENDIF; MOVE_HORIZONTAL (+ln); IF ln <> 0 THEN COPY_TEXT (' '); ENDIF; SET (curmod, CURRENT_BUFFER); RETURN (1); ENDPROCEDURE; ! ---------------------------------- ! Enhanced definition for RETURN key ! ---------------------------------- PROCEDURE ppl_ret_key ! ------------------------------------------------------------------- ! If auto-wrap mode is enabled, see if we have need to perform a wrap ! ------------------------------------------------------------------- IF GV$_auto_wrap_mode = 1 THEN IF ppl_wrap_line (0) = 1 THEN RETURN; ENDIF; ENDIF; ! --------------------------- ! Otherwise, process normally ! --------------------------- P$_ret_key; ! --------------------------------------------------------------------- ! If auto-wrap is enabled, and the left margin is not the position one, ! pad out to the left margin ! --------------------------------------------------------------------- IF GV$_auto_wrap_mode = 1 THEN IF GV$_left_margin <> 1 THEN COPY_TEXT (SUBSTR (spaces_, 1, GV$_left_margin-1)); ENDIF; ENDIF; ENDPROCEDURE; ! nominal definition for RETURN key (RET_KEY) PROCEDURE P$_RET_key LOCAL curchar, curpos, ind; ON_ERROR ERASE (message_buffer); ENDON_ERROR; ! ------------------------- ! Position to the next line ! ------------------------- IF (GET_INFO (CURRENT_BUFFER, "mode") = OVERSTRIKE) THEN EDT$next_prev_line (FORWARD); IF MARK (NONE) = END_OF (CURRENT_BUFFER) THEN ppl_open_line; ENDIF; ELSE SPLIT_LINE; ENDIF; ! ----------------------------------------------------------- ! If the current buffer's file type is .COM, ! the last character typed is not the continuation character, ! and auto-insertion has not been disabled, ! insert a dollar sign after reaching the new line ! ----------------------------------------------------------- IF (ftype_ = '.COM') AND (comfile_mode_ = 1) THEN curpos := MARK (NONE); MOVE_HORIZONTAL (-2); curchar := CURRENT_CHARACTER; ind := INDEX (CURRENT_LINE, '!'); POSITION (curpos); IF (curchar <> '-') OR (ind <> 0) THEN COPY_TEXT ('$'); ENDIF; ENDIF; ENDPROCEDURE !P$_RET_key ! prompting-support, supplying a default (utility) PROCEDURE F$_prompt ( prompt_text, default_answer ) LOCAL prompt, answer; IF default_answer <> GV$_null THEN prompt := prompt_text + " <" + default_answer + ">: "; ELSE prompt := prompt_text + ": "; ENDIF; answer := READ_LINE ( prompt ); CHANGE_CASE ( answer, UPPER ); IF ( answer = GV$_null ) THEN answer := default_answer; ENDIF; RETURN ( answer ); ENDPROCEDURE !F$_prompt ! clear the message window/buffer (GOLD-E) PROCEDURE P$_clear_message_window ERASE ( MESSAGE_BUFFER ); UPDATE ( MESSAGE_WINDOW ); ENDPROCEDURE !P$_clear_message_window ! ----------------------------------------- ! Search-utility routine for P$_search_next ! ----------------------------------------- PROCEDURE P$_search_for_target ( bump, target ) ON_ERROR IF ( ERROR = TPU$_STRNOTFOUND ) OR ( ERROR = TPU$_BEGOFBUF ) OR ( ERROR = TPU$_ENDOFBUF ) THEN ERASE (message_buffer); IF ( GET_INFO ( target, "TYPE") = PATTERN ) THEN MESSAGE ( "Pattern not found" ); ELSE MESSAGE ( "`" + target + "' - string not found" ); ENDIF; GV$_search_abort_flag := TRUE; GV$_repeat_count := 1; GV$_search_range2 := 0; ENDIF; ENDON_ERROR; GV$_search_abort_flag := FALSE; !set TRUE if search fails GV$_matched_range := 0; ! --------------------------------------- ! Bump-off to avoid refinding same target ! --------------------------------------- MOVE_HORIZONTAL ( bump ); SET ( TIMER, ON, "searching..." ); GV$_search_range := ppl_enhanced_search (target, CURRENT_DIRECTION); SET ( TIMER, OFF, GV$_null ); IF ( GV$_search_range <> 0 ) THEN IF ( GV$_search_begin ) THEN POSITION ( BEGINNING_OF ( GV$_search_range ) ); ELSE POSITION ( END_OF ( GV$_search_range ) ); MOVE_HORIZONTAL ( +1 ); ENDIF; ERASE (message_buffer); MESSAGE ('..........................................current match string'); MESSAGE (GV$_search_range); ELSE POSITION (BEGINNING_OF (CURRENT_BUFFER)); MOVE_HORIZONTAL (-1); ! Invoke handler POSITION (GV$_prior_position); RETURN; ENDIF; IF ( GV$_search_abort_flag ) THEN ABORT; !short-circuit for operational repeats ENDIF; IF GV$_beginning_of_select = 0 THEN GV$_search_range2 := CREATE_RANGE (BEGINNING_OF (GV$_search_range), END_OF (GV$_search_range), REVERSE); ELSE GV$_search_range2 := CREATE_RANGE (BEGINNING_OF (GV$_search_range), END_OF (GV$_search_range), UNDERLINE); ENDIF; ENDPROCEDURE !P$_search_for_target ! ---------------------------------------------------------------- ! Find the next occurence of a pre-loaded search string or pattern ! ---------------------------------------------------------------- PROCEDURE P$_search_next ( target ) LOCAL bump; ! ---------------------- ! Get to the right place ! ---------------------- GV$_prior_position := MARK (NONE); IF ( CURRENT_DIRECTION = FORWARD ) THEN IF ( MARK ( NONE ) = END_OF ( CURRENT_BUFFER ) ) THEN RETURN; ENDIF; bump := 1; ELSE IF ( MARK ( NONE ) = BEGINNING_OF ( CURRENT_BUFFER ) ) THEN RETURN; ENDIF; bump := -1; ENDIF; ! ------------------ ! Perform the search ! ------------------ P$_search_for_target ( bump, target ); ENDPROCEDURE !P$_search_next PROCEDURE EDT$append !KP9 (append) LOCAL temp_pos ; EDT$select_range; IF ( GV$_select_range <> 0 ) THEN temp_pos := MARK (NONE); POSITION ( END_OF ( PASTE_BUFFER ) ); MOVE_HORIZONTAL (-1); MOVE_TEXT ( GV$_select_range ); GV$_select_range := 0; POSITION ( temp_pos ); ELSE MESSAGE ( "No Select Active" ); GV$_repeat_count := 1; ENDIF; ENDPROCEDURE !EDT$append PROCEDURE EDT$backspace !BACKSPACE key LOCAL temp_length ; temp_length := CURRENT_OFFSET; IF ( temp_length = 0 ) THEN MOVE_VERTICAL (-1) ; MOVE_HORIZONTAL ( -CURRENT_OFFSET ); ! Make sure we are at 0 ELSE MOVE_HORIZONTAL ( -temp_length ); ENDIF; ENDPROCEDURE !EDT$backspace PROCEDURE EDT$command !GOLD-KP7 (TPU command) LOCAL command, execute_command; ON_ERROR ! Trap compilation failures IF ( ERROR = TPU$_COMPILEFAIL ) THEN MESSAGE ("Unrecognized command" ); RETURN; ENDIF; ENDON_ERROR command := F$_prompt ( GV$_TPU_command_prompt, GV$_null ); IF ( command = GV$_null ) THEN ABORT; ELSE EDIT ( command, TRIM, COMPRESS, UPPER, OFF ); execute_command := COMPILE (command); ENDIF; IF ( execute_command <> 0 ) THEN P$_clear_message_window; EXECUTE ( execute_command ); ENDIF; ENDPROCEDURE !EDT$command PROCEDURE EDT$change_case !GOLD-KP1 (change case) LOCAL character ; EDT$select_range; !check for active select IF ( GV$_select_range <> 0 ) THEN CHANGE_CASE ( GV$_select_range, INVERT ); GV$_select_range := 0; GV$_beginning_of_select := 0; GV$_select_is_active := 0; IF GV$_status_line_mode = 1 THEN ppl_update_status_line (CURRENT_WINDOW); ENDIF; RETURN; ENDIF; !change case of current character IF ( CURRENT_CHARACTER <> GV$_null ) THEN character := CURRENT_CHARACTER; CHANGE_CASE ( character, INVERT ); ERASE_CHARACTER (1); COPY_TEXT (character); IF ( CURRENT_DIRECTION <> FORWARD ) THEN MOVE_HORIZONTAL (-2); ENDIF; RETURN; ENDIF; ENDPROCEDURE !EDT$change_case PROCEDURE EDT$cut !KP6 ( cut selected text) LOCAL temp_position; ! After erasing PASTE_BUFFER, insert a blank line. This blank line is needed ! for the PASTE operation. When doing the PASTE, must know if the last line's ! terminator should be included in the new text. EDT$select_range; IF ( GV$_select_range <> 0 ) THEN temp_position := MARK (NONE); SET ( TIMER, ON, "working..." ); ERASE ( PASTE_BUFFER ); POSITION ( PASTE_BUFFER ); SPLIT_LINE; MOVE_VERTICAL (-1); MOVE_TEXT ( GV$_select_range ); POSITION ( temp_position ); GV$_select_range := 0; SET ( TIMER, OFF, GV$_null ); ELSE MESSAGE ( "No Select Active" ); GV$_repeat_count := 1; ENDIF; GV$_select_is_active := 0; GV$_search_range2 := 0; IF GV$_status_line_mode = 1 THEN ppl_update_status_line (CURRENT_WINDOW); ENDIF; ENDPROCEDURE !EDT$cut ! determine if positioned on the search range: PROCEDURE EDT$on_search_range ! Select and substitute support routine LOCAL v_on_search; IF ( GV$_search_begin ) THEN ! if SET SEARCH BEGIN, then should be positioned ! on the first character of the select range IF ( MARK ( NONE ) = BEGINNING_OF ( GV$_search_range ) ) THEN v_on_search := TRUE; ELSE v_on_search := FALSE; ENDIF; ELSE ! if SET SEARCH END, then move back one character ! to determine if a search range selection is active MOVE_HORIZONTAL ( -1 ); IF ( MARK ( NONE ) = END_OF ( GV$_search_range ) ) THEN v_on_search := TRUE; ELSE v_on_search := FALSE; ENDIF; MOVE_HORIZONTAL ( +1 ); ENDIF; RETURN ( v_on_search ); ENDPROCEDURE !EDT$on_search_range ! Procedure to create the select range PROCEDURE EDT$select_range ! cut support routine IF ( GV$_beginning_of_select <> 0 ) THEN GV$_select_range := SELECT_RANGE; ! If SELECT_RANGE is zero, this means current position is at beginning ! of SR. Create range of length 0 so that EDT emulation works better. IF ( GV$_select_range = 0 ) THEN POSITION ( END_OF ( CURRENT_BUFFER ) ); GV$_select_range := CREATE_RANGE (MARK(NONE), MARK(NONE), NONE); POSITION ( GV$_beginning_of_select ); ENDIF; GV$_beginning_of_select := 0; GV$_select_is_active := 0; ELSE ! Check for being on search string and repeat count <= 1 IF ( GV$_search_range <> 0 ) THEN IF ( EDT$on_search_range = 1 ) AND ( GV$_repeat_count <= 1 ) THEN GV$_select_range := GV$_search_range; ELSE GV$_select_range := 0; ENDIF; ELSE GV$_select_range := 0; ENDIF; ENDIF; ENDPROCEDURE !EDT$select_range PROCEDURE EDT$delete_char !keypad COMMA (delete char) LOCAL temp_line; IF ( MARK (NONE) = END_OF (CURRENT_BUFFER) ) THEN MESSAGE ("Attempt to move past the end of buffer"); ELSE GV$_deleted_char := ERASE_CHARACTER (1); IF ( GV$_deleted_char = GV$_null ) THEN GV$_deleted_char := GV$_lf; temp_line := CURRENT_LINE; MOVE_HORIZONTAL (1); IF ( MARK (NONE) <> END_OF (CURRENT_BUFFER) ) OR ( LENGTH(temp_line) = 0 ) THEN APPEND_LINE; ELSE MOVE_HORIZONTAL (-1); ENDIF; ENDIF; ENDIF; GV$_search_range2 := 0; ENDPROCEDURE !EDT$delete_char PROCEDURE EDT$delete_beg_line !CTRL/U ( delete to beginning of line) GV$_deleted_line := ERASE_CHARACTER ( -CURRENT_OFFSET ); IF ( GV$_deleted_line = GV$_null ) ! then delete previous line THEN IF ( MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) ) THEN MOVE_VERTICAL (-1); EDT$delete_line; ! delete the entire previous line ENDIF; ENDIF; GV$_delete_crlf := 0; GV$_appended_line := 0; ENDPROCEDURE !EDT$delete_beg_line PROCEDURE EDT$delete_end_word !keypad MINUS (delete word) LOCAL temp_length; temp_length := EDT$end_word; IF ( temp_length = 0 ) ! on EOL THEN GV$_deleted_word := ascii(10); ! line feed IF ( MARK (NONE) <> END_OF (CURRENT_BUFFER) ) THEN MOVE_HORIZONTAL (1); IF ( MARK (NONE) <> END_OF (CURRENT_BUFFER) ) THEN APPEND_LINE; ! join both lines ELSE MOVE_HORIZONTAL (-1); ENDIF; ENDIF; ELSE GV$_deleted_word := ERASE_CHARACTER ( -temp_length ); ! delete word ENDIF; GV$_search_range2 := 0; ENDPROCEDURE !EDT$delete_end_word PROCEDURE EDT$delete_line !PF4 (delete line) IF ( CURRENT_OFFSET = 0 ) THEN GV$_deleted_line := ERASE_LINE; ELSE GV$_deleted_line := ERASE_CHARACTER ( LENGTH (CURRENT_LINE) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL (1); IF ( MARK (NONE) <> END_OF (CURRENT_BUFFER) ) THEN APPEND_LINE; ELSE MOVE_HORIZONTAL (-1); ENDIF; ENDIF; GV$_delete_crlf := 1; GV$_appended_line := 0; GV$_search_range2 := 0; ENDPROCEDURE !EDT$delete_line PROCEDURE EDT$delete_to_eol !GOLD-KP2 (delete to end of line) ! This procedure works because ERASE_CHARACTER stops at the end of line. ! 1) Delete from the current point to the end of line. ! 2) If on EOL, delete line terminator plus the entire next line. IF ( CURRENT_OFFSET = LENGTH (CURRENT_LINE) ) THEN MOVE_VERTICAL (1); IF ( MARK (NONE) <> END_OF (CURRENT_BUFFER) ) THEN MOVE_HORIZONTAL (-CURRENT_OFFSET); GV$_deleted_line := ERASE_LINE; GV$_appended_line := 1; GV$_delete_crlf := 0; ELSE GV$_appended_line := 0; GV$_delete_crlf := 1; ENDIF; MOVE_HORIZONTAL (-1); ELSE GV$_deleted_line := ERASE_CHARACTER ( LENGTH (CURRENT_LINE) ); GV$_appended_line := 0; GV$_delete_crlf := 0; ENDIF; ENDPROCEDURE !EDT$delete_to_eol PROCEDURE EDT$end_of_line !KP2 (move to end of line) ON_ERROR GV$_repeat_count :=1 ; ENDON_ERROR; IF ( CURRENT_DIRECTION = FORWARD ) THEN IF ( MARK (NONE) <> END_OF (CURRENT_BUFFER) ) THEN IF ( EDT$on_end_of_line ) THEN MOVE_VERTICAL (1) ENDIF; IF ( MARK (NONE) <> END_OF (CURRENT_BUFFER) ) THEN MOVE_HORIZONTAL ( LENGTH (CURRENT_LINE) - CURRENT_OFFSET ); ! move to EOL ENDIF; ENDIF; ELSE MOVE_HORIZONTAL ( (-current_offset) + (-1) ); ENDIF; ENDPROCEDURE !EDT$end_of_line ! ------------------------------------------------------------------------- ! Replace all occurences of multiple spaces and all tabs with single spaces ! within the specified range or buffer ! ------------------------------------------------------------------------- PROCEDURE ppl_compress_buffer_range (buffer_range) LOCAL start_pos, end_pos, cur_pos, space_found, cur_char; ! ---------------------------- ! Replace all tabs with spaces ! ---------------------------- TRANSLATE (buffer_range, GV$_spc, GV$_tab); ! ------------------------------------------------------------ ! Compress occurences of consecutive spaces into single spaces ! ------------------------------------------------------------ start_pos := BEGINNING_OF (buffer_range); end_pos := END_OF (buffer_range); cur_pos := MARK (NONE); space_found := 0; POSITION (start_pos); LOOP EXITIF MARK (NONE) = end_pos; IF CURRENT_CHARACTER = GV$_spc THEN space_found := space_found + 1; ELSE space_found := 0; ENDIF; ! --------------------------------------------------------------- ! If we have already found an adjacent space, get rid of this one ! --------------------------------------------------------------- IF space_found > 1 THEN ERASE_CHARACTER (1); ELSE MOVE_HORIZONTAL (1); ENDIF; ENDLOOP; POSITION (cur_pos); ENDPROCEDURE; PROCEDURE EDT$fill (entry_type) !GOLD-KP8 (fill) IF entry_type = 0 THEN EDT$select_range; ENDIF; ! ---------------------------------------------------------------------- ! First, compress the range (get rid of multiple spaces and single tabs) ! ---------------------------------------------------------------------- IF ( GV$_select_range <> 0 ) THEN ppl_compress_buffer_range (GV$_select_range); ! ---------------- ! Now, do the fill ! ---------------- IF ( GV$_right_margin = 0 ) THEN EDT$preserve_blanks(FALSE); ELSE EDT$preserve_blanks(TRUE); ENDIF; GV$_select_range := 0; GV$_select_is_active := 0; ppl_update_status_line (CURRENT_WINDOW); ELSE MESSAGE ("No Select Active"); GV$_repeat_count := 1; ENDIF; ENDPROCEDURE !EDT$fill PROCEDURE EDT$preserve_blanks ( flag ) ! support routine for fill LOCAL original_position, b_mark, e_mark, sub_range, temp_range, all_done, temp_pattern; ON_ERROR all_done := 1; ! cause exit GV$_repeat_count := 1; ENDON_ERROR; original_position := MARK ( NONE ); ! b_mark := BEGINNING_OF ( GV$_select_range ); ! skip leading spaces on first line only ! EDT$skip_leading_spaces ( b_mark ); ! POSITION ( original_position ); POSITION (BEGINNING_OF (GV$_select_range)); MOVE_HORIZONTAL (-CURRENT_OFFSET); b_mark := MARK (NONE); POSITION (original_position); LOOP ! skip leading blank lines of a paragraph EDT$skip_lines ( b_mark ); all_done := EDT$find_whiteline ( b_mark, e_mark ); ! start looking here EXITIF all_done; ! now only fill the range created between the blank lines sub_range := CREATE_RANGE ( b_mark, e_mark, NONE ); ! go to line following the range POSITION ( e_mark ); MOVE_HORIZONTAL ( 1 ); MOVE_VERTICAL ( 1 ); ! pick up search at end of current_range b_mark := MARK ( NONE ); ! do the fill operation IF flag THEN FILL ( sub_range, GV$_word_delimiter, GV$_left_margin, GV$_right_margin ); ELSE FILL ( sub_range, GV$_word_delimiter, GV$_left_margin, GET_INFO ( CURRENT_WINDOW, "WIDTH" ) - 4 ); ENDIF; EXITIF all_done; ENDLOOP; POSITION ( original_position ); ENDPROCEDURE !EDT$preserve_blanks PROCEDURE EDT$skip_leading_spaces ( b_mark ) ! support routine for fill LOCAL temp_pattern, temp_range; ON_ERROR RETURN ENDON_ERROR; POSITION ( b_mark ); temp_pattern := ANCHOR & SPAN ( GV$_spc_tab ); ! literal: "" temp_range := SEARCH ( temp_pattern, FORWARD ); POSITION ( END_OF ( temp_range ) ); MOVE_HORIZONTAL ( 1 ); b_mark := MARK ( NONE ); ENDPROCEDURE !EDT$skip_leading_spaces PROCEDURE EDT$find_whiteline ( beg_mark, end_mark ) ! support routine for fill LOCAL bline, ln; ON_ERROR POSITION ( beg_mark ); end_mark := END_OF ( GV$_select_range ); RETURN ( 0 ); ENDON_ERROR; POSITION ( beg_mark ); IF beg_mark >= END_OF ( GV$_select_range ) THEN RETURN ( 1 ); ! all done ENDIF; bline := SEARCH ( GV$_white_pattern, FORWARD ); ! get the beginning and end points right IF ( BEGINNING_OF ( bline ) > END_OF ( GV$_select_range ) ) THEN end_mark := END_OF ( GV$_select_range ); RETURN ( 0 ); ELSE end_mark := END_OF ( bline ); ENDIF; POSITION ( end_mark ); ! go there MOVE_HORIZONTAL ( -1 ); ! back up to previous line ln := LENGTH (CURRENT_LINE); ! --------------------------------------------- ! Allow for lines containing nothing but blanks ! --------------------------------------------- IF ln <> 0 THEN IF CURRENT_LINE = SUBSTR (spaces_, 1, ln) THEN MOVE_HORIZONTAL (-CURRENT_OFFSET-1); ENDIF; ENDIF; end_mark := MARK ( NONE ); RETURN ( 0 ); ENDPROCEDURE !EDT$find_whiteline PROCEDURE EDT$skip_lines ( where ) ! support routine for fill ! skip multiple blank lines, once that one blank line is found LOCAL pat, patstr, srange; ON_ERROR where := MARK ( NONE ); RETURN; ENDON_ERROR; POSITION (where); MOVE_HORIZONTAL (-CURRENT_OFFSET); LOOP IF CURRENT_LINE <> GV$_null THEN patstr := GV$_spc + GV$_tab; pat := ANCHOR & SPAN (patstr) & LINE_END; srange := SEARCH (pat, FORWARD, NO_EXACT); EXITIF srange = 0; ENDIF; MOVE_VERTICAL ( 1 ); MOVE_HORIZONTAL ( -CURRENT_OFFSET ); ENDLOOP; where := MARK ( NONE ); RETURN ENDPROCEDURE !EDT$skip_lines ! ------------------------------------------ ! Toggle between smooth and jump scroll mode ! ------------------------------------------ PROCEDURE ppl_toggle_scroll LOCAL sequence, mode; IF smooth_scroll_mode_ = 0 THEN smooth_scroll_mode_ := 1; sequence := ASCII (27) + '[?4h'; mode := 'SMOOTH'; ELSE smooth_scroll_mode_ := 0; sequence := ASCII (27) + '[?4l'; mode := 'JUMP'; ENDIF; ERASE (message_buffer); SET (TEXT, message_window, NO_TRANSLATE); MESSAGE (sequence); SET (TEXT, message_window, BLANK_TABS); ppl_message ('Your terminal has been set to ' + mode + ' scroll mode...'); ENDPROCEDURE; ! ------------------------ ! Command repeat executive ! ------------------------ PROCEDURE ppl_repeat (first_digit) LOCAL number, i, func, km, goldstr, ptype, alt, tchar, chr, digit, done; ON_ERROR GV$_repeat_count := 1; RETURN; ENDON_ERROR; ! ----------------------- ! Build the repeat factor ! ----------------------- ppl_reset_keymap_list; number := first_digit; done := 0; LOOP IF GV$_status_line_mode = 1 THEN ERASE (message_buffer); MESSAGE (''); MESSAGE ('Repeat: <'+number+'>'); UPDATE (message_window); ENDIF; EXITIF done = 1; done := 1; i := 47; tchar := READ_KEY; LOOP i := i + 1; EXITIF (done = 0) OR (i > 57); digit := ASCII (i); IF tchar = KEY_NAME (digit) THEN number := number + digit; done := 0; ENDIF; ENDLOOP; ENDLOOP; GV$_repeat_count := INT (number); ! ---------------------------------- ! Pull in the command to be repeated ! ---------------------------------- i := 0; goldstr := ''; LOOP EXITIF tchar <> PF1; IF GV$_status_line_mode = 1 THEN goldstr := goldstr + ''; ERASE (message_buffer); MESSAGE (''); MESSAGE ('Repeat: <'+number+'>'+goldstr); ENDIF; ! -------------------------- ! Make a sanity check ! -------------------------- i := i + 1; IF i > 2 THEN MESSAGE ('............................................That shift level does not exist'); GV$_repeat_count := 1; RETURN; ENDIF; tchar := READ_KEY; ENDLOOP; ! ------- ! Execute ! ------- IF i = 0 THEN km := "TPU$KEY_MAP"; ELSE km := "TTK_map_" + STR (i); ENDIF; ! --------------------- ! Special case: SPECINS ! --------------------- IF (tchar = KP3) AND (i = 1) THEN COPY_TEXT (ASCII (GV$_repeat_count)); GV$_repeat_count := 1; ERASE (message_buffer); RETURN; ENDIF; ! ----------------------------- ! Special case: ASCII character ! ----------------------------- IF (tchar = ENTER) and (i = 0) THEN chr := READ_LINE ('Character to be repeated: '); ppl_clear_prompt; alt := 1; ELSE alt := 0; ENDIF; func := LOOKUP_KEY (tchar, PROGRAM, km); i := GV$_repeat_count; LOOP EXITIF i = 0; IF (func <> 0) AND (alt = 0) THEN EXECUTE (func); ! Command ELSE IF alt = 1 THEN COPY_TEXT (chr); ENDIF; ENDIF; i := i - 1; ENDLOOP; ERASE (message_buffer); GV$_repeat_count := 1; ENDPROCEDURE; PROCEDURE EDT$find_buffer ( buffer_name) ! support routine for line mode LOCAL upcased_name, buffer_ptr; upcased_name := buffer_name; CHANGE_CASE ( upcased_name, UPPER ); buffer_ptr := GET_INFO (BUFFERS, "FIRST" ); LOOP EXITIF ( buffer_ptr = 0 ); EXITIF ( upcased_name = GET_INFO ( buffer_ptr, "NAME" ) ); buffer_ptr := GET_INFO ( BUFFERS, "NEXT" ); ENDLOOP; RETURN ( buffer_ptr ); ENDPROCEDURE !EDT$find_buffer PROCEDURE EDT$range_specification ( spec ) ! support routine for line mode ! and for several P$_* routines LOCAL r_index; ! Process a range specifier; return either a range or a buffer. r_index := INDEX ( GV$_ranges, ( GV$_spc + spec ) ); ! what was given? r_index := ( ( r_index + GV$_range_length - 1 ) / GV$_range_length ); CASE r_index FROM 0 TO 2 [0]: MESSAGE ("Unsupported range specification: " + spec); RETURN (0); [1]: ! SELECT EDT$select_range; IF ( GV$_select_range = 0 ) THEN MESSAGE ("No select active"); RETURN (0); ELSE RETURN (GV$_select_range); ENDIF; [2]: ! WHOLE r_index := CURRENT_BUFFER; RETURN (r_index); ENDCASE; MESSAGE ("Unsupported range specification: " + spec); RETURN (0); ENDPROCEDURE !EDT$range_specification PROCEDURE EDT$quit(save_journal) ON_ERROR ! If an error occurs here, stop the EXIT IF ( ERROR <> TPU$_NOJOURNAL ) THEN RETURN (0); ENDIF; ENDON_ERROR; IF (save_journal = TRUE) THEN JOURNAL_CLOSE; ENDIF; QUIT; ENDPROCEDURE !EDT$quit PROCEDURE EDT$exit(save_journal) ON_ERROR ! If an error occurs here, stop the EXIT IF ( ERROR <> TPU$_NOJOURNAL ) THEN RETURN (0); ENDIF; ENDON_ERROR; IF (save_journal = TRUE) THEN JOURNAL_CLOSE; ENDIF; EXIT; ENDPROCEDURE !EDT$exit ! ------------------------------------------------- ! Advance by one character in the current direction ! ------------------------------------------------- PROCEDURE EDT$move_char ON_ERROR GV$_repeat_count := 1; ENDON_ERROR; IF CURRENT_DIRECTION = FORWARD THEN MOVE_HORIZONTAL (+1); ELSE MOVE_HORIZONTAL (-1); ENDIF; ENDPROCEDURE; PROCEDURE EDT$move_word ! KP2 (move word) IF ( CURRENT_DIRECTION = FORWARD ) THEN EDT$move_word_f; ELSE EDT$move_word_r; ENDIF; ENDPROCEDURE !EDT$move_word PROCEDURE EDT$move_word_r !support routine for move word (reverse) ON_ERROR GV$_repeat_count := 1; ENDON_ERROR; ! Move to beginning of word, back a line if none IF ( EDT$beg_word = 0 ) THEN MOVE_HORIZONTAL (-1); ENDIF; ENDPROCEDURE !EDT$move_word_r PROCEDURE EDT$move_word_f !support routine for move word (forward) ON_ERROR GV$_repeat_count := 1; ENDON_ERROR; IF ( edt$END_WORD = 0 ) THEN MOVE_HORIZONTAL(1); ENDIF; ENDPROCEDURE !EDT$move_word_f PROCEDURE EDT$del_beg_word ! support routine for delete word (forward) LOCAL temp_length; temp_length := EDT$beg_word; !go to beginning of word IF ( temp_length = 0 ) THEN IF ( MARK (NONE) = END_OF (CURRENT_BUFFER) ) THEN MOVE_HORIZONTAL (-1); ELSE APPEND_LINE; ENDIF; GV$_deleted_word := GV$_lf; else GV$_deleted_word := ERASE_CHARACTER (temp_length); ENDIF; ENDPROCEDURE !EDT$del_beg_word PROCEDURE EDT$beg_word !support routine for move word LOCAL temp_char, temp_length; IF ( CURRENT_OFFSET = 0 ) THEN return (0); ENDIF; MOVE_HORIZONTAL (-1); !skip current character temp_length := 1; !count any spaces temp_char := CURRENT_CHARACTER; LOOP EXITIF ( CURRENT_OFFSET = 0 ); EXITIF ( temp_char <> GV$_spc ); MOVE_HORIZONTAL (-1); temp_length := temp_length + 1; temp_char := CURRENT_CHARACTER; ENDLOOP; ! if on word terminator, then count that one character; ! otherwise scan to next word terminator. IF ( INDEX ( GV$_word, temp_char ) = 0 ) THEN LOOP EXITIF ( CURRENT_OFFSET = 0 ); MOVE_HORIZONTAL (-1); temp_char := CURRENT_CHARACTER; IF ( INDEX ( GV$_word, temp_char ) <> 0 ) THEN MOVE_HORIZONTAL (1); EXITIF; ENDIF; temp_length := temp_length + 1; ENDLOOP; ENDIF; RETURN ( temp_length ); ENDPROCEDURE !EDT$beg_word PROCEDURE EDT$end_word !support routine for delete word LOCAL temp_range, temp_length; ON_ERROR ! catch search failure (suppress message) RETURN (temp_length); ENDON_ERROR temp_range := SEARCH ( GV$_forward_word, FORWARD, GV$_search_case ); temp_length := LENGTH ( temp_range ); MOVE_HORIZONTAL ( temp_length ); RETURN (temp_length); ENDPROCEDURE !EDT$end_word PROCEDURE EDT$next_prev_line ( dir ) !KP0 (next line) LOCAL offset; ON_ERROR GV$_repeat_count := 1; ENDON_ERROR; offset := current_offset; MOVE_HORIZONTAL ( -offset ); IF ( dir = FORWARD ) THEN MOVE_VERTICAL (1); ELSE IF ( offset = 0 ) THEN MOVE_VERTICAL (-1); ENDIF; ENDIF; ENDPROCEDURE !EDT$next_prev_line PROCEDURE EDT$page !KP7 (move to next page) LOCAL dir, next_page; ON_ERROR IF ( ERROR = TPU$_STRNOTFOUND ) THEN IF ( dir = REVERSE ) THEN POSITION ( BEGINNING_OF ( CURRENT_BUFFER ) ); ppl_forward; ELSE POSITION ( END_OF ( CURRENT_BUFFER ) ); ENDIF; GV$_repeat_count := 1; ENDIF; RETURN; ENDON_ERROR dir := CURRENT_DIRECTION; IF ( dir = FORWARD ) THEN MOVE_HORIZONTAL (+1) ELSE MOVE_HORIZONTAL (-1) ENDIF; next_page := SEARCH ( GV$_ff, dir, GV$_search_case ); POSITION ( BEGINNING_OF (next_page) ); ENDPROCEDURE !EDT$page PROCEDURE EDT$paste !GOLD-KP6 (paste selected text) LOCAL cur_mode, paste_text; ! After copying the text, append the current line to the last line. ! Put an extra blank line in the paste buffer during the cut, allowing ! a CUT/PASTE of text without a line terminator to work properly. cur_mode := GET_INFO ( CURRENT_BUFFER, "MODE" ); SET ( INSERT, CURRENT_BUFFER ); !avoid overstriking! IF ( BEGINNING_OF ( PASTE_BUFFER ) <> END_OF ( PASTE_BUFFER ) ) THEN SET ( TIMER, ON, "working..." ); COPY_TEXT ( PASTE_BUFFER ); APPEND_LINE; SET ( TIMER, OFF, GV$_null ); ENDIF; SET ( cur_mode, CURRENT_BUFFER ); !reset mode ENDPROCEDURE !EDT$paste PROCEDURE EDT$replace !GOLD-KP9 (replace) EDT$select_range; IF ( GV$_select_range <> 0 ) THEN ERASE (GV$_select_range); EDT$paste; GV$_select_range := 0; ELSE MESSAGE ("No select active"); GV$_repeat_count := 1; ENDIF; ENDPROCEDURE !EDT$replace PROCEDURE EDT$reset ! GOLD-PERIOD (reset) GV$_beginning_of_select := 0; GV$_select_is_active := 0; GV$_limited_search := 0; present_marker_ := 0; previous_marker_ := 0; GV$_upper_left_mark := 0; GV$_lower_right_mark := 0; GV$_search_range := 0; GV$_search_range2 := 0; GV$_select_range := 0; IF GV$_status_line_mode = 1 THEN ppl_update_status_line (CURRENT_WINDOW); ENDIF; SET ( FORWARD, CURRENT_BUFFER ); ERASE ( MESSAGE_BUFFER ); ENDPROCEDURE !EDT$reset ! ------------------------------------ ! Enhanced version of character rubout ! ------------------------------------ PROCEDURE ppl_rubout LOCAL curcol, last_char; EDT$rubout; ! ----------------------------------------------------------------- ! If we are in auto-wrap mode, and we have just deleted to the left ! margin, keep removing blanks and tabs until we either reach a ! non-blank character, or the end of the previous line (if any) ! ----------------------------------------------------------------- IF GV$_auto_wrap_mode = 0 THEN RETURN; ENDIF; curcol := GET_INFO (CURRENT_WINDOW, "current_column") - 1; IF curcol >= GV$_left_margin THEN RETURN; ENDIF; LOOP EXITIF CURRENT_OFFSET = 0; last_char := ERASE_CHARACTER (-1); ! ------------------------------------------------------------- ! A non-blank character probably should not be to the left ! of the left margin, but we'll give the user another chance... ! ------------------------------------------------------------- IF (last_char <> GV$_spc) AND (last_char <> GV$_tab) THEN COPY_TEXT (last_char); RETURN; ENDIF; ENDLOOP; EDT$rubout; ENDPROCEDURE; PROCEDURE EDT$rubout ! rubout key (erase prev chr) LOCAL eol_test; ON_ERROR IF ( ERROR = TPU$_STRNOTFOUND ) !suppress error message... THEN !not at eol; interior of line SET ( INSERT, CURRENT_BUFFER ); !reset momentarily; COPY_TEXT ( GV$_spc ); !space to replace deleted char; SET ( OVERSTRIKE, CURRENT_BUFFER ); !set it back... MOVE_HORIZONTAL ( -1 ); !and reposition over it ENDIF; ENDON_ERROR GV$_deleted_char := ERASE_CHARACTER ( -1 ); IF ( GV$_deleted_char = GV$_null ) !can't delete past LINE_BEGIN THEN GV$_deleted_char := GV$_lf; APPEND_LINE; ENDIF; IF ( GET_INFO ( CURRENT_BUFFER, "MODE" ) = OVERSTRIKE ) THEN !overstrike-mode delete eol_test := SEARCH ( (ANCHOR & LINE_END), FORWARD, EXACT ); !at eol? !let the ON_ERROR handle the details ... ENDIF; GV$_search_range2 := 0; ENDPROCEDURE !EDT$rubout ! set-up routine for EDT$search and P$_find_replace_next (utility) PROCEDURE F$_find_global_setup LOCAL dir_dist; IF ( CURRENT_DIRECTION = FORWARD ) THEN dir_dist := GV$_search_begin; ELSE dir_dist := -1; ENDIF; ! if the terminator was forward or reverse key, reset the direction permanently IF ( LAST_KEY = KP5 ) THEN SET ( REVERSE, CURRENT_BUFFER ); IF ( MARK ( NONE ) = BEGINNING_OF ( CURRENT_BUFFER ) ) THEN MESSAGE ( "String/pattern not found" ); RETURN ( dir_dist ) ENDIF; dir_dist := -1; ELSE IF ( LAST_KEY = KP4 ) THEN SET ( FORWARD, CURRENT_BUFFER ); IF ( MARK ( NONE ) = END_OF ( CURRENT_BUFFER ) ) THEN MESSAGE ( "String/pattern not found" ); RETURN ( dir_dist ) ENDIF; dir_dist := 1; ELSE IF ( LAST_KEY = CTRL_U_KEY ) THEN RETURN ( dir_dist ) !abort ENDIF; ENDIF; ENDIF; ENDPROCEDURE !F$_find_global_setup ! -------------------------- ! Move the cursor by section ! -------------------------- PROCEDURE EDT$section (direction_to_move) LOCAL curpos; ON_ERROR IF CURRENT_DIRECTION = REVERSE THEN ppl_forward; ENDIF; GV$_repeat_count := 1; ENDON_ERROR; ! ------------------------------------------------------------- ! If using a workstation, disable scrolling (refresh is faster) ! ------------------------------------------------------------- IF GV$_using_workstation = 1 THEN ppl_set_scroll_region (CURRENT_WINDOW, OFF); ENDIF; ! -------------------------------- ! Move to next or previous section ! -------------------------------- IF direction_to_move = FORWARD THEN MOVE_VERTICAL (+GV$_section_distance); ELSE MOVE_VERTICAL (-GV$_section_distance); ENDIF; MOVE_HORIZONTAL (-CURRENT_OFFSET); curpos := MARK (NONE); ! ---------------------------------------------------------- ! Perform an auto reverse of direction if at buffer boundary ! ---------------------------------------------------------- IF curpos = BEGINNING_OF (CURRENT_BUFFER) THEN ppl_forward; ENDIF; ! --------------------------------------------- ! Re-enable scrolling (if it had been disabled) ! --------------------------------------------- IF GV$_using_workstation = 1 THEN UPDATE (CURRENT_WINDOW); ppl_set_scroll_region (CURRENT_WINDOW, ON); ENDIF; ENDPROCEDURE PROCEDURE EDT$select !keypad PERIOD (select) IF ( GV$_beginning_of_select <> 0 ) THEN MESSAGE ("Select already active") ELSE GV$_beginning_of_select := SELECT (GV$_video); GV$_select_is_active := 1; IF GV$_status_line_mode = 1 THEN ppl_update_status_line (CURRENT_WINDOW); ENDIF; ENDIF; ENDPROCEDURE !EDT$select PROCEDURE EDT$substitute !GOLD-ENTER (substitute) LOCAL r_len; ON_ERROR IF ( ERROR = TPU$_STRNOTFOUND ) THEN EDT$cancel_subs; ENDIF; RETURN; ENDON_ERROR IF ( GV$_search_range = 0 ) THEN EDT$cancel_subs; ELSE ! make sure position is on the search range IF ( EDT$on_search_range = 1 ) THEN ERASE ( GV$_search_range ); EDT$paste; GV$_search_range := ppl_enhanced_search (GV$_search_string, CURRENT_DIRECTION); IF ( GV$_search_begin ) ! SET SEARCH BEGIN THEN POSITION ( BEGINNING_OF ( GV$_search_range ) ); ELSE ! SET SEARCH END POSITION ( END_OF ( GV$_search_range ) ); MOVE_HORIZONTAL ( +1 ); ENDIF; ! if not on the search range, then cancel the substitution: ELSE EDT$cancel_subs; ENDIF; ENDIF; ENDPROCEDURE !EDT$substitute PROCEDURE EDT$cancel_subs ! support routine for substitute MESSAGE ("No select active"); GV$_repeat_count := 1; ENDPROCEDURE !EDT$cancel_subs PROCEDURE EDT$undelete_char !GOLD-COMMA (undelete character) IF ( GV$_deleted_char <> GV$_lf ) THEN COPY_TEXT (GV$_deleted_char); ELSE SPLIT_LINE; ENDIF; MOVE_HORIZONTAL (-1); ENDPROCEDURE !EDT$undelete_char PROCEDURE EDT$undelete_line !GOLD-PF4 (undelete line) LOCAL temp_length; IF (GV$_appended_line) THEN SPLIT_LINE; COPY_TEXT (GV$_deleted_line); MOVE_HORIZONTAL ( -( CURRENT_OFFSET + 1 ) ); ELSE temp_length := LENGTH (GV$_deleted_line); IF ( GV$_delete_crlf = 1 ) AND ( MARK (NONE) <> END_OF ( CURRENT_BUFFER ) ) THEN SPLIT_LINE; MOVE_HORIZONTAL (-1); ENDIF; COPY_TEXT (GV$_deleted_line); MOVE_HORIZONTAL ( -temp_length ); ENDIF; ENDPROCEDURE !EDT$undelete_line PROCEDURE EDT$undelete_word !GOLD-MINUS (undelete word) IF ( GV$_deleted_word <> GV$_lf ) THEN IF ( SUBSTR ( GV$_deleted_word, 1, 1 ) = GV$_lf ) THEN SPLIT_LINE; COPY_TEXT ( SUBSTR ( GV$_deleted_word, 2, LENGTH (GV$_deleted_word) - 1 ) ); ELSE COPY_TEXT (GV$_deleted_word); ENDIF; IF ( CURRENT_DIRECTION = REVERSE ) THEN MOVE_HORIZONTAL ( - LENGTH (GV$_deleted_word) ); ENDIF; ELSE SPLIT_LINE; MOVE_HORIZONTAL (-1); ENDIF; ENDPROCEDURE !EDT$undelete_word PROCEDURE EDT$on_end_of_line !support routine for undelete IF ( CURRENT_CHARACTER = GV$_null ) THEN EDT$on_end_of_line := 1; ELSE EDT$on_end_of_line := 0; ENDIF; ENDPROCEDURE !EDT$on_end_of_line ! control character string initialization loop (utility) PROCEDURE F$_init_chars_loop ( start_code, end_code ) LOCAL code, the_string; code := start_code; the_string := GV$_null; LOOP EXITIF code > end_code; the_string := the_string + ASCII(code); code := code + 1; ENDLOOP; RETURN ( the_string ) ENDPROCEDURE !F$_init_chars_loop ! initialize global variables with control characters (printable style) PROCEDURE P$_init_char_strings ! (1) GV$_word_delimiter := ""; ! (2) GV$_word := ",;:([{"; ! (3) GV$_control_chars := ! "^A^B^C^D^E^F^G^H^N^O" ! + "^P^Q^R^S^T^U^V^W^X^Y^Z^\^]^^^_" ; GV$_word_delimiter:= ASCII(32) ! + F$_init_chars_loop ( 9, 13 ); ! GV$_word := ASCII(32) ! + F$_init_chars_loop ( 9, 13 ); ! ! GV$_word := GV$_word + ",;:([{" ; !extend TPU/EDT's idea of a word separator GV$_control_chars := F$_init_chars_loop ( 0, 31 ); !all the controls GV$_ASCII_chart := F$_init_chars_loop ( 0, 255 ); !all ASCII chars GV$_tab := ASCII( 9); GV$_lf := ASCII(10); GV$_ff := ASCII(12); GV$_cr := ASCII(13); GV$_esc := ASCII(27); GV$_spc := ASCII(32); GV$_spc_tab := GV$_spc + GV$_tab; ENDPROCEDURE !P$_init_char_strings ! ------------------------------------------------------------------------------ ! This the the beginning of the enhancements section............................ ! ------------------------------------------------------------------------------ ! --------------------------------------------------------------------------- ! Position to beginning of current word (the delimiters are beginning of ! line, space or tab). This operation does not extend across line boundaries. ! If the cursor is initially between words (i.e., resting on a tab or space), ! a search in the forward direction is performed. ! --------------------------------------------------------------------------- PROCEDURE ppl_beg_of_word LOCAL tab, final_status, ln, total_ln; tab := ASCII (9); total_ln := LENGTH (CURRENT_LINE) - 1; ! ------------------- ! Is this line empty? ! ------------------- IF total_ln = -1 THEN RETURN (0); ENDIF; ! ---------------------------------------- ! Are we beyond the last word on the line? ! ---------------------------------------- IF total_ln < CURRENT_OFFSET THEN RETURN (0); ENDIF; ! --------------------------------------------------------------- ! If we are starting between words, plan on returning a different ! status than if we are on or inside of a word ! --------------------------------------------------------------- IF (CURRENT_CHARACTER = ' ') OR (CURRENT_CHARACTER = tab) THEN final_status := 2; ELSE final_status := 1; ENDIF; ! ---------------------------------------------------- ! Backup to a point before or at where the word begins ! ---------------------------------------------------- LOOP; EXITIF CURRENT_OFFSET = 0; EXITIF CURRENT_CHARACTER = ' '; EXITIF CURRENT_CHARACTER = tab; MOVE_HORIZONTAL (-1); ENDLOOP; ln := CURRENT_OFFSET; LOOP; IF (CURRENT_CHARACTER <> ' ') AND (CURRENT_CHARACTER <> tab) THEN RETURN (final_status); ENDIF; ln := ln + 1; IF ln > total_ln THEN RETURN (0); ENDIF; MOVE_HORIZONTAL (1); ENDLOOP; ENDPROCEDURE; ! --------------- ! Set left margin ! --------------- PROCEDURE ppl_set_left_margin LOCAL lmargin, lft_margin; ON_ERROR ppl_message ('Invalid response'); ppl_clear_prompt; RETURN; ENDON_ERROR; MESSAGE (''); MESSAGE ('Current left margin: '+STR (GV$_left_margin)+' ... '+ 'Current right margin: '+STR (GV$_right_margin)); lmargin := READ_LINE ('New left margin? (...press RETURN to abort) '); ppl_clear_prompt; ERASE (message_buffer); IF lmargin = '' THEN RETURN; ENDIF; lft_margin := INT (lmargin); IF lft_margin > GV$_right_margin THEN ppl_message("The left margin can not be greater than the right margin"); ELSE IF lft_margin < 1 THEN ppl_message ("Invalid left margin value"); ELSE GV$_left_margin := lft_margin; SET (MARGINS, CURRENT_BUFFER, lft_margin, GV$_right_margin); MESSAGE ("Use the FILL command to shift text to new margin..."); ENDIF; ENDIF; ENDPROCEDURE; ! --------------------------------------------------------- ! Calibrate the scrolling size to the window's visible size ! --------------------------------------------------------- PROCEDURE ppl_adjust_scroll_size LOCAL window_size; window_size := GET_INFO (CURRENT_WINDOW, "visible_length") - 1; GV$_section_distance := (window_size/2) + (window_size/4); ! -------------------------------- ! In case of very small windows... ! -------------------------------- IF GV$_section_distance = 0 THEN GV$_section_distance := 1; ! ----------------------------- ! In case of very large windows ! ----------------------------- ELSE IF GV$_section_distance > 25 THEN GV$_section_distance := 25; ENDIF; ENDIF; ENDPROCEDURE; ! ------------------------------------------------------------------------- ! Remember our present window / buffer combination, if anything has changed ! ------------------------------------------------------------------------- PROCEDURE ppl_remember_bufferwindow IF (present_buffer_ <> CURRENT_BUFFER) OR (present_window_ <> CURRENT_WINDOW) THEN previous_buffer_ := present_buffer_; previous_window_ := present_window_; present_buffer_ := CURRENT_BUFFER; present_window_ := CURRENT_WINDOW; ENDIF; ENDPROCEDURE; ! -------------------------------------------- ! Update the status line of the current window ! -------------------------------------------- PROCEDURE ppl_update_status_line (windowid) LOCAL temp_present_buffer, current_file, current_name, i, status_string, j, file_name_length, buffer_name_length, total_length, screen_width, mod, curstat, selstat, rwmode, tmod, amod, dmod, kmod, wmod, fcmod, rkmode, keymod, gstat, ls, ftype; temp_present_buffer := GET_INFO (windowid, "buffer"); current_file := GET_INFO (temp_present_buffer, "output_file"); current_name := GET_INFO (temp_present_buffer, "name"); kmod := GET_INFO (temp_present_buffer, "mode"); rwmode := GET_INFO (temp_present_buffer, "no_write"); dmod := GET_INFO (temp_present_buffer, "direction"); IF kmod = INSERT THEN mod := ''; ELSE mod := ' overstrike'; ENDIF; IF dmod = FORWARD THEN dmod := ''; ELSE dmod := ' reverse'; ENDIF; IF rwmode = 0 THEN rwmode := ' write'; ELSE rwmode := ' read'; ENDIF; IF GV$_auto_indent_mode = 0 THEN rkmode := ''; ELSE rkmode := ' indent'; ENDIF; IF GV$_auto_wrap_mode = 0 THEN wmod := ''; ELSE wmod := ' wrap'; ENDIF; IF keypad_mode_ = 'n' THEN keymod := ' '; ELSE keymod := ''; ENDIF; IF GV$_real_tabs = 0 THEN tmod := ' notab'; ELSE tmod := ''; ENDIF; IF GV$_free_cursor = 0 THEN fcmod := ''; ELSE fcmod := ' fc'; ENDIF; IF GV$_limited_search <> 0 THEN ls := ' ls'; ELSE ls := ''; ENDIF; amod := ''; IF current_file <> 0 THEN i := INDEX (current_file, ';'); ftype := SUBSTR (current_file, i-4, 4); IF (ftype = '.COM') AND (comfile_mode_ = 1) THEN amod := ' $'; ENDIF; ENDIF; gstat := ' '; IF windowid = CURRENT_WINDOW THEN i := GV$_shift_count; LOOP EXITIF i = 0; gstat := gstat + ''; i := i - 1; ENDLOOP; ENDIF; IF GV$_select_is_active = 1 THEN selstat := '