! ! EDT_PLUS source file for VAXTPU ! ! COPYRIGHT 1986 by ! ! M. Edward (Ted) Nieland ! ! Ames Laboratories Systems Research ! Iowa State University and Laboratories, Inc. ! Ames, Iowa Dayton, Ohio ! ! ALL RIGHTS RESERVED ! !************************************************************************ ! EDT_PLUS is an extension of the EDT Editor supplied by Digital ! Equipment Corporation containing special features that enhance ! productivity in editing. These special functions are can been ! found in the associated document EDTPLUS.DOC. !************************************************************************ ! ! Enhanced: 880119 - RHS ! Added routines/code to better emulate ! EDT and to use the help file TPUHELP ! see EDTP_BUILD.COM & EDTPLUS.DOC ! ! Rewritten, enhanced, and incorporated into Extended EVEPlus ! by Rick Stacks -- 880318 ! ! List of Procedures contained within this file as of ! 880318 - RHS ! ! EDTP$init_variables ! initialize global variables ! EDTP$append ! kp9 (append) ! EDTP$backspace ! backspace key ! EDTP$TPU_Command ! EDTP$change_case ! gold kp1 (change case) ! EDTP$cut ! kp6 (cut selected text) ! EDTP$on_search_range ! Select and substitute support ! EDTP$select_range ! cut support ! EDTP$DEFINE_KEY ! ctrl k (define key) ! EDTP$delete_char ! keypad comma (delete chr) ! EDTP$delete_beg_line ! ctrl u ( delete to beg. of line) ! EDTP$delete_end_word ! keypad minus (delete word) ! EDTP$delete_line ! pf4 (delete line) ! EDTP$delete_to_eol ! gold kp2 ( delete to end of line) ! EDTP$end_of_line ! kp2 (move to end of line) ! EDTP$fill ! gold kp8 (fill) ! EDTP$preserve_blanks(flag) ! support for fill ! EDTP$skip_leading_spaces(mark) ! support for fill ! EDTP$find_whiteline(bmrk,emrk) ! support for fill ! EDTP$skip_lines(where) ! support for fill ! EDTP$gold_number(first_digit) ! gold 0..9 (repeat counts) ! EDTP$help (topic_param) ! gold pf2 (help on topic) ! EDTP$keypad_help ! pf2 (keypad help) ! EDTP$create_keypad_diagram ! support for keypad help ! EDTP$get_keypad_diagram ! support for keypad help ! EDTP$Line_mode(Num_lines) ! ctrl z (line mode) ! EDTP$next_Token(trms,term_chr) ! support for line mode ! EDTP$range_specification(spec) ! support for line mode ! EDTP$buffer ! support for line mode(= buffer cmd) ! EDTP$show ! support for line mode(show cmd) ! EDTP$set ! support for line mode(set cmd) ! EDTP$write ! support for line mode(write cmd) ! EDTP$quit ( save_qualifier ) ! support for line mode(quit cmd) ! EDTP$exit ( save_qualifier ) ! support for line mode(exit cmd) ! EDTP$line_mode_substitute ! support for line mode(subs cmd) ! EDTP$find_sub_delimiter(line_len,cp)! support for subs cmd ! EDTP$single_search_replace(string1,string2,query) ! support for subs cmd ! EDTP$global_search_replace(string1,string2,query) ! support for subs cmd ! EDTP$Replace_String ! EDTP$move_word ! kp2 (move word) ! EDTP$move_word_r ! support for move word (reverse) ! EDTP$move_word_f ! support for move word (forward) ! EDTP$del_beg_word ! support for delete word (forward) ! EDTP$beg_word ! support for move word ! EDTP$end_word ! support for delete word ! EDTP$next_prev_line ! kp0 (next line) ! EDTP$page ! kp7 (move to next page) ! EDTP$paste ! gold kp6 (paste selected text) ! EDTP$replace ! gold kp9 (replace) ! EDTP$reset ! gold kepypad dot(reset) ! EDTP$rubout ! rubout key (erase prev chr) ! EDTP$search ! gold pf3 (search) ! EDTP$search_next ! pf3 (search next) ! EDTP$section(direct_to_move) ! kp8 (section) ! EDTP$select ! keypad dot (select) ! EDTP$substitute ! gold enter (substitute) ! EDTP$cancel_subs ! support for substitute ! EDTP$User_commands ! EDTP$Prompt_On_Exit ! EDTP$RESTORE ! EDTP$find_buffer(buffer_name) ! support for line mode ! EDTP$Set_buffer ! EDTP$main_buf ! EDTP$Write_Buffer ! support for line mode(write cmd) ! EDTP$erase_buf ! EDTP$show_buf ! EDTP$Remove_Page_Marks ! EDTP$Insert_Page_Marks ! EDTP$fill_parag ! EDTP$paragraph_break ! EDTP$GET_KEY_INFO ! EDTP$swap_delim ! EDTP$overstrike ! EDTP$Set_Search ! EDTP$KUT ! EDTP$COPY ! EDTP$COPY_TO_END_OF_BUFFER ! EDTP$PASTE_Buf ! EDTP$SPAWN ! EDTP$find_beg_of_line (b_mark) ! EDTP$return ! EDTP$motion(which_way) ! EDTP$Learning ! EDTP$Stop_Learn ! EDTP$STOP_LEARN_X ! EDTP$undelete_char ! gold comma (undelete character) ! EDTP$undelete_line ! gold pf4 (undelete line) ! EDTP$undelete_word ! gold keypad minus(undelete word) ! EDTP$on_end_of_line ! support for undelete ! EDTP$wrap_word ! space key (wrap word) ! EDTP$eve_cursor_keys ! EDTP$edt_cursor_keys ! EDTP$move_down ! EDTP$move_up ! EDTP$delete_range ! support for line mode(delete cmd) ! EDTP$eve_do ! support for EVE command mode ! EDTP$DEFINE_KEYs ! define all keys ! PCE$EDTP_KEYS ! PCE$VT100_KEYS ! PCE$VT200_KEYS ! EDTP$init_procedure ! initialization procedure ! ! PROCEDURE EDTP$init_variables ! initialize global variables LOCAL Counter; ! ! Initialize some variables ! ! ! Create the null variable ! EDTP$x_empty := ''; ! Initilize read line variable EDTP$x_line := ' '; EDTP$version := 'EDT-PLUS Keypad Emulator Version V 4.00'; ! ! Set up Variables for FF, LF, CR ! EDTP$Tab_Char := ASCII(9); EDTP$Line_Feed := ASCII(10); EDTP$Vertical_Tab := ASCII(11); EDTP$Form_Feed := ASCII(12); EDTP$Carriage_Return := ASCII(13); EDTP$Space := ASCII(32); ! TRUE := 1; FALSE := 0; ! Each command must be eleven characters long, with the first being a space EDTP$x_commands := ' XXXXXXXXXX CHANGE EXIT QUIT INCLUDE ' + ' WRITE = SET SHOW HELP ' + ' SUBSTITUTE DELETE TYPE SPAWN FILL ' + ' TRIM EVE LINE '; EDTP$x_command_length := 11; EDTP$x_make_buf_var := 'new'; EDTP$x_ranges := ' SELECT WHOLE REST BEFORE = '; EDTP$x_range_length := 8; EDTP$x_sets := ' SCREEN WRAP CURSOR TAB SEARCH ' + ' BUFFER FORWARD REVERSE PARAMET MARGINS' + ' NOWRAP ARROWS '; EDTP$x_set_length := 8; EDTP$x_shows := ' BUFFER SEARCH SCREEN VERSION CURSOR ' + ' WRAP MARGINS'; EDTP$x_show_length := 8; EDTP$x_searches := ' GENERAL EXACT BEGIN END '; EDTP$x_searches_length := 8; EDTP$x_search_begin := 1; EDTP$x_terminators := ' =%'; EDTP$x_subs_term := '/'; EDTP$x_digits := '0123456789'; EDTP$x_prefixes := ' %'; EDTP$x_wrap_position := 0; ! set nowrap initially !EDTP$x_word := EDTP$Space + "," + EDTP$Tab_Char + "," + ! EDTP$Form_Feed + "," + EDTP$Line_Feed + "," + ! EDTP$Carriage_return + "," + EDTP$Vertical_Tab; EDTP$x_word := EDTP$Space + EDTP$Tab_Char + EDTP$Form_Feed + EDTP$Line_Feed + EDTP$Carriage_return + EDTP$Vertical_Tab; EDTP$word_delim := 'text'; EDTP$Page_Size := 59; ! PCE$k_no_arg := -2147483648; PCE$x_number_of_windows := 1; ! ! page 6 ! ! the ''& here forces an incremental search ! see page 2-12 of the VAXTPU Ref. Manual ! EDTP$sent_delim := ''& ( ('.'|'?'|'!') & ( ' ' | '" ' | ') ' | '] ' | '} ' | line_end | ('"'&line_end) | (')'&line_end) | (']'&line_end) | ('}'&line_end) )); ! EDTP$parag_delim := line_begin & line_end; EDTP$pattern_paragraph_break := ! Blank line or Runoff command line anchor & line_begin & (("." & any (EDTP$x_runoff_characters)) | ((EDTP$x_empty | span (EDTP$x_word_separators)) & line_end)); ! EDTP$x_runoff_characters := ! Characters used to begin Runoff commands "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!;"; EDTP$x_word_separators := ! Word separators: space, horizontal tab, ! form feed, carriage return, vertical tab, ! and line feed " "; EDTP$entry_mode := 'insert'; EDTP$x_keypad_window := 0; EDTP$x_delete_crlf := 0; EDTP$x_appended_line := 0; EDTP$x_section_distance :=16; EDTP$x_beginning_of_select := 0; EDTP$x_search_string := EDTP$x_empty; EDTP$x_search_case := no_exact; EDTP$x_deleted_char := EDTP$x_empty; EDTP$x_deleted_word := EDTP$x_empty; EDTP$x_deleted_line := EDTP$x_empty; EDTP$x_search_range := 0; EDTP$x_select_range := 0; EDTP$x_repeat_count := 1; EDTP$x_video := reverse; EDTP$x_info_stats_video := none; EDTP$x_control_chars := ""; Counter := 0; LOOP EDTP$x_control_chars := EDTP$x_control_chars + ASCII(counter); Counter := Counter + 1; EXITIF Counter = 32; ENDLOOP; EDTP$Learn_On := 0; EDTP$Learn_Num := 0; EDTP$Single_line := 1; EDTP$Multi_line := 2; ! page 7 EDTP$x_forward_word:= ! don't move off current character position ( anchor & ! if on eol,then match that ( (line_end) | !leading spaces,on a word delimiter (span(' ') ) ) !((span(' ')) & (any(EDTP$x_word) | EDTP$x_empty) ) ) | !no leading spaces,on a word delimiter,move one past it (any(EDTP$x_word)) | !no leading spaces,on a real word,go one beyond it (scan(EDTP$x_word)) | !no leading spaces,on a last real word of line, match rest of line REmain ) & ! after matching, skip over trailing spaces if any ! except if match occurred at the eol. In this case,don't skip over blanks (line_begin|span(' ') | EDTP$x_empty); ENDPROCEDURE; ! page 8 ! ! EDTP APPEND ! PROCEDURE EDTP$append !kp9 (append) LOCAL temp_pos ; EDTP$select_range; if EDTP$x_select_range <> 0 then temp_pos := mark(none); position(end_of(paste_buffer)); move_horizontal(-1); move_text(EDTP$x_select_range); EDTP$x_select_range:=0; position(temp_pos); else message("No Select Active"); EDTP$x_repeat_count := 1; endif; ENDPROCEDURE; ! ! EDTP Backspace ! PROCEDURE EDTP$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; ! page 9 PROCEDURE EDTP$TPU_Command LOCAL line_read, x; ! ! Trap compilation failures ! ON_ERROR IF error = TPU$_COMPILEFAIL THEN MESSAGE ('Unrecognized command'); ENDIF; ENDON_ERROR ! ! input: prompt string ! outputs: function returns true if string read is NOT compiled ! ! ! Get the command(s) to execute ! LOOP line_read := READ_LINE('TPU Command: '); ! get line from user IF line_read <> EDTP$x_empty THEN EDIT (line_read, trim_leading, OFF); ! ! Make sure that the person didn't type help, or some form ! of help - if so, display help for TPU ! IF (INDEX ('HELP', line_read) = 1) OR (INDEX ('help', line_read) = 1) THEN edtp$help (''); return; endif; ! ! compile them ! X := COMPILE(line_read); else return; endif; ! ! execute ! IF x <> 0 THEN execute(x); endif; endloop; ENDPROCEDURE; ! page 10 ! !EDTP CHANGECASE ! PROCEDURE EDTP$change_case !gold kp1 (change case) LOCAL character, this_mode; !check for active select EDTP$select_range; if EDTP$x_select_range <> 0 then change_case(EDTP$x_select_range,invert); EDTP$x_select_range:=0; return; endif; !change case of current character if current_character <> EDTP$x_empty then character := current_character; this_mode := get_info(current_buffer,"mode"); set(overstrike, current_buffer); change_case(character,invert); copy_text(character); set(this_mode, current_buffer); if current_direction <> forward then move_horizontal(-2); endif; return else if current_direction <> forward then move_horizontal(-2); else move_horizontal(1); endif; endif; ENDPROCEDURE ; ! page 11 ! EDTP CUT ! ! After erasing the paste buffer, insert a blank line. This blank ! line is needed for the PASTE operation. When doing the paste, have ! to know if the line terminator on the last line should be included ! in the new text. ! PROCEDURE EDTP$cut !kp6 ( cut selected text) LOCAL temp_position ; EDTP$select_range; if EDTP$x_select_range <> 0 then temp_position := mark(none); erase(paste_buffer); position(paste_buffer); split_line; move_vertical(-1); move_text(EDTP$x_select_range); position(temp_position); EDTP$x_select_range:=0; else message("No Select Active"); EDTP$x_repeat_count := 1; endif; ENDPROCEDURE; ! ! Procedure to determine if we are sitting on the search range. ! PROCEDURE EDTP$on_search_range ! Select and substitute support routine local v_on_search; if (EDTP$x_search_begin) then ! If SET SEARCH BEGIN is active then we should be sitting on the first ! character of the select range if (mark(none) = beginning_of(EDTP$x_search_range)) then v_on_search := 1; else v_on_search := 0; endif; else ! If SET SEARCH END is active, then we need to move back one in order ! to determine if a search range selection is active move_horizontal(-1); if mark(none) = END_OF(EDTP$x_search_range) then v_on_search := 1; else v_on_search := 0; endif; move_horizontal(1); endif; return v_on_search; ENDPROCEDURE; ! page 12 ! ! Procedure to create the select range ! PROCEDURE EDTP$select_range ! cut support routine if (EDTP$x_beginning_of_select <> 0) then EDTP$x_select_range := select_range; ! If the select range is zero, this means that we are still ! positioned on the beginning of the select range. Create ! a range of length zero so that EDT emulation works better. if (EDTP$x_select_range = 0) then position (end_of(current_buffer)); EDTP$x_select_range := create_range (mark(none), mark(none), none); position (EDTP$x_beginning_of_select); endif; EDTP$x_beginning_of_select := 0; else ! Check for being on search string and repeat count <= 1 if (EDTP$x_search_range <> 0) then if (EDTP$on_search_range = 1) AND (EDTP$x_repeat_count <= 1) then EDTP$x_select_range := EDTP$x_search_range; else EDTP$x_select_range := 0; endif; else EDTP$x_select_range := 0; endif; endif; ENDPROCEDURE; ! page 13 ! ! EDTP Define Key ! PROCEDURE EDTP$DEFINE_KEY !ctrl k (define key) LOCAL def, key; def := read_line('Definition: '); key := read_line('Press key to define.',1); key := last_key; DEFINE_KEY(def,key); ENDPROCEDURE; ! page 14 ! ! EDTP DELETE CHARACTER ! PROCEDURE EDTP$delete_char !keypad comma (delete chr) local temp_line; if mark(none) = end_of(current_buffer) then message ("Attempt to move past the end of buffer"); else EDTP$x_deleted_char := erase_character(1); if (EDTP$x_deleted_char = EDTP$x_empty) then EDTP$x_deleted_char := ascii(10); 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; ! page 15 ! ! EDTP Delete to the beginning of the line ! ! PROCEDURE EDTP$delete_beg_line !ctrl u ( delete to beg. of line) EDTP$x_deleted_line := erase_character(- current_offset); if EDTP$x_deleted_line = EDTP$x_empty then if mark(none) <> beginning_of(current_buffer) then move_vertical(-1); EDTP$delete_line; ! delete the entire previous line endif; endif; EDTP$x_delete_crlf := 0; EDTP$x_appended_line := 0; ENDPROCEDURE; ! ! Delete to end of word ! PROCEDURE EDTP$delete_end_word ! keypad minus (delete word) LOCAL temp_length ; temp_length := EDTP$end_word; if temp_length = 0 then EDTP$x_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 EDTP$x_deleted_word := erase_character(- temp_length) ! delete the word endif; ENDPROCEDURE; ! page 16 ! ! EDTP delete line ! ! PROCEDURE EDTP$delete_line !pf4 (delete line) if current_offset = 0 then EDTP$x_deleted_line := erase_line else EDTP$x_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; EDTP$x_delete_crlf := 1; EDTP$x_appended_line := 0; ENDPROCEDURE; ! ! ! EDTP Delete to the end of the line ! ! PROCEDURE EDTP$delete_to_eol !gold kp2 ( delete to end of line) !The below line works because the erase_character will stop at the end of line ! we will only pick up from the current point to the end of the line unless ! we are already on the end of line. In this case we are supposed to deleted ! the 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); EDTP$x_deleted_line := erase_line; EDTP$x_appended_line := 1; EDTP$x_delete_crlf := 0; else EDTP$x_appended_line := 0; EDTP$x_delete_crlf := 1; endif; move_horizontal (-1); else EDTP$x_deleted_line := erase_character(length(current_line)); EDTP$x_appended_line := 0; EDTP$x_delete_crlf := 0; endif; ENDPROCEDURE; ! page 17 ! ! Move the next End of Line ! PROCEDURE EDTP$end_of_line !kp2 (move to end of line) if current_direction = forward then if mark(none) <> end_of (current_buffer) then if EDTP$on_end_of_line then move_vertical(1) endif; ! move back if mark(none) <> end_of(current_buffer) then move_horizontal(length(current_line)-current_offset); ! goto EOL endif; endif else move_horizontal(( - current_offset)+(-1)) endif; ENDPROCEDURE; ! ! EDTP FILL ! PROCEDURE EDTP$fill !gold kp8 (fill) EDTP$select_range; if EDTP$x_select_range <> 0 then ! patterns for matching multiple blank lines EDTP$x_whit_pat:=line_begin &(line_end|(span(' ')&line_end))&line_begin; if(EDTP$x_wrap_position = 0) then EDTP$preserve_blanks(0) else EDTP$preserve_blanks(1) endif; EDTP$x_select_range:=0; else message("No Select Active"); EDTP$x_repeat_count := 1; endif; ENDPROCEDURE; ! page 18 PROCEDURE EDTP$preserve_blanks(flag) ! support routine for fill ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! ! modified at Kalamazoo College ! by including the call to EDTP$find_beg_of_line ! LOCAL original_position, b_mark, e_mark, sub_range, temp_range, all_done, temp_pattern; ON_ERROR all_done:=1; ! cause exit ENDON_ERROR; original_position:=MARK(NONE); b_mark:=BEGINNING_OF(EDTP$x_select_range); ! ! skip leading spaces on first line only ! EDTP$find_beg_of_line (b_mark); EDTP$skip_leading_spaces(b_mark); POSITION(original_position); loop ! skip leading blank lines of a paragraph EDTP$skip_lines(b_mark); all_done:=EDTP$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,EDTP$x_word,1,EDTP$x_wrap_position); ELSE FILL(sub_range,EDTP$x_word,1,GET_INFO(CURRENT_WINDOW,'WIDTH')); ENDIF; EXITIF all_done; ENDLOOP; POSITION(original_position); ENDPROCEDURE; ! page 19 ! PROCEDURE EDTP$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(' '); temp_range:=search(temp_pattern,forward); position(end_of(temp_range)); move_horizontal(1); b_mark:=mark(none); ENDPROCEDURE; PROCEDURE EDTP$find_whiteline(beg_mark,end_mark) ! support routine for fill local bline; on_error position(beg_mark); end_mark:= end_of(EDTP$x_select_range); return 0; endon_error; position(beg_mark); if beg_mark >= end_of(EDTP$x_select_range) then return 1 ! all done endif; bline:=search(EDTP$x_whit_pat,forward); ! get the beginning and end points right if beginning_of(bline) > end_of(EDTP$x_select_range) then end_mark:= end_of(EDTP$x_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; ! page 20 PROCEDURE EDTP$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 exitif current_line <> EDTP$x_empty; move_vertical(1); move_horizontal(-current_offset); endloop; where:=mark(none); return ENDPROCEDURE; ! page 21 ! Procedures for emulating the EDT style GOLD digit commands. ! PROCEDURE EDTP$gold_number ( first_digit) !gold 0..9 (repeat counts) LOCAL number , term_char , exe_flag , key_code ; ! ! Now get the count in here ! number := first_digit; loop term_char := read_line(number,1); if term_char = EDTP$x_empty then term_char := last_key; exe_flag := 1; exitif ; endif; ! See if it is a control character if (index(EDTP$x_control_chars,term_char) <> 0) then exe_flag := 1; exitif ; endif; ! See if it was a digit if (index('0123456789',term_char) = 0) then exe_flag := 0; exitif ; endif; number := number + term_char; endloop; ! ! Get the numeric value EDTP$x_repeat_count := int(number); ! ! If the key was special insert, just stick the character in ! If it wasn't then they are trying to do repeat counts. ! if exe_flag = 1 then if term_char = key_name(kp3,shift_key) then copy_text(ascii(EDTP$x_repeat_count)) else ! page 22 ! Look up the key definition. If there was one, then execute it ! If there isn't a definition, check to see if it is an alphabetic they ! are trying to insert. ! if (term_char = key_name(kp7,shift_key)) then ! The guy is doing an interactive command, get his command first term_char := read_line('TPU Command: '); if (term_char = EDTP$x_empty) then key_code := 0; else key_code := compile(term_char); endif else key_code := lookup_key(term_char,program); endif; if key_code <> 0 then loop execute(key_code); EDTP$x_repeat_count := EDTP$x_repeat_count - 1; exitif EDTP$x_repeat_count < 1; endloop; endif; endif else loop copy_text(term_char); EDTP$x_repeat_count := EDTP$x_repeat_count - 1; exitif EDTP$x_repeat_count < 1; endloop; endif; EDTP$x_repeat_count := 1; ENDPROCEDURE; ! page 23 ! ! Help ! PROCEDURE EDTP$help (topic_param) ! gold pf2 (help on topic) local this_topic, this_window, this_buffer; this_topic := topic_param; this_window := current_window; this_buffer := current_buffer; set(status_line,info_window,EDTP$x_info_stats_video,'Press CTRL-Z to leave prompts and resume editing'); map(info_window,help_buffer); set(text, info_window, no_translate); if (topic_param = EDTP$x_empty) then help_text('TPUHELP', read_line('Topic: '), on, help_buffer); else help_text('TPUHELP', topic_param, on, help_buffer); endif; set(text, info_window, blank_tabs); unmap(info_window); position (this_window); set(text, this_window, blank_tabs); update(this_window); ENDPROCEDURE; ! page 24 ! EDTP Help ! PROCEDURE EDTP$keypad_help !pf2 (keypad help) LOCAL diagram_prompt, text_prompt, current_prompt, temp_string, timer_string, help_key, comment_string; ! First check to see if the screen has at least a length of ! 22 or more - if not then this command doesn't ! make sense (may mess up the user's screen) if (get_info (screen, "visible_length") < 22) then message ('To use keypad help the screen must have length 22 or greater'); return; endif; if (EDTP$x_keypad_window = 0) then EDTP$create_keypad_diagram; else EDTP$get_keypad_diagram; endif; ! Turn off the timer temporarily timer_string := get_info (system, 'timed_message'); if timer_string <> EDTP$x_empty then SET (TIMER, OFF, EDTP$x_EMPTY); endif; diagram_prompt := 'Press the key that you want help on or RETURN to leave help '; text_prompt := 'Press the key that you want help on, PF2 for diagram, or RETURN to leave help'; set (status_line, EDTP$x_keypad_window, reverse, diagram_prompt); map(EDTP$x_keypad_window,EDTP$x_keypad_buffer); update(EDTP$x_keypad_window); help_key := READ_KEY; loop comment_string := lookup_key (help_key, COMMENT); EXITIF comment_string = "return"; if comment_string = "keypad_diagram" then EDTP$get_keypad_diagram; set (status_line, EDTP$x_keypad_window, reverse, diagram_prompt); current_prompt := diagram_prompt; else set (text, EDTP$x_keypad_window, blank_tabs); set (status_line, EDTP$x_keypad_window, reverse, text_prompt); current_prompt := text_prompt; if comment_string = EDTP$x_empty then comment_string := "no" endif; ! page 25 help_text ('TPUHELP', 'EDTP keypad ' + comment_string, OFF, EDTP$x_keypad_buffer); position (beginning_of (EDTP$x_keypad_buffer)); erase_line; erase_line; erase_line; erase_line; position (beginning_of (EDTP$x_keypad_buffer)); endif; update(EDTP$x_keypad_window); help_key := READ_KEY; endloop; unmap (EDTP$x_keypad_window); ! Restore the timer if timer_string <> EDTP$x_empty then SET (TIMER, ON, timer_string); endif; ENDPROCEDURE; ! ! Create the buffer and window for the keypad diagram. ! PROCEDURE EDTP$create_keypad_diagram !support routine for keypad help EDTP$x_keypad_window := create_window(1,22,off); EDTP$x_keypad_buffer := create_buffer('keypad diagram'); set(no_write,EDTP$x_keypad_buffer); set(eob_text,EDTP$x_keypad_buffer, EDTP$x_empty); EDTP$get_keypad_diagram; ENDPROCEDURE; ! page 26 ! Get the keypad diagram into the editor ! PROCEDURE EDTP$get_keypad_diagram !support routine for keypad help ! Do an error check - if the help buffer ! does not exist, then we have to return ! otherwise all of the lines in the current ! buffer will be deleted. if (get_info (EDTP$x_keypad_buffer, "type") = UNSPECIFIED) then return; endif; ! Pad the prompt to make it the same size as the text_prompt set(text,EDTP$x_keypad_window,no_translate); erase (EDTP$x_keypad_buffer); help_text('TPUHELP','keypad_diagrams edtp_keypad',off,EDTP$x_keypad_buffer); ! Go clean up the text in the buffer position(beginning_of(EDTP$x_keypad_buffer)); ! Get rid of the topic lines erase_line; erase_line; erase_line; erase_line; erase_line; ENDPROCEDURE; ! page 27 PROCEDURE EDTP$Line_mode(Num_lines) !ctrl z (line mode) LOCAL command_name , continue_cmd, eve_cmd_line, term_char , old_position, original_line, org_line_length, new_line_length, command_index, line_number; continue_cmd := "CONTINUE"; ! ! Keep looping until we see something that will cause us to exit. ! Right now this is only the Change or Continue commands ! LOOP IF (Num_lines = EDTP$Single_line) THEN EDTP$x_line := READ_LINE('EDTP Command >'); ELSE message('Type CONTINUE to exit from line mode to screen mode'); EDTP$x_line := READ_LINE('*'); ENDIF; ! Save the original line in case this is a substitute command original_line := EDTP$x_line; org_line_length := LENGTH (original_line); ! If they don't type something, set up the continue command if org_line_length = 0 then EDTP$x_line := continue_cmd; endif; ! upshift the command line change_case(EDTP$x_line,upper); ! if continue cmd, return if EDTP$x_line = continue_cmd then message(" "); message(" "); return; endif; ! Did user enter a number only ??? line_number := int(EDTP$x_line); if line_number <> 0 then ! go to line number entered eve_line(line_number); return; endif; ! What command is it? command_name := EDTP$next_token('/',term_char); if command_name = EDTP$x_empty then if EDTP$x_line <> EDTP$x_empty then command_name := EDTP$x_line; else command_name := 'XXXX'; endif; endif; command_index := index(EDTP$x_commands,(' ' + command_name)); command_index := ((command_index + EDTP$x_command_length)-1) / EDTP$x_command_length; CASE command_index FROM 1 TO 18 [outrange]: message(command_name + ' not supported') ; [2]: pce_change_width; [3]: if (term_char = '/') then EDTP$exit(1); else exit; endif; [4]: if (term_char = '/') then EDTP$quit(1); else quit; endif; [5]: eve_include_file(EDTP$next_token(EDTP$x_empty,term_char)); [6]: eve_write_file(EDTP$next_token(EDTP$x_empty,term_char)); [7]: eve_buffer(EDTP$next_token(EDTP$x_empty,term_char)); [8]: EDTP$set; [9]: EDTP$show; [10]: if EDTP$x_line = EDTP$x_empty then EDTP$help ('EDTP HELP'); else EDTP$help ('EDTP LINE_MODE ' + EDTP$x_line); endif; exitif; [11]: ! Get the original line back because the case is important new_line_length := LENGTH (EDTP$x_line); EDTP$x_line := substr (original_line, (org_line_length - new_line_length) + 1, new_line_length); ! Skip over blanks and tabs looking for a valid substitution delimiter loop exitif (term_char <> ' ') AND (term_char <> ' '); term_char := substr (EDTP$x_line, 1, 1); EDTP$x_line := substr (EDTP$x_line, 2, length (EDTP$x_line)-1); endloop; EDTP$x_subs_term := term_char; old_position := Mark(none); EDTP$line_mode_substitute; POSITION(old_position); [12]: EDTP$delete_range; [13]: eve_type_all; [14]: spawn(""); [15]: EDTP$fill_parag; [16]: eve_trim; [17]: EDTP$eve_do(EDTP$next_token(EDTP$x_empty,term_char)); [18]: eve_line(int(EDTP$next_token(EDTP$x_empty,term_char))); ENDCASE; update(current_window); IF (Num_lines = EDTP$Single_line) THEN RETURN; ENDIF; endloop; ENDPROCEDURE; ! page 29 ! ! Line mode command parser. This will return the next token from the line. ! ! EDTP$x_line - what is left of the current line mode command ! PROCEDURE EDTP$next_Token ( additional_terms , term_char) !support routine for line mode LOCAL line_length , ! Length of line terminators , ! Token terminators cp , ! Current pointer into line sp , ! Saved pointer into the line char , ! Current character quoted , ! True if in a quoted string token ; ! Token to return terminators := EDTP$x_terminators + additional_terms; if get_info(EDTP$x_line,"TYPE") = STRING then edit(EDTP$x_line,trim_leading); line_length := length(EDTP$x_line); else line_length := 0; endif; term_char := EDTP$x_empty; If line_length = 0 then RETURN EDTP$x_empty; endif; ! ! Did we find =, as in =buffer ! char := substr(EDTP$x_line,1,1); if char = '=' then EDTP$x_line := substr(EDTP$x_line,2,line_length); term_char := '='; return '='; endif; ! ! look for the end of the thing we are on. ! ! See if the thing we found is a terminator. If so, just ! return that. if index(terminators,char) <> 0 then term_char := char; EDTP$x_line := substr(EDTP$x_line,2,line_length); return EDTP$x_empty; endif; cp := 2; quoted := 0; loop exitif cp > line_length; char := substr(EDTP$x_line,cp,1); exitif (index(terminators,char) <> 0) and (quoted = 0); if char = '"' then quoted := 1-quoted; endif; cp := cp + 1; endloop; term_char := char; token := substr(EDTP$x_line,1,(cp - 1)); EDTP$x_line := substr(EDTP$x_line,(cp+1),line_length); return token; ENDPROCEDURE; ! page 30 ! ! Process a range specifier. We will return either a range or a buffer. ! PROCEDURE EDTP$range_specification ( spec ) ! support routine for line mode LOCAL r_index, first_mark ; ! ! What did they give us ! r_index := index(EDTP$x_ranges,(' '+spec)); r_index := ( (r_index + EDTP$x_range_length - 1) / EDTP$x_range_length); CASE r_index from 0 TO 4 [0]: message('Unsupported range specification: ' + spec); return 0; [1]: ! SELECT EDTP$select_range; if (EDTP$x_select_range = 0) then message("No Select Active"); return 0; else return EDTP$x_select_range; endif; [2]: !WHOLE r_index := current_buffer; return r_index; [3]: !REST first_mark := select(none); position(end_of(current_buffer)); r_index := select_range; return r_index; [4]: !BEFORE first_mark := select(none); position(beginning_of(current_buffer)); r_index := select_range; return r_index; ENDCASE; message('Unsupported range specification: ' + spec); return 0; ENDPROCEDURE; ! page 31 ! ! Process the line mode =buffer command ! PROCEDURE EDTP$buffer ! support routine for line mode(= buffer cmd) LOCAL buffer_ptr , create_variable_string, term_char, buffer_name ; ! This is to move to a new buffer and map it to the main window. If ! the buffer does not exist, create it with the NO_WRITE attribute. ! Get the name from the command line. buffer_name := EDTP$next_token(EDTP$x_empty,term_char); if (buffer_name = EDTP$x_empty) then message('No buffer specified'); return 0; endif; ! IF it exists just map to it. buffer_ptr := EDTP$find_buffer(buffer_name); if buffer_ptr = 0 then EDTP$x_make_buf_var := buffer_name; create_variable_string := EDTP$x_make_buf_var + "_buffer := create_buffer(EDTP$x_make_buf_var)"; execute (create_variable_string); ! Now get the pointer back, we know it is the last buffer in the list buffer_ptr := get_info (buffers,'last'); SET (NO_WRITE, buffer_ptr, ON); set(eob_text, buffer_ptr, '[End of '+buffer_name+']'); endif; map(current_window,buffer_ptr); eve$set_status_line(current_window); return 1; ENDPROCEDURE; ! page 32 ! ! EDTP line mode Show command ! PROCEDURE EDTP$show ! support routine for line mode(show cmd) LOCAL show_type , buf , cur_buf, pos , term_char , save_info_status, show_index ; ! ! What do they want to know ! show_type := EDTP$next_token(EDTP$x_empty,term_char); if (show_type = EDTP$x_empty) then message('You must provide an option to SHOW'); return 0; endif; show_index := index(EDTP$x_shows,(' ' + show_type)); show_index := ((show_index + EDTP$x_show_length - 1) / EDTP$x_show_length); CASE show_index FROM 0 TO 7 [0]: message('Unsupported SHOW option: ' + show_type); return 0; [1]: ! SHOW BUFFER pos := current_window; cur_buf := current_buffer; erase(show_buffer); position(show_buffer); copy_text(' BUFFER NAME LINES FILE'); split_line; copy_text('------------------------------------------------------'); split_line; buf := get_info(buffers,'first'); loop exitif buf = 0; if (buf = cur_buf) then copy_text('='); else copy_text(' '); endif; copy_text(get_info(buf,'name')); copy_text(' '); ! insert a tab copy_Text(str(get_info(buf,'record_count'))); copy_text(' '); ! insert a tab copy_text(get_info(buf,'file_name')); split_line; buf := get_info(buffers,'next'); endloop; ! page 33 set(status_line,info_window,reverse,' '); set(width,info_window,get_info(screen,'width')); map(info_window,show_buffer); update(info_window); buf := read_line('Press RETURN to continue.',1); set(status_line,info_window,EDTP$x_info_stats_video,'Press CTRL-F to remove INFO_WINDOW and resume editing'); unmap(info_window); position(pos); [2]: ! SHOW SEARCH buf := 'Search settings: '; if (EDTP$x_search_begin) then buf := buf + 'BEGIN '; else buf := buf + 'END '; endif; if (EDTP$x_search_case = exact) then buf := buf + 'EXACT '; else buf := buf + 'GENERAL '; endif; message(buf); [3]: ! SHOW SCREEN buf := 'Screen Width is '; buf := buf + str(get_info(current_window,'width')); message(buf); [4]: ! SHOW VERSION message('TPU Version V'+str(get_info(system,'version'))+'.'+ str(get_info(system,'update')) + ' - ' + EDTP$version); ! page 34 [5]: ! SHOW CURSOR buf := 'Cursor boundaries are '; buf := buf + str((get_info(current_window,'scroll_top') + get_info(current_window,'original_top'))); buf := buf + ':'; buf := buf + str((get_info(current_window,'original_bottom') - get_info(current_window,'scroll_bottom'))); message(buf); [6]: ! SHOW WRAP IF (EDTP$x_wrap_position = 0) then message ('No wrap is in effect'); else message('Wrap setting: ' + str (EDTP$x_wrap_position)); endif; [7]: ! SHOW MARGINS message(fao("Current margins settings are !SL & !SL for left and right", get_info(current_buffer, "left_margin"), get_info(current_buffer, "right_margin") ) ); return 1; ENDCASE; ENDPROCEDURE; ! page 35 ! ! EDTP line mode SET command ! PROCEDURE EDTP$set !support routine for line mode(set cmd) LOCAL set_index , temp_value1, temp_value2, term_char , set_type ; ! ! What are we setting? ! set_type := EDTP$next_token(EDTP$x_empty,term_char); if (set_type = EDTP$x_empty) then message('Need to SET something!'); return 0; endif; set_index := index(EDTP$x_sets,(' ' + set_type)); set_index := ((set_index + EDTP$x_set_length - 1) / EDTP$x_set_length); CASE set_index FROM 0 to 12 [0]: message('Unsupported SET option: ' + set_type); return 0; [1]: ! SET SCREEN temp_value1 := EDTP$next_token(EDTP$x_empty,term_char); if (temp_value1 = EDTP$x_empty) then message('Missing width parameter for SET SCREEN'); return 0; endif; temp_value1 := int(temp_value1); set(width,eve$main_window,temp_value1); set(width,message_window,temp_value1); [2]: ! SET WRAP temp_value1 := EDTP$next_token(EDTP$x_empty,term_char); if (temp_value1 = EDTP$x_empty) then message('Missing parameter to SET WRAP'); return 0; endif; temp_value1 := int(temp_value1); ! page 36 if (temp_value1 = 0) then if (EDTP$x_wrap_position <> 0) then unDEFINE_KEY(key_name(' ')); endif; else if (EDTP$x_wrap_position = 0) then DEFINE_KEY('EDTP$wrap_word',key_name(' ')); endif; endif; EDTP$x_wrap_position := temp_value1; [3]: ! SET CURSOR temp_value1 := EDTP$next_token(':',term_char); if (temp_value1 = EDTP$x_empty) then message('No beginning_of (current_buffer) line parameter for SET CURSOR'); return 0; endif; temp_value1 := int(temp_value1) - 1; temp_value2 := EDTP$next_token(':',term_char); if (temp_value2 = EDTP$x_empty) then message('No end_of(current_buffer) line parameter for SET CURSOR'); return 0; endif; temp_value2 := int(temp_value2); temp_value2 := get_info(eve$main_window,'visible_length') - temp_value2; set(scrolling,eve$main_window,ON,temp_value1,temp_value2,0); [4]: ! SET TAB message('Use the TPU command eve_set_tabs_at("tab settings") or'); message(' eve_set_tabs_every(tab value) to set tabs'); [5]: ! SET SEARCH set_type := EDTP$next_token(EDTP$x_empty,term_char); if (set_type = EDTP$x_empty) then message('Missing parameter to SET SEARCH'); return 0; endif; set_index := index(EDTP$x_searches,set_type); set_index := ((set_index + EDTP$x_searches_length - 1) / EDTP$x_searches_length); CASE set_index FROM 0 to 4 [0]: message('Unsupported SET option: ' + set_type); return 0; [1]: ! SET SEARCH GENERAL EDTP$x_search_case := no_exact; [2]: ! SET SEARCH EXACT EDTP$x_search_case := exact; [3]: !SET SEARCH BEGIN EDTP$x_search_begin := 1; [4]: ! SET SEARCH END EDTP$x_search_begin := 0; ENDCASE; [6]: ! SET BUFFER EDTP$buffer; [7]: ! SET FORWARD set(forward,current_buffer); eve$set_status_line(current_window); [8]: ! SET REVERSE set(reverse,current_buffer); eve$set_status_line(current_window); [9]: ! SET PARAMETERS ??? What is this ??? return; [10]: ! SET MARGINS temp_value1 := EDTP$next_token(',',term_char); if (temp_value1 = EDTP$x_empty) then temp_value1 := get_info(current_buffer, "left_margin"); else temp_value1 := int(temp_value1); endif; temp_value2 := EDTP$next_token(',',term_char); if (temp_value2 = EDTP$x_empty) then temp_value2 := get_info(current_buffer, "right_margin"); else temp_value2 := int(temp_value2); endif; set(margins, current_buffer, temp_value1, temp_value2); [11]: ! SET NOWRAP EDTP$x_wrap_position := 0; [12]: ! SET ARROWS set_type := EDTP$next_token(EDTP$x_empty,term_char); if (set_type = EDTP$x_empty) then message('Missing parameter to SET ARROWS'); return 0; endif; edit(set_type, lower); if (set_type = 'edt') then EDTP$edt_cursor_keys; else EDTP$eve_cursor_keys; endif; ENDCASE; return 1; ENDPROCEDURE; ! page 38 ! ! EDTP line mode Write command ! PROCEDURE EDTP$write ! support routine for line mode(write cmd) LOCAL file_name , buffer_ptr, buffer_name, range_specifier , term_char , text_to_write ; ! ! Is there isn't a file name, just write the buffer ! file_name := EDTP$next_token(EDTP$x_empty,term_char); if (file_name = EDTP$x_empty) then write_file(current_buffer); return 1; endif; ! ! Now check for what to write. ! I am only going to support SELECT, WHOLE, and =buffer ! range_specifier := EDTP$next_token(':',term_char); if (range_specifier = EDTP$x_empty) then write_file(current_buffer,file_name); return 1; endif; ! Check for =buffer alone if (range_specifier = '=') then buffer_name := EDTP$next_token(EDTP$x_empty,term_char); if (buffer_name = EDTP$x_empty) then message ('No buffer specified'); return 0; endif; buffer_ptr := EDTP$find_buffer (buffer_name); ! page 39 if (buffer_ptr = 0) then message ('Specified buffer does not exist'); return 0; else write_file(buffer_ptr,file_name); return 1; endif; else text_to_write := EDTP$range_specification(range_specifier); if (text_to_write = 0) then return 0; endif; write_file(text_to_write,file_name); ! ! If we wrote out a range, it must have been the select range. ! Get rid of it. ! if (get_info(text_to_write,'type') = RANGE) then EDTP$x_select_range := 0; endif; return 1; endif; ENDPROCEDURE; ! page 40 ! ! EDTP line mode INCLUDE command ! ! PROCEDURE EDTP$include ! support routine for line mode(include cmd) LOCAL file_name , equal_option , cur_buf, term_char ; ! ! Get the file name ! file_name := EDTP$next_token(EDTP$x_empty,term_char); if (file_name = EDTP$x_empty) then message('No file name specified'); return 0; endif; ! ! Now we look for the optional RANGE. We are only going to support ! one particular option. That of specifying a buffer for the file ! to go into ! equal_option := EDTP$next_token(EDTP$x_empty,term_char); if (equal_option <> EDTP$x_empty) then ! ! It had better be the = command ! if (equal_option <> '=') then message('Unsupported option on INCLUDE, RANGE can only be =buffer'); else if (EDTP$buffer = 0) then return 0; endif; ! If this is not the main_buffer then set it up as NO_WRITE ! so that it will not be written when you exit cur_buf := current_buffer; IF (cur_buf <> EDTP$main_buffer) then set(no_write,cur_buf); endif; endif; endif; ! Now read the file in read_file(file_name); return 1; ENDPROCEDURE; ! page 41 ! ! EDTP line mode QUIT Command ! PROCEDURE EDTP$quit ( save_qualifier ) ! support routine for line mode(quit cmd) LOCAL term_char, save_opt; on_error ! If an error occurs here stop the EXIT if error <> tpu$_nojournal then return 0; endif; endon_error; save_opt := EDTP$next_token('/',term_char); if (term_char = EDTP$x_empty) and (save_qualifier = 0) and (save_opt = EDTP$x_empty) then quit; return 1; endif; if (term_char = '/') then save_opt := EDTP$next_token(EDTP$x_empty,term_char); endif; if (save_opt <> 'SAVE') then message('Unsupported QUIT option'); return 0; else journal_close; endif; quit; return 1; ENDPROCEDURE; ! ! EDTP line mode EXIT command !_ PROCEDURE EDTP$exit ( save_qualifier ) !support routine for line mode(exit cmd) LOCAL term_char, out_name, this_buffer; on_error ! If an error occurs here stop the EXIT if error <> tpu$_nojournal then return 0; endif; endon_error; this_buffer := current_buffer; out_name := EDTP$next_Token('/',term_char); if (term_char = '/') then save_qualifier := 1; out_name := EDTP$next_token(EDTP$x_empty,term_char); endif; ! page 42 if (save_qualifier = 1) then ! I must have picked up SAVE if (out_name <> 'SAVE') then message('Unsupported EXIT option'); return 0; endif; journal_close; out_name := EDTP$next_token(EDTP$x_empty,term_char); endif; if (out_name <> EDTP$x_empty) then set(output_file,this_buffer,out_name); else if (get_info(command_line,'read_only') = 1) then message('File specification required'); return; endif; endif; exit; ENDPROCEDURE; ! page 43 PROCEDURE EDTP$line_mode_substitute ! support routine for line mode(subs cmd) ! ! This procedure searches and replaces a given string by a second string ! If found and more than one or global replacement requested, then the search ! and replace will continue until EOB or string-not-found@ ! ! The command line reads: ! SUBSTITUTE /old_string/new_string/ [whole] [/type] ! ^ [rest] ! ^-- space is req'd. [before] ! ! delimiter (EDTP$x_subs_term) ! string to be replaced ! delimiter (same as above) ! new string ! delimiter (same as above) ! either 'whole' if from beginning to end of buffer ! or first occurrence in the current line ! ! Parse the rest of the line looking for old string and new string ! LOCAL cp, line_length, old_index, temp_mark, offset, whole_set, query_set, rest_set, before_set, type_set, old_string, new_string; whole_set := "NO"; type_set := "NO"; query_set := "NO"; before_set := "NO"; temp_mark := mark(none); ! Remember where we are line_length := length (EDTP$x_line); if (EDTP$find_sub_delimiter (line_length, cp) = 0) then return 0; endif; old_string := substr (EDTP$x_line, 1, (cp - 1)); EDTP$x_line := substr (EDTP$x_line, (cp + 1), line_length); line_length := length (EDTP$x_line); if (EDTP$find_sub_delimiter (line_length, cp) = 0) then return 0; endif; new_string := substr (EDTP$x_line, 1, (cp - 1)); if (cp = line_length) then ! There are no options ! perform the EVE substitute command (eve_replace) eve_replace(old_string, new_string); return; else EDTP$x_line := substr (EDTP$x_line, (cp + 1), line_length); edit (EDTP$x_line, TRIM, UPPER, OFF); ! See if WHOLE was typed offset := INDEX(EDTP$x_line,'W'); IF (offset<>0) THEN whole_set := "YES"; ENDIF; ! See if REST was typed offset := INDEX(EDTP$x_line,'R'); IF (offset<>0) THEN rest_set := "YES"; ENDIF; ! See if BEFORE was typed offset := INDEX(EDTP$x_line,'B'); IF (offset<>0) THEN before_set := "YES"; ENDIF; ! See if TYPE was typed offset := INDEX(EDTP$x_line,'/T'); IF (offset<>0) THEN type_set := "YES"; ENDIF; ! If no type use the eve_replace routine if type_set = "NO" then if whole_set = "YES" then position(beginning_of(current_buffer)); eve_replace(old_string, new_string); eve$position_in_middle(temp_mark); else if rest_set = "YES" then set(forward,current_buffer); eve$set_status_line(current_window); eve_replace(old_string, new_string); eve$position_in_middle(temp_mark); else if before_set = "YES" then set(reverse,current_buffer); eve$set_status_line(current_window); eve_replace(old_string, new_string); eve$position_in_middle(temp_mark); else eve_replace(old_string, new_string); eve$position_in_middle(temp_mark); endif; endif; endif; else ! else use the EDTP routines if whole_set = "YES" then position(beginning_of(current_buffer)); EDTP$global_search_replace (old_string, new_string, query_set); eve$position_in_middle(temp_mark); else if rest_set = "YES" then set(forward,current_buffer); eve$set_status_line(current_window); loop test_result := EDTP$single_search_replace (old_string, new_string, query_set); exitif test_result = 0; endloop; eve$position_in_middle(temp_mark); else if before_set = "YES" then set(forward,current_buffer); eve$set_status_line(current_window); loop test_result := EDTP$single_search_replace (old_string, new_string, query_set); exitif test_result = 0; endloop; eve$position_in_middle(temp_mark); else EDTP$single_search_replace (old_string, new_string, query_set); eve$position_in_middle(temp_mark); endif; endif; endif; endif; endif; return 1; ENDPROCEDURE; PROCEDURE EDTP$find_sub_delimiter (line_length, cp) !support routine for subs cmd ! Find the next delimiter in the command line cp := 1; loop if cp > line_length then message ('Delimiter for SUBSTITUTE could not be found'); return 0; endif; exitif (substr(EDTP$x_line, cp, 1) = EDTP$x_subs_term); cp := cp + 1; endloop; return 1; ENDPROCEDURE; ! page 45 PROCEDURE EDTP$single_search_replace (string1, string2, query) !support routine for subs cmd ! ! This procedure performs a search through the current ! buffer and replaces one string with another LOCAL temp_mark, src_range, response, this_direction; ! Return to caller if string not found on_error message ('No occurrences of ' + string1 + ' found in current line'); position (temp_mark); return 0; endon_error; temp_mark := mark(none); this_direction := current_direction; if this_direction = forward then src_range := SEARCH (string1, forward); ! Search returns a range if found else src_range := SEARCH (string1, reverse); ! Search returns a range if found endif; ! If not found we never gets here position(beginning_of(src_range)); ! Move to right place loop if query = "YES" THEN response := READ_LINE('Replace String? (Y,N) ',1); CHANGE_CASE(response,UPPER); endif; if (response = 'Y') or (query = "NO") then erase (src_range); ! Remove first string position(end_of(src_range)); ! Move to right place copy_text(string2); ! Replace with second string message('First occurrence of ' + string1 + ' replaced with ' + string2 + ' in current line'); return 1; else IF response = 'N' THEN return 1; else message(' Please use Y(es) or N(o).'); endif; endif; endloop; ENDPROCEDURE; ! page 47 PROCEDURE EDTP$global_search_replace (string1, string2, query) !support routine for subs cmd ! ! This procedure performs a search through the current ! buffer and replaces one string with another LOCAL msg_text, src_range, replacement_count, response, temp_line, rev_range, stop; ! Return to caller if string not found ON_ERROR msg_text := FAO ('!UL replacement!%S', replacement_count) + ' of ' + string1 + ' with ' + string2 + ' in current buffer'; MESSAGE (msg_text); ! ! Check to see if user has the buffer clearing feature ! RETURN 0; ENDON_ERROR; replacement_count := 0; response := "Y" ; stop := "NO"; LOOP src_range := SEARCH (string1, forward); ! Search returns a range if found POSITION (BEGINNING_OF (src_range)); ! Move to right place Rev_range := CREATE_RANGE(BEGINNING_OF(src_range),END_OF(src_range), REVERSE); UPDATE(CURRENT_WINDOW); LOOP IF query = "YES" THEN response := READ_LINE('Replace string? (Y, N, A, Q) ',1); CHANGE_CASE(response,UPPER); ENDIF; IF response = "Y" THEN Rev_range := 0; ERASE (src_range); ! Remove first string POSITION (END_OF (src_range)); ! Move to right place COPY_TEXT (string2); ! Replace with second string replacement_count := replacement_count + 1; EXITIF response = "Y"; ELSE IF response = "N" THEN Rev_range := 0; MOVE_HORIZONTAL(+1); EXITIF response = "N"; ENDIF; ! page 48 IF response = "A" THEN Rev_range := 0; query := "NO"; response := "Y"; ERASE (src_range); ! Remove first string POSITION (END_OF (src_range)); ! Move to right place COPY_TEXT (string2); ! Replace with second string replacement_count := replacement_count + 1; EXITIF response = "Y"; ELSE IF response = "Q" THEN stop := "YES"; Rev_range := 0; EXITIF stop = "YES"; ELSE MESSAGE(" Please use Y(es), N(o), A(ll), or Q(uit)"); ENDIF; ENDIF; ENDIF; ENDLOOP; EXITIF stop = "YES"; ENDLOOP; RETURN 1; ENDPROCEDURE; ! page 49 PROCEDURE EDTP$Replace_String LOCAL temp_pos, string_1, string_2, query, query_type; temp_pos := MARK(NONE); POSITION(BEGINNING_OF(CURRENT_BUFFER)); string_1 := READ_LINE("Replace what string? "); IF string_1 = "" THEN Return 0; ENDIF; MESSAGE(" Replace: " + string_1); string_2 := READ_LINE("By what string? "); MESSAGE(" With: " + string_2); Query := READ_LINE(" Enter /Q for Query: ",2); CHANGE_CASE(Query, UPPER); IF query = "/Q" THEN query_type := "YES"; ELSE query_type := "NO"; ENDIF; EDTP$global_search_replace (string_1, string_2, query_type); POSITION(temp_pos); REFRESH; ENDPROCEDURE; ! ! EDTP Move to the next word ! PROCEDURE EDTP$move_word ! kp2 (move word) if current_direction = forward then EDTP$move_word_f; else !moveback EDTP$move_word_r; endif; ENDPROCEDURE; ! ! Move backwards a word ! PROCEDURE EDTP$move_word_r !support routine for move word (reverse) if (EDTP$beg_word = 0) and (mark(none) <> beginning_of(current_buffer)) then ! Move to beginning of word, back a line if none move_horizontal(-1); endif; ENDPROCEDURE; ! ! Move forwards a word ! PROCEDURE EDTP$move_word_f !support routine for move word (forward) if (EDTP$end_word = 0) and (mark(none) <> end_of(current_buffer)) then move_horizontal(1); endif; ENDPROCEDURE; ! page 50 ! ! EDTP Delete to beginning of word ! PROCEDURE EDTP$del_beg_word ! support routine for delete word (forward) LOCAL temp_length ; temp_length := EDTP$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; EDTP$x_deleted_word := ascii(10); else EDTP$x_deleted_word := erase_character(temp_length) endif; ENDPROCEDURE; ! ! Find the beginning of word ! PROCEDURE EDTP$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 <> ' '; move_horizontal(-1); temp_length := temp_length + 1; temp_char := current_character; endloop; ! ! IF we are on a word terminator count that one character. Otherwise ! scan to the next word terminator. ! if (index(EDTP$x_word,temp_char) = 0) then loop exitif current_offset = 0; move_horizontal(-1); temp_char := current_character; if (index(EDTP$x_word,temp_char) <> 0) then move_horizontal(1); exitif ; endif; temp_length := temp_length + 1; endloop; endif; return temp_length; ENDPROCEDURE; ! ! Find the end of the word ! PROCEDURE EDTP$end_word !support routine for delete word LOCAL temp_range , temp_length ; on_error ! catch search failure (suppress message) return temp_length ! return 0 endon_error temp_range:=search(EDTP$x_forward_word,forward); temp_length:=length(temp_range); move_horizontal(temp_length); return temp_length; ENDPROCEDURE; ! page 53 ! ! EDTP next Line ! PROCEDURE EDTP$next_prev_line !kp0 (next line) LOCAL o; ! EDT equiv. of Keypad 0 o := current_offset; move_horizontal(- o); if current_direction = forward then move_vertical(1) else if o = 0 then move_vertical(-1) endif; endif; ENDPROCEDURE; ! page 53 ! ! Process the 7 key, PAGE. ! PROCEDURE EDTP$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(ascii(12),dir); position(beginning_of(next_page)); ENDPROCEDURE; ! ! EDTP PASTE ! ! After copying the text, append the current line to the last line. ! We put an extra blank line in the paste buffer during the cut. ! This way, we can get a CUT / PASTE of text without a line terminator ! to work properly ! PROCEDURE EDTP$paste !gold kp6 (paste selected text) LOCAL paste_text, this_mode; this_mode := get_info(current_buffer, "mode"); set(insert, current_buffer); if (beginning_of(paste_buffer) <> end_of(paste_buffer)) then copy_text(paste_buffer); append_line; endif; set(this_mode, current_buffer); ENDPROCEDURE; ! page 54 ! ! EDTP REPLACE ! PROCEDURE EDTP$replace !gold kp9 (replace) EDTP$select_range; if ( EDTP$x_select_range <> 0) then erase(EDTP$x_select_range); EDTP$paste; EDTP$x_select_range:=0; else message("No Select Active"); EDTP$x_repeat_count := 1; endif; ENDPROCEDURE; ! page 55 ! ! EDTP RESET ! PROCEDURE EDTP$reset ! gold kepypad dot(reset) EDTP$x_beginning_of_select := 0; set(forward, current_buffer); erase(message_buffer); ENDPROCEDURE; ! ! EDTP rubout key ! !Delete the previous character ! PROCEDURE EDTP$rubout ! rubout key (erase prev chr) if get_info(current_buffer,'offset_column') <= get_info(current_buffer,'left_margin') then append_line; else if get_info (current_buffer, 'mode') = insert then erase_character (-1); else if current_character = EDTP$x_empty then erase_character (-1); else move_horizontal (-1); if current_character <> ascii (9) then copy_text (" "); move_horizontal (-1); else erase_character (1); endif; endif; endif; endif; ENDPROCEDURE; ! ! EDTP Search ! PROCEDURE EDTP$search !gold pf3 (search) LOCAL search_term, direction_distance, saved_position, saved_error; on_error saved_error := error; ! get the error # if (error = tpu$_strnotfound) or (error = tpu$_begofbuf) or (error = tpu$_endofbuf) then message('String not found'); if saved_position <> 0 then position(saved_position); return; endif; if (saved_error = tpu$_begofbuf) or (saved_error = tpu$_endofbuf) then return; endif; endif; endon_error ! read a line from the prompt area EDTP$x_search_string:=read_line('Search for: '); if (current_direction = forward) then direction_distance := EDTP$x_search_begin; else direction_distance := -1; endif; ! ! if the terminator was forward or reverse key,reset the direction permanently ! if last_key= kp5 then set(reverse,current_buffer); eve$set_status_line(current_window); if mark(none) = beginning_of(current_buffer) then message('String not found'); return; endif; direction_distance := -1; else if last_key = kp4 then set(forward,current_buffer); eve$set_status_line(current_window); if (mark(none) = end_of(current_buffer)) then message('String not found'); return; endif; direction_distance := 1; else If (last_key = ctrl_u_key) then return; endif; endif; endif; saved_position := mark(none); move_horizontal(direction_distance); EDTP$x_search_range := search(EDTP$x_search_string,current_direction,EDTP$x_search_case); if (EDTP$x_search_range <> 0) then IF (EDTP$x_search_begin) THEN ! SET SEARCH BEGIN is in effect position(beginning_of(EDTP$x_search_range)); eve$position_in_middle(mark(none)); ELSE ! SET SEARCH END is in effect position(beginning_of(EDTP$x_search_range)); eve$position_in_middle(mark(none)); move_horizontal(1); endif; else move_horizontal(-direction_distance); endif; ENDPROCEDURE; ! page 57 ! Search for the same thing again ! PROCEDURE EDTP$search_next !pf3 (search next) LOCAL direction_distance, saved_position; on_error if error = tpu$_strnotfound then message('String not found'); if saved_position <> 0 then ! set search end in effect,go back to end of last range position(saved_position); return endif; endif; endon_error ! ! get to the right place ! if current_direction = FORWARD then IF (mark(none) = end_of(current_buffer)) then message('String not found'); return; endif; direction_distance:=1; else if (mark(none) = beginning_of(current_buffer)) then message('String not found'); return; endif; direction_distance:=-1; endif; IF (EDTP$x_search_begin = 0) and (direction_distance = -1) THEN ! move to beginning of range first IF EDTP$x_search_range <> 0 THEN saved_position := mark(none); ! save place in case of error position(beginning_of(EDTP$x_search_range)); eve$position_in_middle(mark(none)); ENDIF; ENDIF; move_horizontal(direction_distance); EDTP$x_search_range := search(EDTP$x_search_string,current_direction,EDTP$x_search_case); if (EDTP$x_search_range <> 0) then IF (EDTP$x_search_begin) then ! SET SEARCH BEGIN is in effect position(beginning_of(EDTP$x_search_range)); eve$position_in_middle(mark(none)); ELSE ! SET SEARCH END is ine effect position(end_of(EDTP$x_search_range)); eve$position_in_middle(mark(none)); move_horizontal(1); endif; else move_horizontal(-direction_distance); endif; ENDPROCEDURE; ! page 58 ! EDTP SECTION Key Emulation ! PROCEDURE EDTP$section ( direction_to_move ) !kp8 (section) if direction_to_move = forward then move_vertical(EDTP$x_section_distance) else move_vertical(- EDTP$x_section_distance) endif; move_horizontal(- current_offset); ENDPROCEDURE; ! ! EDTP SELECT ! PROCEDURE EDTP$select !keypad dot (select) if EDTP$x_beginning_of_select <> 0 then message("Select already active"); else EDTP$x_beginning_of_select := select(EDTP$x_video); endif; ENDPROCEDURE; ! ! EDTP SUBSTITUTE ! PROCEDURE EDTP$substitute !gold enter (substitute) local r_len; on_error if error = tpu$_strnotfound then EDTP$cancel_subs; endif; return; endon_error if (EDTP$x_search_range = 0) then EDTP$cancel_subs; else ! Make sure we're positioned on the search range ! and haven't moved off if (EDTP$on_search_range = 1) then erase (EDTP$x_search_range); EDTP$paste; EDTP$x_search_range := search(EDTP$x_search_string,current_direction); IF (EDTP$x_search_begin) THEN position(beginning_of(EDTP$x_search_range)); ELSE ! SET SEARCH END is in effect position(end_of(EDTP$x_search_range)); move_horizontal(1); endif; ! If we're not still on the search range, then cancel the substitution else EDTP$cancel_subs; endif; endif; ENDPROCEDURE; PROCEDURE EDTP$cancel_subs ! support routine for substitute message("No Select Active / Search string not found"); EDTP$x_repeat_count := 1; EDTP$x_search_range := 0; ENDPROCEDURE; ! page 65 PROCEDURE EDTP$User_commands ! ! Routine to read in and execute command files that the user ! has set up to customize this version of TPU for him/her. ! The command line will be looked at first to determine ! if the user specified /COMMAND=inifile otherwise the file ! defined by the logical EDTPMAININI will be executed, if present, ! no matter what directory the user is in. ! ! The file EDTPINI.TPU will be executed if the file is located in the ! current default directory. ! LOCAL File, ! File variable commands, ! result from compilation Buffer_ptr; ! Pointer to User_Commands buffer if get_info(COMMAND_LINE, "COMMAND") then file := get_info(COMMAND_LINE, "COMMAND_FILE"); default_file_name := ".TPU"; file := file_parse(file, default_file_name); else ! !##### File := FILE_SEARCH('EDTPMAININI'); if File <> "" THEN Buffer_ptr := CREATE_BUFFER ('User_Commands',File); position (beginning_of(Buffer_Ptr)); commands := compile (buffer_ptr); ! Compile commands position (beginning_of(EDTP$main_buffer)); ! Reset to main buffer execute (commands); ! Execute commands endif; endif; ! ! Check and see if file EDTPINI.TPU exists and if so, then read ! it in and execute the commands. ! File := ""; File := FILE_SEARCH('EDTPINI.TPU'); IF File <> "" THEN ! ! If the User_Commands buffer has not already been created, then ! create it and read in the file, otherwise erase the buffer ! and read in the file. ! IF Buffer_ptr = 0 THEN Buffer_ptr := CREATE_BUFFER ('User_commands',File); else ERASE (Buffer_Ptr); POSITION (BEGINNING_OF(Buffer_Ptr)); READ_FILE (File); endif; position (beginning_of(EDTP$main_buffer)); ! Reset to main buffer execute (Buffer_Ptr); ! and execute the commands endif; ! ! If the User_Commands buffer was created, then delete the buffer. ! ! IF (Buffer_ptr <> 0) then ! delete (Buffer_ptr); ! endif; ENDPROCEDURE; ! page 67 PROCEDURE EDTP$Prompt_On_Exit LOCAL File_Name; ! ! Error message to tell the user how to check on whether he/she ! has enough disk space to store the file. ! ON_ERROR MESSAGE ("If the above error is for disk quota, you can use PF1 + CTRL D and "); MESSAGE (" SPAWN to get to the VMS $ prompt. After deleting excess"); MESSAGE (" files, LOGOUT to return to editing and then try again to exit."); ADJUST_WINDOW(MESSAGE_WINDOW,-5,0); ADJUST_WINDOW(EDTP$MAIN_WINDOW,0,-3); RETURN ENDON_ERROR; ! ! Prompt for name of file to be saved ! File_Name := READ_LINE("Name of file to store: "); ! ! Set the "Writing File" message to apeear at one second intervals ! SET (TIMER, ON, "Writing File"); IF File_Name <> "" THEN ! Write file using WRITE_FILE(MAIN_BUFFER,File_Name); ! entered name ELSE WRITE_FILE(EDTP$MAIN_BUFFER); ! or using default name. ENDIF; SET (TIMER, OFF, "Writing File"); EXIT; ENDPROCEDURE; ! page 70 PROCEDURE EDTP$RESTORE ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! LOCAL start_mark, ret, bizz_mark, bizz_mark_range; bizz_MARK := '^^&&^^'; ! Set identifying mark start_mark := MARK(none); ! Save original position POSITION (BEGINNING_OF (CURRENT_BUFFER)); ! Move to begining of buffer bizz_MARK_RANGE := SEARCH(bizz_MARK,FORWARD,EXACT); ! Search for mark IF bizz_mark_range = 0 THEN POSITION (start_mark); ! Retrun to original position MESSAGE ('No mark found in this buffer.'); ! ! Check to see if user has the buffer clearing feature ! RETURN; ! exit routine ENDIF; POSITION (bizz_MARK_RANGE); ! Set position ERASE (bizz_MARK_RANGE); ! Remove mark ENDPROCEDURE; ! page 71 PROCEDURE EDTP$find_buffer ( buffer_name) ! support routine for line mode ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! ! ! Find the buffer by name ! 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; ! page 72 PROCEDURE EDTP$Set_buffer ! ! Routine to set the buffer and set status line as needed ! LOCAL buffer_ptr , create_variable_string, file_1, buffer_1, status_1, term_char, file_write, file_name, buffer_name ; ! ! This is to move to a new buffer and map it to the main window. If ! the buffer does not exist, ask whether to create it with the NO_WRITE ! attribute. Get the buffer name from the command line. ! buffer_name := READ_LINE ("Enter buffer name [default - MAIN]: "); CHANGE_CASE(buffer_name,UPPER); IF buffer_name = EDTP$x_empty THEN buffer_name := "MAIN" ENDIF; ! IF it exists just map to it. buffer_ptr := EDTP$find_buffer(buffer_name); IF buffer_ptr = 0 THEN file_name := READ_LINE("Enter name of file: "); IF (file_name <> "") THEN buffer_ptr := CREATE_BUFFER(buffer_name,file_name); ELSE buffer_ptr := CREATE_BUFFER(buffer_name); ENDIF; POSITION(buffer_ptr); SET (TAB_STOPS,buffer_ptr,8); IF (file_name <> "") THEN SET(OUTPUT_FILE,buffer_ptr,file_name); file_write := READ_LINE ("Write the contents of this buffer to a file upon exit [Y/N]? ",1); IF (INDEX(file_write,'y') = 0) and (INDEX(file_write,'Y') = 0) THEN SET (NO_WRITE, buffer_ptr, ON); ELSE SET (NO_WRITE, buffer_ptr, OFF); ENDIF; ENDIF; SET(EOB_TEXT, buffer_ptr, '[End of '+buffer_name+']'); MAP(CURRENT_WINDOW,buffer_ptr); ! page 73 ! ! Find Buffer Name and associated file and set status line ! to show buffer name and file name ! file_1 := GET_INFO(buffer_ptr,"FILE_NAME"); IF file_1 = "" THEN file_1 := GET_INFO(buffer_ptr,"OUTPUT_FILE"); IF file_1 = 0 THEN file_1 := ""; ENDIF; ENDIF; eve$set_status_line(current_window); RETURN 1; ELSE MAP(CURRENT_WINDOW,buffer_ptr); ! ! Find Buffer Name and associated file and set status line ! to show buffer name and file name ! file_1 := GET_INFO(buffer_ptr,"FILE_NAME"); IF file_1 = "" THEN file_1 := GET_INFO(buffer_ptr,"OUTPUT_FILE"); IF file_1 = 0 THEN file_1 := ""; ENDIF; ENDIF; eve$set_status_line(current_window); RETURN 1; ENDIF; ENDPROCEDURE; ! page 74 PROCEDURE EDTP$main_buf ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! LOCAL buffer_ptr , create_variable_string, term_char; ! ! This is to move to a new buffer and map it to the main window. If ! the buffer does not exist, create it with the NO_WRITE attribute. ! Get the name from the command line. ! ! IF it exists just map to it. buffer_ptr := EDTP$find_buffer("MAIN"); IF buffer_ptr = 0 THEN EDTP$x_make_buf_var := "MAIN"; create_variable_string := EDTP$x_make_buf_var + "_buffer := CREATE_BUFFER(EDTP$x_make_buf_var)"; EXECUTE (create_variable_string); ! Now get the pointer back, we know it is the last buffer in the list buffer_ptr := GET_INFO (BUFFERS,'LAST'); SET (NO_WRITE, buffer_ptr, ON); SET(EOB_TEXT, buffer_ptr, '[End of MAIN]'); ENDIF; MAP(CURRENT_WINDOW,buffer_ptr); eve$set_status_line(current_window); UPDATE(CURRENT_WINDOW); RETURN 1; ENDPROCEDURE; ! page 75 PROCEDURE EDTP$Write_Buffer ! support routine for line mode(write cmd) ! ! ! LOCAL file_name , buffer_ptr, buffer_name, range_specifier , term_char , text_to_write ; file_name := READ_LINE("Enter file to write to: "); buffer_name := READ_LINE("Enter buffer to write from (Default - current buffer) : "); IF (buffer_name = EDTP$x_empty) THEN buffer_ptr := CURRENT_BUFFER; ELSE buffer_ptr := EDTP$find_buffer (buffer_name); ENDIF; IF (buffer_ptr = 0) THEN MESSAGE ('Specified buffer does not exist'); ! ! Check to see if user has the buffer clearing feature ! RETURN 0; ELSE SET (TIMER, ON, "Writing File"); WRITE_FILE(buffer_ptr,file_name); SET (TIMER, OFF, "Writing File"); RETURN 1; ENDIF; ENDPROCEDURE; ! page 76 PROCEDURE EDTP$erase_buf ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! LOCAL file_name , buffer_ptr, buffer_name, range_specifier , term_char , text_to_write ; buffer_name := READ_LINE("Enter buffer to erase: "); IF (buffer_name = EDTP$x_empty) THEN MESSAGE ('No buffer specified'); ! ! Check to see if user has the buffer clearing feature ! RETURN 0; ENDIF; buffer_ptr := EDTP$find_buffer (buffer_name); IF (buffer_ptr = 0) THEN MESSAGE ('Specified buffer does not exist'); ! ! Check to see if user has the buffer clearing feature ! RETURN 0; ELSE ERASE(buffer_ptr); RETURN 1; ENDIF; ENDPROCEDURE; ! page 78 PROCEDURE EDTP$show_buf ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! LOCAL show_type , buf , cur_buf, pos , file, term_char , save_info_status, show_index ; ! SHOW BUFFER pos := CURRENT_WINDOW; cur_buf := CURRENT_BUFFER; ERASE(SHOW_BUFFER); POSITION(SHOW_BUFFER); COPY_TEXT(' BUFFER NAME LINES FILE'); SPLIT_LINE; COPY_TEXT('------------------------------------------------------'); SPLIT_LINE; buf := GET_INFO(BUFFERS,'FIRST'); LOOP EXITIF buf = 0; IF (buf = cur_buf) THEN COPY_TEXT('='); ELSE COPY_TEXT(' '); ENDIF; COPY_TEXT(GET_INFO(buf,'NAME')); COPY_TEXT(' '); ! insert a tab COPY_TEXT(STR(GET_INFO(buf,'RECORD_COUNT'))); COPY_TEXT(' '); ! insert a tab file := GET_INFO(buf,'FILE_NAME'); IF file = "" THEN file := GET_INFO(buf,'FILE_NAME'); ENDIF; COPY_TEXT(file); SPLIT_LINE; buf := GET_INFO(BUFFERS,'NEXT'); ENDLOOP; SET(STATUS_LINE,INFO_WINDOW,REVERSE,' '); SET(WIDTH,INFO_WINDOW,GET_INFO(screen,'WIDTH')); MAP(INFO_WINDOW,SHOW_BUFFER); UPDATE(INFO_WINDOW); buf := READ_LINE('Press RETURN to continue.',1); SET(STATUS_LINE,INFO_WINDOW,NONE,'Press CTRL-F to remove INFO_WINDOW and resume editing'); UNMAP(INFO_WINDOW); POSITION(pos); ENDPROCEDURE; ! page 79 PROCEDURE EDTP$Remove_Page_Marks LOCAL found_range, This_Line, Line_len; ON_ERROR MESSAGE('Page Marks Removed. Operation Completed.'); RETURN; ENDON_ERROR POSITION (BEGINNING_OF(CURRENT_BUFFER)); LOOP found_range := SEARCH(EDTP$Form_Feed,FORWARD,EXACT); IF found_range=0 THEN RETURN 1; ENDIF; POSITION(found_range); This_line := CURRENT_LINE; Line_len := LENGTH(This_line); IF (Line_len = 1) THEN ERASE_LINE; ENDIF; MOVE_VERTICAL(+1); ENDLOOP ENDPROCEDURE; ! page 80 PROCEDURE EDTP$Insert_Page_Marks LOCAL found_range, This_Line, Line_Len, Start, End, Here, Search_Range, New_key, ESC, Res_Key; ON_ERROR ENDON_ERROR LOOP found_range := SEARCH(EDTP$Form_Feed,REVERSE,EXACT); IF found_range=0 THEN POSITION (BEGINNING_OF(CURRENT_BUFFER)); EXITIF found_range=0; ELSE POSITION(found_range); This_line := CURRENT_LINE; Line_len := LENGTH(This_line); EXITIF (Line_len = 1); ENDIF; MOVE_VERTICAL(-1); ENDLOOP; LOOP MOVE_VERTICAL(+1); MOVE_HORIZONTAL(+1); MOVE_HORIZONTAL(-CURRENT_OFFSET); Start := MARK(NONE); MOVE_VERTICAL(EDTP$Page_Size); End := MARK(NONE); POSITION(Start); LOOP found_range := SEARCH(EDTP$Form_Feed,FORWARD,EXACT); IF found_range=0 THEN POSITION (END_OF(CURRENT_BUFFER)); EXITIF found_range=0; ELSE POSITION(found_range); This_line := CURRENT_LINE; Line_len := LENGTH(This_line); EXITIF (Line_len = 1); ENDIF; MOVE_VERTICAL(+1); ENDLOOP; Here := MARK(NONE); IF (Here = End) and (End = END_OF(CURRENT_BUFFER)) THEN ! ! Check to see if user has the buffer clearing feature ! MESSAGE('Operation Finished'); RETURN 1; ! page 81 ELSE IF Here > End THEN POSITION(End); UPDATE(CURRENT_WINDOW); ERASE(MESSAGE_BUFFER); MESSAGE(' Insert Page? [Y(es),Q(uit) Arrow keys to move]'); ESC := ASCII(27); LOOP Res_Key := READ_CHAR; CHANGE_CASE(Res_Key,UPPER); IF (Res_Key = ESC) THEN Res_Key := READ_CHAR; Res_Key := READ_CHAR; ENDIF; EXITIF Res_Key = "Y"; EXITIF Res_Key = "Q"; IF Res_Key = "A" THEN MOVE_VERTICAL(-1); UPDATE(CURRENT_WINDOW); ENDIF; IF Res_Key = "B" THEN MOVE_VERTICAL(+1); UPDATE(CURRENT_WINDOW); ENDIF; ENDLOOP; IF Res_Key = "Q" THEN MESSAGE('Operation Finished'); RETURN 1; ENDIF; IF Res_Key = "Y" THEN SPLIT_LINE; MOVE_VERTICAL(-1); COPY_TEXT(EDTP$Form_Feed); UPDATE(CURRENT_WINDOW); ENDIF; ENDIF; ENDIF; ENDLOOP; ENDPROCEDURE; ! page 85 PROCEDURE EDTP$fill_parag ! Fills the current paragraph local this_position, ! Marker for current cursor position start_paragraph, ! Marker for start of current paragraph stop_paragraph, ! Marker for end of current paragraph fill_range; ! Range for current paragraph ! Can't fill an empty buffer - avoid additional checks later on if beginning_of (current_buffer) = end_of (current_buffer) then message ("Nothing to fill"); return; endif; this_position := mark (none); current_left_margin := get_info(current_buffer, "left_margin"); current_right_margin := get_info(current_buffer, "right_margin"); ! Find beginning and end of paragraph ! If on a blank line do preceding paragraph move_horizontal (- current_offset); loop exitif mark (none) = beginning_of (current_buffer); move_vertical (-1); if edtp$paragraph_break then move_vertical (1); exitif 1; endif; endloop; start_paragraph := mark (none); position (this_position); move_horizontal (- current_offset); loop exitif mark (none) = end_of (current_buffer); exitif edtp$paragraph_break; move_vertical (1); endloop; if start_paragraph = mark (none) then message ("Nothing to fill"); position (this_position); else move_horizontal (-1); stop_paragraph := mark (none); ! Now fill the paragraph fill_range := create_range (start_paragraph, stop_paragraph, none); fill (fill_range, EDTP$x_word, current_left_margin, current_right_margin); position(start_paragraph); set(screen_update,on); endif; ENDPROCEDURE; PROCEDURE EDTP$paragraph_break ! Returns true if current line looks like a runoff command (starts with ! a period followed by an alphabetic character) or a blank line, ! else returns false. Assumes cursor was at start of line. on_error return (0); endon_error; if search (EDTP$pattern_paragraph_break, forward) <> 0 then return (1); endif; ENDPROCEDURE; ! page 86 PROCEDURE EDTP$GET_KEY_INFO ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! LOCAL key_to_interpret, key_info; MESSAGE("Press the key you want information on: "); key_to_interpret := READ_KEY; key_info := LOOKUP_KEY(key_to_interpret, COMMENT); IF key_info <> "" THEN MESSAGE("Comment: " + key_info); ELSE MESSAGE("No comment is associated with that key."); ENDIF; ! ! Check to see if user has the buffer clearing feature ! ENDPROCEDURE; ! page 87 PROCEDURE EDTP$swap_delim ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! IF (EDTP$word_delim = 'text') THEN ! next line is space, tab, ff, lf, cr, vt, and punctuation EDTP$x_word := EDTP$Space + "," + EDTP$Tab_Char + "," + EDTP$Form_Feed + "," + EDTP$Line_Feed + "," + EDTP$Carriage_return + "," + EDTP$Vertical_Tab + "/<>[]{},.:*&!;+-=^()\|'"; DEFINE_KEY ('EDTP$return',RET_KEY,'return'); EDTP$word_delim := 'program'; ELSE ! next line is space, tab, ff, lf, cr, vt EDTP$x_word := EDTP$Space + "," + EDTP$Tab_Char + "," + EDTP$Form_Feed + "," + EDTP$Line_Feed + "," + EDTP$Carriage_return + "," + EDTP$Vertical_Tab; DEFINE_KEY ('split_line',RET_KEY,'return'); EDTP$word_delim := 'text'; ENDIF; ENDPROCEDURE; ! page 94 PROCEDURE EDTP$Set_Search ! ! sets EDTP search to GENERAL ! IF EDTP$x_search_case = exact THEN EDTP$x_search_case := no_exact; ELSE EDTP$x_search_case := exact; ENDIF; ENDPROCEDURE; PROCEDURE EDTP$KUT LOCAL temp_position, new_buffer, buffer_ptr; EDTP$select_range; IF EDTP$x_select_range <> 0 THEN temp_position := MARK(NONE); new_buffer:= READ_LINE("Buffer to cut to: "); CHANGE_CASE(new_buffer,UPPER); buffer_ptr := GET_INFO(BUFFERS,'FIRST'); LOOP EXITIF buffer_ptr = 0; EXITIF new_buffer = GET_INFO(buffer_ptr,'NAME'); buffer_ptr := GET_INFO(BUFFERS,'NEXT'); ENDLOOP; IF buffer_ptr = 0 THEN buffer_ptr := CREATE_BUFFER(new_buffer); ENDIF; ERASE(buffer_ptr); POSITION(buffer_ptr); SPLIT_LINE; MOVE_VERTICAL(-1); MOVE_TEXT(EDTP$x_select_range); POSITION(temp_position); EDTP$x_select_range:=0; ELSE MESSAGE("No Select Active"); EDTP$x_repeat_count := 1; ! ! Check to see if user has the buffer clearing feature ! ENDIF; ENDPROCEDURE; ! page 95 PROCEDURE EDTP$COPY LOCAL temp_position, new_buffer, buffer_ptr; EDTP$select_range; IF EDTP$x_select_range <> 0 THEN temp_position := MARK(NONE); new_buffer:= READ_LINE("Buffer to copy to: "); CHANGE_CASE(new_buffer,UPPER); buffer_ptr := GET_INFO(BUFFERS,'FIRST'); LOOP EXITIF buffer_ptr = 0; EXITIF new_buffer = GET_INFO(buffer_ptr,'NAME'); buffer_ptr := GET_INFO(BUFFERS,'NEXT'); ENDLOOP; IF buffer_ptr = 0 THEN buffer_ptr := CREATE_BUFFER(new_buffer); SET (NO_WRITE, buffer_ptr, ON); SET(EOB_TEXT, buffer_ptr, '[End of '+new_buffer+']'); ENDIF; ERASE(buffer_ptr); POSITION(buffer_ptr); COPY_TEXT(EDTP$x_select_range); POSITION(temp_position); EDTP$x_select_range:=0; ELSE MESSAGE("No Select Active"); EDTP$x_repeat_count := 1; ! ! Check to see if user has the buffer clearing feature ! ENDIF; ENDPROCEDURE; ! page 96 PROCEDURE EDTP$COPY_TO_END_OF_BUFFER LOCAL temp_position, new_buffer, buffer_ptr; EDTP$select_range; IF EDTP$x_select_range <> 0 THEN temp_position := MARK(NONE); new_buffer:= READ_LINE("Buffer to append to: "); CHANGE_CASE(new_buffer,UPPER); buffer_ptr := GET_INFO(BUFFERS,'FIRST'); LOOP EXITIF buffer_ptr = 0; EXITIF new_buffer = GET_INFO(buffer_ptr,'NAME'); buffer_ptr := GET_INFO(BUFFERS,'NEXT'); ENDLOOP; IF buffer_ptr = 0 THEN buffer_ptr := CREATE_BUFFER(new_buffer); SET (NO_WRITE, buffer_ptr, ON); SET(EOB_TEXT, buffer_ptr, '[End of '+new_buffer+']'); ENDIF; POSITION(end_of(buffer_ptr)); COPY_TEXT(EDTP$x_select_range); POSITION(temp_position); EDTP$x_select_range:=0; ELSE MESSAGE("No Select Active"); ! ! Check to see if user has the buffer clearing feature ! EDTP$x_repeat_count := 1; ENDIF; ENDPROCEDURE; ! page 97 PROCEDURE EDTP$PASTE_Buf LOCAL temp_position, new_buffer, buffer_ptr, paste_text ; new_buffer:= READ_LINE("Buffer to PASTE from: "); CHANGE_CASE(new_buffer,UPPER); buffer_ptr := GET_INFO(BUFFERS,'FIRST'); LOOP EXITIF buffer_ptr = 0; EXITIF new_buffer = GET_INFO(buffer_ptr,'NAME'); buffer_ptr := GET_INFO(BUFFERS,'NEXT'); ENDLOOP; IF buffer_ptr = 0 THEN MESSAGE("No such buffer"); ! ! Check to see if user has the buffer clearing feature ! RETURN; ENDIF; IF (BEGINNING_OF(buffer_ptr) <> END_OF(buffer_ptr)) THEN COPY_TEXT(buffer_ptr); APPEND_LINE; ENDIF; ENDPROCEDURE; ! page 99 PROCEDURE EDTP$SPAWN LOCAL Command, JUNK; Command := READ_LINE(' DCL Command: '); IF Command = "" THEN SET (STATUS_LINE, CURRENT_WINDOW, REVERSE, ' LOGOUT to resume editing'); UPDATE(CURRENT_WINDOW); SET (SCREEN_UPDATE,OFF); SPAWN; eve$set_status_line(current_window); SET (SCREEN_UPDATE,ON); REFRESH; ELSE SET (SCREEN_UPDATE,OFF); SPAWN(command); JUNK := READ_LINE('Press any key to continue',1); SET (SCREEN_UPDATE,ON); REFRESH; ENDIF; ENDPROCEDURE; PROCEDURE EDTP$find_beg_of_line (b_mark) ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! ! to be called by EDTP$preserve_blanks, thereby preventing ! the dreaded word-split when the select range starts in a ! word that extends beyond the specified margin. ! LOCAL temp_pattern, temp_rang; ON_ERROR RETURN ENDON_ERROR; POSITION (b_mark); MOVE_HORIZONTAL (-current_offset); b_mark := MARK(NONE); ENDPROCEDURE; ! page 100 PROCEDURE EDTP$return ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! ! implements autoindent a'la Apple Pascal, ! actuated when programming delimiters are used. ! LOCAL blanktab, orig_pos, first_pos, leading_blanks, dupe; ! search for first non-space or tab character ! if line is empty then search for line_end SPLIT_LINE; ! string next is space, tab blanktab := ''&(NOTANY (" ") | LINE_END); orig_pos := MARK(NONE); MOVE_VERTICAL (-1); first_pos := MARK(NONE); leading_blanks := SEARCH (blanktab,FORWARD,EXACT); IF leading_blanks <> 0 THEN POSITION (leading_blanks); endif; if current_offset <> 0 THEN MOVE_HORIZONTAL (-1); dupe := CREATE_RANGE(first_pos,MARK(NONE),NONE); POSITION (orig_pos); COPY_TEXT(dupe); ELSE POSITION (orig_pos); ENDIF; ENDPROCEDURE; ! page 101 PROCEDURE EDTP$motion(which_way) ! ! This routine is based upon one from Kalamazoo Collage Supplement ! Copyright 1985 by Richard D. Piccard, Michael L. Penix, and ! Kalamazoo College, Kalamazoo, Michigan, to the extent not ! copyright by DIGITAL. ! ! EDT up/down arrow motion w/ grace near tabs ! from DECUS Symposium 12/85 "Programming with TPU." ! LOCAL temp_col, last_col, new_col, bob, eob, buf; buf := CURRENT_BUFFER; bob := beginning_of(buf); eob := END_OF(buf); last_col := GET_INFO(buf,'OFFSET_COLUMN'); IF (last_col <> EDTP$x_prev_column) THEN EDTP$x_target_column := last_col; ENDIF; MOVE_VERTICAL (which_way); new_col := GET_INFO(buf,'OFFSET_COLUMN'); ! ! now get as close to the target as possible ! IF new_col <> EDTP$x_target_column THEN IF new_col < EDTP$x_target_column THEN LOOP EXITIF MARK(NONE) = eob; EXITIF MARK(NONE) = bob; EXITIF CURRENT_CHARACTER = ''; EXITIF new_col >= EDTP$x_target_column; MOVE_HORIZONTAL (1); temp_col := GET_INFO(buf,'OFFSET_COLUMN'); IF temp_col > EDTP$x_target_column THEN MOVE_HORIZONTAL(-1); EXITIF; ELSE new_col := temp_col; ENDIF; ENDLOOP; ELSE LOOP EXITIF current_offset = 0; EXITIF new_col <= EDTP$x_target_column; MOVE_HORIZONTAL(-1); new_col := GET_INFO(buf,'OFFSET_COLUMN'); ENDLOOP; ENDIF; ENDIF; EDTP$x_prev_column := new_col; ENDPROCEDURE; ! page 102 PROCEDURE EDTP$Learning LOCAL EDTP$L_Key; EDTP$L_key := READ_LINE('Enter key to be defined'); EDTP$Learn_key := LAST_KEY; MESSAGE("Press GOLD ] to end LEARN sequence"); DEFINE_KEY('EDTP$Stop_Learn_X',KEY_NAME(']',SHIFT_KEY),'Learn_End'); EDTP$Learn_On := 1; MESSAGE("LEARN Activated"); LEARN_BEGIN(EXACT); ENDPROCEDURE; PROCEDURE EDTP$Stop_Learn MESSAGE(" Learn not activated"); ENDPROCEDURE; PROCEDURE EDTP$STOP_LEARN_X EDTP$Learn_1 := LEARN_END; DEFINE_KEY(EDTP$Learn_1,EDTP$Learn_Key); MESSAGE("LEARN Completed"); DEFINE_KEY('EDTP$Stop_Learn',KEY_NAME(']',SHIFT_KEY),'Learn_End'); EDTP$Learn_On := 0; ENDPROCEDURE; ! page 104 ! ! EDTP UNDELETE CHARACTER ! PROCEDURE EDTP$undelete_char !gold comma (undelete character) if EDTP$x_deleted_char <> ascii(10) then copy_text (EDTP$x_deleted_char) else split_line endif; move_horizontal (-1); ENDPROCEDURE; ! ! EDTP UNDELETE LINE ! PROCEDURE EDTP$undelete_line !gold pf4 (undelete line) LOCAL temp_length; if (EDTP$x_appended_line) then split_line; copy_text (EDTP$x_deleted_line); move_horizontal (-(current_offset + 1)); else temp_length := length(EDTP$x_deleted_line); if (EDTP$x_delete_crlf = 1) and (mark(none) <> end_of(current_buffer)) then split_line; move_horizontal(-1); endif; copy_text(EDTP$x_deleted_line); move_horizontal( - ( temp_length ) ); endif; ENDPROCEDURE; ! ! EDTP Undelete WORD ! PROCEDURE EDTP$undelete_word !gold keypad minus(undelete word) local two_lines; if EDTP$x_deleted_word <> ascii(10) then if substr(EDTP$x_deleted_word, 1, 1) = ascii(10) then split_line; copy_text(substr(EDTP$x_deleted_word, 2, length(EDTP$x_deleted_word) - 1)); else copy_text(EDTP$x_deleted_word) ; endif; move_horizontal( - length (EDTP$x_deleted_word)); else split_line; move_horizontal (-1); endif; ENDPROCEDURE; ! page 105 PROCEDURE EDTP$on_end_of_line !support routine for undelete if (current_character = EDTP$x_empty) then EDTP$on_end_of_line := 1 else EDTP$on_end_of_line := 0 endif; ENDPROCEDURE; !**************************************** PROCEDURE EDTP$WRAP_WORD ! ! Procedure to wrap the word to the next line. Bound to space key when ! a SET WRAP is done. ! local word_size, trash_space; if EDTP$x_wrap_position = 0 then undefine_key(key_name(' ')); else if current_column > EDTP$x_wrap_position then word_size := EDTP$beg_word; split_line; move_horizontal(word_size); endif; endif; copy_text(' '); ENDPROCEDURE; !**************************************** PROCEDURE EDTP$eve_cursor_keys DEFINE_KEY("cursor_horizontal(-1)", left, "left_arrow"); DEFINE_KEY("cursor_horizontal(1)", right, "right_arrow"); DEFINE_KEY('EDTP$move_up', up, "Up_arrow"); DEFINE_KEY('EDTP$move_down', down, "Down_arrow"); EDTP$pce_scroll_top := get_info(current_window, "scroll_top"); EDTP$pce_scroll_bot := get_info(current_window, "scroll_bottom"); EDTP$pce_scroll_amt := get_info(current_window, "scroll_amount"); set(scrolling, current_window, on, 0, 0, 0); ENDPROCEDURE; !**************************************** PROCEDURE EDTP$edt_cursor_keys DEFINE_KEY("move_horizontal(-1)", left, "left_arrow"); DEFINE_KEY("move_horizontal(1)", right, "right_arrow"); DEFINE_KEY('EDTP$motion(-1)', up, "Up_arrow"); DEFINE_KEY('EDTP$motion(+1)', down, "Down_arrow"); set(scrolling, current_window, on, EDTP$pce_scroll_top, EDTP$pce_scroll_bot, EDTP$pce_scroll_amt); ENDPROCEDURE; !**************************************** PROCEDURE EDTP$move_down ! Move down one row, staying in the same column. Scroll if necessary. if get_info (current_window, "current_row") = get_info (current_window, "visible_bottom") then scroll (current_window, 1); else cursor_vertical (1); endif; ENDPROCEDURE; !**************************************** PROCEDURE EDTP$move_up ! Move up one row, staying in the same column. Scroll if necessary. if get_info (current_window, "current_row") = get_info (current_window, "visible_top") then scroll (current_window, -1); else cursor_vertical (-1); endif; ENDPROCEDURE; !**************************************** PROCEDURE EDTP$delete_range ! support routine for line mode(delete cmd) LOCAL buffer_ptr, buffer_name, range_specifier , term_char , text_to_delete ; ! ! Now check for what to delete. ! I am only going to support SELECT, WHOLE, REST, BEFORE, and =buffer ! range_specifier := EDTP$next_token(':',term_char); if (range_specifier = EDTP$x_empty) then message("No range specified -- use SELECT, WHOLE, REST, BEFORE, or =buffer"); return 0; endif; ! Check for =buffer alone if (range_specifier = '=') then buffer_name := EDTP$next_token(EDTP$x_empty,term_char); if (buffer_name = EDTP$x_empty) then message ('No buffer specified'); return 0; endif; buffer_ptr := EDTP$find_buffer (buffer_name); if (buffer_ptr = 0) then message ('Specified buffer does not exist'); return 0; else erase(buffer_ptr); return 1; endif; else text_to_delete := EDTP$range_specification(range_specifier); if (text_to_delete = 0) then return 0; endif; erase(text_to_delete); ! ! If we wrote out a range, it must have been the select range. ! Get rid of it. ! if (get_info(text_to_delete,'type') = RANGE) then EDTP$x_select_range := 0; endif; return 1; endif; ENDPROCEDURE; !**************************************** PROCEDURE EDTP$eve_do(cmd_string) local old_position, eve_cmd_line, cmd_string, original_line, org_line_length; original_line := cmd_string; org_line_length := length(original_line); old_position := mark(none); if index(original_line, "EVE ") <> 0 then eve_cmd_line := substr(original_line, 5, org_line_length); else eve_cmd_line := original_line; endif; if (length (eve_cmd_line) > 0) then eve$process_command (eve_cmd_line); else if current_window = eve$command_window then eve$exit_command_window; else eve$enter_command_window; endif; endif; ENDPROCEDURE; ! page 113 ! ! Bind all EDTP keys ! ! Procedure to define keys to emulate EDT ! PROCEDURE EDTP$DEFINE_KEYs !define all keys LOCAL temp_string ; create_key_map ("EDTP$std_keys"); ! ! Define all the keys ! ! arrow keys ! DEFINE_KEY('EDTP$move_up', up, "Up_arrow", "EDTP$std_keys"); DEFINE_KEY('EDTP$move_down', down, "Down_arrow", "EDTP$std_keys"); DEFINE_KEY('MOVE_VERTICAL(-(EDTP$window_size))', key_name(up,shift_key), "Move_screen_up", "EDTP$std_keys"); DEFINE_KEY('MOVE_VERTICAL(+(EDTP$window_size))', key_name(down,shift_key), "Move_screen_down", "EDTP$std_keys"); ! ! Editing keypad keys ! DEFINE_KEY('EDTP$search', E1, "find", "EDTP$std_keys"); DEFINE_KEY('EDTP$paste', E2, "paste", "EDTP$std_keys"); DEFINE_KEY('EDTP$cut', E3, "cut", "EDTP$std_keys"); DEFINE_KEY("EDTP$select", E4, "select", "EDTP$std_keys"); DEFINE_KEY('EDTP$section(reverse)', E5, "sect", "EDTP$std_keys"); DEFINE_KEY('EDTP$section(forward)', E6, "sect", "EDTP$std_keys"); ! ! Function keys ! DEFINE_KEY('EDTP$keypad_help', help, "keypad_diagram", "EDTP$std_keys"); DEFINE_KEY('EDTP$help(EDTP$x_empty)', key_name(help,shift_key), "vaxtpu_help", "EDTP$std_keys"); DEFINE_KEY('EDTP$eve_do("")', do, "EVE cmd mode", "EDTP$std_keys"); ! ! keypad keys ! DEFINE_KEY("EDTP$keypad_help", pf2, "keypad_diagram", "EDTP$std_keys"); DEFINE_KEY("EDTP$help(EDTP$x_empty)", key_name(pf2,shift_key), "help", "EDTP$std_keys"); DEFINE_KEY('EDTP$search_next', pf3, "fndnxt", "EDTP$std_keys"); DEFINE_KEY('EDTP$search', key_name(pf3,shift_key), "find", "EDTP$std_keys"); DEFINE_KEY('EDTP$delete_line', pf4, "del_l", "EDTP$std_keys"); DEFINE_KEY('EDTP$undelete_line', key_name(pf4,shift_key), "und_l", "EDTP$std_keys"); ! DEFINE_KEY('EDTP$next_prev_line', kp0, "move by line", "EDTP$std_keys"); DEFINE_KEY('split_line; move_vertical(-1)', key_name(kp0,shift_key), "open line", "EDTP$std_keys"); DEFINE_KEY('EDTP$move_word_f', kp1, "move fwd word", "EDTP$std_keys"); DEFINE_KEY('EDTP$change_case', key_name(kp1,shift_key), "change case", "EDTP$std_keys"); DEFINE_KEY('EDTP$end_of_line', kp2, "go to eol", "EDTP$std_keys"); DEFINE_KEY('EDTP$delete_to_eol', key_name(kp2,shift_key), "del to eol", "EDTP$std_keys"); DEFINE_KEY('EDTP$move_word_r', kp3, "move rev word", "EDTP$std_keys"); DEFINE_KEY('copy_text(ascii(int(read_line("SPECINS : "))))', key_name(kp3,shift_key), "specins", "EDTP$std_keys"); DEFINE_KEY('eve_forward', kp4, "advance", "EDTP$std_keys"); DEFINE_KEY('position(end_of(current_buffer))', key_name(kp4,shift_key), "bottom", "EDTP$std_keys"); DEFINE_KEY('eve_reverse', kp5, "backup", "EDTP$std_keys"); DEFINE_KEY('position(beginning_of(current_buffer))', key_name(kp5,shift_key), "top", "EDTP$std_keys"); DEFINE_KEY("EDTP$cut", kp6, "cut", "EDTP$std_keys"); DEFINE_KEY("EDTP$paste", key_name(kp6,shift_key), "paste", "EDTP$std_keys"); DEFINE_KEY('EDTP$page', kp7, "page", "EDTP$std_keys"); DEFINE_KEY('EDTP$Line_mode(EDTP$Single_line)', key_name(kp7,shift_key), "EDTP CMD mode", "EDTP$std_keys"); DEFINE_KEY('EDTP$section(current_direction)', kp8, "sect", "EDTP$std_keys"); DEFINE_KEY('EDTP$fill', key_name(kp8,shift_key), "fill", "EDTP$std_keys"); DEFINE_KEY('EDTP$append', kp9, "append", "EDTP$std_keys"); DEFINE_KEY('EDTP$replace', key_name(kp9,shift_key), "replace", "EDTP$std_keys"); ! DEFINE_KEY('EDTP$delete_end_word', minus, "del_w", "EDTP$std_keys"); DEFINE_KEY('EDTP$undelete_word', key_name(minus,shift_key), "und_w", "EDTP$std_keys"); DEFINE_KEY('EDTP$delete_char', comma, "del_c", "EDTP$std_keys"); DEFINE_KEY('EDTP$undelete_char', key_name(comma,shift_key), "und_c", "EDTP$std_keys"); DEFINE_KEY("EDTP$select", period, "select", "EDTP$std_keys"); DEFINE_KEY("EDTP$reset", key_name(period,shift_key), "reset", "EDTP$std_keys"); DEFINE_KEY("eve_return", enter, "return", "EDTP$std_keys"); DEFINE_KEY('EDTP$substitute', key_name(enter,shift_key), "subs", "EDTP$std_keys"); ! ! control keys ! DEFINE_KEY('EDTP$end_of_line', ctrl_e_key, "Move to end of line", "EDTP$std_keys"); DEFINE_KEY('unmap(info_window)', ctrl_f_key, "unmap info window", "EDTP$std_keys"); DEFINE_KEY("user$tab_conversion", ctrl_i_key, "TAB", "EDTP$std_keys"); DEFINE_KEY('EDTP$define_key', ctrl_k_key, "Define key", "EDTP$std_keys"); DEFINE_KEY('move_horizontal(-(current_offset+1))', ctrl_p_key, "Move to end of previous line", "EDTP$std_keys"); DEFINE_KEY('eve_quote', ctrl_v_key, "Quote (Binary insert)", "EDTP$std_keys"); DEFINE_KEY("refresh", ctrl_w_key, "Refresh", "EDTP$std_keys"); DEFINE_KEY('EDTP$Line_mode(EDTP$Multi_line)', ctrl_z_key, "EDT_Line_mode", "EDTP$std_keys"); ! ! 'SHIFT + key' keys ! DEFINE_KEY('EDTP$Set_Buffer', key_name('b',shift_key), "Change_buffer.", "EDTP$std_keys"); ! ! 'SHIFT + control-key' keys ! DEFINE_KEY('EDTP$Prompt_on_EXIT', key_name(ctrl_z_key,shift_key), "File EXIT", "EDTP$std_keys"); ! ! other keys ! DEFINE_KEY('EDTP$wrap_word', key_name(' '), "", "EDTP$std_keys"); DEFINE_KEY("user$tab_conversion", tab_key, "TAB", "EDTP$std_keys"); DEFINE_KEY("eve_return", ret_key, "return", "EDTP$std_keys"); DEFINE_KEY('EDTP$backspace', bs_key, "backspace", "EDTP$std_keys"); DEFINE_KEY('EDTP$rubout', del_key, "delete", "EDTP$std_keys"); ! ! Define the numeric keys for use with EDTP$gold_number ! these are necessary to emulate EDT repeat counts ! DEFINE_KEY('EDTP$gold_number("0")', key_name('0',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("1")', key_name('1',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("2")', key_name('2',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("3")', key_name('3',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("4")', key_name('4',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("5")', key_name('5',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("6")', key_name('6',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("7")', key_name('7',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("8")', key_name('8',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("9")', key_name('9',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number(EDTP$x_empty)', key_name('+',shift_key), "", "EDTP$std_keys"); DEFINE_KEY('EDTP$gold_number("-")', key_name('-',shift_key), "", "EDTP$std_keys"); ENDPROCEDURE; PROCEDURE PCE$EDTP_KEYS on_error endon_error; remove_key_map("TPU$KEY_MAP_LIST", pce$x_standard_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_user_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_standard_keys, ALL); add_key_map(eve$x_key_map_list, "first", EDTP$x_standard_keys); add_key_map(eve$x_key_map_list, "last", pce$x_vt200_keys); add_key_map(eve$x_key_map_list, "last", pce$x_standard_keys); add_key_map(eve$x_key_map_list, "last", eve$x_user_keys); add_key_map(eve$x_key_map_list, "last", eve$x_vt200_keys); add_key_map(eve$x_key_map_list, "last", eve$x_standard_keys); eve$x_vt200_keypad := TRUE; ENDPROCEDURE; !**************************************** PROCEDURE PCE$VT100_KEYS on_error endon_error; pce$x_standard_keys := "pce$std_keys"; pce$x_vt100_keys := "pce$100_keys"; pce$x_vt200_keys := "pce$200_keys"; edtp$x_standard_keys := "edtp$std_keys"; remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", edtp$x_standard_keys,ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_standard_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_user_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_standard_keys, ALL); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_vt100_keys); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_standard_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_user_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_vt100_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_standard_keys); eve$x_vt200_keypad := FALSE; ENDPROCEDURE; !**************************************** PROCEDURE PCE$VT200_KEYS on_error endon_error; pce$x_standard_keys := "pce$std_keys"; pce$x_vt100_keys := "pce$100_keys"; pce$x_vt200_keys := "pce$200_keys"; edtp$x_standard_keys := "edtp$std_keys"; remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", edtp$x_standard_keys,ALL); remove_key_map("TPU$KEY_MAP_LIST", pce$x_standard_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_user_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt100_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_vt200_keys, ALL); remove_key_map("TPU$KEY_MAP_LIST", eve$x_standard_keys, ALL); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_vt200_keys); add_key_map(eve$x_key_map_list, eve$kt_last, pce$x_standard_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_user_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_vt200_keys); add_key_map(eve$x_key_map_list, eve$kt_last, eve$x_standard_keys); eve$x_vt200_keypad := TRUE; ENDPROCEDURE; ! ! EDTP INITIALIZATION PROCEDURE ! ! This procedure is invoked to initialize the editing session. The windows ! and buffers are created here. ! PROCEDURE EDTP$init_procedure ! initialization procedure ! ! Initialize our variables EDTP$init_variables; edtp$x_standard_keys := "edtp$std_keys"; ! save scroll settings for use later by cursor setting routines EDTP$pce_scroll_top := 6; EDTP$pce_scroll_bot := 7; EDTP$pce_scroll_amt := 0; ! ! Go and read information in user files and do final set up ! EDTP$Windows := "OFF"; EDTP$main_buffer := current_buffer; EDTP$x_wrap_position := 0; EDTP$window_size := 21; ! EDTP$User_Commands; ! eve$set_status_line(current_window); eveplus_v_begin_select := 0; ! ! Set bell on only after the set up has been completed ! SET (BELL,ALL,ON); ENDPROCEDURE; ! ! This is the code to be executed when the section is being built ! ! Define the keys, user_variables, save the section, and quit. ! edtp$define_keys; compile ('procedure edtp$define_keys endprocedure'); save ("tpu$eveplus:tpuplus.tpu$section"); quit;