! ------------------------------------------------------------------------------ ! DEV_TPU:EDTEM.TPU ! ----------------- ! ! PP&L standard TPU-emulated EDT with multiple enhancements ! !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! To rebuild the DEV_TPU:EDTEM.TPU$SECTION section file, perform these ! following steps: ! ! 1. Invoke command procedure DEV_TPU:BUILD_EDTEM. ! This rebuilds section file DEV_TPU:EDTEM.TPU$SECTION. ! ! 2. Copy DEV_TPU:EDTEM.TPU$SECTION into SYS_MANAGER on all appropriate ! nodes. ! ! 3. Invoke INSTALL and REPLACE SYS_MANAGER:EDTEM.TPU$SECTION on each ! node (if one wishes to make it a known, shareable image). !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ! This editor passed through three major stages of development: ! ! 1. The EDT emulator as developed by DEC. ! ! 2. Modification and cleanup of DEC's EDT emulator by ! Lorin Ricker and Rick Evans. The result is known as the ! EDT baseline editor. Symbols and functions starting with ! F$, P$ and GV$ were introduced at that time. ! ! 3. Addition of the functions described in EDTEM.DOC by Mike Latshaw. ! These are the ppl_* functions. ! ! M. Latshaw <> 10/01/86 ! ------------------------------------------------------------------------------ ! ------------------------------------------------------------------------------ ! Here is the baseline editor................................................... ! ------------------------------------------------------------------------------ ! *** Bind all EDT and EDTEM keys *** PROCEDURE EDT$define_keys !define all keys ! arrow keys ! DEFINE_KEY ( 'MOVE_HORIZONTAL (-GV$_arrow_skip_size)', LEFT, "-C (LEFT arrow)" ); DEFINE_KEY ( 'SHIFT ( CURRENT_WINDOW, +32 )', KEY_NAME(LEFT,SHIFT_KEY), "shift_left (GOLD-LEFT arrow)" ); DEFINE_KEY ( 'MOVE_HORIZONTAL (+GV$_arrow_skip_size)', RIGHT, "+C (RIGHT arrow)" ); DEFINE_KEY ( 'SHIFT ( CURRENT_WINDOW, -32 )', KEY_NAME(RIGHT,SHIFT_KEY), "shift_right (GOLD-RIGHT arrow)" ); DEFINE_KEY ( 'MOVE_VERTICAL (+1)', DOWN, "DOWN (DOWN arrow)" ); DEFINE_KEY ( 'MOVE_VERTICAL (-1)', UP, "UP (UP arrow)" ); ! editing keypad keys ! DEFINE_KEY ( 'EDT$search', E1, "Find (E1)" ); DEFINE_KEY ( 'EDT$paste', E2, "Paste (E2)" ); DEFINE_KEY ( 'EDT$cut', E3, "Cut (E3)" ); DEFINE_KEY ( 'EDT$select', E4, "Select (E4)" ); DEFINE_KEY ( 'EDT$section(REVERSE)', E5, "Previous_Screen (E5)" ); DEFINE_KEY ( 'EDT$section(FORWARD)', E6, "Next_Screen (E6)" ); ! function keys ! DEFINE_KEY ( 'EDT$keypad_help', HELP, "Keypad_Diagram (HELP)" ); DEFINE_KEY ( 'EDT$help (GV$_null)', KEY_NAME(HELP,SHIFT_KEY), "VAXTPU_help (GOLD-HELP)" ); ! numeric/application keypad keys !first row ! DEFINE_KEY ( 'EDT$keypad_help', PF2, "Keypad_Diagram (PF2)" ); DEFINE_KEY ( 'EDT$help (GV$_null)', KEY_NAME(PF2,SHIFT_KEY), "VAXTPU_help (GOLD-PF2)" ); DEFINE_KEY ( 'EDT$search_next ( GV$_search_string )', PF3, "next (PF3)" ); DEFINE_KEY ( 'EDT$delete_line', PF4, "delete_L (PF4)" ); DEFINE_KEY ( 'EDT$undelete_line', KEY_NAME(PF4,SHIFT_KEY), "undelete_L (GOLD-PF4)" ); ! second row ! DEFINE_KEY ( 'EDT$page', KP7, "page (KP7)" ); DEFINE_KEY ( 'EDT$command', KEY_NAME(KP7,SHIFT_KEY), "TPU_command (GOLD-KP7)" ); DEFINE_KEY ( 'edt$section (CURRENT_DIRECTION)', KP8, "paragraph (KP8)" ); DEFINE_KEY ( 'EDT$fill', KEY_NAME(KP8,SHIFT_KEY), "fill (GOLD-KP8)" ); DEFINE_KEY ( 'EDT$append', KP9, "append (KP9)" ); DEFINE_KEY ( 'EDT$replace', KEY_NAME(KP9,SHIFT_KEY), "replace (GOLD-KP9)" ); DEFINE_KEY ( 'EDT$delete_end_word', MINUS, "delete_W (MINUS)" ); DEFINE_KEY ( 'EDT$undelete_word', KEY_NAME(MINUS,SHIFT_KEY), "undelete_W (GOLD-MINUS)" ); !third row ! DEFINE_KEY ( 'POSITION (END_OF (CURRENT_BUFFER))', KEY_NAME(KP4,SHIFT_KEY), "bottom (GOLD-KP4)" ); DEFINE_KEY ( 'POSITION (BEGINNING_OF (CURRENT_BUFFER))', KEY_NAME(KP5,SHIFT_KEY), "top (GOLD-KP5)" ); DEFINE_KEY ( 'EDT$cut', KP6, "cut (KP6)" ); DEFINE_KEY ( 'EDT$paste', KEY_NAME(KP6,SHIFT_KEY), "paste (GOLD-KP6)" ); DEFINE_KEY ( 'EDT$delete_char', COMMA, "delete_C (COMMA)" ); DEFINE_KEY ( 'EDT$undelete_char', KEY_NAME(COMMA,SHIFT_KEY), "undelete_C (GOLD-COMMA)" ); !fourth row ! DEFINE_KEY ( 'EDT$move_word', KP1, "word (KP1)" ); DEFINE_KEY ( 'EDT$change_case', KEY_NAME(KP1,SHIFT_KEY), "change_case (GOLD-KP1)" ); DEFINE_KEY ( 'EDT$end_of_line', KP2, "EOL (KP2)" ); DEFINE_KEY ( 'EDT$delete_to_eol', KEY_NAME(KP2,SHIFT_KEY), "delete_EOL (GOLD-KP2)" ); DEFINE_KEY ( 'EDT$move_char', KP3, "char (KP3)" ); DEFINE_KEY ( 'COPY_TEXT (ASCII (INT (READ_LINE ("SpecIns: "))))', KEY_NAME(KP3,SHIFT_KEY), "SpecIns (GOLD-KP3)" ); !fifth row ! DEFINE_KEY ( 'EDT$next_prev_line ( CURRENT_DIRECTION )', KP0, "line (KP0)" ); DEFINE_KEY ( 'ppl_open_line', KEY_NAME(KP0,SHIFT_KEY), "open_line (GOLD-KP0)" ); DEFINE_KEY ( 'EDT$select', PERIOD, "select (PERIOD)" ); DEFINE_KEY ( 'EDT$reset', KEY_NAME(PERIOD,SHIFT_KEY), "reset (GOLD-PERIOD)" ); DEFINE_KEY ( 'ppl_auto_scroll', ENTER, "ENTER ...auto scroll" ); DEFINE_KEY ( 'EDT$substitute', KEY_NAME(ENTER,SHIFT_KEY), "substitute (ENTER)" ); ! control keys ! DEFINE_KEY ( 'ppl_box_comment', CTRL_F_KEY, 'F ...frame a single-line comment (according to language type)'); DEFINE_KEY ( 'EDT$backspace', BS_KEY, " (BS,CTRL/H)" ); DEFINE_KEY ( 'EDT$del_beg_word', LF_KEY, "delete_previous_word (LF,CTRL/J)" ); DEFINE_KEY ( 'COPY_TEXT(ASCII(9))', TAB_KEY, " (TAB,CTRL/I)" ); DEFINE_KEY ( 'ppl_invert_word', CTRL_K_KEY, 'K ...invert the case of the previous or current word'); DEFINE_KEY ( 'COPY_TEXT (GV$_ff)', CTRL_L_KEY, " (FF,CTRL/L)" ); DEFINE_KEY ( 'P$_ret_key', RET_KEY, " (RETURN,CTRL/M)" ); DEFINE_KEY ( 'ppl_indent_as_above (1)', CTRL_N_KEY, 'N ...indent to level of last non-comment, non-blank line (add below)'); DEFINE_KEY ( 'ppl_indent_as_above (-1)', CTRL_P_KEY, 'P ...indent to level of last non-comment, non-blank line (add above)'); DEFINE_KEY ( 'EDT$delete_beg_line', CTRL_U_KEY, "delete_to_BOL (CTRL/U)" ); DEFINE_KEY ( 'REFRESH', CTRL_W_KEY, "refresh_screen (CTRL/W)" ); DEFINE_KEY ( 'UNMAP (INFO_WINDOW)', ctrl_z_key, "resume_editing (CTRL/Z)" ); ! GOLD-letter keys ! ! Define the numeric keys for use with EDT$gold_number ! to execute EDT repeat counts: DEFINE_KEY ( 'EDT$gold_number("0")', KEY_NAME('0',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("1")', KEY_NAME('1',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("2")', KEY_NAME('2',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("3")', KEY_NAME('3',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("4")', KEY_NAME('4',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("5")', KEY_NAME('5',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("6")', KEY_NAME('6',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("7")', KEY_NAME('7',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("8")', KEY_NAME('8',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("9")', KEY_NAME('9',SHIFT_KEY) ); DEFINE_KEY ( 'EDT$gold_number("-")', KEY_NAME('-',SHIFT_KEY) ); ! --------------- ! EDTEM functions ! --------------- DEFINE_KEY ('ppl_adjust_window', KEY_NAME ('A', SHIFT_KEY), ' A ...adjust the top and bottom limits of the current window'); DEFINE_KEY ('ppl_go_to_buffer ("")', KEY_NAME ('B', SHIFT_KEY), ' B ...go to specified buffer'); DEFINE_KEY ('ppl_create_and_map', KEY_NAME ('C', SHIFT_KEY), ' C ...create and map a window to the current buffer'); DEFINE_KEY ('ppl_dcl_command ("")', KEY_NAME ('D', SHIFT_KEY), ' D ...issue an online DCL command'); DEFINE_KEY ('EXIT', KEY_NAME ('E', SHIFT_KEY), ' E ...exit the editing session, saving all changes'); DEFINE_KEY ('ppl_go_to_flagged_buffer', KEY_NAME ('F', SHIFT_KEY), ' F ...go to flagged buffer or include flagged file'); DEFINE_KEY ('ppl_display_on_full_screen', KEY_NAME ('G', SHIFT_KEY), ' G ...display current buffer using full screen'); DEFINE_KEY ('ppl_help', KEY_NAME ('H', SHIFT_KEY), ' H ...display user standard function descriptions'); DEFINE_KEY ('ppl_fetch_file ("")', KEY_NAME ('I', SHIFT_KEY), ' I ...read a file into a new buffer'); DEFINE_KEY ('ppl_cut_rectangle', KEY_NAME ('K', SHIFT_KEY), ' K ...cut a marked rectangle'); DEFINE_KEY ('ppl_go_to_previous_buffer', KEY_NAME ('L', SHIFT_KEY), ' L ...go to the previously active buffer'); DEFINE_KEY ('ppl_go_to_main_buffer', KEY_NAME ('M', SHIFT_KEY), ' M ...go to the main editing buffer'); DEFINE_KEY ('ppl_toggle_keypad', KEY_NAME ('N', SHIFT_KEY), ' N ...toggle between application and numeric keypad modes'); DEFINE_KEY ('ppl_toggle_output_mode', KEY_NAME ('O', SHIFT_KEY), ' O ...toggle buffer output status modes (readonly, write)'); DEFINE_KEY ('ppl_write_buffer', KEY_NAME ('P', SHIFT_KEY), ' P ...write the selected range to a device or file'); DEFINE_KEY ('QUIT', KEY_NAME ('Q', SHIFT_KEY), ' Q ...quit the editing session without saving changes'); DEFINE_KEY ('ppl_find_and_replace', KEY_NAME ('R', SHIFT_KEY), ' R ...sequential queried search and replace'); DEFINE_KEY ('ppl_show_buffers', KEY_NAME ('S', SHIFT_KEY), ' S ...display active buffers with count of mapped windows'); DEFINE_KEY ('ppl_specify_output', KEY_NAME ('T', SHIFT_KEY), ' T ...redefine the output file/device of the current buffer'); DEFINE_KEY ('ppl_delete_window ("")', KEY_NAME ('U', SHIFT_KEY), ' U ...delete the current window'); DEFINE_KEY ('ppl_mark_rectangle', KEY_NAME ('V', SHIFT_KEY), ' V ...mark a rectangle paste boundary'); DEFINE_KEY ('ppl_visit_forward_windows', KEY_NAME ('W', SHIFT_KEY), ' W ...step through the mapped windows'); DEFINE_KEY ('ATTACH', KEY_NAME ('X', SHIFT_KEY), ' X ...return to parent process (TPU command mode, only)'); DEFINE_KEY ('ERASE (message_buffer)', KEY_NAME (' ', SHIFT_KEY), ' ...clear the message buffer'); DEFINE_KEY ('ppl_spawn', KEY_NAME ('+', SHIFT_KEY), ' + ...spawn subprocess with optional one-shot command'); DEFINE_KEY ('ppl_adjust_screen_width', KEY_NAME ('<', SHIFT_KEY), " < ...adjust current window's horizontal screen width"); DEFINE_KEY ('curpos_ := MARK (NONE)', KEY_NAME ('[', SHIFT_KEY), ' [ ...remember current position with current buffer'); DEFINE_KEY ('POSITION (curpos_)', KEY_NAME (']', SHIFT_KEY), ' ] ...return to remembered position within current buffer'); DEFINE_KEY ('ppl_define_function', KEY_NAME ('~', SHIFT_KEY), ' ~ ...define user function'); DEFINE_KEY ('ppl_describe_function', KEY_NAME ('`', SHIFT_KEY), ' ` ...describe user function'); DEFINE_KEY ('ppl_save_context', KEY_NAME ('|', SHIFT_KEY), ' | ...save current function key definitions'); DEFINE_KEY ('ppl_show_ruler', KEY_NAME ('\', SHIFT_KEY), ' \ ...display ruler in current buffer'); DEFINE_KEY ('ppl_insert_ruler', KEY_NAME ('/', SHIFT_KEY), ' / ...insert ruler into buffer above current line'); DEFINE_KEY ('ppl_trimt', KEY_NAME ('}', SHIFT_KEY), ' } ...trim trailing blanks and tabs from current line'); DEFINE_KEY ('ppl_comfile_mode', KEY_NAME ('$', SHIFT_KEY), ' $ ...toggle command file auto prompt mode'); DEFINE_KEY ('ppl_compile_source', KEY_NAME ('?', SHIFT_KEY), ' ? ...compile source (/NOOBJECT/LIST) in current buffer'); DEFINE_KEY ('ppl_set_top_line_down', KEY_NAME (UP, SHIFT_KEY), ' ...define the upper limit of the current window'); DEFINE_KEY ('ppl_set_bottom_line_up', KEY_NAME (DOWN,SHIFT_KEY), ' ...define the lower limit of the current window'); DEFINE_KEY ('ppl_create_scratch_buffer', KEY_NAME (ctrl_b_key, SHIFT_KEY), ' B ...create a scratch buffer'); DEFINE_KEY ('ppl_go_to_buffer("dcl_command")',KEY_NAME (ctrl_d_key, SHIFT_KEY), ' D ...recall DCL command buffer to screen'); DEFINE_KEY ('ppl_include_file ("")', KEY_NAME (ctrl_i_key, SHIFT_KEY), ' I ...read a file into the current buffer at current line'); DEFINE_KEY ('ppl_paste_rectangular', KEY_NAME (ctrl_k_key, SHIFT_KEY), ' K ...paste a rectangle into the current buffer'); DEFINE_KEY ('ppl_toggle_modes', KEY_NAME (ctrl_m_key, SHIFT_KEY), ' M ...toggle between insert and overstrike modes'); DEFINE_KEY ('ppl_unmark_rectangle', KEY_NAME (ctrl_v_key, SHIFT_KEY), ' V ...remove a rectangle paste boundary'); DEFINE_KEY ('ppl_toggle_width', KEY_NAME (ctrl_w_key, SHIFT_KEY), ' W ...toggle between normal (80) and wide (132) column modes'); ! ------------- ! DEC overrides ! ------------- DEFINE_KEY ('ppl_forward', Kp4, "advance (KP4)"); DEFINE_KEY ('ppl_reverse', Kp5, "backup (KP5)"); DEFINE_KEY ('ppl_normal_find', KEY_NAME (PF3, SHIFT_KEY), "find (GOLD-PF3)"); DEFINE_KEY ('edt$rubout', del_key, 'delete_previous_char (^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. ENDPROCEDURE !EDT$init_variables ! 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); 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 ! error handler for searches (utility) PROCEDURE P$_search_error_handler ( search_target ) LOCAL saved_error; saved_error := ERROR; IF ( saved_error = TPU$_STRNOTFOUND ) OR ( saved_error = TPU$_BEGOFBUF ) OR ( saved_error = TPU$_ENDOFBUF ) THEN IF ( GET_INFO ( search_target, "TYPE") = PATTERN ) THEN MESSAGE ( "Pattern not found" ); ELSE MESSAGE ( "`" + search_target + "' - string not found" ); ENDIF; GV$_search_abort_flag := TRUE; GV$_repeat_count := 1; RETURN; ENDIF; ENDPROCEDURE !P$_search_error_handler ! 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 ! search-utility routine for EDT$search and P$_find_replace_next (utility) PROCEDURE P$_find_global_search_string ( dir_dist, search_target ) LOCAL its_a_pattern; ON_ERROR P$_search_error_handler ( search_target ) ENDON_ERROR GV$_search_abort_flag := FALSE; !set TRUE if search fails IF ( GET_INFO ( search_target, "TYPE") = PATTERN ) THEN its_a_pattern := TRUE; ELSE its_a_pattern := FALSE; ENDIF; ! bump-off to avoid refinding same target: MOVE_HORIZONTAL ( dir_dist ); IF ( its_a_pattern ) THEN GV$_search_range := !pattern searching is case-sensitive SEARCH ( search_target, CURRENT_DIRECTION, EXACT ); ELSE GV$_search_range := !string-literal searching is either SEARCH ( search_target, CURRENT_DIRECTION, GV$_search_case ); ENDIF; IF ( GV$_search_range <> 0 ) THEN IF ( GV$_search_begin ) THEN ! SET SEARCH BEGIN is in effect POSITION ( BEGINNING_OF ( GV$_search_range ) ); ELSE ! SET SEARCH END is in effect POSITION ( END_OF ( GV$_search_range ) ); MOVE_HORIZONTAL ( +1 ); ENDIF; ELSE MOVE_HORIZONTAL ( -dir_dist ); !recover from previous bump-off ENDIF; IF ( GV$_search_abort_flag ) THEN ABORT; !short-circuit for GOLD-number operational repeats ENDIF; ENDPROCEDURE !P$_find_global_search_string ! clear the message window/buffer (GOLD-E) PROCEDURE P$_clear_message_window ERASE ( MESSAGE_BUFFER ); UPDATE ( MESSAGE_WINDOW ); ENDPROCEDURE !P$_clear_message_window 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 ); ! Was HELP requested? IF ( INDEX ("HELP", SUBSTR ( command, 1, 4 ) ) = 1 ) THEN IF ( command = "HELP" ) THEN ! return key-map summary: EDT$help ( "KED" ); ELSE ! let user specify topic: EDT$help ( SUBSTR ( command, 5, 32 ) ); ENDIF; RETURN; ELSE ! prepare user's command for execution: execute_command := COMPILE (command); ENDIF; 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; 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; 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; 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; 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; 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; 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 PROCEDURE EDT$fill !GOLD-KP8 (fill) EDT$select_range; IF ( GV$_select_range <> 0 ) THEN ! patterns for matching multiple blank lines IF ( GV$_right_margin = 0 ) THEN EDT$preserve_blanks(FALSE) ELSE EDT$preserve_blanks(TRUE) ENDIF; GV$_select_range := 0; 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 ); 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 + 1, GV$_right_margin ); ELSE FILL ( sub_range, GV$_word_delimiter, GV$_left_margin + 1, 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; 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 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 ON_ERROR where := MARK ( NONE ); RETURN; ENDON_ERROR; POSITION ( where ); LOOP IF ( CURRENT_LINE <> GV$_null ) THEN EXITIF; ENDIF; MOVE_VERTICAL ( 1 ); MOVE_HORIZONTAL ( -CURRENT_OFFSET ); ENDLOOP; where := MARK ( NONE ); RETURN ENDPROCEDURE !EDT$skip_lines ! Procedures for EDT style GOLD-digit commands. PROCEDURE EDT$gold_number ( first_digit ) !GOLD-0..9 (repeat counts) LOCAL number, term_char, exe_flag, key_code; ON_ERROR GV$_repeat_count := 1; !reset RETURN; ENDON_ERROR; number := first_digit; LOOP term_char := READ_LINE ( number, 1 ); !Unfortunately, this built-in will ! not read control characters (e.g. ! CTRL/R, etc.), which limits gold- ! number repeats to keypad and ! GOLD-letter commands. IF ( term_char = GV$_null ) THEN term_char := LAST_KEY; exe_flag := 1; EXITIF ; ENDIF; IF ( INDEX ( GV$_control_chars, term_char ) <> 0 ) ! is it control character? THEN exe_flag := 1; EXITIF ; ENDIF; IF ( INDEX ( GV$_digits, term_char ) = 0 ) ! is it not a digit? THEN exe_flag := 0; EXITIF ; ENDIF; number := number + term_char; ENDLOOP; GV$_repeat_count := INT ( number ); ! If the key was SPECINS, just stick the character in; ! otherwise, do a repeat-count: IF ( exe_flag = TRUE ) THEN IF ( term_char = KEY_NAME ( KP3, SHIFT_KEY ) ) !SPECINS: GOLD-number/GOLD-KP3 THEN COPY_TEXT ( ASCII ( GV$_repeat_count ) ); ELSE ! Look up the key definition. If there was one, then execute it. ! If no definition, check to see if an alphabetic to insert. IF ( term_char = KEY_NAME ( KP7, SHIFT_KEY ) ) THEN ! doing an interactive command, get command: term_char := F$_prompt ( GV$_TPU_command_prompt, GV$_null ); IF ( term_char = GV$_null ) THEN key_code := 0; ELSE key_code := COMPILE ( term_char ); ENDIF !( term_char = GV$_null ) ELSE key_code := LOOKUP_KEY ( term_char, PROGRAM ); ENDIF; !( term_char = KEY_NAME ( KP7, SHIFT_KEY ) ) IF ( key_code <> 0 ) THEN LOOP EXECUTE ( key_code ); GV$_repeat_count := GV$_repeat_count - 1; EXITIF ( GV$_repeat_count < 1 ); ENDLOOP; ENDIF; !( key_code <> 0 ) ENDIF; !( term_char = KEY_NAME ( KP3, SHIFT_KEY ) ) ELSE LOOP COPY_TEXT ( term_char ); GV$_repeat_count := GV$_repeat_count - 1; EXITIF ( GV$_repeat_count < 1 ); ENDLOOP; ENDIF; !( exe_flag = TRUE ) GV$_repeat_count := 1; !reset ENDPROCEDURE !EDT$gold_number PROCEDURE EDT$help (topic_param) !HELP and GOLD-HELP (help on topic) LOCAL topic; SET ( STATUS_LINE, INFO_WINDOW, GV$_info_stats_video, GV$_CTRL_Z_prompt ); SET ( WIDTH, INFO_WINDOW, GET_INFO (SCREEN,"WIDTH") ); SET ( VIDEO, INFO_WINDOW, NONE ); SET ( PAD, INFO_WINDOW, OFF ); MAP ( INFO_WINDOW, HELP_BUFFER ); topic := topic_param; IF ( topic = GV$_null ) THEN topic := F$_prompt ( "Topic", "KED" ); ENDIF; P$_clear_message_window; HELP_TEXT ( "SYS_MANAGER:EDTBASE", topic, ON, HELP_BUFFER ); UNMAP ( INFO_WINDOW ); ENDPROCEDURE !EDT$help PROCEDURE EDT$keypad_help !HELP (keypad help) LOCAL text_prompt, timer_string, help_key, comment_string; ! Check to see if screen has at least a length of 24 or more - If not, ! then this command doesn't make sense (may mess up the user's screen). IF ( GET_INFO ( SCREEN, "VISIBLE_LENGTH" ) < 24 ) THEN MESSAGE ("screen must have length >= 24 to use keypad help"); ABORT; ENDIF; IF ( GV$_keypad_window = 0 ) !this is a window-pointer-var, if not zero THEN EDT$create_keypad_diagram; ELSE EDT$get_keypad_diagram; ENDIF; timer_string := GET_INFO ( SYSTEM, "TIMED_MESSAGE"); !turn off timer temporarily IF ( timer_string <> GV$_null ) THEN SET (TIMER, OFF, GV$_null); ENDIF; text_prompt := " = help on that key; " + " = diagram; " + GV$_CTRL_Z_prompt; MAP ( GV$_keypad_window, GV$_keypad_buffer ); UPDATE ( GV$_keypad_window ); help_key := READ_KEY; LOOP EXITIF ( ( help_key = CTRL_Z_KEY ) OR ( help_key = CTRL_M_KEY ) ); comment_string := LOOKUP_KEY ( help_key, COMMENT ); comment_string := SUBSTR ( comment_string, 1, INDEX ( comment_string, GV$_spc ) - 1 ); IF ( ( help_key = HELP ) OR ( help_key = PF2 ) ) THEN EDT$get_keypad_diagram; ELSE SET ( TEXT, GV$_keypad_window, BLANK_TABS ); SET ( STATUS_LINE, GV$_keypad_window, REVERSE, text_prompt ); IF ( comment_string = GV$_null ) THEN comment_string := "no" ENDIF; HELP_TEXT ( "SYS_MANAGER:EDTBASE", "KED " + comment_string, OFF, GV$_keypad_buffer ); POSITION ( BEGINNING_OF (GV$_keypad_buffer) ); ERASE_LINE; ERASE_LINE; ERASE_LINE; ERASE_LINE; POSITION ( BEGINNING_OF (GV$_keypad_buffer) ); ENDIF; UPDATE (GV$_keypad_window); help_key := READ_KEY; ENDLOOP; UNMAP (GV$_keypad_window); IF ( timer_string <> GV$_null ) THEN SET (TIMER, ON, timer_string); ! Restore timer ENDIF; ENDPROCEDURE !EDT$keypad_help ! Create the buffer and window for the keypad diagram. PROCEDURE EDT$create_keypad_diagram !support routine for keypad help GV$_keypad_window := CREATE_WINDOW ( 1, 24, OFF ); GV$_keypad_buffer := CREATE_BUFFER ( "keypad diagram" ); SET ( NO_WRITE, GV$_keypad_buffer ); SET ( EOB_TEXT, GV$_keypad_buffer, GV$_null ); EDT$get_keypad_diagram; ENDPROCEDURE !EDT$create_keypad_diagram ! Get the keypad diagram into the editor PROCEDURE EDT$get_keypad_diagram !support routine for keypad help ! Do error check - If HELP_BUFFER does not exist, then return. ! Otherwise, all lines in CURRENT_BUFFER will be deleted. IF ( GET_INFO ( GV$_keypad_buffer, "TYPE") = UNSPECIFIED ) THEN RETURN; ENDIF; SET ( TEXT, GV$_keypad_window, NO_TRANSLATE ); ERASE ( GV$_keypad_buffer ); SET ( STATUS_LINE, GV$_keypad_window, NONE, GV$_null ); HELP_TEXT ( "SYS_MANAGER:EDTBASE", "KEYPAD_" + GV$_TT_answerback_msg, OFF, GV$_keypad_buffer ); ! clean up the text in the help buffer: POSITION ( BEGINNING_OF (GV$_keypad_buffer) ); ! delete the HELP topic lines: ERASE_LINE; ERASE_LINE; ERASE_LINE; ! delete the extra spaces at the beginning of each line: LOOP EXITIF ( MARK (NONE) = END_OF (GV$_keypad_buffer) ); ERASE_CHARACTER (2); MOVE_VERTICAL (1); ENDLOOP; ! delete one blank line at EOB: ERASE_LINE; POSITION ( BEGINNING_OF (GV$_keypad_buffer) ); ENDPROCEDURE !EDT$get_keypad_diagram 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 ) ) 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 ( 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; SET ( FORWARD, CURRENT_BUFFER ); ERASE ( MESSAGE_BUFFER ); ENDPROCEDURE !EDT$reset 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; 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 PROCEDURE EDT$search !GOLD-PF3 (search) LOCAL search_term, dir_dist; prompt := "Search for: "; GV$_search_string := READ_LINE ( prompt ); dir_dist := F$_find_global_setup; P$_find_global_search_string ( dir_dist, GV$_search_string ); ENDPROCEDURE !EDT$search PROCEDURE EDT$search_next ( search_target ) ! Search for same thing again: ! PF3 (search next) and CTRL/P (search next GPS) LOCAL search_target_type, dir_dist; IF ( GET_INFO ( search_target, "TYPE") = PATTERN ) THEN search_target_type := "pattern"; ELSE search_target_type := "string"; ENDIF; ! get to the right place IF ( CURRENT_DIRECTION = FORWARD ) THEN IF ( MARK(NONE) = END_OF(CURRENT_BUFFER) ) THEN MESSAGE ( FAO ("!AS not found", search_target_type ) ); GV$_repeat_count := 1; RETURN; ENDIF; dir_dist := 1; ELSE IF ( MARK(NONE) = BEGINNING_OF(CURRENT_BUFFER) ) THEN MESSAGE ( FAO ("!AS not found", search_target_type ) ); GV$_repeat_count := 1; RETURN; ENDIF; dir_dist := -1; ENDIF; IF ( GV$_search_begin ) AND ( dir_dist = -1 ) THEN ! move to beginning of range first IF ( GV$_search_range <> 0 ) THEN POSITION ( BEGINNING_OF ( GV$_search_range ) ); ENDIF; ENDIF; P$_find_global_search_string ( dir_dist, search_target ); ENDPROCEDURE !EDT$search_next PROCEDURE EDT$section ( direction_to_move ) !KP8 (section) ON_ERROR GV$_repeat_count := 1; ENDON_ERROR; IF ( direction_to_move = FORWARD ) THEN MOVE_VERTICAL (GV$_section_distance); ELSE MOVE_VERTICAL (-GV$_section_distance); ENDIF; MOVE_HORIZONTAL ( -CURRENT_OFFSET ); ENDPROCEDURE !EDT$section 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); 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 := SEARCH ( GV$_search_string, CURRENT_DIRECTION, GV$_search_case ); 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 PROCEDURE EDT$wrap_word ! ...conditionally (wrap word) LOCAL word_size, margin_size, cur_mode; ! Wrap word at current EOL to the next line. ! Bound to space key when a SET WRAP is done. IF ( GV$_right_margin = 0 ) THEN UNDEFINE_KEY ( KEY_NAME(GV$_spc) ); ELSE IF ( CURRENT_COLUMN > GV$_right_margin ) THEN word_size := EDT$beg_word; cur_mode := GET_INFO ( CURRENT_BUFFER, "MODE" ); SET(INSERT,CURRENT_BUFFER); SPLIT_LINE; COPY_TEXT(SUBSTR(GV$_Spaces,1,GV$_left_margin)); SET(cur_mode,CURRENT_BUFFER); MOVE_HORIZONTAL (word_size); ENDIF; ENDIF; COPY_TEXT (GV$_spc); ENDPROCEDURE !EDT$wrap_word ! 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$_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; ! --------------------------------------------------------- ! 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); IF GV$_section_distance = 0 THEN GV$_section_distance := 1; ENDIF; ENDPROCEDURE; ! ----------------------------------------------------------------- ! If we are going to a different window looking at the same buffer, ! remember our current position ! ----------------------------------------------------------------- PROCEDURE ppl_remember_position (new_window, new_buffer) IF new_buffer <> CURRENT_BUFFER THEN RETURN; ENDIF; IF new_window = CURRENT_WINDOW THEN RETURN; ENDIF; present_position_ := MARK (NONE); 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; IF (present_window_ <> previous_window_) AND (present_buffer_ = previous_buffer_) THEN POSITION (previous_position_); previous_position_ := present_position_; 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, file_name_length, buffer_name_length, total_length, screen_width, windowid, mod, curstat, rwmode, dmod, kmod, 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 := ' insert '; ELSE mod := ' overstrike '; ENDIF; IF dmod = FORWARD THEN dmod := ' forward'; ELSE dmod := ' reverse'; ENDIF; IF rwmode = 0 THEN rwmode := 'write'; ELSE rwmode := 'read'; ENDIF; IF windowid = CURRENT_WINDOW THEN curstat := '*'; ELSE curstat := ' '; ENDIF; status_string := curstat + current_name + mod + rwmode + dmod; IF keypad_mode_ = 'n' THEN status_string := status_string + ' ' + keypad_mode_; ENDIF; IF current_file <> 0 THEN i := INDEX (current_file, ';'); ftype := SUBSTR (current_file, i-4, 4); IF (ftype = '.COM') AND (comfile_mode_ = 1) THEN status_string := status_string + ' auto'; ENDIF; buffer_name_length := LENGTH (status_string); file_name_length := LENGTH (current_file); total_length := buffer_name_length + file_name_length; screen_width := GET_INFO (SCREEN, "width"); status_string := status_string + SUBSTR (spaces_, 1, screen_width-total_length-1) + current_file; ENDIF; SET (STATUS_LINE, windowid, REVERSE, status_string); ENDPROCEDURE; ! ---------------------------------------------- ! Update the status lines of all visible windows ! ---------------------------------------------- PROCEDURE ppl_update_all_status_lines LOCAL stat, loop_buffer, loop_window; loop_window := GET_INFO (WINDOW, "first"); LOOP EXITIF loop_window = 0; loop_buffer := GET_INFO (loop_window, "buffer"); IF loop_buffer <> MESSAGE_BUFFER THEN stat := GET_INFO (loop_window, "visible"); IF stat = 1 THEN ppl_update_status_line (loop_window); ENDIF; ENDIF; loop_window := GET_INFO (WINDOW, "next"); ENDLOOP; ENDPROCEDURE; ! ------------------------------------ ! Match a window to its default buffer ! ------------------------------------ PROCEDURE ppl_find_window (assigned_window_name) LOCAL window_name, loop_window, buffer_id1, buffer_id2; loop_window := GET_INFO (WINDOW, "first"); window_name := assigned_window_name; CHANGE_CASE (window_name, UPPER); buffer_id2 := ppl_find_buffer (window_name); IF buffer_id2 = 0 THEN ! In case we are trying to match against RETURN (0); ! a non-existent buffer ENDIF; LOOP EXITIF loop_window = 0; buffer_id1 := GET_INFO (loop_window, "buffer"); IF buffer_id1 = buffer_id2 THEN RETURN (loop_window); ELSE loop_window := GET_INFO (WINDOWS, "next"); ENDIF; ENDLOOP; RETURN (0); ENDPROCEDURE; ! -------------------------------------------------- ! Create a new window (if it does not already exist) ! -------------------------------------------------- PROCEDURE ppl_create_window (window_name) LOCAL adj_window_name, line_limit, first_line, window_id, top_offset, bot_offset, size, cur_size, half_size; ! ----------------------------------------------------- ! If an explicit window name is provided by the caller, ! see if that window already exists ! ----------------------------------------------------- IF window_name <> '' THEN adj_window_name := window_name; CHANGE_CASE (adj_window_name, UPPER); window_id := ppl_find_window (adj_window_name); IF window_id <> 0 THEN ! Does the window already exist? RETURN (window_id); ENDIF; ENDIF; ! ---------------------------------------------------------- ! If feasible, partition the current window into two halves, ! placing the new window in the upper half ! ---------------------------------------------------------- cur_size := GET_INFO (CURRENT_WINDOW, "visible_length"); half_size := cur_size / 2; IF half_size >= 2 THEN first_line := GET_INFO (CURRENT_WINDOW, "visible_top"); size := cur_size - half_size + 1; window_id := CREATE_WINDOW (first_line, half_size, OFF); line_limit := half_size; ! ------------------------------ ! Otherwise, use the full screen ! ------------------------------ ELSE line_limit := GET_INFO (SCREEN, "visible_length") - 2; window_id := CREATE_WINDOW (1, line_limit, OFF); ENDIF; ! ---------------------------------- ! Establish the scrolling parameters ! ---------------------------------- IF line_limit < 9 THEN line_limit := line_limit - 2; top_offset := line_limit / 2; IF top_offset = 0 THEN bot_offset := 0; ELSE bot_offset := line_limit - top_offset; ENDIF; SET (SCROLLING, window_id, ON, top_offset, bot_offset, 0); ELSE SET (SCROLLING, window_id, ON, 3, 4, 0); ENDIF; RETURN (window_id); ENDPROCEDURE; ! -------------------------------------------------------- ! Adjust the size of an existing window (prompting method) ! -------------------------------------------------------- PROCEDURE ppl_adjust_window LOCAL delta_up, delta_down, ascii_in; ON_ERROR MESSAGE ('Invalid entry'); ppl_clear_prompt; RETURN (0); ENDON_ERROR; MESSAGE ('...press RETURN for an adjustment of zero...'); ascii_in := READ_LINE ('By how many lines should the window be adjusted upward? '); IF ascii_in = '' THEN delta_up := 0; ELSE delta_up := - INT (ascii_in); ENDIF; ascii_in := READ_LINE ('By how many lines should the window be adjusted downward? '); IF ascii_in = '' THEN delta_down := 0; ELSE delta_down := INT (ascii_in); ENDIF; ADJUST_WINDOW (CURRENT_WINDOW, delta_up, delta_down); ppl_adjust_scroll_size; ppl_clear_prompt; ERASE (message_buffer); ENDPROCEDURE; ! ------------------------------------------------------------------------- ! Set the visible top boundary to the line currently occupied by the cursor ! ------------------------------------------------------------------------- PROCEDURE ppl_set_top_line_down LOCAL curpos, curtop, delta_up; curtop := GET_INFO (CURRENT_WINDOW, "visible_top"); curpos := GET_INFO (CURRENT_WINDOW, "current_row"); delta_up := curpos - curtop; ADJUST_WINDOW (CURRENT_WINDOW, delta_up, 0); ppl_adjust_scroll_size; ppl_clear_prompt; ERASE (message_buffer); ENDPROCEDURE; ! ---------------------------------------------------------------------------- ! Set the visible bottom boundary to the line currently occupied by the cursor ! ---------------------------------------------------------------------------- PROCEDURE ppl_set_bottom_line_up LOCAL curpos, curbot, origbot, delta_down; curbot := GET_INFO (CURRENT_WINDOW, "visible_bottom"); curpos := GET_INFO (CURRENT_WINDOW, "current_row"); delta_down := curpos - curbot; ADJUST_WINDOW (CURRENT_WINDOW, 0, delta_down); ppl_adjust_scroll_size; ppl_clear_prompt; ERASE (message_buffer); ENDPROCEDURE; ! ------------------------------------------------------------------- ! Display the current window on full screen (clamp to size of buffer) ! ------------------------------------------------------------------- PROCEDURE ppl_display_on_full_screen LOCAL screen_size, buf_size, curbot, curtop, delta_up, delta_down; curtop := GET_INFO (CURRENT_WINDOW, "visible_top"); curbot := GET_INFO (CURRENT_WINDOW, "visible_bottom"); buf_size := GET_INFO (CURRENT_BUFFER, "record_count"); screen_size := GET_INFO (SCREEN, "visible_length") - 4; IF buf_size < screen_size THEN screen_size := buf_size + 1; ENDIF; delta_up := 1 - curtop; delta_down := screen_size - curbot; ADJUST_WINDOW (CURRENT_WINDOW, delta_up, delta_down); ppl_adjust_scroll_size; ppl_clear_prompt; ERASE (message_buffer); ENDPROCEDURE; ! ------------------------------------------------------------- ! Unmap and delete a window (the window is no longer available) ! ------------------------------------------------------------- PROCEDURE ppl_delete_window (wid) LOCAL wid, windid; ON_ERROR ppl_go_to_main_buffer; RETURN; ENDON_ERROR; IF wid = "" THEN windid := CURRENT_WINDOW; ELSE windid := wid; ENDIF; IF windid = main_window THEN MESSAGE ('Deleting the main window is not allowed'); RETURN; ENDIF; IF windid = message_window THEN MESSAGE ('Deleting the message window is not allowed'); RETURN; ENDIF; present_buffer_ := previous_buffer_; present_window_ := previous_window_; DELETE (windid); ppl_adjust_scroll_size; ppl_file_type; ppl_update_all_status_lines; ENDPROCEDURE; ! ------------------------------------------- ! Match an assigned buffer name to its buffer ! ------------------------------------------- PROCEDURE ppl_find_buffer (assigned_buffer_name) LOCAL buffer_name, loop_buffer, loop_buffer_name; loop_buffer := GET_INFO (BUFFERS, "first"); buffer_name := assigned_buffer_name; CHANGE_CASE (buffer_name, UPPER); LOOP EXITIF loop_buffer = 0; loop_buffer_name := GET_INFO (loop_buffer, "name"); IF buffer_name = loop_buffer_name THEN RETURN (loop_buffer); ELSE loop_buffer := GET_INFO (BUFFERS, "next"); ENDIF; ENDLOOP; RETURN (0); ENDPROCEDURE; ! ---------------------------------------------------------------- ! If a buffer by the given name already exists, modify the name by ! appending a "version number" ! ---------------------------------------------------------------- PROCEDURE ppl_modify_buffer_name (existing_name) LOCAL count, loop_buffer, loop_buffer_name, new_name, test_pattern; count := 2; test_pattern := existing_name + "#"; loop_buffer := GET_INFO (BUFFERS, "first"); LOOP EXITIF loop_buffer = 0; loop_buffer_name := GET_INFO (loop_buffer, "name"); IF INDEX (loop_buffer_name, test_pattern) = 1 THEN count := count + 1; ENDIF; loop_buffer := GET_INFO (BUFFERS, "next"); ENDLOOP; new_name := existing_name + "#" + STR (count); RETURN (new_name); ENDPROCEDURE; ! ---------------------------------------------- ! Create a buffer (if it does not already exist) ! ---------------------------------------------- PROCEDURE ppl_create_buffer (buffer_name, use_existing_buffer) LOCAL new_buffer; ON_ERROR ! (Invoked if buffer already exists) IF use_existing_buffer = 1 THEN ! Reuse the existing buffer? new_buffer := ppl_find_buffer (buffer_name); ERASE (new_buffer); ! Erase current contents RETURN (new_buffer); ELSE ! Modify the name and create buffer_name := ppl_modify_buffer_name (buffer_name); new_buffer := CREATE_BUFFER (buffer_name); SET (NO_WRITE, new_buffer, ON); RETURN (new_buffer); ENDIF; ENDON_ERROR; new_buffer := CREATE_BUFFER (buffer_name); SET (NO_WRITE, new_buffer, ON); RETURN (new_buffer); ENDPROCEDURE; ! ------------------------ ! Fetch the specified file ! ------------------------ PROCEDURE ppl_fetch_file (in_name) LOCAL file_buffer, file_name, actual_file_name, in_name, buffer_name, window_id; ON_ERROR DELETE (window_id); DELETE (file_buffer); ERASE (message_buffer); MESSAGE ('File ' + file_name + ' was not found'); MAP (present_window_, present_buffer_); ppl_adjust_scroll_size; ppl_file_type; ppl_update_all_status_lines; RETURN (0); ENDON_ERROR; ! ------------ ! Prompt mode? ! ------------ IF in_name = '' THEN MESSAGE ('...press RETURN to abort...'); file_name := READ_LINE ('Name of file to load into NEW buffer: '); ERASE (message_buffer); IF file_name = '' THEN ppl_clear_prompt; RETURN; ENDIF; ! ---------------------------------------------- ! File name supplied external to this procedure? ! ---------------------------------------------- ELSE file_name := in_name; ENDIF; CHANGE_CASE (file_name, UPPER); buffer_name := FILE_PARSE (file_name, '', '', NAME); IF CURRENT_BUFFER = dcl_command_buffer THEN ppl_delete_window (""); ENDIF; file_buffer := ppl_create_buffer (buffer_name, 0); window_id := ppl_create_window (buffer_name); MAP (window_id, file_buffer); ppl_adjust_scroll_size; actual_file_name := READ_FILE (file_name); SET (OUTPUT_FILE, file_buffer, actual_file_name); POSITION (BEGINNING_OF (file_buffer)); ppl_file_type; ppl_update_all_status_lines; ppl_remember_bufferwindow; ERASE (message_buffer); ENDPROCEDURE; ! ---------------------------------------------------- ! Include the specified file (into the current buffer) ! ---------------------------------------------------- PROCEDURE ppl_include_file (in_name) LOCAL file_name, actual_file_name, in_name; ON_ERROR ERASE (message_buffer); MESSAGE ('File ' + file_name + ' was not found'); RETURN (0); ENDON_ERROR; ! ------------ ! Prompt mode? ! ------------ IF in_name = '' THEN MESSAGE ('...press RETURN to abort...'); file_name := READ_LINE ('Name of file to load into CURRENT buffer: '); ERASE (message_buffer); IF file_name = '' THEN ppl_clear_prompt; RETURN; ENDIF; ! ---------------------------------------------- ! File name supplied external to this procedure? ! ---------------------------------------------- ELSE file_name := in_name; ENDIF; CHANGE_CASE (file_name, UPPER); actual_file_name := READ_FILE (file_name); ppl_clear_prompt; ERASE (message_buffer); ENDPROCEDURE; ! ----------------------------------------------------------------------- ! Go to the previously displayed buffer, mapping it to its default window ! ----------------------------------------------------------------------- PROCEDURE ppl_go_to_previous_buffer LOCAL temp_previous_buffer, temp_previous_window, bufnam; temp_previous_buffer := previous_buffer_; temp_previous_window := previous_window_; ppl_remember_position (temp_previous_window, temp_previous_buffer); MAP (temp_previous_window, temp_previous_buffer); ppl_adjust_scroll_size; ppl_remember_bufferwindow; ppl_file_type; ppl_update_all_status_lines; ERASE (message_buffer); ENDPROCEDURE; ! ----------------------------------------------------------- ! Return to the main buffer, mapping it to its default window ! ----------------------------------------------------------- PROCEDURE ppl_go_to_main_buffer ppl_remember_position (main_window, main_buffer); MAP (main_window, main_buffer); ppl_adjust_scroll_size; ppl_remember_bufferwindow; ppl_file_type; ppl_update_all_status_lines; ERASE (message_buffer); ENDPROCEDURE; ! -------------------------------------------------------------- ! Move to the specified buffer, mapping it to its default window ! -------------------------------------------------------------- PROCEDURE ppl_go_to_buffer (in_name) LOCAL buffer_id, buffer_name, in_name; IF in_name = '' THEN MESSAGE ('...press RETURN to abort...'); buffer_name := READ_LINE ('Go to buffer: '); IF buffer_name = '' THEN ! Abort action? ppl_clear_prompt; ERASE (message_buffer); RETURN; ENDIF; ELSE buffer_name := in_name; ENDIF; CHANGE_CASE (buffer_name, UPPER); buffer_id := ppl_find_buffer (buffer_name); ! Match name to its buffer IF buffer_id = 0 THEN ERASE (message_buffer); MESSAGE ('Buffer ' + buffer_name + ' does not exist'); RETURN; ENDIF; window_id := ppl_create_window (buffer_name); ppl_remember_position (window_id, buffer_id); MAP (window_id, buffer_id); ppl_adjust_scroll_size; ppl_remember_bufferwindow; ppl_file_type; ppl_update_all_status_lines; ERASE (message_buffer); ENDPROCEDURE; ! ---------------------------------------------------------------------------- ! Write the selected range to the specified file/printer ! (Note that EDT$ symbols are being used - if they are changed by DEC, beware) ! ---------------------------------------------------------------------------- PROCEDURE ppl_write_buffer LOCAL srange, dest; ON_ERROR ERASE (message_buffer); MESSAGE ('Invalid output file/device'); RETURN; ENDON_ERROR; MESSAGE ('...press RETURN to abort...'); dest := READ_LINE ('Name of output file/device: '); IF dest = '' THEN ! Abort action? ppl_clear_prompt; RETURN; ENDIF; IF GV$_beginning_of_select = 0 THEN ! If nothing specific, write all WRITE_FILE (CURRENT_BUFFER, dest); ELSE WRITE_FILE (SELECT_RANGE, dest); edt$reset; ! Remove inverse video selection ENDIF; ppl_clear_prompt; ERASE (message_buffer); ENDPROCEDURE; ! -------------------------------------------------- ! Specify the output target of the buffer's contents ! -------------------------------------------------- PROCEDURE ppl_specify_output LOCAL target, rwmode, variation, bufferid, buffername; ERASE (message_buffer); MESSAGE ('...press RETURN to abort...'); target := READ_LINE ("Name of buffer's new output file/device: "); ppl_clear_prompt; ERASE (message_buffer); IF target = '' THEN RETURN; ENDIF; CHANGE_CASE (target, UPPER); target := FILE_PARSE (target); ! ---------------------------------------------------------- ! Output has been changed. Warn the user if the buffer is in ! readonly mode. Also verify that the user has not tried to ! assign output from two different buffers to the same file. ! ---------------------------------------------------------- IF target = ' ' THEN MESSAGE ('Invalid output specification'); RETURN; ENDIF; bufferid := ppl_match_file_to_buffer (target); IF (bufferid <> 0) AND (bufferid <> CURRENT_BUFFER) THEN buffername := GET_INFO (bufferid, "name"); MESSAGE (target+' is already assigned to buffer '+buffername); RETURN; ENDIF; rwmode := GET_INFO (CURRENT_BUFFER, "no_write"); IF rwmode = 1 THEN MESSAGE ('Warning: the current buffer has READONLY output status'); SET (TEXT, MESSAGE_WINDOW, NO_TRANSLATE); MESSAGE (ASCII(7)); SET (TEXT, MESSAGE_WINDOW, BLANK_TABS); ENDIF; SET (OUTPUT_FILE, CURRENT_BUFFER, target); ppl_file_type; ppl_update_all_status_lines; RETURN; ENDPROCEDURE; ! ----------------------- ! Create a scratch buffer ! ----------------------- PROCEDURE ppl_create_scratch_buffer LOCAL buffername, bufferid, windowid; scratch_buffer_count_ := scratch_buffer_count_ + 1; buffername := '?#' + STR (scratch_buffer_count_); bufferid := ppl_create_buffer (buffername, 0); windowid := ppl_create_window (buffername); MAP (windowid, bufferid); ppl_adjust_scroll_size; ppl_file_type; ppl_update_all_status_lines; ppl_remember_bufferwindow; ERASE (message_buffer); ENDPROCEDURE; ! ------------------------------------- ! Match a given file name to its buffer ! ------------------------------------- PROCEDURE ppl_match_file_to_buffer (filename) LOCAL filename, loop_buffer, filename_ln, buffer_filename; filename_ln := LENGTH (filename); loop_buffer := GET_INFO (BUFFERS, "first"); LOOP; EXITIF loop_buffer = 0; buffer_filename := GET_INFO (loop_buffer, "output_file"); IF buffer_filename <> 0 THEN buffer_filename := SUBSTR (buffer_filename, 1, filename_ln); IF buffer_filename = filename THEN RETURN (loop_buffer); ENDIF; ENDIF; loop_buffer := GET_INFO (BUFFERS, "next"); ENDLOOP; RETURN (0); ENDPROCEDURE; ! ----------------------- ! Clear the prompt region ! ----------------------- PROCEDURE ppl_clear_prompt LOCAL screen_length; screen_length := GET_INFO (SCREEN, "visible_length"); SET (PROMPT_AREA, screen_length-1, 1, REVERSE); ENDPROCEDURE; ! ----------------------- ! Toggle the screen width ! ----------------------- PROCEDURE ppl_toggle_width LOCAL cur_width; cur_width := GET_INFO (SCREEN, "width"); IF cur_width = 80 THEN SET (WIDTH, CURRENT_WINDOW, 132); ELSE SET (WIDTH, CURRENT_WINDOW, 80); ENDIF; ppl_update_all_status_lines; ENDPROCEDURE; ! ------------------------------------------ ! Toggle between insert and overstrike modes ! ------------------------------------------ PROCEDURE ppl_toggle_modes LOCAL buf_mode; buf_mode := GET_INFO (CURRENT_BUFFER, "mode"); IF buf_mode = INSERT THEN SET (OVERSTRIKE, CURRENT_BUFFER); ELSE SET (INSERT, CURRENT_BUFFER); ENDIF; ppl_update_all_status_lines; ENDPROCEDURE; ! ------------- ! Delete a word ! ------------- PROCEDURE ppl_delete_word LOCAL init_len, final_len, init_pos, cmode, places, nblanks; cmode := GET_INFO (CURRENT_BUFFER, "mode"); IF cmode = OVERSTRIKE THEN init_len := LENGTH (CURRENT_LINE); init_pos := CURRENT_OFFSET; ENDIF; edt$delete_end_word; IF cmode = OVERSTRIKE THEN IF (init_len - init_pos) < 1 THEN RETURN ENDIF; nblanks := init_len - LENGTH (CURRENT_LINE); places := nblanks; SET (INSERT, CURRENT_BUFFER); LOOP EXITIF nblanks = 0; COPY_TEXT (' '); nblanks := nblanks - 1; ENDLOOP; SET (OVERSTRIKE, CURRENT_BUFFER); MOVE_HORIZONTAL (-places); ENDIF; ENDPROCEDURE; ! ---------------------------------------------- ! Create and optionally map a window to a buffer ! ---------------------------------------------- PROCEDURE ppl_create_and_map LOCAL window_id; window_id := ppl_create_window (''); ppl_remember_position (window_id, CURRENT_BUFFER); MAP (window_id, CURRENT_BUFFER); ppl_adjust_scroll_size; ppl_remember_bufferwindow; ppl_update_all_status_lines; ERASE (message_buffer); ENDPROCEDURE; ! --------------------------------------------------------------- ! Visit windows (moving forward, as ordered by TPU's window list) ! --------------------------------------------------------------- PROCEDURE ppl_visit_forward_windows LOCAL buffer_id, loop_id; loop_id := GET_INFO (WINDOWS, "current"); LOOP loop_id := GET_INFO (loop_id, "next"); IF loop_id = 0 THEN loop_id := GET_INFO (WINDOWS, "first"); ENDIF; buffer_id := GET_INFO (loop_id, "buffer"); IF (buffer_id <> 0) AND (buffer_id <> help_buffer) AND (buffer_id <> message_buffer) AND (buffer_id <> rectangular_paste_buffer) THEN ppl_remember_position (loop_id, buffer_id); MAP (loop_id, buffer_id); ppl_adjust_scroll_size; ppl_remember_bufferwindow; ppl_file_type; ppl_update_all_status_lines; RETURN; ENDIF; ENDLOOP; ENDPROCEDURE; ! ------------------------------------------ ! Record the file type of the current buffer ! ------------------------------------------ PROCEDURE ppl_file_type LOCAL fname, i; fname := GET_INFO (CURRENT_BUFFER, "output_file"); IF fname = 0 THEN ftype_ := '????'; RETURN; ENDIF; i := INDEX (fname, ';'); ftype_ := SUBSTR (fname, i-4, 4); ENDPROCEDURE; ! -------------------------------------------------- ! Toggle auto '$' insertion (file type is .COM) mode ! -------------------------------------------------- PROCEDURE ppl_comfile_mode IF comfile_mode_ = 0 THEN comfile_mode_ := 1; ppl_file_type; ELSE comfile_mode_ := 0; ENDIF; ppl_update_all_status_lines; ENDPROCEDURE; ! ------------------------------------------------------------ ! Paste a rectangular cut. The pattern will be left-justified. ! ------------------------------------------------------------ PROCEDURE ppl_paste_rectangular LOCAL cur_column, nrecs, loop_count, starting_spot, source_range, source_start, source_line_length, target_line_length, offset_from_start, alignment_column; starting_spot := MARK (NONE); alignment_column := CURRENT_COLUMN; loop_count := -1; nrecs := GET_INFO (rectangular_paste_buffer, "record_count") - 1; IF nrecs = 0 THEN MESSAGE ("There is nothing to paste"); RETURN; ENDIF; LOOP ! ------------------------------------------------------------- ! If there is still something in the rectangular paster buffer, ! go fetch a line. If it is empty, then we are done. ! ------------------------------------------------------------- EXITIF loop_count = nrecs; loop_count := loop_count + 1; ! ----------------------------------------------------- ! If this is not the first pass of this loop, move the ! target down by one row. ! If the present column is less than the target column, ! pad with blanks until we are properly aligned ! ----------------------------------------------------- IF loop_count <> 0 THEN MOVE_VERTICAL (1); cur_column := GET_INFO (CURRENT_BUFFER, "offset") + 1; LOOP EXITIF cur_column >= alignment_column; COPY_TEXT (' '); cur_column := cur_column + 1; ENDLOOP; remove_the_terminator := 0; ENDIF; ! ------------------------------------------------- ! Extract a line from the rectangular paster buffer ! ------------------------------------------------- target_line_length := LENGTH (CURRENT_LINE); POSITION (BEGINNING_OF (rectangular_paste_buffer)); MOVE_VERTICAL (loop_count); source_start := MARK (NONE); source_line_length := LENGTH (CURRENT_LINE); MOVE_HORIZONTAL (source_line_length-1); source_range := CREATE_RANGE (source_start, MARK (NONE), NONE); ! ------------------------------ ! Copy it into the target buffer ! ------------------------------ POSITION (starting_spot); IF loop_count <> 0 THEN MOVE_VERTICAL (1); ENDIF; COPY_TEXT (source_range); ! ----------------------------------------------- ! Reposition over our starting spot for this line ! ----------------------------------------------- MOVE_HORIZONTAL (-source_line_length); starting_spot := MARK (NONE); ENDLOOP; MOVE_VERTICAL (-loop_count); ERASE (message_buffer); ENDPROCEDURE; ! -------------------------------------------------------------------------- ! Record a rectangular paste marker. The currently marked position (if any), ! will be transferred to the previously marked category. ! -------------------------------------------------------------------------- PROCEDURE ppl_mark_rectangle previous_marker_ := present_marker_; present_marker_ := MARK (UNDERLINE); ENDPROCEDURE; ! ----------------------------------------------------------------------------- ! Remove the most currently defined (and still existing) rectangular paste mark ! ----------------------------------------------------------------------------- PROCEDURE ppl_unmark_rectangle IF previous_marker_ = 0 THEN IF present_marker_ = 0 THEN MESSAGE ('No markers are currently defined'); ELSE present_marker_ := MARK (NONE); present_marker_ := 0; ENDIF; RETURN; ENDIF; present_marker_ := MARK (NONE); present_marker_ := previous_marker_; previous_marker_ := 0; ENDPROCEDURE; ! ----------------------------------------------------------------------- ! Insert the specified number of blanks, leaving the current character as ! directed ! ----------------------------------------------------------------------- PROCEDURE ppl_add_blanks (number_of_blanks, position_flag) LOCAL curmod, count; count := number_of_blanks; LOOP EXITIF count = 0; COPY_TEXT (' '); count := count - 1; ENDLOOP; curmod := GET_INFO (CURRENT_BUFFER, "mode"); ! --------------------------------------------------------- ! Leave current character positioned at beginning of insert ! --------------------------------------------------------- IF position_flag = 0 THEN MOVE_HORIZONTAL (-number_of_blanks); ENDIF; ENDPROCEDURE; ! ----------------------------------------------------------------------------- ! Perform a rectangular cut. For this operation to work, the user must have ! previously specified two, valid rectangle markers (i.e., the last two markers ! must have been defined inside the same buffer). ! ----------------------------------------------------------------------------- PROCEDURE ppl_cut_rectangle LOCAL presmark_bufid, prevmark_bufid, presmark_col, prevmark_col, curpos, curmod, curdir, col_offset, cur_offset, count, offset_from_start, eol_adjustment, start_of_cut_range, line_length, required_line_length, pad_count, backoff_count, cut_range, start_mark, test_mark, cur_mark; ! ---------------------------------------------------------------------- ! We must have both markers defined, and they must be in the same buffer ! ---------------------------------------------------------------------- IF (present_marker_ = 0) OR (previous_marker_ = 0) THEN MESSAGE ('Rectangle is not fully defined'); RETURN; ENDIF; presmark_bufid := GET_INFO (present_marker_, "buffer"); prevmark_bufid := GET_INFO (previous_marker_, "buffer"); IF presmark_bufid <> prevmark_bufid THEN MESSAGE ('Rectangle markers are not contained within the same buffer'); RETURN; ENDIF; ! --------------------------------------------- ! Determine our cut range and starting position ! --------------------------------------------- curpos := MARK (NONE); presmark_col := GET_INFO (present_marker_, "offset"); prevmark_col := GET_INFO (previous_marker_, "offset"); ! ------------------------------------------------------ ! The row of whichever marker is closer to the top ! of the buffer will become the starting row. When ! our choice of rows has been made, align to the ! leftmost of the two marker columns. This will position ! us in the upper left hand corner of the rectangle. ! ------------------------------------------------------ IF previous_marker_ > present_marker_ THEN POSITION (present_marker_); col_offset := prevmark_col - presmark_col; test_mark := previous_marker_; ELSE POSITION (previous_marker_); col_offset := presmark_col - prevmark_col; test_mark := present_marker_; ENDIF; IF col_offset < 0 THEN MOVE_HORIZONTAL (col_offset); col_offset := -col_offset; ENDIF; cur_mark := MARK (NONE); offset_from_start := GET_INFO (cur_mark, "offset"); required_line_length := offset_from_start + col_offset +1; ! ------------------------------ ! Turn the rectangle markers off ! ------------------------------ present_marker_ := MARK (NONE); present_marker_ := 0; previous_marker_ := MARK (NONE); previous_marker_ := 0; ! --------------------------------------- ! Here is the rectangle cut and save loop ! --------------------------------------- curmod := GET_INFO (CURRENT_BUFFER, "mode"); curdir := GET_INFO (CURRENT_BUFFER, "direction"); SET (FORWARD, CURRENT_BUFFER); ERASE (rectangular_paste_buffer); LOOP EXITIF cur_mark > test_mark; ! ------------------------------------------------ ! Pad the right side of the cut range if necessary ! ------------------------------------------------ line_length := LENGTH (CURRENT_LINE); IF required_line_length > line_length THEN cur_offset := GET_INFO (CURRENT_BUFFER, "offset"); ! ----------------------------------------------- ! Must we pad even to get to the starting column? ! ----------------------------------------------- IF cur_offset < offset_from_start THEN backoff_count := offset_from_start - cur_offset; ppl_add_blanks (backoff_count, 1); start_of_cut_range := SELECT (NONE); ! ------------------------------------------------------ ! If we didn't have to back pad up to the starting spot, ! we must already be there. Start the select range and ! move up to the current end-of-line. ! ------------------------------------------------------ ELSE backoff_count := 0; start_of_cut_range := SELECT (NONE); MOVE_HORIZONTAL (line_length-cur_offset); ENDIF; ! ----------------------------------------------- ! Now, pad out to the end of the line's cut range ! ----------------------------------------------- eol_adjustment := required_line_length - LENGTH (CURRENT_LINE); ppl_add_blanks (eol_adjustment, 1); ! ---------------------------------------------- ! The line completely encompasses the cut range. ! No adjustment is necessary. ! ---------------------------------------------- ELSE start_of_cut_range := SELECT (NONE); MOVE_HORIZONTAL (col_offset+1); ! Move past last to cut ENDIF; ! -------------------------------------------------------------- ! Cut a range line, pasting it into the rectangular paste buffer ! -------------------------------------------------------------- cut_range := SELECT_RANGE; POSITION (END_OF (rectangular_paste_buffer)); MOVE_TEXT (cut_range); ! -------------------------- ! Get ready for the next cut ! -------------------------- POSITION (start_of_cut_range); start_of_cut_range := 0; MOVE_VERTICAL (1); cur_mark := MARK (NONE); ! ------------------------------------------ ! Remove any pad which we added to this line ! ------------------------------------------ IF backoff_count <> 0 THEN MOVE_VERTICAL (-1); ERASE_CHARACTER (-backoff_count); POSITION (cur_mark); backoff_count := 0; ENDIF; ENDLOOP; ! ------------------------------------- ! Put us back into the original context ! ------------------------------------- start_of_cut_range := 0; ! Clear last select range IF curdir = REVERSE THEN SET (REVERSE, CURRENT_BUFFER); ENDIF; POSITION (curpos); ENDPROCEDURE; ! ------------------------------------------------------- ! Display the help text for the PP&L enhancement commands ! ------------------------------------------------------- PROCEDURE ppl_help help_buffer := ppl_create_buffer ('PPL_HELP', 1); help_window_ := ppl_create_window ('PPL_HELP'); ppl_remember_position (help_window_, help_buffer); MAP (help_window_, help_buffer); ppl_adjust_scroll_size; READ_FILE ('SYS_MANAGER:EDTEM.HLP'); POSITION (BEGINNING_OF (help_buffer)); ppl_remember_bufferwindow; ppl_update_all_status_lines; ENDPROCEDURE; ! ------------------------------------------------------------ ! Create a DCL subprocess (with optional one-command argument) ! ------------------------------------------------------------ PROCEDURE ppl_spawn LOCAL cmd; ERASE (message_buffer); MESSAGE ('...when finished, type LOGOUT to terminate the subprocess'); cmd := READ_LINE ('Command (optional): ', cmd); SPAWN (cmd); ERASE (message_buffer); ppl_clear_prompt; ENDPROCEDURE; ! ------------------- ! Issue a DCL command ! ------------------- PROCEDURE ppl_dcl_command (incommand) LOCAL command, incommand, proc, bfr_size, win_size; ON_ERROR ERASE (message_buffer); UPDATE (message_window); dcl_command_proc := CREATE_PROCESS (dcl_command_buffer); SEND (command, dcl_command_proc); ENDON_ERROR; dcl_command_buffer := ppl_create_buffer ('DCL_COMMAND', 1); dcl_command_window := ppl_create_window ('DCL_COMMAND'); ppl_delete_window (dcl_command_window); dcl_command_window := ppl_create_window ('DCL_COMMAND'); ERASE (message_buffer); IF incommand = '' THEN MESSAGE ("...press RETURN to abort"); command := READ_LINE ('Command: '); ppl_clear_prompt; IF command = '' THEN ERASE (message_buffer); RETURN; ENDIF; ELSE command := incommand; ENDIF; SEND (command, dcl_command_proc); ppl_remember_position (dcl_command_window, dcl_command_buffer); MAP (dcl_command_window, dcl_command_buffer); bfr_size := GET_INFO (CURRENT_BUFFER, "record_count"); win_size := GET_INFO (CURRENT_WINDOW, "visible_length") - 1; IF bfr_size = 0 THEN ERASE (message_buffer); MESSAGE ("No output was produced... the command window will not be displayed"); ppl_delete_window (""); RETURN; ENDIF; IF bfr_size < win_size THEN ADJUST_WINDOW (CURRENT_WINDOW, 0, bfr_size-win_size); ENDIF; ppl_adjust_scroll_size; POSITION (BEGINNING_OF (dcl_command_buffer)); ppl_remember_bufferwindow; ppl_file_type; ppl_update_all_status_lines; ERASE (message_buffer); ENDPROCEDURE; ! ----------------------- ! Adjust the screen width ! ----------------------- PROCEDURE ppl_adjust_screen_width LOCAL size; ERASE (message_buffer); size := INT(READ_LINE ('Screen width? ')); ppl_clear_prompt; IF ((size < 1) OR (size > 132)) THEN MESSAGE ('Invalid screen width'); RETURN; ENDIF; SET (WIDTH, CURRENT_WINDOW, size); ENDPROCEDURE; ! ---------------------------- ! Display a summary of buffers ! ---------------------------- PROCEDURE ppl_show_buffers LOCAL buffer_name, file_name, loop_buffer, number_of_windows, mode, statusline; summary_buffer_ := ppl_create_buffer ('PPL_BUFFER_SUMMARY', 1); summary_window_ := ppl_create_window ('PPL_BUFFER_SUMMARY'); ppl_remember_position (summary_window_, summary_buffer_); MAP (summary_window_, summary_buffer_); ppl_adjust_scroll_size; ppl_remember_bufferwindow; ppl_file_type; ppl_update_all_status_lines; loop_buffer := GET_INFO (BUFFERS, "first"); LOOP EXITIF loop_buffer = 0; buffer_name := GET_INFO (loop_buffer, "name"); IF (buffer_name <> "RECTANGULAR_PASTE_BUFFER") AND (buffer_name <> "PPL_BUFFER_SUMMARY") AND (buffer_name <> "DCL_COMMAND") AND (buffer_name <> "SHOW") AND (buffer_name <> "HELP") AND (buffer_name <> "PASTE") AND (buffer_name <> "MESSAGE") AND (buffer_name <> "KEYPAD DIAGRAM") THEN number_of_windows := GET_INFO (loop_buffer, "map_count"); file_name := GET_INFO (loop_buffer, "output_file"); mode := GET_INFO (loop_buffer, "no_write"); IF file_name = 0 THEN file_name := ""; ENDIF; IF mode = 0 THEN mode := 'W/'; ELSE mode := 'R/'; ENDIF; statusline := buffer_name + SUBSTR (spaces_, 1, 20-LENGTH (buffer_name)) + mode + STR (number_of_windows) + ' ' + file_name; POSITION (END_OF (summary_buffer_)); COPY_TEXT (ASCII(13)+ASCII(10)+statusline); ENDIF; loop_buffer := GET_INFO (BUFFERS, "next"); ENDLOOP; POSITION (BEGINNING_OF (summary_buffer_)); ENDPROCEDURE; ! ------------------------------------------------------------ ! Go to the buffer pointed to by the current row of the cursor ! in the PPL SHOW BUFFERS display, or load the file pointed ! by the cursor in the PPL DCL COMMAND buffer (the user must ! have executed some form of directory command with the ! GOLD D command) ! ------------------------------------------------------------ PROCEDURE ppl_go_to_flagged_buffer LOCAL cur_line, window_id, buffer_id, buffer_name, filename, devdir, fname, partial_line, idx, ln, pos, total_ln, aligned_to_word, srange; ON_ERROR IF ERROR = TPU$_STRNOTFOUND THEN ELSE POSITION (pos); ERASE (message_buffer); MESSAGE ('Cursor is not properly specifying a valid choice'); RETURN; ENDIF; ENDON_ERROR; IF (CURRENT_BUFFER <> summary_buffer_) AND (CURRENT_BUFFER <> dcl_command_buffer) THEN RETURN; ENDIF; pos := MARK (NONE); ! ------------------- ! SHOW BUFFERS lookup ! ------------------- IF CURRENT_BUFFER = summary_buffer_ THEN cur_line := CURRENT_LINE; buffer_name := SUBSTR (cur_line, 3, INDEX (cur_line, ' ')-3); ppl_delete_window (""); buffer_id := ppl_find_buffer (buffer_name); window_id := ppl_create_window (buffer_name); ppl_remember_position (window_id, buffer_id); MAP (window_id, buffer_id); ppl_adjust_scroll_size; ppl_remember_bufferwindow; ppl_file_type; ppl_update_all_status_lines; ERASE (message_buffer); ! ------------------ ! DCL COMMAND lookup ! ------------------ ELSE IF CURRENT_BUFFER = dcl_command_buffer THEN ! ------------------------------------------ ! Position to the beginning of the file name ! ------------------------------------------ aligned_to_word := ppl_beg_of_word; IF aligned_to_word <> 1 THEN POSITION (pos); ERASE (message_buffer); MESSAGE ('Invalid file specification'); RETURN; ENDIF; ! ------------------- ! Fetch the file name ! ------------------- total_ln := LENGTH (CURRENT_LINE); ln := total_ln - CURRENT_OFFSET; partial_line := SUBSTR (CURRENT_LINE, CURRENT_OFFSET+1, ln); idx := INDEX (partial_line, ';'); IF idx = 0 THEN POSITION (pos); ERASE (message_buffer); MESSAGE ('Invalid file name specification'); RETURN; ENDIF; idx := INDEX (partial_line, ' '); IF idx = 0 THEN idx := LENGTH (partial_line); ENDIF; fname := SUBSTR (partial_line, 1, idx); ! ------------------------------------------------------- ! Fetch the device and directory (will be bypassed if the ! the user specified /NOHEAD in the DIRECTORY command) ! ------------------------------------------------------- POSITION (BEGINNING_OF (CURRENT_BUFFER)); srange := SEARCH ('Directory ', FORWARD); IF srange <> 0 THEN POSITION (srange); MOVE_HORIZONTAL (10); total_ln := LENGTH (CURRENT_LINE); ln := total_ln - CURRENT_OFFSET; devdir := SUBSTR (CURRENT_LINE, CURRENT_OFFSET+1, ln); filename := devdir + fname; ELSE filename := fname; ENDIF; ! -------------- ! Fetch the file ! -------------- ppl_fetch_file (filename); ENDIF; ENDIF; ENDPROCEDURE; ! -------------------------------------------------------------------- ! Toggle the current buffer between readonly and write (on exit) modes ! -------------------------------------------------------------------- PROCEDURE ppl_toggle_output_mode LOCAL rwmode; ERASE (MESSAGE_BUFFER); rwmode := GET_INFO (CURRENT_BUFFER, "no_write"); IF rwmode = 0 THEN SET (NO_WRITE, CURRENT_BUFFER, ON); MESSAGE ('Warning - the current buffer has been set to READONLY mode'); ELSE SET (NO_WRITE, CURRENT_BUFFER, OFF); MESSAGE ('Warning - the current buffer has been set to WRITE mode'); ENDIF; ppl_update_all_status_lines; SET (TEXT, MESSAGE_WINDOW, NO_TRANSLATE); MESSAGE (ASCII(7)); SET (TEXT, MESSAGE_WINDOW, BLANK_TABS); ENDPROCEDURE; ! ---------------------------------- ! Change to forward buffer direction ! ---------------------------------- PROCEDURE ppl_forward SET (FORWARD, CURRENT_BUFFER); ppl_update_all_status_lines; ENDPROCEDURE; ! ---------------------------------- ! Change to reverse buffer direction ! ---------------------------------- PROCEDURE ppl_reverse SET (REVERSE, CURRENT_BUFFER); ppl_update_all_status_lines; ENDPROCEDURE; ! --------------- ! Open a new line ! --------------- PROCEDURE ppl_open_line LOCAL ind, curpos, curchar; ! ------------------- ! Create the new line ! ------------------- SPLIT_LINE; MOVE_HORIZONTAL (-1); ! ----------------------------------------------------------- ! If the current buffer's file type is .COM, ! the last character on the previous line ! 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; ! --------------------------------------- ! Parse a find-and-replace pattern string ! --------------------------------------- PROCEDURE ppl_pattern_build (control_string, final_pattern_string) LOCAL control_string_len, match_char, literal_mode, loc, done, matched, needs_operator, force_in_effect, pattern_string, cur_position, cur_char; force_in_effect := 0; literal_mode := 0; pattern_string := ""; control_string_len := LENGTH (control_string); cur_position := 1; needs_operator := 0; LOOP; EXITIF cur_position > control_string_len; cur_char := SUBSTR (control_string, cur_position, 1); matched := 0; ! -------------------------------------------------------------- ! The '\' (force literal) has priority over all other characters ! -------------------------------------------------------------- IF (cur_char = '\') AND (force_in_effect = 0) THEN IF literal_mode = 0 THEN literal_mode := 1; IF needs_operator = 1 THEN pattern_string := pattern_string + "&'"; ELSE pattern_string := pattern_string + "'"; ENDIF; ENDIF; matched := 1; force_in_effect := 1; ENDIF; ! ----------------------------------------------------------------- ! If forced literal not started, check for other special characters ! ----------------------------------------------------------------- IF force_in_effect = 0 THEN CASE cur_char FROM ' ' TO '|' ! ------------------------------ ! Is there an asterisk wildcard? ! ------------------------------ ['*']: matched := 1; IF literal_mode = 1 THEN literal_mode := 0; pattern_string := pattern_string + "'"; needs_operator := 1; ENDIF; IF needs_operator = 1 THEN pattern_string := pattern_string + "&"; ELSE needs_operator := 1; ENDIF; IF cur_position = control_string_len THEN pattern_string := pattern_string + "REMAIN"; ELSE done := 0; loc := cur_position + 1; ! ---------------------------------------- ! Parse out the rest of any literal string ! ---------------------------------------- LOOP; EXITIF done = 1; IF loc > control_string_len THEN done := 1; loc := loc - 1; ELSE match_char := SUBSTR (control_string, loc, 1); CASE match_char FROM ' ' TO '|' ['*']: done := 1; loc := loc - 1; ['%']: done := 1; loc := loc - 1; ['&']: done := 1; loc := loc - 1; ['|']: done := 1; loc := loc - 1; ['(']: done := 1; loc := loc - 1; [')']: done := 1; loc := loc - 1; ['\']: done := 1; loc := loc - 1; ENDCASE; ENDIF; loc := loc + 1; ENDLOOP; ! ------------------------------------------- ! No literal followed the wildcard character? ! ------------------------------------------- loc := loc - 1; IF loc <> cur_position THEN pattern_string := pattern_string + "MATCH('" + SUBSTR (control_string, cur_position+1, loc-cur_position) + "')"; cur_position := loc; needs_operator := 1; ENDIF; ENDIF; ! ---------------------------- ! Is there a percent wildcard? ! ---------------------------- ['%']: matched := 1; IF literal_mode = 1 THEN literal_mode := 0; pattern_string := pattern_string + "'"; needs_operator := 1; ENDIF; IF needs_operator = 1 THEN pattern_string := pattern_string + "&ARB(1)"; ELSE pattern_string := pattern_string + "ARB(1)"; needs_operator := 1; ENDIF; ! --------------------------- ! Is this a left parenthesis? ! --------------------------- ['(']: matched := 1; IF literal_mode = 1 THEN literal_mode := 0; pattern_string := pattern_string + "'&"; ENDIF; pattern_string := pattern_string + "("; needs_operator := 0; ! ---------------------------- ! Is this a right parenthesis? ! ---------------------------- [')']: matched := 1; IF literal_mode = 1 THEN literal_mode := 0; pattern_string := pattern_string + "')"; ELSE pattern_string := pattern_string + ")"; ENDIF; needs_operator := 1; ! -------------------- ! Is this an AND sign? ! -------------------- ['&']: matched := 1; IF literal_mode = 1 THEN literal_mode := 0; pattern_string := pattern_string + "'&"; ELSE pattern_string := pattern_string + "&"; ENDIF; needs_operator := 0; ! ------------------- ! Is this an OR sign? ! ------------------- ['|']: matched := 1; IF literal_mode = 1 THEN literal_mode := 0; pattern_string := pattern_string + "'|"; ELSE pattern_string := pattern_string + "|"; ENDIF; needs_operator := 0; ENDCASE; ENDIF; ! ------------------------------------------------------------------------------ ! If nothing special has been matched, treat it as an ordinary literal character ! ------------------------------------------------------------------------------ IF matched = 0 THEN; IF literal_mode = 0 THEN IF needs_operator = 1 THEN needs_operator := 0; pattern_string := pattern_string + "&'"; ELSE pattern_string := pattern_string + "'"; ENDIF; literal_mode := 1; ENDIF; pattern_string := pattern_string + cur_char; force_in_effect := 0; ENDIF; cur_position := cur_position + 1; ENDLOOP; IF literal_mode = 1 THEN pattern_string := pattern_string + "'"; ENDIF; final_pattern_string := pattern_string; ENDPROCEDURE; ! ------------------------------ ! Find and replace : prompt mode ! ------------------------------ PROCEDURE ppl_find_and_replace LOCAL replace_string, bias, istart, iend, irange, srange, action, bypass, submsg, pat_search_string, match_count, pre_search_string, original_offset, original_position; ON_ERROR IF (ERROR = TPU$_STRNOTFOUND) OR (ERROR = TPU$_BEGOFBUF) OR (ERROR = TPU$_ENDOFBUF) THEN IF match_count = 0 THEN submsg := 'No occurence of string "' + pre_search_string + '" was found/replaced'; ELSE IF match_count = 1 THEN submsg := '1 occurence of string "' + pre_search_string + '" was replaced'; ELSE submsg := STR (match_count) + ' occurences of string "' + pre_search_string + '" were replaced'; ENDIF; ENDIF; ELSE submsg := 'Illegal operation: "'+pre_search_string+'"'; ENDIF; ERASE (MESSAGE_BUFFER); MESSAGE (submsg); ppl_clear_prompt; POSITION (original_position); ppl_goto_original_position (original_offset); RETURN; ENDON_ERROR; MESSAGE (' '); MESSAGE ('Press RETURN for pattern search mode... press RETURN twice to abort command'); match_count := 0; original_offset := GET_INFO (CURRENT_BUFFER, "offset"); original_position := MARK (NONE); pre_search_string := READ_LINE ('Normal search string: '); ! -------------------------- ! Enter pattern search mode? ! -------------------------- IF pre_search_string = "" THEN ERASE (MESSAGE_BUFFER); MESSAGE (' '); MESSAGE ('Press RETURN to abort command'); pre_search_string := READ_LINE ('PATTERN search string: '); IF pre_search_string = "" THEN ppl_clear_prompt; ERASE (MESSAGE_BUFFER); RETURN; ELSE ppl_pattern_build (pre_search_string, pat_search_string); IF pat_search_string = "" THEN ppl_clear_prompt; ERASE (MESSAGE_BUFFER); MESSAGE ('Invalid pattern search string'); RETURN; ENDIF; EXECUTE ('search_string:='+pat_search_string+';'); ppl_clear_prompt; MESSAGE ('Search action: '+pat_search_string); ENDIF; ELSE search_string := pre_search_string; ENDIF; replace_string := READ_LINE ('Replacement string: '); ppl_clear_prompt; MESSAGE ('ABORT: U REPLACE : '); MESSAGE ('EXIT : REPLACE ALL: KEEP: any other key'); IF LAST_KEY = KP4 THEN ppl_forward; ELSE IF LAST_KEY = KP5 THEN ppl_reverse; ENDIF; ENDIF; IF CURRENT_DIRECTION = FORWARD THEN bias := 1; ELSE bias := -1; ENDIF; bypass := 0; ! ---------------------------------------- ! Here is the main search and replace loop ! ---------------------------------------- LOOP srange := SEARCH (search_string, CURRENT_DIRECTION, NO_EXACT); POSITION (BEGINNING_OF (srange)); istart := SELECT (REVERSE); ! Turn on inverse video POSITION (END_OF (srange)); MOVE_HORIZONTAL (1); irange := SELECT_RANGE; IF bypass = 0 THEN UPDATE (CURRENT_WINDOW); action := READ_KEY; ENDIF; IF action = ctrl_u_key THEN POSITION (BEGINNING_OF (CURRENT_BUFFER)); MOVE_HORIZONTAL (-1); ! Trigger error handler ! (just in case... ERASE (MESSAGE_BUFFER); ! ... will leave this.. POSITION (original_position); ! ... here) ppl_goto_original_position (original_offset); RETURN; ENDIF; IF action = LF_KEY THEN original_position := istart; POSITION (original_position); original_offset := GET_INFO (CURRENT_BUFFER, "offset"); POSITION (BEGINNING_OF (CURRENT_BUFFER)); MOVE_HORIZONTAL (-1); ! Trigger error handler ! (just in case... ERASE (MESSAGE_BUFFER); ! ... will leave this.. POSITION (original_position); ! ... here) ppl_goto_original_position (original_offset); RETURN; ENDIF; IF action = TAB_KEY THEN action := RET_KEY; bypass := 1; ENDIF; IF action = RET_KEY THEN ERASE (PASTE_BUFFER); POSITION (BEGINNING_OF (PASTE_BUFFER)); MOVE_TEXT (srange); POSITION (BEGINNING_OF (srange)); COPY_TEXT (replace_string); match_count := match_count + 1; ENDIF; istart := 0; ! Turn off inverse video ENDLOOP; ENDPROCEDURE; ! ------------------------------------------------------------------ ! An attempt to reset to an original position may have been upset by ! character insertions and deletions. Restore the original position ! as defined by the offset from the beginning of the buffer. ! ------------------------------------------------------------------ PROCEDURE ppl_goto_original_position (original_offset) LOCAL original_offset, present_offset, bias; present_offset := GET_INFO (CURRENT_BUFFER, "offset"); IF present_offset <> original_offset THEN bias := original_offset - present_offset; MOVE_HORIZONTAL (bias); ENDIF; ENDPROCEDURE; ! --------------------------------------------------------------------- ! Normal find mode. We are trapping the regular, DEC-supplied procedure ! so that the status line can be updated in case the user changes the ! search direction (GOLD 4, GOLD 5 used as search terminator). ! --------------------------------------------------------------------- PROCEDURE ppl_normal_find edt$search; ! Invoke the DEC-supplied procedure ppl_update_all_status_lines; ! Now, update the status lines ENDPROCEDURE; ! -------------------------------------------------------------- ! Identify the brand of CRT this guy is using (DEC or Ann Arbor) ! -------------------------------------------------------------- PROCEDURE ppl_crt_brand LOCAL dummy, keychar, id; ! ------------------- ! Interrogate the CRT ! ------------------- SET (TEXT, MESSAGE_WINDOW, NO_TRANSLATE); MESSAGE (ASCII(27)+'[c'); SET (TEXT, MESSAGE_WINDOW, BLANK_TABS); ERASE (MESSAGE_BUFFER); ! ----------------- ! Receive the reply ! ----------------- dummy := READ_CHAR; ! dummy := READ_CHAR; ! [ keychar := READ_CHAR; ! This is the important one LOOP; ! Filter the remaining components of sequence EXITIF dummy = 'c'; dummy := READ_CHAR; ENDLOOP; IF keychar = '?' THEN page_size := GET_INFO (SCREEN, "visible_length"); IF page_size = 24 THEN RETURN (1); ! DEC CRT ELSE RETURN (2); ! Ann Arbor Ambassador ENDIF; ENDIF; IF keychar = '2' THEN RETURN (3); ! Ann Arbor VXL ENDIF; RETURN (0); ! Unknown CRT ENDPROCEDURE; ! -------------------------------------------------- ! Toggle between numeric and application keypad mode ! -------------------------------------------------- PROCEDURE ppl_toggle_keypad LOCAL crt_type; ! ------------------- ! Obtain the CRT type ! ------------------- crt_type := ppl_crt_brand; ! --------------------- ! Is this type unknown? ! --------------------- IF crt_type = 0 THEN ERASE (MESSAGE_BUFFER); MESSAGE ('Unable to recognize CRT type'); RETURN; ENDIF; ! -------------------------- ! Establish transparent mode ! -------------------------- SET (TEXT, MESSAGE_WINDOW, NO_TRANSLATE); ! --- ! DEC ! --- IF crt_type = 1 THEN IF keypad_mode_ = 'a' THEN MESSAGE (ASCII(27)+'>'); ELSE MESSAGE (ASCII(27)+'='); ENDIF; ! ----------------------------- ! Ann Arbor (Ambassador or VXL) ! ----------------------------- ELSE IF keypad_mode_ = 'a' THEN MESSAGE (ASCII(27)+'[>27l'); ELSE MESSAGE (ASCII(27)+'[>27h'); ENDIF; ENDIF; ! ------------------------------------- ! Remember the new status and report it ! ------------------------------------- MESSAGE (ASCII(7)); SET (TEXT, MESSAGE_WINDOW, BLANK_TABS); ERASE (MESSAGE_BUFFER); IF keypad_mode_ = 'a' THEN keypad_mode_ := 'n'; MESSAGE ('Numeric keypad mode has been enabled'); ELSE keypad_mode_ := 'a'; MESSAGE ('Application keypad mode has been enabled'); ENDIF; ppl_update_all_status_lines; ENDPROCEDURE; ! ------------------------------------- ! Dynamically define a new function key ! ------------------------------------- PROCEDURE ppl_define_function LOCAL fkey, lmode; ERASE (MESSAGE_BUFFER); 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; 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; fkey := READ_LINE ('Enter function key ( is assumed) '); ppl_clear_prompt; IF fkey = '' THEN MESSAGE ('Abort request acknowledged'); RETURN; ENDIF; IF LENGTH (fkey) <> 1 THEN MESSAGE ('Invalid function key sequence...aborting'); RETURN; ENDIF; ! ---------------------------------------- ! Initiate the function definition process ! ---------------------------------------- function_key_ := fkey; SET (TEXT, MESSAGE_WINDOW, NO_TRANSLATE); MESSAGE (ASCII(7)); SET (TEXT, MESSAGE_WINDOW, BLANK_TABS); IF lmode = 'Y' THEN MESSAGE ('...Defining function ' + fkey + ' (EXACT mode)'); LEARN_BEGIN (EXACT); ELSE MESSAGE ('...Defining function ' + fkey + ' (NO EXACT mode)'); LEARN_BEGIN (NO_EXACT); ENDIF; ! ------------------------------------------------------- ! Temporarily define the function as an invocation of the ! procedure that will cause the real function to be saved ! ------------------------------------------------------- DEFINE_KEY ('ppl_remember_function', KEY_NAME (fkey, SHIFT_KEY)); ENDPROCEDURE; ! ------------------------------------------------------------- ! Point the just learned keystrokes to the desired function key ! ------------------------------------------------------------- PROCEDURE ppl_remember_function LOCAL keystrokes, descrip; keystrokes := LEARN_END; ERASE (MESSAGE_BUFFER); SET (TEXT, MESSAGE_WINDOW, NO_TRANSLATE); MESSAGE (ASCII(7)); SET (TEXT, MESSAGE_WINDOW, BLANK_TABS); descrip := READ_LINE ('Function '+function_key_+' description: '); ppl_clear_prompt; DEFINE_KEY (keystrokes, KEY_NAME (function_key_, SHIFT_KEY), descrip); ENDPROCEDURE; ! ---------------------------------------------------------------------- ! Interrogate a user-defined function key for its associated description ! ---------------------------------------------------------------------- PROCEDURE ppl_describe_function LOCAL fkey, descrip; ERASE (MESSAGE_BUFFER); MESSAGE ('Press the function for which you want information ( is NOT assumed)'); ERASE (MESSAGE_BUFFER); fkey := READ_KEY; descrip := LOOKUP_KEY (fkey, COMMENT); IF descrip = '' THEN MESSAGE ('There is no information associated with that function'); ELSE MESSAGE (descrip); ENDIF; ENDPROCEDURE; ! -------------------------------------------------------------------------- ! Save the current context of the editor into the user's SYS$LOGIN directory ! -------------------------------------------------------------------------- PROCEDURE ppl_save_context LOCAL ans; ERASE (MESSAGE_BUFFER); ans := READ_LINE ('Save currently defined function keys? (Y for yes) '); CHANGE_CASE (ans, UPPER); ppl_clear_prompt; IF ans <> 'Y' THEN RETURN; ENDIF; SAVE ('SYS$LOGIN:PPLSECINI.TPU$SECTION'); ERASE (MESSAGE_BUFFER); MESSAGE ('Current function definitions have been saved in ' + 'SYS$LOGIN:PPLSECINI.TPU$SECTION'); ENDPROCEDURE; ! ------------------------------------------------------------- ! Trim trailing blanks and tabs off the end of the current line ! ------------------------------------------------------------- PROCEDURE ppl_trimt LOCAL cur_char; IF LENGTH(CURRENT_LINE) <> CURRENT_OFFSET THEN ! If not at end of current line edt$end_of_line; ! ...then, get there ENDIF; IF CURRENT_OFFSET = 0 THEN ! Null line? edt$next_prev_line (FORWARD); ! Prevents one from being in rut RETURN; ENDIF; LOOP; MOVE_HORIZONTAL (-1); cur_char := CURRENT_CHARACTER; IF (cur_char = ' ') OR (cur_char = ASCII(9)) THEN edt$delete_char; ! Remove if space or tab ELSE edt$next_prev_line (FORWARD); ! Go to next line RETURN; ENDIF; IF CURRENT_OFFSET = 0 THEN ! At beginning of line? RETURN; ENDIF; ENDLOOP; ENDPROCEDURE; ! -------------- ! Auto scrolling ! -------------- PROCEDURE ppl_auto_scroll LOCAL com_key, curdir; ppl_clear_prompt; ERASE (message_buffer); MESSAGE ("............press any other key to exit scrolling function........."); MESSAGE ("KP4: scroll forward KP5: scroll backward ENTER: pause/resume"); curdir := CURRENT_DIRECTION; LOOP SCROLL (CURRENT_WINDOW); com_key := READ_KEY; IF com_key = ENTER THEN com_key := READ_KEY; ENDIF; IF com_key = KP4 THEN ppl_forward; ELSE IF com_key = KP5 THEN ppl_reverse; ELSE IF com_key <> ENTER THEN IF curdir <> CURRENT_DIRECTION THEN IF curdir = FORWARD THEN ppl_forward; ELSE ppl_reverse; ENDIF; ENDIF; ERASE (message_buffer); RETURN; ENDIF; ENDIF; ENDIF; ENDLOOP; ENDPROCEDURE; ! ------------- ! Display ruler ! ------------- PROCEDURE ppl_show_ruler LOCAL curcol; curcol := GET_INFO (CURRENT_BUFFER, "offset") + 1; ERASE (message_buffer); SET (STATUS_LINE, CURRENT_WINDOW, REVERSE, ruler_); MESSAGE ("At the moment the ruler was displayed, your current column was " + STR (curcol)); ENDPROCEDURE; ! ------------ ! Insert ruler ! ------------ PROCEDURE ppl_insert_ruler LOCAL curwid, curoff; curwid := GET_INFO (CURRENT_WINDOW, "width"); curoff := CURRENT_OFFSET; IF curoff <> 0 THEN EDT$backspace; ENDIF; COPY_TEXT (SUBSTR (ruler_, 1, curwid)); SPLIT_LINE; MOVE_HORIZONTAL (curoff); ENDPROCEDURE; ! -------------------------------------- ! Construct a patterned, repeated string ! -------------------------------------- PROCEDURE ppl_ditto (material, len) LOCAL i, final_string; i := len; final_string := ''; LOOP EXITIF i < 1; final_string := final_string + material; i := i - 1; ENDLOOP; RETURN (final_string); ENDPROCEDURE; ! ----------------------- ! Construct a comment box ! ----------------------- PROCEDURE ppl_box_comment LOCAL len, biglen, origlen, done, i, inset, s, r, pat, curpos, botpos, oldpos, comstart, comend, main_len, offset, tmp_comfile_mode, frame, fname, ftype; ON_ERROR ERASE (message_buffer); ENDON_ERROR; ! --------------------------- ! Is someone pulling our leg? ! --------------------------- len := LENGTH (CURRENT_LINE); IF len = 0 THEN ERASE (message_buffer); MESSAGE ('There is nothing to frame'); RETURN; ENDIF; ! ------------------------------------------------------------- ! Compensate for the possibility that the comment may not start ! in column one ! ------------------------------------------------------------- curpos := MARK (NONE); IF CURRENT_OFFSET <> 0 THEN EDT$backspace; ENDIF; inset := ''; offset := 0; LOOP EXITIF (CURRENT_CHARACTER <> ' ') AND (CURRENT_CHARACTER <> GV$_tab); inset := inset + CURRENT_CHARACTER; offset := offset + 1; MOVE_HORIZONTAL (+1); IF CURRENT_OFFSET = len THEN POSITION (curpos); ERASE (message_buffer); MESSAGE ('There is nothing but blanks and/or tabs on that line'); RETURN; ENDIF; ENDLOOP; ! ----------------------- ! Select the box material ! ----------------------- IF (ftype_ = '.FOR') OR (ftype_ = '.TPU') THEN main_len := len - offset - 2; comstart := '!'; comend := ''; frame := comstart + ' ' + ppl_ditto ('-', main_len); ELSE IF ftype_ = '.COM' THEN main_len := len - offset - 3; comstart := '$!'; comend := ''; frame := comstart + ' ' + ppl_ditto ('-', main_len); tmp_comfile_mode := comfile_mode_; comfile_mode_ := 0; ! Temporarily disable ELSE IF ftype_ = '.MAR' THEN main_len := len - offset - 2; comstart := ';'; comend := ''; frame := comstart + ' ' + ppl_ditto ('-', main_len); ELSE IF ftype_ = '.PLI' THEN main_len := len - offset - 4; comstart := '/*'; comend := '*/'; frame := comstart + ppl_ditto ('-', main_len); ELSE POSITION (curpos); ERASE (message_buffer); MESSAGE ('That file type is not supported'); RETURN; ENDIF; ENDIF; ENDIF; ENDIF; ! ----------------------------------------- ! Build the initial version of the box side ! ----------------------------------------- frame := inset + frame; ! Our rough version biglen := len; origlen := len; ! ------------------------------------------------------- ! Scan upwards until we find the beginning of comment box ! ------------------------------------------------------- IF CURRENT_OFFSET <> 0 THEN EDT$backspace; ENDIF; botpos := MARK (NONE); oldpos := botpos; done := 0; s := ' ' + GV$_tab; pat := ANCHOR & ((SPAN (s) & comstart) | comstart); LOOP EXITIF done = 1; MOVE_VERTICAL (-1); curpos := MARK (NONE); IF curpos = oldpos THEN; ! Beginning of buffer? done := 1; ELSE r := SEARCH (pat, FORWARD); IF r = 0 THEN ! Not a comment line? MOVE_VERTICAL (+1); done := 1; ELSE oldpos := curpos; len := LENGTH (CURRENT_LINE); IF len > biglen THEN biglen := len; ENDIF; ENDIF; ENDIF; ENDLOOP; ! ------------------------------------ ! Finalize the version of the box side ! ------------------------------------ i := biglen - origlen; IF i <> 0 THEN frame := frame + ppl_ditto ('-', i); ENDIF; frame := frame + comend; ! ------------------------------------ ! Start with the top part of the frame ! ------------------------------------ COPY_TEXT (frame); P$_ret_key; ! ------------------------ ! Do the bottom part, next ! ------------------------ POSITION (botpos); MOVE_VERTICAL (+1); COPY_TEXT (frame); ! -------------------------------------------------- ! Make a best attempt to leave the user where wanted ! -------------------------------------------------- P$_ret_key; MOVE_HORIZONTAL (+1); botpos := MARK (NONE); MOVE_HORIZONTAL (-1); IF ftype_ = '.COM' THEN IF botpos = END_OF (CURRENT_BUFFER) THEN COPY_TEXT ('$'); ENDIF; comfile_mode_ := tmp_comfile_mode; ELSE IF botpos = END_OF (CURRENT_BUFFER) THEN P$_ret_key; ELSE SPLIT_LINE; MOVE_HORIZONTAL (-1); ENDIF; ENDIF; ENDPROCEDURE; ! ------------------------------------------------- ! Indent to the same extent as on the previous line ! ------------------------------------------------- PROCEDURE ppl_indent_as_above (dir) LOCAL inset, len, i, fname, ftype, found, origpos, origlen, comchar, curdir, newpos, oldpos; ON_ERROR IF ERROR = TPU$_BEGOFBUF THEN ERASE (message_buffer); ENDIF; ENDON_ERROR; ! ------------------------------------------------------------------ ! Position to the beginning of the line, if we are not already there ! ------------------------------------------------------------------ IF CURRENT_OFFSET <> 0 THEN EDT$backspace; ENDIF; ! ------------------------------------------- ! Search upward until we find a non-commented ! (and not empty) line ! ------------------------------------------- origpos := MARK (NONE); origlen := LENGTH (CURRENT_LINE); ! ------------------------------------------------------ ! If the current line is empty, we must conduct a search ! ------------------------------------------------------ IF origlen = 0 THEN ! ------------------------------------------- ! Get the comment indicator character, if any ! ------------------------------------------- IF (ftype_ = '.FOR') OR (ftype_ = '.TPU') THEN comchar := '!'; ELSE IF ftype_ = '.MAR' THEN comchar := ';'; ELSE IF ftype_ = '.PLI' THEN comchar := '/'; ELSE comchar := ''; ENDIF; ENDIF; ENDIF; ! ---------------- ! Start the search ! ---------------- oldpos := origpos; found := 0; LOOP EXITIF found = 1; MOVE_VERTICAL (-1); newpos := MARK (NONE); len := LENGTH (CURRENT_LINE); inset := ''; ! ------------------- ! Up against the top? ! ------------------- IF newpos = oldpos THEN found := 1; ! --------------------------------------- ! If this line is not empty, check it out ! --------------------------------------- ELSE oldpos := newpos; IF len <> 0 THEN ! -------------------------------- ! Get to the beginning of the line ! and build an offset pad ! -------------------------------- LOOP EXITIF (CURRENT_CHARACTER <> ' ') AND (CURRENT_CHARACTER <> GV$_tab); inset := inset + CURRENT_CHARACTER; MOVE_HORIZONTAL (+1); EXITIF CURRENT_OFFSET = len; ENDLOOP; IF (CURRENT_CHARACTER <> comchar) AND (CURRENT_OFFSET <> len) THEN found := 1; ELSE POSITION (oldpos); ENDIF; ENDIF; ENDIF; ENDLOOP; ! ------------------------------------------------- ! If the line is not empty, use it as the reference ! ------------------------------------------------- ELSE inset := ''; ! -------------------------------- ! Get to the beginning of the line ! and build an offset pad ! -------------------------------- LOOP EXITIF (CURRENT_CHARACTER <> ' ') AND (CURRENT_CHARACTER <> GV$_tab); inset := inset + CURRENT_CHARACTER; MOVE_HORIZONTAL (+1); EXITIF CURRENT_OFFSET = origlen; ENDLOOP; ENDIF; ! ----------------------------------------------- ! If we want the new line under the current line, ! position to the end of the current line ! ----------------------------------------------- POSITION (origpos); IF dir = 1 THEN ! ------------------- ! Move to end-of-line ! ------------------- IF origlen <> 0 THEN curdir := CURRENT_DIRECTION; SET (FORWARD, CURRENT_BUFFER); EDT$end_of_line; SET (curdir, CURRENT_BUFFER); ENDIF; ! ------------------ ! Build the new line ! ------------------ P$_ret_key; COPY_TEXT (inset); ! ----------------------------------------------- ! If we want the new line above the current line, ! first insert the text, and then split the line ! ----------------------------------------------- ELSE COPY_TEXT (inset); P$_ret_key; MOVE_HORIZONTAL (-1); ENDIF; ENDPROCEDURE; ! -------------------------------------------- ! Invert the case of the previous/current word ! -------------------------------------------- PROCEDURE ppl_invert_word LOCAL curpos; curpos := MARK (NONE); EDT$move_word_r; IF CURRENT_OFFSET = 0 THEN IF CURRENT_CHARACTER = ' ' THEN EDT$move_word_r; ENDIF; ENDIF; IF CURRENT_OFFSET = LENGTH (CURRENT_LINE) THEN EDT$move_word_r; ENDIF; EDT$select; POSITION (curpos); EDT$change_case; ENDPROCEDURE; ! --------------------------------------------------------------------- ! Compile (on a test basis) the current buffer's source in its language ! --------------------------------------------------------------------- PROCEDURE ppl_compile_source LOCAL fname, com, source_name, list_name, final_fname, mod_status, mode_status, i; ! ---------------------------------------------- ! Construct names for the temporary output files ! ---------------------------------------------- fname := GET_INFO (CURRENT_BUFFER, "output_file"); IF fname = 0 THEN ERASE (message_buffer); MESSAGE ('The current buffer has no output file assigned'); RETURN; ENDIF; i := INDEX (fname, ';'); fname := SUBSTR (fname, 1, i-1); i := INDEX (fname, ']'); fname := SUBSTR (fname, i+1, 255); source_name := 'SYS$LOGIN:' + fname + '_EDTEM'; list_name := 'SYS$LOGIN:' + fname + '_EDTEM_LIST'; ! ---------------------- ! Build the command line ! ---------------------- IF ftype_ = '.FOR' THEN com := 'FORTRAN '; ELSE IF ftype_ = '.PLI' THEN com := 'PLI '; ELSE IF ftype_ = '.MAR' THEN com := 'MACRO '; ELSE ERASE (message_buffer); 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"); final_fname := WRITE_FILE (CURRENT_BUFFER, source_name); ! ------------------------------------------------------- ! If the buffer was modified, writing it output 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 (' '); edt$rubout; IF mode_status = OVERSTRIKE THEN SET (OVERSTRIKE, CURRENT_BUFFER); ENDIF; ENDIF; ERASE (message_buffer); ! ----------------------- ! Perform the compilation ! ----------------------- com := '@SYS_MANAGER:EDTEM_COMPILE ' + '"' + com + '"' + ' ' + source_name + ' ' + list_name; ppl_dcl_command (com); ENDPROCEDURE; ! ------------------------------------ ! Dummy local initialization procedure ! ------------------------------------ PROCEDURE tpu$local_init tpu$local_init := 1; ENDPROCEDURE; ! ------------------------------------------------------------------------ ! MAIN INITIALIZATION PROCEDURE ! ! This PROCEDURE is invoked to initialize the editing session. The windows ! and buffers are created here. ! ------------------------------------------------------------------------ PROCEDURE TPU$init_procedure LOCAL temp, output_file_name, parsed_output_file_name, input_file_name_only; ! Initialize our variables EDT$init_variables; ! Name this as the EDTEM editor and shorten error message text SET ( FACILITY_NAME, "EDTEM"); SET ( MESSAGE_FLAGS, 1); ! Create all the necessary default buffers and windows ! help buffer HELP_BUFFER := CREATE_BUFFER ( "HELP" ); SET ( EOB_TEXT, HELP_BUFFER, GV$_null ); SET ( NO_WRITE, HELP_BUFFER ); SET ( SYSTEM, HELP_BUFFER ); ! show buffer next, but don't map it yet SHOW_BUFFER := CREATE_BUFFER ( "SHOW" ); SET ( TAB_STOPS, SHOW_BUFFER, "21 33" ); ! For use with line mode emulator SET ( EOB_TEXT, SHOW_BUFFER, GV$_null ); SET ( NO_WRITE, SHOW_BUFFER ); SET ( SYSTEM, SHOW_BUFFER ); GV$_screen_length := GET_INFO ( SCREEN, "VISIBLE_LENGTH" ); ! Create the prompt area SET ( PROMPT_AREA, ( GV$_screen_length - 1 ), 1, REVERSE ); !LMR: modified; was 2, now 3 ! paste buffer PASTE_BUFFER := CREATE_BUFFER ( "PASTE" ); SET ( EOB_TEXT, PASTE_BUFFER, "[End of PASTE]" ); SET ( NO_WRITE, PASTE_BUFFER ); SET ( SYSTEM, PASTE_BUFFER ); ! Create window for show buffer and help buffer INFO_WINDOW := CREATE_WINDOW ( 1, ( GV$_screen_length - 2 ), ON ); GV$_CTRL_Z_prompt := "CTRL/Z to resume editing"; SET ( STATUS_LINE, INFO_WINDOW, GV$_info_stats_video, GV$_CTRL_Z_prompt ); SET ( WIDTH, INFO_WINDOW, GET_INFO ( SCREEN, "WIDTH" ) ); SET ( PAD, INFO_WINDOW, OFF ); SET ( VIDEO, INFO_WINDOW, NONE ); ! message buffer/window MESSAGE_BUFFER := CREATE_BUFFER ( "MESSAGE" ); SET ( EOB_TEXT, MESSAGE_BUFFER, GV$_null ); SET ( PERMANENT, MESSAGE_BUFFER ); SET ( NO_WRITE, MESSAGE_BUFFER ); SET ( SYSTEM, MESSAGE_BUFFER ); SET ( OVERSTRIKE, MESSAGE_BUFFER ); SET ( MAX_LINES, MESSAGE_BUFFER, 20 ); MESSAGE_WINDOW := CREATE_WINDOW ( ( GV$_screen_length - 1 ), 2, OFF ); SET ( WIDTH, MESSAGE_WINDOW, GET_INFO ( SCREEN, "WIDTH" ) ); !LMR: added SET ( VIDEO, MESSAGE_WINDOW, NONE ); MAP ( MESSAGE_WINDOW, MESSAGE_BUFFER ); ! Now position to another buffer. This is to not have the EOB line as ! the current line when the window gets mapped and updated. We want to ! see messages... POSITION ( PASTE_BUFFER ); ! Now for the main buffer. Create it from the input file input_file := GET_INFO ( COMMAND_LINE, "FILE_NAME" ); ! if /NOCREATE is present and file does not exist, then exit... IF ( GET_INFO ( COMMAND_LINE, "CREATE" ) = 0 ) THEN ! /NOCREATE specified temp := FILE_PARSE ( input_file ); IF ( FILE_SEARCH ( temp ) = GV$_null ) AND ( input_file <> GV$_null ) THEN ! exit immediately if file not there MESSAGE ( "Input file does not exist: " + temp ); EXIT; ELSE temp := FILE_SEARCH ( GV$_null ) ! reset ENDIF; ENDIF; MAIN_BUFFER := CREATE_BUFFER ( "MAIN", input_file ); IF ( GET_INFO ( COMMAND_LINE, "READ_ONLY" ) = 1 ) THEN SET ( NO_WRITE, MAIN_BUFFER ); ENDIF; IF ( GET_INFO ( COMMAND_LINE, "OUTPUT" ) <> 1 ) THEN SET ( NO_WRITE, MAIN_BUFFER ); ELSE output_file_name := GET_INFO ( COMMAND_LINE, "OUTPUT_FILE" ); IF ( output_file_name <> GV$_null ) THEN ! The output file should be written to the current directory by default ! unless there is another directory specified in the output_file_name. ! We need to use SYS$DISK:[] as the default file specification so that ! the output file won't be written to the same directory as the input ! file if an input file directory is explicitly specified on the command line. ! We also DON'T want the node, device or directory of the input file, just ! the name. input_file_name_only := FILE_PARSE ( input_file, GV$_null, GV$_null, NAME ) + FILE_PARSE ( input_file, GV$_null, GV$_null, TYPE ); parsed_output_file_name := FILE_PARSE ( output_file_name, "SYS$DISK:[]", input_file_name_only ); IF ( parsed_output_file_name <> GV$_null ) THEN SET ( OUTPUT_FILE, MAIN_BUFFER, parsed_output_file_name ); ! Want this buffer to be considered modified so it will ! be written on exit for use especially with MAIL/EDIT: POSITION ( MAIN_BUFFER ); SPLIT_LINE; APPEND_LINE; ! Marks it as modified ENDIF; ENDIF; ENDIF; SET ( EOB_TEXT, MAIN_BUFFER, "[End of MAIN]" ); SET ( SYSTEM, MAIN_BUFFER ); SET ( PERMANENT, MAIN_BUFFER ); !LMR: added MAIN_WINDOW := CREATE_WINDOW ( 1, ( GV$_screen_length - 2 ), OFF ); SET ( SCROLLING, MAIN_WINDOW, ON, 3, 4, 0 ); MAP ( MAIN_WINDOW, MAIN_BUFFER ); ! Start journalling IF ( GET_INFO ( COMMAND_LINE, "JOURNAL" ) = 1 ) AND ( GET_INFO ( COMMAND_LINE, "READ_ONLY" ) <> 1 ) THEN default_journal_name := "SYS$DISK:[]"; IF ( input_file = GV$_null ) THEN input_file_name_only := "TPU.TJL"; ELSE input_file_name_only := FILE_PARSE ( input_file, GV$_null, GV$_null, NAME ) + ".TJL"; ENDIF; journal_file := GET_INFO ( COMMAND_LINE, "JOURNAL_FILE" ); journal_file := FILE_PARSE ( journal_file, default_journal_name, input_file_name_only ); JOURNAL_OPEN ( journal_file ); ENDIF; ! Go to the current position in the main buffer POSITION ( MAIN_WINDOW ); ! --------------------------------------------------------- ! This is initialization required for the enhancements code ! --------------------------------------------------------- SET (BELL, BROADCAST, ON); rectangular_paste_buffer := CREATE_BUFFER ("RECTANGULAR_PASTE_BUFFER"); SET (NO_WRITE, rectangular_paste_buffer, ON); spaces_ := ' ' + ' ' + ' '; previous_position_ := MARK (NONE); present_position_ := MARK (NONE); previous_buffer_ := CURRENT_BUFFER; previous_window_ := CURRENT_WINDOW; present_buffer_ := CURRENT_BUFFER; present_window_ := CURRENT_WINDOW; present_marker_ := 0; previous_marker_ := 0; curpos_ := MARK (NONE); scratch_buffer_count_ := 0; keypad_mode_ := 'a'; comfile_mode_ := 1; ruler_ := '....+....1....+....2....+....3....+....4' + '....+....5....+....6....+....7....+....8' + '....+....9....+....0....+....1....+....2' + '....+....3..'; main_file_name := GET_INFO (CURRENT_BUFFER, "file_name"); SET (OUTPUT_FILE, CURRENT_BUFFER, main_file_name); ERASE (message_buffer); ppl_adjust_scroll_size; ppl_file_type; ppl_update_status_line (CURRENT_WINDOW); ! ----------------------------------- ! Customized functions initialization ! ----------------------------------- tpu$local_init; ENDPROCEDURE !TPU$init_procedure ! -------------------------------------------- ! Here is where we create the new section file ! -------------------------------------------- SET ( INFORMATIONAL, ON ); EDT$define_keys; ! bind keys ! Relinquish memory taken up (unnecessarily) by the EDT$define_keys procedure. COMPILE ( "PROCEDURE EDT$define_keys ENDPROCEDURE" ); SET ( INFORMATIONAL, OFF ); SAVE ("DEV_TPU:EDTEM.TPU$SECTION"); QUIT;